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

add some garbage

Browse Source
This commit is contained in:
tTh 2024-02-06 17:03:00 +01:00
parent ca899f5e90
commit ab23dc9897
14 changed files with 127 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
BloubWorld/Makefile
View File

@ -13,7 +13,7 @@ MYLIB = '../Modules/libtth90modules.a'
# ------------------------------------------------------------
essai: essai.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
# ------------------------------------------------------------
@ -46,16 +46,16 @@ genbloubs: genbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
movebloubs: movebloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
listbloubs: listbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
exportbloubs: exportbloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
mergebloubs: mergebloubs.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
gfortran $(GFOPT) $< $(OBJS) $(MYLIB) -o $@
# ------------------------------------------------------------

45
BloubWorld/bloubspace.f90
View File

@ -31,6 +31,8 @@ module bloubspace
! ----------------------------------------------------------------
subroutine load_boundingbox(infile, where, name)
implicit none
character(*), intent(in) :: infile
type(t_boundingbox), intent (out) :: where
character(8), intent(in) :: name
@ -73,6 +75,7 @@ module bloubspace
! dispersion de la position autour de l'origine
!-
subroutine make_a_random_bloub(blb, coefxyz)
implicit none
type(t_bloubs), intent (out) :: blb
real, intent(in) :: coefxyz
@ -81,25 +84,30 @@ module bloubspace
blb%py = coefxyz * (rand() - 0.50)
blb%pz = coefxyz * (rand() - 0.50)
blb%vx = (rand()) / 5.000
if (blb%px .LT. 0.0) blb%vx = -blb%vx
blb%vx = (rand() / 9.000)
! if (blb%px .LT. 0.0) blb%vx = -blb%vx
blb%vy = 0.2 + (rand()) / 8.000
if (blb%py .LT. 0.0) blb%vy = -blb%vy
blb%vy = -0.10 + (rand() / 11.000)
! if (blb%py .LT. 0.0) blb%vy = -blb%vy
blb%vz = (rand()) / 5.000
if (blb%pz .LT. 0.0) blb%vz = -blb%vz
blb%vz = (rand() / 10.000)
! if (blb%pz .LT. 0.0) blb%vz = -blb%vz
blb%red = mod(irand(), 256)
blb%green = 127 + mod(irand(), 127)
blb%blue = mod(irand(), 256)
blb%state = 0
blb%alive = .TRUE.
blb%age = 0
blb%agemax = 100
blb%agemax = 250 + mod(irand(), 250)
end subroutine
! ----------------------------------------------------------------
! Load a blbs file into an array of bloubs
subroutine spit_bloubs_to_file (fname, blbarray, towrite)
implicit none
character(*), intent(in) :: fname
type(t_bloubs), dimension(:) :: blbarray
integer, intent(in) :: towrite
@ -131,7 +139,7 @@ module bloubspace
enddo
close(output)
write(0, '(1X, "spitted ", I0, " bloubs to .", A)') &
write(0, '(1X, "spitted ", I0, " bloubs to ", A)') &
spitted, trim(fname)
end subroutine spit_bloubs_to_file
@ -139,6 +147,7 @@ module bloubspace
! Dump an array of bloubs to a blbs file.
!
subroutine slurp_bloubs_file_in_array (infile, blbarray, nbread)
implicit none
character(*), intent(in) :: infile
type(t_bloubs), dimension(:), intent(out) :: blbarray
integer, intent(out) :: nbread
@ -167,7 +176,7 @@ module bloubspace
read (unit=input, iostat=errcode, iomsg=chaine) bloub
if (0 .ne. errcode) then
! may be we got an EOF ?
! write(0, '(" got errcode on read ", (I8,1X,A))') errcode, chaine
! write(0, '("errcode on read ", (I0,1X,A))') errcode, chaine
exit
endif
nbread = nbread + 1
@ -189,6 +198,7 @@ module bloubspace
! Display a bloub content to stderr
subroutine display_bloub (blb, message)
implicit none
type(t_bloubs), intent (in) :: blb
character(*), intent (in) :: message
@ -212,6 +222,7 @@ module bloubspace
! Deplacement d'un bloub
!-
subroutine move_bloub (blb, coef)
implicit none
type(t_bloubs), intent (inout) :: blb
real, intent (in) :: coef
@ -220,6 +231,9 @@ module bloubspace
blb%py = blb%py + (blb%vy * coef)
blb%pz = blb%pz + (blb%vz * coef)
! faire vieillir le bloub
blb%age = blb%age + 1
end subroutine
! ----------------------------------------------------------------
!
@ -229,10 +243,11 @@ module bloubspace
! vitesse. XXX
!
subroutine bound_a_bloub (blb)
implicit none
type(t_bloubs), intent (inout) :: blb
real, parameter :: SH = 6.0
real, parameter :: SV = 4.0
real, parameter :: SV = 6.0
logical :: flag
@ -242,6 +257,7 @@ module bloubspace
if ((blb%px + blb%radius) .GT. SH) then
blb%vx = -1.0 * blb%vx
blb%px = SH - blb%radius
flag = .TRUE.
endif
if ((blb%px - blb%radius) .LT. -SH) then
blb%vx = -1.0 * blb%vx
@ -275,12 +291,18 @@ module bloubspace
if (flag) then
blb%age = blb%age + 1
blb%radius = blb%radius * 0.9999
endif
if (blb%age .GT. blb%agemax) then
blb%alive = .FALSE.
endif
end subroutine
! ----------------------------------------------------------------
function distance_of_bloubs(bla, blb)
implicit none
type(t_bloubs), intent(in) :: bla, blb
real :: distance_of_bloubs
@ -298,6 +320,7 @@ module bloubspace
! kill a bloub under condition(s)
subroutine green_soylent (blb)
implicit none
type(t_bloubs), intent (inout) :: blb
if (blb%age .gt. 240) then
@ -306,7 +329,7 @@ module bloubspace
! this is juste a molly-guard, don't worry
!
if (blb%radius .GT. 4.0) then
if (blb%radius .GT. 5.0) then
blb%alive = .FALSE.
endif
end subroutine

