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

Compare commits

base: tTh:a1f5030300acc0386d4325184e8c4e785ff01018
Branches Tags
tTh:master
..
compare: tTh:ad0fe18337f00eca0924b6a17661854b7cab6bdf
Branches Tags
tTh:master

No commits in common. "a1f5030300acc0386d4325184e8c4e785ff01018" and "ad0fe18337f00eca0924b6a17661854b7cab6bdf" have entirely different histories.
a1f5030300 ... ad0fe18337

15 changed files with 291 additions and 203 deletions
Show Stats Expand all files Collapse all files

2
GravityField/.gitignore vendored
View File

@ -10,7 +10,6 @@ WS/*/*.gif
WS/data/*
*.pgm
*.pnm
*.png
*.gif
*.log
@ -21,5 +20,4 @@ WS/data/*
foo.pgm
bar.pgm
planets.txt

3
GravityField/Makefile
View File

@ -3,7 +3,7 @@
#
GFOPT = -Wall -Wextra -g -time -I../Modules
MODOBJ = ../Modules/spitpgm.o ../Modules/pixrgb.o
MODOBJ = ../Modules/spitpgm.o
all: essai animation
@ -20,4 +20,3 @@ essai: essai.f90 Makefile realfield.o
animation: animation.f90 Makefile realfield.o
gfortran $(GFOPT) $< realfield.o $(MODOBJ) -o $@
#-

76
GravityField/animation.f90
View File

@ -6,16 +6,13 @@
program animation
use realfield
use spitpgm ! extern module
use pixrgb ! extern module
use spitpgm
implicit none
! some configuration constants
integer, parameter :: S_WIDTH = 1024
integer, parameter :: S_HEIGHT = 1024
integer, parameter :: NB_BODY = 51
integer, parameter :: S_WIDTH = 1600
integer, parameter :: S_HEIGHT = 1600
integer, parameter :: NB_BODY = 60
!!! WARNING : global variable !!!
type(massbody) :: planets(NB_BODY)
@ -54,71 +51,12 @@ subroutine la_grande_boucle(start, nbre, moons)
write (filename, "(a, i5.5, a)") 'WS/data/', pass, '.txt'
call save_bodies_to_txt_file (planets, filename)
write (filename, "(a, i5.5, a)") 'WS/colmap/', pass, '.pnm'
call make_color_map(planets, filename, S_WIDTH, S_HEIGHT)
enddo
call print_barycentre_bodies(moons)
end subroutine
!-----------------------------------------------------------------------
!-
! this is going to go very complex
!-
subroutine make_color_map(moons, fname, width, height)
type(massbody), intent(in) :: moons(:)
character(len=*), intent(in) :: fname
integer, intent(in) :: width, height
type(t_pixrgb), dimension(:,:), allocatable :: cmap
integer :: ix, iy, near, ipl
integer :: errcode
real :: curdist, smalldist
real :: fx, fy, dx, dy
write(0, *) "colmap ", ubound(moons, 1), "moons to ", trim(fname)
! write(0, *) "mapsize ", width, height
allocate (cmap(width, height), stat=errcode)
! write(0, *) "errcode allocate ", errcode
! map = -1 ! invalidate colmap
! DO SOME GOOD STUFF HERE
do ix=1, width
fx = real(ix)
do iy=1, height
fy = real(iy)
near = -1
smalldist = 1e37
! loop over all the planet's bodies
do ipl=1, ubound(moons, 1)
! compute the pseudo distance
dx = fx - moons(ipl)%posx
dy = fy - moons(ipl)%posy
curdist = (dx*dx) + (dy*dy)
if (curdist .LT. smalldist) then
near = ipl
smalldist = curdist
endif
end do ! loop on all the moons, ipl index
cmap(ix, iy)%r = mod(near*13, 255)
cmap(ix, iy)%g = mod(near*14, 255)
cmap(ix, iy)%b = mod(near*15, 255)
enddo
enddo
call rgbpix_spit_as_pnm(cmap, fname)
deallocate(cmap)
end subroutine
!-----------------------------------------------------------------------
!-
! C'est ici que se passe le deplacement des choses mouvantes
@ -162,9 +100,9 @@ subroutine deplace_les_planetes(moons, clipit)
if (moons(foo)%posy .LT. EE) moons(foo)%posy = SH
endif
moons(foo)%heading = moons(foo)%heading + (0.78*(rand()-0.50))
if (moons(foo)%heading .GT. 6.283185307) moons(foo)%heading = 0.0
if (moons(foo)%heading .LT. 0.000000001) moons(foo)%heading = 0.0
moons(foo)%heading = moons(foo)%heading + (0.73*(rand()-0.50))
if (moons(foo)%heading .GT. 6.2831853) moons(foo)%heading = 0.0
if (moons(foo)%heading .LT. 0.0000001) moons(foo)%heading = 0.0
enddo

29
GravityField/essai.f90
View File

@ -4,15 +4,14 @@
!-
!-----------------------------------------------------------------------
program essai
use realfield
use spitpgm ! XXX
use pixrgb
use realfield
use spitpgm ! XXX
implicit none
call init_random()
call essai_near_planet(1024, 1024)
call essai_near_planet(9999, 4096)
STOP 'BECAUSE YOLO'
@ -24,17 +23,17 @@ contains
subroutine essai_near_planet(nbplanets, szfield)
integer, intent(in) :: nbplanets, szfield
type(t_pixrgb), dimension(:,:), allocatable :: cmap
integer :: ix, iy
real :: fx, fy, dx, dy
integer :: near, ipl, errcode
real :: curdist, smalldist
type(massbody) :: planets(nbplanets)
integer, dimension(:,:), allocatable :: map
integer :: ix, iy
real :: fx, fy, dx, dy
integer :: near, ipl, errcode
real :: curdist, smalldist
type(massbody) :: planets(nbplanets)
print *, "near planets test", nbplanets, szfield
allocate(cmap(szfield, szfield), stat=errcode)
! map = -1
allocate(map(szfield, szfield), stat=errcode)
map = -1
! create some random bodies
do ipl=1, nbplanets
@ -64,9 +63,7 @@ subroutine essai_near_planet(nbplanets, szfield)
endif
end do ! loop on ipl
cmap(ix, iy)%r = mod(near*4, 255)
cmap(ix, iy)%g = mod(near*7, 255)
cmap(ix, iy)%b = mod(near*11, 255)
map(ix, iy) = mod(near, 255)
enddo
@ -74,7 +71,7 @@ subroutine essai_near_planet(nbplanets, szfield)
enddo
call rgbpix_spit_as_pnm(cmap, "rgb.pnm")
call spit_as_pgm_8(map, "nearest.pgm")
end subroutine
!-----------------------------------------------------------------------

256
GravityField/planets.txt Normal file
View File

@ -0,0 +1,256 @@
1013.732 479.582 0.290 1.017 1.000 1
430.874 1001.870 0.290 1.017 1.000 2
800.342 78.438 0.290 1.017 1.000 3
428.470 526.633 0.290 1.017 1.000 4
683.159 770.951 0.290 1.017 1.000 5
701.194 777.932 0.290 1.017 1.000 6
267.438 498.398 0.290 1.017 1.000 7
262.751 573.644 0.290 1.017 1.000 8
270.289 292.426 0.290 1.017 1.000 9
627.722 878.386 0.290 1.017 1.000 10
22.025 515.642 0.290 1.017 1.000 11
290.843 647.793 0.290 1.017 1.000 12
286.059 107.685 0.290 1.017 1.000 13
453.554 233.725 0.290 1.017 1.000 14
159.328 67.029 0.290 1.017 1.000 15
152.345 463.567 0.290 1.017 1.000 16
573.714 436.390 0.290 1.017 1.000 17
527.947 253.697 0.290 1.017 1.000 18
966.389 433.661 0.290 1.017 1.000 19
741.138 371.189 0.290 1.017 1.000 20
372.941 119.116 0.290 1.017 1.000 21
67.088 120.760 0.290 1.017 1.000 22
41.045 694.811 0.290 1.017 1.000 23
1013.042 151.672 0.290 1.017 1.000 24
411.353 586.398 0.290 1.017 1.000 25
613.496 364.846 0.290 1.017 1.000 26
259.256 198.103 0.290 1.017 1.000 27
496.138 170.245 0.290 1.017 1.000 28
257.557 308.504 0.290 1.017 1.000 29
525.176 778.064 0.290 1.017 1.000 30
440.230 541.262 0.290 1.017 1.000 31
799.345 739.641 0.290 1.017 1.000 32
813.888 418.630 0.290 1.017 1.000 33
5.606 23.445 0.290 1.017 1.000 34
830.096 458.621 0.290 1.017 1.000 35
403.674 558.310 0.290 1.017 1.000 36
607.764 285.689 0.290 1.017 1.000 37
37.096 880.355 0.290 1.017 1.000 38
356.318 293.626 0.290 1.017 1.000 39
316.936 926.324 0.290 1.017 1.000 40
866.501 975.019 0.290 1.017 1.000 41
67.733 730.619 0.290 1.017 1.000 42
729.362 78.098 0.290 1.017 1.000 43
858.881 905.600 0.290 1.017 1.000 44
714.731 960.900 0.290 1.017 1.000 45
348.047 542.835 0.290 1.017 1.000 46
616.241 437.787 0.290 1.017 1.000 47
442.461 153.413 0.290 1.017 1.000 48
1000.800 218.301 0.290 1.017 1.000 49
1019.812 265.548 0.290 1.017 1.000 50
468.635 773.757 0.290 1.017 1.000 51
757.952 349.819 0.290 1.017 1.000 52
623.835 69.878 0.290 1.017 1.000 53
936.649 305.260 0.290 1.017 1.000 54
277.168 188.377 0.290 1.017 1.000 55
869.400 551.435 0.290 1.017 1.000 56
772.921 19.061 0.290 1.017 1.000 57
866.402 341.690 0.290 1.017 1.000 58
187.490 295.394 0.290 1.017 1.000 59
331.403 352.603 0.290 1.017 1.000 60
305.129 107.302 0.290 1.017 1.000 61
157.077 123.851 0.290 1.017 1.000 62
802.511 700.405 0.290 1.017 1.000 63
835.042 639.913 0.290 1.017 1.000 64
977.107 345.243 0.290 1.017 1.000 65
519.231 196.308 0.290 1.017 1.000 66
19.148 293.031 0.290 1.017 1.000 67
562.970 75.356 0.290 1.017 1.000 68
849.966 574.314 0.290 1.017 1.000 69
279.082 615.885 0.290 1.017 1.000 70
584.110 51.878 0.290 1.017 1.000 71
494.784 955.355 0.290 1.017 1.000 72
343.330 103.512 0.290 1.017 1.000 73
985.494 2.025 0.290 1.017 1.000 74
237.697 344.096 0.290 1.017 1.000 75
689.527 271.636 0.290 1.017 1.000 76
400.948 823.344 0.290 1.017 1.000 77
641.239 727.330 0.290 1.017 1.000 78
754.439 688.874 0.290 1.017 1.000 79
563.593 301.311 0.290 1.017 1.000 80
458.305 201.571 0.290 1.017 1.000 81
414.437 193.264 0.290 1.017 1.000 82
66.340 858.252 0.290 1.017 1.000 83
581.047 789.558 0.290 1.017 1.000 84
92.270 445.578 0.290 1.017 1.000 85
314.886 258.626 0.290 1.017 1.000 86
870.542 281.844 0.290 1.017 1.000 87
950.321 712.520 0.290 1.017 1.000 88
668.751 277.683 0.290 1.017 1.000 89
657.493 510.938 0.290 1.017 1.000 90
79.789 598.045 0.290 1.017 1.000 91
778.442 652.189 0.290 1.017 1.000 92
448.882 551.705 0.290 1.017 1.000 93
183.790 578.385 0.290 1.017 1.000 94
95.258 490.511 0.290 1.017 1.000 95
823.913 982.279 0.290 1.017 1.000 96
238.219 928.096 0.290 1.017 1.000 97
939.519 416.739 0.290 1.017 1.000 98
993.705 782.314 0.290 1.017 1.000 99
201.680 204.326 0.290 1.017 1.000 100
632.987 284.384 0.290 1.017 1.000 101
628.982 558.302 0.290 1.017 1.000 102
473.389 803.737 0.290 1.017 1.000 103
821.032 689.111 0.290 1.017 1.000 104
450.250 1022.021 0.290 1.017 1.000 105
524.726 389.024 0.290 1.017 1.000 106
85.356 979.333 0.290 1.017 1.000 107
908.096 675.005 0.290 1.017 1.000 108
938.300 415.427 0.290 1.017 1.000 109
458.256 410.863 0.290 1.017 1.000 110
549.126 883.600 0.290 1.017 1.000 111
624.306 805.188 0.290 1.017 1.000 112
629.212 316.885 0.290 1.017 1.000 113
62.177 533.617 0.290 1.017 1.000 114
304.220 203.132 0.290 1.017 1.000 115
21.081 0.085 0.290 1.017 1.000 116
405.950 914.355 0.290 1.017 1.000 117
400.203 580.699 0.290 1.017 1.000 118
61.306 236.277 0.290 1.017 1.000 119
30.451 813.913 0.290 1.017 1.000 120
839.479 460.128 0.290 1.017 1.000 121
128.185 926.739 0.290 1.017 1.000 122
669.502 612.316 0.290 1.017 1.000 123
1023.136 835.990 0.290 1.017 1.000 124
175.260 577.813 0.290 1.017 1.000 125
721.221 470.951 0.290 1.017 1.000 126
788.444 813.822 0.290 1.017 1.000 127
343.506 1016.263 0.290 1.017 1.000 128
20.247 328.702 0.290 1.017 1.000 129
20.033 817.854 0.290 1.017 1.000 130
529.659 342.216 0.290 1.017 1.000 131
834.377 726.658 0.290 1.017 1.000 132
717.108 973.606 0.290 1.017 1.000 133
903.599 868.624 0.290 1.017 1.000 134
820.994 55.067 0.290 1.017 1.000 135
847.451 289.793 0.290 1.017 1.000 136
417.015 511.916 0.290 1.017 1.000 137
130.385 22.086 0.290 1.017 1.000 138
516.851 127.014 0.290 1.017 1.000 139
704.355 654.162 0.290 1.017 1.000 140
840.949 591.745 0.290 1.017 1.000 141
372.462 251.530 0.290 1.017 1.000 142
387.971 822.062 0.290 1.017 1.000 143
586.202 389.374 0.290 1.017 1.000 144
857.189 121.079 0.290 1.017 1.000 145
280.527 318.742 0.290 1.017 1.000 146
550.201 518.697 0.290 1.017 1.000 147
436.426 92.767 0.290 1.017 1.000 148
606.332 796.643 0.290 1.017 1.000 149
374.774 202.992 0.290 1.017 1.000 150
749.391 846.073 0.290 1.017 1.000 151
680.757 338.990 0.290 1.017 1.000 152
895.365 721.634 0.290 1.017 1.000 153
243.932 691.413 0.290 1.017 1.000 154
235.747 343.001 0.290 1.017 1.000 155
722.185 293.543 0.290 1.017 1.000 156
980.411 581.501 0.290 1.017 1.000 157
231.767 14.362 0.290 1.017 1.000 158
748.521 556.466 0.290 1.017 1.000 159
339.368 88.726 0.290 1.017 1.000 160
277.478 280.950 0.290 1.017 1.000 161
268.876 87.406 0.290 1.017 1.000 162
612.005 908.155 0.290 1.017 1.000 163
638.146 974.669 0.290 1.017 1.000 164
343.702 224.118 0.290 1.017 1.000 165
484.285 629.835 0.290 1.017 1.000 166
549.323 94.525 0.290 1.017 1.000 167
452.412 488.683 0.290 1.017 1.000 168
813.415 668.603 0.290 1.017 1.000 169
866.972 698.606 0.290 1.017 1.000 170
288.569 319.693 0.290 1.017 1.000 171
158.021 627.531 0.290 1.017 1.000 172
749.866 631.385 0.290 1.017 1.000 173
1008.135 616.388 0.290 1.017 1.000 174
859.900 629.288 0.290 1.017 1.000 175
568.738 762.936 0.290 1.017 1.000 176
135.985 961.989 0.290 1.017 1.000 177
214.835 106.589 0.290 1.017 1.000 178
466.882 1004.028 0.290 1.017 1.000 179
206.272 578.728 0.290 1.017 1.000 180
731.467 641.932 0.290 1.017 1.000 181
84.864 896.165 0.290 1.017 1.000 182
853.682 574.344 0.290 1.017 1.000 183
778.383 684.776 0.290 1.017 1.000 184
300.240 892.090 0.290 1.017 1.000 185
970.355 540.868 0.290 1.017 1.000 186
316.377 748.213 0.290 1.017 1.000 187
498.763 244.511 0.290 1.017 1.000 188
182.843 15.200 0.290 1.017 1.000 189
487.792 181.146 0.290 1.017 1.000 190
162.138 189.944 0.290 1.017 1.000 191
588.940 330.425 0.290 1.017 1.000 192
305.797 79.678 0.290 1.017 1.000 193
779.842 622.361 0.290 1.017 1.000 194
891.255 257.374 0.290 1.017 1.000 195
301.400 927.166 0.290 1.017 1.000 196
677.282 304.462 0.290 1.017 1.000 197
163.184 355.807 0.290 1.017 1.000 198
920.052 918.941 0.290 1.017 1.000 199
669.611 395.978 0.290 1.017 1.000 200
229.081 946.170 0.290 1.017 1.000 201
589.930 595.882 0.290 1.017 1.000 202
270.613 615.464 0.290 1.017 1.000 203
674.544 355.220 0.290 1.017 1.000 204
272.597 163.081 0.290 1.017 1.000 205
686.532 115.490 0.290 1.017 1.000 206
557.638 575.794 0.290 1.017 1.000 207
569.172 889.062 0.290 1.017 1.000 208
256.693 126.401 0.290 1.017 1.000 209
642.427 210.147 0.290 1.017 1.000 210
163.201 653.254 0.290 1.017 1.000 211
945.659 193.471 0.290 1.017 1.000 212
464.449 43.739 0.290 1.017 1.000 213
915.366 1008.563 0.290 1.017 1.000 214
655.432 684.051 0.290 1.017 1.000 215
400.490 287.380 0.290 1.017 1.000 216
816.521 640.733 0.290 1.017 1.000 217
419.932 397.152 0.290 1.017 1.000 218
504.952 841.905 0.290 1.017 1.000 219
269.056 34.997 0.290 1.017 1.000 220
415.209 880.811 0.290 1.017 1.000 221
839.573 1015.335 0.290 1.017 1.000 222
796.541 705.907 0.290 1.017 1.000 223
123.859 936.821 0.290 1.017 1.000 224
128.800 5.187 0.290 1.017 1.000 225
145.896 614.746 0.290 1.017 1.000 226
895.135 950.052 0.290 1.017 1.000 227
292.349 355.497 0.290 1.017 1.000 228
823.712 676.958 0.290 1.017 1.000 229
995.911 1001.759 0.290 1.017 1.000 230
977.771 241.749 0.290 1.017 1.000 231
867.318 371.658 0.290 1.017 1.000 232
66.115 149.584 0.290 1.017 1.000 233
145.432 1006.314 0.290 1.017 1.000 234
742.372 636.881 0.290 1.017 1.000 235
191.685 146.477 0.290 1.017 1.000 236
138.664 934.882 0.290 1.017 1.000 237
300.195 127.767 0.290 1.017 1.000 238
58.593 709.640 0.290 1.017 1.000 239
396.524 190.953 0.290 1.017 1.000 240
133.646 559.808 0.290 1.017 1.000 241
175.764 857.418 0.290 1.017 1.000 242
901.305 205.074 0.290 1.017 1.000 243
921.106 194.016 0.290 1.017 1.000 244
407.945 648.279 0.290 1.017 1.000 245
267.767 911.259 0.290 1.017 1.000 246
591.715 894.716 0.290 1.017 1.000 247
60.756 201.187 0.290 1.017 1.000 248
96.241 628.767 0.290 1.017 1.000 249
2.529 527.167 0.290 1.017 1.000 250
445.350 577.405 0.290 1.017 1.000 251
1016.970 637.687 0.290 1.017 1.000 252
415.472 183.063 0.290 1.017 1.000 253
649.696 532.005 0.290 1.017 1.000 254
858.078 733.697 0.290 1.017 1.000 255
243.600 233.657 0.290 1.017 1.000 256

2
GravityField/raytrace.sh
View File

@ -37,8 +37,6 @@ convert ${TMPF} \
# ---------------------------------------
# main loop, build all that nice picz
for foo in $(seq 0 1999)
do
echo '............' $foo

6
GravityField/realfield.f90
View File

@ -102,14 +102,12 @@ function compute_gravity(fx, fy, body)
rx = fx - body%posx
ry = fy - body%posy
! ??? dist = sqrt( (rx*rx) + (ry*ry) )
dist = (rx*rx) + (ry*ry)
dist = sqrt( (rx*rx) + (ry*ry) )
if (dist .LT. 0.08) then
! write (0, *) "dist too small ", dist
compute_gravity = 0e0
else
! ??? compute_gravity = body%mass / (dist ** 2)
compute_gravity = body%mass / dist
compute_gravity = body%mass / (dist ** 2)
endif
end function

4
GravityField/runme.sh
View File

@ -4,9 +4,7 @@ set -e # stop on error
make animation
date > animation.log
time ./animation | tee animation.log
./encode.sh WS/nanim/ quux.mp4
./encode.sh WS/colmap/ zzz.mp4

15
GravityField/vision.pov
View File

@ -21,11 +21,7 @@ global_settings {
#declare HFDIR = "WS/nanim/";
#declare HFCK = mod(clock, 2000);
#declare HFNAME = concat(HFDIR, str(HFCK , -5, 0), ".pgm");
#declare CMDIR = "WS/colmap/";
#declare CMNAME = concat(CMDIR, str(HFCK , -5, 0), ".pnm");
#debug concat("- - - - - - - ", HFNAME, " ", CMNAME, "\n")
#debug concat("- - - - - - - ", HFNAME, "\n")
#declare GravityField = object
{
@ -35,13 +31,8 @@ height_field {
translate <-0.5, 0, -0.5>
}
texture {
pigment {
image_map { ppm CMNAME }
// image_map { png "WS/mire1024.png" }
rotate x*90
translate <-0.5, 0, -0.5>
}
finish { phong 0.45 }
pigment { color Gray70 }
finish { phong 0.55 }
}
}

2
Modules/.gitignore vendored
View File

@ -2,6 +2,4 @@
chkpixels
*.pgm
*.pnm
*.png

9
Modules/Makefile
View File

@ -8,22 +8,17 @@ GFOPT = -Wall -Wextra -time -g
all: chkpixels
# -----------------------------------------------
spitpgm.o: spitpgm.f90 Makefile
gfortran $(GFOPT) -c $< -o $@
pixrgb.o: pixrgb.f90 Makefile
gfortran $(GFOPT) -c $< -o $@
trials.o: trials.f90 Makefile
gfortran $(GFOPT) -c $< -o $@
#
# programmes de testouille
#
OBJS = trials.o spitpgm.o pixrgb.o
chkpixels: chkpixels.f90 Makefile $(OBJS)
gfortran $(GFOPT) $< $(OBJS) -o $@
chkpixels: chkpixels.f90 Makefile trials.o spitpgm.o
gfortran $(GFOPT) $< spitpgm.o trials.o -o $@

38
Modules/chkpixels.f90
View File

@ -3,50 +3,20 @@
program chkpixels
use spitpgm
use pixrgb
use trials ! experiments, ymmv.
use spitpgm ! main module
use trials ! experiments, ymmv.
implicit none
write(0, *) "------ CHKPIXELS ------"
! call test_spit_as(3)
call test_spit_rgb(256)
call test_alpha(3)
STOP 'BECAUSE NO CPU AVAILABLE'
contains
!-------------------------------------------------------------------
!-
subroutine test_spit_rgb(sz)
integer, intent(in) :: sz
type(t_pixrgb), allocatable :: pixrgb(:,:)
integer :: ix, iy
print *, "test spit rgb", sz
allocate(pixrgb(sz, sz))
! pixrgb = 0
do ix=1, sz
do iy=1, sz
pixrgb(ix, iy)%r = ix
pixrgb(ix, iy)%g = 0
pixrgb(ix, iy)%b = iy
end do
end do
call rgbpix_spit_as_pnm(pixrgb, "rgb.pnm")
deallocate(pixrgb)
end subroutine
!-------------------------------------------------------------------
!-
subroutine test_spit_as(increment)
subroutine test_alpha(increment)
integer, intent(in) :: increment
integer, parameter :: SZ = 40

42
Modules/pixrgb.f90
View File

@ -1,42 +0,0 @@
!-
! This module try to write PGM complient gray level files
!-
module pixrgb
implicit none
!-----------------------------------------------------------------------
!-
! definition of structures
!-
type t_pixrgb
integer :: r, g, b
integer :: alpha = 0
end type
!-------------------------------------------------------------------
contains
!-------------------------------------------------------------------
!-
subroutine rgbpix_spit_as_pnm(pic, fname)
type(t_pixrgb), intent(in) :: pic(:,:)
character (len=*), intent(in) :: fname
integer :: io, ix, iy
open(newunit=io, file=fname)
write (io, '(a2)') "P3"
write (io, '("# spit_rgb_pnm")')
write (io, '(i0," ",i0)') size(pic, 1), size(pic, 2)
write (io, '(i0)') 255
do iy=1, ubound(pic, 2)
do ix=1, ubound(pic, 1)
write(io, "(3I7)") pic(ix, iy)%r, pic(ix, iy)%g, pic(ix, iy)%b
enddo
enddo
close(unit=io)
end subroutine
!-------------------------------------------------------------------
end module

2
Modules/spitpgm.f90
View File

@ -1,5 +1,5 @@
!-
! This module try to write PGM complient gray level files
! This module try to write PNM complient files - ymmv
!-
module spitpgm

6
Modules/trials.f90
View File

@ -4,13 +4,7 @@
module trials
implicit none
!-----------------------------------------------------------------------
!-------------------------------------------------------------------
contains
!-----------------------------------------------------------------------
!-
!-------------------------------------------------------------------
subroutine new_spit_a(pic, fname)