Fortraneries/BloubWorld/mergebloubs.f90

61 lines
1.5 KiB
Fortran

program mergebloubs
!-------------------------------------------!
! THIS IS A BIG MESS OF BUGS !
!-------------------------------------------!
use bloubspace
implicit none
integer, parameter :: NB_MAX_BLOUBS = 25000
character(200) :: infile, outfile
type(t_bloubs) :: bloub, newbloub
integer :: inu, outu, errcode
type(t_bloubs), dimension(:), allocatable :: les_bloubs
! --------------- check command line parameters
if (IARGC() .ne. 2) then
STOP ": NEED IN AND OUT FILENAME"
endif
call getarg(1, infile)
call getarg(2, outfile)
write(0, '(A, 2A20, I8)') "*** mergebloubs ", &
trim(infile), trim(outfile), NB_MAX_BLOUBS
STOP '[done]'
! --------------------------------------------------------------
contains
subroutine merge_two_bloubs(bla, blb, blr)
type(t_bloubs), intent(in) :: bla, blb
type(t_bloubs), intent(out) :: blr
blr%nick = "merged "
blr%num = 0 ! ???
blr%px = (bla%px + blb%px) / 2.0
blr%py = (bla%py + blb%py) / 2.0
blr%pz = (bla%pz + blb%pz) / 2.0
blr%vx = (bla%vx + blb%vx) / 2.0
blr%vy = (bla%vy + blb%vy) / 2.0
blr%vz = (bla%vz + blb%vz) / 2.0
blr%radius = (bla%radius + blb%radius) / 2.718
blr%age = min(bla%age, blb%age)
! bring it to life !
blr%alive = .TRUE.
end subroutine
end program