      PROGRAM GCMPARF
C     PROGRAM GCMPARF (PARAMS,       INPUT,       OUTPUT,               )       I2
C    1           TAPE1=PARAMS, TAPE5=INPUT, TAPE6=OUTPUT)
C     ---------------------------------------------------                       I2
C
C     OCT 24/2003 - K.VONSALZEN (ADJUST "IC" COMPUTED VALUE AS A RESULT OF      I2
C                                ADDING VA(ICD(97)) IN CONV7. ALSO, ADJUST      I2
C                                "IWRKC" COMPUTED VALUE FOR THE SIZE CHANGE OF  I2
C                                "ACORX" IN CONV7 (WHICH USES INDEX "ID89").    I2
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)     
C     MAY  8/2003 - M. LAZARE/(ADD TWO ILG*ILEV AND THREE ILG WORK FIELDS       
C                 K.VONSALZEN. IN CONJUNCTION WITH JL'S CHANGE TO               
C                              RADIATION. ALSO WRITE OUT NBS,NBL AS             
C                              PARMSUB PARAMETERS, ADD AN EXTRA WORK            
C                              FIELD OF SIZE ILG*NBS TO CLASS WORKSPACE,        
C                              AND ADD TWO EXTRA POINTERS FOR DEEP)             
C     NOV 01/2002 - M. LAZARE (REPLACE INPUT PARAMETERS ITRACG,ISULFR BY          
C                              NTRAC,NTRACA, OUTPUT THESE AND NTRACN              
C                              INSTEAD OF NSULF, IN CONJUNCTION WITH MOVE         
C                              TO NEW MORE GENERALIZED TRACER FORMULATION)             
C     JUN 14/2002 - M. LAZARE (REVISE CALCULATED SIZE IN "IG" OF THE TOTAL 
C                              WORK SPACE REQUIRED BY SUBROUTINE CLASS)
C     MAY 22/2002 - M. LAZARE (REVISED WORK SPACE FOR NEW CORRELATED-K          
C                              RADIATION SCHEME. THIS INCLUDES NO "VA"          
C                              WORKSPACE REQUIREMENTS FOR SHORTWAVE OR          
C                              LONGWAVE (THEREBY REDUCING WORKSPACE             
C                              REQUIREMENTS CONSIDERABLY) AND REDUCED           
C                              "WRK" REQUIREMENTS AS WELL.                      
C                              THIS IS THE GCMPARM VERSION FOR GCM15.)          
C     MAY 22/2002 - M. LAZARE (PREVIOUS VERSION GCMPARE FOR GCM14.)
C     OCT  7/99 - J. SCINOCCA (PREVIOUS VERSION GCMPARD FOR GCM13.)
C
CGCMPARF - COMPUTES ARRAY DIMENSIONS FOR GCM15                          0  1 C  I1
C                                                                               I3
CAUTHOR  - M.LAZARE/R.HARVEY.                                                   I3
C                                                                               I3
CPURPOSE - COMPUTES AND WRITES OUT TO PARAMS FILE THE PARMSUB INPUT CARD        I3
C          IMAGES FOR THE AUTOMATIC DIMENSIONING OF ARRAYS IN THE G.C.M.        I3
C          VERSION-13.                                                          I3
C                                                                               I3
COUTPUT FILE...                                                                 I3
C                                                                               I3
C      PARAMS = CARD IMAGE FILE CONTAINING THE REPLACEMENT VALUES FOR           I3
C               PARMSUB TO PROCESS THE GCM VERSION-14 ARRAY DIMENSIONS.         I3
C
CINPUT PARAMETERS...
C                                                                               I5
C      ILEV  = NUMBER OF MODEL    LEVELS                                        I5
C      LEVS  = NUMBER OF MOISTURE LEVELS                                        I5
C      ILGSLD= NUMBER OF LONGITUDES +2      ON THE DYNAMICS GRID                I5
C      ILATD = NUMBER OF GAUSSIAN LATITUDES ON THE DYNAMICS GRID                I5
C      LRLMT = CODE CONTAINING THE M AND N TRUNCATION LIMITS AND TYPE           I5
C                                                                               I5
C      NTRAC = NUMBER OF TOTAL TRACERS IN MODEL (IF ZERO, THEN GCMPARM          I5
C              COMMENTS OUT DIMENSION STATEMENTS FOR TRACER-RELATED ARRAYS).    I5
C      ITRACA= SWITCH TO INCLUDE ADVECTED TRACERS IN MODEL (IF NOT              I5
C              USED, THEN GCMPARM COMMENTS OUT DIMENSION STATEMENTS FOR         I5
C              TRACER-RELATED ARRAYS).                                          I5
C                                                                               I5
C      IOZTYP = SWITCH FOR INPUT OZONE DISTRIBUTION                             I5
C               (IOZTYP=1 => OLD JAPANESE DATASET WITH LEVOZ=37,                I5
C                IOZTYP=2 => NEW AMIP2    DATASET WITH LEVOZ=59)                I5
C                                                                               I5
C      ISULF=  SULFUR CYCLE/ADVECTION SCHEME INDICATOR. THE ONLY ALLOWED        I5
C              CHOICES ARE: ISULF={0,1}; THE FIRST INDICATES THE                I5
C              FULL SULFUR CYCLE WITH 4 ADDITIONAL TRACERS AND THE SECOND       I5
C              INDICATES ONLY SULFUR CONCENTRATIONS RATHER THAN EMISSIONS       I5
C              ARE USED.                                                        I5 
C      MACHINE = SWITCH TO INDICATE THE MACHINE TYPE ON WHICH THE MODEL IS      I5
C                TO BE RUN (USED IN LENPAK TO CALCULATE THE APPROPRIATE         I5
C                DIMENSIONS OF SOME OF THE ARRAYS):                             I5
C                   MACHINE = 1     FOR 64 BIT MACHINES                         I5
C                   MACHINE = 2     FOR 32 BIT MACHINES                         I5
C      NLATJD  = NUMBER OF LATITUDES TO BE CHAINED TOGETHER FOR MULTIPLE-       I5
C                LATITUDE FORMULATION ON THE DYNAMICS GRID.                     I5
C      IDBL    = SWITCH TO INDICATE WHETHER DOUBLE-TRANSFORM METHODOLOGY        I5
C                IS TO BE USED (IDBL.NE.0) OR NOT (IDBL=0).                     I5
C  IF(IDBL.NE.0).....                                                           I5
C      ILGSLP= NUMBER OF LONGITUDES +2      ON THE PHYSICS GRID                 I5
C      ILATP = NUMBER OF GAUSSIAN LATITUDES ON THE PHYSICS GRID                 I5
C      NINISW= NUMBER OF SOLAR SPECTRAL INTERVALS                               I5
C      NLATJP  = NUMBER OF LATITUDES TO BE CHAINED TOGETHER FOR MULTIPLE-       I5
C                LATITUDE FORMULATION ON THE TRANSFORM GRID.                    I5
C                                                                               I5
CEXAMPLE OF INPUT CARD...                                                       I5
C                                                                               I5
C* GCMPARF   35   35  146   72     48482   16   11    2    1    1    8 1        I5
C*                     98   48                                       8          I5
C----------------------------------------------------------------------------
C
C     * ARRAY DIMENSIONS NAMING CONVENTION.
C
C     * I = ILGSL = NUMBER OF LONGITUDES + 2 (NECCESSARY FOR TRANSFORMS).
C
C     * NOTE THAT THIS REFERS TO A SINGLE LATITUDE. FOR GRID SIZES, THE
C     * RESULT IS MULTIPLIED BY NLATJ TO ACCOMODATE MULTIPLE LATITUDES.
C     * THIS IS FOR THE PHYSICS LATITUDE LOOP LENGTH. IF (IDBL.NE.0),
C     * ARRAY DIMENSIONS FOR THE DYNAMICS LOOP HAVE "D" INSTEAD OF "I".
C
C     * J = JLAT = NUMBER OF LATITUDES.
C     * L = ILEV = NUMBER OF DYNAMIC LEVELS.
C     * S = LEVS
C     * C = ICAN = NUMBER OF DISTINCT CANOPY TYPES.
C     * G = IGND = NUMBER OF SOIL LAYERS.
C     * M = LM
C     * N = N MAX
C     * R = LA
C     * WHEN ANY OF THE ABOVE (X) ARE FOLLOWED BY AN INTEGER (N),
C     * IT IMPLIES (X+N).
C     * TWO OR MORE CONSECUTIVE OF THE ABOVE (X,Y) IMPLIES (X*Y).
C     * PN MEANS THAT THE PRECEEDIND DIMENSIONS ARE PACKED 2N.
C     * A  MEANS THAT THE JUST PRECEEDING AND FOLLOWING SIZES
C     * ARE ADDED FOR THE DIMENSION.
C     *   IM1 = ILG - 1

      IMPLICIT REAL (A-H,O-Z),
     +INTEGER (I-N)
      CHARACTER*1 IP(6)
      CHARACTER*1 IPLONG(8)
      CHARACTER*1 IPVLONG(10)
