Fortraneries/Fraktalism/evolvopick.f90

program evolvopick

  use spitpgm
  use points3d 
  use fraktals

!-----------------------------------------------------

  implicit none

  double precision, dimension(4)    ::  KA, KB, KI
  integer                           ::  tick, nbsteps
  double precision                  ::  dptick
  type(t_point3d), dimension(:), allocatable ::  points
  integer                                    ::  nbpoints
  integer                                    ::  fd, errcode
  character (len=200)                        ::  command

  KA(1) = -1.42      ;     KA(2) =  1.62
  KA(3) =  1.08      ;     KA(4) = -2.43

  KB(1) =  1.51      ;     KB(2) = -1.89
  KB(3) =  1.69      ;     KB(4) =  0.79

  nbsteps  = 1800
  nbpoints = 70000
  allocate(points(nbpoints), stat=errcode)
  if (0 .NE. errcode) then
    STOP " : EVOLVOPICK, NO ENOUGH MEMORY"
  endif

  do tick = 0, nbsteps-1

    dptick = DBLE(tick) / DBLE(nbsteps)
    ! print *, tick, "      ", dptick
    call interp4dp(KA, KB, KI, dptick)
    ! print *, KI(1), KI(2), KI(3), KI(4)
    write(0, '(1X, I8, 3X, 4F11.6)') tick, KI

    !  mmmm, not optimal
    open (newunit=fd, file='WS/k-pick.txt',            &
          status='unknown', position='append',         &
          action='write', iostat=errcode)
    if (0 .NE. errcode) then
      STOP ' : FUBAR ON OUTPUT FILE'
    endif
    write(fd, '(I5, 4X, 4F8.4)') tick, KI
    close(fd)
    !            

    call compute_pickover(points, KI)
    call write_points3d(points, 27, 69900, 'WS/pick.dat')

    write(command, '(A, I6)') './tracepick.sh ', tick
    call execute_command_line (command, exitstat=errcode)
    if (0 .NE. errcode) then
      STOP ' : ERR RUN TRACE COMMAND !'
    endif

  enddo

!-----------------------------------------------------

end program evolvopick