      PROGRAM GCMPRDB
C     PROGRAM GCMPRDB (PARAMS,       INPUT,       OUTPUT,               )       I2
C    1           TAPE1=PARAMS, TAPE5=INPUT, TAPE6=OUTPUT)
C     ---------------------------------------------------                       I2
C
C     OCT 08/03 - M. LAZARE.    - ILG,ILGD VALUES DEPENDENT ON LON,LOND,        I2
C                                 LONSL,LONSLD.                                 I2
C     JUN 26/03 - M. LAZARE.    NEW VERSION FOR IBM (MODEL VERSION GCM13B):     I2
C                               - REMOVE (UNUSED) DEFINITIONS FOR:              I2
C                                 LM1,G1,G2,P0,P1,P2,LJ,L1J,LL,TENER,           I2
C                                 ILG,ILGD,NADVSL,NTOTSL,NTASKS,IDM.            I2
C                               - CHANGE READ-IN PARAMETERS:                    I2
C                                 LONSL,LONSLD,LON,LOND,NNODE INSTEAD OF        I2
C                                 ILGSL,ILGSLD,NLATJ,NLATJD,MACHINE.            I2
C                                 ALSO:  NLAT,NLATD READ INSTEAD OF             I2
C                                 ILAT,ILATD.                                   I2
C                                 ILGSL,ILGSLD,ILAT,ILATD,NLATJ,NLATJD,         I2
C                                 LONTP,LONTD,ILGTP,ILGTD,NTASKT,NTASKTD,       I2
C                                 NTASKP AND NTASKD CALCULATED INSIDE.          I2
C                               - CODE RESTRUCTURED IN FUNCTIONAL SECTIONS.     I2 
C     JUN 21/03 - M. LAZARE.    NEW VERSION FOR IBM (MODEL VERSION GCM13A):     I2
C                               - "NENDJ" -> NTASK.                             I2
C                               - ENSURE CONSISTENCY BETWEEN VARIOUS GRID       I2
C                                 SIZES FOR BOTH PHYSICS AND DYNAMICS.          I2
C                               - REFERENCES TO "NPPS", "NPVG", "NPSF"          I2
C                                 REMOVED ("NPGG" HAS TO BE KEPT FOR I/O).      I2
C                               - REFERENCES TO "IL", "IL1", "IS", "DL",        I2
C                                 "DS" REMOVED IN CONJUNCTION WITH CHANGES      I2 
C                                 TO LSMOD ROUTINES.                            I2 
C                               - PROPER NAMING CONVENTION FOR                  I2
C                                 ILGSL/ILGTD/ILG AND ILGSLD/ILGDTD/ILGD.       I2
C                               - REORGANIZATION OF S/L STUFF.                  I2 
C                               - IP0J NOW LONSL*ILAT+1.                        I2  
C                               - "IDBL" REFERENCES REMOVED (ALWAYS TRUE).      I2
C                               - DP0J ADDED (LONSLD*ILATD+1).                  I2  
C                               - MULTI-LEVEL "PAK" DIMENSIONS REMOVED.         I2
C     OCT 12/01 - M. LAZARE.    NEW VERSION FOR MODEL VERSION GCM13A.           I2
C                               REMOVE 5*ILG WORK FIELDS FOR CLASS AND          I2
C                               ADD 1*ILG*IGND.                                 I2
C     OCT  7/99 - J. SCINOCCA - PREVIOUS VERSION GCMPRDA FOR GCM13.
C                                                                               I2
CGCMPRDB - COMPUTES ARRAY DIMENSIONS FOR GCM13B                         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-13 ARRAY DIMENSIONS.         I3
C
CINPUT PARAMETERS...
C                                                                               I5
C      ILEV  = NUMBER OF MODEL    LEVELS                                        I5
C      LEVS  = NUMBER OF MOISTURE LEVELS                                        I5
C      LONSLD= NUMBER OF LONGITUDES         ON THE DYNAMICS GRID                I5
C      NLATD = 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      NINTSW = NUMBER OF SPECTRAL INTERVALS IN SOLAR RADIATION CODE            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      ITRAC = 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      NNODE = NUMBER OF SMP NODES USED TO RUN MODEL (MPI FOR NNODE>1).         I5
C      LOND    = NUMBER OF GRID POINTS PER SLICE FOR DYNAMICS CALCULATION.      I5
C      LONSL   = NUMBER OF LONGITUDES         ON THE PHYSICS GRID               I5
C      NLAT    = NUMBER OF GAUSSIAN LATITUDES ON THE PHYSICS GRID               I5
C      LON     = NUMBER OF GRID POINTS PER SLICE FOR PHYSICS CALCULATION.       I5
C                                                                               I5
CEXAMPLE OF INPUT CARD...                                                       I5
C                                                                               I5
C* GCMPRDB   31   31  144   72     48482    4    2    0    1   32               I5
C*                     96   48                                 32               I5
C----------------------------------------------------------------------------
C
C     * ARRAY DIMENSIONS NAMING CONVENTION.
C
C     * I = ILGSL = NUMBER OF LONGITUDES + 2 (NECCESSARY FOR TRANSFORMS)
C     *             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.
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
      CHARACTER*128 FILNAM
