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 PGWNAD(0.0, W, 0.0, H)
      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

Advertisements