      PROGRAM GCMPARE
C     PROGRAM GCMPARE (PARAMS,       INPUT,       OUTPUT,               )       I2
C    1           TAPE1=PARAMS, TAPE5=INPUT, TAPE6=OUTPUT)
C     ---------------------------------------------------                       I2
C
C     JUL 03/2003 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)     I2
C     JUN 14/2002 - M. LAZARE (REVISE CALCULATED SIZE IN "IG" OF THE TOTAL WORK I2
C                              SPACE REQUIRED BY SUBROUTINE CLASS)              I2
C     MAY 22/2002 - M.LAZARE/  - HARD-CODE IN CARBON,SEASALT,DUST TRACERS TO    
C                 K.VONSALZEN    CALCULATE TOTAL NUMBER OF TRACERS (NTRAC).     
C                              - REVISE INTERNAL DEEP CONVECTION POINTERS       
C                                (ICD) FOR CHANGES TO PRECIPITATING SHALLOW.    
C     SEP 26/2001 - M. LAZARE (REVISE WORKSPACE FOR CONV (FOR SHALLOW/CLOSURE)
C     AUG 08/2000 - M. LAZARE (REMOVE "ILAT AND ILEV NOT 'TRADITIONAL'" ABORT    
C                              CHECK)                                            
C     SEP 26/2001 - M. LAZARE (REVISE WORKSPACE FOR CONV (FOR SHALLOW/CLOSURE)  
C     MAY 31/2001 - M. LAZARE (REDUCE THE SIZES COMPUTED IN "IC" AND "IWRKC"    
C                              WHICH ARE ASSOCIATED WITH THE DEEP CONVECTION.   
C     DEC 22/2000 - M. LAZARE (ADD WORKSPACE FOR CONV (FOR NEW SHALLOW/CLOSURE) 
C     AUG 08/2000 - M. LAZARE (REMOVE "ILAT AND ILEV NOT 'TRADITIONAL'" ABORT   
C                              CHECK)                                          
C     JAN 14/2000 - M. LAZARE (ADD WORK SPACE AND READ/WRITE FOR                
C                              PROGNOSTIC CLOUDS/SULFUR CYCLE:                  
C                              - ISULFR READ IN INSTEAD OF NINTSW.              
C                              - NSULF={4,0} FOR ABS(ISULF)={4,1}.              
C                              - THEN SET IDEFSL SWITCH TO BE {0,1}             
C                                DEPENDING ON SIGN OF ISULF, AND USE            
C                                THIS TO CONTROL "CSP" OR "CSL" SECTION         
C                                AT END, AND SET ISULF TO BE {1,0} FOR          
C                                ABS(ISULFR)={4,1}.                             
C                              - USE VALUE OF ISULF TO SET A NEW                
C                                PARMSUB PARAMETER "CSC", TO COMMENT            
C                                OUT SULFUR CYCLE COMPONENTS IF ISULF=0.        
C                              - CALCULATE NTSEM BASED ON CHOICE OF ISULF.      
C                              - READ IN NUMBER OF GENERAL PASSIVE TRACERS      
C                                AS ITRACG INSTEAD OF ITRAC AND CALCULATE       
C                                NTRAC=NTRACG+NPROGC+NSULF (NPROGC=4).          
C                              - WRITE OUT: NTRAC,NTRACG,NSULF,NPROGC,NTSEM     
C                                AND ISULF.)
C
C     OCT 12/2001 - M. LAZARE  PREVIOUS VERSION GCMPRDA FOR GCM13A.          
C
CGCMPARE - COMPUTES ARRAY DIMENSIONS FOR GCM14                          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-14.                                                          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         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      NOTE - ANY OF THE ABOVE MAY BE SET TO A VALUE GREATER THAN OR            I5
C             EQUAL TO THE REQUIRED SIZE.                                       I5
C      ISULFR= SULFUR CYCLE/ADVECTION SCHEME INDICATOR. THE ONLY ALLOWED        I5
C              CHOICES ARE: ABS(ISULFR)={4,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. THE SIGN CONTROLS S/L OR SPECTRAL ADVECTION            I5
C              (NEGATIVE OR POSITIVE VALUES, RESPECTIVELY).                     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      ITRACG= OPTIONAL SWITCH TO INCLUDE PASSIVE TRACER IN MODEL (IF NOT       I5
C              USED, THEN GCMPARM COMMENTS OUT DIMENSION STATEMENTS FOR         I5
C              TRACER-RELATED ARRAYS).                                          I5
C                                                                               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         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* GCMPARE   22   22  146   72     48482    4    2    0    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 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 KIP1JG
      CHARACTER*8 KIP1JK
      CHARACTER*8 KIP3JL
      CHARACTER*8 KDP3JL
      CHARACTER*8 KIP3JS
      CHARACTER*8 KNTRAC
      CHARACTER*8 KNTRACG
      CHARACTER*8 KNPROGC
      CHARACTER*8 KISULF
      CHARACTER*8 KNSULF
      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 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 KIP1JG/'  IP1JG='/
      DATA KIP1JK/'  IP1JK='/
      DATA KIP3JL/'  IP3JL='/
      DATA KDP3JL/'  DP3JL='/
      DATA KIP3JS/'  IP3JS='/
      DATA KNTRAC/'  NTRAC='/
      DATA KNTRACG/' NTRACG='/
      DATA KNPROGC/' NPROGC='/
      DATA KISULF/'  ISULF='/
      DATA KNSULF/'  NSULF='/
      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,ISULFR,IOZTYP,          I4
     1                                        ITRACG,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('GCMPARE',-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('GCMPARE',-2)
        ENDIF
      ELSE
C
C       * ABORT SINCE NO LONGER SINGLE-TRANSFORM IN MODEL.
C
        CALL                                       XIT('GCMPARE',-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     * ADDED SECTION FOR PROGNOSTIC CLOUDS/SULFUR CYCLE.
C
C     * ABORT IF VALUES OF ISULFR NOT PERMITTED ONES.
C
      IASULF=ABS(ISULFR)
      IF(IASULF.NE.1 .AND.IASULF.NE.4)   CALL      XIT('GCMPARE',-4)
C
C     * DETERMINE TYPE OF ADVECTION SCHEME BASED ON SIGN OF ISULFR.
C
      IF(ISULFR.LT.0)    THEN
        IDEFSL=1
      ELSE
        IDEFSL=0
      ENDIF
C
C     * CALCULATE NSULF,NTSEM BASED ON ISULFR.
C
      IF(IASULF.EQ.1) THEN
        NSULF=0
        ISULF=0
        NTSEM=ILEV
      ELSE
        NSULF=4
        ISULF=1
        NTSEM=6*ILEV+7
      ENDIF   
C
      CALL ITPARM(IP,N,ISULF)
      WRITE(1,1010) KISULF  ,IP
      CALL ITPARM(IP,N,NSULF)
      WRITE(1,1010) KNSULF  ,IP
      CALL ITPARM(IP,N,NTSEM)
      WRITE(1,1010) KNTSEM,IP
C
C     * ABORT IF ADVECTION SCHEME (SPECTRAL OR S/L) NOT CONSISTENT
C     * BETWEEN PROGNOSTIC CLOUDS AND GENERAL TRACERS.
C
      IF((ITRACG.LT.0 .AND. IDEFSL.EQ.0) .OR. (ITRACG.GT.0 .AND.
     1    IDEFSL.EQ.1)) CALL                       XIT('GCMPARE',-5)
C
C     * DETERMINE TOTAL NUMBER OF TRACERS.
C 
      NPROGC=4
      NCARB=4
      NDUST=2
      NSALT=2
      NTRACG=ABS(ITRACG)
      NTRAC=NTRACG+NPROGC+NCARB+NDUST+NSALT+NSULF
C
      CALL ITPARM(IP,N,NPROGC)
      WRITE(1,1010) KNPROGC ,IP
      CALL ITPARM(IP,N,NTRACG)
      WRITE(1,1010) KNTRACG ,IP
      CALL ITPARM(IP,N,NTRAC)
      WRITE(1,1010) KNTRAC  ,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,NPGG,NPSF,NPPS,
     1              ITRACG,MACHINE,NLATJD,IDBL
      WRITE(6,6020) ILGSL,ILAT,ISULFR,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('GCMPARE',-6)
      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('GCMPARE',-7)

      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 (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     * RADIATION PARAMETERS (SEE VALUES IN SUBROUTINE RADNEW7).
C     * IVA REPRESENTS THE SIZE OF THE WORK FIELDS ONLY USED IN THE
C     * LONGWAVE ROUTINE. THIS WORK SPACE IS ALSO USED FOR FIELDS ONLY
C     * CONTAINED IN THE SHORTWAVE ROUTINE, THE DEEP CONVECTION SCHEME
C     * AND CLASS, BUT THIS LATTER SPACE IS WELL "HIDDEN" WITHIN THE
C     * SPACE REQUIRED FOR THE LONGWAVE ROUTINES. DIFFERENT POINTERS
C     * IRL, IRS AND ICD ARE USED TO PARTITION THIS SPACE WITHIN THE
C     * LONGWAVE, SHORTWAVE AND DEEP CONVECTION ROUTINES, RESPECTIVELY.
C     * THESE ARE DEFINED IN THE SUBROUTINE POINTP9.
C     * THIS WORKSPACE IS ALSO USED BY THE CLASS SUBROUTINE BUT IS
C     * PARTITIONED IN THE DECLARATION STATEMENT DIRECTLY (CLASS IS IN
C     * LSMOD).
C
      NINT=6
      NG1=2
      NTR=11
      NG1P1=NG1+1
      NUA=31
      NU2=8
      MP=11
      MP2=2*MP
      NTRA=21
      KMX=ILEV+1
      KMXP=KMX+1
      NGLP1=KMX*NG1P1+1
      IWV=125

C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINE LONGWV3.

      IL1 = ILG*NGLP1*2*NUA
      IL2 = (ILG*KMXP*KMXP)*4
      IL3 = (ILG*NINT*KMX)*3
      IL4 = ILG*(KMX+10*KMXP+3*NINT+3*NTRA+2*NGLP1+NUA+24)

      IL  = IL1+IL2+IL3+IL4+1

C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINE SHORTW6.

      NSWGAS=3
      NINTSW=4  
      IS = ILG*(5*NSWGAS*KMXP+4*NINTSW*KMXP+3*NSWGAS+4*(NSWGAS-1)+
     1          NINTSW+20*KMXP+20*KMX+2*IWV+23)+(NSWGAS-1)+1

C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINES CALLED
C     * BY DEEP CONVECTION.

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

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

      IG = ILG*(23*IGND+4*(ICAN+1)+4*ICAN+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.

      ICS = MAX(IC,IS)
      IGL = MAX(IG,IL)
      IVA = MAX(ICS,IGL,IPS)
      PRINT *, '0IC,IS,IG,IL,IPS = ',IC,IS,IG,IL,IPS
      IF(IVA.GT.MAXLEN) CALL                       XIT('GCMPARE',-8)
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 RADNEW7 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 POINT12.
C     * THE LARGEST SPACE AS REQUIRED BY RADIATION (IWRKR) AND
C     * DEEP CONVECTION (IWRKC) IS CHOSEN.

      NTRACA=4
      IWRKC=ILG*(NTRACA*ILEV+51*ILEV+7*ILEV*NTRAC+NTRAC+39)+NTRAC
      IWRKR=ILG*(KMXP*KMXP + 14*KMXP + 38*KMX + 36)
     1       + (NINTSW-2)*(7*ILG*KMX+ILG)+1
      IWRK=MAX(IWRKC,IWRKR)+1
      IF(IWRK.GT.MAXLEN) CALL                      XIT('GCMPARE',-9)
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
      ICLD=ILG*(ILEV+2)*(ILEV+2)
      ILENPHS=ILG*((3*NINTSW+34+NTRAC)*ILEV+3*NINTSW+41+2*NTRAC)+
     1        ICLD+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+NTRAC*ILEV+1
      NLEV2E=2*ILEV+1
      NLEV3E=2*ILEV
      NLEVE=NLEV1E+NLEV2E+1
      NLEV1A=3*ILEV+LEVS+NTRAC*ILEV+2
      NLEV2A=3*ILEV+LEVS+NTRAC*ILEV
      NLEV3A=2*ILEV+LEVS+NTRAC*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('GCMPARE',-10)
       PRINT *, '0ILENMHE,ILENMHA,IWRKC,IWRKR = ',2*ILENMHE,2*ILENMHA,
     1            IWRKC,IWRKR
       PRINT *, '0ILENPHS,ILENDYN,ILENRST,ILENSL,IVALTR = ',
     1            ILENPHS,ILENDYN,ILENRST,ILENSL,IVALTR
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     * NORMAL TERMINATION.

      STOP

C     * E.O.F. ON INPUT.

  901 CALL                                         XIT('GCMPARE',-11)
  902 CALL                                         XIT('GCMPARE',-12)

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=','     ,')
 5010 FORMAT(10X,4I5,I10,5I5,I2)                                                I4
 5020 FORMAT(20X,2I5,30X,I5)                                                    I4
 6010 FORMAT('0',4I6,I12,6I6)
 6020 FORMAT('0',12X,2I6,42X,3I6)
 6030 FORMAT('0',12X,3I6)
      END
