      PROGRAM INITG14                                                   
C     PROGRAM INITG14 (ICTL,        FWAT,        OROGWD,        SOCI,           I2                                                  
C    1                 FLKU,        FLKR,        LLPHYS,      GGPHYS,           I2
C    2                 INPUT,       OUTPUT                              )       I2                                                  
C    2          TAPE99=ICTL, TAPE88=FWAT, TAPE77=OROGWD, TAPE66=SOCI,                                                               
C    3          TAPE55=FLKU, TAPE44=FLKR, TAPE1=LLPHYS,TAPE2=GGPHYS,  
C    4          TAPE5=INPUT, TAPE6=OUTPUT)                                                             
C     ----------------------------------------------------------------          I2                                                  
C
C     NOV 29/16 - M. LAZARE. - NEW VERSION FOR GCM19:                           I2
C                              - READS IN INLAND LAKE INFORMATION FROM FILE     I2
C                                "FLKU" (UNIT 55) AND "FLKR" (UNIT 44).         I2
C                                THIS INCLUDES ZERO (FOR NOW) FIELDS OF         I2
C                                "LLAK" AND "BLAK" FOR DIANA'S LAKE MODEL.      I2
C                              - READS IN (OPTIONALLY) NEMO FRACTIONAL          I2
C                                OCEAN MASK (IBUF(3)="SRCF") AND INCORPORATE    I2
C                                THIS INTO USUAL METHODOLOGY.                   I2
C                                NEW LO-RES ARRAY "FWAT" ADDED.                 I2
C                              - FUDGE-IN SOIL DATA FOR POINTS WHICH AREN'T     I2
C                                ABLE TO BE INITIALIZED IN THE USUAL FASHION,   I2
C                                FOR NOW.                                       I2
C                              - SET MASK=2 WHEN FLKR.NE.0.                     I2
C                              - PREVIOUS REFERENCES TO "LICN" CHANGED TO       I2
C                                "GICN", SINCE "LICN" NOW USED FOR LAKE ICE     I2
C                                CONCENTRATION.                                 I2
C                              - ADD "LIC" AND "LICN" NEW FIELDS TO OUTPUT      I2
C                                FILE. THESE ARE DONE LIKE THEIR SEA-ICE        I2
C                                COUNTERPARTS, EXCEPT THAT THE LAKE MASK IS     I2
C                                USED.                                          I2
C     MAY 26/14 - M. LAZARE. - PREVIOUS VERSION INITG13 FOR GCM18:              I2                                                  
C                              - REMOVE CALCULATION AND WRITING-OUT OF          I2                                                  
C                                FAREPAT (NOW DONE IN INIT12 COMMON DECK).      I2                                                  
C                              - PROCESSES NEW SOIL COLOUR INDEX FILE (SOCI).   I2                                                  
C                                THIS IS DONE AT THE BEGINNING BECAUSE THE      I2                                                  
C                                RESOLUTION IS DIFFERENT FROM THE OTHERS.       I2                                                  
C                              - READS IN {NTLD,NTLK,NTWT,IFLM} FROM            I2                                                  
C                                CONTROL FILE (FROM NEW VERSION ICNTRLD)        I2                                                  
C                                AND USES THESE TO DEFINE NECESSARY FIELDS      I2                                                  
C                                TO SUPPORT GENERALIZED TILING AND FRACTIONAL   I2                                                  
C                                LAND MASK.                                     I2                                                  
C                              - READ IN NEW FIELDS "FLAK" AND "LICN"           I2                                                  
C                                FROM NEW "LPCREV2", CONVERT TO FRACTION        I2                                                  
C                                ("FLAK" AND "LICN", RESPECTIVELY, AND          I2                                                  
C                                OUTPUT TO AN FILE.                             I2                                                  
C                              - ALSO OUTPUT FRACTION OF LAND FROM HIGH-RES     I2                                                  
C                                LAND MASK ("FLND").                            I2                                                  
C                              - "GICN" FIELD USED TO SET GLACIER FLAGS         I2                                                  
C                                (IE FROM GLC2000) INSTEAD OF SOILS DATA FLAG.  I2                                                  
C                              - "FLKU" AND "FLKR" SET TO ZERO IF NTLK=0.       I2                                                  
C                              - ENSURE FRACTIONAL LAKE AND WATER DO NOT        I2                                                  
C                                CO-EXIST, SO THAT THERE IS NO ISSUE WITH       I2                                                  
C                                DEFINING FRACTIONAL ICE IF IT EXISTS.          I2                                                  
C                                IN THAT CASE, THE FRACTIONAL LAKE IS           I2                                                  
C                                ASSIGNED TO OCEAN.                             I2                                                  
C     MAR 24/09 - M. LAZARE.   PREVIOUS VERSION INITG12 FOR GCM15G+                                                                 
C                              - ADDED "PHIS" FIELD PROCESSING.                                                                     
C                              - USE "-1" FOR IBUF(1-4) IN READING "MASK" RECORDS.                                                  
C                              - HIGHER INPUT RESOLUTION UP TO 1/12X1/12.                                                           
C                              - UNUSED FIELDS REMOVED: PHIS,ENV.                                                                   
C                              - SINCE INPUT VEG FIELD DOESN'T HAVE                                                                 
C                                VALUES OVER ANTARCTICA (WE WERE ABLE TO                                                            
C                                FUDGE IN VALUES USING SCRIPPS TOPGORAPHY                                                           
C                                PREVIOUSLY AT 1X1), THE ROUTINE HRTOLR4                                                            
C                                IS TRICKED WITH A TEMPORARY LOW-RES LAND                                                           
C                                MASK WHICH HAS NO LAND THERE; REPRESENTATIVE                                                       
C                                VALUES FOR EACH FIELD ARE PUT BACK THERE                                                           
C                                SUBSEQUENTLY.                                                                                      
C                              - CALLS NEW HRTOLR4, REMOVING IGRID AND                                                              
C                                PASSING IN ADDED WORK ARRAYS: LONM,LONP,                                                           
C                                LATM, LATP, TO CORRECT AREA-AVERAGING AROUND                                                       
C                                EDGES OF LOW-RES GRID SQUARE.                                                                      
C     FEB 20/06 - M. LAZARE. - PREVIOUS VERSION INITG11.                                                                            
C     MAY 14/04 - M. LAZARE. - PREVIOUS VERSION INITG10.                                                                            
C                                                                               I2                                                  
CINITG14 - GRID PHYSICS INITIALIZATION PROGRAM FOR GCM18+               2  1 C  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, 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 HIGH 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 HRTOLR4.        I3                                                  
C                 THE ONLY DISCRETE FIELD PROCESSED IS A WORK FIELD FOR         I3                                                  
C                 THE SOIL DATA. ALL OTHERS ARE AREA-AVERAGED.                  I3                                                  
C                 SINCE INPUT VEG FIELD DOESN'T HAVE VALUES OVER ANTARCTICA     I3                                                  
C                 (WE WERE ABLE TO FUDGE IN VALUES USING SCRIPPS TOPGORAPHY     I3                                                  
C                 PREVIOUSLY AT 1X1), THE ROUTINE HRTOLR4 IS TRICKED WITH A     I3                                                  
C                 TEMPORARY LOW-RES LAND MASK WHICH HAS NO LAND THERE;          I3                                                  
C                 REPRESENTATIVE VALUES FOR EACH FIELD ARE PUT BACK THERE       I3                                                  
C                 SUBSEQUENTLY.                                                 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 HRTOLR4.           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 HRTOLR4. 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      FWAT   = NEMO FRACTIONAL MASK.                                           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      SOCI   = SOIL COLOUR INDEX FILE AND ASSOCIATED MASK AT 720X360.          I3                                                  
C                                                                               I3
C      FLKU   = UNRESOLVED INLAND LAKE INFORMATION FILE.                        I3       
C      FLKR   = RESOLVED   INLAND LAKE INFORMATION FILE.                        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      FINALLY, A "T" IN THE OUTPUT VARIABLES INDICATES THAT THE FIELD          I3                                                  
C      HAS MULTIPLE TILES. LAND-ONLY FIELDS HAVE "NTLD" TILES,                  I3                                                  
C      LAKE-ONLY FIELDS HAVE "NTLK" TILES AND WATER/ICE FIELDS HAVE             I3                                                  
C      "NTWT" TILES. THE FIELDS {GT,SNO} EXIST ACROSS ALL TILES AND             I3                                                  
C      THEREFORE HAVE (NLTD+NTLK+NTWT) TILES.                                   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      BLAK   EXTINCTION COEFFICIENT OF LAKE    M-1                             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  **  FCAN   AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C      FLKU   UNRESOLVED INLAND LAKE FRACTION   FRACTION                        I3                                                  
C      FLKR   RESOLVED   INLAND LAKE FRACTION   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      LDPT   DEPTH OF INLAND LAKE              METRES                          I3                                                  
C      LLAK   LENGTH OF INLAND LAKE             METRES                          I3                                                  
C  **  LNZ0   LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C      LICN   PORTION OF LAND ICE (GLACIER)     PERCENTAGE                      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      SOCI   SOIL COLOUR INDEX                                                 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 T WEIGHTED NEAR-IR CANOPY ALBEDO    FRACTION                        I3                                                  
C      ALLW   NEAR-IR CANOPY ALBEDO (SFC)           -                           I3                                                  
C      ALSW   VISIBLE CANOPY ALBEDO (SFC)           -                           I3                                                  
C  **   AVW T WEIGHTED VISIBLE CANOPY ALBEDO    FRACTION                        I3                                                  
C      BLAK   EXTINCTION COEFFICIENT OF LAKE    M-1                             I3                                                  
C  *** CLAY T PERCENTAGE OF CLAY IN SOIL LAYER  PERCENTAGE                      I3                                                  
C  *   CMAS T CANOPY MASS                       KG/M**2                         I3                                                  
C      DPTH T DEPTH OF SOIL                     METRES                          I3                                                  
C      FARE   AREAL FRACTION OF TILE            FRACTION                        I3                                                  
C  **  FCAN T AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C      FLKU   UNRESOLVED INLAND LAKE FRACTION   FRACTION                        I3                                                  
C      FLKR   RESOLVED   INLAND LAKE FRACTION   FRACTION                        I3
C      FLND   AREAL FRACTION OF LAND            FRACTION                        I3                                                  
C      GICN   AREA FRACTION OF LAND GLACIER     FRACTION                        I3                                                  
C        GT   GROUND TEMPERATURE (IDAY ONLY)    DEG K                           I3                                                  
C  *   LAMN T MINIMUM LEAF AREA INDEX               -                           I3                                                  
C  *   LAMX T MAXIMUM LEAF AREA INDEX               -                           I3                                                  
C      LDPT   DEPTH OF INLAND LAKE              METRES                          I3                                                  
C       LIC   LAKE ICE AMOUNT                   KG/M**2                         I3                                                  
C      LICN   AMIP2 LAKE ICE CONCENTRATION      FRACTION                        I3                                                  
C      LLAK   LENGTH OF INLAND LAKE             METRES                          I3                                                  
C  **  LNZ0 T LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C  *** ORGM T PERCENTAGE OF ORGM IN SOIL LAYER  PERCENTAGE                      I3                                                  
C      PHIS   SFC GEOPOTENTIAL ON MODEL GRID    GPM                             I3                                                  
C  *   ROOT T CANOPY ROOTING DEPTH              METRES                          I3                                                  
C  *** SAND T 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 T SOIL TEMPERATURE  (IDAY ONLY)     DEGK                            I3                                                  
C  *** THIC T SOIL FROZEN WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C  *** THLQ T SOIL LIQUID WATER (IDAY ONLY)     FRACTION OF TOTAL VOLUME        I3                                                  
C        ZS   SURFACE HEIGHT ON ANALYSIS GRID   METRES                          I3                                                  
C                                                                               I3
CINPUT PARAMETERS...                                                            I5                                                    
C                                                                               I5                                                  
C      FLAK_BND  = VALUE BELOW WHICH LAKE FRACTION IS CONSIDERED TOO SMALL      I5
C                  TO BE CONSIDERED RELEVANT AND THUS FRACTION SET TO ZERO      I5
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 GLC2000 LAND MASK (LAND=-1.,ELSE 0.)                                                  
C     * HRMASKS IS THE HIGH-RESOLUTION OFFSET SOIL COLOUR LAND MASK (1/0).                                                         
C                                                                                                                                   
C     * "FWAT" IS THE NEMO FRACTIONAL WATER FIELD.
C     * DIFFERENT PROCESSING IS DONE ON IT TO PRODUCE THE "MASK" FIELD, DEPENDING
C     * ON WHETHER THE INPUT FILE IS THE OLD BINARY LAND MASK OR THE NEMO FRACTIONAL
C     * AREA OF WATER..
C                                                                                                                                   
C     * FLND IS THE FRACTIONAL LAND MASK FIELD OBTAINED BY DOING A STRAIGHTFORWARD                                                  
C     * AVERAGE OF THE HIGH-RESOLUTION LAND MASK. IT IS USED TO "EXTEND" THE                                                        
C     * NORMAL SPECIFIED LOW-RESOLUTION MASK TO ACCOUNT FOR PARTIAL LAND, 
C     * UNRESOLVED LAKE, RESOLVED LAKE AND WATER.                                                                                                                      
C     * MASKL, MASKKU, MASKKR AND MASKW, RESPECTIVELY, ARE THE RESULTING MASKS WHICH ARE                                                     
C     * USED TO DO THE AREA AVERAGE.                                                                                                
C                                                                                                                                   
C     * IF THE INTEGER SWITCH CONTROLLING THE USE OF THE FRACTIONAL LAND MASK                                                       
C     * (IFLM, READ FROM CONTROL FILE) IS ZERO, THESE ARE MERELY SET TO THEIR                                                       
C     * USUAL DISCRETE VALUES (NO FRACTION).                                                                                        
C                                                                                                                                   
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 (NLGX=360*12,NLATX=180*12,IGND=3,NM=12,NM1=NM+1,        
     1           NLOMAX=64980,NHIMAX=NLGX*NLATX,IJB=NHIMAX)             
      INTEGER BI,BJ                                                     
      PARAMETER ( BI=360, BJ=181)                                       
C                                                                                                                                   
      REAL GLL(NHIMAX),HRMASK(NHIMAX),HRMASKS(NHIMAX),                  
     1     GWH(NHIMAX),GWA(NHIMAX),GHR(NHIMAX),DLAY(NHIMAX,3)           
                                                                        
      REAL GH(NLOMAX),GL(NLOMAX),GC(NLOMAX),GWL(NLOMAX),                
     1     GT(NLOMAX),MASK(NLOMAX),GLR(NLOMAX),
     2     DPTH(NLOMAX),MASKL(NLOMAX),MASKKR(NLOMAX),MASKKU(NLOMAX),
     3     MASKW(NLOMAX)       
      REAL FLND(NLOMAX),FWAT(NLOMAX),FLKU(NLOMAX),LDPT(NLOMAX),
     1     LLAK(NLOMAX),BLAK(NLOMAX),FLKR(NLOMAX),GICN(NLOMAX)          
      REAL FTIL(NLOMAX),FARE(NLOMAX),SOCI(NLOMAX)                       
C                                                                                                                                   
      REAL DLAT(BJ), DLON(BI)                                           
      REAL LONM(BI), LONP(BI), LATM(BJ), LATP(BJ)                       
      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 HRTOLR4.                                                                        
                                                                        
      INTEGER LONB(NLOMAX), LATB(NLOMAX)                                
C                                                                                                                                   
C     * WORK ARRAYS FOR SUBROUTINE HRTOLR4.                                                                                         
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 "NLGX" AND AN ABORT                                                                    
C     * CONDITION IS GENERATED WITHIN THE SUBROUTINE.                                                                               
C                                                                                                                                   
      REAL GCHRTMP(NLGX,NLATX)                                          
      REAL RLON(NLGX), RLAT(NLATX)                                      
                                                                        
      REAL GCLRTMP(361,181)                                             
      INTEGER LATL(181), LATH(181), LONL(361), LONH(361)                
                                                                        
      REAL VAL(NLGX), DIST(NLGX)                                        
      INTEGER LOCAT(NLGX), IVAL(NLGX), LOCFST(NLGX), NMAX(NLGX)         
                                                                        
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(IJB)                                     
                                                                        
      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/IJB,+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                                                             
                                                                        
      NFF=10                                                             
      CALL JCLPNT(NFF,99,88,77,66,55,44,1,2,5,6)                                
                                                                        
      REWIND 2                                                          
      INTERP=1                             
C                                                                                                                                    
C     * READ INPUT PARAMETERS.
C                                                                                                                                    
      READ(5,5010,END=905) FLAK_BND                                             I4
C                                                                        
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,          
     1                      NTLD,NTLK,NTWT,IFLM                         
      ILG1  = ILG+1                                                     
      ILATH = ILAT/2                                                    
      LGG   = ILG1*ILAT                                                 
      WRITE(6,6010) IDAY,ILG1,ILAT                                      
      WRITE(6,6011) NTLD,NTLK,NTWT,IFLM                                 
                                                                        
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/(REAL(ILG))                                           
      DO 120 I=1,ILG1                                                   
          DLON(I)=DGX*REAL(I-1)                                        
  120 CONTINUE                                                          
                                                                        
      NMO=12                                                            
      NDAY=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     * THIS PROGRAM ALSO SUPPORTS THE NEW NEMO FRACTIONAL WATER AS INPUT.
C                                                                                                                                   
      CALL GETFLD2(88,MASK,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                                XIT('INITG14',-1)   
      WRITE(6,6025) IBUF                                                
C
C     * SET INTEGER SWITCH FOR TYPE OF MASK BASED ON IBUF(3).
C
      IF(IBUF(3).EQ.NC4TO8("  GC")) THEN
        IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL XIT('INITG14',-2) 
        IMASK=0
      ELSE IF(IBUF(3).EQ.NC4TO8("SRCF")) THEN
        IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL XIT('INITG14',-3) 
        IMASK=1
      ELSE
        CALL                                          XIT('INITG14',-4)
      ENDIF      
C
C     * ABORT IF IMASK=0 AND FRACTIONAL LAND OR LAKE TILES SPECIFIED.
C
      IF(IMASK.EQ.0 .AND. IFLM.NE.0) CALL             XIT('INITG14',-5)
      IF(IMASK.EQ.0 .AND. NTLK.NE.0) CALL             XIT('INITG14',-6)
C---------------------------------------------------------------------
C     * GET HIGH-RES GLC2000 LAND MASK (-1./0.) INTO ARRAY "HRMASK", FOR USE                                                        
C     * IN PROCESSING SUBSEQUENT FIELDS.                                                                                            
C                                                                                                                                   
      CALL GETFLD2(-1,HRMASK,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),        
     +                                           1,IBUF,MAXX,OK)        
      IF(.NOT.OK) CALL                                XIT('INITG14',-7)   
      WRITE(6,6025) IBUF                                                
      NLG=IBUF(5)                                                       
      NLAT=IBUF(6)                                                      
      LLL=NLG*NLAT    
C---------------------------------------------------------------------                                                              
      IF(IMASK.EQ.0)                                           THEN
C
C       * DEFINE LAND FRACTION BASED ON BINARY MASK.
C       * CALCULATE FWAT AS RESIDUAL OF THIS FLND.
C       * THIS WILL INCLUDE LAKES DEFINED BY MASK=2 IN THE OLD STYLE.
C       * THERE ARE NO INLAND LAKES AS PER {FLKU,FLKR} FOR THIS OPTION.
C
        DO I=1,LGG
          IF(MASK(I).EQ.-1.) THEN                                       
            FLND(I)=1.                                                  
          ELSE                                                          
            FLND(I)=0.                                                  
          ENDIF                                                         
          FWAT(I)=MAX(0., MIN(1.-FLND(I),1.))
        ENDDO
      ELSE
C
C       * RENAME MASK TO FWAT, SINCE MASK WILL BE SUBSEQUENTLY
C       * REDEFINED.
C
        DO I=1,LGG
          FWAT(I)=MASK(I)
        ENDDO
      ENDIF    !IMASK
C
C     * REMOVE INLAND LAKES IN HR MASK FIELD (TREATED AS WATER) FOR FURTHER
C     * PROCESSING OF **LAND-ONLY** FIELDS.
C
      DO I=1,LLL                                                        
        HRMASK(I)=MIN(0.E0, HRMASK(I))                                  
      ENDDO                                                       
C---------------------------------------------------------------------                                                              
C     * FRACTION OF LAKE (BOTH RESOLVED AND UNRESOLVED).                                                                                                 
C     * SET FRACTION TO ZERO IF NO LAKE TILES.
C
      REWIND 55
      CALL GETFLD2(55,FLKU,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                              XIT('INITG14',-8)   
      WRITE(6,6025) IBUF                                                
C
      REWIND 44
      CALL GETFLD2(44,FLKR,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                              XIT('INITG14',-9)   
      WRITE(6,6025) IBUF  
C                                              
      IF(NTLK.EQ.0) THEN
        DO I=1,LGG
          FLKU(I)=0.
          FLKR(I)=0.                                        
        ENDDO
      ENDIF
C
C     * CONSTRAINTS AND CONSISTENCIES!
C     * THEN OBTAIN FLND.
C
      DO I=1,LGG
        FWAT(I)=MIN(1., MAX(FWAT(I),0.) )
        FLKU(I)=MIN(1., MAX(FLKU(I),0.) )
        FLKR(I)=MIN(1., MAX(FLKR(I),0.) )
        IF(FLKU(I).LT.FLAK_BND)   FLKU(I)=0.
        IF(FLKR(I).LT.FLAK_BND)   FLKR(I)=0.
        FNOL=FLKU(I)+FLKR(I)+FWAT(I)
        IF(FNOL.GT.1.) THEN
          EXCESS=FNOL-1.
          FLKUR=FLKU(I)+FLKR(I)
          FNOLO=FNOL
          FWATO=FWAT(I)
          FLKUO=FLKU(I)
          FLKRO=FLKR(I)
          IF(FLKU(I).GT.0. .AND. FLKR(I).GT.0.) THEN
            FLKR(I)=FLKR(I)*(1.-EXCESS/FLKUR)
            FLKU(I)=FLKU(I)*(1.-EXCESS/FLKUR)
          ELSE IF(FLKU(I).GT.0. .AND. FLKR(I).EQ.0.) THEN
            FLKU(I)=FLKU(I)-EXCESS
          ELSE IF(FLKR(I).GT.0. .AND. FLKU(I).EQ.0.) THEN
            FLKR(I)=FLKR(I)-EXCESS
          ENDIF
          FNOL=FLKU(I)+FLKR(I)+FWAT(I)
          IF(FNOL.GT.1) THEN
            PRINT *, 'FNOLO,FWATO,FLKUO,FLKRO,FNOL,FWAT,FLKU,FLKR = ',
     1                FNOLO,FWATO,FLKUO,FLKRO,FNOL,
     2                FWAT(I),FLKU(I),FLKR(I)
            CALL                                    XIT('INITG14',-10) 
          ENDIF
        ENDIF
        FLND(I)=MAX(0., MIN(1.-FNOL,1.))
      ENDDO
C---------------------------------------------------------------------                                                              
C     * DEPTH,LENGTH AND EXTINCTION COEFFICIENT OF LAKE.                                                                                                 
C
      CALL GETFLD2(55,LDPT,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                              XIT('INITG14',-11)   
      WRITE(6,6025) IBUF                                                
C
      CALL GETFLD2(55,LLAK,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                              XIT('INITG14',-12)   
      WRITE(6,6025) IBUF                                                
C
      CALL GETFLD2(55,BLAK,-1,-1,-1,-1,IBUF,MAXX,OK)                  
      IF(.NOT.OK) CALL                              XIT('INITG14',-13)   
      WRITE(6,6025) IBUF                                                
C
C     * SET THESE TO ZERO IF NO UNRESOLVED LAKE FRACTION.
C
      DO I=1,LGG
        IF(FLKU(I).EQ.0.)   THEN
          LDPT(I)=0.
          LLAK(I)=0.
          BLAK(I)=0.
        ENDIF 
      ENDDO
C-------------------------------------------------------------------
C     * CREATE "MASK" FIELD FOR IFLM=1 TO MATCH WHAT IS USED FOR IFLM=0.
C     * THIS IS LIKELY TO BE REPLACED BY THE DIRECT USE OF "FLKR/FLKU" ITSELF,
C     * AT WHICH POINT THIS CALCULATION AND THE WRITE TO "AN" FILE CAN BE REMOVED.
C                                      
      IF(IFLM.NE.0) THEN                                                                                             
        DO I=1,LGG                                                    
          IF(FLND(I).GT.0.5) THEN
            MASK(I)=-1.  
          ELSE
            MASK(I)=0.
          ENDIF
          IF(FLKR(I).NE.0. .OR. FLKU(I).NE.0.)  MASK(I)=2.
        ENDDO
      ENDIF
C
C     * SAVE THE LAND MASK FOR USE IN THE AGCM.
C
      IBUF(2)=0                                                         
      IBUF(3)=NC4TO8("MASK")                                            
      IBUF(4)=1                                                         
      IBUF(5)=ILG1
      IBUF(6)=ILAT
      IBUF(8)=1                                                         
      CALL PUTFLD2(2,MASK,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                                                
C---------------------------------------------------------------------  
C     * USE INTEGER SWITCH "IFLM" TO SET MASK ARRAYS                                                                                
C     * {MASKL,MASKK,MASKW}, BASED ON WHETHER DOING FRACTIONAL LAND                                                                 
C     * MASK OR NOT.                                                                                                                
C                                                                                                                                   
      IF(IFLM.EQ.0) THEN                                                
C
C       * REMOVE INLAND LAKES IN HR MASK FIELD (TREATED AS WATER) FOR FURTHER
C       * PROCESSING OF **LAND-ONLY** FIELDS.
C
        DO I=1,LGG                                                      
          MASK  (I)=MIN(0.,MASK(I))                                  
          MASKL (I)=MASK(I)                                              
          MASKKR(I)=MASK(I)                                              
          MASKKU(I)=MASK(I)
          MASKW (I)=MASK(I)                                              
        ENDDO                                                           
      ELSE                                                              
C
C       * "FRACLMT" IS THE VALUE BELOW WHICH FRACTIONAL COVER IS IGNORED,                                                              
C       * DUE TO PROBLEMS WITH MIS-MATCHED LAND/OCEAN HIGH-RES MASKS                                                                  
C       * (IE AMIP BC AND IMPLICIT SOILS MASK).                                                                                       
C                                                                                                                                   
        FRACLMT=0.
        DO I=1,LGG                                                      
          IF(FLND(I).GT.FRACLMT) THEN                                   
            MASKL(I)=-1.                                                
          ELSE                                                          
            MASKL(I)=0.                                                 
          ENDIF                                                         
C                                                                                                                                   
          IF(FLKR(I).GT.FRACLMT) THEN                                        
            MASKKR(I)=0.                                                 
          ELSE                                                          
            MASKKR(I)=-1.                                                 
          ENDIF                                                         
C                                                                                                                                   
          IF(FLKU(I).GT.FRACLMT) THEN                                        
            MASKKU(I)=0.                                                 
          ELSE                                                          
            MASKKU(I)=-1.                                                 
          ENDIF   
C                                                                                                                                   
          IF(FWAT(I).GT.FRACLMT) THEN                              
            MASKW(I)=0.                                                 
          ELSE                                                          
            MASKW(I)=-1.                                                
          ENDIF                                                         
        ENDDO                                                           
      ENDIF
C---------------------------------------------------------------------                                                              
C     * CALCULATE FRACTION OF GLACIER.                                                                                              
C     * FIRST CREATE FIELD OF {0.,1.} VALUES.                                                                                       
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LICN"),1,            
     +                                         IBUF,MAXX,OK)            
      IF(.NOT.OK) CALL                              XIT('INITG14',-14)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-15)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GICN,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-16)  
      ENDIF                                                             
C=====================================================================                                                              
C     * SOIL COLOUR INDEX AND MASK.                                                                                                 
C                                                                                                                                   
      CALL GETFLD2(-66,HRMASKS,NC4TO8("GRID"),1,NC4TO8("LNDM"),1,       
     +                                              IBUF,MAXX,OK)       
      IF(.NOT.OK) CALL                              XIT('INITG14',-17)  
      WRITE(6,6025) IBUF                                                
      CALL GETFLD2(66, GLL,    NC4TO8("GRID"),1,NC4TO8("SOCI"),1,       
     +                                              IBUF,MAXX,OK)       
      IF(.NOT.OK) CALL                              XIT('INITG14',-18)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
C     * CONVERT TO USUAL MASK DEFINITION.                                                                                           
C                                                                                                                                   
      MLG=IBUF(5)                                                       
      MLAT=IBUF(6)                                                      
      LLLS=MLG*MLAT                                                     
      DO I=1,LLLS                                                       
        HRMASKS(I)=-1.*HRMASKS(I)                                       
      ENDDO                                                             
C                                                                                                                                   
      IOPTION=3                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(SOCI,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,HRMASKS,MLG,MLAT,IOPTION,ICHOICE,                
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-19)  
      ENDIF                                                             
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('INITG14',-20)   
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL  XIT('INITG14',-21)   
        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 HRTOLR4(GH,MASKW,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GHR,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                      XIT('INITG14',-22)  
        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), MASKW(I).EQ.-1.E0)               
            GLR(I)=GH(I)                                                
            SICNMO(NI)=GH(I)                                            
  131   CONTINUE                                                        
C                                                                                                                                   
C       * NOW COMBINE THE "GH" AND "MASKW" FIELDS, WHERE LAND IS                                                                    
C       * DETERMINED FROM "MASKW" 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(MASKW(I).EQ.-1.E0)         THEN                            
            GC(I)=MASKW(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       * SST (DEG K) (12 MONTHS).                                                                                                  
                                                                        
        CALL GETFLD2(-1,GWA,NC4TO8("GRID"),MMD(N),NC4TO8(" SST"),       
     +                                            1,IBUF,MAXX,OK)       
        IF(.NOT.OK) CALL                            XIT('INITG14',-23)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL  XIT('INITG14',-24)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=2                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKW,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GWA,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                      XIT('INITG14',-25)  
        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)                                                                                       
C                                                                                                                                   
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),NDAY,NC4TO8(" SIC"),         
     +                                          1,IBUF,MAXX,OK)         
        IF(.NOT.OK) CALL                            XIT('INITG14',-26)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL  XIT('INITG14',-27)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        DO 141 I=1,LLL                                                  
            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 HRTOLR4(GH,MASKW,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                      XIT('INITG14',-28)  
        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     * 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)                                              
          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('INITG14',-29)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-30)  
      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 HRTOLR4(GH,MASKW,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-31)  
      ENDIF                                                             
