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

bloubworld: more tweaking, more pimping

Browse Source
This commit is contained in:
tTh
2024-01-29 05:25:08 +01:00
parent 329f054fff
commit 5030fda56f
10 changed files with 119 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files

15
BloubWorld/mergebloubs.f90
View File

@@ -33,7 +33,7 @@ program mergebloubs
endif
call slurp_bloubs_file_in_array(trim(infile), bloubs, nbgot)
write(0, '(A,I6,1X,A)') " slurped ", nbgot, "bloubs"
write(0, '(A,I0,1X,A)') " slurped ", nbgot, "bloubs"
contacts = 0
do ia = 1, nbgot
@@ -42,19 +42,26 @@ program mergebloubs
dist = distance_of_bloubs(bloubs(ia), bloubs(ib))
radd = bloubs(ia)%radius + bloubs(ib)%radius
if (dist .LT. radd) then
contacts = contacts + 1
call merge_two_bloubs(bloubs(ia), bloubs(ib), merged)
bloubs(ia) = merged
bloubs(ia)%nick = "marged"
bloubs(ia)%state = 1;
bloubs(ib)%alive = .FALSE.
write(0, *) " *** merged ", ia, " and ", ib, &
" new r = ", merged%radius
endif
enddo
enddo
call spit_bloubs_to_file (outfile, bloubs, nbgot)
! print *, contacts, "contacts pour ", nbgot, "bloubs"
if (contacts .GT. 0) then
write(0, '(A,I0,A,I0,A)') &
" merge: ", contacts, " contacts pour ", nbgot, " bloubs"
endif
! STOP 'mergebloubs [done]'
@@ -77,8 +84,8 @@ contains
blr%vy = (bla%vy + blb%vy) / 2.0
blr%vz = (bla%vz + blb%vz) / 2.0
blr%radius = (bla%radius + blb%radius) / 2.222
blr%age = min(bla%age, blb%age)
blr%radius = (bla%radius + blb%radius)
blr%age = max(bla%age, blb%age)
! bring it to life !
blr%alive = .TRUE.