
      program qcom
c
c     v. 2 (Sept 2000) --
c     Array subscript ranges now start with 0 instead of 1.		
c
      CALL INPUT !     Assign parameters for run (sample not included)
C
C     Initialize all values of arrays for v, w, theta, pi, fv, fw, ftheta, fpi, etc.,
C     including vaulues for boundary points for v, w, theta, pi.
C
      CALL INIT  ! initialize all variables as described above (sample not included)
C
      ITT = 1 ! itt is time step index
C
C     USE FORWARD SCHEME TO do first step
C
      A = 1.
      B = 0.
      N1 = MOD ( ITT    , 2 ) + 1
      N2 = MOD ( ITT - 1, 2 ) + 1
C
      CALL STEP ( N1, N2, A, B ) ! do first time step
C
C     ADAMS - BASHFORTH TWO - LEVEL SCHEME
C
      A =   3. / 2. 
      B = - 1. / 2. 
C
      ITTNOW = ITT  + 1
C
      DO ITT = ITTNOW, ITTMAX
C
      N1 = MOD ( ITT    , 2 ) + 1
      N2 = MOD ( ITT - 1, 2 ) + 1
C
      CALL STEP ( N1, N2, A, B ) ! do subsequent time steps
C
      end do
C	
C     END-OF-RUN OUTPUT ROUTINES GO HERE
C
      STOP 100
      END

      SUBROUTINE STEP ( N1, N2, A, B )

C     This is the entire subroutine.

      CALL RCALC ( N2 ) ! calculate forcing terms from variables at current time
      CALL AB ( N1, N2, A, B ) ! update variables using a time scheme
      CALL BOUND ! apply boundary conditions to variables
C
      RETURN
      END

      SUBROUTINE RCALC (  N2 )
C
C     COMMON BLOCKS ETC GO HERE
C
C     CALCULATES FORCING TERMS FOR V(J,K), ETC.; STORES THEM  IN FV(J,K,N2), ETC.
C
      DO K = 1, KT
      DO J = 1, JT
      FV(J,K,N2)  = [fv for v(j,k)]
      END DO
      END DO

C
C     ETC (forcing for w, theta, and pi)
C
      RETURN
      END

      SUBROUTINE AB ( N1, N2, A, B )
C
C     COMMON BLOCKS ETC GO HERE
C
C     THE FOLLOWING LOOP UPDATES V USING EITHER THE FORWARD OR THE ADAMS-BASHFORTH 
C      SCHEME DEPENDING ON THE VALUES OF A, B.  
C     SUBSCRIPT N2 OF FV ALWAYS REFERS TO THE MOST RECENTLY CALCULATED VALUES FOR FV.
C
      DO K = 1, KT
      DO J = 1, JT
      V(J,K)  = V(J,K)  + DT * ( A * FV(J,K,N2)  + B * FV(J,K,N1) )
      END DO
      END DO
C
C     ETC (update w, theta, and pi)
C
      RETURN
      END

      SUBROUTINE BOUND
C
C     COMMON BLOCKS ETC GO HERE
C
C     apply boundary conditions for v
C
      do j = 1, jt
      v(j,0) = v(j,1) ! free slip b.c.
      v(j,kt+1) = v(j,kt) ! free slip b.c.
      end do
c
      do k = 0, kt+1
      v(0,k) = v(jt,k) ! periodic b.c.
      v(jt+1,k) = v(1,k) ! periodic b.c.
      end do
C
C     ETC (apply b.c. for w, theta, and pi)
C
      RETURN
      END
