      PROGRAM INITG10                                                                                                               
C     PROGRAM INITG10 (ICTL,        MASK,       OROGWD,       LLPHYS,           I2                                                  
C    1                                          GGPHYS,        OUTPUT,  )       I2                                                  
C    2          TAPE99=ICTL, TAPE88=MASK,TAPE77=OROGWD, TAPE1=LLPHYS,                                                               
C    3                                    TAPE2=GGPHYS,  TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          I2                                                  
C                                                                               I2                                                  
C     MAY 14/04 - M. LAZARE. - CHANGE THE DIMENSION OF "LONB(361),LATB(181)" TO I2                                                  
C                              "NLOMAX".                                        I2                                                  
C     JAN 08/04 - L.SOLHEIM  - REMOVED UNUSED ARRAYS GTO1,SICO1,SICNO1,MFD,NMDM                                                     
C                            - INITIALIZED "SICMO" ARRAY PASSED TO CLMMOD                                                           
C                              TO ZERO                                                                                              
C                            - MODIFIED CLMMOD CALL LIST TO BE CONSISTENT WITH                                                      
C                              CHANGES THEREIN                                                                                      
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     SEP 09/02 - M.LAZARE.    USE ACCURACY LIMIT IN LOOP 570 TO ENSURE                                                             
C                              PROPER DEFINITIONS OF SOIL LAYER DEPTHS.                                                             
C     OCT 22/01 - M.LAZARE.    REMOVE SURFACE HEIGHT CONVERSION AND WRITING                                                         
C     MAR 18/99 - M.LAZARE.    NO SIC OR SICN CONSERVATION.                                                                         
C     DEC 18/98 - M.LAZARE.    READ-IN AMIP2 MASK FIELD AND USE FOR SST/                                                            
C                              SIC/SICN ONLY (OLD SCRIPPS MASK USED FOR                                                             
C                              AS USUAL). USE NEW IOPTION.EQ.2 FOR THESE.                                                           
C     DEC 12/98 - J.SCINOCCA.  READ-IN 6 FIELDS (SD,GAM,PSI,ALPH,DELT,SIGX)                                                         
C                              DIRECTLY AT MODEL RESOLUTION FROM A                                                                  
C                              SEPARATE FILE, IN SUPPORT OF NEW OROGRAPHIC                                                          
C                              GWD SCHEME. OLD PROCESSING OF ENV COMMENTED                                                          
C                              OUT (SD FIELD CAN BE USED AS SQUARE ROOT OF                                                          
C                              VARIANCE).                                                                                           
C     SEP 10/97 - M.LAZARE. 1. STORE 12 MONTHS OF GT,SIC,SICN AND CALL                                                              
C                              ROUTINE TO ENSURE CONSERVATION OF MONTHLY                                                            
C                              MEANS UPON INTEGRATION, BEFORE WRITING OUT                                                           
C                              RESULTS. ALL AREA-AVERAGING FOR LOW-RES                                                              
C                              NON-LAND POINTS (WATER OR ICE) DONE BASED ON                                                         
C                              ALL HIGH-RES NON-LAND POINTS (WATER OR ICE).                                                         
C                              IN OTHER WORDS, ALL REFERENCES TO HIGH-RES                                                           
C                              WATER/ICE BOUNDARY IN OLD "GC" FIELD (FROM                                                           
C                              (SHEA-TRENBERTH-REYNOLDS) IS REMOVED, AND                                                            
C                              AND GC READ IN IS ONLY LAND MASK FROM SCRIPPS.                                                       
C                           2. GT,SNO,SIC,SICN,TBAR,THLQ AND THIC ARE READ IN                                                       
C                              FROM LLPHYS FOR IDAY ONLY. WL AND WF HAVE BEEN                                                       
C                              REMOVED AS HAS THE "FUDGING" OF A TBAR FIELD                                                         
C                              BASED ON GT.                                                                                         
C     APR 28/97 - M.LAZARE. 1. PROCESS AMIP2 SST AND SEA-ICE CONCENTRATION                                                          
C                              FIELDS, SET GT TO AMIP2 VALUES OVER WATER,                                                           
C                              AND CONVERT SEA-ICE CONCENTRATION FROM                                                               
C                              PERCENT TO FRACTION. ELIMINATE WRITING                                                               
C                              OUT OF "GC" (WITH ASSOCIATED CHANGE                                                                  
C                              TO "GETGG_" SUBROUTINE) SINCE THIS IS                                                                
C                              NOW DETERMINED AT EACH TIMESTEP FROM SEA-                                                            
C                              ICE CONCENTRATION.                                                                                   
C                           2. READ IN NEW LAND-SURFACE 1X1 FIELDS OF                                                               
C                              SAND AND CLAY (3 SOIL LEVELS EACH) AND                                                               
C                              1-LEVEL FIELD OF VARIABLE SOIL DEPTH.                                                                
C                              THIS REPLACES LOOK-UP TABLE GENERATION                                                               
C                              OF VALUES FROM WILSON/HENDERSON-SELLERS.                                                             
C                              DRAINAGE IS DETERMINED FROM THE SOIL DEPTH                                                           
C                              AND FOR NOW, ORGANIC MATTER IS SET TO ZERO.                                                          
C                           3. DATA FLAGS IN THE SAND FIELD ARE USED TO                                                             
C                              DETERMINE HIGH-RES POINTS WHICH ARE,                                                                 
C                              RESPECTIVELY, WATER (-1), ORGANIC                                                                    
C                              SOIL (-2) OR GLACIER ICE (-4). A RESULTING                                                           
C                              LOW-RES LAND TYPE FIELD ("GL") IS CREATED                                                            
C                              AND THIS INFORMATION IS INSERTED INTO THE                                                            
C                              RESULTING LOW-RES SOIL FIELDS. FURTHERMORE,                                                          
C                              A HIGH-RES SOIL/NOSOIL MASK IS GENERATED                                                             
C                              FROM THE SAND FIELD AND USED IN THE AREA-                                                            
C                              AVERAGING. NEGATIVE-VALUE FLAGS ARE NOT                                                              
C                              USED IN THE AREA-AVERAGING, SO THAT ONLY                                                             
C                              DATAPOINTS WITH ACTUAL SOIL ARE COUNTED.                                                             
C                              FOR THE THIRD SOIL LAYER, A WEIGHTED AVERAGE                                                         
C                              OVER THE ACTUAL SOIL THICKNESS IS TAKEN, TO                                                          
C                              ACCOUNT FOR THE PRESENCE OF BEDROCK WITHIN                                                           
C                              THIS THICK LAYER.                                                                                    
C                           4. WORK FIELDS DLAY, GHR AND GLR HAVE BEEN ADDED                                                        
C                              TO AID IN PROCESSING THE SOIL DATA.                                                                  
C                           5. ENSURE CONSISTENCY BETWEEN LAND MASK ("MASK")                                                        
C                              AND SOIL MASK, AT LOW RESOLUTION. TRUE NON-                                                          
C                              LAND POINTS (MASK=0) MUST BE TURNED INTO WATER                                                       
C                              AT LOW RESOLUTION FOR SOIL DATA MANIPULATION.                                                        
C                              IN THE CASE WHERE THE TRUE MASK INDICATES                                                            
C                              LAND BUT THE SOIL DATA DOESN'T, AN ABORT                                                             
C                              CONDITION IS GENERATED.                                                                              
C                                                                                                                                   
C     OCT 10/96 - M.LAZARE. 1. ADD NEW INPUT MASK FILE AT MODEL                                                                     
C                              RESOLUTION AND USE TO DETERMINE OTHER                                                                
C                              FIELDS CONSISTENTLY. WRITE MASK TO OUTPUT.                                                           
C                           2. PROCESSING OF "SNO" DONE IN LOOP OVER                                                                
C                              MONTHS FOR "IDAY" ONLY, TO AVOID                                                                     
C                              RE-READING 1X1 GC FIELD AGAIN ("WF" AND                                                              
C                              "WL" LEFT WHERE THEY ARE AND PROCESSED                                                               
C                              USING HIGH-RES MASK FIELD ("HRMASK"),                                                                
C                              SINCE ONLY INTERESTED OVER LAND). THIS                                                               
C                              MASK FIELD IS ALSO USED FOR THE OTHER                                                                
C                              FIELDS WHICH ONLY REQUIRE LAND/NO-LAND                                                               
C                              MASK.                                                                                                
C                           3. NEW INITIALIZATION SUBROUTINE USED,                                                                  
C                              "HRTOLR3", WHICH ALSO ATTEMPTS TO                                                                    
C                              "BORROW" INFORMATION FROM NEAREST                                                                    
C                              NEIGHBOURS ON GAUSSIAN GRID IN THE CASE                                                              
C                              THAT NO VALID HIGH-RES POINTS OF THE                                                                 
C                              SAME LAND TYPE ARE AVAILABLE. TWO NEW                                                                
C                              WORK FIELDS ARE PASSED (LONB,LATB).                                                                  
C     FEB 13/96 - M.LAZARE. PREVIOUS VERSION INITGG9.                                                                               
C                                                                               I2                                                  
CINITG10 - GRID PHYSICS INITIALIZATION PROGRAM FOR GCM12                2  1    I1                                                  
C                                                                               I3                                                  
CAUTHOR  - M.LAZARE                                                             I3                                                  
C                                                                               I3                                                  
CPURPOSE - CONVERTS HIGH-RESOLUTION LAT-LONG SURFACE PHYSICS GRIDS TO           I3                                                  
C          GAUSSIAN GRIDS.                                                      I3                                                  
C          NOTE - ALL INITIAL SURFACE FIELDS ARE AT 1X1 DEGREE OFFSET           I3                                                  
C                 RESOLUTION. THE GROUND COVER, GROUND TEMPERATURE,             I3                                                  
C                 AMIP2 SST AND SEA-ICE CONCENTRATION, AS WELL AS THE           I3                                                  
C                 SEA ICE FIELDS MUST BE AVAILABLE FOR ALL MONTHS. THE          I3                                                  
C                 SNOW COVER, LIQUID AND FROZEN WATER FIELDS ARE                I3                                                  
C                 REQUIRED FOR ANY MONTH THE MODEL STARTS FROM. THE             I3                                                  
C                 PROGRAM ABORTS IF FCAN, AVW, AIW, LNZ0, LAMX, LAMN,           I3                                                  
C                 CMAS, ROOT, ENV, DPTH, SAND OR CLAY ARE                       I3                                                  
C                 MISSING AT START-UP DATE - THESE FIELDS HAVE ONE              I3                                                  
C                 BASIC ANNUAL VALUE.                                           I3                                                  
C                                                                               I3                                                  
C                 AS WELL, THE SURFACE HEIGHT FIELD (ON THE ANALYSIS            I3                                                  
C                 GAUSSIAN GRID) IS OBTAINED FROM THE CONTROL FILE              I3                                                  
C                 (AFTER CONVERTING FROM GEOPOTENTIAL TO HEIGHT) AND            I3                                                  
C                 SAVED ON THE AN FILE FOR DISPLAY PURPOSES.                    I3                                                  
C                                                                               I3                                                  
C                 INITIAL FIELDS AT 1X1 DEGREE RESOLUTION ARE EITHER            I3                                                  
C                 AREA-AVERAGED (CONTINUOUS) OR THEIR MOST-FREQUENTLY           I3                                                  
C                 OCCURRING VALUE IN THE MODEL-RESOLUTION GRID SQUARE           I3                                                  
C                 CHOSEN (DISCRETE-VALUED) USING THE SUBROUTINE HRTOLR3.        I3                                                  
C                 THE ONLY DISCRETE FIELD PROCESSED IS A WORK FIELD FOR         I3                                                  
C                 THE SOIL DATA. ALL OTHERS ARE AREA-AVERAGED.                  I3                                                  
C                                                                               I3                                                  
C                 THE SOIL DATA IS TREATED SOMEWHAT UNIQUELY:                   I3                                                  
C                 1. DATA FLAGS IN THE SAND FIELD ARE USED TO                   I3                                                  
C                    DETERMINE HIGH-RES POINTS WHICH ARE,                       I3                                                  
C                    RESPECTIVELY, WATER (-1), ORGANIC                          I3                                                  
C                    SOIL (-2) OR GLACIER ICE (-4). A RESULTING                 I3                                                  
C                    LOW-RES LAND TYPE FIELD ("GL") IS CREATED                  I3                                                  
C                    AND THIS INFORMATION IS INSERTED INTO THE                  I3                                                  
C                    RESULTING LOW-RES SOIL FIELDS (FOR NOW THIS IS NOT.        I3                                                  
C                    DONE FOR ORGANIC SOILS, SINCE NO WETLAND MODEL YET).       I3                                                  
C                 2. A HIGH-RES SOIL/NOSOIL MASK IS GENERATED                   I3                                                  
C                    FROM THE SAND FIELD AND USED IN THE AREA-                  I3                                                  
C                    AVERAGING.                                                 I3                                                  
C                 3. SAND AND CLAY (AND SOIL DEPTH) ARE AREA-AVERAGED           I3                                                  
C                    FROM THE INPUT HIGH-RESOLUTION DATA VIA HRTOLR3.           I3                                                  
C                    BEFORE WRITING OUT THE RESULT, FRACTION IS CONVERTED TO    I3                                                  
C                    PERCENTAGE SINCE THIS IS WHAT IS USED IN CLASS.            I3                                                  
C                    DRAINAGE IS DETERMINED FROM A SWITCH WHICH IS UNITY FOR    I3                                                  
C                    DEPTHS GE 4.1M OTHERWISE ZERO (AT HIGH-RESOLUTION) AND     I3                                                  
C                    THEN AREA-AVERAGED USING HRTOLR3. FOR NOW, ORGANIC         I3                                                  
C                    MATTER IS SET TO ZERO.                                     I3                                                  
C                 4. NEGATIVE-VALUE FLAGS ARE NOT USED IN THE AREA-AVERAGING,   I3                                                  
C                    SO THAT ONLY DATAPOINTS WITH ACTUAL SOIL ARE COUNTED.      I3                                                  
C                    A WEIGHTED AVERAGE OVER THE ACTUAL SOIL THICKNESS          I3                                                  
C                    IS TAKEN, TO ACCOUNT FOR THE PRESENCE OF BEDROCK.          I3                                                  
C                 5. ENSURE CONSISTENCY BETWEEN LAND MASK ("MASK")              I3                                                  
C                    AND SOIL MASK, AT LOW RESOLUTION. TRUE NON-                I3                                                  
C                    LAND POINTS (MASK=0) MUST BE TURNED INTO WATER             I3                                                  
C                    AT LOW RESOLUTION FOR SOIL DATA MANIPULATION.              I3                                                  
C                    IN THE CASE WHERE THE TRUE MASK INDICATES                  I3                                                  
C                    LAND BUT THE SOIL DATA DOESN'T, AN ABORT                   I3                                                  
C                    CONDITION IS GENERATED.                                    I3                                                  
C                                                                               I3                                                  
CINPUT FILES...                                                                 I3                                                  
C                                                                               I3                                                  
C      ICTL   = CONTAINS GLOBAL LAT-LONG GRIDS WHICH ARE READ AND               I3                                                  
C               HORIZONTALLY SMOOTHED TO GLOBAL GAUSSIAN GRIDS. THE LAT-        I3                                                  
C               LONG GRIDS MAY BE IN ANY ORDER ON THIS FILE.                    I3                                                  
C                                                                               I3                                                  
C      MASK   = CONTAINS LAND MASK (NO SEA-ICE, I.E. -1/0) ON MODEL             I3                                                  
C               GAUSSIAN-GRID.                                                  I3                                                  
C                                                                               I3                                                  
C      OROGWD = CONTAINS THE 6 FIELDS (SD,GAM,PSI,ALPH,DELT,SIGX) DIRECTLY AT   I3                                                  
C               THE MODEL RESOLUTION IN SUPPORT OF NEW OROGRAPHIC GWD SCHEME.   I3                                                  
C                                                                               I3                                                  
C      LLPHYS = OFFSET LAT-LONG PHYSICS GRIDS:                                  I3                                                  
C                                                                               I3                                                  
C      NOTE THAT IN THE FOLLOWING, A "*" IN COLUMN 4 INDICATES THAT THE         I3                                                  
C      FIELD CONTAINS "ICAN" GRIDS, I.E. ONE FOR EACH VEGETATION TYPE.          I3                                                  
C      TWO ADJACENT STARS INDICATE THAT THE FIELD CONTAINS "ICANP1" =           I3                                                  
C      ICAN+1 GRIDS, I.E. AN EXTRA ONE FOR URBAN. CURRENTLY, ICAN=4.            I3                                                  
C      IN ADDITION, THREE ADJACENT STARTS INDICATE THAT THE FIELD               I3                                                  
C      CONTAINS "IGND" GRIDS, I.E. ONE FOR EACH SOIL LAYER.                     I3                                                  
C      THESE DEFINE THE FOLLOWING CANOPY TYPES:                                 I3                                                  
C                                                                               I3                                                  
C           CLASS 1: TALL CONIFEROUS.                                           I3                                                  
C           CLASS 2: TALL BROADLEAF.                                            I3                                                  
C           CLASS 3: ARABLE AND CROPS.                                          I3                                                  
C           CLASS 4: GRASS, SWAMP AND TUNDRA (I.E. OTHER).                      I3                                                  
C           CLASS 5: URBAN (ONLY FOR FCAN,LNZ0,AVW,AIW).                        I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C  **   AIW   WEIGHTED NEAR-IR CANOPY ALBEDO    PERCENTAGE                      I3                                                  
C      ALLW   NEAR-IR CANOPY ALBEDO (SFC)       PERCENTAGE                      I3                                                  
C      ALSW   VISIBLE CANOPY ALBEDO (SFC)       PERCENTAGE                      I3                                                  
C  **   AVW   WEIGHTED VISIBLE CANOPY ALBEDO    PERCENTAGE                      I3                                                  
C  *** CLAY   FRACTION OF CLAY IN SOIL LAYER    FRACTION                        I3                                                  
C  *   CMAS   CANOPY MASS                       KG/M**2                         I3                                                  
C      DPTH   DEPTH OF SOIL                     METRES                          I3                                                  
C       ENV   ENVELOPE OROGRAPHY                METRES                          I3                                                  
C  **  FCAN   AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C        GC   LAND MASK                         -1.=LAND,0.=SEA/ICE             I3                                                  
C        GT   GROUND TEMPERATURE (IDAY ONLY)    DEG K                           I3                                                  
C  *   LAMN   MINIMUM LEAF AREA INDEX               -                           I3                                                  
C  *   LAMX   MAXIMUM LEAF AREA INDEX               -                           I3                                                  
C  **  LNZ0   LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C      MASK   AMIP2 LAND MASK                   -1.=LAND,0.=SEA/ICE             I3                                                  
C  *   ROOT   CANOPY ROOTING DEPTH              METRES                          I3                                                  
C  *** SAND   FRACTION OF SAND IN SOIL LAYER    FRACTION                        I3                                                  
C       SIC   SEA ICE AMOUNT                    KG/M**2                         I3                                                  
C      SICN   AMIP2 SEA ICE CONCENTRATION       PERCENT                         I3                                                  
C       SNO   SNOW DEPTH (IDAY ONLY)            KG/M**2 = MM WATER DEPTH        I3                                                  
C       SST   AMIP2 SEA-SURFACE TEMPERATURE     DEGK                            I3                                                  
C  *** TBAR   SOIL TEMPERATURE  (IDAY ONLY)     DEGK                            I3                                                  
C  *** THIC   SOIL FROZEN WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C  *** THLQ   SOIL LIQUID WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      GGPHYS = GAUSSIAN GRID SURFACE PHYSICS FIELDS:                           I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C  **   AIW   WEIGHTED NEAR-IR CANOPY ALBEDO    FRACTION                        I3                                                  
C      ALLW   NEAR-IR CANOPY ALBEDO (SFC)           -                           I3                                                  
C      ALSW   VISIBLE CANOPY ALBEDO (SFC)           -                           I3                                                  
C  **   AVW   WEIGHTED VISIBLE CANOPY ALBEDO    FRACTION                        I3                                                  
C  *** CLAY   PERCENTAGE OF CLAY IN SOIL LAYER  PERCENTAGE                      I3                                                  
C  *   CMAS   CANOPY MASS                       KG/M**2                         I3                                                  
C      DPTH   DEPTH OF SOIL                     METRES                          I3                                                  
C       ENV   ENVELOPE OROGRAPHY                METRES                          I3                                                  
C  **  FCAN   AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C        GT   GROUND TEMPERATURE                DEG K                           I3                                                  
C  *   LAMN   MINIMUM LEAF AREA INDEX               -                           I3                                                  
C  *   LAMX   MAXIMUM LEAF AREA INDEX               -                           I3                                                  
C  **  LNZ0   LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C  *** ORGM   PERCENTAGE OF ORGM IN SOIL LAYER  PERCENTAGE                      I3                                                  
C  *   ROOT   CANOPY ROOTING DEPTH              METRES                          I3                                                  
C  *** SAND   PERCENTAGE OF SAND IN SOIL LAYER  PERCENTAGE                      I3                                                  
C       SIC   SEA ICE AMOUNT                    KG/M**2                         I3                                                  
C      SICN   AMIP2 SEA ICE CONCENTRATION       FRACTION                        I3                                                  
C       SNO   SNOW DEPTH (IDAY ONLY)            KG/M**2 = MM WATER DEPTH        I3                                                  
C  *** TBAR   SOIL TEMPERATURE  (IDAY ONLY)     DEGK                            I3                                                  
C  *** THIC   SOIL FROZEN WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C  *** THLQ   SOIL LIQUID WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C        ZS   SURFACE HEIGHT ON ANALYSIS GRID   METRES                          I3                                                  
C-----------------------------------------------------------------------------                                                      
C     * IF NO HIGH-RESOLUTION POINTS ARE FOUND WITHIN A PARTICULAR LOW-                                                             
C     * RESOLUTION GRID SQUARE, EVEN AFTER CONSIDERING INFORMATION FROM                                                             
C     * NEAREST-NEIGHBOUR POINTS ON THE GAUSSIAN GRID, AN ABORT CONDITION                                                           
C     * IS GENERATED.                                                                                                               
                                                                                                                                    
C     * HRMASK IS THE HIGH-RESOLUTION OFFSET LAND MASK (LAND=-1., ELSE 0.)                                                          
C     * WHILE MASK IS THE STANDARD LAND MASK AT GAUSSIAN GRID RESOLUTION                                                            
C     * (READ IN) AND GC IS THE ASSOCIATED GAUSSIAN-GRID GROUND COVER FIELD                                                         
C     * WHICH IS GENERATED FROM MASK AND THE AREAL-AVERAGED HRMASK FIELD                                                            
C     * (GC=1. IF THIS IS > 0.5).                                                                                                   
                                                                                                                                    
C     * GH IS GENERALLY THE RESULTING OUTPUT FIELD ARRAY FOR ALL FIELDS.                                                            
                                                                                                                                    
C     * GWL IS ALSO USED TO STORE THE AREAL FRACTIONS OF EACH CANOPY                                                                
C     * CLASS, SINCE THESE ARE REQUIRED TO CALCULATE THE AVERAGED                                                                   
C     * VISIBLE AND NEAR-IR ALBEDOES OF EACH CANOPY TYPE.                                                                           
                                                                                                                                    
C     * GT IS A LOW-RESOLUTION WORK FIELD USED FOR INTERIM STORAGE OF                                                               
C     * THE TEMPERATURE OF THE FIRST SOIL LAYER.                                                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (NLG=360,NLAT=180,IGND=3,NM=12,NM1=NM+1,NLOMAX=18528,                                                               
     1           NHIMAX=NLG*NLAT)                                                                                                   
      INTEGER BI,BJ,BIJV                                                                                                            
      PARAMETER ( BI=361, BJ=181, BIJV=65341 )                                                                                      
C                                                                                                                                   
      REAL GLL(NHIMAX),HRMASK(NHIMAX),GWH(NHIMAX),GWA(NHIMAX),                                                                      
     1     GHR(NHIMAX),DLAY(NHIMAX,3)                                                                                               
      REAL GH(NLOMAX),GL(NLOMAX),GC(NLOMAX),GWL(NLOMAX),                                                                            
     1     GT(NLOMAX),MASK(NLOMAX),GLR(NLOMAX),DPTH(NLOMAX)                                                                         
      REAL DLAT(BJ), DLON(BI)                                                                                                       
      REAL*8 SL(BJ), CL(BJ), WL(BJ), WOSSL(BJ), RAD(BJ)                                                                             
C                                                                                                                                   
C     * 12-MONTH ARRAYS AT LOW-RESOLUTION OF GT,SIC,SICN,TIME WHICH                                                                 
C     * ARE PROCESSED IN ROUTINE CLMMOD IN ORDER TO CONSERVE MONTHLY                                                                
C     * MEANS UPON INTEGRATION (NLOMAX IS THE MAXIMUM NUMBER OF GRID                                                                
C     * POINTS AT LOW RESOLUTION WHICH THE PROGRAM SUPPORTS):                                                                       
C                                                                                                                                   
      REAL GTMO(NLOMAX*NM)                                                                                                          
      REAL SICMO(NLOMAX*NM)                                                                                                         
      REAL SICNMO(NLOMAX*NM)                                                                                                        
      REAL GCMO(NLOMAX*NM)                                                                                                          
      REAL TIME(NLOMAX*NM)                                                                                                          
                                                                                                                                    
C     * INTERNAL ARRAYS FOR ROUTINE CLMMOD:                                                                                         
                                                                                                                                    
      REAL AA(NM,NM),BB(NM),CC(NM,NM),DD(NM)                                                                                        
      REAL A1(NM,NM),B1(NM),C1(NM,NM),D1(NM)                                                                                        
      REAL A2(NM,NM),B2(NM),C2(NM,NM),D2(NM)                                                                                        
                                                                                                                                    
      INTEGER NFDM(NM),MMD(NM),NYYMM(NM)                                                                                            
                                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
C     * WORK ARRAYS FOR SUBROUTINE GGFILL CALLED IN HRTOLR3.                                                                        
                                                                                                                                    
      INTEGER LONB(NLOMAX), LATB(NLOMAX)                                                                                            
C                                                                                                                                   
C     * WORK ARRAYS FOR SUBROUTINE HRTOLR3.                                                                                         
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)                                                                         
                                                                                                                                    
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(BIJV)                                                                                                
                                                                                                                                    
      DATA SICN_MIN/0.0E0/,   SICN_CRT/0.175E0/,                                                                                    
     &      SST_FRZ/271.16E0/, SIC_MIN/45.0E0/                                                                                      
      DATA GTFSW/271.2E0/, DENI/913.E0/                                                                                             
      DATA NFDM/1,32,60,91,121,152,182,213,244,274,305,335/                                                                         
      DATA  MMD/16,46,75,106,136,167,197,228,259,289,320,350/                                                                       
      DATA MAXX,NPGG/BIJV,+1/                                                                                                       
      DATA RLIM /1.E-8/                                                                                                             
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
C     * INITIALIZE "SICMO" ARRAY PASSED TO CLMMOD TO ZERO                                                                           
                                                                                                                                    
      DO I =1,NLOMAX*NM                                                                                                             
       SICMO(I)=0.0                                                                                                                 
      ENDDO                                                                                                                         
                                                                                                                                    