C-------------------------------------------------------------------
      CHARACTER*8 KNNODE
      CHARACTER*8 KNTSW
      CHARACTER*8 KIOZT
      CHARACTER*8 KNTRAC
C
      CHARACTER*8 KLONSL
      CHARACTER*8 KIM1
      CHARACTER*8 KLONSLD
      CHARACTER*8 KNLAT
      CHARACTER*8 KNLATD
      CHARACTER*8 KNLATJ
      CHARACTER*8 KNLATJD
C
      CHARACTER*8 KILGSL
      CHARACTER*8 KILGSLD
      CHARACTER*8 KJ
      CHARACTER*8 KILAT
      CHARACTER*8 KILATD
      CHARACTER*8 KLON
      CHARACTER*8 KLOND 
      CHARACTER*8 KLONTP
      CHARACTER*8 KLONTD
      CHARACTER*8 KILGTP
      CHARACTER*8 KILGTD
      CHARACTER*8 KI
      CHARACTER*8 KD
C
      CHARACTER*8 KNTASKP
      CHARACTER*8 KNTASKD
      CHARACTER*8 KNTASKTP
      CHARACTER*8 KNTASKTD
C
      CHARACTER*8 KNLATJM
      CHARACTER*8 KNTASKM
      CHARACTER*8 KIP0J
      CHARACTER*8 KDP0J
C
      CHARACTER*8 KL
      CHARACTER*8 KS
      CHARACTER*8 KL1
      CHARACTER*8 KL2
      CHARACTER*8 KL3
      CHARACTER*8 KL3J
      CHARACTER*8 KC
      CHARACTER*8 KC1
      CHARACTER*8 KG
      CHARACTER*8 KP3
C
      CHARACTER*8 KR
      CHARACTER*8 KRAM
      CHARACTER*8 KM1
      CHARACTER*8 KNL
C
      CHARACTER*8 KGLL
      CHARACTER*8 KIDLM
      CHARACTER*8 KRL
      CHARACTER*8 KRS
C
      CHARACTER*8 KIP0F
      CHARACTER*8 KIVA
      CHARACTER*8 KIWRK
      CHARACTER*8 KIPID
C------------------------------------------------------------------------
      DATA KNNODE   /'  NNODE='/
      DATA KNTSW    /' NINTSW='/
      DATA KIOZT    /' IOZTYP='/
      DATA KNTRAC   /'  NTRAC='/
C
      DATA KLONSL   /'  LONSL='/
      DATA KIM1     /'    IM1='/
      DATA KLONSLD  /' LONSLD='/
      DATA KNLAT    /'   NLAT='/
      DATA KNLATD   /'  NLATD='/
      DATA KNLATJ   /'  NLATJ='/
      DATA KNLATJD  /' NLATJD='/
C
      DATA KILGSL   /'  ILGSL='/
      DATA KILGSLD  /' ILGSLD='/
      DATA KJ       /'      J='/
      DATA KILAT    /'   ILAT='/
      DATA KILATD   /'  ILATD='/
      DATA KLON     /'    LON='/
      DATA KLOND    /'   LOND='/
      DATA KLONTP   /'  LONTP='/
      DATA KLONTD   /'  LONTD='/
      DATA KILGTP   /'     IT='/
      DATA KILGTD   /'     DT='/
      DATA KI       /'      I='/
      DATA KD       /'      D='/