C
      INTEGER LSR(2,400)
      INTEGER*4 II
C
      COMMON /MACHTYP/ MACHINE, INTSIZE
C
      CHARACTER*8 KR
      CHARACTER*8 KL
      CHARACTER*8 KLM1
      CHARACTER*8 KL1
      CHARACTER*8 KL2
      CHARACTER*8 KL3
      CHARACTER*8 KL3J
      CHARACTER*8 KS
      CHARACTER*8 KNBS
      CHARACTER*8 KNBL
      CHARACTER*8 KC
      CHARACTER*8 KC1
      CHARACTER*8 KG
      CHARACTER*8 KG1
      CHARACTER*8 KG2
      CHARACTER*8 KD
      CHARACTER*8 KI
      CHARACTER*8 KIDBL
      CHARACTER*8 KILATD
      CHARACTER*8 KILGD
      CHARACTER*8 KNLATD
      CHARACTER*8 KNENDD
      CHARACTER*8 KILGP
      CHARACTER*8 KNLATP
      CHARACTER*8 KNENDP
      CHARACTER*8 KJ
      CHARACTER*8 KIM1
      CHARACTER*8 KM1
      CHARACTER*8 KRAM
      CHARACTER*8 KP0
      CHARACTER*8 KP1
      CHARACTER*8 KP2
      CHARACTER*8 KP3
      CHARACTER*8 KIP0J
      CHARACTER*8 KIP1J
      CHARACTER*8 KIP2J
      CHARACTER*8 KIP3J
      CHARACTER*8 KRL
      CHARACTER*8 KRS
      CHARACTER*8 KIL
      CHARACTER*8 KIL1
      CHARACTER*8 KIS
      CHARACTER*8 KDL
      CHARACTER*8 KDS
      CHARACTER*8 KLJ
      CHARACTER*8 KL1J
      CHARACTER*8 KNL
      CHARACTER*8 KLL
      CHARACTER*8 KGLL
      CHARACTER*8 KIP0JL
      CHARACTER*8 KIP0JS
      CHARACTER*8 KIP0JC
      CHARACTER*8 KIP0JD
      CHARACTER*8 KIP0JR
      CHARACTER*8 KIP1JG
      CHARACTER*8 KIP1JK
      CHARACTER*8 KIP3JL
      CHARACTER*8 KDP3JL
      CHARACTER*8 KIP3JS
      CHARACTER*8 KNTRAC
      CHARACTER*8 KNTRACA
      CHARACTER*8 KNTRACN
      CHARACTER*8 KISULF
      CHARACTER*8 KNTSEM
      CHARACTER*8 KTENER
      CHARACTER*8 KIPID
      CHARACTER*8 KIVA
      CHARACTER*8 KIWRK
      CHARACTER*8 KIOZT
      CHARACTER*8 KIP0F
      CHARACTER*8 KNLATJM
      CHARACTER*8 KNENDJM
      CHARACTER*8 KIDM
      CHARACTER*8 KIDLM