C     NFF=5                                                                                                                         
C     CALL JCLPNT(NFF,99,88,1,2,6)                                                                                                  
      NFF=6                                                                                                                         
      CALL JCLPNT(NFF,99,88,77,1,2,6)                                                                                               
                                                                                                                                    
      REWIND 2                                                                                                                      
      INTERP=1                                                                                                                      
                                                                                                                                    
C     * READ DAY OF THE YEAR, GAUSSIAN GRID SIZE AND LAND SURFACE SCHEME                                                            
C     * CODE FROM CONTROL FILE.                                                                                                     
                                                                                                                                    
      REWIND 99                                                                                                                     
      READ(99,END=910) LABL                                                                                                         
      READ(99,END=911) LABL,IXX,IXX,ILG,ILAT,IXX,IDAY,IXX,IXX                                                                       
      ILG1  = ILG+1                                                                                                                 
      ILATH = ILAT/2                                                                                                                
      LGG   = ILG1*ILAT                                                                                                             
      WRITE(6,6010)  IDAY,ILG1,ILAT                                                                                                 
                                                                                                                                    
C     * GAUSSG COMPUTES THE VALUE OF THE GAUSSIAN LATITUDES AND THEIR                                                               
C     * SINES AND COSINES. TRIGL MAKES THEM GLOBAL (S TO N).                                                                        
                                                                                                                                    
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
                                                                                                                                    
      DO 100 I=1,ILAT                                                                                                               
          DLAT(I) = RAD(I)*180.E0/3.14159E0                                                                                         
  100 CONTINUE                                                                                                                      
                                                                                                                                    