5
BloubWorld/essai.f90
View File

@ -1,19 +1,18 @@
program essai
! use bloubspace
use mathstuff
use mathstuff2
implicit none
call test_random(10)
STOP ': BECAUSE JOB IS DONE'
! --------------------------------------------------------------
contains
subroutine test_random(nbre)
implicit none
integer, intent(in) :: nbre
integer :: foo
real :: quux, bar

3
BloubWorld/exportbloubs.f90
View File

@ -34,7 +34,8 @@ program exportbloubs
endif
if (bloub%alive) then
print *, bloub%px, bloub%py, bloub%pz, bloub%radius, &
bloub%age, bloub%state
bloub%age, bloub%state, " ", &
bloub%red, bloub%green, bloub%blue
compte = compte + 1
endif
enddo

4
BloubWorld/genbloubs.f90
View File

@ -33,8 +33,8 @@ program genbloubs
bloub%nick = 'noname '
bloub%num = i + 41
call make_a_random_bloub(bloub, 8.25)
bloub%radius = 0.015 + (0.08*rand())
call make_a_random_bloub(bloub, 11.80)
bloub%radius = 0.010 + (0.12*rand())
write(idu) bloub ! no error control ?

6
BloubWorld/listbloubs.f90
View File

@ -1,4 +1,4 @@
program movebloubs
program listbloubs
use bloubspace
implicit none
@ -33,13 +33,13 @@ program movebloubs
write(0, '(A,I6,1X,A)') "slurped ", nbgot, "bloubs"
do i=1, nbgot
write(6, '(A8, 1X, 1L, 1X, I2, 3X, F8.3, 3X, 3F8.3, 3X, 3F8.3, 1X, I4)') &
write(6, '(A8, 1X, 1L, 1X, I2, 1X, F8.3, 1X, 3F8.3, 1X, 3F8.3, 1X, 2I4)') &
bloubs(i)%nick, bloubs(i)%alive, &
bloubs(i)%state, &
bloubs(i)%radius, &
bloubs(i)%px, bloubs(i)%py, bloubs(i)%pz, &
bloubs(i)%vx, bloubs(i)%vy, bloubs(i)%vz, &
bloubs(i)%age
bloubs(i)%age, bloubs(i)%agemax
enddo
end program

6
BloubWorld/mathstuff.f90
View File

@ -8,18 +8,20 @@ module mathstuff
! not really tested yet...
subroutine init_random_seed()
implicit none
integer, dimension(3) :: tarray
integer :: t3, foo
real :: dummy
call itime(tarray)
t3 = 3600*tarray(1) + 60*tarray(2) + tarray(3)
! write(0, '(A,3I3,A,I6)') "sranding: ", tarray, " --> ", t3
! write(0, '(A,3I3,A,I6)') " sranding: ", tarray, " --> ", t3
call srand(t3)
! after initializing the random generator engine,
! you MUST use it for initializing the initializer
do foo=1, tarray(1)+5
do foo=1, tarray(1)+15
dummy = rand()
enddo