C
      DATA KNTASKP  /' NTASKP='/
      DATA KNTASKD  /' NTASKD='/
      DATA KNTASKTP /'NTASKTP='/
      DATA KNTASKTD /'NTASKTD='/
C
      DATA KNLATJM  /' NLATJM='/
      DATA KNTASKM  /' NTASKM='/
      DATA KIP0J    /'   IP0J='/
      DATA KDP0J    /'   DP0J='/
C
      DATA KL       /'      L='/
      DATA KS       /'      S='/
      DATA KL1      /'     L1='/
      DATA KL2      /'     L2='/
      DATA KL3      /'     L3='/
      DATA KL3J     /'    L3J='/
      DATA KC       /'      C='/
      DATA KC1      /'     C1='/
      DATA KG       /'      G='/
      DATA KP3      /'     P3='/
C
      DATA KR       /'      R='/
      DATA KRAM     /'    RAM='/
      DATA KM1      /'     M1='/
      DATA KNL      /'     NL='/
C
      DATA KGLL     /'    GLL='/
      DATA KIDLM    /'   IDLM='/
      DATA KRL      /'     RL='/
      DATA KRS      /'     RS='/
C
      DATA KIP0F    /'   IP0F='/
      DATA KIVA     /'    IVA='/
      DATA KIWRK    /'   IWRK='/
      DATA KIPID    /'   IPID='/
C====================================================================
C     * OPEN UNITS, READ AND PRINTOUT INPUT DATA.
      II=1
      CALL GETARG(II,FILNAM)
      OPEN(1,FILE=FILNAM)
C
      READ(5,5010,END=901) ILEV,LEVS,LONSLD,NLATD,LRLMT,NINTSW,IOZTYP,          I4
     1                                        ITRAC,NNODE,LOND                  I4
C
C     * READ SECOND CARD WITH REDUCED PHYSICS GRID SIZE.
C
      READ(5,5020,END=902) LONSL,NLAT,LON                                       I4
C
      WRITE(6,6010) ILEV,LEVS,LONSLD,NLATD,LRLMT,ITRAC,NNODE,LOND
      WRITE(6,6020) LONSL,NLAT,NINTSW,IOZTYP,LON
C======================================================================
C     * DEFAULT NUMBER OF CHARACTERS FOR MOST GCMPARM VARIABLES.
C
      N=5
C
C     * DEFAULT FOR NNODE AND CONDITIONS ON NINTSW,IOZTYP.
C
      IF(NNODE.EQ.0) NNODE=1
      CALL ITPARM(IP,N,NNODE)
      WRITE(1,1010) KNNODE  ,IP
C
      IF(NINTSW.LT.4.OR.NINTSW.GT.16) CALL         XIT('GCMPRDB',-1)
      CALL ITPARM(IP,N,NINTSW)
      WRITE(1,1010) KNTSW   ,IP
C
      IF(IOZTYP.LT.1.OR.IOZTYP.GT.2) CALL          XIT('GCMPRDB',-2)
      CALL ITPARM(IP,N,IOZTYP)
      WRITE(1,1010) KIOZT   ,IP
C
      NTRAC=ABS(ITRAC)
      CALL ITPARM(IP,N,NTRAC)
      WRITE(1,1010)KNTRAC,IP
C=======================================================================
C     * FULL GRID LATITUDE INFORMATION.
C
      CALL ITPARM(IP,N,LONSL)
      WRITE(1,1010) KLONSL,IP
C
      CALL ITPARM(IP,N,LONSL+1)
      WRITE(1,1010) KIM1 ,IP
C
      CALL ITPARM(IP,N,LONSLD)
      WRITE(1,1010) KLONSLD,IP
C
      CALL ITPARM(IP,N,NLAT)
      WRITE(1,1010) KNLAT,IP
C
C     * "KJ" IS "NLAT" DIMENSION FOR S/L.
C
      CALL ITPARM(IP,N,NLAT)
      WRITE(1,1010) KJ   ,IP
C
      CALL ITPARM(IP,N,NLATD)
      WRITE(1,1010) KNLATD,IP