C     * DEFINE LONGITUDE VECTOR FOR GAUSSIAN GRID.                                                                                  
                                                                                                                                    
      DGX=360.E0/(FLOAT(ILG))                                                                                                       
      DO 120 I=1,ILG1                                                                                                               
          DLON(I)=DGX*FLOAT(I-1)                                                                                                    
  120 CONTINUE                                                                                                                      
                                                                                                                                    
      NMO=12                                                                                                                        
C                                                                                                                                   
C     * DEFINE TARGET GRID TYPE FOR SUBROUTINE HRTOLR3 (GAUSSIAN GRID).                                                             
C                                                                                                                                   
      IGRID=0                                                                                                                       
C                                                                                                                                   
C     * READ-IN THE STANDARD LAND MASK ON THE MODEL GAUSSIAN GRID.                                                                  
C     * IN CASE IT CONTAINS INFORMATION ON LAKES (GC=+2) AND IS PACKED,                                                             
C     * PROCESS THE FIELD TO GET ONLY VALUES OF (-1/0) FOR (LAND/NOLAND)                                                            
C     * BEFORE PROCESSING FURTHER.                                                                                                  
C     * NOTE THAT THIS IS DONE *AFTER* SAVING TO THE AN FILE, SINCE                                                                 
C     * INFORMATION ON LAKES MAY BE REQUIRED BY THE MODEL.                                                                          
C                                                                                                                                   
      NDAY=0                                                                                                                        
      CALL GETFLD2(88,MASK,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),                                                                      
     +                                         0,IBUF,MAXX,OK)                                                                      
      IF(.NOT.OK) CALL                             XIT('INITG10',-1)                                                                
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 125 I=1,LGG                                                                                                                
          IVALM=NINT(MASK(I))                                                                                                       
          MASK(I)=REAL(IVALM)                                                                                                       
  125 CONTINUE                                                                                                                      
