2022-03-27 04:36:25 +02:00
|
|
|
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
|
2022-03-30 08:42:39 +02:00
|
|
|
integer :: fd, errcode
|
2022-03-27 04:36:25 +02:00
|
|
|
character (len=200) :: command
|
|
|
|
|
|
2022-03-30 08:42:39 +02:00
|
|
|
KA(1) = -1.42 ; KA(2) = 1.62
|
|
|
|
|
KA(3) = 1.08 ; KA(4) = -2.43
|
2022-03-27 04:36:25 +02:00
|
|
|
|
2022-03-30 08:42:39 +02:00
|
|
|
KB(1) = 1.51 ; KB(2) = -1.89
|
|
|
|
|
KB(3) = 1.69 ; KB(4) = 0.79
|
|
|
|
|
|
|
|
|
|
nbsteps = 1800
|
|
|
|
|
nbpoints = 70000
|
2022-03-27 04:36:25 +02:00
|
|
|
allocate(points(nbpoints), stat=errcode)
|
|
|
|
|
if (0 .NE. errcode) then
|
|
|
|
|
STOP " : EVOLVOPICK, NO ENOUGH MEMORY"
|
|
|
|
|
endif
|
|
|
|
|
|
2022-03-30 08:42:39 +02:00
|
|
|
do tick = 0, nbsteps-1
|
2022-03-27 04:36:25 +02:00
|
|
|
|
|
|
|
|
dptick = DBLE(tick) / DBLE(nbsteps)
|
|
|
|
|
! print *, tick, " ", dptick
|
|
|
|
|
call interp4dp(KA, KB, KI, dptick)
|
|
|
|
|
! print *, KI(1), KI(2), KI(3), KI(4)
|
2022-03-30 08:42:39 +02:00
|
|
|
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)
|
|
|
|
|
!
|
2022-03-27 04:36:25 +02:00
|
|
|
|
|
|
|
|
call compute_pickover(points, KI)
|
2022-03-30 08:42:39 +02:00
|
|
|
call write_points3d(points, 27, 69900, 'WS/pick.dat')
|
2022-03-27 04:36:25 +02:00
|
|
|
|
|
|
|
|
write(command, '(A, I6)') './tracepick.sh ', tick
|
|
|
|
|
call execute_command_line (command, exitstat=errcode)
|
|
|
|
|
if (0 .NE. errcode) then
|
2022-03-30 08:42:39 +02:00
|
|
|
STOP ' : ERR RUN TRACE COMMAND !'
|
2022-03-27 04:36:25 +02:00
|
|
|
endif
|
|
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
!-----------------------------------------------------
|
|
|
|
|
contains
|
|
|
|
|
|
2022-03-30 08:42:39 +02:00
|
|
|
|
|
|
|
|
|
2022-03-27 04:36:25 +02:00
|
|
|
subroutine interp4dp (ina, inb, out, dpk)
|
|
|
|
|
double precision, dimension(4), intent(in) :: ina, inb
|
|
|
|
|
double precision, dimension(4), intent(out) :: out
|
|
|
|
|
double precision, intent(in) :: dpk
|
|
|
|
|
integer :: foo
|
|
|
|
|
|
|
|
|
|
do foo=1, 4
|
|
|
|
|
out(foo) = (ina(foo) * (1.0-dpk)) + (inb(foo) * (dpk))
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
|
|
end program evolvopick
|