C     THREE EXTRA VARIABLES FOR OPTIMIZED SL SCHEME
C
      CHARACTER*8 KNADVSL
      CHARACTER*8 KNTOTSL
      CHARACTER*8 KNLATJS
      CHARACTER*8 KNENDS
C
      CHARACTER*128 FILNAM

      DATA KR    /'      R='/
      DATA KL    /'      L='/
      DATA KLM1  /'    LM1='/
      DATA KL1   /'     L1='/
      DATA KL2   /'     L2='/
      DATA KL3   /'     L3='/
      DATA KL3J  /'    L3J='/
      DATA KS    /'      S='/
      DATA KNBS  /'    NBS='/
      DATA KNBL  /'    NBL='/
      DATA KC    /'      C='/
      DATA KC1   /'     C1='/
      DATA KG    /'      G='/
      DATA KG1   /'     G1='/
      DATA KG2   /'     G2='/
      DATA KD    /'      D='/
      DATA KI    /'      I='/
      DATA KIDBL /'   IDBL='/
      DATA KILATD/'  ILATD='/
      DATA KILGD /'   ILGD='/
      DATA KNLATD/' NLATJD='/
      DATA KNENDD/' NENDJD='/
      DATA KILGP /'    ILG='/
      DATA KNLATP/'  NLATJ='/
      DATA KNENDP/'  NENDJ='/

      DATA KIP0F /'   IP0F='/
      DATA KNLATJM/' NLATJM='/
      DATA KNENDJM/' NENDJM='/
      DATA KIDM   /'    IDM='/
      DATA KIDLM  /'   IDLM='/

      DATA KJ    /'      J='/
      DATA KIM1  /'    IM1='/
      DATA KM1   /'     M1='/
      DATA KRAM  /'    RAM='/
      DATA KP0   /'     P0='/
      DATA KP1   /'     P1='/
      DATA KP2   /'     P2='/
      DATA KP3   /'     P3='/
      DATA KIP0J /'   IP0J='/
      DATA KIP1J /'   IP1J='/
      DATA KIP2J /'   IP2J='/
      DATA KIP3J /'   IP3J='/
      DATA KRL   /'     RL='/
      DATA KRS   /'     RS='/
      DATA KIL   /'     IL='/
      DATA KIL1  /'    IL1='/
      DATA KIS   /'     IS='/
      DATA KDL   /'     DL='/
      DATA KDS   /'     DS='/
      DATA KLJ   /'     LJ='/
      DATA KL1J  /'    L1J='/
      DATA KNL   /'     NL='/
      DATA KLL   /'     LL='/
      DATA KGLL  /'    GLL='/
      DATA KIP0JL/'  IP0JL='/
      DATA KIP0JS/'  IP0JS='/
      DATA KIP0JC/'  IP0JC='/
      DATA KIP0JD/'  IP0JD='/
      DATA KIP0JR/'  IP0JR='/
      DATA KIP1JG/'  IP1JG='/
      DATA KIP1JK/'  IP1JK='/
      DATA KIP3JL/'  IP3JL='/
      DATA KDP3JL/'  DP3JL='/
      DATA KIP3JS/'  IP3JS='/
      DATA KNTRAC/'  NTRAC='/
      DATA KNTRACN/' NTRACN='/
      DATA KNTRACA/' NTRACA='/
      DATA KISULF/'  ISULF='/
      DATA KNTSEM/'  NTSEM='/
      DATA KTENER/'  TENER='/
      DATA KIPID /'   IPID='/
      DATA KIVA  /'    IVA='/
      DATA KIWRK /'   IWRK='/
      DATA KIOZT /' IOZTYP='/

C 
      DATA KNADVSL/' NADVSL='/
      DATA KNTOTSL/' NTOTSL='/
      DATA KNLATJS/' NLATJS='/
      DATA KNENDS /' NENDJS='/
C--------------------------------------------------------------------
      II=1
      CALL GETARG(II,FILNAM)
      OPEN(1,FILE=FILNAM)
      N=5
      READ(5,5010,END=901) ILEV,LEVS,ILGSLD,ILATD,LRLMT,NTRAC,ITRACA,           I4
     1                     IOZTYP,ISULF,MACHINE,NLATJD,IDBL                     I4