C                                                                                                                                   
      IBUF(3)=NC4TO8("MASK")                                                                                                        
      IBUF(4)=1                                                                                                                     
      IBUF(8)=1                                                                                                                     
      CALL PUTFLD2(2,MASK,IBUF,MAXX)                                                                                                
      WRITE(6,6026) IBUF                                                                                                            
C                                                                                                                                   
      DO 126 I=1,LGG                                                                                                                
          MASK(I)=MIN(0.E0, MASK(I))                                                                                                
  126 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * SAVE HIGH-RES LAND MASK (-1./0.) INTO ARRAY "HRMASK", FOR USE                                                               
C     * IN PROCESSING SUBSEQUENT FIELDS.                                                                                            
C     * SET HIGH-RES LAND MASK TO GLACIER LAND SOUTH OF 78.5S TO                                                                    
C     * MAKE ROSS AND WEDELL SEA ICE SHELVES "GLACIERS".                                                                            
C                                                                                                                                   
      CALL GETFLD2(-1,HRMASK,NC4TO8("GRID"),NDAY,NC4TO8("MASK"),                                                                    
     +                                           1,IBUF,MAXX,OK)                                                                    
      IF(.NOT.OK) CALL                             XIT('INITG10',-2)                                                                
      WRITE(6,6025) IBUF                                                                                                            
                                                                                                                                    
      IGLAC=IBUF(5)*12                                                                                                              
      LLL=IBUF(5)*IBUF(6)                                                                                                           
C                                                                                                                                   
      DO 127 I=1,LLL                                                                                                                
          IF(I.LE.IGLAC) HRMASK(I)=-1.E0                                                                                            
  127 CONTINUE                                                                                                                      
C=====================================================================                                                              
C     * FIELDS FOR EACH OF TWELVE MID-MONTHS:                                                                                       
C                                                                                                                                   
C     * LOOP OVER MONTHS.                                                                                                           
C                                                                                                                                   
      DO 250 N=1,NMO                                                                                                                
C---------------------------------------------------------------------                                                              
        NDAY=MMD(N)                                                                                                                 
        NYYMM(N)=NDAY                                                                                                               
C                                                                                                                                   
C       * GET AMIP2 SEA-ICE CONCENTRATION, CONVERT TO FRACTION AND                                                                  
C       * AREA-AVERAGE TO GAUSSIAN GRID.                                                                                            
                                                                                                                                    
        CALL GETFLD2(-1,GHR,NC4TO8("GRID"),MMD(N),NC4TO8("SICN"),                                                                   
     +                                            1,IBUF,MAXX,OK)                                                                   
        IF(.NOT.OK) CALL                           XIT('INITG10',-3)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        DO 130 I=1,LLL                                                                                                              
            GHR(I)=0.01E0*GHR(I)                                                                                                    
            IF(HRMASK(I).EQ.-1.E0) GHR(I)=0.E0                                                                                      
  130   CONTINUE                                                                                                                    
C                                                                                                                                   
        IOPTION=2                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GHR,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INITG10',-4)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
C       * STORE THIS MONTH'S RESULT INTO TIME-SERIES ARRAY FOR SUBSEQUENT                                                           
C       * PROCESSING, AS WELL AS WORK ARRAY "GLR" FOR USE IN                                                                        
C       * CONSISTENCY CHECKS WITH SEA-ICE MASS AT LOW RESOLUTION.                                                                   
C                                                                                                                                   
        DO 131 I=1,LGG                                                                                                              
            NI=(N-1)*ILG1*ILAT+I                                                                                                    
            GH(I)=MIN(1.0E0,MAX(0.0E0,GH(I)))                                                                                       
            GH(I) = MERGE(0.E0, GH(I), MASK(I).EQ.-1.E0)                                                                            
            GLR(I)=GH(I)                                                                                                            
            SICNMO(NI)=GH(I)                                                                                                        
  131   CONTINUE                                                                                                                    
C                                                                                                                                   
C       * NOW COMBINE THE "GH" AND "MASK" FIELDS, WHERE LAND IS                                                                     
C       * DETERMINED FROM "MASK" AND WATER/SEA-ICE FROM "GH".                                                                       
C       * STORE THIS MONTH'S RESULT INTO AN ARRAY FOR SUBSEQUENT                                                                    
C       * PROCESSING AS A "PSEUDO" GROUND COVER.                                                                                    
                                                                                                                                    
        DO 132 I=1,LGG                                                                                                              
            NI=(N-1)*ILG1*ILAT+I                                                                                                    
            IF(MASK(I).EQ.-1.E0)         THEN                                                                                       
                GC(I)=MASK(I)                                                                                                       
            ELSE                                                                                                                    
                IF(GH(I).GE.SICN_CRT)   THEN                                                                                        
                    GC(I)=1.E0                                                                                                      
                ELSE                                                                                                                
                    GC(I)=0.E0                                                                                                      
                ENDIF                                                                                                               
          ENDIF                                                                                                                     
          GCMO(NI)=GC(I)                                                                                                            
  132   CONTINUE                                                                                                                    
C                                                                                                                                   
C------------------------------------------------------------------------                                                           
C       * SST (DEG K) (12 MONTHS).                                                                                                  
                                                                                                                                    
        CALL GETFLD2(-1,GWA,NC4TO8("GRID"),MMD(N),NC4TO8(" SST"),                                                                   
     +                                            1,IBUF,MAXX,OK)                                                                   
        IF(.NOT.OK) CALL                           XIT('INITG10',-5)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=2                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GWA,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INITG10',-6)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
C       * ENSURE SST'S AREN'T BELOW FREEZING OVER "WATER" (DEFINED                                                                  
C       * BY PSEUDO GROUND COVER).                                                                                                  
C       * SET FIRST AND THIRD SOIL LAYER TEMPERATURES TO VALUE                                                                      
C       * STORED IN MID-JANUARY, SINCE ALL MONTHS HAVE SAME INFORMATION                                                             
C       * OVER LAND IN ORDER TO START MODEL. THIS WILL BE REPLACED BY                                                               
C       * READING IN OF TBAR,THLQ AND THIC AFTER A LONGER CLIMATOLOGY                                                               
C       * HAS BEEN RUN.                                                                                                             
C                                                                                                                                   
        DO 134 I=1,LGG                                                                                                              
            IF(GC(I).EQ.0.E0) GH(I)=MAX(GH(I),GTFSW)                                                                                
  134   CONTINUE                                                                                                                    
C                                                                                                                                   
C       * STORE THIS MONTH'S RESULT INTO 12-MONTH ARRAY FOR SUBSEQUENT                                                              
C       * PROCESSING.                                                                                                               
C                                                                                                                                   
                                                                                                                                    
        DO 138 I=1,LGG                                                                                                              
          NI=(N-1)*ILG1*ILAT+I                                                                                                      
          GTMO(NI)=GH(I)                                                                                                            
  138   CONTINUE                                                                                                                    
C------------------------------------------------------------------------                                                           
C       * SEA ICE AMOUNT (KG M-2) (12 MONTHS)                                                                                       
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),NDAY,NC4TO8(" SIC"),                                                                     
     +                                          1,IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-7)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
