      PROGRAM ICNTRLB                                                                                                               
C     PROGRAM ICNTRLB (GPINIT,  LLPHYS,  SPPHIS,      ICTL,      INPUT,         I2                                                  
C    1                                                          OUTPUT, )       I2                                                  
C    2           TAPE1=GPINIT, TAPE2=LLPHYS, TAPE3=SPPHIS, TAPE99=ICTL,                                                             
C    3                                       TAPE5=INPUT,   TAPE6=OUTPUT)                                                           
C     ------------------------------------------------------------------        I2                                                  
C                                                                                                                                   
C     FEB 20/06 - M.LAZARE. NEW VERSION BASED ON ICNTRLA, WITH:                 I2                                                  
C                           - CLEAN-UP DIMENSIONS USING PARAMETER               I2                                                  
C                             STATEMENTS, FOR BETTER UNDERSTAND.                I2                                                  
C                           - ADD MOUNTAINS ON MODEL GRID TO CTL FILE.          I2                                                  
C                           - CALLS GGAST INSTEAD OF GGAST2, SO THAT            I2                                                  
C                             TRANSFORMS WILL WORK FOR 192X96 LINEAR            I2                                                  
C                             GRID (T95) ON EXISTING 192X96 INITIAL             I2                                                  
C                             DATA.                                             I2                                                  
C                           - UNUSED CODE FOR HRALR2 REMOVED.                   I2                                                  
C                           - BUGFIX TO HAVE ALP,EPSI ALSO AS REAL*8.           I2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS PREVIOUS VERSION ICNTRLA.                                                                       
C                                                                               I2                                                  
CICNTRLB - CREATES THE INITIALIZATION CONTROL DATASET FOR GCM13+        3  1 C  I1                                                  
C                                                                               I3                                                  
CAUTHOR  - M.LAZARE                                                             I3                                                  
C                                                                               I3                                                  
CPURPOSE - CREATES THE INITIALIZATION CONTROL DATASET FOR USE IN                I3                                                  
C          THE GCM INITIALIZATION SEQUENCE, HYBRID MODEL. IT MUST               I3                                                  
C          BE THE FIRST PROGRAM RUN IN ANY INITIALIZATION SEQUENCE              I3                                                  
C          SINCE ALL OF THE INITIALIZATION PROGRAMS REQUIRE THAT                I3                                                  
C          DATASET.                                                             I3                                                  
C          IT CONTAINS CONTROL PARAMETERS READ FROM CARDS AND ALSO              I3                                                  
C          AN "OPTIMAL" MOUNTAIN FIELD SPECTRALLY SMOOTHED TO THE               I3                                                  
C          SAME RESOLUTION AS THE ANALYSIS GRID.                                I3                                                  
C                                                                               I3                                                  
CINPUT FILES...                                                                 I3                                                  
C                                                                               I3                                                  
C      GPINIT = PRESSURE LEVEL GAUSSIAN GRIDS OF FIELDS THAT WILL BE            I3                                                  
C               USED TO START THE MODEL. THIS PROGRAM READS ONLY ONE            I3                                                  
C               TEMPERATURE FIELD TO GET THE ANALYSIS GRID SIZE.                I3                                                  
C      LLPHYS = LAT-LONG PHYSICS DATASET. THIS PROGRAM READS ONLY THE           I3                                                  
C               LAND MASK FROM THIS DATASET.                                    I3                                                  
C      SPPHIS = "OPTIMAL" TOPOGRAPHY FIELD OF PHIS PRODUCED BY AN               I3                                                  
C               EARLIER PROCESS DESIGNED TO MINIMIZED "GIBBS PHENOMENA"         I3                                                  
C               ON THE DYNAMICS TRANSFORM GRID, IN SPECTRAL SPACE               I3                                                  
C               (MODEL TRUNCATION).                                             I3                                                  
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      ICTL   = INITIALIZATION CONTROL DATASET. IT CONTAINS ALL THE             I3                                                  
C               INFORMATION READ FROM CARDS (SEE BELOW) AND THE                 I3                                                  
C               SPECTRALLY SMOOTHED MOUNTAINS ON THE ANALYSIS                   I3                                                  
C               GAUSSIAN GRID.                                                  I3                                                  
C                                                                               I3                                                  
CINPUT PARAMETERS...                                                            I5                                                  
C                                                                               I5                                                  
C      ILEV       = NUMBER OF MODEL SIGMA LEVELS.                               I5                                                  
C                   NOTE: IN ORDER TO MAINTAIN UPWARD COMPATABILITY, AT LEAST   I5                                                  
C                         50 VALUES ARE READ IN FROM THE INPUT CARD             I5                                                  
C                         AND "ILEV" VALUES ARE USED.                           I5                                                  
C      ILGM,ILATM = NUMBER OF LONGITUDE AND LATITUDE POINTS TO BE USED IN       I5                                                  
C                   THE G.C.M.                                                  I5                                                  
C      LRT,LMT    = MODEL SPECTRAL TRUNCATION WAVE NUMBERS.                     I5                                                  
C                   A RHOMBOIDAL FIELD WILL HAVE SIZE (LRT+1,LMT+1)             I5                                                  
C      KTR        = TRUNCATION TYPE (0=RHOMBOIDAL, 2=TRIANGULAR).               I5                                                  
C      IDAY       = JULIAN DAY OF THE YEAR THE MODEL STARTS FROM.               I5                                                  
C      LAY        = LAYERING CONVENTION FOR LEVELS VS LAYERS                    I5                                                  
C                   (SEE SUBROUTINE BASCAL).                                    I5                                                  
C      GMT        = GREENWICH MEAN TIME ON IDAY FROM WHICH MODEL STARTS.        I5                                                  
C      ICOORD     = 4HET10/4HET15/4H ETA FOR HYBRID VERTICAL COORDINATE.        I5                                                  
C      PTOIT      = PRESSURE (PA) WHERE UPPER BOUNDARY CONDITION IS APPLIED.    I5                                                  
C      MOIST      = CHOICE OF WATER VAPOUR MOISTURE VARIABLE,                   I5                                                  
C                   4HT-TD FOR DEW POINT DEPRESSION                             I5                                                  
C                   4H  TD FOR DEW POINT                                        I5                                                  
C                   4H   Q FOR SPECIFIC HUMIDITY,                               I5                                                  
C                   4HRLNQ FOR -1./LN(Q),                                       I5                                                  
C                   4HSQRT FOR Q**0.5.                                          I5                                                  
C      IHYD       = CODE INDICATING DESIRED LAND SURFACE SCHEME                 I5                                                  
C                   0  FOR "OLD" HYDROLOGY SCHEME                               I5                                                  
C                   1  FOR "NEW" HYDROLOGY SCHEME                               I5                                                  
C                   2  FOR CLASS ("CANADIAN LAND SURFACE SCHEME")               I5                                                  
C      SREF       = VALUE OF "Q0" FOR GENERALIZED HYBRID MOISTURE VARIABLE      I5                                                  
C      SPOW       = VALUE OF POWER FOR GENERALIZED HYBRID MOISTURE VARIABLE     I5                                                  
C                                                                               I5                                                  
C      LG         = VALUE OF MID MOMENTUM LAYER (UP TO $X50L$ VALUES) IN CODED  I5                                                  
C                   PRESSURE LEVELS.                                            I5                                                  
C                                                                               I5                                                  
C      LH         = VALUE OF MID THERMODYNAMIC LAYER (UP TO $X50L$ VALUES) IN   I5                                                  
C                   CODED PRESSURE LEVELS.                                      I5                                                  
C                                                                               I5                                                  
CEXAMPLE OF INPUT CARDS...                                                      I5                                                  
C                                                                               I5                                                  
C* ICNTRLB   10   64   32   20   20    2    1                                   I5                                                  
C*  0 0.00  ETA      500. RLNQ    1   16.3E-3        1.                         I5                                                  
C* 10   32   80  150  235  360  550  750  880  970                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C* 18   51  110  188  291  445  642  812  924  985                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C*  0    0    0    0    0    0    0    0    0    0                              I5                                                  
C------------------------------------------------------------------------------                                                     
C                                                                                                                                   
C     IN ORDER TO MAINTAIN UPWARD COMPABILITY, THE DIMENSION FOR                                                                    
C     THE LEVEL DEPENDENT ARRAYS (IE. SG,SH...) HAS TO BE AT                                                                        
C     LEAST 50.                                                                                                                     
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
C                                                                                                                                   
C     * THE FOLLOWING PARAMETER STATEMENTS ARE SET UP FOR A T$M$ MODEL                                                              
C     * RESOLUTION IN SPECTRAL SPACE AND A $I$X$J$ INPUT ANALYSIS SIZE                                                              
C     * WITH $X50L$ LEVELS.                                                                                                         
c     * NOTE THAT "MAXX" IS USED FOR BOTH GRID AND SPECTRAL I/O SIZES.                                                              
C     * SINCE IT IS DEFINED FOR THE GRID SIZE AND THIS IS LARGER THAN                                                               
C     * THE SPECTRAL SIZE!                                                                                                          
C     * ** HIGHER FUTURE RESOLUTIONS WILL REQUIRE CORRESPONDING CHANGES!! **                                                        
C                                                                                                                                   
      PARAMETER(LMTOTAL=65, MAXLEV=100, NLON=192, NLAT=96,                                                                          
     1     LMP=LMTOTAL+1, LATOTAL=(LMTOTAL*LMP)/2, IRAM=LATOTAL+LMTOTAL,                                                            
     2     MAXLG=NLON+2, IGRID=(NLON+1)*NLAT, MAXX=IGRID*1,                                                                         
     3     IWRKL=(NLON+1)*MAXLEV, IWRKS=MAXLG)                                                                                      
                                                                                                                                    
      REAL*8 SL(NLAT),CL(NLAT),WL(NLAT),RAD(NLAT),WOSSL(NLAT)                                                                       
      REAL*8 ALP(IRAM), EPSI(IRAM)                                                                                                  
      REAL SG(MAXLEV),SH(MAXLEV)                                                                                                    
      INTEGER LSR(2,LMP), LG(MAXLEV), LH(MAXLEV)                                                                                    
      INTEGER IFAX(10)                                                                                                              
      REAL TRIGS(MAXLG)                                                                                                             
                                                                                                                                    
      COMPLEX SP                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      COMMON /BLANCK/ SP  (IRAM)                                                                                                    
      COMMON /BLANCK/ GG  (IGRID),WRKL(IWRKL)                                                                                       
      COMMON /SCM   / WRKS(IWRKS)                                                                                                   
      COMMON /ICOM  / IBUF(8),IDAT(MAXX)                                                                                            
