      PROGRAM GCMPARC
C     PROGRAM GCMPARC (PARAMS,       INPUT,       OUTPUT,               )       I2
C    1           TAPE1=PARAMS, TAPE5=INPUT, TAPE6=OUTPUT)
C     ---------------------------------------------------                       I2
C
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       I2
C     DEC 12/98 - M.LAZARE   - ADD SPACE FOR "GTPREV","GTOGAT","FSGGAT",        I2
C                              "CBGOGAT" IN WORKSPACE FOR "VA" FOR CLASS12.     I2
C                            - ADD SPACE FOR EXTRA ARRAY "WRKT" IN NEW ROUTINES I2
C                              "SWAPS1" AND "SWAPS2" (REPLACING "SWAPS").       I2
C                            - ADD 4 NEW MULTI-LEVEL FIELDS WORKSPACE IN        I2
C                              "ILENPHS" FOR NEW GWD.                           I2
C     MAY 08/98 - B.DENIS    CHANGES FOR THE MULTI-TASKING GCM12 VERSION.       I2
C                                                                               I2
C                            - THE COMMON BLOCK ICOM IS NOW JUST USED FOR IO.   I2
C                              IT USED TO BE ALSO USED FOR THE SO-CALLED        I2
C                              SCRATCH ARRAY "SC" WHICH IS NOW EITHER DEFINED   I2
C                              LIKE THIS:                                       I2
C                                                                               I2
C                              --->      COMMON /ICOMSC/ SC($IPID$)             I2
C                                                                               I2
C                              WHEN THE MULTI-TASKING SWITCH IS TURNED OFF OR   I2
C                              BY DYNAMIC MEMORY ALLOCATION WHEN THE MULTI      I2
C                              SWITCH IS ON.                                    I2
C                                                                               I2
C                              TO DIMENSIONALIZE "ICOM", WE NOW COMPUTE "IP0F"  I2
C                              WHICH REPRESENTS THE MAX SIZE OF (HORIZONTAL     I2
C                              PHYSICS GRID, SPECTRAL FIELD) ENCOUTERED IN I/O. I2
C                                                                               I2
C                              --->      COMMON /ICOM/ IBUF(8),IDAT($IP0F$)     I2
C                                                                               I2
C                            - ADD NEW PARAMETERS TO ALLOW SOME WORK ARRAYS     I2
C                              TO BE USED IN THE DYNAMICS AS WELL AS IN THE     I2
C                              THE PHYSICS WITHOUT ANY CONSTRAINTS ON THE       I2
C                              NUMBER OF CHAINED LATITUDES.                     I2
C                                                                               I2
C                               NENDJM = MAX (NENDJ,    NENDJD)                 I2
C                               NLATJM = MAX (NLATJ,    NLATJD)                 I2
C                               IDM    = MAX (ILG,      ILGD)                   I2
C                               IDLM   = MAX (ILG*ILEV, ILGD*ILEV)              I2
C                                                                               I2
C                            - DISABLE THE RESTRICTION OF HAVING ILGD >= ILG.   I2
C                                                                               I2
C                            - REDUCE THE VALUE OF "ILENRST" USED TO COMPUTE    I2
C                              THE SPACE FOR "RSTART" AS WELL AS ELIMINATING    I2
C                              DEPENCY OF "IPIDTMP" COMPUTED VALUE ON "ILENBUF" I2
C                              AFFECTING THE OUTCOME OF "IPID" VALUE.           I2
C                                                                               I2
C     MAR 10/98 - M.LAZARE/  - MP=8 -> MP=11 AND NUA=24 -> NUA=31 TO REFLECT    I2
C                 R.HARVEY.    CHANGES IN LONGWAVE RADIATION (ZHONG&HAIG        I2
C                              CONTINUUM AND REVISED BAND MODEL.                I2
C                            - ABORT GENERATED IF IDBL=0 IN CONJUNCTION         I2
C                              WITH ONLY DOUBLE-TRANSFORM IN NEW MODEL.         I2
C                            - INCREASE SIZE FOR S/W POINTERS FOR OPTIMIZED     I2
C                              SWLINK3.                                         I2
C                            - REVISE POINTERS FOR DEEP CONVECTION AND          I2
C                              VERTICAL DIFFUSION TO REFLECT PROPER HANDLING    I2
C                              OF N-TRACERS NOW IN GCM12.                       I2
C                            - ADD POINTERS FOR NEW WORK ARRAYS IN CLASS12      I2
C                              (VARIABLE "IG") AND REMOVE REFERENCES TO         I2
C                              "ISBND" AND "ISOIL" (NO LONGER NEEDED).          I2
C                            - ADD SWITCH FOR INPUT OZONE DISTRIBUTION          I2
C                              TO INPUT CARD (IOZTYP=1 => OLD JAPANESE          I2
C                              DATASET WITH LEVOZ=37, IOZTYP=2 => NEW AMIP2     I2
C                              DATASET WITH LEVOZ=59. BOTH "IOZTYP"             I2
C                              AND "L3" (="LEVOZ") ARE ALSO WRITTEN OUT.        I2
C                            - MOVE ALL "SLICE" PARAMETERS (I.E. "$IL$")        I2
C                              TO BE "NLONG" TO ACCOMODATE LARGER NUMBER        I2
C                              OF CHAINED LATITUDES.                            I2
C                           -  INCLUDE A VARIABLE NUMBER OF SPECTRAL BANDS      I2
C                              IN THE SOLAR CODE (PREVIOUSLY HARD-CODED TO 2).  I2
C                           -  DELETED INTERNAL PACKING DENSITIES.              I2
C                           -  REMOVE ALL REFERENCES TO "WRKS".                 I2
C     JAN 16/96 - M. LAZARE. PREVIOUS VERSION GCMPARB. I2
C                                                                               I2
CGCMPARC - COMPUTES ARRAY DIMENSIONS FOR GCM12                          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-11.                                                          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-11 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      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      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* GCMPARC   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 KTENER
      CHARACTER*8 KIPID
      CHARACTER*8 KIVA
      CHARACTER*8 KIWRK
      CHARACTER*8 KNTSW
      CHARACTER*8 KIOZT
C<<BD
      CHARACTER*8 KIP0F
      CHARACTER*8 KNLATJM
      CHARACTER*8 KNENDJM
      CHARACTER*8 KIDM
      CHARACTER*8 KIDLM
C>>BD
      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='/
C<<BD
      DATA KIP0F /'   IP0F='/
      DATA KNLATJM/' NLATJM='/
      DATA KNENDJM/' NENDJM='/
      DATA KIDM   /'    IDM='/
      DATA KIDLM  /'   IDLM='/
C>>BD
      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 KTENER/'  TENER='/
      DATA KIPID /'   IPID='/
      DATA KIVA  /'    IVA='/
      DATA KIWRK /'   IWRK='/
      DATA KNTSW /' NINTSW='/
      DATA KIOZT /' IOZTYP='/
C--------------------------------------------------------------------
      II=1
      CALL GETARG(II,FILNAM)
      OPEN(1,FILE=FILNAM)
      N=5
      READ(5,5010,END=901) ILEV,LEVS,ILGSLD,ILATD,LRLMT,NINTSW,IOZTYP,          I4
     1                                        ITRAC,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('GCMPARC',-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('GCMPARC',-2)
        ENDIF
      ELSE
C
C       * ABORT SINCE NO LONGER SINGLE-TRANSFORM IN MODEL.
C
        CALL                                       XIT('GCMPARC',-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
      WRITE(6,6010) ILEV,LEVS,ILGSLD,ILATD,LRLMT,NPGG,NPSF,NPPS,
     1              ITRAC,MACHINE,NLATJD,IDBL
      WRITE(6,6020) ILGSL,ILAT,NINTSW,IOZTYP,NLATJ
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,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
C<<BD
C===  IF(NINTSW.LT.2.OR.NINTSW.GT.16) CALL         XIT('GCMPARC',-4)
      IF(NINTSW.LT.4.OR.NINTSW.GT.16) CALL         XIT('GCMPARC',-4)
C>>BD
      CALL ITPARM(IP,N,NINTSW)
      WRITE(1,1010) KNTSW   ,IP
C
      IF(IOZTYP.LT.1.OR.IOZTYP.GT.2) CALL          XIT('GCMPARC',-5)
      CALL ITPARM(IP,N,IOZTYP)
      WRITE(1,1010) KIOZT   ,IP
C<<BD
      NENDJM = MAX (NENDJ,    NENDJD)
      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>>BD
C     * "ILG" IS SIZE USED FOR ROW GRIDS IN USUAL MANNER. IT IS AUGMENTED
C     * BY ONE TO MINIMIZE MEMORY BANK CONFLICTS. 
C<<BD
C
      ILG=ILGSL*NLATJ+1
      ILGD=ILGSLD*NLATJD+1
C<<BD
C===  IF(ILGD.LT.ILG) CALL                         XIT('GCMPARC',-6)
C>>BD
C
      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
C<<BD
      IDM    = MAX (ILG,      ILGD)
      CALL ITPARM(IP,N,IDM)
      WRITE(1,1010) KIDM  ,IP
C>>BD

      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
      NTRAC=ABS(ITRAC)
      CALL ITPARM(IP,N,NTRAC)
      WRITE(1,1010)KNTRAC,IP
      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

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

C>>BD

      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 RADNEW3).
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
C     * THE SPACE DEFINED BY IWRK REPRESENTS THE WORK SPACE PASSED TO
C     * THE ARRAY "WRK" IN PHYSICS, USED FOR ARRAYS IN SUBROUTINE
C     * CONV WHICH ARE NOT EXCHANGED WITH PHYSICS. ITS SPACE IS
C     * PARTITIONED USING THE POINTERS ID1,ID2,.... THESE ARE DEFINED IN
C     * THE SUBROUTINE POINT10.
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
      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 CONV5.

      NBF=10
      IC = ILG*(30*ILEV+9*ILEV*NBF+2*ILEV*NTRAC+34)+1

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

C     IG = ILG*(22*IGND+4*(ICAN+1)+4*ICAN+179)+1   ! Before Nov 21/98.
C     IG = ILG*(22*IGND+4*(ICAN+1)+4*ICAN+183)+1   ! Before Feb 23/99.
      IG = ILG*(22*IGND+4*(ICAN+1)+4*ICAN+184)+1

C     * FIND MAXIMUM SIZE FOR DIMENSIONING WORK ARRAY VA.

      ICS = MAX(IC,IS)
      IGL = MAX(IG,IL)
      IVA = MAX(ICS,IGL)
      IF(IVA.GT.MAXLEN) CALL                       XIT('GCMPARC',-7)
      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('GCMPARC',-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), MHEXP6 (ILENMHE),
C     * MHANL6 (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+23+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
      ILENSL=ILGSL*(15*ILAT*ILEV+48*ILEV+3*ILAT+61) +
     1       (ILAT+4)*(12*ILEV+2)
C
C<<BD 
C      * SPACE FOR RSTART.

C===      ILENB  =ILG
C===      ILENRST=ILEV*2+8+MAX(2*LA*ILEV,ILENB)

      ILENRST=ILEV*2

C>>BD
C
      NGRID=ILGSLD*ILATD
      NSIZE=MAX(NGRID,2*LA)
      ILENBUF=MAX(NSIZE,20000) + 8
C<<BD
      CALL ITPARM(IPVLONG,NVLONG,ILENBUF)
      WRITE(1,1018) KIP0F,IPVLONG
C>>BD

C===  IVALPD=MAX(ILENPHS,ILENDYN)
C===  IVALRB=MAX(ILENRST,ILENBUF)
C===  IPIDTMP=MAX(IVALPD,IVALRB)

      IPIDTMP=MAX(ILENPHS,ILENDYN,ILENRST)
C>>BD
      IPIDTEM=MAX(IVALTR,ILENSL)
      IPID=MAX(IPIDTMP,IPIDTEM) + 1
      IF(IPID.GT.MAXLEN) CALL                      XIT('GCMPARC',-9)
C
      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('GCMPARC',-10)
  902 CALL                                         XIT('GCMPARC',-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=','     ,')
 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,I6)
      END