C       * SET HIGH-RES VALUES TO THOSE OF GLACIER LAND SOUTH OF 78.5S                                                               
C       * TO MAKE ROSS AND WEDELL SEA ICE SHELVES "GLACIERS".                                                                       
C                                                                                                                                   
        DO 141 I=1,LLL                                                                                                              
            IF(I.LE.IGLAC) GLL(I)=0.E0                                                                                              
            IF(GHR(I).EQ.0.E0)    THEN                                                                                              
                GLL(I)=0.E0                                                                                                         
            ELSE                                                                                                                    
C               SICN_CLP=MIN(GHR(I),1.)                                                                                             
C               SICN_CLP=MAX(SICN_CLP,SICN_MIN)                                                                                     
C               HLIM=MAX(6.0*(SICN_CLP-SICN_CRT)/(1.0-SICN_CRT)                                                                     
C    1              +SIC_MIN/(DENI*SICN_CRT),0.)                                                                                    
C               SIC_MAX=DENI*HLIM*SICN_CLP                                                                                          
C               GLL(I)=MIN(GLL(I),SIC_MAX)                                                                                          
                GLL(I)=MAX(GLL(I),SIC_MIN)                                                                                          
            ENDIF                                                                                                                   
  141   CONTINUE                                                                                                                    
C                                                                                                                                   
        IOPTION=2                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INITG10',-8)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
C       * ENSURE CONSISTENCY BETWEEN SEA-ICE CONCENTRATION AND MASS FIELDS.                                                         
C                                                                                                                                   
        DO 150 I=1,LGG                                                                                                              
          GH(I)=MERGE(0.E0,GH(I),GC(I).EQ.-1.E0)                                                                                    
          GHOLD=GH(I)                                                                                                               
          IF(GLR(I).EQ.0.E0)    THEN                                                                                                
              GH(I)=0.E0                                                                                                            
          ELSE                                                                                                                      
C             SICN_CLP=MIN(GLR(I),1.)                                                                                               
C             SICN_CLP=MAX(SICN_CLP,SICN_MIN)                                                                                       
C             HLIM=MAX(6.0*(SICN_CLP-SICN_CRT)/(1.0-SICN_CRT)                                                                       
C    1            +SIC_MIN/(DENI*SICN_CRT),0.)                                                                                      
C             SIC_MAX=DENI*HLIM*SICN_CLP                                                                                            
C             GH(I)=MIN(GH(I),SIC_MAX)                                                                                              
              GH(I)=MAX(GH(I),SIC_MIN)                                                                                              
          ENDIF                                                                                                                     
C         IF(I.EQ.440) THEN                                                                                                         
C          PRINT *,' N,I,GHOLD,GHNEW = ',N,I,GHOLD,GH(I)                                                                            
C         ENDIF                                                                                                                     
  150   CONTINUE                                                                                                                    
C                                                                                                                                   
C       * SAVE SIC FIELD NOW; THIS DOES NOT UNDERGO CONSERVATION                                                                    
C       * OF MONTHLY MEANS!                                                                                                         
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("DUMM"),1,                                                                         
     +                                    ILG1,ILAT,0,NPGG)                                                                         
        IBUF(2) = MMD(N)                                                                                                            
C                                                                                                                                   
        IBUF(3) = NC4TO8("SICN")                                                                                                    
        CALL PUTFLD2(2,GLR,IBUF,MAXX)                                                                                               
        WRITE(6,6026) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3) = NC4TO8(" SIC")                                                                                                    
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C                                                                                                                                   
  250 CONTINUE                                                                                                                      
C---------------------------------------------------------------------C                                                             
C                                                                                                                                   
C     * CALL ROUTINE TO PROCESS GT,SIC AND SICN TO CONSERVE MONTHLY                                                                 
C     * MEANS UPON INTEGRATION AND WRITE OUT RESULTS FOR EACH MONTH.                                                                
C                                                                                                                                   
      CALL CLMMOD(GTMO,SICNMO,SICMO,GCMO,TIME,                                                                                      
     1            NFDM, MMD, NYYMM, NM, ILG1, ILAT,                                                                                 
     2            AA,BB,CC,DD,A1,B1,C1,D1,A2,B2,C2,D2,                                                                              
     3            SICN_MIN,SICN_CRT,SST_FRZ,SIC_MIN)                                                                                
