Fortraneries/BloubWorld/movebloubs.f90

68 lines
1.4 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
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 WRITE TO " // trim(outfile)
endif
bx = 0.0; by = 0.0; bz = 0.0
do
read (unit=inu, iostat=errcode) bloub
if (0 .ne. errcode) then
exit
endif
call move_bloub (bloub, 0.333)
bx = bx + bloub%px
by = by + bloub%py
bz = bz + bloub%pz
! boundingbox action
if (0.0 .gt. bloub%py) then
bloub%vy = -1.0 * bloub%vy
bloub%py = 0.0
endif
write(outu) bloub ! no error control ?
enddo
close(inu) ; close(outu)
end program