Compare commits
	
		
			5 Commits
		
	
	
		
			17e5de3ecb
			...
			d0ac316652
		
	
	| Author | SHA1 | Date | |
|---|---|---|---|
| 
						 | 
					d0ac316652 | ||
| 
						 | 
					1cb5dc13bb | ||
| 
						 | 
					8535ba09d9 | ||
| 
						 | 
					ecfcef2303 | ||
| 
						 | 
					a8acf23b73 | 
							
								
								
									
										1
									
								
								GrafAnim/.gitignore
									
									
									
									
										vendored
									
									
								
							
							
						
						
									
										1
									
								
								GrafAnim/.gitignore
									
									
									
									
										vendored
									
									
								
							@ -1,5 +1,6 @@
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
essai
 | 
					essai
 | 
				
			||||||
 | 
					doubledice
 | 
				
			||||||
 | 
					
 | 
				
			||||||
*.scratch
 | 
					*.scratch
 | 
				
			||||||
*.tga
 | 
					*.tga
 | 
				
			||||||
 | 
				
			|||||||
@ -7,6 +7,9 @@ GFOPT = -Wall -Wextra -g -time
 | 
				
			|||||||
essai:	essai.f90 usegenplot.o Makefile
 | 
					essai:	essai.f90 usegenplot.o Makefile
 | 
				
			||||||
	gfortran $(GFOPT) $< usegenplot.o -o $@
 | 
						gfortran $(GFOPT) $< usegenplot.o -o $@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					doubledice:	doubledice.f90 usegenplot.o Makefile
 | 
				
			||||||
 | 
						gfortran $(GFOPT) $< usegenplot.o -o $@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
usegenplot.o:	usegenplot.f90 Makefile
 | 
					usegenplot.o:	usegenplot.f90 Makefile
 | 
				
			||||||
	gfortran $(GFOPT) -c $<
 | 
						gfortran $(GFOPT) -c $<
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										9
									
								
								GrafAnim/doubledice.f90
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										9
									
								
								GrafAnim/doubledice.f90
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,9 @@
 | 
				
			|||||||
 | 
					program doubledice
 | 
				
			||||||
 | 
					  use usegenplot
 | 
				
			||||||
 | 
					  implicit none
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  call init_genplot("essai.genplot")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  call end_genplot("OK boomer")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end program
 | 
				
			||||||
@ -4,38 +4,43 @@ program essai
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
  integer                   :: foo, bar
 | 
					  integer                   :: foo, bar
 | 
				
			||||||
  integer                   :: nbarg
 | 
					  integer                   :: nbarg
 | 
				
			||||||
  integer                   :: numframe = 1
 | 
					  integer                   :: numframe = 0
 | 
				
			||||||
  character(len=32)         :: arg
 | 
					  character(len=256)        :: arg
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  ! write(0, *)   "------------ essai graf anim ---------------"
 | 
					  ! write(0, *)   "------------ essai graf anim ---------------"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  nbarg = IARGC()
 | 
					  nbarg = IARGC()
 | 
				
			||||||
  if (nbarg .GT. 0) then
 | 
					  if (nbarg .GT. 0) then
 | 
				
			||||||
       call GETARG(1, arg)
 | 
					       call GETARG(1, arg)
 | 
				
			||||||
       write (0, '(A40, A5)') "argument = ",  arg
 | 
					       ! write (0, '(A40, A5)') "argument = ",  arg
 | 
				
			||||||
       read (arg, *) numframe
 | 
					       read (arg, *) numframe
 | 
				
			||||||
  endif
 | 
					  endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  write(0, '(A40, I5)')  "frame number =", numframe
 | 
					  write(0, '(A20, I5)')  "frame number =", numframe
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  call init_genplot("essai.genplot")
 | 
					  call init_genplot("essai.genplot")
 | 
				
			||||||
  ! call do_frame(7)
 | 
					  call do_frame(7)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  bar = (numframe * 20) - 160 
 | 
					  call gplt_setcol(2)
 | 
				
			||||||
  do foo=20, 620, 40
 | 
					
 | 
				
			||||||
 | 
					  bar = (numframe * 20) - 120
 | 
				
			||||||
 | 
					  do foo=20, 620, 50
 | 
				
			||||||
    call gplt_line(foo, 20, bar, 460)
 | 
					    call gplt_line(foo, 20, bar, 460)
 | 
				
			||||||
    call gplt_line(bar, 20, foo, 460)
 | 
					    call gplt_line(bar, 20, foo, 460)
 | 
				
			||||||
  enddo
 | 
					  enddo
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  call end_genplot("done for today")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
contains        !------------------------------------------
 | 
					contains        !------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