C
C     * READ SECOND CARD WITH REDUCED PHYSICS GRID SIZE AND NLATJ IF
C     * IDBL.NE.0).
C
      IF(IDBL.NE.0)                                             THEN
      READ(5,5020,END=902) ILGSL,ILAT,NLATJ                                     I4
      ENDIF

C
C     * DEFINE MULTIPLE-LATITUDE FORMULATION PARAMETERS.
C     * "NENDJ" REFERS TO THE RESULTING NUMBER OF ITTERATIONS IN THE
C     * LATITUDE LOOP FOR A GIVEN "NLATJ" (READ-IN).
C     * ENSURE NLATJ NON-ZERO TO AVOID FLOATING-POINT ERRORS (NLATJ=1
C     * SAME AS NLATJ=0).
C     * THE ABOVE APPLIES TO BOTH THE DYNAMICS (SUBSCRIPT "D") AND
C     * PHYSICS (SUBSCRIPT "P") GRIDS.
C
      NLATJD=MAX(NLATJD,1)
      IF(MOD(ILATD,NLATJD).EQ.0)                  THEN
         NENDJD=ILATD/NLATJD
      ELSE
         CALL                                      XIT('GCMPARF',-1)
      ENDIF
C
      IF(IDBL.NE.0)                                       THEN
        NLATJ=MAX(NLATJ,1)
        IF(MOD(ILAT,NLATJ).EQ.0)                  THEN
          NENDJ=ILAT/NLATJ
        ELSE
          CALL                                     XIT('GCMPARF',-2)
        ENDIF
      ELSE
C
C       * ABORT SINCE NO LONGER SINGLE-TRANSFORM IN MODEL.
C
        CALL                                       XIT('GCMPARF',-3)
      ENDIF
C
C     * IF(IDBL.EQ.0), SET VALUES FOR PHYSICS GRID TO THOSE OF THE
C     * DYNAMICS (TRANSFORM) GRID.
C
      IF(IDBL.EQ.0)                               THEN
        ILGSL=ILGSLD
        ILAT=ILATD
        NLATJ=NLATJD
        NENDJ=NENDJD
      ENDIF
C
C     * FORCE ALL INTERNAL PACKING DENSITIES TO ZERO. THIS IS DONE IN
C     * CONJUNCTION WITH THE CHANGE OVER TO SAVING ONE GRID PER RECORD
C     * INSTEAD OF ONE LATITUDE ROW PER RECORD IN THE RESTART FILE.
C     * PACKING DENSITIES ARE STILL READ IN FROM THE INPUT CARD TO
C     * MAINTAIN UPWARD COMPATIBLITY WITH MODEL SUBMISSION JOBS.
C
      NPGG=0
      NPPS=0
      NPSF=0
      NPVG=0
C====================================================================
C     * TRACERS (TOTA,ADVECTED,NON-ADVECTED).
C     * DETERMINE TYPE OF ADVECTION SCHEME BASED ON SIGN OF ITRACA.
C
      CALL ITPARM(IP,N,NTRAC)
      WRITE(1,1010) KNTRAC  ,IP
C
      NTRACA=MAX(ITRACA,0)
      IF(ITRACA.GT.0)       THEN
        NTRACN=NTRAC-NTRACA
      ELSE
        NTRACN=0
      ENDIF
      CALL ITPARM(IP,N,NTRACA)
      WRITE(1,1010) KNTRACA ,IP
      CALL ITPARM(IP,N,NTRACN)
      WRITE(1,1010) KNTRACN ,IP
C
      IF(ITRACA.LT.0)    THEN
        IDEFSL=1
      ELSE
        IDEFSL=0
      ENDIF
C====================================================================
C     * ADDED SECTION FOR SULFUR CYCLE.
C     * ABORT IF VALUES OF ISULF NOT PERMITTED ONES.
C     * CALCULATE NTSEM BASED ON ISULF.
C
      IF(ISULF.NE.1 .AND.ISULF.NE.0)   CALL        XIT('GCMPARF',-4)
C
      IF(ISULF.EQ.0) THEN
        NTSEM=ILEV
      ELSE
        NTSEM=6*ILEV+7
      ENDIF   
C
      CALL ITPARM(IP,N,ISULF)
      WRITE(1,1010) KISULF  ,IP
      CALL ITPARM(IP,N,NTSEM)
      WRITE(1,1010) KNTSEM,IP
C====================================================================
C
      NLATJS=NLATJ
      NENDJS=ILAT/NLATJS
C
C     * FOR NEW OPTIMIZED VERSION OF SEMILAG SCHEME (SMILAG3) THE WORK
C     * ARRAYS DEPEND ON THE NUMBER OF ADVECTED FIELDS NADVSL WHICH
C     * INCLUDES MOISTURE.  SINCE THERE IS NO INFORMATION REGARDING
C     * THE ADVECTION OF MOISTURE AT THIS POINT IN THE CODE, WE
C     * MUST ASSUME LAGRANGIAN ADVECTION OF WATER SO THAT NADV=1+NTRAC.
C
      NADVSL=1+NTRAC
C
C     * NTOTSL IS USED TO DETEMINE THE LEADING DIMENSION OF WORK 
C     * ARRAYS THAT ARE SHARED IN THE NEW SCHEME.
C
      NTOTSL=MAX(3,NADVSL)
C
C     * SPECIFICATION OF WORK SPACE FOR SMILAG3 NEEDS TO KNOW IF THE
C     * PRIESTLEY MASS FIXER IS TO BE CALLED.  THIS IS NOT KNOWN HERE
C     * SO WE ASSUME THAT IT IS TO BE CALLED IN CALCULATING THE AMOUNT
C     * OF WORK SPACE.