C                                                                                                                                   
      DO 257 I=1,LGG                                                    
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                         
        GH(I) = MERGE(0.E0, GH(I), MASKW(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('INITG14',-32)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-33)  
      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 HRTOLR4(GH,MASKW,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-34)  
      ENDIF                                                             
C                                                                                                                                   
      DO 259 I=1,LGG                                                    
        GH(I) = MERGE(0.E0, MAX(0.E0,GH(I)), MASKW(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     * UNRESOLVED LAKE-ICE CONCENTRATION (IDAY ONLY).                                                                                          
                                                                        
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("SICN"),1,         
     +                                            IBUF,MAXX,OK)         
      IF(.NOT.OK) CALL                              XIT('INITG14',-35)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-36)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      DO I=1,LLL                                                    
        GWH(I)=MAX(0.0E0,GWH(I))                                        
      ENDDO
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,MASKKU,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-37)  
      ENDIF                                                             
C                                                                                                                                   
      DO I=1,LGG                                                    
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                         
        GH(I) = MERGE(0.E0, GH(I), MASKKU(I).EQ.-1.E0)                   
      ENDDO
C
C     * UNRESOLVED LAKE-ICE MASS (IDAY ONLY).                                                                                                   
C                                                                        
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8(" SIC"),           
     +                                        1,IBUF,MAXX,OK)           
      IF(.NOT.OK) CALL                              XIT('INITG14',-38)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-39)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      DO I=1,LLL                                                    
        GWH(I)=MAX(0.0E0,GWH(I))                                        
      ENDDO
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GL,MASKKU,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-40)  
      ENDIF                                                             
