adding a lot of grabage
This commit is contained in:
tth
@@ -11,35 +11,139 @@ module bloubspace
|
||||
type t_bloubs
|
||||
character(8) :: nick
|
||||
logical :: alive
|
||||
integer :: state
|
||||
integer :: num ! ???
|
||||
real :: px, py, pz
|
||||
real :: vx, vy, vz
|
||||
real :: radius
|
||||
integer :: age
|
||||
integer :: age, agemax
|
||||
end type t_bloubs
|
||||
|
||||
type t_boundingbox
|
||||
character(8) :: id
|
||||
real :: xm, ym, zm
|
||||
real :: xp, yp, zp
|
||||
end type t_boundingbox
|
||||
|
||||
contains ! -----------------------------------------
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
|
||||
subroutine load_boundingbox(infile, where, name)
|
||||
character(*), intent(in) :: infile
|
||||
type(t_boundingbox), intent (out) :: where
|
||||
character(8), intent(in) :: name
|
||||
|
||||
integer :: fd, errcode
|
||||
character(200) :: message
|
||||
|
||||
print *, "try to load ", infile
|
||||
|
||||
! put some default values
|
||||
where%id = "default"
|
||||
where%xm = -5.0 ; where%ym = -5.0 ; where%zm = -5.0
|
||||
where%xp = 5.0 ; where%yp = 5.0 ; where%zp = 5.0
|
||||
|
||||
! and now, try to read the file
|
||||
open (newunit=fd, file=trim(infile), &
|
||||
status='old', action='read', &
|
||||
iostat=errcode, iomsg=message)
|
||||
if (errcode .NE. 0) then
|
||||
stop 'OPEN ERROR ' // message
|
||||
endif
|
||||
|
||||
do
|
||||
read(unit=fd, iostat=errcode, iomsg=message, &
|
||||
fmt='(A,6F8.3)') where
|
||||
if (errcode .NE. 0) then
|
||||
! print *, "errcode ", errcode
|
||||
print *, "message: ", message
|
||||
exit
|
||||
endif
|
||||
enddo
|
||||
|
||||
close(fd)
|
||||
|
||||
end subroutine load_boundingbox
|
||||
|
||||
! ----------------------------------------------------------------
|
||||
|
||||
subroutine random_pv (blb)
|
||||
type(t_bloubs), intent (inout) :: blb
|
||||
type(t_bloubs), intent (out) :: blb
|
||||
|
||||
blb%px = 1.35 * (rand() - 0.50)
|
||||
blb%py = 0.50 + (rand() * 0.50)
|
||||
blb%pz = 1.90 * (rand() - 0.50)
|
||||
blb%px = 4.33 * (rand() - 0.50)
|
||||
blb%py = 3.33 * (rand() - 0.50)
|
||||
blb%pz = 4.51 * (rand() - 0.50)
|
||||
|
||||
blb%vx = (rand() - 0.5) / 2.500
|
||||
blb%vy = (rand() - 0.1) / 4.000
|
||||
blb%vz = (rand() - 0.5) / 2.500
|
||||
blb%vx = (rand()) / 2.000
|
||||
blb%vy = (rand()) / 2.900
|
||||
blb%vz = (rand()) / 2.000
|
||||
|
||||
blb%alive = .TRUE.
|
||||
blb%state = 0
|
||||
blb%alive = .TRUE.
|
||||
blb%age = 0
|
||||
blb%agemax = 500
|
||||
|
||||
end subroutine
|
||||
! ----------------------------------------------------------------
|
||||
! Load a blbs file into an array of bloubs
|
||||
subroutine spit_bloubs_to_file (fname, blbarray, towrite)
|
||||
|
||||
character(*), intent(in) :: fname
|
||||
type(t_bloubs), dimension(:) :: blbarray
|
||||
integer, intent(in) :: towrite
|
||||
|
||||
write (0, '(" spiting", (I6), "bloubs to", (A), "file")') &
|
||||
towrite, trim(fname)
|
||||
|
||||
STOP ' : NOT IMPLEMENTED'
|
||||
|
||||
end subroutine
|
||||
! ----------------------------------------------------------------
|
||||
! Dump an array of bloubs to a blbs file.
|
||||
!
|
||||
subroutine slurp_bloubs_file_in_array (infile, blbarray, nbread)
|
||||
character(*), intent(in) :: infile
|
||||
type(t_bloubs), dimension(:), intent(out) :: blbarray
|
||||
integer, intent(out) :: nbread
|
||||
|
||||
character(200) :: chaine
|
||||
integer :: input, errcode, idx
|
||||
type(t_bloubs) :: bloub
|
||||
|
||||
write(0, '(" slurping from file [", (A), "]")') trim(infile)
|
||||
|
||||
open( newunit=input, &
|
||||
file=trim(infile), form='unformatted', &
|
||||
iostat=errcode, iomsg=chaine, &
|
||||
action='read', status='old')
|
||||
if (0 .ne. errcode) then
|
||||
write(0, '(" errcode ", I8, 2X, A)') errcode, chaine
|
||||
STOP " : CAN'T OPEN FILE " // trim(infile)
|
||||
endif
|
||||
! write(0, '((A, I3))') " slurping from unit ", input
|
||||
|
||||
nbread = 0
|
||||
idx = 1;
|
||||
do
|
||||
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
|
||||
exit
|
||||
endif
|
||||
nbread = nbread + 1
|
||||
! print *, bloub%nick, bloub%radius
|
||||
if (bloub%alive) then
|
||||
blbarray(idx) = bloub
|
||||
idx = idx + 1
|
||||
endif
|
||||
enddo
|
||||
|
||||
close(input) ! no error checking ?
|
||||
|
||||
write(0, '(" read ", (I8), " bloubs")') nbread
|
||||
end subroutine
|
||||
! ----------------------------------------------------------------
|
||||
! Display a bloub content to stderr
|
||||
|
||||
@@ -52,7 +156,7 @@ module bloubspace
|
||||
if (blb%alive) then
|
||||
life = "alive"
|
||||
else
|
||||
life = "dead"
|
||||
life = "dead "
|
||||
endif
|
||||
write (0, '(4X, A)') '+--------------- ' // message // " -------"
|
||||
write (0, '(4X,A3,A8,2X,I6,4X,A5,4X,I5)') '| ', &
|
||||
@@ -76,37 +180,42 @@ module bloubspace
|
||||
|
||||
end subroutine
|
||||
! ----------------------------------------------------------------
|
||||
!
|
||||
! detection des collisions avec les parois de la boite
|
||||
! laquelle boite gagnerais beaucoup a etre parametrable.
|
||||
!
|
||||
subroutine bound_a_blob (blb)
|
||||
type(t_bloubs), intent (inout) :: blb
|
||||
|
||||
if (5.0 .lt. blb%px) then
|
||||
if ( 5.0 .lt. (blb%px + blb%radius)) then
|
||||
blb%vx = -1.0 * blb%vx
|
||||
blb%px = 5.0
|
||||
blb%age = blb%age + 1
|
||||
endif
|
||||
if (-5.0 .gt. blb%px) then
|
||||
if (-5.0 .gt. (blb%px + blb%radius)) then
|
||||
blb%vx = -1.0 * blb%vx
|
||||
blb%px = -5.0
|
||||
blb%age = blb%age + 1
|
||||
endif
|
||||
|
||||
if (0.0 .gt. blb%py) then
|
||||
! vertical axe
|
||||
if (-4.99 .gt. (blb%py + blb%radius)) then
|
||||
blb%vy = -1.0 * blb%vy
|
||||
blb%py = 0.0
|
||||
blb%py = blb%radius
|
||||
blb%age = blb%age + 1
|
||||
endif
|
||||
if (4.99 .lt. blb%py) then !!
|
||||
if ( 4.99 .lt. (blb%py + blb%radius)) then ! overshoot ?
|
||||
blb%vy = -1.0 * blb%vy
|
||||
blb%age = blb%age + 1
|
||||
blb%py = 4.99 !!
|
||||
blb%py = 5.0 - blb%radius !!
|
||||
endif
|
||||
|
||||
if (5.0 .lt. blb%pz) then
|
||||
if ( 5.0 .lt. (blb%pz + blb%radius)) then
|
||||
blb%vz = -1.0 * blb%vz
|
||||
blb%age = blb%age + 1
|
||||
blb%pz = 5.0
|
||||
endif
|
||||
if (-5.0 .gt. blb%pz) then
|
||||
if (-5.0 .gt. (blb%pz + blb%radius)) then
|
||||
blb%vz = -1.0 * blb%vz
|
||||
blb%age = blb%age + 1
|
||||
blb%pz = -5.0
|
||||
@@ -134,7 +243,14 @@ module bloubspace
|
||||
|
||||
subroutine green_soylent (blb)
|
||||
type(t_bloubs), intent (inout) :: blb
|
||||
if (blb%age .gt. 8) then
|
||||
|
||||
if (blb%age .gt. 18) then
|
||||
blb%alive = .FALSE.
|
||||
endif
|
||||
|
||||
! this is juste a molly-guard, don't worry
|
||||
!
|
||||
if (blb%radius .GT. 2.0) then
|
||||
blb%alive = .FALSE.
|
||||
endif
|
||||
end subroutine
|
||||
|
||||
Reference in New Issue
Block a user