tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

pickover evolutif

Browse Source
This commit is contained in:
tth
2022-03-30 08:42:39 +02:00
parent f89860afe0
commit 756ef965fd
7 changed files with 79 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files

39
Fraktalism/evolvopick.f90
View File

@@ -13,44 +13,57 @@ program evolvopick
double precision :: dptick
type(t_point3d), dimension(:), allocatable :: points
integer :: nbpoints
integer :: errcode
integer :: fd, errcode
character (len=200) :: command
KA(1) = 2.24 ; KA(2) = 0.43
KA(3) = -0.65 ; KA(4) = -2.43
KB(1) = 1.11 ; KB(2) = 0.22
KB(3) = 1.65 ; KB(4) = -1.43
KA(1) = -1.42 ; KA(2) = 1.62
KA(3) = 1.08 ; KA(4) = -2.43
nbsteps = 1199
nbpoints = 26000
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
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, 4F12.6)') tick, KI
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, 7, 25990, 'WS/pick.dat')
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 COMMAND !'
STOP ' : ERR RUN TRACE COMMAND !'
endif
enddo
!-----------------------------------------------------
contains
subroutine interp4dp (ina, inb, out, dpk)
double precision, dimension(4), intent(in) :: ina, inb
double precision, dimension(4), intent(out) :: out
@@ -63,6 +76,4 @@ program evolvopick
end subroutine
end program evolvopick