C                                                                                                                                   
      DO I=1,LGG                                                    
        GL(I) = MERGE(0.E0, GL(I), MASKKU(I).EQ.-1.E0)                   
      ENDDO
C                                                                                                                                   
C     * LAKE TEMPERATURE (IDAY ONLY).                                                                                             
C     * ONLY USED FOR CONSISTENCY CHECK FOR {LICRN,LICR}, **NOT** OUTPUT!
C                                                                                                                                   
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("  GT"),1,         
     +                                            IBUF,MAXX,OK)         
      IF(.NOT.OK) CALL                              XIT('INITG14',-41)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-42)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GWL,MASKKU,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-43)  
      ENDIF                                                             
C
      DO I=1,LGG                                                    
        GWL(I) = MERGE(0.E0, GWL(I), MASKKU(I).EQ.-1.E0)         
      ENDDO
C
      IF(NTLK.GT.0)                                 THEN
C
C       * CONSISTENCY CHECKS BETWEEN {LIUN,LIU,LGTU}.
C                                                 
        DO I=1,LGG
          IF(MASKKU(I).EQ.0.) THEN
            IF(GWL(I).GT.273.16) THEN
              GH (I)=0.
            ELSE
              GH (I)=MAX(GH(I),0.15)
            ENDIF
C
            IF(GH(I).EQ.0.) THEN
              GL (I)=0.
              GWL(I)=MAX(GWL(I),273.16)
            ELSE
              GL (I)=MAX(45.,MIN(GL(I),900.))
              GWL(I)=273.16
            ENDIF
          ENDIF
        ENDDO
       
      ELSE