C----------------------------------------------------------------------                                                             
      NFIL=6                                                                                                                        
      CALL JCLPNT (NFIL,1,2,3,99,5,6)                                                                                               
                                                                                                                                    
C     * GET THE ANALYSIS GRID SIZE FROM GPINIT.                                                                                     
                                                                                                                                    
      REWIND 1                                                                                                                      
      CALL FIND (1,NC4TO8("GRID"),-1,NC4TO8("TEMP"),-1,OK)                                                                          
      IF(.NOT.OK) CALL                             XIT('ICNTRLB',-1)                                                                
      CALL FBUFFIN(1,IBUF,-8,K,LEN)                                                                                                 
      IF (K.GE.0) GOTO 903                                                                                                          
      CALL PRTLAB (IBUF)                                                                                                            
      ILG1 =IBUF(5)                                                                                                                 
      ILAT =IBUF(6)                                                                                                                 
      ILG  =ILG1-1                                                                                                                  
                                                                                                                                    
C     * READ MODEL PARAMETERS FROM CARDS. WRITE CONTROL FILE RECORDS.                                                               
                                                                                                                                    
      READ(5,5010,END=904) ILEV,ILGM,ILATM,LRT,LMT,KTR,IDAY,LAY,                I4                                                  
     1                     GMT,ICOORD,PTOIT,MOIST,IHYD,SREF,SPOW                I4                                                  
      MAXRLEV=MAX(ILEV,50)                                                                                                          
      IF (MAXRLEV.GT.MAXLEV) THEN                                                                                                   
        WRITE(6,6018) MAXRLEV,MAXLEV                                                                                                
        CALL                                       XIT('ICNTRLB',-2)                                                                
      ENDIF                                                                                                                         
      READ(5,5012,END=905) (LG(L),L=1,MAXRLEV)                                  I4                                                  
      READ(5,5012,END=905) (LH(L),L=1,MAXRLEV)                                  I4                                                  
                                                                                                                                    