C=======================================================================
C     * DERIVED RUN-TIME CONFIGURATION PARAMETERS BASED ON INPUT.
C     * "NTASK" REFERS TO THE RESULTING NUMBER OF ITTERATIONS IN THE
C     * LATITUDE LOOP ON EACH NODE, BASED ON NUMBER OF NODES AND
C     * SPECIFIED CHUNK SIZE (FOR EACH OF PHYSICS,DYNAMICS).  
C     * THE ABOVE APPLIES TO BOTH THE DYNAMICS (SUBSCRIPT "D") AND
C     * PHYSICS (SUBSCRIPT "P") GRIDS.
C
C     * FIRST ENSURE ALL PARAMETERS ARE CONSISTENT WITH WHAT IS
C     * REQUIRED BY THE MODEL.
C
      IF(LON.GE.LONSL)                                THEN
         IF(MOD(LON,LONSL).NE.0) CALL              XIT('GCMPRDB',-3)
      ELSE
         IF(MOD(LONSL,LON).NE.0) CALL              XIT('GCMPRDB',-4)
      ENDIF
C
      IF(LOND.GE.LONSLD)                              THEN
         IF(MOD(LOND,LONSLD).NE.0) CALL            XIT('GCMPRDB',-5)
      ELSE
         IF(MOD(LONSLD,LOND).NE.0) CALL            XIT('GCMPRDB',-6)
      ENDIF
C
      IF(MOD(NLAT, NNODE).NE.0) CALL               XIT('GCMPRDB',-7)
      IF(MOD(NLATD,NNODE).NE.0) CALL               XIT('GCMPRDB',-8)
C
      NLATJ =MAX(LON /LONSL ,1)
      CALL ITPARM(IP,N,NLATJ)
      WRITE(1,1010) KNLATJ ,IP
C
      NLATJD=MAX(LOND/LONSLD,1)
      CALL ITPARM(IP,N,NLATJD)
      WRITE(1,1010) KNLATJD ,IP
C
      ILAT=NLAT/NNODE
      IF(MOD(ILAT, NLATJ ).NE.0) CALL              XIT('GCMPRDB',-9)
      CALL ITPARM(IP,N,ILAT)
      WRITE(1,1010) KILAT  ,IP
C
      ILATD=NLATD/NNODE
      IF(MOD(ILATD,NLATJD).NE.0) CALL              XIT('GCMPRDB',-10)
      CALL ITPARM(IP,N,ILATD)
      WRITE(1,1010) KILATD ,IP
C
      ILGSL=LONSL+2
      CALL ITPARM(IP,N,ILGSL)
      WRITE(1,1010) KILGSL ,IP
C
      ILGSLD=LONSLD+2
      CALL ITPARM(IP,N,ILGSLD)
      WRITE(1,1010) KILGSLD ,IP
C
      CALL ITPARM(IP,N,LON)
      WRITE(1,1010) KLON   ,IP
C
      CALL ITPARM(IP,N,LOND)
      WRITE(1,1010) KLOND  ,IP
C
      LON_TP=LONSL*NLATJ
      CALL ITPARM(IP,N,LON_TP)
      WRITE(1,1010) KLONTP ,IP
C
      LON_TD=LONSLD*NLATJD
      CALL ITPARM(IP,N,LON_TD)
      WRITE(1,1010) KLONTD ,IP
C
      ILG_TP=ILGSL*NLATJ+1
      CALL ITPARM(IP,N,ILG_TP)
      WRITE(1,1010) KILGTP ,IP
C
      ILG_TD=ILGSLD*NLATJD+1
      CALL ITPARM(IP,N,ILG_TD)
      WRITE(1,1010) KILGTD ,IP
C
C     * VALUES FOR ILG,ILGD ARE DEPENDENT ON WHETHER WE ARE RUNNING
C     * WITH SUB-LATITUDES PER TASK OR NOT. IF NO SUBLATITUDES, THE
C     * CODE CAN BE MORE EFFICIENT RUNNING WITH JUST ONE OPENMP LOOP
C     * FOR EACH OF THE PHYSICS/DYNAMICS; TO DO SO, HOWEVER, REQUIRES
C     * CHANGING THE DEFINITION OF ILG TO BE CONSISTENT WITH ILG_TP
C     * AND SIMILARILY FOR DYNAMICS.
C
      IF(LON.GE.LONSL) THEN
        ILG=ILG_TP
      ELSE
        ILG=LON+1
      ENDIF
      CALL ITPARM(IP,N,ILG)
      WRITE(1,1010) KI   ,IP