C
C       * NO UNRESOLVED LAKE FRACTION, SO SET THESE TO ZERO.
C
        DO I=1,LGG
          GH (I)=0.
          GL (I)=0.
          GWL(I)=0.
        ENDDO
      ENDIF
C                       
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LUIN"),1,            
     +                                     ILG1,ILAT,0,NPGG)            
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                      
      WRITE(6,6026) IBUF                                                
C
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LUIM"),1,            
     +                                     ILG1,ILAT,0,NPGG)            
      CALL PUTFLD2(2,GL,IBUF,MAXX)                                      
      WRITE(6,6026) IBUF                              
C-----------------------------------------------------------------------
C     * RESOLVED LAKE-ICE CONCENTRATION (IDAY ONLY).                                                                                          
                                                                        
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("SICN"),1,         
     +                                            IBUF,MAXX,OK)         
      IF(.NOT.OK) CALL                              XIT('INITG14',-44)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-45)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      DO I=1,LLL                                                    
        GWH(I)=MAX(0.0E0,GWH(I))                                        
      ENDDO
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,MASKKR,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-46)  
      ENDIF                                                             
C                                                                                                                                   
      DO I=1,LGG                                                    
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                         
        GH(I) = MERGE(0.E0, GH(I), MASKKR(I).EQ.-1.E0)                   
      ENDDO
