Let It Snow in Fortran – the code

So here’s the code to do “let it snow” with Fortran.

If you are looking for developing graphics application with Intel Fortran compiler using pgplot and quickwin, then this small program can get you started.

The snow module is generic and creates the snow, while the main program deals with actually driving the snow.

You can download the program here and see the snow in action here

Have a look.

```      MODULE SNOW
!———————————————————————–
! Inspired from Google’s let it snow
! Developed by Sukhbinder Singh

! 30th December 2011
!
!———————————————————————–
INTEGER, PARAMETER :: NUM=200
INTEGER, PARAMETER :: ITIME=50
INTEGER, PARAMETER :: ISPEED=700
REAL :: Y(NUM),X(NUM),FALL(NUM)
REAL :: SFS(NUM),STEP(NUM),CURRSTEP(NUM)
REAL :: H,W,R
CONTAINS

!
!———————————————————————–
SUBROUTINE INIT()
DOUBLE PRECISION :: XX
CALL RANDOM_SEED

W=600.0
H=600.0
DO I=1,NUM
CALL RANDOM_NUMBER(XX)
SFS(I)=INT(1.0D0+XX*1.0D0)
CURRSTEP(I)=0
IF(SFS(I) .EQ. 1) THEN
CALL RANDOM_NUMBER(XX)
FALL(I)=INT(2.0D0+XX*2.0D0)
CALL RANDOM_NUMBER(XX)
STEP(I)=0.050D0+XX*0.1D0
ELSE

CALL RANDOM_NUMBER(XX)
FALL(I)=INT(3.0D0+XX*2.0D0)
CALL RANDOM_NUMBER(XX)
STEP(I)=0.050D0+XX*0.050D0
END IF
CALL RANDOM_NUMBER(XX)
XX=XX*W
X(I)= XX

CALL RANDOM_NUMBER(XX)
XX=XX*H
Y(I)= XX

!
END DO
END SUBROUTINE
!
!———————————————————————–
SUBROUTINE SNOWING
DOUBLE PRECISION :: DX,DY,XX

CALL RANDOM_SEED

DO I=1,NUM
DY=FALL(I)
DX = FALL(I)*COS(CURRSTEP(I))
Y(I)=Y(I)-DY
X(I)=X(I)-DX
!
IF((X(I) .LE. 0.0) .OR. (Y(I) .LE. 0.0)) THEN

CALL RANDOM_NUMBER(XX)
Y(I)=H*XX
CALL RANDOM_NUMBER(XX)
X(I)=XX*W
!
IF(SFS(I) .EQ. 1) THEN

CALL RANDOM_NUMBER(XX)
FALL(I)=INT(2.0D0+XX*2.0D0)
!
CALL RANDOM_NUMBER(XX)
STEP(I)=0.050D0+XX*0.1D0
ELSE
CALL RANDOM_NUMBER(XX)
FALL(I)=INT(3.0D0+XX*2.0D0)
CALL RANDOM_NUMBER(XX)
STEP(I)=0.050D0+XX*0.050D0
END IF

END IF
CURRSTEP(I)=CURRSTEP(I)+STEP(I)
END DO

END SUBROUTINE

!
!———————————————————————–
SUBROUTINE MYDELAY(NNSEC)
INTEGER :: COUNT, COUNT_RATE, COUNT_MAX,NNSEC,ICOUNT
CALL SYSTEM_CLOCK(COUNT, COUNT_RATE, COUNT_MAX)
ICOUNT = COUNT+NNSEC
DO

CALL SYSTEM_CLOCK(COUNT, COUNT_RATE, COUNT_MAX)
IF(COUNT .GE. ICOUNT) EXIT
END DO

END SUBROUTINE
END MODULE
!———————————————————————–
! Main program calling the snow module
! uses quickwin and pgplot library.
!———————————————————————–

PROGRAM SNOWFORTRAN
!
USE SNOW
USE IFQWIN
!Qwin
INTEGER(4) RESULT

INTEGER(2) numfonts, fontnum
TYPE (qwinfo) winfo
!
INTEGER N,NT
REAL PI,A,B
PARAMETER (NT = 2000)
PARAMETER (PI=3.14159265359)
PARAMETER (A = 2.0*PI/num)
PARAMETER (B = 2.0*PI/NT)

! Variables:
INTEGER I, T, L,ISYM
CHARACTER*8 STR
INTEGER PGBEG
!———————————————————————–

IF (PGBEG(0,’/w9',1,1) .NE. 1) STOP

! Maximize frame window
winfo%TYPE = QWIN\$MAX
RESULT = SETWSIZEQQ(QWIN\$FRAMEWINDOW, winfo)
! Maximize child window
RESULT = SETWSIZEQQ(0, winfo)

CALL PGQINF(‘HARDCOPY’, STR, L)
IF (STR(:L).NE.’NO’) WRITE (*,*) ‘Warning: device is not interactive’

CALL INIT
N=NUM
ISYM=39
CALL PGPAGE
CALL PGVSIZ (-1.5, 10.5, -1.5, 8.0)
CALL PGBBUF
CALL PGSCI(1)

!
CALL PGPT (N, X, Y, ISYM)
CALL PGEBUF
CALL PGSCI(3)
CALL PGSLS(5)
CALL PGSLW (25)
CALL PGSCH(5.0)
CALL PGMTXT(‘B’, -1.7, 1.4, 1.5,’\frHAPPY NEW YEAR’)
CALL PGSCH(1.0)
CALL PGSLW (1)

DO

CALL PGBBUF
CALL PGSCI(0)
CALL MYDELAY(ISPEED)
CALL PGPT (N, X, Y, ISYM)
CALL PGSCI(1)
CALL SNOWING
CALL PGPT (N, X, Y, ISYM)
CALL PGEBUF
END DO

CALL PGEND
END```