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

subroutine green_soylent in actio

Browse Source
This commit is contained in:
tth 2022-02-08 18:56:51 +01:00
parent 6094e29efd
commit c35c00e3da
9 changed files with 88 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
BloubWorld/.gitignore vendored
View File

@ -1,5 +1,7 @@
bloubs.inc
nbimg.inc
*.gif
*.blbs
*.mp4

26
BloubWorld/bloubspace.f90
View File

@ -23,13 +23,13 @@ module bloubspace
subroutine random_pv (blb)
type(t_bloubs), intent (inout) :: blb
blb%px = rand() - 0.50
blb%py = rand() * 0.25
blb%pz = rand() - 0.50
blb%px = 2.0 * (rand() - 0.50)
blb%py = rand() * 0.50
blb%pz = 2.0 * (rand() - 0.50)
blb%vx = (rand() - 0.5) / 4.000
blb%vy = (rand() - 0.5) / 4.000
blb%vz = (rand() - 0.5) / 4.000
blb%vx = (rand() - 0.5) / 3.000
blb%vy = (rand() - 0.5) / 3.000
blb%vz = (rand() - 0.5) / 3.000
blb%alive = .TRUE.
@ -47,10 +47,10 @@ module bloubspace
else
life = "dead"
endif
write (0, '(A)') '------------- ' // message
write (0, '(4X,A8,2X,I6,4X,A5)') blb%nick, blb%num, blb%alive
write (0, '(4X,A1,3X,3(F8.3, 4X))') 'P', blb%px, blb%py, blb%pz
write (0, '(4X,A1,3X,3(F8.3, 4X))') 'V', blb%vx, blb%vy, blb%vz
write (0, '(4X, A)') '+------------ ' // message
write (0, '(4X,A3,A8,2X,I6,4X,A5)') '| ', blb%nick, blb%num, life
write (0, '(4X,A3,3X,3(F8.3, 4X))') '| P', blb%px, blb%py, blb%pz
write (0, '(4X,A3,3X,3(F8.3, 4X))') '| V', blb%vx, blb%vy, blb%vz
write (0, '()')
end subroutine
@ -85,18 +85,22 @@ module bloubspace
if (0.0 .gt. blb%py) then
blb%vy = -1.0 * blb%vy
blb%py = 0.0
blb%seq = blb%seq + 1
endif
if (3.0 .lt. blb%py) then
blb%vy = -1.0 * blb%vy
blb%seq = blb%seq + 1
blb%py = 3.0
endif
if (5.0 .lt. blb%pz) then
blb%vz = -1.0 * blb%vz
blb%seq = blb%seq + 1
blb%pz = 5.0
endif
if (-5.0 .gt. blb%pz) then
blb%vz = -1.0 * blb%vz
blb%seq = blb%seq + 1
blb%pz = -5.0
endif
@ -105,7 +109,7 @@ module bloubspace
! ----------------------------------------------------------------
subroutine green_soylent (blb)
type(t_bloubs), intent (inout) :: blb
if (blb%seq .gt. 200) then
if (blb%seq .gt. 4) then
blb%alive = .FALSE.
endif
end subroutine

4
BloubWorld/encode.sh
View File

@ -3,10 +3,10 @@
DDIR="frames/"
ffmpeg -nostdin \
-loglevel info \
-loglevel warning \
-y -r 25 -f image2 -i $DDIR/%05d.png \
-metadata artist='---[ tTh ]---' \
-metadata title='---[ BloubWorld ]---' \
-metadata title='---[ BloubWorld alpha ]---' \
-c:v libx264 -pix_fmt yuv420p \
bloubworld.mp4

2
BloubWorld/exportbloubs.f90
View File

@ -36,7 +36,7 @@ program genbloubs
compte = compte + 1
enddo
write(0, '(1X, I5, A)') compte, " bloubs exported"
write(0, '(1X, I8, A)') compte, " bloubs exported"
close(idu)

2
BloubWorld/genbloubs.f90
View File

@ -31,7 +31,7 @@ program genbloubs
bloub%nick = 'noname '
bloub%alive = .TRUE.
call random_pv(bloub)
bloub%radius = 0.030
bloub%radius = 0.025
bloub%seq = 0
write(idu) bloub ! no error control ?

53
BloubWorld/movebloubs.f90
View File