C
C     * RESOLVED LAKE-ICE MASS (IDAY ONLY).                                                                                                   
C                                                                        
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8(" SIC"),           
     +                                        1,IBUF,MAXX,OK)           
      IF(.NOT.OK) CALL                              XIT('INITG14',-47)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-48)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      DO I=1,LLL                                                    
        GWH(I)=MAX(0.0E0,GWH(I))                                        
      ENDDO
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GL,MASKKR,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-49)  
      ENDIF                                                             
C                                                                                                                                   
      DO I=1,LGG                                                    
        GL(I) = MERGE(0.E0, GL(I), MASKKR(I).EQ.-1.E0)                   
      ENDDO
C                                                                                                                                   
C     * LAKE TEMPERATURE (IDAY ONLY).                                                                                             
C     * ONLY USED FOR CONSISTENCY CHECK FOR {LICRN,LICR}, **NOT** OUTPUT!
C                                                                                                                                   
      CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("  GT"),1,         
     +                                            IBUF,MAXX,OK)         
      IF(.NOT.OK) CALL                              XIT('INITG14',-50)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-51)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=0                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GWL,MASKKR,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-52)  
      ENDIF                                                             
C
      DO I=1,LGG                                                    
        GWL(I) = MERGE(0.E0, GWL(I), MASKKR(I).EQ.-1.E0)         
      ENDDO
C
      IF(NTLK.GT.0)                                 THEN
C
C       * CONSISTENCY CHECKS BETWEEN {LIRN,LIR,LGTR}.
C                                                 
        DO I=1,LGG
          IF(MASKKR(I).EQ.0.) THEN
            IF(GWL(I).GT.273.16) THEN
              GH (I)=0.
            ELSE
              GH (I)=MAX(GH(I),0.15)
            ENDIF
C
            IF(GH(I).EQ.0.) THEN
              GL (I)=0.
              GWL(I)=MAX(GWL(I),273.16)
            ELSE
              GL (I)=MAX(45.,MIN(GL(I),900.))
              GWL(I)=273.16
            ENDIF
          ENDIF
        ENDDO
       
      ELSE
C
C       * NO RESOLVED LAKE FRACTION, SO SET THESE TO ZERO.
C
        DO I=1,LGG
          GH (I)=0.
          GL (I)=0.
          GWL(I)=0.
        ENDDO
      ENDIF
C                       
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LRIN"),1,            
     +                                     ILG1,ILAT,0,NPGG)            
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                      
      WRITE(6,6026) IBUF                                                
C
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LRIM"),1,            
     +                                     ILG1,ILAT,0,NPGG)            
      CALL PUTFLD2(2,GL,IBUF,MAXX)                                      
      WRITE(6,6026) IBUF                                                
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('INITG14',-53)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-54)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-55)  
      ENDIF                                                             