15
BloubWorld/mergebloubs.f90
View File

@ -5,6 +5,7 @@ program mergebloubs
!-------------------------------------------!
use bloubspace
use mathstuff2
implicit none
integer, parameter :: NB_MAX_BLOUBS = 250000
@ -24,9 +25,11 @@ program mergebloubs
call getarg(1, infile)
call getarg(2, outfile)
write(0, '(A, 2A15, I8)') "### mergebloubs ", &
write(0, '(A, A, 1X, A, 1X, I6)') "### mergebloubs ", &
trim(infile), trim(outfile), NB_MAX_BLOUBS
call init_random_seed()
allocate (bloubs(NB_MAX_BLOUBS), stat=errcode)
if (0 .NE. errcode) then
STOP " : NO ENOUGH MEMORY"
@ -52,6 +55,8 @@ program mergebloubs
write(0, *) " *** merged ", ia, " and ", ib, &
" new r = ", merged%radius
! call display_bloub (bloubs(ia), "juste merged")
endif
enddo
@ -70,6 +75,7 @@ program mergebloubs
contains
subroutine merge_two_bloubs(bla, blb, blr)
implicit none
type(t_bloubs), intent(in) :: bla, blb
type(t_bloubs), intent(out) :: blr
@ -91,8 +97,13 @@ contains
blr%vx = (bla%vx + blb%vx) / 2.0
blr%vy = (bla%vy + blb%vy) / 2.0
blr%vz = (bla%vz + blb%vz) / 2.0
if (0.001 .GT. rand()) then
blr%vx = blr%vx * 1.04
blr%vy = blr%vy * 1.04
blr%vz = blr%vz * 1.04
endif
blr%radius = (va + vb) ** 0.33333333333
blr%radius = (va + vb) ** 0.33335
blr%age = min(bla%age, blb%age)
! bring it to life !

33
BloubWorld/movebloubs.f90
View File