C     * CONVERT CODED PRESSURE LEVELS TO ETA/SIGMA LEVELS.                                                                          
                                                                                                                                    
      CALL LVDCODE(SG,LG,MAXRLEV)                                                                                                   
      CALL LVDCODE(SH,LH,MAXRLEV)                                                                                                   
      DO 100 L=1,MAXRLEV                                                                                                            
        SG(L) = SG(L) * 0.001E0                                                                                                     
        SH(L) = SH(L) * 0.001E0                                                                                                     
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C     LRLMT=1000*(LRT+1)+10*(LMT+1)+KTR                                                                                             
      CALL FXLRLMT (LRLMT,LRT+1,LMT+1,KTR)                                                                                          
      LABL=NC4TO8("LABL")                                                                                                           
      REWIND 99                                                                                                                     
      WRITE(99) LABL,ILEV,(SG(L),L=1,ILEV),                                                                                         
     1                    (SH(L),L=1,ILEV),                                                                                         
     2                    LAY,ICOORD,PTOIT,MOIST,SREF,SPOW                                                                          
      WRITE(99) LABL,ILG,ILAT,ILGM,ILATM,LRLMT,IDAY,GMT,IHYD                                                                        
C                                                                                                                                   
C     * PRINT OUT PARAMETERS.                                                                                                       
C                                                                                                                                   
      CALL WRITLEV(SG,ILEV,' SG ')                                                                                                  
      CALL WRITLEV(SH,ILEV,' SH ')                                                                                                  
