Received: from SGCCP.GSFC.NASA.GOV by spica.npac.syr.edu (4.1/I-1.98K)
	id AA02939; Tue, 2 Feb 93 08:56:18 EST
Date:    Tue, 2 Feb 1993 8:57:04 EST
From: ALLEN@SGCCP.GSFC.NASA.GOV
Message-Id: <930202085704.22c00515@SGCCP.GSFC.NASA.GOV>
Subject: transport.subs
To: kim@npac.syr.edu
X-Vmsmail-To: @KIMM



      SUBROUTINE SET19
 
      IMPLICIT REAL (A-H,O-Z)
 
      PARAMETER (NCON=1,NTAPES=61)
 
      REAL SCALE(NCON)
      COMMON // HEADER(50), HD2(50)
 
      INTEGER IST1(NTAPES), NSTEPS(NTAPES),WINDSOURCE,GRID
 
      LOGICAL RSTAR, FIRST,CHEM,DIFF,DIAG,DIURNAL
C
      COMMON /RDVAR/RSTAR,FIRST,ISAVE,ITAP1,IST1,NSTEPS,
     ! DT,NTSTRC,I1,B,CHEM,SCALE,WINDSOURCE,DIFF,DFCOEF,NPLOTS,DIURNAL
     1 ,GRID,iread0
 
      COMMON /RDVAR2/DIAG
C
************SPECIFY VARIABLES UPDATED EACH TIME MODEL IS RUN******
C     ITAP1   SPECIFIES THE HISTORY FILE THAT CONTAINS THE
C             DATA AT THE INITIAL TIME STEP OF THIS RESTART.
      ITAP1 =  1
C
C     SPECIFY WIND SOURCE.
*****1 = 1979 ASSM DATA 2 = 1989 ASSM DATA  3 = ERIC'S GCM  4= RDSCH
**** 5 = RASCH AND WILLIAMSON WINDS
      WINDSOURCE = 1
C
C     IST1 SPECIES THE 1ST NEW OBS TO BE ACCESSED ON
C          EACH HISTORY TAPE.  IF RSTAR IS TRUE IST1(ITAP1) REFERS
C          TO THE FIRST OBS WHICH WAS NOT ACCESSED IN THE PREVIOUS
C          RUN.
C     NSTEPS  THIS ARRAY SPECIFIES THAT LAST OBS TO BE ACCESSED ON
      IF (WINDSOURCE.EQ.1) THEN
         IST1(1)   = 1
         NSTEPS(1) = 2
