Animating Heart using pgplot with fortran

Here’s the code for the heart animation written in fortran, using pgplot and quickwin.

Not an optimized code but mashed quickly to get something up and running.

Find the story and code in action at the following post Did i miss the valentine’s day?

      MODULE DATAitem

      TYPE thedata
        REAL x0,y0,xf,yf,dx,dy,speed
        CHARACTER(len=1) schar
      END TYPE

      INTEGER,parameter :: isteps=15,iinum=2000
      INTEGER inum
      LOGICAL :: direction
      END MODULE

      PROGRAM heart

!
! Animating heart.
! by sukhbinder
! date: 27th Feb 2012
!

      USE DATAitem
      USE IFqwin

      TYPE(qwinfo) :: winfo
      INTEGER(4)   :: RESULT

      INTEGER  :: pgopen,pgcurs
      REAL xr(iinum),yr(iinum)
      TYPE(thedata) alpa(iinum)
      CHARACTER*1 ch

      winfo%TYPE=QWIN$MAX
      RESULT= setwsizeqq(qwin$framewindow,winfo)

      RESULT=aboutboxqq("Heart animation IN PGPLOT\rSukhbinder SINgh\rVersion 1.0\r15Feb2012"C)

      direction =.true.

      IF(pgopen('/w9') .LE. 0) STOP

      CALL pgenv(-2.0,2.0,-2.0,1.5,1,-2)

      DO iii=100,2000,200
         INum=iii
         CALL INit
         CALL mydelay(500)
         CALL ani

      END DO

      CALL pgclos

      CONTAINS

      SUBROUTINE ani

       DO i=1,isteps
         CALL pgbbuf()

          CALL pgsci(0)

            CALL pgpt(inum,alpa%xf,alpa%yf,1)

          CALL pgsci(2)
          DO j=1,inum
            IF(direction) THEN

              alpa(j)%xf=alpa(j)%xf-alpa(j)%dx
              alpa(j)%yf=alpa(j)%yf-alpa(j)%dy
            ELSE
              alpa(j)%xf=alpa(j)%xf+alpa(j)%dx
              alpa(j)%yf=alpa(j)%yf+alpa(j)%dy
            END IF

          END DO
          CALL pgpt(inum,alpa%xf,alpa%yf,1)
          CALL mydelay(400)

         CALL pgebuf()
       END DO

       IF(direction) THEN
         direction = .FALSE.
       ELSE
         direction = .TRUE.
       END IF

       END SUBROUTINE ani

      SUBROUTINE init

      REAL xxx(3)

      xr(1)=-2.0
      xinc=real(4.0/inum)
      yr(1)=(cos(xr(1)))**0.5 * cos(200*xr(1)) + (abs(xr(1)))**0.5 -0.7 &
	  * (4.0 -xr(1) * xr(1))**0.01
      DO i=2,inum
       xr(i)=xr(i-1)+xinc
       yr(i)=(cos(xr(i)))**0.5 * cos(200*xr(i)) +  (abs(xr(i)))**0.5 -0.7 &
	   * (4.0 -xr(i) * xr(i))**0.01
      END DO

       CALL RANDOM_SEED
       DO i=1,inum
         alpa(i)%x0=xr(i)
         alpa(i)%y0=yr(i)
         CALL RANDOM_NUMBER(xxx)
         xxx(1)=-20.0 + xxx(1)*40.0
         xxx(2)=-20.0 + xxx(2)*40.0

         xxx(3)=xxx(1)
         alpa(i)%xf=xxx(1)
         alpa(i)%yf=xxx(2)
         alpa(i)%speed=xxx(3)
         alpa(i)%dx=(alpa(i)%xf-alpa(i)%x0)/isteps
         alpa(i)%dy=(alpa(i)%yf-alpa(i)%y0)/isteps
       END DO

        CALL pgsci(2)
       CALL pgpt(inum,alpa%xf,alpa%yf,1)

      END SUBROUTINE
      END PROGRAM

      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

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s