C                                                                                                                                   
C     * NOW WRITE OUT THE RESULTS FOR EACH MONTH.                                                                                   
C     * AGAIN, NOTE BECAUSE OF DIMENSIONING OF 12-MONTH ARRAYS TO                                                                   
C     * HANDLE VARIABLE-DIMENSION GRID SIZES UP TO "NLOMAX", WE                                                                     
C     * MUST USE THE WORK ARRAY "GH" TO WRITE OUT DATA                                                                              
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("DUMM"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
C                                                                                                                                   
      DO 255 N=1,NMO                                                                                                                
          IBUF(2) = MMD(N)                                                                                                          
C                                                                                                                                   
          DO 251 I=1,LGG                                                                                                            
            NI=(N-1)*ILG1*ILAT+I                                                                                                    
            GH(I)=GTMO(NI)                                                                                                          
  251     CONTINUE                                                                                                                  
          IBUF(3) = NC4TO8("  GT")                                                                                                  
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
  255 CONTINUE                                                                                                                      
C=====================================================================                                                              
C     * FIELDS FOR IDAY:                                                                                                            
C---------------------------------------------------------------------                                                              
C                                                                                                                                   
C     * SEA-ICE CONCENTRATION (IDAY ONLY).                                                                                          
                                                                                                                                    
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("SICN"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITG10',-9)                                                                
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 256 I=1,LLL                                                                                                                
        GWH(I)=MAX(0.0E0,GWH(I))                                                                                                    
        IF(HRMASK(I).EQ.-1.E0) GWH(I)=0.E0                                                                                          
  256 CONTINUE                                                                                                                      
C                                                                                                                                   
      IOPTION=2                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-10)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 257 I=1,LGG                                                                                                                
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                                                                                     
        GH(I) = MERGE(0.E0, GH(I), MASK(I).EQ.-1.E0)                                                                                
  257 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("SICN"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * SEA-ICE MASS (IDAY ONLY).                                                                                                   
                                                                                                                                    
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8(" SIC"),                                                                       
     +                                        1,IBUF,MAXX,OK)                                                                       
      IF(.NOT.OK) CALL                             XIT('INITG10',-11)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 258 I=1,LLL                                                                                                                
        GWH(I)=MAX(0.0E0,GWH(I))                                                                                                    
        IF(HRMASK(I).EQ.-1.E0) GWH(I)=0.E0                                                                                          
  258 CONTINUE                                                                                                                      
C                                                                                                                                   
      IOPTION=2                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-12)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 259 I=1,LGG                                                                                                                
        GH(I) = MERGE(0.E0, MAX(0.E0,GH(I)), MASK(I).EQ.-1.E0)                                                                      
  259 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8(" SIC"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C----------------------------------------------------------------------                                                             
C     * SAVE HIGH-RES LAND MASK (-1./0.) INTO ARRAY "HRMASK", FOR USE                                                               
C     * IN PROCESSING SUBSEQUENT FIELDS.                                                                                            
C     * *** NOTE *** WE CHANGE THE LAND MASK NOW BECAUSE SUBSEQUENT                                                                 
C     * DERIVED FIELD ARE CONSISTENT WITH SCRIPPS LAND MASK!!!!!                                                                    
C     * SET HIGH-RES LAND MASK TO GLACIER LAND SOUTH OF 78.5S TO                                                                    
C     * MAKE ROSS AND WEDELL SEA ICE SHELVES "GLACIERS".                                                                            
C                                                                                                                                   
      CALL GETFLD2(-1,HRMASK,NC4TO8("GRID"),0,NC4TO8("  GC"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITG10',-13)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 260 I=1,LLL                                                                                                                
          IF(I.LE.IGLAC) HRMASK(I)=-1.E0                                                                                            
  260 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * GROUND TEMPERATURE (IDAY ONLY).                                                                                             
C                                                                                                                                   
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("  GT"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITG10',-14)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-15)                                                               
      ENDIF                                                                                                                         
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("  GT"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * SNOW DEPTH (KG/M**2 WATER EQUIVALENT = MM SNOW).                                                                            
C     * MAKE SURE SNOW IS NOT NEGATIVE.                                                                                             
C     * IDAY ONLY.                                                                                                                  
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),IDAY,NC4TO8(" SNO"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITG10',-16)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 261 I=1,LLL                                                                                                                
        GLL(I)=MAX(0.0E0,GLL(I))                                                                                                    
  261 CONTINUE                                                                                                                      
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-17)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 262 I=1,LGG                                                                                                                
        GH(I)=MAX(0.0E0,GH(I))                                                                                                      
  262 CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8(" SNO"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * SOIL TEMPERATURES, LIQUID AND FROZEN WATER CONTENTS (IDAY ONLY).                                                            
C     * ZERO OUT THESE OVER NON-LAND POINTS, SINCE FIELD NOT                                                                        
C     * RELEVANT OTHERWISE. NOTE FIELDS ARE UNPACKED (NPGG=1)                                                                       
C     * SO THAT PACKING IS NOT A CONCERN.                                                                                           
C                                                                                                                                   
      DO 269 L=1,IGND                                                                                                               
C                                                                                                                                   
          CALL GETFLD2(-1,GHR,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),                                                                   
     +                                            L,IBUF,MAXX,OK)                                                                   
          IF(.NOT.OK) CALL                         XIT('INITG10',-18)                                                               
          WRITE(6,6025) IBUF                                                                                                        
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR3(GT,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                             
     1                 GHR,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                   
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                   
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITG10',-19)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
          CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("THLQ"),                                                                   
     +                                            L,IBUF,MAXX,OK)                                                                   
          IF(.NOT.OK) CALL                         XIT('INITG10',-20)                                                               
          WRITE(6,6025) IBUF                                                                                                        
C                                                                                                                                   
          DO 266 I=1,LLL                                                                                                            
            GWH(I)=MAX(0.0E0,GWH(I))                                                                                                
            IF(HRMASK(I).NE.-1.E0) GWH(I)=0.E0                                                                                      
  266     CONTINUE                                                                                                                  
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                             
     1                 GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                   
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                   
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITG10',-21)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
          CALL GETFLD2(-1,GWA,NC4TO8("GRID"),IDAY,NC4TO8("THIC"),                                                                   
     +                                            L,IBUF,MAXX,OK)                                                                   
          IF(.NOT.OK) CALL                         XIT('INITG10',-22)                                                               
          WRITE(6,6025) IBUF                                                                                                        
C                                                                                                                                   
          DO 267 I=1,LLL                                                                                                            
            GWA(I)=MAX(0.0E0,GWA(I))                                                                                                
            IF(HRMASK(I).NE.-1.E0) GWA(I)=0.E0                                                                                      
  267     CONTINUE                                                                                                                  
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR3(GL,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                             
     1                 GWA,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                   
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                   
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITG10',-23)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
          THLMIN=0.04E0                                                                                                             
          DO 268 I=1,LGG                                                                                                            
              IF(MASK(I).GT.-1.E0) THEN                                                                                             
                GT(I)=0.E0                                                                                                          
                GH(I)=0.E0                                                                                                          
                GL(I)=0.E0                                                                                                          
              ELSE                                                                                                                  
                GH(I)=MAX(GH(I),THLMIN)                                                                                             
                GL(I)=MAX(GL(I),THLMIN)                                                                                             
              ENDIF                                                                                                                 
  268     CONTINUE                                                                                                                  
C                                                                                                                                   
          CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),L,                                                                    
     +                                         ILG1,ILAT,0,NPGG)                                                                    
          CALL PUTFLD2(2,GT,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
          CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("THLQ"),L,                                                                    
     +                                         ILG1,ILAT,0,NPGG)                                                                    
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
          CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("THIC"),L,                                                                    
     +                                         ILG1,ILAT,0,NPGG)                                                                    
          CALL PUTFLD2(2,GL,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
  269 CONTINUE                                                                                                                      
C=====================================================================                                                              
C     * INVARIANT FIELDS:                                                                                                           
C---------------------------------------------------------------------                                                              
C     * ENVELOPE OROGRAPHY (VARIANCE IN M2).                                                                                        
C     * PUT VALUES TO ZERO OVER SEA ICE AND OCEAN POINTS.                                                                           
                                                                                                                                    
C     CALL GETFLD2(-1,GLL,4HGRID,0,4H ENV,1,IBUF,MAXX,OK)                                                                           
C     IF(.NOT.OK) CALL                             XIT('INITG10',-24)                                                               
C     WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
C     DO 270 I=1,LLL                                                                                                                
C         GLL(I)=MAX(0.0,GLL(I))                                                                                                    
C         IF(HRMASK(I).NE.-1.) GLL(I)=0.                                                                                            
C 270 CONTINUE                                                                                                                      
C                                                                                                                                   
C     IOPTION=1                                                                                                                     
C     ICHOICE=1                                                                                                                     
C     CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
C    1             GLL,HRMASK,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,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
C     IF(.NOT.OK)THEN                                                                                                               
C       WRITE(6,6030) LONBAD,LATBAD                                                                                                 
C       CALL                                       XIT('INITG10',-25)                                                               
C     ENDIF                                                                                                                         
C                                                                                                                                   
C     DO 271 I=1,LGG                                                                                                                
C       GH(I) = CVMGT (MAX(GH(I),0.0), 0.0, MASK(I).LT.0.0)                                                                         
C 271 CONTINUE                                                                                                                      
                                                                                                                                    
C     CALL SETLAB(IBUF,4HGRID,0,4H ENV,1,ILG1,ILAT,0,NPGG)                                                                          
C     CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
C     WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
C     * JUST READ IN PARAMETERS FOR SUB-GRID TOPOG DIRECTLY                                                                         
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8("  SD"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-26)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("  SD"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8(" GAM"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-27)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8(" GAM"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8(" PSI"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-28)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8(" PSI"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8("ALPH"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-29)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALPH"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8("DELT"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-30)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("DELT"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-77,GH,NC4TO8("GRID"),0,NC4TO8("SIGX"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-31)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("SIGX"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
                                                                                                                                    
C---------------------------------------------------------------------                                                              
C     * CREATE A HIGH-RES MASK OF DISCRETE-VALUED FLAGS (-4=GLACIER,                                                                
C     * -3=ROCK, -2=ORGANIC, -1=WATER, OTHERWISE ZERO) FROM DATA IN                                                                 
C     * HIGH-RES SANDINESS FIELD (STORE IN "GWA") AND USER HRTOLR3 TO PRODUCE                                                       
C     * THE RESULTING LOW-RES DISCRETE-VALUED FIELD ("GL") WHICH IS                                                                 
C     * SUBSEQUENTLY INSERTED BACK INTO THE AREA-AVERAGED SAND/CLAY.                                                                
C******************************************************************                                                                 
C     * FOR THIS VERSION, THIS IS NOT DONE FOR ORGANIC SOILS AS                                                                     
C     * THERE IS NO ORGANIC SOIL MODEL YET. SO, HIGH-RES ORGANIC                                                                    
C     * POINTS ARE *NOT* INCLUDED IN THE AREA-AVERAGING TO GET THE                                                                  
C     * PSEUDO HIGH-RES LAND MASK "GHR". FOR LATER VERSIONS WITH                                                                    
C     * AN ORGANIC MODEL, REMOVE THIS RESTRICTION AND THE REST                                                                      
C     * SHOULD FOLLOW (ALSO REMOVE THE CALL TO ABORT IF GL=-2)!!!!                                                                  
C******************************************************************                                                                 
C     * SET HIGH-RES LAND MASK TO GLACIER LAND SOUTH OF 78.5S TO                                                                    
C     * MAKE ROSS AND WEDELL SEA ICE SHELVES "GLACIERS".                                                                            
                                                                                                                                    
C     * DEFINE A HIGH-RES MASK OF SOIL/NOSOIL AND STORE IN WORK                                                                     
C     * ARRAY "GHR". GHR=-1 IF GWA.NE.-1; OTHERWISE GHR=0.                                                                          
C     * THIS WILL BE SUBSEQUENTLY USED IN THE AREA-AVERAGING FOR                                                                    
C     * SOIL CHARACTERISTICS.                                                                                                       
C                                                                                                                                   
      CALL GETFLD2(-1,GWA,NC4TO8("GRID"),0,NC4TO8("SAND"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      WRITE(6,6025) IBUF                                                                                                            
      IF(.NOT.OK) CALL                             XIT('INITG10',-32)                                                               
C                                                                                                                                   
      DO 555 I=1,LLL                                                                                                                
        GWA(I)=MIN(GWA(I),0.E0)                                                                                                     
        IF(I.LE.IGLAC) GWA(I)=-4.E0                                                                                                 
C ************************************************************                                                                      
C       * REPLACE IF CONDITION BY THE FOLLOWING WHEN AN ORGANIC                                                                     
C       * SOIL MODEL IS IN PLACE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!                                                                   
C                                                                                                                                   
C       IF(GWA(I).EQ.-1.)    THEN                                                                                                   
C ************************************************************                                                                      
        IF(GWA(I).EQ.-1.E0 .OR. GWA(I).EQ.-2.E0)    THEN                                                                            
           GHR(I)=0.E0                                                                                                              
        ELSE                                                                                                                        
           GHR(I)=-1.E0                                                                                                             
        ENDIF                                                                                                                       
  555 CONTINUE                                                                                                                      
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=0                                                                                                                     
      CALL HRTOLR3(GL,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GWA,GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                          
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-33)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * ENSURE CONSISTENCY BETWEEN LAND MASK ("MASK") AND SOIL                                                                      
C     * MASK, AT LOW RESOLUTION. TRUE NON-LAND POINTS (MASK=0)                                                                      
C     * MUST BE TURNED INTO WATER AT LOW RESOLUTION FOR SOIL                                                                        
C     * DATA MANIPULATION.                                                                                                          
C     * SET LOW-RES VALUES IN "GL" TO -4 S OF 60S IF MASK INDICATES                                                                 
C     * LAND, FOR CONSISTENCY. THIS IS NECESSARY BECAUSE SOME                                                                       
C     * WATER POINTS WERE MANUALLY CHANGED TO GLACIER BY HAND TO                                                                    
C     * SATISFY THE OCEAN MODEL REQUIREMENTS IN PRODUCING THE                                                                       
C     * LOW-RES LAND MASK.                                                                                                          
C     **********************************************************                                                                    
C     * IN THE CASE WHERE THE TRUE MASK INDICATES LAND BUT                                                                          
C     * THE SOIL DATA DOESN'T, THE SOIL DATA IS CHANGED TO                                                                          
C     * "LAND" (NOT GLACIER OR ORGANIC - SO THE PRINTOUT MUST                                                                       
C     * BE CHECKED CAREFULLY!!) AND A WARNING MESSAGE IS GENERATED.                                                                 
C     **********************************************************                                                                    
C     * DEFINE A LOW-RES MASK OF SOIL/NOSOIL AND STORE IN WORK                                                                      
C     * ARRAY "GLR". GLR=-1 IF GL.NE.-1; OTHERWISE GLR=0.                                                                           
C     * THIS WILL BE SUBSEQUENTLY USED IN THE AREA-AVERAGING FOR                                                                    
C     * SOIL CHARACTERISTICS.                                                                                                       
C                                                                                                                                   
C     * WE ENSURE LOOP 558 DOES NOT VECTORIZE, BECAUSE THE                                                                          
C     * COMPILER HAS PROBLEMS WITH RANGE OF "DLAT"'                                                                                 
C                                                                                                                                   
*vdir novector                                                                                                                      
      DO 558 I=1,LGG                                                                                                                
        IF(MASK(I).EQ.0.E0) GL(I)=-1.E0                                                                                             
        LAT=(I-1)/ILG1+1                                                                                                            
        LON=I-(LAT-1)*ILG1                                                                                                          
        IF(DLAT(LAT).LE.-60.E0 .AND. MASK(I).EQ.-1.E0) GL(I)=-4.E0                                                                  
        IF(GL(I).NE.-1.E0)    THEN                                                                                                  
           GLR(I)=-1.E0                                                                                                             
        ELSE                                                                                                                        
           GLR(I)=0.E0                                                                                                              
        ENDIF                                                                                                                       
        IF(MASK(I).EQ.-1.E0 .AND. GLR(I).EQ.0.E0)          THEN                                                                     
           WRITE(6,6040) I,LON,LAT,MASK(I),GLR(I),GL(I)                                                                             
           GLR(I)=-1.E0                                                                                                             
           GL(I)=0.E0                                                                                                               
        ENDIF                                                                                                                       
        IF(GL(I).EQ.-2.E0)                               THEN                                                                       
           WRITE(6,6045) I,LON,LAT,MASK(I),GL(I)                                                                                    
        ENDIF                                                                                                                       
        IF(GL(I).EQ.-3.E0)                               THEN                                                                       
           WRITE(6,6050) I,LON,LAT,MASK(I),GL(I)                                                                                    
        ENDIF                                                                                                                       
  558 CONTINUE                                                                                                                      
C---------------------------------------------------------------------                                                              
C     * SOIL DEPTH (METRES) AND DRAINAGE (SCALE OF 0-1).                                                                            
                                                                                                                                    
C     * USE HIGH-RES INFORMATION OF SOIL DEPTH TO SET A MASK OF 0/1 FOR                                                             
C     * DRAINAGE AT HIGH RESOLUTION (DRN=0 FOR DPTH<4.1M, OTRW DRN=1)                                                               
C     * AND THEN AREA-AVERAGE. USE WORK FIELD GWH TO STORE 0/1 VALUES                                                               
C     * AT HIGH-RESOLUTION AND GWL FOR RESULTING LOW-RES FIELD.                                                                     
C     * INSERT BACK IN FLAGS AT LOW RESOLUTION AFTERWARDS.                                                                          
C     * STORE BACK RESULTING LOW-RESOLUTION DEPTH INTO ARRAY "DPTH"                                                                 
C     * TO RE-SET CONSISTENT ROCK FLAG (-3) USED IN MODEL.                                                                          
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("DPTH"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-34)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 560 I=1,LLL                                                                                                                
        GLL(I)=MAX(GLL(I),0.E0)                                                                                                     
        IF(GLL(I).LT.4.1E0) THEN                                                                                                    
          GWH(I)=0.E0                                                                                                               
        ELSE                                                                                                                        
          GWH(I)=1.E0                                                                                                               
        ENDIF                                                                                                                       
  560 CONTINUE                                                                                                                      
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,GLR,ILG1,ILAT,DLON,DLAT,ILG,                                                                                  
     1             GLL,GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                          
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-35)                                                               
      ENDIF                                                                                                                         
                                                                                                                                    
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GWL,GLR,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GWH,GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                          
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-36)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 570 I=1,LGG                                                                                                                
        IF(GL(I).LT.0.E0) THEN                                                                                                      
         GH (I)=GL(I)                                                                                                               
         GWL(I)=GL(I)                                                                                                               
        ELSE                                                                                                                        
         GWL(I) = MAX (MIN (GWL(I), 1.0E0), 0.E0)                                                                                   
         GH(I)  = MAX (GH(I), 0.E0)                                                                                                 
         IF(GH(I)-0.10E0 .GE. 0.E0 .AND. GH(I)-0.10E0 .LT.RLIM) THEN                                                                
           GH(I)=0.10E0                                                                                                             
         ELSE                                                                                                                       
           IF(GH(I)-0.35E0 .GE. 0.E0 .AND. GH(I)-0.35E0 .LT.RLIM)                                                                   
     &        GH(I)= 0.35E0                                                                                                         
         ENDIF                                                                                                                      
        ENDIF                                                                                                                       
        DPTH(I)=GH(I)                                                                                                               
  570 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("DPTH"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C                                                                                                                                   
      IBUF(3)=NC4TO8(" DRN")                                                                                                        
      CALL PUTFLD2(2,GWL,IBUF,MAXX)                                                                                                 
      WRITE(6,6026) IBUF                                                                                                            
C                                                                                                                                   
C     * STORE THE DEPTHS OF THE SOIL LAYERS INTO DLAY AND REDUCE                                                                    
C     * TO THE GAUSSIAN GRID FOR SUBSEQUENT USE IN DETERMINING                                                                      
C     * LAYER SAND/CLAY FRACTIONS (IN WORK ARRAY "GT").                                                                             
C                                                                                                                                   
      DO 580 I=1,LLL                                                                                                                
        IF(GLL(I).GE.0.35E0)        THEN                                                                                            
           DLAY(I,1)=0.10E0                                                                                                         
           DLAY(I,2)=0.25E0                                                                                                         
           DLAY(I,3)=GLL(I)-0.35E0                                                                                                  
        ELSE IF(GLL(I).GE.0.10E0 .AND. GLL(I).LT.0.35E0) THEN                                                                       
           DLAY(I,1)=0.10E0                                                                                                         
           DLAY(I,2)=GLL(I)-0.10E0                                                                                                  
           DLAY(I,3)=0.E0                                                                                                           
        ELSE IF(GLL(I).GE.0.E0 .AND. GLL(I).LT.0.10E0) THEN                                                                         
           DLAY(I,1)=GLL(I)                                                                                                         
           DLAY(I,2)=0.E0                                                                                                           
           DLAY(I,3)=0.E0                                                                                                           
        ELSE                                                                                                                        
           DLAY(I,1)=0.E0                                                                                                           
           DLAY(I,2)=0.E0                                                                                                           
           DLAY(I,3)=0.E0                                                                                                           
        ENDIF                                                                                                                       
  580 CONTINUE                                                                                                                      
C---------------------------------------------------------------------                                                              
C     * SOIL: SAND, CLAY AND ORGANIC MATTER.                                                                                        
C                                                                                                                                   
C     * FOR NOW, ORGANIC MATTER IS SET TO ZERO.                                                                                     
C                                                                                                                                   
C     * LOOP OVER "IGND" SOIL LAYERS. USE GLL/GH FOR SAND AND GWH/GWL                                                               
C     * FOR CLAY.                                                                                                                   
C     * THE FIRST TWO SOIL LAYERS ARE AVERAGED AS USUAL, BASED ON                                                                   
C     * SOIL MASK (GHR/GLR).                                                                                                        
C     * A WEIGHTED AVERAGE BASED ON THE LAYER THICKNESS IS USED, SINCE                                                              
C     * PART OF THE LAYER MAY BE BEDROCK.                                                                                           
C     * CONVERT TO PERCENTAGE AND STORE BACK IN LOW-RESOLUTION FLAGS                                                                
C     * AT END.                                                                                                                     
C                                                                                                                                   
      DO 620 K = 1,IGND                                                                                                             
C                                                                                                                                   
C     * FIRST AREA-AVERAGE THE SOIL DEPTH FOR THE LAYER.                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GT,GLR,ILG1,ILAT,DLON,DLAT,ILG,                                                                                  
     1             DLAY(1,K),GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                    
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-37)                                                               
      ENDIF                                                                                                                         
                                                                                                                                    
C                                                                                                                                   
C         * FIRST GET HIGH-RES FIELDS.                                                                                              
C                                                                                                                                   
          CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("SAND"),K,                                                                    
     +                                             IBUF,MAXX,OK)                                                                    
          IF(.NOT.OK) CALL                         XIT('INITG10',-38)                                                               
          WRITE(6,6025) IBUF                                                                                                        
                                                                                                                                    
          CALL GETFLD2(-1,GWH,NC4TO8("GRID"),0,NC4TO8("CLAY"),K,                                                                    
     +                                             IBUF,MAXX,OK)                                                                    
          IF(.NOT.OK) CALL                         XIT('INITG10',-39)                                                               
          WRITE(6,6025) IBUF                                                                                                        
C                                                                                                                                   
C         * MULTIPLY THE ABOVE FIELDS BY THE HIGH-RES DEPTH TO BE                                                                   
C         * SUBSEQUENTLY NORMALIZED.                                                                                                
C                                                                                                                                   
          DO 585 I=1,LLL                                                                                                            
             GLL(I)=MAX(GLL(I),0.E0)                                                                                                
             GWH(I)=MAX(GWH(I),0.E0)                                                                                                
             GLL(I)=GLL(I)*DLAY(I,K)                                                                                                
             GWH(I)=GWH(I)*DLAY(I,K)                                                                                                
  585     CONTINUE                                                                                                                  
C                                                                                                                                   
C         * DO THE AREA-AVERAGING.                                                                                                  
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR3(GH,GLR,ILG1,ILAT,DLON,DLAT,ILG,                                                                              
     1                 GLL,GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                      
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                   
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITG10',-40)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR3(GWL,GLR,ILG1,ILAT,DLON,DLAT,ILG,                                                                             
     1                 GWH,GHR,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                      
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                   
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITG10',-41)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * DIVIDE THE ABOVE FIELDS BY THE AVERAGE LAYER DEPTH TO                                                                   
C         * COMPLETE THE NORMALIZATION.                                                                                             
C         * CONVERT TO PERCENTAGE AND INSERT BACK IN FLAGS FOR ICE/WATER.                                                           
C                                                                                                                                   
          DO 595 I=1,LGG                                                                                                            
             IF(GT(I).GT.0.E0) THEN                                                                                                 
               GH (I)=(GH (I)/GT(I))*100.E0                                                                                         
               GWL(I)=(GWL(I)/GT(I))*100.E0                                                                                         
             ELSE                                                                                                                   
               GH (I)=-3.E0                                                                                                         
               GWL(I)=-3.E0                                                                                                         
             ENDIF                                                                                                                  
             IF(DPTH(I).GT.0.10E0 .AND. DPTH(I).LE.0.35E0) THEN                                                                     
                IF(K.EQ.3) THEN                                                                                                     
                   GH (I)=-3.E0                                                                                                     
                   GWL(I)=-3.E0                                                                                                     
                ENDIF                                                                                                               
             ELSE IF(DPTH(I).GT.0.E0 .AND. DPTH(I).LE.0.10E0) THEN                                                                  
                IF(K.GE.2) THEN                                                                                                     
                   GH (I)=-3.E0                                                                                                     
                   GWL(I)=-3.E0                                                                                                     
                ENDIF                                                                                                               
             ELSE IF(DPTH(I).LE.0.E0) THEN                                                                                          
                   GH (I)=-3.E0                                                                                                     
                   GWL(I)=-3.E0                                                                                                     
             ENDIF                                                                                                                  
             IF(GL(I).LT.0.E0) THEN                                                                                                 
               GH (I)=GL(I)                                                                                                         
               GWL(I)=GL(I)                                                                                                         
             ENDIF                                                                                                                  
  595     CONTINUE                                                                                                                  
C                                                                                                                                   
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("SAND"),K,                                                                       
     +                                      ILG1,ILAT,0,NPGG)                                                                       
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
          IBUF(3)=NC4TO8("CLAY")                                                                                                    
          CALL PUTFLD2(2,GWL,IBUF,MAXX)                                                                                             
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
C         * FOR NOW, STORE ORGANIC FRACTION AS ZERO, PUTTING BACK                                                                   
C         * IN FLAGS FOR ICE/WATER/ROCK.                                                                                            
C                                                                                                                                   
          DO 618 I = 1, LGG                                                                                                         
              GH(I)=0.E0                                                                                                            
              IF(GT(I).LE.0.E0) THEN                                                                                                
                 GH (I)=-3.E0                                                                                                       
              ELSE IF(GL(I).LT.0.E0) THEN                                                                                           
                 GH (I)=GL(I)                                                                                                       
              ENDIF                                                                                                                 
  618     CONTINUE                                                                                                                  
C                                                                                                                                   
          IBUF(3)=NC4TO8("ORGM")                                                                                                    
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C                                                                                                                                   
  620 CONTINUE                                                                                                                      
C*********************************************************************                                                              
C     * LOOP OVER VEGETATION TYPES FOR FOLLOWING FIELDS:                                                                            
C                                                                                                                                   
      ICAN=4                                                                                                                        
      ICANP1=ICAN+1                                                                                                                 
      DO 780 IC=1,ICANP1                                                                                                            
                                                                                                                                    
C---------------------------------------------------------------------                                                              
C       * AREAL FRACTION OF EACH CANOPY TYPE.                                                                                       
C       * ENSURE CONSISTENCY WITH PRIMARY VEGETATION FIELD OVER GLACIER                                                             
C       * ICE AND WITH GROUND COVER OVER OTHER NON-LAND POINTS.                                                                     
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("FCAN"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-42)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GWL,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                              
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INITG10',-43)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
C       * SET CANOPY FRACTIONS TO ZERO OVER ROCK AND GLACIER, AS                                                                    
C       * WELL AS OPEN WATER.                                                                                                       
C                                                                                                                                   
        DO 730 I=1,LGG                                                                                                              
            IF(GL(I).EQ.-3.E0 .AND. GWL(I).NE.0.E0) THEN                                                                            
              PRINT *, '0IN LOOP 730, INCONSISTENCY: I,MASK,GL,GWL = ',                                                             
     1                  I,MASK(I),GL(I),GWL(I)                                                                                      
            ENDIF                                                                                                                   
            IF(GL(I).LE.-3.E0 .OR. MASK(I).GT.-0.5E0) GWL(I)= 0.E0                                                                  
  730   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("FCAN"),IC,                                                                        
     +                                        ILG1,ILAT,0,1)                                                                        
        CALL PUTFLD2(2,GWL,IBUF,MAXX)                                                                                               
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * VISIBLE ALBEDO OF EACH CANOPY TYPE.                                                                                       
C       * CONVERT FROM PERCENT TO FRACTION AND COMPLETE WEIGHTING                                                                   
C       * CALCULATION OVER CANOPY TYPES.                                                                                            
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8(" AVW"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-44)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-45)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 735 I=1,LGG                                                                                                              
            IF(GWL(I).GT.0.0E0) THEN                                                                                                
                GH(I) = 0.01E0*GH(I)/GWL(I)                                                                                         
            ELSE                                                                                                                    
                GH(I)=0.0E0                                                                                                         
            ENDIF                                                                                                                   
  735   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALVC"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * NEAR-IR ALBEDO OF EACH CANOPY TYPE.                                                                                       
C       * CONVERT FROM PERCENT TO FRACTION AND COMPLETE WEIGHTING                                                                   
C       * CALCULATION OVER CANOPY TYPES.                                                                                            
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8(" AIW"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-46)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-47)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 740 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = 0.01E0*GH(I)/GWL(I)                                                                                             
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  740   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALIC"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * LN OF ROUGHNESS LENGTH OF EACH CANOPY TYPE.                                                                               
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LNZ0"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-48)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-49)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 745 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  745   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LNZ0"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C                                                                                                                                   
C       * FOLLOWING FIELDS IN VEGETATION CLASS LOOP NOT DEFINED FOR                                                                 
C       * URBAN CLASS (IC=ICAN+1).                                                                                                  
C                                                                                                                                   
        IF(IC.EQ.ICANP1) GO TO 780                                                                                                  
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
C       * MAXIMUM LEAF AREA INDEX OF EACH CANOPY TYPE.                                                                              
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LAMX"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-50)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-51)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 750 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  750   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LAMX"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * MINIMUM LEAF AREA INDEX OF EACH CANOPY TYPE.                                                                              
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LAMN"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-52)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-53)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 755 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  755   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LAMN"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * CANOPY MASS OF EACH CANOPY TYPE.                                                                                          
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("CMAS"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-54)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-55)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 760 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  760   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("CMAS"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * ROOTING DEPTH OF EACH CANOPY TYPE.                                                                                        
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ROOT"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITG10',-56)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITG10',-57)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 765 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  765   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ROOT"),IC,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
                                                                                                                                    
  780 CONTINUE                                                                                                                      
C*********************************************************************                                                              
C---------------------------------------------------------------------                                                              
C     * VISIBLE ALBEDO (CONVERT FROM PER-CENT TO FRACTION 0. TO 1.)                                                                 
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ALSW"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-58)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-59)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 920 I=1,LGG                                                                                                                
        GH(I) = GH(I)*0.01E0                                                                                                        
  920 CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALSW"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * NEAR-IR ALBEDO (CONVERT FROM PERCENT TO FRACTION 0. TO 1.)                                                                  
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ALLW"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITG10',-60)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITG10',-61)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 930 I=1,LGG                                                                                                                
          GH(I) = GH(I)*0.01E0                                                                                                      
  930 CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALLW"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * ALL DONE...                                                                                                                 
                                                                                                                                    
      CALL                                         XIT('INITG10',0)                                                                 
                                                                                                                                    
C     * E.O.F. ON FILE ICTL.                                                                                                        
                                                                                                                                    
  910 CALL                                         XIT('INITG10',-62)                                                               
  911 CALL                                         XIT('INITG10',-63)                                                               
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0IDAY,ILG1,ILAT =',3I6)                                                                                               
 6025 FORMAT(' ',A4,I10,1X,A4,5I6)                                                                                                  
 6026 FORMAT(' ',60X,A4,I10,1X,A4,5I6)                                                                                              
 6030 FORMAT('0EXITING PROGRAM; NO POINTS FOUND WITHIN GRID SQUARE',                                                                
     1       ' CENTRED AT (',I3,',',I3,')')                                                                                         
 6040 FORMAT('0MISMATCH BETWEEN "TRUE" AND SOIL DATA MASKS:   I,LON,LAT,                                                            
     1MASK,GLR,GL=',3I5,3(1X,F3.0))                                                                                                 
 6045 FORMAT('0SURFACE ORGANIC POINT:  I,LON,LAT,MASK,GL = ',3I5,                                                                   
     1        2(1X,F3.0))                                                                                                           
 6050 FORMAT('0SURFACE ROCK    POINT:  I,LON,LAT,MASK,GL = ',3I5,                                                                   
     1        2(1X,F3.0))                                                                                                           
      END                                                                                                                           