C     * NLGD,NLATW,NLEVW - LONGITUDE,LATITUDE,HEIGHT DIMENSIONS OF
C     * NEW SEMILAG WORK ARRAYS.

      NLATW=NLATJS+4
      NLEVW=ILEV+4
      NLGW=ILGSL+2

      WRITE(6,6010) ILEV,LEVS,ILGSLD,ILATD,LRLMT,NTRAC,ITRACA,
     1              MACHINE,NLATJD,IDBL
      WRITE(6,6020) ILGSL,ILAT,ISULF,IOZTYP,NLATJ
      WRITE(6,6030) NADVSL,NTOTSL,NLATJS
C-----------------------------------------------------------------------
      CALL ITPARM(IP,N,IDBL)
      WRITE(1,1010) KIDBL  ,IP
      CALL ITPARM(IP,N,NLATJ)
      WRITE(1,1010) KNLATP ,IP
      CALL ITPARM(IP,N,NENDJ)
      WRITE(1,1010) KNENDP ,IP
      CALL ITPARM(IP,N,NENDJS)
      WRITE(1,1010) KNENDS ,IP
      CALL ITPARM(IP,N,ILGSL)
      WRITE(1,1010) KILGP  ,IP
      CALL ITPARM(IP,N,NLATJD)
      WRITE(1,1010) KNLATD ,IP
      CALL ITPARM(IP,N,NENDJD)
      WRITE(1,1010) KNENDD ,IP
      CALL ITPARM(IP,N,ILGSLD)
      WRITE(1,1010) KILGD   ,IP
C
      IF(IOZTYP.LT.1.OR.IOZTYP.GT.2) CALL          XIT('GCMPARF',-5)
      CALL ITPARM(IP,N,IOZTYP)
      WRITE(1,1010) KIOZT   ,IP

      NENDJM = MAX (NENDJ,    NENDJD,   NENDJS)
      CALL ITPARM(IP,N,NENDJM)
      WRITE(1,1010) KNENDJM ,IP

      NLATJM = MAX (NLATJ,    NLATJD)
      CALL ITPARM(IP,N,NLATJM)
      WRITE(1,1010) KNLATJM ,IP

C     * "ILG" IS SIZE USED FOR ROW GRIDS IN USUAL MANNER. IT IS AUGMENTED
C     * BY ONE TO MINIMIZE MEMORY BANK CONFLICTS. 
C
      ILG=ILGSL*NLATJ+1
      ILGD=ILGSLD*NLATJD+1

C===  IF(ILGD.LT.ILG) CALL                         XIT('GCMPARF',-6)

      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)

      CALL ITPARM(IP,N,ILEV)
      WRITE(1,1010) KL   ,IP
      CALL ITPARM(IP,N,LEVS)
      WRITE(1,1010) KS   ,IP

      CALL ITPARM(IP,N,ILEV-1)
      WRITE(1,1010) KLM1 ,IP
      CALL ITPARM(IP,N,ILEV+1)
      WRITE(1,1010) KL1  ,IP
      CALL ITPARM(IP,N,ILEV+2)
      WRITE(1,1010) KL2  ,IP
C
      IF(IOZTYP.EQ.1)          THEN
         LEVOZ=37
      ELSE
         LEVOZ=59
      ENDIF
      CALL ITPARM(IP,N,LEVOZ)
      WRITE(1,1010) KL3  ,IP
      CALL ITPARM(IP,N,LEVOZ*ILAT)
      WRITE(1,1010) KL3J ,IP
C
      CALL ITPARM(IP,N,ILEV*ILEV)
      WRITE(1,1010) KLL  ,IP

      CALL ITPARM(IP,N,LA)
      WRITE(1,1010) KR   ,IP

      CALL ITPARM(IP,N,ILGD)
      WRITE(1,1010) KD   ,IP
      CALL ITPARM(IP,N,ILG)
      WRITE(1,1010) KI   ,IP

      IDM    = MAX (ILG,      ILGD)
      CALL ITPARM(IP,N,IDM)
      WRITE(1,1010) KIDM  ,IP

      CALL ITPARM(IP,N,ILGSL-1)
      WRITE(1,1010) KIM1 ,IP

      CALL ITPARM(IP,N,ILAT)
      WRITE(1,1010) KJ   ,IP
      CALL ITPARM(IP,N,ILEV*ILAT)
      WRITE(1,1010) KLJ  ,IP
      CALL ITPARM(IP,N,(ILEV+1)*ILAT)
      WRITE(1,1010) KL1J ,IP
      CALL ITPARM(IP,N,ILATD)
      WRITE(1,1010) KILATD   ,IP

      CALL ITPARM(IP,N,LM+1)
      WRITE(1,1010) KM1  ,IP
      NSTAR=LR
      IF(KTR.EQ.0) NSTAR=LR*2
      CALL ITPARM(IP,N,NSTAR*ILEV)
      WRITE(1,1010) KNL  ,IP
      CALL ITPARM(IP,N,LA+LM)
      WRITE(1,1010) KRAM ,IP

      CALL ITPARM(IP,N,NPVG)
      WRITE(1,1010) KP0  ,IP
      CALL ITPARM(IP,N,NPPS)
      WRITE(1,1010) KP1  ,IP
      CALL ITPARM(IP,N,NPSF)
      WRITE(1,1010) KP2  ,IP
      CALL ITPARM(IP,N,NPGG)
      WRITE(1,1010) KP3  ,IP

      CALL ITPARM(IP,N,ILG*NENDJ)
      WRITE(1,1010) KIP0J,IP

      KK=LENPAK(ILG,NENDJ,NPPS)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP1J,IP

      KK=LENPAK(ILG,NENDJ,NPSF)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP2J,IP

      KK=LENPAK(ILG,NENDJ,NPGG)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP3J,IP