@ -2,7 +2,7 @@ program movebloubs
use bloubspace
use povstuff
use mathstuff
use mathstuff2
implicit none
@ -14,8 +14,6 @@ program movebloubs
! logical :: add_new_bloub = .TRUE.
real :: rnd
call init_random_seed()
i = IARGC()
if (i .ne. 2) then
STOP ": BAD ARGS ON COMMAND LINE"
@ -26,6 +24,8 @@ program movebloubs
write (0, '(A)') &
"### moving bloubs from "//trim(infile)//" to "//trim(outfile)
call init_random_seed()
open(newunit=inu, &
file=trim(infile), form='unformatted', &
iostat=errcode, &
@ -61,10 +61,14 @@ program movebloubs
! moving, morphing and boundingboxing
call move_bloub (bloub, 0.185)
call bound_a_bloub (bloub)
if (bloub%radius .GT. 0.0238) then
if (bloub%radius .GT. 3.50) then
bloub%radius = bloub%radius * 0.999
endif
! if (bloub%radius .LT. 0.00015) then
! bloub%alive = .FALSE.
! endif
! XXX call green_soylent (bloub)
! XXX if (.NOT. bloub%alive) then
! XXX ! write(0, '(A)') " KILL!"
@ -94,8 +98,15 @@ program movebloubs
! ok, we have read all the bloubs from the input file
! insert some fancy conditional here
if (compteur .LT. 200) then
call add_more_bloubs(outu, 5, 0.032)
if (compteur .LT. 50) then
call add_more_bloubs(outu, 5, 0.046)
endif
rnd = rand()
! write(0, *) 'rnd= ', rnd
if (rnd .LT. 0.18) then
write (0, *) '... random of life ...'
call add_more_bloubs(outu, 5, 0.056)
endif
close(inu) ; close(outu)
@ -104,20 +115,22 @@ program movebloubs
contains
subroutine add_more_bloubs(un, nbre, rayon)
implicit none
integer, intent(in) :: un, nbre
real, intent(in) :: rayon
type(t_bloubs) :: bloub
integer :: foo, count
count = nbre+mod(irand(), 3)
write(0, '(A,I4,1X,A)') "movebloubs adding", count, "bloubs"
count = nbre+mod(irand(), 2)
write(0, '(1X,A,I0,1X,A)') "movebloubs: adding ", count, " bloubs"
do foo=1, count
bloub%nick = 'newbie '
call make_a_random_bloub(bloub, 7.12)
bloub%radius = rayon + (0.09*rand())
call make_a_random_bloub(bloub, 10.00)
bloub%radius = rayon + (0.11*rand())
bloub%age = 1
bloub%agemax = 160 + (count * 4)
bloub%alive = .TRUE.
bloub%num = mod(irand(), 42)
write(un) bloub ! no error control ?

24
BloubWorld/plotworld.sh Executable file
View File

@ -0,0 +1,24 @@
#!/bin/bash
INFILE="out.blbs"
SSV="WS/out.ssv"
IMAGE="dessin.png"
./listbloubs $INFILE > $SSV
timestamp=$(date --utc)
gnuplot << __EOC__
set term png size 720,720
set output "${IMAGE}"
set grid front
set tics 1
set title "High density bloub world - ${timestamp}"
plot \
"${SSV}" using 5:6 lt rgb "#002090"
__EOC__
echo 'done'

2
BloubWorld/povstuff.f90
View File

@ -13,6 +13,7 @@ module povstuff
contains ! -----------------------------------------
subroutine show_bbox( bbox )
implicit none
type (t_boundb), intent(in) :: bbox
print *, bbox%bbminx, bbox%bbminy, bbox%bbminz
@ -23,6 +24,7 @@ module povstuff
! ----------------------------------------------------------------
subroutine start_of_inc_file (fd)
implicit none
integer, intent (in) :: fd
write(fd, '(A)') "// DON'T EDIT THIS FILE !"

6
BloubWorld/runme.sh
View File

@ -34,7 +34,7 @@ printf "\n#declare NbImg = %d;\n" $NBIMG > WS/nbimg.inc
# first, we have to make a seminal buch of bloubs
# --> this function need to be parametrizable
#
./genbloubs ${BLBS_IN} 666
./genbloubs ${BLBS_IN} 2
for idx in $(seq 0 $((NBIMG-1)) )
do
@ -75,14 +75,14 @@ do
-annotate +45+5 "BloubWorld" \
$PNG
echo $PNG '[done]'
echo ' ' $PNG '[done]'
./movebloubs ${BLBS_IN} ${BLBS_OUT}
./mergebloubs ${BLBS_OUT} ${BLBS_IN}
# mv ${BLBS_OUT} ${BLBS_IN}
echo "### run done"
sleep 5
sleep 35
done

15
BloubWorld/scene.pov
View File

@ -47,7 +47,7 @@ union {
cylinder { 0, -y, 30
texture {
pigment { color srgb <0.225, 0.244, 0.211> }
finish { phong 0.18 metallic 0.25 reflection 0.15 }
finish { phong 0.18 metallic 0.25 reflection 0.10 }
}
translate -6.20*y
}
@ -61,17 +61,18 @@ sky_sphere {
#declare Croisillon = object
{
#local SC = 0.75;
union {
cylinder { -1*x, 1*x, 0.04 }
cylinder { -1*y, 1*y, 0.04 }
cylinder { -1*z, 1*z, 0.04 }
cylinder { -SC*x, SC*x, 0.04 }
cylinder { -SC*y, SC*y, 0.04 }
cylinder { -SC*z, SC*z, 0.04 }
}
texture {
pigment { color Gray50 }
}
}
object { Croisillon scale 0.80 translate <Bary_X, Bary_Y, Bary_Z> }
object { Croisillon scale 0.90 translate <Bary_X, Bary_Y, Bary_Z> }
// ----------------------------------------------------------
@ -130,10 +131,10 @@ union {
object { Montants }
#local G = Green * 0.80;
object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue } }
object { Une_Borne translate <-BH, 0, -BH> pigment { color Blue*0.9 } }
object { Une_Borne translate < BH, 0, -BH> pigment { color G } }
object { Une_Borne translate <-BH, 0, BH> pigment { color G } }
object { Une_Borne translate < BH, 0, BH> pigment { color Red } }
object { Une_Borne translate < BH, 0, BH> pigment { color Red*0.9 } }
}
}

4
BloubWorld/toinc.awk
View File

@ -21,11 +21,11 @@ BEGIN {
color = "Cyan"
if (merged) {
if (age > 100) color = "Orange"
if (age > 150) color = "Orange"
else color = "Yellow"
}
else {
if (age > 100) color = "Black"
if (age > 150) color = "DarkGreen"
else color = "Aquamarine"
}
if (age < 18) color = "Gray40"