@ -2,14 +2,19 @@ program movebloubs
use bloubspace
use povstuff
use mathstuff
implicit none
character(200) :: infile, outfile
integer :: inu, outu, errcode, i
integer :: compteur, killed
type(t_bloubs) :: bloub
double precision :: bx, by, bz
logical :: add_new_bloub = .FALSE.
logical :: add_new_bloub = .TRUE.
! real :: rnd
call init_random_seed()
i = IARGC()
if (i .ne. 2) then
@ -18,19 +23,19 @@ program movebloubs
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', &
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(unit=outu, file=trim(outfile), form='unformatted', &
open(newunit=outu, &
file=trim(outfile), form='unformatted', &
iostat=errcode, &
action='write', status='replace')
if (0 .ne. errcode) then
@ -38,26 +43,35 @@ program movebloubs
endif
bx = 0.0; by = 0.0; bz = 0.0
compteur = 0
killed = 0
do
read (unit=inu, iostat=errcode) bloub
if (0 .ne. errcode) then
! may be we got an EOF ?
exit
endif
! moving and boundingboxing
call move_bloub (bloub, 0.11)
call bound_a_blob(bloub)
call move_bloub (bloub, 0.15)
call bound_a_blob (bloub)
call green_soylent (bloub)
if (.NOT. bloub%alive) then
write(0, '(A)') " KILL!"
killed = killed + 1
cycle
endif
! calcul du barycentre
bx = bx + bloub%px
by = by + bloub%py
bz = bz + bloub%pz
bx = bx + dble(bloub%px)
by = by + dble(bloub%py)
bz = bz + dble(bloub%pz)
write(outu, iostat=errcode) bloub ! no error control ?
if (0 .ne. errcode) then
STOP " : WRITE ERROR TO " // trim(outfile)
endif
compteur = compteur + 1
enddo
@ -66,19 +80,20 @@ program movebloubs
bloub%nick = 'newbie '
bloub%alive = .TRUE.
call random_pv(bloub)
bloub%radius = 0.042
bloub%radius = 0.045
bloub%seq = 0
!
! where is the bug ?
!
call display_bloub (bloub, "new bloub")
write(outu) bloub ! no error control ?
endif
! ther was some strange bias in this data
! may be a random not symetric around 0.0 ?
write (0, '(A,3(F11.3,3X))') "barycentre : ", bx, by, bz
close(inu) ; close(outu)
write (0, '(I5, A)') killed, " bloubs killed"
bx = bx / dble(compteur)
by = by / dble(compteur)
bz = bz / dble(compteur)
write (0, '(A,3(F12.6,3X))') "barycentre : ", bx, by, bz
end program

2
BloubWorld/povstuff.f90
View File

@ -20,6 +20,8 @@ module povstuff
end subroutine
! ----------------------------------------------------------------
! ----------------------------------------------------------------
! we need some primitives for the gestion of colors.
! may be a small database indexed by name ?

14
BloubWorld/runme.sh
View File

@ -11,6 +11,8 @@ POVOPT="+Q9 +a -v -d -W920 -H600"
DDIR="frames"
LOGERR="log.error"
NBIMG=3000
make all
err=$?
if [ $err -ne 0 ] ; then
@ -18,13 +20,15 @@ if [ $err -ne 0 ] ; then
exit 1
fi
printf "\n#declare NbImg = %d;\n" $NBIMG > nbimg.inc
#
# first, we have to make a seminal buch of bloubs
# --> this function need to be paraletrizable
#
./genbloubs in.blbs 100000
./genbloubs in.blbs 6000
for idx in $(seq 0 800)
for idx in $(seq 0 $NBIMG)
do
echo "======== run passe $idx ========="
@ -40,14 +44,14 @@ do
fi
td=$(date +'%F %R:%S')
txt=$(printf "%9d %5d %s" $$ $idx "${td}")
txt=$(printf "%5d %s" $idx "${td}")
PNG=$(printf "%s/%05d.png" ${DDIR} $idx)
echo "$txt"
echo "$txt" | tee -a log.txt
convert ${TMPPNG} \
-font fixed \
-pointsize 20 \
-fill orange \
-fill Yellow \
-gravity south-east \
-annotate +15+10 "$txt" \
$PNG

24
BloubWorld/scene.pov
View File

@ -5,26 +5,32 @@
#version 3.7;
global_settings {
ambient_light rgb <0.09, 0.02, 0.02>
ambient_light rgb <0.12, 0.01, 0.01>
assumed_gamma 1.0
}
#include "colors.inc"
#include "nbimg.inc"
#declare NormClock = clock / NbImg;
// ----------------------------------------------------------
#include "bloubs.inc"
object {
Bloubs
texture {
pigment { color Gray50 }
finish { phong 0.58 metallic 0.45 }
pigment { color Gray60 }
finish { phong 0.58 specular 0.45 }
}
}
plane {
<0, 1, 0>, 0
texture {
pigment { color Gray10 }
pigment { color Black }
finish { phong 0.18 metallic 0.45 }
}
}
@ -39,7 +45,7 @@ plane {
{
union {
cylinder { <0, 0, 0>, <0, BV, 0>, BR }
cylinder { <0, 0, 0>, <0, 0.03, 0>, BR*4 }
cylinder { <0, 0, 0>, <0, 0.02, 0>, BR*8 }
}
}
@ -58,11 +64,13 @@ object { Les_Bornes }
// ----------------------------------------------------------
light_source { <4, 12, -11> color Gray80 }
// light_source { <4, 19, 9> color White }
light_source { <7, 19, 9> color Gray60 }
#declare HCAM = 5 + (5 * NormClock);
camera {
location <7, 5, -16>
location <6, HCAM, -16>
look_at <0, 0, 0>
right x*image_width/image_height
angle 54
angle 52
}