Implementación del algoritmo de ordenación Mergesort en Fortran90.

abrirfiles.f90

      SUBROUTINE abrirfiles
        INTEGER*4 long
        CHARACTER*11 status,form
        CHARACTER*72 cfile
        CHARACTER*80 fname
!!Abrir archivos de lectura y escritura
      iarg=iargc()
      if(iarg.ne.1) STOP 'Exactamente introducir un argumento en la linea de comando'
      CALL GETARG(1,cfile,long)
      OPEN(1,FILE=cfile,STATUS='old',ERR=8000)
 8003 READ(1,*,END=8001) iunit,fname,status,form
      OPEN(iunit,FILE=fname,STATUS=status,FORM=form,iostat=ist,ERR=8002)
      GOTO 8003
 8000 WRITE(*,*) 'Error al abrir !!!!',cfile
      STOP 
 8002 WRITE(*,*) ' ERROR IN OPENING UNIT:',IUNIT
      WRITE(*,*) ' FILENAME: ',FNAME,'  STATUS: ',STATUS,'  FORM:',FORM,ist
      STOP 'OPEN FAILED'
 8001 RETURN
      END

mergesort.f90

!Códigos correspondientes al trabajo realizado para el ISUM 2012.
! Test de rendimiento de los algoritmos de ordenamiento Quicksort,
! Mezcla y burbuja implementados en C++, Fortran y Python.
! Guanajuato, Guanajuato, México (14-16 de Marzo 2012)
!
! Programa: mergesort.f90
! compilar: ifort -O mergesort.cpp -o mergesort
! Uso: $./mergesort 1000.dat
! El tamaño del array se toma del nombre del archivo (1000.dat)
! Salida:
! $Tamaño_array Tiempo_de_ejecución_del_algoritmo


subroutine Merge(A,NA,B,NB,C,NC)
 
   integer, intent(in) :: NA,NB,NC         
   integer, intent(in out) :: A(NA)        
   integer, intent(in)     :: B(NB)
   integer, intent(in out) :: C(NC)
 
   integer :: I,J,K
 
   I = 1; J = 1; K = 1;
   do while(I <= NA .and. J <= NB)
      if (A(I) <= B(J)) then
         C(K) = A(I)
         I = I+1
      else
         C(K) = B(J)
         J = J+1
      endif
      K = K + 1
   enddo
   do while (I <= NA)
      C(K) = A(I)
      I = I + 1
      K = K + 1
   enddo
   return
 
end subroutine merge
 
recursive subroutine MergeSort(A,N,T)
 
   integer, intent(in) :: N
   integer, dimension(N), intent(in out) :: A
   integer, dimension((N+1)/2), intent (out) :: T
   integer :: NA,NB,V
 
   if (N < 2) return
   if (N == 2) then
      if (A(1) > A(2)) then
         V = A(1)
         A(1) = A(2)
         A(2) = V
      endif
      return
   endif      
   NA=(N+1)/2
   NB=N-NA
 
   call MergeSort(A,NA,T)
   call MergeSort(A(NA+1),NB,T)
 
   if (A(NA) > A(NA+1)) then
      T(1:NA)=A(1:NA)
      call Merge(T,NA,A(NA+1),NB,A,N)
   endif
   return
 
end subroutine MergeSort
 
program TestMergeSort
 
   integer             :: N 
   real , allocatable  :: A(:),T(:)
   real                :: 	inicio, final
   real                :: nn
   call abrirfiles()
   read(6,*) N
   nn=N
   allocate(T((N+1)/2),A(N))
   do i=1,n
		read(5,*) A(i)
	enddo
	!print*, n,A
	call cpu_time(inicio)
	call MergeSort(A,N,T)
	call cpu_time(final)
     write(*,100)  n,(final-inicio)
 100   format(I12,f11.6)
  !
  ! write(*,'(A,/,10I3)')'arreglo ordenado :',A
 
end program TestMergeSort