REDO FROM START
This commit is contained in:
parent
101ae7c1e8
commit
ac284a5764
@ -14,9 +14,7 @@ program mergebloubs
|
|||||||
integer :: inu, outu, errcode
|
integer :: inu, outu, errcode
|
||||||
|
|
||||||
type(t_bloubs), dimension(:), allocatable :: les_bloubs
|
type(t_bloubs), dimension(:), allocatable :: les_bloubs
|
||||||
integer :: i, idx, nbr_merge
|
|
||||||
real :: rval
|
|
||||||
logical :: merged
|
|
||||||
|
|
||||||
! --------------- check command line parameters
|
! --------------- check command line parameters
|
||||||
if (IARGC() .ne. 2) then
|
if (IARGC() .ne. 2) then
|
||||||
@ -28,118 +26,8 @@ program mergebloubs
|
|||||||
write(0, '(A, 2A20, I8)') "*** mergebloubs ", &
|
write(0, '(A, 2A20, I8)') "*** mergebloubs ", &
|
||||||
trim(infile), trim(outfile), NB_MAX_BLOUBS
|
trim(infile), trim(outfile), NB_MAX_BLOUBS
|
||||||
|
|
||||||
! --------------- allocate memory for the people
|
|
||||||
|
|
||||||
allocate (les_bloubs(NB_MAX_BLOUBS), stat=errcode)
|
STOP '[done]'
|
||||||
if (0 .NE. errcode) then
|
|
||||||
STOP " : NO ENOUGH MEMORY"
|
|
||||||
endif
|
|
||||||
|
|
||||||
do i = 1, NB_MAX_BLOUBS
|
|
||||||
les_bloubs(i)%alive = .FALSE.
|
|
||||||
enddo
|
|
||||||
|
|
||||||
! --------------- open / creat the files
|
|
||||||
|
|
||||||
open(newunit=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(newunit=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
|
|
||||||
|
|
||||||
! --------------- read the first bloub
|
|
||||||
|
|
||||||
idx = 1
|
|
||||||
|
|
||||||
read (unit=inu, iostat=errcode) bloub
|
|
||||||
if (0 .ne. errcode) then
|
|
||||||
STOP " : ERR READING FIRST BLOUB"
|
|
||||||
endif
|
|
||||||
call display_bloub (bloub, "first bloub")
|
|
||||||
write(outu, iostat=errcode) bloub
|
|
||||||
if (0 .ne. errcode) then
|
|
||||||
STOP " : FIRST BLOUB, WRITE ERROR TO " // trim(outfile)
|
|
||||||
endif
|
|
||||||
|
|
||||||
les_bloubs(idx) = bloub
|
|
||||||
idx = idx + 1
|
|
||||||
|
|
||||||
! --------------- loop over the other bloubs
|
|
||||||
nbr_merge = 0
|
|
||||||
|
|
||||||
do ! infinite loop
|
|
||||||
|
|
||||||
! print *, "============ PASS ", idx
|
|
||||||
if (idx .EQ. NB_MAX_BLOUBS) then
|
|
||||||
write(0, '(I8, A)') idx, " max number of bloubs reached"
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
|
|
||||||
! read the next bloub from input file
|
|
||||||
read (unit=inu, iostat=errcode) bloub
|
|
||||||
if (0 .ne. errcode) then
|
|
||||||
exit
|
|
||||||
endif
|
|
||||||
!! call display_bloub (bloub, "next bloub")
|
|
||||||
|
|
||||||
if (.NOT. bloub%alive) then
|
|
||||||
STOP " : I HAVE READ A DEAD BLOUB"
|
|
||||||
endif
|
|
||||||
|
|
||||||
! check with all the previuous blobs
|
|
||||||
merged = .FALSE.
|
|
||||||
do i = 1, idx-1
|
|
||||||
if (.NOT. les_bloubs(i)%alive) then
|
|
||||||
! print *, "dead bloub at ", i, " on ", idx
|
|
||||||
! call display_bloub(les_bloubs(i), "DEAD ? WTF ?")
|
|
||||||
cycle
|
|
||||||
endif
|
|
||||||
rval = distance_of_bloubs(les_bloubs(i), bloub)
|
|
||||||
if (rval .LT. (les_bloubs(i)%radius + bloub%radius)) then
|
|
||||||
print *, "contact : ", i, idx, rval
|
|
||||||
call merge_two_bloubs(les_bloubs(i), bloub, newbloub)
|
|
||||||
les_bloubs(i)%alive = .FALSE.
|
|
||||||
nbr_merge = nbr_merge + 1
|
|
||||||
merged = .TRUE.
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
if (merged) then
|
|
||||||
les_bloubs(idx) = newbloub
|
|
||||||
bloub = newbloub
|
|
||||||
else
|
|
||||||
! put old bloub in the list
|
|
||||||
les_bloubs(idx) = bloub
|
|
||||||
endif
|
|
||||||
|
|
||||||
write(outu, iostat=errcode) bloub
|
|
||||||
if (0 .ne. errcode) then
|
|
||||||
STOP " : WRITE ERROR TO " // trim(outfile)
|
|
||||||
endif
|
|
||||||
|
|
||||||
idx = idx + 1
|
|
||||||
|
|
||||||
! print *, "idx = ", idx
|
|
||||||
|
|
||||||
enddo ! end of infinit... WHAT?
|
|
||||||
|
|
||||||
! --------------- is the job done ?
|
|
||||||
|
|
||||||
close(inu) ; close(outu)
|
|
||||||
|
|
||||||
write(0, '()')
|
|
||||||
write(0, '(I5, A)') nbr_merge, " merges"
|
|
||||||
write(0, '(A)') "--- mergebloubs . . . . . . . [done]"
|
|
||||||
|
|
||||||
! --------------------------------------------------------------
|
! --------------------------------------------------------------
|
||||||
contains
|
contains
|
||||||
@ -148,7 +36,7 @@ contains
|
|||||||
type(t_bloubs), intent(in) :: bla, blb
|
type(t_bloubs), intent(in) :: bla, blb
|
||||||
type(t_bloubs), intent(out) :: blr
|
type(t_bloubs), intent(out) :: blr
|
||||||
|
|
||||||
blr%nick = "newbie "
|
blr%nick = "merged "
|
||||||
blr%num = 0 ! ???
|
blr%num = 0 ! ???
|
||||||
|
|
||||||
blr%px = (bla%px + blb%px) / 2.0
|
blr%px = (bla%px + blb%px) / 2.0
|
||||||
|
Loading…
Reference in New Issue
Block a user