C         NSTEPS(1) = 10
         IST1(2)   =  999
         NSTEPS(2) = 10
         IST1(3)   = 999
         NSTEPS(3) = 11
         IST1(4)   = 999
         NSTEPS(4) = 11
         IST1(5)   = 999
         NSTEPS(5) =  10
         IST1(6)   =  999
         NSTEPS(6) =  11
         IST1(7)   =  999
         NSTEPS(7) =  10
         IST1(8)   = 999
         NSTEPS(8) = 11
         IST1(9)   = 999
         NSTEPS(9) = 10
         IST1(10)  =  999
         NSTEPS(10)= 10
         IST1(11)  =  999
         NSTEPS(11)= 10
         IST1(12)  = 999
         NSTEPS(12)= 13
         IST1(13)  = 999
         NSTEPS(13)= 11
         IST1(14)  = 999
         NSTEPS(14)= 12
         IST1(15)  = 999
         NSTEPS(15)= 1
         IST1(16)   = 999
         NSTEPS(16) =  11
         IST1(17)  =  999
         NSTEPS(17) = 12
         IST1(18)   = 999
         NSTEPS(18) = 11
         IST1(19)   = 999
         NSTEPS(19) = 11
         IST1(20)   = 999
         NSTEPS(20) = 11
         IST1(21)   = 999
         NSTEPS(21) = 11
         IST1(22)   = 999
         NSTEPS(22) = 12
         IST1(23)   = 999
         NSTEPS(23) = 11
         IST1(24)   = 999
         NSTEPS(24) = 5
         IST1(25)   = 999
         NSTEPS(25) = 4
         IST1(26)   = 999
         NSTEPS(26) = 9
         IST1(27)   = 999
         NSTEPS(27) = 11
         IST1(28)   = 999
         NSTEPS(28) = 10
         IST1(29)   = 999
         NSTEPS(29) = 9
         IST1(30)   = 999
         NSTEPS(30) = 10
         IST1(31)   = 999
         NSTEPS(31) = 6
         IST1(32)   = 999
         NSTEPS(32) = 7
         IST1(33)   = 999
         NSTEPS(33) = 10
         IST1(34)   = 999
         NSTEPS(34) = 10
         IST1(35)   = 999
         NSTEPS(35) = 11
         IST1(36)   = 999
         NSTEPS(36) = 11
         IST1(37)   = 999
         NSTEPS(37) = 9
         IST1(38)   = 999
         NSTEPS(38) = 12
         IST1(39)   = 999
         NSTEPS(39) = 13
         IST1(40)   = 999
         NSTEPS(40) = 13
         IST1(41)   = 999
         NSTEPS(41) = 8
         IST1(42)   = 999
         NSTEPS(42) = 15
         IST1(43)   = 999
         NSTEPS(43) = 15
         IST1(44)   = 999
         NSTEPS(44) = 16
         IST1(45)   = 999
         NSTEPS(45) = 16
         IST1(46)   = 999
         NSTEPS(46) = 16
         IST1(47)   = 999
         NSTEPS(47) = 16
         IST1(48)   = 999
         NSTEPS(48) = 16
         IST1(49)   = 999
         NSTEPS(49) = 16
         IST1(50)   = 999
         NSTEPS(50) = 16
         IST1(51)   = 999
         NSTEPS(51) = 16
         IST1(52)   = 999
         NSTEPS(52) = 18
         IST1(53)   = 999
         NSTEPS(53) = 15
         IST1(54)   = 999
         NSTEPS(54) = 14
         IST1(55)   = 999
         NSTEPS(55) = 13
         IST1(56)   = 999
         NSTEPS(56) = 14
         IST1(57)   = 999
         NSTEPS(57) = 13
         IST1(58)   = 999
         NSTEPS(58) = 13
         IST1(59)   = 999
         NSTEPS(59) = 14
         IST1(60)   = 999
         NSTEPS(60) = 13
         IST1(61)   = 999
         NSTEPS(61) = 9
      ELSE IF (WINDSOURCE.EQ.2) THEN
         IST1(1) =     99
         NSTEPS(1) =  10
         IST1(2)   =  999
          NSTEPS(2)  = 10
         IST1(3)   = 999
         NSTEPS(3) = 11
         IST1(4)   = 999
         NSTEPS(4) = 13
         IST1(5)   = 999
         NSTEPS(5) =  14
         IST1(6)   =  999
         NSTEPS(6) =  13
         IST1(7)   =  999
         NSTEPS(7) =  12
         IST1(8)   = 999
         NSTEPS(8)   = 14
         IST1(9)   = 999
         NSTEPS(9) = 13
         IST1(10)   =  999
         NSTEPS(10) = 12
         IST1(11)  =  999
         NSTEPS(11) = 13
         IST1(12)   = 999
         NSTEPS(12) = 12
         IST1(13)   = 999
         NSTEPS(13) = 15
         IST1(14)   = 999
         NSTEPS(14) = 13
         IST1(15)   = 999
         NSTEPS(15) = 13
         IST1(16)   = 999
         NSTEPS(16) =  13
         IST1(17)  =  999
         NSTEPS(17) = 13
         IST1(18)   = 999
         NSTEPS(18) = 12
         IST1(19)   = 999
         NSTEPS(19) = 13
         IST1(20)   = 999
         NSTEPS(20) = 15
         IST1(21)   = 999
         NSTEPS(21) = 16
         IST1(22)   = 999
         NSTEPS(22) = 12
         IST1(23)   = 999
         NSTEPS(23) = 13
         IST1(24)   = 999
         NSTEPS(24) = 13
         IST1(25)   = 999
         NSTEPS(25) = 13
         IST1(26)   = 999
         NSTEPS(26) = 14
         IST1(27)   = 999
         NSTEPS(27) = 13
         IST1(28)   = 999
         NSTEPS(28) = 14
         IST1(29)   = 999
         NSTEPS(29) = 14
         IST1(30)   = 999
         NSTEPS(30) = 2
         IST1(31)   = 999
         NSTEPS(31) = 0
         IST1(32)   = 999
         NSTEPS(32) = 0
         IST1(33)   = 999
         NSTEPS(33) = 0
         IST1(34)   = 999
         NSTEPS(34) = 0
         IST1(35)   = 999
         NSTEPS(35) = 0
         IST1(36)   = 999
         NSTEPS(36) = 0
         IST1(37)   = 999
         NSTEPS(37) = 0
         IST1(38)   = 999
         NSTEPS(38) = 0
         IST1(39)   = 999
         NSTEPS(39) = 0
         IST1(40)   = 999
         NSTEPS(40) = 0
         IST1(41)   = 999
         NSTEPS(41) = 0
         IST1(42)   = 999
         NSTEPS(42) = 0
         IST1(43)   = 999
         NSTEPS(43) = 0
         IST1(44)   = 999
         NSTEPS(44) = 0
         IST1(45)   = 999
         NSTEPS(45) = 0
         IST1(46)   = 999
         NSTEPS(46) = 0
         DO 25 III=47,61
            IST1(III) = 999
            NSTEPS(III) = 0
 25      CONTINUE
      ELSE
         IST1(1)   = 999
         NSTEPS(1) = 23
         IST1(2)   =  999
         NSTEPS(2) = 24 
         IST1(3)   =  999
         NSTEPS(3) = 24
         DO 26 III=4,61
            IST1(III) = 999
            NSTEPS(III) = 0
 26      CONTINUE
      END IF
 
