Implementación del algoritmo de ordenación Quicksort 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

quicksort.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: quicksort.f90
! compilar: ifort -O quicksort.cpp -o quicksort
! Uso: $./quicksort 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


module q_s
 contains
function dividir(array,inicio,fin) result(f_result)

  integer              :: f_result	
  integer , intent(in) :: inicio
  integer , intent(in) :: fin
  integer , intent(out) :: array(:)
  integer temp,izq,der,pivote
 
  pivote=array(inicio)
  izq=inicio
  der=fin
  do while (izq < der)
     do while(array(der) > pivote)
        der=der-1
     enddo
     do while((izq<der).and.( (array(izq))<=pivote ))
       izq=izq+1
     enddo
     if (izq.lt.der) then
        temp=array(izq)
        array(izq)=array(der)
        array(der)=temp
      endif
  enddo
  temp=array(der)

  array(der)=array(inicio)
  array(inicio)=temp
  f_result=der
  return
end function
 recursive subroutine quicksort(array,inicio,fin)

  integer , intent(in) :: inicio
  integer , intent(in) :: fin
  integer , intent(inout) ::  array(:)
  integer :: pivote

  if (inicio < fin) then

     pivote=dividir(array,inicio,fin)
     call  quicksort(array,inicio,pivote-1)
     !print*,array
     call  quicksort(array,pivote+1,fin)
  endif
  return
end subroutine quicksort

end module q_s

program quick
   use q_s
   integer     :: n
   integer , allocatable :: array(:)
   real        :: ini, final
  
   call abrirfiles()
   read(6,*) N
   allocate(array(n))
   
   do i=1,n
      read(5,*) array(i)
   enddo
   call cpu_time(ini)
   call quicksort(array,1,n)
   call cpu_time(final)
   !write(*,101) array
   write(*,100)  n,(final-ini)
100 format(I12,f11.4)
101 format(4I5) 
  

  
end program quick