      PROGRAM GCMPR6O 
C     PROGRAM GCMPR6O (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     SEP 19/94 - ELLISON CHAN. - READ-IN, WRITE-OUT AND USE NEW                
C                                 INPUT PARAMETER, "NLATJ", FOR CHAINED         
C                                 LATITUDES.                                    
C                               - ADD "KIP0JL" AND "KIP0JS" AND DELETE "LRECJ"  
C     NOV 19/93 - M.LAZARE  PREVIOUS VERSION GCMPAR6.
C                                                                               I2
CGCMPR6O - COMPUTES ARRAY DIMENSIONS FOR GCM6O                          0  1 C  I1
C                                                                               I3
CAUTHOR  - R.LAPRISE                                                            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-6O (OPTIMIZED VERSION OF GCM6)                               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-6O 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 =0)           I5
C      NPSF  = INTERNAL PACKING DENSITY FOR SURFACE FLUXES (GEN. = 0)           I5
C      NPPS  = INTERNAL PACKING DENSITY FOR PCP, SNO, WF AND WL (GEN. = 0)      I5
C                                                                               I5
C      NOTE - THE MAXIMUM PACKING DENSITY IS HARD-CODED TO ZERO IN VERSIONS     I5
C             FROM THE SX-3 ONWARD AS THE NEW STANDARD.
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      NLATJ   = NUMBER OF LATITUDES TO BE CHAINED TOGETHER FOR MULTIPLE-       I5
C                LATITUDE FORMULATION.                                          I5
C                                                                               I5
CEXAMPLE OF INPUT CARD...                                                       I5
C                                                                               I5
C* GCMPR6O   10   10   98   48     33332    1    1    1    0    1    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
C     * J = JLAT = NUMBER OF LATITUDES. 
C     * L = ILEV = NUMBER OF DYNAMIC LEVELS.
C     * S = LEVS
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)
      INTEGER*4 II
C
      INTEGER LSR(2,400)
C
      COMMON /MACHTYP/ MACHINE,INTSIZE
C
      CHARACTER*8 KR        
      CHARACTER*8 KL     
      CHARACTER*8 KL1    
      CHARACTER*8 KL2    
      CHARACTER*8 KL3J   
      CHARACTER*8 KS    
      CHARACTER*8 KI     
      CHARACTER*8 KJ     
      CHARACTER*8 KILG  
      CHARACTER*8 KNLATJ
      CHARACTER*8 KNENDJ
      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 KIP0JL
      CHARACTER*8 KIP0JS
      CHARACTER*8 KIP3JK 
      CHARACTER*8 KIP3JL 
      CHARACTER*8 KIP3JS
      CHARACTER*8 KNTRAC 
      CHARACTER*8 KTENER 
      CHARACTER*8 KIPID  
      CHARACTER*8 KIVA   
   
      CHARACTER*128 FILNAM

      DATA KR    /'      R='/    
      DATA KL    /'      L='/ 
      DATA KL1   /'     L1='/ 
      DATA KL2   /'     L2='/ 
      DATA KL3J  /'    L3J='/ 
      DATA KS    /'      S='/
      DATA KI    /'      I='/ 
      DATA KJ    /'      J='/ 
      DATA KILG  /'    ILG='/
      DATA KNLATJ/'  NLATJ='/
      DATA KNENDJ/'  NENDJ='/
      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 KIP0JL/'  IP0JL='/
      DATA KIP0JS/'  IP0JS='/
      DATA KIP3JK/'  IP3JK='/ 
      DATA KIP3JL/'  IP3JL='/ 
      DATA KIP3JS/'  IP3JS='/
      DATA KNTRAC/'  NTRAC='/ 
      DATA KTENER/'  TENER='/ 
      DATA KIPID /'   IPID='/ 
      DATA KIVA  /'    IVA='/ 

C-------------------------------------------------------------------- 
      II=1
      CALL GETARG(II,FILNAM)
      OPEN(1,FILE=FILNAM)
      N=5 

      READ(5,5010,END=901) ILEV,LEVS,ILGSL,ILAT,LRLMT,NPGG,NPSF,NPPS,           I4
     1                                        ITRAC,MACHINE,NLATJ               I4
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     * 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     * "ILG" IS SIZE USED FOR ROW GRIDS IN USUAL MANNER. IT IS AUGMENTED
C     * BY ONE TO MINIMIZE MEMORY BANK CONFLICTS.
C 
      NLATJ=MAX(NLATJ,1)
      IF(MOD(ILAT,NLATJ).EQ.0)                  THEN
         NENDJ=ILAT/NLATJ
      ELSE
         CALL                                      XIT('GCMPR6O',-1)
      ENDIF
