! Metodos Numericos y Simulaciones en Astrofisica
! FCEFN - UNSJ, 2010
!
! ejemplo 3b
!
! Ordenamiento de arrays - Metodo Heapsort
!
!
program eje3b
implicit none
  integer, parameter ::d=selected_real_kind(16,200)
  integer :: ii
  real(d), dimension(50) :: ori,dat
  real(d) :: val

! inicializa generador de numeros aleatorios
!
  call random_seed()

! arma un array de numeros reales al azar
!
  do ii=1,50
    call random_number(val)
    dat(ii)=float(int(10000._d*val))/10._d
  enddo

! guarda el array original
!
  ori=dat

! lo ordena usando insercion
!
  call heap(50,dat)

! salida a pantalla
!
  write(*,*)'Array original: '
  write(*,*)ori
  write(*,*)' '
  write(*,*)'Array ordenado: '
  write(*,*)dat

end program eje3b

! subrutina para efectuar un ordenamiento
! utilizando el metodo Heapsort
!
! se ingresa con:
!
! N   numero de elementos del array
! ARR array a ordenar
!
! en la salida se devuelve el array ordenado en ARR.
!
subroutine heap(n,arr)
implicit none
  integer, parameter ::d=selected_real_kind(16,200)
  integer :: n,ll,ir,ii,jj
  real(d),dimension(n) :: arr
  real(d) :: rra

  if(n < 2) return

! construye la pila. El indice LL se decrementa hasta 1 al
! armar la pila mientras que IR se decrementa a 1 al efectuar
! la seleccion para el ordenamiento final
!
  ll=n/2+1
  ir=n

  do
    if(ll > 1)then

! aun esta construyendo la pila
!
      ll=ll-1
      rra=arr(ll)

! esta seleccionando objetos de la pila
!
    else

! deja libre un lugar al final del array
!
      rra=arr(ir)
      arr(ir)=arr(1)
      ir=ir-1

! este es el punto de salida cuando selecciona
! el ultimo elemento
!
      if(ir == 1)then
        arr(1)=rra
        return
      endif
    endif

! posiciona el elemento seleccionado en su nivel correcto
!
    ii=ll
    jj=ll+ll
    do while(jj <= ir)
      if(jj < ir)then

! compara con los elementos que estan por debajo en la pila
!
        if(arr(jj) < arr(jj+1))jj=jj+1
      endif
      if(rra < arr(jj))then
        arr(ii)=arr(jj)
        ii=jj
        jj=jj+jj
      else
        jj=ir+1
      endif
    enddo

! selecciona el elemento
!
    arr(ii)=rra
  enddo

end subroutine
