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

shacking around code lines

Browse Source
This commit is contained in:
tTh
2022-12-12 00:57:00 +01:00
parent 9569e1b462
commit 61382ed12a
3 changed files with 134 additions and 38 deletions
Download Patch File Download Diff File Expand all files Collapse all files

89
GravityField/realfield.f90
View File

@@ -72,7 +72,7 @@ subroutine create_some_planets(planets, coef, sx, sy)
!-
planets(1)%posx = sx / 2
planets(1)%posy = sy / 2
planets(1)%mass = 29e8
planets(1)%mass = 31e8
planets(1)%serial = 1337
planets(1)%speed = 6.666
else
@@ -82,10 +82,11 @@ subroutine create_some_planets(planets, coef, sx, sy)
planets(foo)%posx = rand() * real(sx-1)
planets(foo)%posy = rand() * real(sy-1)
planets(foo)%mass = 7e6 + coef*foo
planets(foo)%heading = 3.14159 * rand()
if (rand() .LT. 0.08) planets(foo)%speed = 3.14159
planets(foo)%heading = 2 * 3.14159 * rand()
if (rand() .LT. 0.15) planets(foo)%speed = 3.14159
planets(foo)%serial = foo*2 + 120
endif
write (*, fmt) foo, planets(foo)
enddo
end subroutine
@@ -110,11 +111,29 @@ function compute_gravity(fx, fy, body)
endif
end function
!-----------------------------------------------------------------------
!-
! Export a massbody area to a text file. no error check, wtf ?
!-
subroutine save_bodies_to_txt_file (astres, fname)
type(massbody), intent(in) :: astres(:)
character(len=*), intent(in) :: fname
character(50) :: fmt
integer :: io, idx
write(0, "('saving planets to ', A20)") fname
fmt = "( 2(F9.3, ' ') 2(F9.3, ' '), F14.3, I8)"
open(newunit=io, file=fname)
do idx = 1, ubound(astres, 1)
write(io, fmt) astres(idx)
enddo
close(io)
end subroutine
!-----------------------------------------------------------------------
!-
! Compute the gravity field in a pre-allocated array relative
! to the massbody 'moon'. Nobody know where the magic number
! to the massbody 'moon'. Nobody know where the magic numbers
! come from, sorry.
!-
subroutine compute_a_field(field, moon)
@@ -158,7 +177,7 @@ subroutine build_and_write_a_field(szx, szy, moons, fname)
field = 0.0
do foo=1, ubound(moons, 1)
call compute_a_field(tmpf, moons(foo))
tmpf = tmpf * 0.019
tmpf = tmpf * 0.018
field = field + tmpf
enddo
@@ -199,9 +218,67 @@ subroutine init_random()
! you MUST use it for initializing the initializer
do t3=1, 4
dummy = rand()
write(0, *) 'dummy ', t3, dummy
write(0, '(" dummy", I4, F9.6)') t3, dummy
enddo
end subroutine
!-----------------------------------------------------------------------
!-
! dump a field of reals numbers to disk - preliminary version
!-
subroutine dump_a_field_to_file(field, fname)
real, dimension(:,:), intent(in) :: field
character(len=*), intent(in) :: fname
integer :: header(8)
integer :: io
print *, "D) field size ", ubound(field, 1), "W", ubound(field, 2), "H"
print *, "D) filename ", fname
header = 0
header(1) = 574908040 ! magic number
header(2) = 1 ! this is a dump of real field
header(3) = ubound(field, 1)
header(4) = ubound(field, 2)
header(5) = 666
open(newunit=io, file=fname, form='unformatted')
write(io) header
write(io) field
close(io)
end subroutine
!-----------------------------------------------------------------------
!-
! load a real field from file - preliminary version
!-
subroutine load_a_field_from_file(field, fname)
real, dimension(:,:), intent(in) :: field
character(len=*), intent(in) :: fname
integer :: header(8)
integer :: io, foo
print *, "L) field size ", ubound(field, 1), "W", ubound(field, 2), "H"
!-
! how to check if the field array was valid ?
!-
open(newunit=io, file=fname, form='unformatted', status='old', &
action='read')
read(io) header
do foo=1, 8
print *, foo, header(foo)
enddo
STOP ' --- FUCKED UP BEYOND ALL REPAIR ---'
close(io)
end subroutine
!-----------------------------------------------------------------------
!-----------------------------------------------------------------------