C
      IF(LOND.GE.LONSLD) THEN
        ILGD=ILG_TD
      ELSE
        ILGD=LOND+1
      ENDIF
      CALL ITPARM(IP,N,ILGD)
      WRITE(1,1010) KD   ,IP
C
      NTASKP=LONSL*ILAT/LON
      CALL ITPARM(IP,N,NTASKP)
      WRITE(1,1010) KNTASKP ,IP
C
      NTASKD=LONSLD*ILATD/LOND
      CALL ITPARM(IP,N,NTASKD)
      WRITE(1,1010) KNTASKD ,IP
C
      NTASKTP=ILAT/NLATJ
      CALL ITPARM(IP,N,NTASKTP)
      WRITE(1,1010) KNTASKTP ,IP
C
      NTASKTD=ILATD/NLATJD
      CALL ITPARM(IP,N,NTASKTD)
      WRITE(1,1010) KNTASKTD,IP
C
      NLATJM = MAX (NLATJ,  NLATJD)
      CALL ITPARM(IP,N,NLATJM)
      WRITE(1,1010) KNLATJM ,IP
C
      NTASKM = MAX (NTASKP, NTASKD)
      CALL ITPARM(IP,N,NTASKM)
      WRITE(1,1010) KNTASKM ,IP
C
      CALL ITPARM(IP,N,LONSL*ILAT+1)
      WRITE(1,1010) KIP0J,IP
C
      CALL ITPARM(IP,N,LONSLD*ILATD+1)
      WRITE(1,1010) KDP0J,IP
C==================================================================
C     * LEVEL AND SPECTRAL SPACE SIZES.
C
      CALL ITPARM(IP,N,ILEV)
      WRITE(1,1010) KL   ,IP
C
      CALL ITPARM(IP,N,LEVS)
      WRITE(1,1010) KS   ,IP
C
      CALL ITPARM(IP,N,ILEV+1)
      WRITE(1,1010) KL1  ,IP
C
      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
C
      CALL ITPARM(IP,N,LEVOZ*NLAT)
      WRITE(1,1010) KL3J ,IP
C
      ICAN=4
      CALL ITPARM(IP,N,ICAN)
      WRITE(1,1010) KC   ,IP
C
      CALL ITPARM(IP,N,ICAN+1)
      WRITE(1,1010) KC1  ,IP
C
      IGND=3
      CALL ITPARM(IP,N,IGND)
      WRITE(1,1010) KG   ,IP
C
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)
C
      CALL ITPARM(IP,N,LA)
      WRITE(1,1010) KR   ,IP
C
      CALL ITPARM(IP,N,LM+1)
      WRITE(1,1010) KM1  ,IP
C
      NSTAR=LR
      IF(KTR.EQ.0) NSTAR=LR*2
      CALL ITPARM(IP,N,NSTAR*ILEV)
      WRITE(1,1010) KNL  ,IP
C
      CALL ITPARM(IP,N,LA+LM)
      WRITE(1,1010) KRAM ,IP
C
C     * OLD INTERNAL PACKING DENSITY SET TO ZERO (MUST BE KEPT DUE
C     * TO PRESENCE IN I/O ROUTINES). 
C
      NPGG=0
      CALL ITPARM(IP,N,NPGG)
      WRITE(1,1010) KP3  ,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

      KK=MAX(ILGSLD*NLATD,((ILEV+2)**2)*NLATD)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015) KGLL,IPLONG
C
      IDLM   = MAX (ILG*ILEV, ILGD*ILEV)
      CALL ITPARM(IPLONG,NLONG,IDLM)
      WRITE(1,1015) KIDLM  ,IPLONG
C
      CALL ITPARM(IPLONG,NLONG,LA*ILEV)
      WRITE(1,1015) KRL  ,IPLONG