C
C     * PARAMETERS FOR NEW RADIATION SCHEME.
C
      NBS=4
      NBL=9
      CALL ITPARM(IP,N,NBS)
      WRITE(1,1010) KNBS ,IP
      CALL ITPARM(IP,N,NBL)
      WRITE(1,1010) KNBL ,IP
      KK=ILG*NENDJ*NBS
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP0JR,IP
C
C     * PARAMETERS FOR NEW (IHYD=2) LAND SURFACE SCHEME.
C
      ICAN=4
      IGND=3
      CALL ITPARM(IP,N,ICAN)
      WRITE(1,1010) KC   ,IP
      CALL ITPARM(IP,N,ICAN+1)
      WRITE(1,1010) KC1  ,IP
      CALL ITPARM(IP,N,IGND)
      WRITE(1,1010) KG   ,IP
      CALL ITPARM(IP,N,IGND+1)
      WRITE(1,1010) KG1  ,IP
      CALL ITPARM(IP,N,IGND+2)
      WRITE(1,1010) KG2  ,IP

      KK=LENPAK(ILG,NENDJ*IGND,NPPS)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP1JG,IP
      KK=ILG*NENDJ*ICAN
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP0JC,IP
      KK=ILG*NENDJ*(ICAN+1)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP0JD,IP
C
C     * PARAMETERS FOR "N" TRACERS.
C
      CALL ITPARM(IP,N,7+NTRAC)
      WRITE(1,1010)KTENER,IP
C
C     * SEVEN SIGNIFICANT DIGITS ARE ALLOCATED FOR THE FOLLOWING
C     * PARAMETERS, SINCE THEY CAN BE QUITE LARGE. ONE SHOULD NOT USE
C     * N=NLONG=7 IN THE ABOVE CALCULATIONS BECAUSE SOME RESULTING
C     * LINES AFTER PARMSUB WILL EXTEND PAST 72 CHARACTERS.
C     * IN ANY EVENT, THE ABOVE-CALCULATED VALUES WILL NOT RANGE BEYOND
C     * A VALUE OF 99999 FOR MODEL RESOLUTIONS SMALLER THAN T60L20.
C
      NLONG=7

      CALL ITPARM(IPLONG,NLONG,ILG*ILEV)
      WRITE(1,1015) KIL  ,IPLONG
      CALL ITPARM(IPLONG,NLONG,ILG*LEVS)
      WRITE(1,1015) KIS   ,IPLONG
      CALL ITPARM(IPLONG,NLONG,ILGD*ILEV)
      WRITE(1,1015) KDL  ,IPLONG
      CALL ITPARM(IPLONG,NLONG,ILGD*LEVS)
      WRITE(1,1015) KDS  ,IPLONG

      IDLM   = MAX (ILG*ILEV, ILGD*ILEV)
      CALL ITPARM(IPLONG,NLONG,IDLM)
      WRITE(1,1015) KIDLM  ,IPLONG

      CALL ITPARM(IPLONG,NLONG,ILG*(ILEV+1))
      WRITE(1,1015) KIL1 ,IPLONG

      KK=MAX(ILGD*NENDJD,((ILEV+2)**2)*ILATD)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015) KGLL,IPLONG
C
      CALL ITPARM(IPLONG,NLONG,LA*ILEV)
      WRITE(1,1015) KRL  ,IPLONG

      CALL ITPARM(IPLONG,NLONG,LA*LEVS)
      WRITE(1,1015) KRS  ,IPLONG
C
      KK=ILG*NENDJ*ILEV
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP0JL,IPLONG

      KK=ILG*NENDJ*LEVS
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP0JS,IPLONG
C
      KK=LENPAK(ILG,NENDJ*(ILEV+1),NPPS)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP1JK,IPLONG

      KK=LENPAK(ILG,NENDJ*ILEV,NPGG)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP3JL,IPLONG

      KK=LENPAK(ILGD,NENDJD*ILEV,NPGG)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KDP3JL,IPLONG

      KK=LENPAK(ILG,NENDJ*LEVS,NPGG)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP3JS,IPLONG
C
C     * NINE SIGNIFICANT DIGITS ARE ALLOCATED FOR THE FOLLOWING
C     * PARAMETERS, SINCE THEY CAN BE QUITE LARGE. THESE ARE
C     * USED FOR IVA (THE SIZE OF THE WORK ARRAY "VA"), IPID (THE
C     * SIZE OF THE WORK ARRAY "SC") AND IWRK (THE SIZE OF THE WORK
C     * ARRAY "WRK").
C
      NVLONG=9
      MAXLEN=999999999
C     * --------------------------------------------------------------
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINES CALLED
C     * BY DEEP CONVECTION.

      NBF=10
      NEQP=13
      IC = ILG*(48*ILEV+9*ILEV*NBF+8*ILEV*NTRAC+ILEV*NEQP+34+NTRAC)+1