subroutine do_frame(color)
 | 
					subroutine do_frame(color)
 | 
				
			||||||
  integer, intent(in)           :: color
 | 
					  integer, intent(in)           :: color
 | 
				
			||||||
 | 
					  integer                       :: savecol
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  call gplt_line(  0,   0, 640,   0)
 | 
					  savecol = gplt_getcol()
 | 
				
			||||||
  call gplt_line(  0, 480, 640, 480)
 | 
					  call gplt_setcol(color)
 | 
				
			||||||
  call gplt_line(  0,   0,   0, 480)
 | 
					  call gplt_rect(0, 0, 640, 480)
 | 
				
			||||||
  call gplt_line(640,   0, 640, 480)
 | 
					  call gplt_setcol(savecol)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -9,7 +9,7 @@ do
 | 
				
			|||||||
	./essai $foo > a.scratch
 | 
						./essai $foo > a.scratch
 | 
				
			||||||
	fname=$(printf "F/%04d.tga" $foo)
 | 
						fname=$(printf "F/%04d.tga" $foo)
 | 
				
			||||||
	echo $fname
 | 
						echo $fname
 | 
				
			||||||
	genplot2 a.scratch $fname
 | 
						genplot2 -s 640x480 a.scratch $fname
 | 
				
			||||||
 | 
					
 | 
				
			||||||
done
 | 
					done
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -1,6 +1,9 @@
 | 
				
			|||||||
module usegenplot
 | 
					module usegenplot
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  implicit none
 | 
					  implicit none
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    integer, private           :: color = 4
 | 
				
			||||||
 | 
					    logical, private           :: initialised = .FALSE.
 | 
				
			||||||
  contains
 | 
					  contains
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
@ -8,23 +11,62 @@ module usegenplot
 | 
				
			|||||||
subroutine init_genplot(filename)
 | 
					subroutine init_genplot(filename)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  character(*), intent(in)    :: filename
 | 
					  character(*), intent(in)    :: filename
 | 
				
			||||||
 | 
					 | 
				
			||||||
  write(0, *)   '--> init genplot "', filename, '"'
 | 
					  write(0, *)   '--> init genplot "', filename, '"'
 | 
				
			||||||
 | 
					  initialised = .TRUE.
 | 
				
			||||||
 | 
					  color = 4
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					subroutine end_genplot(message)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  character(*), intent(in)    :: message
 | 
				
			||||||
 | 
					  write(0, *)   '--> end genplot "', message, '"'
 | 
				
			||||||
 | 
					  initialised = .FALSE.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					subroutine do_initialise_once(motif)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  character(*), intent(in)    :: motif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  write(0, *)   '--> do initialise once "', motif, '", flag is ', initialised
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  call init_genplot('a.scratch')
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					subroutine gplt_setcol(col)
 | 
				
			||||||
 | 
					  integer, intent(in)           :: col
 | 
				
			||||||
 | 
					  color = col
 | 
				
			||||||
 | 
					end subroutine
 | 
				
			||||||
 | 
					function   gplt_getcol()
 | 
				
			||||||
 | 
					  integer gplt_getcol
 | 
				
			||||||
 | 
					  gplt_getcol = color
 | 
				
			||||||
 | 
					end function
 | 
				
			||||||
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
subroutine gplt_move(x, y)
 | 
					subroutine gplt_move(x, y)
 | 
				
			||||||
   integer, intent(in)          :: x, y
 | 
					  integer, intent(in)          :: x, y
 | 
				
			||||||
   print *, x, y, 0
 | 
					
 | 
				
			||||||
 | 
					  if (.NOT. initialised) then
 | 
				
			||||||
 | 
					    call do_initialise_once('in gplt_move')
 | 
				
			||||||
 | 
					  endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  print *, x, y, 0
 | 
				
			||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
subroutine gplt_draw(x, y)
 | 
					subroutine gplt_draw(x, y)
 | 
				
			||||||
   integer, intent(in)          :: x, y
 | 
					  integer, intent(in)          :: x, y
 | 
				
			||||||
   print *, x, y, 2
 | 
					  if (.NOT. initialised) then
 | 
				
			||||||
 | 
					    call do_initialise_once('in gplt_draw')
 | 
				
			||||||
 | 
					  endif
 | 
				
			||||||
 | 
					  print *, x, y, color
 | 
				
			||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
@ -36,11 +78,19 @@ subroutine gplt_line(x1, y1, x2, y2)
 | 
				
			|||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
subroutine gplt_rect(x1, y1, x2, y2)
 | 
					subroutine gplt_rect(x1, y1, x2, y2)
 | 
				
			||||||
   integer, intent(in)           :: x1, y1, x2, y2! -------------------------------------------------------------------
 | 
					   integer, intent(in)           :: x1, y1, x2, y2
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					   call gplt_move(x1, y1)
 | 
				
			||||||
 | 
					   call gplt_draw(x2, y1)
 | 
				
			||||||
 | 
					   call gplt_draw(x2, y2)
 | 
				
			||||||
 | 
					   call gplt_draw(x1, y2)
 | 
				
			||||||
 | 
					   call gplt_draw(x1, y1)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
end subroutine
 | 
					end subroutine
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
! -------------------------------------------------------------------
 | 
					! -------------------------------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
