      PROGRAM GCMPR7U 
C     PROGRAM GCMPR7U (PARAMS,       INPUT,       OUTPUT,               )       I2
C    1           TAPE1=PARAMS, TAPE5=INPUT, TAPE6=OUTPUT) 
C     ---------------------------------------------------                       I2
C                                                                               I2
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       I2
C     NOV 07/95 - F. MAJAESS (IMPROVE CODE PORTABILITY)                         
C     AUG 11/94 - F. MAJAESS (USE INTEGER*4 FOR C-ROUTINE ARG)                  
C     FEB 10/92 - E.CHAN.   REPLACE CALL TO JCLPNT WITH CALL TO GETARG AND      
C                           AN OPEN STATEMENT. ALSO REMOVE XIT(___,0).          
C     JAN 13/92 - E.CHAN.   CONVERT HOLLERITH TO ASCII AND CHECK FOR            
C                           PACKING DENSITIES GREATER THAN 6.                  
C     DEC 06/90 - M.LAZARE, (CORRECT "RL, RS, KIP1JK, KIP3JL AND KIP3JS")       
C     AUG 22/90 - M.LAZARE, R.LAPRISE, JEAN DE GRANDPRE.
C                 CREATED FROM PREVIOUS VERSION OF GCMPAR6 WITH:  
C                           A.) LENGTH OF VA ARRAY INCREASED FOR NEW
C                               LONGWAVE RADIATION CODE.
C                           B.) NEW SUBSTITUTIONAL SIZES FOR "CLASS"
C                               HYDROLOGY SCHEME AND "N" TRACER 
C                               FORMULATION.
C                           C.) IPID SIZE CALCULATION MODIFIED
C                               FOR REMOVED FIELDS IN PHYSICS AND "N" 
C                               TRACER FORMULATION. 
C                           D.) EMD,EMM PACKED 2:1 INSTEAD OF 6:1.
C                                                                               I2
CGCMPR7U - COMPUTES ARRAY DIMENSIONS FOR GCM7                           0  1 C  I1
C                                                                               I3
CAUTHOR  - M.LAZARE, R.LAPRISE, JEAN DE GRANDPRE                                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-7.                                                           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-7 ARRAY DIMENSIONS.          I3
C 
CINPUT PARAMETERS...
C                                                                               I5
C      ILEV  = NUMBER OF MODEL    LEVELS                                        I5
C      LEVS  = NUMBER OF MOISTURE LEVELS                                        I5
C      ILG   = NUMBER OF LONGITUDES         ON THE TRANSFORM GRID               I5
C      ILAT  = NUMBER OF GAUSSIAN LATITUDES ON THE TRANSFORM 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                                                                               I5
C      NPGG  = INTERNAL PACKING DENSITY FOR MOST GRIDS (GENERALLY =6)           I5
C      NPSF  = INTERNAL PACKING DENSITY FOR SURFACE FLUXES (GEN. = 2)           I5
C      NPPS  = INTERNAL PACKING DENSITY FOR PCP, SNO, WF AND WL (GEN. = 2)      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
CEXAMPLE OF INPUT CARD...                                                       I5
C                                                                               I5
C* GCMPR7U   10    8   66   32     21212    1    1    1    0                    I5
C---------------------------------------------------------------------------- 
C 
C     * ARRAY DIMENSIONS NAMING CONVENTION. 
C 
C     * I = ILG = NUMBER OF LONGITUDES + 2 (NECCESSARY FOR TRANSFORMS). 
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)
C  
      INTEGER LSR(2,400)
      INTEGER*4 II

      CHARACTER*8 KR     
      CHARACTER*8 KL     
      CHARACTER*8 KLM1   
      CHARACTER*8 KL1    
      CHARACTER*8 KL2    
      CHARACTER*8 KL3J   
      CHARACTER*8 KS     
      CHARACTER*8 KC    
      CHARACTER*8 KG     
      CHARACTER*8 KG1    
      CHARACTER*8 KG2    
      CHARACTER*8 KI     
      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 KLLPJ  
      CHARACTER*8 KWRKS  
      CHARACTER*8 KRL    
      CHARACTER*8 KRS    
      CHARACTER*8 KIL    
      CHARACTER*8 KIL1   
      CHARACTER*8 KIS    
      CHARACTER*8 KLJ    
      CHARACTER*8 KL1J   
      CHARACTER*8 KNL    
      CHARACTER*8 KLL    
      CHARACTER*8 KGLL     
      CHARACTER*8 KIP0JC 
      CHARACTER*8 KIP1JG 
      CHARACTER*8 KIP1JK 
      CHARACTER*8 KIP3JC
      CHARACTER*8 KIP3JL 
      CHARACTER*8 KIP3JS 
      CHARACTER*8 KNTRAC 
      CHARACTER*8 KTENER 
      CHARACTER*8 KIPID  
      CHARACTER*8 KIVA   
      CHARACTER*8 KIWRK  
  
      CHARACTER*128 FILNAM

      DATA KR    /'      R='/ 
      DATA KL    /'      L='/ 
      DATA KLM1  /'    LM1='/ 
      DATA KL1   /'     L1='/ 
      DATA KL2   /'     L2='/ 
      DATA KL3J  /'    L3J='/ 
      DATA KS    /'      S='/ 
      DATA KC    /'      C='/
      DATA KG    /'      G='/ 
      DATA KG1   /'     G1='/ 
      DATA KG2   /'     G2='/ 
      DATA KI    /'      I='/ 
      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 KLLPJ /'L2L2P3J='/ 
      DATA KWRKS /'   WRKS='/ 
      DATA KRL   /'     RL='/ 
      DATA KRS   /'     RS='/ 
      DATA KIL   /'     IL='/ 
      DATA KIL1  /'    IL1='/ 
      DATA KIS   /'     IS='/ 
      DATA KLJ   /'     LJ='/ 
      DATA KL1J  /'    L1J='/ 
      DATA KNL   /'     NL='/ 
      DATA KLL   /'     LL='/ 
      DATA KGLL  /'    GLL='/   
      DATA KIP0JC/'  IP0JC='/ 
      DATA KIP1JG/'  IP1JG='/ 
      DATA KIP1JK/'  IP1JK='/ 
      DATA KIP3JC/'  IP3JC='/
      DATA KIP3JL/'  IP3JL='/ 
      DATA KIP3JS/'  IP3JS='/ 
      DATA KNTRAC/'  NTRAC='/ 
      DATA KTENER/'  TENER='/ 
      DATA KIPID /'   IPID='/ 
      DATA KIVA  /'    IVA='/ 
      DATA KIWRK /'   IWRK='/ 