C     * CALCULATE SIZE OF TOTAL WORK SPACE REQUIRED BY SUBROUTINE CLASS.

      IG = ILG*(23*IGND+4*(ICAN+1)+4*ICAN+NBS+179)+1

C     * CALCULATE THE SIZE OF THE WORK SPACE REQUIRED BY PORTION OF NEW 
C     * SCHEME
C
      IPS=NTOTSL*NLGW+3*NLGW*NLATW*NLEVW+2*NLGW*NLATW*NLEVW*NADVSL+
     1     3*NLGW*NLATW*ILEV+2*NLATW+2*NTOTSL*NLGW+3*NLGW*NLATW+
     2     4*NTOTSL*NLGW*2*2*2+20*NTOTSL*NLGW+3*NLGW*NTOTSL+
     3     5*NLGW*NLATW*NLEVW*NTOTSL

      WRITE(6,*) "IPS= ",IPS

C     * FIND MAXIMUM SIZE FOR DIMENSIONING WORK ARRAY VA.

      IVA = MAX(IC,IG,IPS)
      IF(IVA.GT.MAXLEN) CALL                       XIT('GCMPARF',-7)
C
C     CHECK TO SEE IF IVA SET BY NEW SEMILAG REQUIREMENTS.
C
      IF(IVA.EQ.IPS) THEN
         WRITE(6,*) "IVA IS SET BY SPACE REQUIRED BY SEMILAG3 SCHEME"
         WRITE(6,*) "IVA, IPS= ",IVA,IPS
         WRITE(6,*) "SPACE MY BE SAVED BY REDUCING NLATJS"
      ENDIF

      CALL ITPARM(IPVLONG,NVLONG,IVA)
      WRITE(1,1018) KIVA,IPVLONG
C     * --------------------------------------------------------------
C     * DETERMINE SIZE FOR PHYSICS ROUTINES WORK ARRAY "WRK".
C     * THE SPACE DEFINED BY IWRK REPRESENTS THE WORK SPACE PASSED TO
C     * THE ARRAY "WRK" IN PHYSICS, USED FOR ARRAYS IN SUBROUTINE
C     * CONV7 AND RADDRIV WHICH ARE NOT EXCHANGED WITH PHYSICS. ITS SPACE IS
C     * PARTITIONED USING THE POINTERS ID1,ID2,.. OR IR1,IR2,.... THESE ARE
C     * DEFINED IN THE SUBROUTINE POINT13.
C     * THE LARGEST SPACE AS REQUIRED BY RADIATION (IWRKR) AND
C     * DEEP CONVECTION (IWRKC) IS CHOSEN.

      NTRACNC=4
      IWRKC=ILG*(NTRACNC*ILEV+53*ILEV+7*ILEV*NTRAC+2*NTRAC+38)+NTRAC
      IWRKR=ILG*(4*ILEV*NBS + ILEV*NBL + 88*ILEV + 65)+2*ILEV
      IWRK=MAX(IWRKC,IWRKR)+1
      IF(IWRK.GT.MAXLEN) CALL                      XIT('GCMPARF',-8)
C
      CALL ITPARM(IPVLONG,NVLONG,IWRK)
      WRITE(1,1018)KIWRK,IPVLONG
C     * --------------------------------------------------------------
C     * THE WORK SPACE OF SIZE "IPID" IS USED IN SEVERAL AREAS OF THE
C     * MODEL: PHYSICS (ILENPHS), DYNAMICS (ILENDYN), MHEXP7 (ILENMHE),
C     * MHANL7 (ILENMHA), SEMILAG (ILENSL), RESTART (ILENRST) AND
C     * COMMON BLOCK ICOM (ROUTINES GETZON6,GETSPE,GETAGB, ETC.).
C     * THIS ICOM SPACE MUST BE AT LEAST 20008, SINCE THAT IS
C     * WHAT IS HARD-CODED IN THE VARIOUS SUBROUTINES AND THE MAIN
C     * DIMENSIONING OF THE COMMON BLOCK MUST BE GREATER OR EQUAL TO
C     * THE ASSOCIATED DIMENSIONING IN THE CALLED SUBROUTINES.
C     * THE LARGEST OF THESE IS CHOSEN.
C
      ILENPHS=ILG*((3*NBS+3*NBL+34+NTRAC)*ILEV+43+2*NTRAC)+
     1        IWRK
      ILENDYN=ILGD*(3*ILEV+3)+ILEV*(4*LA+2*ILEV+4)+LEVS+2*LA
C
C     * FOR MULTIPLE-LATITUDES, WORK SPACE IS REQUIRED FOR SWAPPING
C     * DATA FOR MAXIMUM EFFICIENCY.
C     * THE FACTOR OF TWO IS THE EXPRESSION FOR "IVALTR" STEMS FROM
C     * THE FACT THAT THE WORK SPACE INTERNAL TO THESE ROUTINES
C     * REFLECTS OPERATIONS ON COMPLEX VARIABLES.
C
      NILH=ILGSL/2
      NILHD=ILGSLD/2
      NLEV1E=3*ILEV+LEVS+NTRACA*ILEV+1
      NLEV2E=2*ILEV+1
      NLEV3E=2*ILEV
      NLEVE=NLEV1E+NLEV2E+1
      NLEV1A=3*ILEV+LEVS+NTRACA*ILEV+2
      NLEV2A=3*ILEV+LEVS+NTRACA*ILEV
      NLEV3A=2*ILEV+LEVS+NTRACA*ILEV
      NLEV4A=2*ILEV
      ILENMHE=NILHD*NLATJD*(2*NLEVE+NLEV2E+NLEV3E) +
     1        LA*(NLEV1E+NLEV3E) + 2*NLEV1E*(LA+1)
      ILENMHA=NILHD*NLATJD*(NLEVE+NLEV1A+NLEV2A+NLEV3A+NLEV4A) +
     1        LA*(NLEV1A+NLEV4A) + 2*NLEV1A*(LA+1)
      IVALTR=2*MAX(ILENMHE,ILENMHA)

      