end module
 | 
					end module
 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										2
									
								
								GravityField/.gitignore
									
									
									
									
										vendored
									
									
										Normal file
									
								
							
							
						
						
									
										2
									
								
								GravityField/.gitignore
									
									
									
									
										vendored
									
									
										Normal file
									
								
							@ -0,0 +1,2 @@
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
 | 
					essai
 | 
				
			||||||
							
								
								
									
										8
									
								
								GravityField/Makefile
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										8
									
								
								GravityField/Makefile
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,8 @@
 | 
				
			|||||||
 | 
					#
 | 
				
			||||||
 | 
					# Fortraneries by tTh - Gravity Field
 | 
				
			||||||
 | 
					#
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					GFOPT = -Wall -Wextra -g -time 
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					essai:	essai.f90  Makefile
 | 
				
			||||||
 | 
						gfortran $(GFOPT) $<  -o $@
 | 
				
			||||||
							
								
								
									
										5
									
								
								GravityField/README.md
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								GravityField/README.md
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,5 @@
 | 
				
			|||||||
 | 
					# Gravity Field
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					Some crude experiments to make fancy picture of a useless gravaity field.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					Expect bug party.
 | 
				
			||||||
							
								
								
									
										62
									
								
								GravityField/essai.f90
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										62
									
								
								GravityField/essai.f90
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,62 @@
 | 
				
			|||||||
 | 
					program essai
 | 
				
			||||||
 | 
					  implicit none
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  integer                 :: ix, iy
 | 
				
			||||||
 | 
					  real                    :: fx, fy
 | 
				
			||||||
 | 
					  real                    :: foo, bar, maxi, mini
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  maxi = 0.0
 | 
				
			||||||
 | 
					  mini = 9e9
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  do ix=1, 2000
 | 
				
			||||||
 | 
					    fx = real(ix)
 | 
				
			||||||
 | 
					    do iy=1, 2000
 | 
				
			||||||
 | 
					      fy = real(iy)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					      foo = rdist(fx, fy, 222.22, 765.432)
 | 
				
			||||||
 | 
					      bar = gravity(foo, 1337.0)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					      maxi = max(maxi, bar)
 | 
				
			||||||
 | 
					      mini = min(mini, bar)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    enddo
 | 
				
			||||||
 | 
					  enddo
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  print *, "dist : ", mini, maxi
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					contains        !------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					function gravity(distance, masse)
 | 
				
			||||||
 | 
					  real, intent(in)      :: distance, masse
 | 
				
			||||||
 | 
					  real                  :: gravity
 | 
				
			||||||
 | 
					  real                  :: computed
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  if (distance .LT.  0.010) then
 | 
				
			||||||
 | 
					    computed = 0.0
 | 
				
			||||||
 | 
					  else
 | 
				
			||||||
 | 
					    computed = masse / (distance ** 2)
 | 
				
			||||||
 | 
					  endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  gravity = computed
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end function
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					                !------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					function rdist(ax, ay, bx, by)
 | 
				
			||||||
 | 
					  real, intent(in)       :: ax, ay, bx, by
 | 
				
			||||||
 | 
					  real                      :: rdist
 | 
				
			||||||
 | 
					  real                      :: rx, ry
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  rx = real(ax-bx)
 | 
				
			||||||
 | 
					  ry = real(ay-by)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  rdist = sqrt( (rx*rx) + (ry*ry) )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end function
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					                !------------------------------------------
 | 
				
			||||||
 | 
					                !------------------------------------------
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					end program
 | 
				
			||||||
@ -1,7 +1,7 @@
 | 
				
			|||||||
# Fortraneries
 | 
					# Fortraneries
 | 
				
			||||||
 | 
					
 | 
				
			||||||
Le Fortran moderne, c'est quand même assez cool, alors autant diffuser
 | 
					Le Fortran moderne, c'est quand même assez cool, alors autant diffuser
 | 
				
			||||||
mes gruikeries.
 | 
					mes gruikeries. Pour l'édification des masses...
 | 
				
			||||||
 | 
					
 | 
				
			||||||
J'ai découvert le Fortran moderne lors de mon reclufinement
 | 
					J'ai découvert le Fortran moderne lors de mon reclufinement
 | 
				
			||||||
de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
 | 
					de Janvier 2022, et j'ai bien aimé. Bon, contrairement à la
 | 
				
			||||||
@ -13,7 +13,8 @@ l'existence des _pointeurs_ compense largement.
 | 
				
			|||||||
- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
 | 
					- [SoundBrotching](SoundBrotching/) : faire gémir vos tympans
 | 
				
			||||||
- [BloubWorld](BloubWorld/) : la vie des particules
 | 
					- [BloubWorld](BloubWorld/) : la vie des particules
 | 
				
			||||||
- [Fraktalism](Fraktalism/) : du chaos dans les pixels
 | 
					- [Fraktalism](Fraktalism/) : du chaos dans les pixels
 | 
				
			||||||
- [RandomStuff](RandomStuff) : on a tous droit à notre jardin secret
 | 
					- [RandomStuff](RandomStuff/) : on a tous droit à notre jardin secret
 | 
				
			||||||
 | 
					- [GrafAnim](GrafAnim/) : Ah, enfin de la gif89a en vue !
 | 
				
			||||||
 | 
					
 | 
				
			||||||
## hotline
 | 
					## hotline
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user