C
      CALL ITPARM(IPLONG,NLONG,LA*LEVS)
      WRITE(1,1015) KRS  ,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     * SIZE FOR GENERAL I/O (MADE BIG ENOUGH TO HANDLE I/O OF ANY
C     * FIELDS ON DYNAMICS GRID IN THE FUTURE).
C
      NGRID=ILGSLD*NLATD
      NSIZE=MAX(NGRID,2*LA)
      ILENBUF=MAX(NSIZE,20000) + 8
      CALL ITPARM(IPVLONG,NVLONG,ILENBUF)
      WRITE(1,1018) KIP0F,IPVLONG
C=====================================================================
C     * FIND MAXIMUM SIZE FOR DIMENSIONING WORK ARRAY VA.
C
C---------------------------------------------------------------------
C     * RADIATION PARAMETERS.
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
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY LONGWAVE.
C
      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
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SHORTWAVE.
C
      NSWGAS=3
      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---------------------------------------------------------------------
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINES CALLED
C     * BY CONVECTION.
C
      NBF=10
      IC = ILG*(30*ILEV+9*ILEV*NBF+2*ILEV*NTRAC+34)+1
C---------------------------------------------------------------------
C     * CALCULATE SIZE OF TOTAL WORK SPACE REQUIRED BY CLASS.
C
      IG = ILG*(23*IGND+4*(ICAN+1)+4*ICAN+179)+1
C---------------------------------------------------------------------
C     * SEMI-LAG WORKSPACE.
C
      NLATJS=NLATJ
      NTASKS=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+ABS(ITRAC)
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     * NLGD,NLATW,NLEVW - LONGITUDE,LATITUDE,HEIGHT DIMENSIONS OF
C     * NEW SEMILAG WORK ARRAYS.
C
      NLATW=NLATJS+4
      NLEVW=ILEV+4
      NLGW=ILGSL+2
      WRITE(6,6030) NADVSL,NTOTSL,NLATJS

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-----------------------------------------------------------------------
      ICS = MAX(IC,IS)
      IGL = MAX(IG,IL)
      IVA = MAX(ICS,IGL,IPS)
      IF(IVA.GT.MAXLEN) CALL                       XIT('GCMPRDB',-11)

      CALL ITPARM(IPVLONG,NVLONG,IVA)
      WRITE(1,1018) KIVA,IPVLONG
C=======================================================================
C     * DETERMINE SIZE FOR PHYSICS ROUTINES WORK ARRAY "WRK".
C     * THE LARGEST SPACE AS REQUIRED BY RADIATION (IWRKR) AND
C     * DEEP CONVECTION (IWRKC) IS CHOSEN.

      IWRKC=ILG*(41*ILEV+6*ILEV*NTRAC+ILG*NTRAC+NTRAC+28)
      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('GCMPRDB',-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), MHEXP_ (ILENMHE),
C     * MHANL_ (ILENMHA), SEMILAG (ILENSL), RESTART (ILENRST) AND
C     * COMMON BLOCK ICOM (FOR I/O ROUTINES).
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+28+NTRAC)*ILEV+3*NINTSW+36+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---------------------------------------------------------------------
C     * SEMI-LAG REQUIREMENTS.
C
      ILENSL=2*NADVSL*(ILGSL+1)*(ILAT+4)*ILEV+
     1       (ILGSL+1)*(ILAT+4)*ILEV
      WRITE(6,*) "ILENSL= ",ILENSL
C---------------------------------------------------------------------
C     * SPACE FOR RSTART.
C
      ILENRST=ILEV*2
C---------------------------------------------------------------------
      IPIDTMP=MAX(ILENPHS,ILENDYN,ILENRST)
      IPIDTEM=MAX(IVALTR,ILENSL)
      IPID=MAX(IPIDTMP,IPIDTEM) + 1
      IF(IPID.GT.MAXLEN) CALL                      XIT('GCMPRDB',-12)
      CALL ITPARM(IPVLONG,NVLONG,IPID)
      WRITE(1,1018) KIPID,IPVLONG
C=====================================================================
      IF(ITRAC.EQ.0)THEN
        WRITE(1,1020)
        WRITE(1,1030)
        WRITE(1,1040)
      ELSE IF(ITRAC.GT.0) THEN
        WRITE(1,1025)
        WRITE(1,1030)
        WRITE(1,1045)
      ELSE
        WRITE(1,1025)
        WRITE(1,1035)
        WRITE(1,1040)
      ENDIF

C     * NORMAL TERMINATION.

      STOP

C     * E.O.F. ON INPUT.

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