C                                                                                                                                   
      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('INITG14',-56)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-57)  
      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 HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-58)  
      ENDIF                                                             
C                                                                                                                                   
      DO 262 I=1,LGG                                                    
        GH(I)=MAX(0.0E0,GH(I))                                          
  262 CONTINUE                                                          
C                                                                                                                                   
      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                                                   
          CALL GETFLD2(-1,GHR,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),       
     +                                            L,IBUF,MAXX,OK)       
          IF(.NOT.OK) CALL                           XIT('INITG14',-59)  
          IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL XIT('INITG14',-60) 
          WRITE(6,6025) IBUF                                            
C                                                                                                                                   
          IOPTION=1                                                     
          ICHOICE=1                                                     
          CALL HRTOLR4(GT,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                
     1                 LONM,LONP,LATM,LATP,                             
     2                 GHR,HRMASK,NLG,NLAT,IOPTION,ICHOICE,             
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK)THEN                                               
            WRITE(6,6030) LONBAD,LATBAD                                 
            CALL                                     XIT('INITG14',-61)  
          ENDIF                                                         
C                                                                                                                                   
          CALL GETFLD2(-1,GWH,NC4TO8("GRID"),IDAY,NC4TO8("THLQ"),       
     +                                            L,IBUF,MAXX,OK)       
          IF(.NOT.OK) CALL                           XIT('INITG14',-62)  
          IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL XIT('INITG14',-63) 
          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 HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                
     1                 LONM,LONP,LATM,LATP,                             
     2                 GWH,HRMASK,NLG,NLAT,IOPTION,ICHOICE,             
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK)THEN                                               
            WRITE(6,6030) LONBAD,LATBAD                                 
            CALL                                     XIT('INITG14',-64)  
          ENDIF                                                         
C                                                                                                                                   
          CALL GETFLD2(-1,GWA,NC4TO8("GRID"),IDAY,NC4TO8("THIC"),       
     +                                            L,IBUF,MAXX,OK)       
          IF(.NOT.OK) CALL                           XIT('INITG14',-65)  
          IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL XIT('INITG14',-66) 
          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 HRTOLR4(GL,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                
     1                 LONM,LONP,LATM,LATP,                             
     2                 GWA,HRMASK,NLG,NLAT,IOPTION,ICHOICE,             
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK)THEN                                               
            WRITE(6,6030) LONBAD,LATBAD                                 
            CALL                                     XIT('INITG14',-67)  
          ENDIF                                                         
C                                                                                                                                   
          THLMIN=0.04E0                                                 
          DO 268 I=1,LGG                                                
              IF(MASKL(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                                                                                                                                   
          DO N=1,NTLD                                                   
            IBUF4=1000*L + N                                            
            CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),IBUF4,  
     +                                           ILG1,ILAT,0,NPGG)      
            CALL PUTFLD2(2,GT,IBUF,MAXX)                                
            WRITE(6,6026) IBUF                                          
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("THLQ"),IBUF4,  
     +                                           ILG1,ILAT,0,NPGG)      
            CALL PUTFLD2(2,GH,IBUF,MAXX)                                
            WRITE(6,6026) IBUF                                          
C                                                                                                                                   
            CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("THIC"),IBUF4,  
     +                                           ILG1,ILAT,0,NPGG)      
            CALL PUTFLD2(2,GL,IBUF,MAXX)                                
            WRITE(6,6026) IBUF                                          
         ENDDO                                                          
  269 CONTINUE                                                          
C---------------------------------------------------------------------                                                              
C     * INVARIANT FIELDS:                                                                                                           
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('INITG14',-68)  
      IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT)  CALL XIT('INITG14',-69)  
      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('INITG14',-70)  
      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('INITG14',-71)  
      IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL  XIT('INITG14',-72)  
      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('INITG14',-73)  
      IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL  XIT('INITG14',-74)  
      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('INITG14',-75)  
      IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL  XIT('INITG14',-76)  
      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('INITG14',-77)  
      IF(IBUF(5).NE.ILG1 .OR. IBUF(6).NE.ILAT) CALL  XIT('INITG14',-78)  
      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 HRTOLR4 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     * 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('INITG14',-79)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT)  CALL  XIT('INITG14',-80)  