C-------------------------------------------------------------------- 
      II=1
      CALL GETARG(II,FILNAM)
      OPEN(1,FILE=FILNAM)
      N=5 
      READ(5,5010,END=901) ILEV,LEVS,ILG,ILAT,LRLMT,NPGG,NPSF,NPPS,             I4
     1                                                        ITRAC             I4
      IF ( (NPGG.GT.6) .OR. (NPSF.GT.6) .OR. (NPPS.GT.6) ) THEN
        WRITE(6,6000)
        CALL                                       XIT('GCMPAR6',-1)
      ENDIF
      WRITE(6,6010)ILEV,LEVS,ILG,ILAT,LRLMT,NPGG,NPSF,NPPS
     1            ,ITRAC
      CALL DIMGT(LSR,LA,LR,LM,KTR,LRLMT)
      NPVG=1
  
      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
      CALL ITPARM(IP,N,37*ILAT) 
      WRITE(1,1010) KL3J ,IP
      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,ILG) 
      WRITE(1,1010) KI   ,IP
      CALL ITPARM(IP,N,ILG-1) 
      WRITE(1,1010) KIM1 ,IP
      CALL ITPARM(IP,N,ILG*ILEV)
      WRITE(1,1010) KIL  ,IP
      CALL ITPARM(IP,N,ILG*LEVS)
      WRITE(1,1010) KIS  ,IP
      CALL ITPARM(IP,N,ILG*(ILEV+1))
      WRITE(1,1010) KIL1 ,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,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*ILAT)
      WRITE(1,1010) KIP0J,IP
  
      KK=LENPAK(ILG,ILAT,NPPS)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP1J,IP
  
      KK=LENPAK(ILG,ILAT,NPSF)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP2J,IP
  
      KK=LENPAK(ILG,ILAT,NPGG)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KIP3J,IP
  
      L2SQ=(ILEV+2)**2
      KK=LENPAK(L2SQ,ILAT,NPGG) 
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KLLPJ,IP
  
      KK=MAX((ILEV+2)**2, 64*ILG)
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KWRKS,IP
C 
C     * PARAMETERS FOR NEW (IHYD=2) LAND SURFACE SCHEME.
C 
      ICAN=2
      IGND=3
  
      CALL ITPARM(IP,N,ICAN)
      WRITE(1,1010) KC   ,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,ILAT*IGND,NPPS) 
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP1JG,IP
      KK=ILG*ILAT*ICAN
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP0JC,IP
      KK=LENPAK(ILG,ILAT*ICAN,NPGG) 
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010)KIP3JC,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 WORK ARRAYS IVA, 
C     * GLL AND IPID, 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((ILG+1)*ILAT,((ILEV+2)**2)*ILAT)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015) KGLL,IPLONG 
      CALL ITPARM(IPLONG,NLONG,LA*ILEV) 
      WRITE(1,1015) KRL  ,IPLONG
      CALL ITPARM(IPLONG,NLONG,LA*LEVS) 
      WRITE(1,1015) KRS  ,IPLONG