C                                                                                                                                   
      WRITE(6,6017) ILG,ILAT,ILGM,ILATM                                                                                             
      CALL IDATEC  (MONTH,MDAY,IDAY)                                                                                                
      WRITE(6,6019) IDAY,MONTH,MDAY                                                                                                 
      WRITE(6,6021) LAY,ICOORD,PTOIT,GMT,MOIST                                                                                      
      WRITE(6,6022) SREF,SPOW                                                                                                       
      WRITE(6,6023) IHYD                                                                                                            
      IF((ICOORD.EQ.NC4TO8("    ")).OR.(ICOORD.EQ.NC4TO8(" SIG")))                                                                  
     1  CALL                                       XIT('ICNTRLB',-3)                                                                
                                                                                                                                    
C     * COMPUTE CONSTANTS.                                                                                                          
                                                                                                                                    
      CALL DIMGT  (LSR,LA,LR,LM,KTR,LRLMT)                                                                                          
      CALL PRLRLMT (LA,LR,LM,KTR,LRLMT)                                                                                             
      CALL EPSCAL (EPSI,LSR,LM)                                                                                                     
C                                                                                                                                   
C     * GET THE "OPTIMAL TOPOGRAPHY" FIELD IN SPECTRAL SPACE AND CONVERT                                                            
C     * TO THE ANALYSIS AND MODEL GAUSSIAN GRIDS.                                                                                   
C                                                                                                                                   
      CALL GETFLD2(3,SP,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                   
      IF(.NOT.OK) CALL                             XIT('ICNTRLB',-4)                                                                
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
C     * ANALYSIS-GRID.                                                                                                              
C                                                                                                                                   
      ILATH=ILAT/2                                                                                                                  
      CALL FTSETUP(TRIGS,IFAX,ILG)                                                                                                  
      CALL GAUSSG (ILATH,SL,WL,CL,RAD,WOSSL)                                                                                        
      CALL TRIGL  (ILATH,SL,WL,CL,RAD,WOSSL)                                                                                        
      CALL STAGG  (GG,ILG1,ILAT,1,SL, SP,LSR,LM,LA,                                                                                 
     1             ALP,EPSI,WRKS,WRKL,TRIGS,IFAX,MAXLG)                                                                             
      CALL SETLAB (IBUF,NC4TO8("GRID"),0,NC4TO8("PHIS"),1,                                                                          
     +                                      ILG1,ILAT,0,1)                                                                          
      CALL PUTFLD2 (99,GG,IBUF,MAXX)                                                                                                
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
C     * MODEL-GRID.                                                                                                                 
C                                                                                                                                   
      ILGM1=ILGM+1                                                                                                                  
      ILATHM=ILATM/2                                                                                                                
      CALL FTSETUP(TRIGS,IFAX,ILGM)                                                                                                 
      CALL GAUSSG (ILATHM,SL,WL,CL,RAD,WOSSL)                                                                                       
      CALL TRIGL  (ILATHM,SL,WL,CL,RAD,WOSSL)                                                                                       
      CALL STAGG  (GG,ILGM1,ILATM,1,SL, SP,LSR,LM,LA,                                                                               
     1             ALP,EPSI,WRKS,WRKL,TRIGS,IFAX,MAXLG)                                                                             
      CALL SETLAB (IBUF,NC4TO8("GRID"),0,NC4TO8("PHIM"),1,                                                                          
     +                                    ILGM1,ILATM,0,1)                                                                          
      CALL PUTFLD2 (99,GG,IBUF,MAXX)                                                                                                
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
      CALL                                         XIT('ICNTRLB',0)                                                                 
                                                                                                                                    
C     * E.O.F. ON FILE GPINIT.                                                                                                      
                                                                                                                                    
  903 CALL                                         XIT('ICNTRLB',-5)                                                                
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  904 CALL                                         XIT('ICNTRLB',-6)                                                                
  905 CALL                                         XIT('ICNTRLB',-7)                                                                
C-----------------------------------------------------------------------                                                            
 5010 FORMAT (10X,7I5,/,I5,E5.0,1X,A4,E10.0,1X,A4,I5,2E10.0)                    I4                                                  
 5012 FORMAT (10I5)                                                             I4                                                  
 6000 FORMAT (I5,A4,'LEVELS',/,(5X,10(1PE9.2)))                                                                                     
 6005 FORMAT (5X,10F9.5)                                                                                                            
 6010 FORMAT (5X,10F9.3)                                                                                                            
 6017 FORMAT ('0 ANALYSIS GRID=',2I5,5X,'MODEL GRID =',2I5)                                                                         
 6018 FORMAT ('0 CAN NOT HANDLE ',I3,' LEVELS; MAXIMUM IS ',I3)                                                                     
 6019 FORMAT ('0 IDAY =',I6,'  (',A3,I3,')')                                                                                        
 6021 FORMAT (' LAY=',I5,', COORD=',A4,', P.LID=',F10.3,' (PA)',                                                                    
     1        /' GMT=',F10.3,',  MOIST=',A4)                                                                                        
 6022 FORMAT (' SREF=',E12.4,', SPOW=',F10.3)                                                                                       
 6023 FORMAT (10X,'  IHYD=',I4)                                                                                                     
 6030 FORMAT('0NO POINTS FOUND WITHIN GRID SQUARE CENTRED AT (',I3,',',                                                             
     1       I3,')')                                                                                                                
      END                                                                                                                           