C      ILENSL=NTOTSL*NLGW+3*NLGW*NLATW*NLEVW+2*NLGW*NLATW*NLEVW*NADVSL+
C     1     3*NLGW*NLATW*ILEV+2*NLATW+2*NTOTSL*NLGW+3*NLGW*NLATW+
C     2     4*NTOTSL*NLGW*2*2*2+20*NTOTSL*NLGW+3*NLGW*NTOTSL+
C     3     5*NLGW*NLATW*NLEVW*NTOTSL
      ILENSL=2*NADVSL*(ILGSL+1)*(ILAT+4)*ILEV+
     1       (ILGSL+1)*(ILAT+4)*ILEV

      WRITE(6,*) "ILENSL= ",ILENSL

C     * SPACE FOR RSTART.

      ILENRST=ILEV*2
C
      NGRID=ILGSLD*ILATD
      NSIZE=MAX(NGRID,2*LA)
      ILENBUF=MAX(NSIZE,20000) + 8

      CALL ITPARM(IPVLONG,NVLONG,ILENBUF)
      WRITE(1,1018) KIP0F,IPVLONG

      IPIDTMP=MAX(ILENPHS,ILENDYN,ILENRST)
      IPIDTEM=MAX(IVALTR,ILENSL)
      IPID=MAX(IPIDTMP,IPIDTEM) + 1
      IF(IPID.GT.MAXLEN) CALL                      XIT('GCMPARF',-9)

C
C     CHECK TO SEE IF IPID SET BY NEW SEMILAG REQUIREMENTS.
C
      IF(IPID.EQ.ILENSL+1) THEN
         WRITE(6,*) "IPID IS SET BY SPACE REQUIRED BY SEMILAG3 SCHEME"
         WRITE(6,*) "IPID, ILENSL= ",IPID,ILENSL
         WRITE(6,*) "SPACE MY BE SAVED BY REDUCING NLATJS"
      ENDIF

      CALL ITPARM(IPVLONG,NVLONG,IPID)
      WRITE(1,1018) KIPID,IPVLONG
C
C     SEMILAG PARAMETERS
      CALL ITPARM(IPVLONG,NVLONG,NADVSL)
      WRITE(1,1018) KNADVSL,IPVLONG
      CALL ITPARM(IPVLONG,NVLONG,NTOTSL)
      WRITE(1,1018) KNTOTSL,IPVLONG
      CALL ITPARM(IPVLONG,NVLONG,NLATJS)
      WRITE(1,1018) KNLATJS,IPVLONG

C     * --------------------------------------------------------------
C     * NOTE THAT FOR THIS VERSION ONWARD, ITRAC.NE.0 ALWAYS, SO
C     * $COM$="     "!
C
      WRITE(1,1025)
C
C     * DISTINGUISH IN CODE BETWEEN S/L AND SPECTRAL ADVECTION.
C 
      IF(IDEFSL.EQ.0) THEN
        WRITE(1,1030)
        WRITE(1,1045)
      ELSE
        WRITE(1,1035)
        WRITE(1,1040)
      ENDIF
C
C     * CONTROL IN CODE WHERE COMPONENTS EXPLICITLY RELATED TO
C     * SULFUR CYCLE ARE HANDLED.
C
      IF(ISULF.EQ.0) THEN
        WRITE(1,1050)
      ELSE
        WRITE(1,1055)
      ENDIF
C
C     * CONTROL IN CODE WHERE COMPONENTS EXPLICITLY RELATED TO
C     * EXISTENCE OF NON-ADVECTED TRACERS IN SPECTRAL MODE.
C
      IF(ITRACA.LE.0 .OR. NTRACN.EQ.0) THEN
        WRITE(1,1060)
      ELSE
        WRITE(1,1065)
      ENDIF

C     * NORMAL TERMINATION.

      STOP

C     * E.O.F. ON INPUT.

  901 CALL                                         XIT('GCMPARF',-10)
  902 CALL                                         XIT('GCMPARF',-11)

C--------------------------------------------------------------------
 1010 FORMAT(A8,6A1)
 1015 FORMAT(A8,8A1)
 1018 FORMAT(A8,10A1)
 1020 FORMAT('    COM=','C ***,')
 1025 FORMAT('    COM=','     ,')
 1030 FORMAT('    CSL=','C ***,')
 1035 FORMAT('    CSL=','     ,')
 1040 FORMAT('    CSP=','C ***,')
 1045 FORMAT('    CSP=','     ,')
 1050 FORMAT('    CSC=','C ***,')
 1055 FORMAT('    CSC=','     ,')
 1060 FORMAT('    CSN=','C ***,')
 1065 FORMAT('    CSN=','     ,')
 5010 FORMAT(10X,4I5,I10,6I5,I2)                                                I4
 5020 FORMAT(20X,2I5,35X,I5)                                                    I4
 6010 FORMAT('0',4I6,I12,5I6)
 6020 FORMAT('0',12X,2I6,42X,3I6)
 6030 FORMAT('0',12X,3I6)
      END