C 
      KK=LENPAK(ILG,ILAT*(ILEV+1),NPPS) 
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP1JK,IPLONG
      KK=LENPAK(ILG,ILAT*ILEV,NPGG) 
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP3JL,IPLONG
      KK=LENPAK(ILG,ILAT*LEVS,NPGG) 
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP3JS,IPLONG
C 
C     * RADIATION PARAMETERS (SEE VALUES IN SUBROUTINE RADNEW). 
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, BUT THIS LATTER SPACE IS
C     * WELL "HIDDEN" WITHIN THE SPACE REQUIRED FOR THE LONGWAVE
C     * ROUTINES. DIFFERENT POINTERS IRL AND IRS ARE USED TO PARTITION
C     * THIS SPACE WITHIN THE LONGWAVE AND SHORTWAVE ROUTINES,
C     * RESPECTIVELY. THESE ARE DEFINED IN THE SUBROUTINE POINTP7.
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 POINTP7. 
C 
      NINT=6
      NG1=2 
      NTR=11
      NG1P1=NG1+1 
      NUA=24
      NU2=8 
      MP=8
      MP2=2*MP
      NTRA=21 
      KMX=ILEV+1
      KMXP=KMX+1
      NGLP1=KMX*NG1P1+1 
  
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINE LONGWV.
  
      IL1 = ILG*NGLP1*(NUA+NU2) 
      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 SHORTW3. 
  
      IS = ILG*(6*KMX+29*KMXP+50)+1 
  
C     * CALCULATE SIZE OF WORK ARRAY VA REQUIRED BY SUBROUTINE CONV.
  
      IC = ILG*(30*ILEV+30)+1 
  
C     * FIND MAXIMUM SIZE FOR DIMENSIONING WORK ARRAY VA. 
  
      ICS = MAX(IC,IS) 
      IVA = MAX(IL,ICS)
      CALL ITPARM(IPLONG,NLONG,IVA) 
      WRITE(1,1015) KIVA,IPLONG 
C 
C     * THE WORK SPACE OF SIZE "IPID" IS USED IN SEVERAL AREAS OF THE 
C     * MODEL: PHYSICS (ILENPHS), DYNAMICS (ILENDYN), RESTART 
C     * (ILENRST) AND COMMON BLOCK ICOM (ROUTINES GETZON5,GETSPE,GETAGB,
C     * ETC.). THIS ICOM SPACE MUST BE AT LEAST 20008, SINCE THAT IS
C     * WHAT IS HARD-COATED 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)
      IHYD=ILG*(10*IGND+44)+(IGND+2)*(IGND+1)+43*IGND+17
      IWRK=ILG*(39*ILEV+28) 
      CALL ITPARM(IPLONG,NLONG,IWRK)
      WRITE(1,1015) KIWRK ,IPLONG 
      ILENPHS=ILG*((20+NTRAC)*ILEV+2*NTRAC+36)+ICLD+IHYD+IWRK 
      ILENDYN=ILG*(3*ILEV+3)+ILEV*(4*LA+2*ILEV+4)+LEVS+2*LA 
C 
      ILENB  =ILG*((3+NTRAC)*ILEV+LEVS) 
      ILENRST=ILEV*2+8+MAX(2*LA*ILEV,ILENB)
C 
      NGRID=ILG*ILAT
      NSIZE=MAX(NGRID,2*LA)
      ILBUF=MAX(NSIZE,L2SQ*ILAT) 
      ILENBUF=MAX(ILBUF,20000) + 8 
C 
      IVALPD=MAX(ILENPHS,ILENDYN)
      IVALRB=MAX(ILENRST,ILENBUF)
      IPID=MAX(IVALPD,IVALRB) + 1
      CALL ITPARM(IPLONG,NLONG,IPID)
      WRITE(1,1015) KIPID,IPLONG
  
      IF(ITRAC.EQ.0)THEN
        WRITE(1,1020)
      ELSE
        WRITE(1,1025)
      ENDIF 
  
C     * NORMAL TERMINATION.

      STOP

C     * E.O.F. ON INPUT.
  
  901 CALL                                         XIT('GCMPR7U',-1)
C-------------------------------------------------------------------- 
 1010 FORMAT(A8,6A1)
 1015 FORMAT(A8,8A1)
 1020 FORMAT('    COM=','C ***,')
 1025 FORMAT('    COM=','     ,')
 5010 FORMAT(10X,4I5,I10,4I5)                                                   I4
 6000 FORMAT('*** PACKING DENSITIES MUST BE 6 OR LESS ***')
 6010 FORMAT('0',4I6,I12,4I6)
      END 
