      PROGRAM ICNTRL9                                                                                                               
C     PROGRAM ICNTRL9 (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                                                                               I2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       I2                                                  
C     APR 30/03 - F.MAJAESS (DUE TO NAME CONFLICT, REPLACE "IDATE" BY "IDATEC") I2                                                  
C     JUN 12/97 - F.MAJAESS (VARIABLE DIMENSION THE NUMBER OF LEVELS)                                                               
C     FEB 03/95 - MARK HOLZER. READ IN NEW SPECTRAL TOPOPOGRAPHY                                                                    
C                              AS ADDITIONAL FILE, TRANSFORM                                                                        
C                              AND WRITE ONTO CONTROL FILE.                                                                         
C     FEB 15/94 - F.MAJAESS.   PREVIOUS VERSION ICNTRL8.                                                                            
C                                                                               I2                                                  
CICNTRL9 - CREATES THE INITIALIZATION CONTROL DATASET FOR GCM10         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                                                                               I5                                                  
C      LG         = VALUE OF MID MOMENTUM LAYER (UP TO $L$ VALUES) IN CODED     I5                                                  
C                   PRESSURE LEVELS.                                            I5                                                  
C                                                                               I5                                                  
C      LH         = VALUE OF MID THERMODYNAMIC LAYER (UP TO $L$ VALUES) IN      I5                                                  
C                   CODED PRESSURE LEVELS.                                      I5                                                  
C                                                                               I5                                                  
CEXAMPLE OF INPUT CARDS...                                                      I5                                                  
C                                                                               I5                                                  
C* ICNTRL9   10   64   32   20   20    2    1                                   I5                                                  
C*  0 0.00  ETA      500. RLNQ    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)                                                                                                                 
      LOGICAL OK                                                                                                                    
      CHARACTER*4 STRING                                                                                                            
                                                                                                                                    
      REAL*8 SL(181),CL(181),WL(181),WOSSL(181)                                                                                     
      REAL SG(100),SH(100)                                                                                                          
      INTEGER LSR(2,66), LG(100), LH(100)                                                                                           
                                                                                                                                    
      REAL LLGC                                                                                                                     
      COMPLEX SP                                                                                                                    
      COMMON /BLANCK/ SP  (214500)                                                                                                  
      COMMON /BLANCK/ GG  (18528),GLL (65341),WRKL(366)                                                                             
      COMMON /BLANCK/ GC  (18528),LLGC (65341)                                                                                      
      COMMON /SCM   / WRKS(546,2)                                                                                                   
      COMMON /ALPCOM/ ALP   (2210),DALP(2210)                                                                                       
      COMMON /ALPCOM/ DELALP(2210),EPSI(2210)                                                                                       
      COMMON /GAUS  / SL,CL,WL,WOSSL                                                                                                
      COMMON /GAUS  / RAD(181),DLAT(181),DLON(361)                                                                                  
      COMMON /ICOM  / IBUF(8),IDAT(65341)                                                                                           
                                                                                                                                    
      PARAMETER (NLG=360,NLAT=180)                                                                                                  
C                                                                                                                                   
C     * WORK ARRAYS FOR SUBROUTINE HRTOLR2.                                                                                         
C     * NOTE THAT THE SIZES OF ARRAYS VAL,DIST,LOCAT,IVAL,LOCFST AND                                                                
C     * NMAX REALLY REPRESENT THE NUMBER OF HIGH-RESOLUTION GRID                                                                    
C     * POINTS WITHIN A LOW-RESOLUTION GRID SQUARE. FOR CONVENIENCE                                                                 
C     * SAKE, THEY ARE DIMENSIONED WITH SIZE "NLG" AND AN ABORT                                                                     
C     * CONDITION IS GENERATED WITHIN THE SUBROUTINE.                                                                               
C                                                                                                                                   
      REAL GCHRTMP(NLG,NLAT)                                                                                                        
      REAL RLON(NLG), RLAT(NLAT)                                                                                                    
                                                                                                                                    
      REAL GCLRTMP(361,181)                                                                                                         
      INTEGER LATL(181), LATH(181), LONL(361), LONH(361)                                                                            
                                                                                                                                    
      REAL VAL(NLG), DIST(NLG)                                                                                                      
      INTEGER LOCAT(NLG), IVAL(NLG), LOCFST(NLG), NMAX(NLG)                                                                         
                                                                                                                                    
      DATA MAXX/65341/, MAXLEV/100/                                                                                                 
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('ICNTRL9',-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                                                                                                                  
      ILATH=ILAT/2                                                                                                                  
                                                                                                                                    
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                          I4                                                  
      MAXRLEV=MAX(ILEV,50)                                                                                                          
      IF (MAXRLEV.GT.MAXLEV) THEN                                                                                                   
        WRITE(6,6018) MAXRLEV,MAXLEV                                                                                                
        CALL                                       XIT('ICNTRL9',-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),LAY,ICOORD,PTOIT,MOIST                                                                   
      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) IHYD                                                                                                            
      IF((ICOORD.EQ.NC4TO8("    ")).OR.(ICOORD.EQ.NC4TO8(" SIG")))                                                                  
     1  CALL                                       XIT('ICNTRL9',-3)                                                                
                                                                                                                                    