C
      ILG=ILGSL*NLATJ+1
      CALL ITPARM(IP,N,NLATJ)
      WRITE(1,1010) KNLATJ ,IP
      CALL ITPARM(IP,N,NENDJ)
      WRITE(1,1010) KNENDJ ,IP
      CALL ITPARM(IP,N,ILGSL)
      WRITE(1,1010) KILG   ,IP
C
      WRITE(6,6010)ILEV,LEVS,ILGSL,ILAT,LRLMT,NPGG,NPSF,NPPS
     1            ,ITRAC,MACHINE,NLATJ

      NPVG=0
      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) 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,LA*ILEV) 
      WRITE(1,1010) KRL  ,IP
      CALL ITPARM(IP,N,LA*LEVS) 
      WRITE(1,1010) KRS  ,IP
  
      CALL ITPARM(IP,N,ILG) 
      WRITE(1,1010) KI   ,IP
      CALL ITPARM(IP,N,ILGSL-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*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
  
      L2SQ=(ILEV+2)**2
      KK=LENPAK(L2SQ,NENDJ,NPGG) 
      CALL ITPARM(IP,N,KK)
      WRITE(1,1010) KLLPJ,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 WORK
C     * ARRAYS, 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 
C
      KK=MAX((ILEV+2)**2, 64*ILG)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015) KWRKS,IP

      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

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

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

      KK=LENPAK(ILG,NENDJ*(ILEV+1),NPGG) 
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015)KIP3JK,IPLONG
  
      KK=MAX((ILG+1)*NENDJ,((ILEV+2)**2)*ILAT)
      CALL ITPARM(IPLONG,NLONG,KK)
      WRITE(1,1015) KGLL,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 POINTPH.
C 
C     * THE SPACE DEFINED BY IRAD REPRESENTS THE WORK SPACE PASSED TO 
C     * THE ARRAY "WRK" IN PHYSICS, USED FOR ARRAYS IN SUBROUTINE 
C     * RADIATN WHICH ARE NOT EXCHANGED WITH PHYSICS. ITS SPACE IS
C     * PARTITIONED USING THE POINTERS IR1,IR2,.... THESE ARE DEFINED IN
C     * THE SUBROUTINE POINTPH. 
C 
      NINT=5
      NG1=2 
      NTR=11
      NG1P1=NG1+1 
      NUA=3*NINT+3
      MP=NINT+3 
      MP2=2*MP
      NTRA=NUA+1
      LN6=MP2*NTR*6 
      KMX=ILEV+1
      KMXP=KMX+1
      NGLP1=KMX*NG1P1+1 
  
      IU  = ILG*8*NGLP1 
      IV  = ILG*NUA*NGLP1 
      IB  = ILG*(ILEV*(7+ILEV)+40+3*NTRA+2*NINT+NGLP1+NUA)
      IVA = IU+IV+IB+1
      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)
      IRAD=ILG*(30*ILEV+49+NGLP1) 
      ILENPHS=ILG*(20*ILEV+36)+ICLD+IRAD
      ILENDYN=ILG*(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
      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=ILEV 
      ILENMHE=NILH*NLATJ*(2*NLEVE+NLEV2E+NLEV3E) +
     1        LA*(NLEV1E+NLEV3E)       
      ILENMHA=NILH*NLATJ*(NLEVE+NLEV1A+NLEV2A+NLEV3A+NLEV4A) +
     1        LA*(NLEV1A+NLEV4A)       
      IVALTR=2*MAX(ILENMHE,ILENMHA)
C 
      ILENB  =ILG*(3*ILEV+LEVS) 
      IF(ITRAC.NE.0) ILENB=ILENB+ILG*ILEV 
      ILENRST=ILEV*2+8+MAX(2*LA*ILEV,ILENB)
C 
      NGRID=ILGSL*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)
      IPIDTMP=MAX(IVALPD,IVALRB)
      IPID=MAX(IPIDTMP,IVALTR) + 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('GCMPR6O',-3)
C-------------------------------------------------------------------- 
 1010 FORMAT(A8,6A1)
 1015 FORMAT(A8,8A1)
 1020 FORMAT('    COM=','C ***,')
 1025 FORMAT('    COM=','     ,')
 5010 FORMAT(10X,4I5,I10,6I5)                                                   I4
 6010 FORMAT('0',4I6,I12,6I6)
      END
