84 lines
2.1 KiB
Fortran
84 lines
2.1 KiB
Fortran
program movebloubs
|
|
|
|
use bloubspace
|
|
use povstuff
|
|
|
|
implicit none
|
|
|
|
character(200) :: infile, outfile
|
|
integer :: inu, outu, errcode, i
|
|
type(t_bloubs) :: bloub
|
|
double precision :: bx, by, bz
|
|
logical :: add_new_bloub = .FALSE.
|
|
|
|
i = IARGC()
|
|
if (i .ne. 2) then
|
|
STOP ": BAD ARGS ON COMMAND LINE"
|
|
endif
|
|
call getarg(1, infile)
|
|
call getarg(2, outfile)
|
|
|
|
inu = 42 ; outu = 51
|
|
|
|
write (0, '(A)') &
|
|
"*** moving bloubs from "//trim(infile)//" to "//trim(outfile)
|
|
|
|
open(unit=inu, file=trim(infile), form='unformatted', &
|
|
iostat=errcode, &
|
|
action='read', status='old')
|
|
if (0 .ne. errcode) then
|
|
STOP " : CAN'T OPEN FILE " // trim(infile)
|
|
endif
|
|
|
|
open(unit=outu, file=trim(outfile), form='unformatted', &
|
|
iostat=errcode, &
|
|
action='write', status='replace')
|
|
if (0 .ne. errcode) then
|
|
STOP " : CAN'T OPEN " // trim(outfile) // "FOR WRITE"
|
|
endif
|
|
|
|
bx = 0.0; by = 0.0; bz = 0.0
|
|
|
|
do
|
|
read (unit=inu, iostat=errcode) bloub
|
|
if (0 .ne. errcode) then
|
|
exit
|
|
endif
|
|
|
|
! moving and boundingboxing
|
|
call move_bloub (bloub, 0.11)
|
|
call bound_a_blob(bloub)
|
|
|
|
! calcul du barycentre
|
|
bx = bx + bloub%px
|
|
by = by + bloub%py
|
|
bz = bz + bloub%pz
|
|
|
|
write(outu, iostat=errcode) bloub ! no error control ?
|
|
if (0 .ne. errcode) then
|
|
STOP " : WRITE ERROR TO " // trim(outfile)
|
|
endif
|
|
|
|
enddo
|
|
|
|
if (add_new_bloub) then
|
|
! and now, we inject a new bloub in the universe
|
|
bloub%nick = 'newbie '
|
|
bloub%alive = .TRUE.
|
|
call random_pv(bloub)
|
|
bloub%radius = 0.042
|
|
bloub%seq = 0
|
|
!
|
|
! where is the bug ?
|
|
!
|
|
call display_bloub (bloub, "new bloub")
|
|
write(outu) bloub ! no error control ?
|
|
endif
|
|
|
|
! ther was some strange bias in this data
|
|
! may be a random not symetric around 0.0 ?
|
|
write (0, '(A,3(F11.3,3X))') "barycentre : ", bx, by, bz
|
|
|
|
close(inu) ; close(outu)
|
|
|
|
end program |