C     * COMPUTE CONSTANTS.                                                                                                          
                                                                                                                                    
      CALL DIMGT  (LSR,LA,LR,LM,KTR,LRLMT)                                                                                          
      CALL PRLRLMT (LA,LR,LM,KTR,LRLMT)                                                                                             
      CALL EPSCAL (EPSI,LSR,LM)                                                                                                     
      CALL GAUSSG (ILATH,SL,WL,CL,RAD,WOSSL)                                                                                        
      CALL  TRIGL (ILATH,SL,WL,CL,RAD,WOSSL)                                                                                        
                                                                                                                                    
      DO 110 I=1,ILAT                                                                                                               
  110 DLAT(I)=RAD(I)*180.E0/3.14159E0                                                                                               
                                                                                                                                    
      DGX=360.E0/(FLOAT(ILG))                                                                                                       
      DO 120 I=1,ILG1                                                                                                               
        DLON(I)=DGX*FLOAT(I-1)                                                                                                      
  120 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * DEFINE TARGET GRID TYPE FOR SUBROUTINE HRTOLR2 (GAUSSIAN GRID).                                                             
C                                                                                                                                   
      IGRID=0                                                                                                                       
C                                                                                                                                   
C     * GET LAND-WATER MASK GROUND COVER FIELDS TO BE USED IN HRALR.                                                                
C     * IF THIS ROUTINE ABORTS BECAUSE GAUSSIAN GRID IS OF SAME SIZE OR LARGER                                                      
C     * THAN INITIAL GRID, REDO USING EXTRACTION.                                                                                   
C     * THIS FIELD IS NOT USED CURRENTLY BUT THE CODE IS KEPT (COMMENTED OUT)                                                       
C     * FOR FUTURE REFERENCE IF REQUIRED.                                                                                           
C                                                                                                                                   
C     CALL GETFLD2(-2,LLGC,4HGRID,1,4H  GC,1,IBUF,MAXX,OK)                                                                          
C     IF(.NOT.OK) CALL                             XIT('ICNTRL9',-4)                                                                
C     LLL=IBUF(5)*IBUF(6)                                                                                                           
C     DO 160 I=1,LLL                                                                                                                
C       LLGC(I)=CVMGT(0.,LLGC(I),LLGC(I).EQ.1.)                                                                                     
C       GLL(I)=LLGC(I)                                                                                                              
C 160 CONTINUE                                                                                                                      
                                                                                                                                    
                                                                                                                                    
C     IOPTION=0                                                                                                                     
C     ICHOICE=2                                                                                                                     
C     CALL HRTOLR2(GC,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
C    1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
C    2             OK,LONBAD,LATBAD,                                                                                                
C    3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
C    4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
                                                                                                                                    
C     IF(.NOT.OK)THEN                                                                                                               
C       WRITE(6,6030) LONBAD,LATBAD                                                                                                 
C       CALL                                       XIT('ICNTRL9',-5)                                                                
C     ENDIF                                                                                                                         
                                                                                                                                    
C     * GET THE "OPTIMAL TOPOGRAPHY" FIELD IN SPECTRAL SPACE AND CONVERT                                                            
C     * TO THE ANALYSIS GAUSSIAN GRID.                                                                                              
                                                                                                                                    
      CALL GETFLD2(3,SP,-1,-1,-1,-1,IBUF,MAXX,OK)                                                                                   
      IF(.NOT.OK) CALL                             XIT('ICNTRL9',-6)                                                                
      CALL PRTLAB (IBUF)                                                                                                            
C                                                                                                                                   
                                                                                                                                    
      CALL STAGG2 (GG,ILG1,ILAT,1,SL, SP,LSR,LM,LA,                                                                                 
     1             ALP,EPSI,WRKS,WRKL)                                                                                              
                                                                                                                                    
C     * PUT THE MOUNTAINS ON THE CONTROL FILE.                                                                                      
                                                                                                                                    
      CALL SETLAB  (IBUF,NC4TO8("GRID"),0,NC4TO8("PHIS"),1,                                                                         
     +                                       ILG1,ILAT,0,1)                                                                         
      CALL PUTFLD2 (99,GG,IBUF,MAXX)                                                                                                
      CALL PRTLAB (IBUF)                                                                                                            
      CALL                                         XIT('ICNTRL9',0)                                                                 
                                                                                                                                    
C     * E.O.F. ON FILE GPINIT.                                                                                                      
                                                                                                                                    
  903 CALL                                         XIT('ICNTRL9',-7)                                                                
                                                                                                                                    
C     * E.O.F. ON INPUT.                                                                                                            
                                                                                                                                    
  904 CALL                                         XIT('ICNTRL9',-8)                                                                
  905 CALL                                         XIT('ICNTRL9',-9)                                                                
C-----------------------------------------------------------------------                                                            
 5010 FORMAT (10X,7I5,/,I5,E5.0,1X,A4,E10.0,1X,A4,I5)                           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 (10X,'  IHYD=',I4)                                                                                                     
 6030 FORMAT('0NO POINTS FOUND WITHIN GRID SQUARE CENTRED AT (',I3,',',                                                             
     1       I3,')')                                                                                                                
      END                                                                                                                           