C                                                                                                                                   
      DO 555 I=1,LLL                                                    
        GWA(I)=MIN(GWA(I),0.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 
      if(imask.ne.0)                                       then   
c
c       * initialize lat/lon identification arrays for trouble points.
c
        do i=1,lgg
          lonb(i)=0
          latb(i)=0
        enddo
      endif
C                                                                                                                                   
      IOPTION=1                                                         
      ICHOICE=0                                                         
      CALL HRTOLR4(GL,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GWA,GHR,NLG,NLAT,IOPTION,ICHOICE,                    
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        if(imask.ne.0)                                     then
          nbadpts=0
          do ij=1,lgg
            if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
              nbadpts=nbadpts+1
            else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
              print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
              call xit('initg14',-64)
            endif
          enddo
c
          do n=1,nbadpts
            i=lonb(n)
            j=latb(n)
            ij=(j-1)*ilg1+i
            if(gicn(ij).gt.0.4) then
             gl(ij)=-4.
            else if(maskl(ij).eq.0.) then
             gl(ij)=-1.
            else
             gl(ij)=0.
            endif
          enddo
c
c         * add in cyclic longitude, which would have been done in
c         * hrtolr4 if it had completed successfully.
c
          do j=1,ilat
            jstart=(j-1)*ilg1+1
            jend  = j*ilg1
            gl(jend)=gl(jstart)
          enddo
        else  
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                       XIT('INITG14',-81)  
        endif
      ENDIF                                                             
C                                                                                                                                   
C     * THIS IS NEW: SET GL=-4. IF GICN>0.4. ALSO, IF GICN SAYS                                                                     
C     * IT IS NON-GLACIER BUT THE OLD GLACIER MASK FROM THE SAND                                                                    
C     * FIELD SAYS IT IS, WE SET THESE POINTS TO ROCK (GL=-3.).                                                                     
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 62S 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(MASKL(I).EQ.0.E0) GL(I)=-1.E0                                
        IF(GICN(I).GE.0.4)   GL(I)=-4.E0                                
        LAT=(I-1)/ILG1+1                                                
        LON=I-(LAT-1)*ILG1                                              
        IF(GL(I).EQ.-4. .AND. GICN(I).LT.0.4) THEN                      
          PRINT *, '0I,LON,LAT,GL,GICN = ',I,LON,LAT,GL(I),GICN(I)      
          GL(I)=-3.                                                     
        ENDIF                                                           
        IF(GL(I).NE.-1.E0)    THEN                                      
           GLR(I)=-1.E0                                                 
        ELSE                                                            
           GLR(I)=0.E0                                                  
        ENDIF                                                           
        IF(MASKL(I).EQ.-1.E0 .AND. GLR(I).EQ.0.E0)          THEN        
           WRITE(6,6040) I,LON,LAT,MASKL(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,MASKL(I),GL(I)                       
        ENDIF                                                           
        IF(GL(I).EQ.-3.E0)                               THEN           
           WRITE(6,6050) I,LON,LAT,MASKL(I),GL(I)                       
        ENDIF                                                           
  558 CONTINUE                                                          
C---------------------------------------------------------------------                                                              
C     * SOIL DEPTH (METRES) AND DRAINAGE (SCALE OF 0-1).                                                                            
C                                                                                                                                   
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('INITG14',-82)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL   XIT('INITG14',-83)  
      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 
      if(imask.ne.0)                                       then                                                         
c
c       * initialize lat/lon identification arrays for trouble points.
c
        do i=1,lgg
          lonb(i)=0
          latb(i)=0
        enddo
      endif
C
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,GLR,ILG1,ILAT,DLON,DLAT,ILG,                      
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,GHR,NLG,NLAT,IOPTION,ICHOICE,                    
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        if(imask.ne.0)                                     then
          nbadpts=0
          do ij=1,lgg
            if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
              nbadpts=nbadpts+1
            else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
              print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
              call xit('initg14',-67)
            endif
          enddo
c
          do n=1,nbadpts
            i=lonb(n)
            j=latb(n)
            ij=(j-1)*ilg1+i
            if(gicn(ij).gt.0.4) then
             gh(ij)=-4.
            else if(maskl(ij).eq.0.) then
             gh(ij)=0.
            else
             gh(ij)=1.00
            endif
          enddo
c
c         * add in cyclic longitude, which would have been done in
c         * hrtolr4 if it had completed successfully.
c
          do j=1,ilat
            jstart=(j-1)*ilg1+1
            jend  = j*ilg1
            gh(jend)=gh(jstart)
          enddo
        else  
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                       XIT('INITG14',-84)  
        endif
      ENDIF    
      if(imask.ne.0)                                       then                                                         
c
c       * initialize lat/lon identification arrays for trouble points.
c
        do i=1,lgg
          lonb(i)=0
          latb(i)=0
        enddo
      endif
C
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GWL,GLR,ILG1,ILAT,DLON,DLAT,ILG,                     
     1             LONM,LONP,LATM,LATP,                                 
     2             GWH,GHR,NLG,NLAT,IOPTION,ICHOICE,                    
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        if(imask.ne.0)                                     then
          nbadpts=0
          do ij=1,lgg
            if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
              nbadpts=nbadpts+1
            else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
              print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
              call xit('initg14',-68)
            endif
          enddo
c
          do n=1,nbadpts
            i=lonb(n)
            j=latb(n)
            ij=(j-1)*ilg1+i
            if(gicn(ij).gt.0.4) then
             gwl(ij)=-4.
            else if(maskl(ij).eq.0.) then
             gwl(ij)=0.
            else
             gwl(ij)=0.
            endif
          enddo
c
c         * add in cyclic longitude, which would have been done in
c         * hrtolr4 if it had completed successfully.
c
          do j=1,ilat
            jstart=(j-1)*ilg1+1
            jend  = j*ilg1
            gwl(jend)=gwl(jstart)
          enddo
        else  
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                       XIT('INITG14',-85)  
        endif
      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             
C                                                                        
      DO N=1,NTLD                                                       
        CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("DPTH"),N,             
     +                                    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                                              
        IBUF(3)=NC4TO8("SOCI")                                          
        CALL PUTFLD2(2,SOCI,IBUF,MAXX)                                  
      ENDDO                                                             
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
          if(imask.ne.0)                                       then
c
c           * initialize lat/lon identification arrays for trouble points.
c
            do i=1,lgg
              lonb(i)=0
              latb(i)=0
            enddo
          endif
C                                                                                                                                   
          IOPTION=1                                                     
          ICHOICE=1                                                     
          CALL HRTOLR4(GT,GLR,ILG1,ILAT,DLON,DLAT,ILG,                  
     1                 LONM,LONP,LATM,LATP,                             
     2                 DLAY(1,K),GHR,NLG,NLAT,IOPTION,ICHOICE,          
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK) THEN                                              
            if(imask.ne.0)                                     then
              nbadpts=0
              do ij=1,lgg
                if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
                  nbadpts=nbadpts+1
                else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                    (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
                  print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
                  call xit('initg14',-69)
                endif
              enddo
c
              do n=1,nbadpts
                i=lonb(n)
                j=latb(n)
                ij=(j-1)*ilg1+i
                if(gicn(ij).gt.0.4) then
                 gt(ij)=0.
                else if(maskl(ij).eq.0.) then
                 gt(ij)=0.
                else
                 if(k.eq.1) then
                   gt(ij)=0.10
                 else if(k.eq.2) then
                   gt(ij)=0.25
                 else
                   gt(ij)=0.65
                 endif
                endif
              enddo
c
c             * add in cyclic longitude, which would have been done in
c             * hrtolr4 if it had completed successfully.
c
              do j=1,ilat
                jstart=(j-1)*ilg1+1
                jend  = j*ilg1
                gt(jend)=gt(jstart)
              enddo
            else  
              WRITE(6,6030) LONBAD,LATBAD                                   
              CALL                                   XIT('INITG14',-86)  
            endif
          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('INITG14',-87)  
          IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL XIT('INITG14',-88)  
          WRITE(6,6025) IBUF                                            
                                                                        
          CALL GETFLD2(-1,GWH,NC4TO8("GRID"),0,NC4TO8("CLAY"),K,        
     +                                             IBUF,MAXX,OK)        
          IF(.NOT.OK) CALL                           XIT('INITG14',-89)  
          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
          if(imask.ne.0)                                       then
c
c           * initialize lat/lon identification arrays for trouble points.
c
            do i=1,lgg
              lonb(i)=0
              latb(i)=0
            enddo
          endif
C                                                                                                                                   
          IOPTION=1                                                     
          ICHOICE=1                                                     
          CALL HRTOLR4(GH,GLR,ILG1,ILAT,DLON,DLAT,ILG,                  
     1                 LONM,LONP,LATM,LATP,                             
     2                 GLL,GHR,NLG,NLAT,IOPTION,ICHOICE,                
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK)THEN                                               
            if(imask.ne.0)                                     then
              nbadpts=0
              do ij=1,lgg
                if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
                  nbadpts=nbadpts+1
                else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                    (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
                  print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
                  call xit('initg14',-73)
                endif
              enddo
c
              do n=1,nbadpts
                i=lonb(n)
                j=latb(n)
                ij=(j-1)*ilg1+i
                if(gicn(ij).gt.0.4) then
                 gh(ij)=-4.
                else if(maskl(ij).eq.0.) then
                 gh(ij)=0.
                else
                 if(k.eq.1) then
                   gh(ij)=0.5*0.10
                 else if(k.eq.2) then
                   gh(ij)=0.5*0.25
                 else
                   gh(ij)=0.5*0.65
                 endif
                endif
              enddo
c
c             * add in cyclic longitude, which would have been done in
c             * hrtolr4 if it had completed successfully.
c
              do j=1,ilat
                jstart=(j-1)*ilg1+1
                jend  = j*ilg1
                gh(jend)=gh(jstart)
              enddo
            else  
              WRITE(6,6030) LONBAD,LATBAD                                   
              CALL                                   XIT('INITG14',-91)  
            endif
          ENDIF                                                         
C
          if(imask.ne.0)                                       then
c
c           * initialize lat/lon identification arrays for trouble points.
c
            do i=1,lgg
              lonb(i)=0
              latb(i)=0
            enddo
          endif
C                                                                                                                                   
          IOPTION=1                                                     
          ICHOICE=1                                                     
          CALL HRTOLR4(GWL,GLR,ILG1,ILAT,DLON,DLAT,ILG,                 
     1                 LONM,LONP,LATM,LATP,                             
     2                 GWH,GHR,NLG,NLAT,IOPTION,ICHOICE,                
     3                 OK,LONBAD,LATBAD,                                
     4                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,   
     5                 VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)       
C                                                                                                                                   
          IF(.NOT.OK)THEN                                               
            if(imask.ne.0)                                     then
              nbadpts=0
              do ij=1,lgg
                if(lonb(ij).ne.0 .and. latb(ij).ne.0) then
                  nbadpts=nbadpts+1
                else if ( (lonb(ij).ne.0 .and. latb(ij).eq.0) .or.
     1                    (lonb(ij).eq.0 .and. latb(ij).ne.0) ) then
                  print *, '0ij,lonb,latb = ',ij,lonb(ij),latb(ij)
                  call xit('initg14',-74)
                endif
              enddo
c
              do n=1,nbadpts
                i=lonb(n)
                j=latb(n)
                ij=(j-1)*ilg1+i
                if(gicn(ij).gt.0.4) then
                 gwl(ij)=-4.
                else if(maskl(ij).eq.0.) then
                 gwl(ij)=0.
                else
                 if(k.eq.1) then
                   gwl(ij)=0.5*0.10
                 else if(k.eq.2) then
                   gwl(ij)=0.5*0.25
                 else
                   gwl(ij)=0.5*0.65
                 endif
                endif
              enddo
c
c             * add in cyclic longitude, which would have been done in
c             * hrtolr4 if it had completed successfully.
c
              do j=1,ilat
                jstart=(j-1)*ilg1+1
                jend  = j*ilg1
                gwl(jend)=gwl(jstart)
              enddo
            else  
              WRITE(6,6030) LONBAD,LATBAD                                   
              CALL                                   XIT('INITG14',-92)  
            endif
          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                                                                                                                                   
          DO N=1,NTLD                                                   
            IBUF4=1000*K + N                                            
            CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("SAND"),IBUF4,     
     +                                        ILG1,ILAT,0,NPGG)         
            CALL PUTFLD2(2,GH,IBUF,MAXX)                                
            WRITE(6,6026) IBUF                                          
          ENDDO                                                         
C                                                                                                                                   
          DO N=1,NTLD                                                   
            IBUF4=1000*K + N                                            
            CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("CLAY"),IBUF4,     
     +                                        ILG1,ILAT,0,NPGG)         
            CALL PUTFLD2(2,GWL,IBUF,MAXX)                               
            WRITE(6,6026) IBUF                                          
          ENDDO                                                         
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                                                                                                                                   
          DO N=1,NTLD                                                   
            IBUF4=1000*K + N                                            
            CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ORGM"),IBUF4,     
     +                                        ILG1,ILAT,0,NPGG)         
            CALL PUTFLD2(2,GH,IBUF,MAXX)                                
            WRITE(6,6026) IBUF                                          
          ENDDO                                                         
  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('INITG14',-93)  
        IF(IBUF(5).NE.NLG .OR.IBUF(6).NE.NLAT) CALL  XIT('INITG14',-94)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GWL,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                 
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
          WRITE(6,6030) LONBAD,LATBAD                                   
          CALL                                       XIT('INITG14',-95)  
        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,MASKL(I),GL(I),GWL(I)                         
            ENDIF                                                       
            IF(GL(I).LE.-3.E0 .OR. MASKL(I).GT.-0.5E0) GWL(I)= 0.E0     
  730   CONTINUE                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("FCAN"),IBUF4,       
     +                                      ILG1,ILAT,0,1)              
          CALL PUTFLD2(2,GWL,IBUF,MAXX)                                 
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-96)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-97)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-98)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALVC"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-99)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-82)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-83)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ALIC"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-84)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-85)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-86)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LNZ0"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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       * 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('INITG14',-87)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-88)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-89)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LAMX"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-90)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-91)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-92)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LAMN"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-93)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-94)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-95)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("CMAS"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
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('INITG14',-96)  
        IF(IBUF(5).NE.NLG.OR.IBUF(6).NE.NLAT) CALL   XIT('INITG14',-97)  
        WRITE(6,6025) IBUF                                              