*******SPECIFY VARS UPDATED EACH EXPERIMENT********
C
C     IS THIS A RESTART(TRUE) OR THE INITIAL RUN OF THE EXPERIMENT?
      RSTAR = .false.
c
c     specify iread0 ( number of observations to skip before 1st obs in
c      calculation 12z dec1 78 startup means iread0 = 0 for 78-79 calcu.
      iread0 = 0
 
C     SHOULD THE FIRST FIELD BE SAVED?
      FIRST = .true.
C
C     SPECIFY TIME INCREMENT BETWEEN INPUT HISTORY UNIT WIND FIELDS
      DT = 21600.
C
C     WILL DIAGNOSTICS BE CALCULATED.
      DIAG = .FALSE.
C
C     CONVERT IC TO PPV FROM (PPB OR PPM ETC.)
      SCALE(1) = 1.E-6
C     SCALE(2) = 1.E-9
C     SCALE(3) = 1.E-9
 
C     TAPE THAT CONTAINS THE FIRST OBSERVATION OF EXPERIMENT
      I1 = 1
 
C     TIME STEP(TDT) IS SPECIFIED (TDT = DT / NTSTRC)
C!!!!!!!!!!WARNING FOR VAN LEER ONLY RUNS USE NTSTRC=24*1
C     NTSTRC = 36
      NTSTRC    =  24 * 3
 
C     IS DIURNAL CYCLE NEEDED.
      DIURNAL = .false.
 
C     ISAVE    SPECIFIES THE NUMBER OF SAVES THAT ARE SKIPPED TO
C              ACCESS THE CONSTITUENT RESTART RECORDS.
      ISAVE =  0
C
C     SPECIFY SOLID BODY ROTATION ANGLE
      PI = 4.0 * ATAN(1.)
      B  = PI * 0.5
C     B  = 0.
 
C     IS THIS A RUN WITH CHEMISTRY?
      CHEM = .true.
 
C     WILL THERE BE TROPOSPHERIC DIFFUSION?
      DIFF = .false.
C     IF SO WHAT IS THE DIFFUSION COEFFICIENT?
      DFCOEF = 5.66E3 * 16.
 
C     NUMBER OF OBS PER OUTPUT DATASET.
      IF (NCON.EQ.1) THEN
         NPLOTS = 24
      ELSE IF (NCON.EQ.2) THEN
         NPLOTS = 12
      ELSE
         NPLOTS =  8
      END IF
 
C     SPECIFY TRANSPORT GRID  MECHANISTIC=2 19 LEV MODEL=1
      GRID = 1
 
      RETURN
      END
C
C
C
      SUBROUTINE HEADER(TIME,TDT,JTAPE,ILON)
 
      IMPLICIT REAL (A-H,O-Z)
 
      PARAMETER (N=144,JGMAX=88,KTOP=19,NCON=1)
 
      COMMON // HEAD(50)
 
      DO 40 I=1,50
         HEAD(I) = -999.
 40   CONTINUE
 
C     EXPERIMENT HEAD IS CREATED
C     EXPERIMENT NUMBER
      HEAD(1) =  700.
C     DATE IN REAL TIME OF EXPERIMENT
      HEAD(3) = 920120.
C     MODEL TIME THAT THIS EXPERIMENT BEGAN
c      HEAD(4) = 781205.50
C      HEAD(4) = 881228.0
      HEAD(4) = 781201.5
C     HEAD RECORDS BEFORE EACH OBSERVATION
      HEAD(6) = 1.
C     NUMBER OF CONSTITUENTS
      HEAD(7) = NCON
C     NUMBER OF EAST-WEST GRID POINTS
      HEAD(8) = N
C     NUMBER OF NORTH-SOUTH GRID POINTS
      HEAD(9) = JGMAX
C     NUMBER OF VERTICAL LEVELS
      HEAD(10) = KTOP
C     MODEL USED (1.)=PRESS (2.)=COMBINED SIGMA-PRESS (3.)=SIGMA
      HEAD(11) = 2.
C     TYPE OF CHEMISTRY USED (1.)=FULL (0.)=NONE (2.)=PARAMETERIZED
      HEAD(12) = 2.
C     TIME OF  OBSERVATION IN DAYS
      HEAD(13) =  TIME / 86400.
C     DYNAMICAL TIME STEP IN MINUTES
      HEAD(14) = TDT / 60.
C     CHEMICAL TIME STEP IN MINUTES
      HEAD(15) = TDT / 60.
C
C     WAS THIS RUN ON THE CRAY? (1.)=YES (-999.)=NO
      HEAD(47) = 1.
 
C      T2 = HEAD(4) + HEAD(13)
C      IF (T2.GE.881232.) THEN
C         T2 = T2 - 881231.
C         IF (T2.GE.60.) THEN
C            T2 = T2 - 59.
C CC           HEAD(48) = 890300. + T2
C C        ELSE IF (T2.GE.32.) THEN
C            T2 = T2 - 31.
C            HEAD(48) = 890200. + T2
C         ELSE
C            HEAD(48) = 890100. + T2
C         END IF
C      ELSE
C         HEAD(48) = T2
C      END IF
 
       T2 = HEAD(4) + HEAD(13)
       IF ((T2.GE.781232.).AND.(T2.LT.781263.)) THEN
          T2 = T2 - 781231.
          HEAD(48) = 790100. + T2
       ELSE IF (T2.GE.781263.) THEN
          T2 = T2 - 781262.
          HEAD(48) = 790200. + T2
       ELSE IF (T2.GE.781291.) THEN
          T2 = T2 - 781290.
          HEAD(48) = 790300. + T2
       ELSE IF (T2.GE.781322.) THEN
          T2 = T2 - 781321.
          HEAD(48) = 790400. + T2
       ELSE IF (T2.GE.781352.) THEN
          T2 = T2 - 781351.
          HEAD(48) = 790500. + T2
       ELSE
          HEAD(48) = T2
       END IF
C     SPECIFY WHICH LONGITUDE IS OUTPUT (0 INDICATES THAT ALL ARE)
      HEAD(49) = ILON
 
C     OUTPUT OBSERVATION HEAD
      write (jtape) head
 
      RETURN
      END