C                                                                                                                                   
        IOPTION=1                                                       
        ICHOICE=1                                                       
        CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                  
     1               LONM,LONP,LATM,LATP,                               
     2               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,               
     3               OK,LONBAD,LATBAD,                                  
     4               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,     
     5               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)         
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                 
        WRITE(6,6030) LONBAD,LATBAD                                     
          CALL                                       XIT('INITG14',-98)  
        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                                                        
C                                                                                                                                   
        DO N=1,NTLD                                                     
          IBUF4=1000*IC + N                                             
          CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ROOT"),IBUF4,       
     +                                      ILG1,ILAT,0,NPGG)           
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                  
          WRITE(6,6026) IBUF                                            
        ENDDO                                                           
  780 CONTINUE                                                          
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('INITG14',-86)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-87)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-88)  
      ENDIF                                                             
C                                                                                                                                   
      DO 920 I=1,LGG                                                    
        GH(I) = GH(I)*0.01E0                                            
  920 CONTINUE                                                          
C                                                                                                                                   
      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.)                                                                  
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ALLW"),1,            
     +                                         IBUF,MAXX,OK)            
      IF(.NOT.OK) CALL                              XIT('INITG14',-89)  
      IF(IBUF(5).NE.NLG .OR. IBUF(6).NE.NLAT) CALL  XIT('INITG14',-90)  
      WRITE(6,6025) IBUF                                                
C                                                                                                                                   
      IOPTION=1                                                         
      ICHOICE=1                                                         
      CALL HRTOLR4(GH,MASKL,ILG1,ILAT,DLON,DLAT,ILG,                    
     1             LONM,LONP,LATM,LATP,                                 
     2             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,                 
     3             OK,LONBAD,LATBAD,                                    
     4             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,       
     5             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)           
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                   
        WRITE(6,6030) LONBAD,LATBAD                                     
        CALL                                        XIT('INITG14',-91)  
      ENDIF                                                             
C                                                                                                                                   
      DO 930 I=1,LGG                                                    
        GH(I) = GH(I)*0.01E0                                            
  930 CONTINUE                                                          
C                                                                                                                                   
      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     * GLACIER FRACTION.                                                                                                           
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("GICN"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,GICN,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                                                
C---------------------------------------------------------------------                                                              
C     * LAND FRACTION.                                                                                                              
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("FLND"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,FLND,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                                                
C---------------------------------------------------------------------                                                              
C     * UNRESOLVED LAKE INFORMATION.
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("FLKU"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,FLKU,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                                                
C
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LDEP"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,LDPT,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                   
C
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("LLAK"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,LLAK,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF            
C
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("BLAK"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,BLAK,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF            
C---------------------------------------------------------------------                                                              
C     * RESOLVED LAKE FRACTION AND DEPTH.                                                                                                     
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("FLKR"),1,               
     +                                  ILG1,ILAT,0,NPGG)               
      CALL PUTFLD2(2,FLKR,IBUF,MAXX)                                    
      WRITE(6,6026) IBUF                            
C---------------------------------------------------------------------                                                              
C     * SURFACE GEOPOTENTIAL ON MODEL GRID (FROM CONTROL FILE).                                                                     
                                                                        
      CALL GETFLD2(99,GL,NC4TO8("GRID"),0,NC4TO8("PHIM"),1,IBUF,MAXX,OK)
      IF(.NOT.OK) CALL                              XIT('INITG14',-95)  
      IBUF(3)=NC4TO8("PHIS")                                            
      CALL PUTFLD2(2,GL,IBUF,MAXX)                                      
      WRITE(6,6026) IBUF                                                
C---------------------------------------------------------------------
C     * ALL DONE...                                                                                                                 
C                                                                        
      CALL                                          XIT('INITG14',0)    
C                                                                                                                                    
C     * E.O.F. ENCOUNTERED WHILE READING INPUT.                                                                                     
C                                                                                                                                    
  905 CALL                                          XIT('INITG14',-3)                                                                 
C                                                                        
C     * E.O.F. ON FILE ICTL.                                                                                                        
C                                                                        
  910 CALL                                          XIT('INITG14',-96)  
  911 CALL                                          XIT('INITG14',-97)  
C---------------------------------------------------------------------                                                    
 5010 FORMAT(10X,F10.2)                                                         I4                                                            
 6010 FORMAT('0IDAY,ILG1,ILAT =',3I6)                                   
 6011 FORMAT('0NTLD,NTLK,NTWT,IFLM = ',4I5)                             
 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                                                               
