      PROGRAM INITGG8                                                                                                               
C     PROGRAM INITGG8 (ICTL,       LLPHYS,       GGPHYS,       OUTPUT,  )       I2                                                  
C    1          TAPE99=ICTL, TAPE1=LLPHYS, TAPE2=GGPHYS, TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          I2                                                  
C                                                                               I2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       I2                                                  
C     NOV 06/95 - F.MAJAESS (REVISE DEFAULT PACKING DENSITY VALUE)                                                                  
C     NOV 05/93 - M.LAZARE. NEW INITIALIZATION PROCESS FROM NEW 1X1                                                                 
C                           OFFSET INITIAL HIGH-RESOLUTION FIELDS, USING                                                            
C                           NEW SUBROUTINE HRTOLR2, WHICH COMBINES THE                                                              
C                           PREVIOUS HRAL AND HRTOLR. ALSO, NO LOWER                                                                
C                           BOUND OF ZERO IS IMPOSED ON ZS.                                                                         
C                           ALL IHYD=1 CODE HAS BEEN REMOVED.                                                                       
C     MAR 17/93 - M.LAZARE. PREVIOUS VERSION INITGG7.                                                                               
C                                                                               I2                                                  
CINITGG8 - GRID PHYSICS INITIALIZATION PROGRAM FOR GCM8                 2  1    I1                                                  
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 AND          I3                                                  
C                 SEA ICE FIELDS MUST BE AVAILABLE FOR ALL MONTHS. THE          I3                                                  
C                 SNOW COVER, LIQUID AND FROZEN WATER FIELDS ARE                I3                                                  
C                 REQUIRED FOR ANY MONTH THE MODEL STARTS FROM. THE             I3                                                  
C                 PROGRAM ABORTS IF FCAN, AVW, AIW, LNZ0, LAMX, LAMN,           I3                                                  
C                 CMAS, ROOT, ENV, PVEG, SVEG, SOIL OR PGND ARE                 I3                                                  
C                 MISSING AT START-UP DATE IDAY - THESE FIELDS HAVE ONE         I3                                                  
C                 BASIC ANNUAL VALUE.                                           I3                                                  
C                                                                               I3                                                  
C                 AS WELL, THE SURFACE HEIGHT FIELD (ON THE ANALYSIS            I3                                                  
C                 GAUSSIAN GRID) IS OBTAINED FROM THE CONTROL FILE              I3                                                  
C                 (AFTER CONVERTING FROM GEOPOTENTIAL TO HEIGHT) AND            I3                                                  
C                 SAVED ON THE AN FILE FOR DISPLAY PURPOSES.                    I3                                                  
C                                                                               I3                                                  
C                 INITIAL FIELDS AT 1X1 DEGREE RESOLUTION ARE EITHER            I3                                                  
C                 AREA-AVERAGED (CONTINUOUS) OR THEIR MOST-FREQUENTLY           I3                                                  
C                 OCCURRING VALUE IN THE MODEL-RESOLUTION GRID SQUARE           I3                                                  
C                 CHOSEN (DISCRETE-VALUED) USING THE SUBROUTINE HRTOLR2.        I3                                                  
C                 THE DISCRETE FIELDS ARE CONSIDERED TO BE GC AND SOIL.         I3                                                  
C                 ALL OTHERS ARE AREA-AVERAGED.                                 I3                                                  
C                                                                               I3                                                  
C                 THE SOIL FIELD IS TREATED SOMEWHAT UNIQUELY.                  I3                                                  
C                 THE SOIL COLOUR AND CLAYINESS ARE OBTAINED ON A               I3                                                  
C                 SCALE OF 1 TO 12 (DARK TO LIGHT, COARSE TO FINE), AND         I3                                                  
C                 THE SOIL SANDINESS AND DRAINAGE ARE OBTAINED ON A             I3                                                  
C                 SCALE OF 1 TO 15 (FINE TO COARSE, POOR TO FREE)               I3                                                  
C                 RESPECTIVELY ON THE 1X1 DEGREE GRID AND ARE AREA-             I3                                                  
C                 AVERAGED USING HRTOLR2. THE VALUES WHICH RESULT FOR EACH      I3                                                  
C                 LOW-RESOLUTION GRID SQUARE ARE THEN STORED INTO FOUR          I3                                                  
C                 "LEVELS" OF THE SOIL FIELD, WITH "LEVELS" 1-4                 I3                                                  
C                 REPRESENTING COLOUR, SANDINESS, CLAYINESS AND                 I3                                                  
C                 DRAINAGE RESPECTIVELY.                                        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      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      THESE DEFINE THE FOLLOWING CANOPY TYPES:                                 I3                                                  
C                                                                               I3                                                  
C           CLASS 1: TALL CONIFEROUS.                                           I3                                                  
C           CLASS 2: TALL BROADLEAF.                                            I3                                                  
C           CLASS 3: ARABLE AND CROPS.                                          I3                                                  
C           CLASS 4: GRASS, SWAMP AND TUNDRA (I.E. OTHER).                      I3                                                  
C           CLASS 5: URBAN (ONLY FOR FCAN,LNZ0,AVW,AIW).                        I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C  **   AIW   WEIGHTED NEAR-IR CANOPY ALBEDO    PERCENTAGE                      I3                                                  
C      ALLW   NEAR-IR CANOPY ALBEDO (SFC)       PERCENTAGE                      I3                                                  
C      ALSW   VISIBLE CANOPY ALBEDO (SFC)       PERCENTAGE                      I3                                                  
C  **   AVW   WEIGHTED VISIBLE CANOPY ALBEDO    PERCENTAGE                      I3                                                  
C       ENV   ENVELOPE OROGRAPHY                METRES                          I3                                                  
C  **  FCAN   AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C        GC   GROUND COVER                      -1.=LAND,0.=SEA,+1.=ICE         I3                                                  
C        GT   GROUND TEMPERATURE                DEG K                           I3                                                  
C  *   LAMN   MINIMUM LEAF AREA INDEX               -                           I3                                                  
C  *   LAMX   MAXIMUM LEAF AREA INDEX               -                           I3                                                  
C  **  LNZ0   LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C  *   CMAS   CANOPY MASS                       KG/M**2                         I3                                                  
C      PVEG   PRIMARY VEGETATION TYPE           0-24                            I3                                                  
C  *   ROOT   CANOPY ROOTING DEPTH              METRES                          I3                                                  
C       SIC   SEA ICE AMOUNT                    KG/M**2                         I3                                                  
C       SNO   SNOW DEPTH                        KG/M**2 = MM WATER DEPTH        I3                                                  
C      SOIL   SOIL CLASS                        SEE NOTE ABOVE                  I3                                                  
C      SVEG   SECONDARY VEGETATION TYPE         0-24                            I3                                                  
C        WF   FROZEN GROUND WATER               FRACTION OF CAPACITY            I3                                                  
C        WL   LIQUID GROUND WATER               FRACTION OF CAPACITY            I3                                                  
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      GGPHYS = GAUSSIAN GRID SURFACE PHYSICS FIELDS:                           I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C  **   AIW   WEIGHTED NEAR-IR CANOPY ALBEDO    FRACTION                        I3                                                  
C      ALLW   NEAR-IR CANOPY ALBEDO (SFC)           -                           I3                                                  
C      ALSW   VISIBLE CANOPY ALBEDO (SFC)           -                           I3                                                  
C  **   AVW   WEIGHTED VISIBLE CANOPY ALBEDO    FRACTION                        I3                                                  
C       ENV   ENVELOPE OROGRAPHY                METRES                          I3                                                  
C  **  FCAN   AREAL FRACTION OF CANOPY TYPE     FRACTION                        I3                                                  
C        GC   GROUND COVER                      -1.=LAND,0.=SEA,+1.=ICE         I3                                                  
C        GT   GROUND TEMPERATURE                DEG K                           I3                                                  
C  *   LAMN   MINIMUM LEAF AREA INDEX               -                           I3                                                  
C  *   LAMX   MAXIMUM LEAF AREA INDEX               -                           I3                                                  
C  **  LNZ0   LN OF SURFACE ROUGHNESS LENGTH        -                           I3                                                  
C  *   CMAS   CANOPY MASS                       KG/M**2                         I3                                                  
C      PVEG   PRIMARY VEGETATION TYPE           0-24                            I3                                                  
C  *   ROOT   CANOPY ROOTING DEPTH              METRES                          I3                                                  
C       SIC   SEA ICE AMOUNT                    KG/M**2                         I3                                                  
C       SNO   SNOW DEPTH                        KG/M**2 = MM WATER DEPTH        I3                                                  
C      SOIL   SOIL CLASS                        SEE NOTE ABOVE                  I3                                                  
C        WF   FROZEN GROUND WATER               FRACTION OF CAPACITY            I3                                                  
C        WL   LIQUID GROUND WATER               FRACTION OF CAPACITY            I3                                                  
C        ZS   SURFACE HEIGHT ON ANALYSIS GRID   METRES                          I3                                                  
C-----------------------------------------------------------------------------                                                      
C     * IF NO HIGH-RESOLUTION POINTS ARE FOUND WITHIN A PARTICULAR LOW-                                                             
C     * RESOLUTION GRID SQUARE, AN ABORT CONDITION IS GENERATED.                                                                    
                                                                                                                                    
C     * GLL IS THE FIELD READ IN FOR HIGH-RESOLUION OFFSET LAT-LON FIELDS WHILE                                                     
C     * GL IS THE FIELD READ IN FOR LOW-RESOLUTION LAT-LON FIELDS (ALSO                                                             
C     * USED AS THE OUTPUT FIELD FOR PRIMARY VEGETATION, FOR CONSISTENCY                                                            
C     * CHECKS).                                                                                                                    
C     * LLGC IS THE HIGH-RESOLUTION OFFSET LAT-LON GROUND COVER ARRAY WHILE GC                                                      
C     * IS THE GAUSSIAN-GRID GROUND COVER ARRAY.                                                                                    
C     * GH IS THE RESULTING OUTPUT FIELD ARRAY FOR ALL FIELDS.                                                                      
                                                                                                                                    
C     * GWH AND GWL ARE WORK FIELDS (HIGH-RESOLUTION AND LOW-RESOLUTION                                                             
C     * RESPECTIVELY) USED TO DETERMINE THE OUTPUT FIELD FOR SOIL                                                                   
C     * CLASS, WHICH CONTAINS AREA-AVERAGED INFORMATION ON COLOUR,                                                                  
C     * TEXTURE AND DRAINAGE, LATER DECOMPOSED IN THE MODEL.                                                                        
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     * COLOUR                                                                                                                      
C     * SAND    - LOOKUP TABLES FOR TRANSLATION OF SOIL CODES (0 TO 32)                                                             
C     * CLAY      INTO COLOUR, SANDINESS, CLAYINESS AND DRAINAGE CODES.                                                             
C     * DRAIN                                                                                                                       
C     *                                                                                                                             
C     *                                                                                                                             
C     * IPROP   - PROPERTY LIST FOR CURRENT HI-RES GRID POINT                                                                       
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (NLG=360,NLAT=180)                                                                                                  
C                                                                                                                                   
      REAL GLL(65341),LLGC(65341),GWH(65341)                                                                                        
      REAL GH(18528),GL(18528),GC(18528),GWL(18528),                                                                                
     1     GT(18528)                                                                                                                
      REAL DLAT(181), DLON(361)                                                                                                     
      REAL*8 SL(181), CL(181), WL(181), WOSSL(181), RAD(181)                                                                        
                                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
      REAL COLOUR(0:32),SAND(0:32),CLAY(0:32),DRAIN(0:32)                                                                           
      INTEGER ISOIL(0:32),NFDM(13)                                                                                                  
C                                                                                                                                   
C     * WORK ARRAYS FOR SUBROUTINE HRTOLR2.                                                                                         
C     * NOTE THAT THE SIZES OF ARRAYS VAL,DIST,LOCAT,IVAL,LOCFST AND                                                                
C     * NMAX REALLY REPRESENT THE NUMBER OF HIGH-RESOLUTION GRID                                                                    
C     * POINTS WITHIN A LOW-RESOLUTION GRID SQUARE. FOR CONVENIENCE                                                                 
C     * SAKE, THEY ARE DIMENSIONED WITH SIZE "NLG" AND AN ABORT                                                                     
C     * CONDITION IS GENERATED WITHIN THE SUBROUTINE.                                                                               
C                                                                                                                                   
      REAL GCHRTMP(NLG,NLAT)                                                                                                        
      REAL RLON(NLG), RLAT(NLAT)                                                                                                    
                                                                                                                                    
      REAL GCLRTMP(361,181)                                                                                                         
      INTEGER LATL(181), LATH(181), LONL(361), LONH(361)                                                                            
                                                                                                                                    
      REAL VAL(NLG), DIST(NLG)                                                                                                      
      INTEGER LOCAT(NLG), IVAL(NLG), LOCFST(NLG), NMAX(NLG)                                                                         
                                                                                                                                    
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
C                                                                                                                                   
C     LOOK-UP TABLE VALUES FOR SOIL FIELD DECOMPOSITION.                                                                            
C                                                                                                                                   
      DATA COLOUR/1.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                
     &   0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                  
     &   12.0E0,12.0E0,12.0E0,12.0E0,12.0E0,12.0E0,                                                                                 
     &   4.0E0, 4.0E0, 4.0E0, 4.0E0, 4.0E0,                                                                                         
     &   4.0E0, 1.0E0, 1.0E0, 1.0E0, 1.0E0, 1.0E0,                                                                                  
     &   1.0E0,12.0E0, 4.0E0, 1.0E0,12.0E0/                                                                                         
      DATA SAND /15.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                
     &   0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                  
     &   15.0E0, 3.6E0, 1.0E0,15.0E0, 3.6E0, 1.0E0,                                                                                 
     &   15.0E0, 3.6E0, 1.0E0,15.0E0, 3.6E0,                                                                                        
     &   1.0E0,15.0E0, 3.6E0, 1.0E0,15.0E0, 3.6E0,                                                                                  
     &   1.0E0, 1.0E0, 1.0E0, 1.0E0,15.0E0/                                                                                         
      DATA CLAY / 1.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                
     &   0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                  
     &   1.0E0, 4.2E0,12.0E0, 1.0E0, 4.2E0,12.0E0,                                                                                  
     &   1.0E0, 4.2E0,12.0E0, 1.0E0, 4.2E0,                                                                                         
     &   12.0E0, 1.0E0, 4.2E0,12.0E0, 1.0E0, 4.2E0,                                                                                 
     &   12.0E0,12.0E0,12.0E0,12.0E0, 1.0E0/                                                                                        
      DATA DRAIN/ 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                
     &   0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0,                                                                                  
     &   10.0E0,10.0E0,10.0E0, 5.0E0, 5.0E0, 5.0E0,                                                                                 
     &   10.0E0,10.0E0,10.0E0, 5.0E0, 5.0E0,                                                                                        
     &   5.0E0,10.0E0,10.0E0,10.0E0, 5.0E0, 5.0E0,                                                                                  
     &   5.0E0, 0.0E0, 0.0E0, 0.0E0, 0.0E0/                                                                                         
                                                                                                                                    
      DATA     ISOIL /                                                                                                              
     .   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,                                                                            
     .   0, 331, 321, 311, 332, 322, 312, 231, 221, 211,                                                                            
     . 232, 222, 212, 131, 121, 111, 132, 122, 112, 313,                                                                            
     . 213, 113, 333 /                                                                                                              
                                                                                                                                    
      DATA NFDM/1,32,60,91,121,152,182,213,244,274,305,335,0/                                                                       
      DATA MAXX,NPGG/65341,+1/                                                                                                      
C---------------------------------------------------------------------                                                              
      NFF=4                                                                                                                         
      CALL JCLPNT(NFF,99,1,2,6)                                                                                                     
      REWIND 2                                                                                                                      
      INTERP=1                                                                                                                      
                                                                                                                                    
C     * READ DAY OF THE YEAR, GAUSSIAN GRID SIZE AND LAND SURFACE SCHEME                                                            
C     * CODE FROM CONTROL FILE.                                                                                                     
                                                                                                                                    
      REWIND 99                                                                                                                     
      READ(99,END=910) LABL                                                                                                         
      READ(99,END=911) LABL,IXX,IXX,ILG,ILAT,IXX,IDAY,IXX,IXX                                                                       
      ILG1  = ILG+1                                                                                                                 
      ILATH = ILAT/2                                                                                                                
      LGG   = ILG1*ILAT                                                                                                             
      WRITE(6,6010)  IDAY,ILG1,ILAT                                                                                                 
                                                                                                                                    
C     * GAUSSG COMPUTES THE VALUE OF THE GAUSSIAN LATITUDES AND THEIR                                                               
C     * SINES AND COSINES. TRIGL MAKES THEM GLOBAL (S TO N).                                                                        
                                                                                                                                    
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
                                                                                                                                    
      DO 100 I=1,ILAT                                                                                                               
          DLAT(I) = RAD(I)*180.E0/3.14159E0                                                                                         
  100 CONTINUE                                                                                                                      
                                                                                                                                    
C     * DEFINE LONGITUDE VECTOR FOR GAUSSIAN GRID.                                                                                  
                                                                                                                                    
      DGX=360.E0/(FLOAT(ILG))                                                                                                       
      DO 120 I=1,ILG1                                                                                                               
          DLON(I)=DGX*FLOAT(I-1)                                                                                                    
  120 CONTINUE                                                                                                                      
                                                                                                                                    
C     * DETERMINE IF IDAY IS STARTING DAY OF A MONTH. IF NOT, INCREMENT                                                             
C     * NUMBER OF MONTHS BY ONE TO INCLUDE IDAY FIELDS AS WELL FOR GC,                                                              
C     * GT AND SIC.                                                                                                                 
                                                                                                                                    
      NMO=13                                                                                                                        
      DO 125 N=1,12                                                                                                                 
        IF(IDAY.EQ.NFDM(N).AND.NMO.EQ.13) NMO=12                                                                                    
  125 CONTINUE                                                                                                                      
      IF(NMO.EQ.13) NFDM(NMO)=IDAY                                                                                                  
C                                                                                                                                   
C     * DEFINE TARGET GRID TYPE FOR SUBROUTINE HRTOLR2 (GAUSSIAN GRID).                                                             
C                                                                                                                                   
      IGRID=0                                                                                                                       
C                                                                                                                                   
C     * INITIALIZE ACCUMULATOR OF THIRD SOIL LAYER TEMPERATURE TO 0.                                                                
C                                                                                                                                   
      DO 128 I=1,LGG                                                                                                                
          GL(I)=0.E0                                                                                                                
  128 CONTINUE                                                                                                                      
                                                                                                                                    
      DO 250 N=1,NMO                                                                                                                
C---------------------------------------------------------------------                                                              
C         * GROUND COVER (LAND=-1., SEA=0., PACK ICE=1.) FOR EVERY                                                                  
C         * MONTH.                                                                                                                  
                                                                                                                                    
          NDAY = NFDM(N)                                                                                                            
          CALL GETFLD2(-1,GLL,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
          IF(.NOT.OK) CALL                         XIT('INITGG8',-1)                                                                
          WRITE(6,6025) IBUF                                                                                                        
                                                                                                                                    
C         * SAVE EACH MONTH LAT-LON GROUND COVER INTO LLGC, FOR USE IN                                                              
C         * ROUTINE HRTOLR2 FOR GROUND TEMPERATURE AND SEA ICE (MUST DO                                                             
C         * FOR EACH MONTH).                                                                                                        
                                                                                                                                    
          LLL=IBUF(5)*IBUF(6)                                                                                                       
          DO 130 I=1,LLL                                                                                                            
              LLGC(I)=GLL(I)                                                                                                        
  130     CONTINUE                                                                                                                  
C                                                                                                                                   
          IOPTION=0                                                                                                                 
          ICHOICE=2                                                                                                                 
          CALL HRTOLR2(GC,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1                 GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                             
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITGG8',-2)                                                                
          ENDIF                                                                                                                     
          NPACK=MIN(4,IBUF(8))                                                                                                      
          CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),1,                                                                    
     +                                        ILG1,ILAT,0,NPACK)                                                                    
          CALL PUTFLD2(2,GC,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
          CALL GCROUND(GC,1,LGG)                                                                                                    
C------------------------------------------------------------------------                                                           
C         * GROUND TEMPERATURE (DEG K) (12 MONTHS).                                                                                 
                                                                                                                                    
          CALL GETFLD2(-1,GLL,NC4TO8("GRID"),NDAY,NC4TO8("  GT"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
          IF(.NOT.OK) CALL                         XIT('INITGG8',-3)                                                                
          WRITE(6,6025) IBUF                                                                                                        
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1                 GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                             
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITGG8',-4)                                                                
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * ACCUMULATE THIRD SOIL LAYER TEMPERATURE; SET FIRST SOIL                                                                 
C         * LAYER TEMPERATURE TO GT OF STARTING DAY.                                                                                
                                                                                                                                    
          IF(N.LT.13) THEN                                                                                                          
              DO 134 I=1,LGG                                                                                                        
                  GL(I)=GL(I)+GH(I)                                                                                                 
  134         CONTINUE                                                                                                              
          ENDIF                                                                                                                     
          IF(IDAY.EQ.NFDM(N)) THEN                                                                                                  
              DO 135 I=1,LGG                                                                                                        
                  GT(I)=GH(I)                                                                                                       
  135         CONTINUE                                                                                                              
          ENDIF                                                                                                                     
                                                                                                                                    
          CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8("  GT"),1,                                                                    
     +                                         ILG1,ILAT,0,NPGG)                                                                    
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
C------------------------------------------------------------------------                                                           
C         * SEA ICE AMOUNT (KG M-2) (12 MONTHS)                                                                                     
                                                                                                                                    
          CALL GETFLD2(-1,GLL,NC4TO8("GRID"),NDAY,NC4TO8(" SIC"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
          IF(.NOT.OK) CALL                         XIT('INITGG8',-5)                                                                
          WRITE(6,6025) IBUF                                                                                                        
          DO 140 I=1,LLL                                                                                                            
            GWH(I)=MERGE(0.0E0,LLGC(I),LLGC(I).GE.0.0E0)                                                                            
  140     CONTINUE                                                                                                                  
          DO 145 I=1,LGG                                                                                                            
            GWL(I)=MERGE(0.0E0,GC(I),GC(I).GE.0.0E0)                                                                                
  145     CONTINUE                                                                                                                  
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR2(GH,GWL,ILG1,ILAT,DLON,DLAT,ILG,                                                                              
     1                 GLL,GWH,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                      
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                             
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITGG8',-6)                                                                
          ENDIF                                                                                                                     
C                                                                                                                                   
          DO 150 I=1,LGG                                                                                                            
            GH(I)=MERGE(0.0E0,MAX(0.0E0,GH(I)),GC(I).EQ.0.0E0)                                                                      
  150     CONTINUE                                                                                                                  
          NPACK=MIN(2,IBUF(8))                                                                                                      
          CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8(" SIC"),1,                                                                    
     +                                        ILG1,ILAT,0,NPACK)                                                                    
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
  250 CONTINUE                                                                                                                      
C---------------------------------------------------------------------                                                              
C     * CALCULATE TEMPERATURE OF SECOND SOIL LAYER; WRITE OUT ALL                                                                   
C     * THREE SOIL LAYER TEMPERATURES.                                                                                              
                                                                                                                                    
      DO 260 I=1,LGG                                                                                                                
          GL(I)=GL(I)/12.E0                                                                                                         
          GH(I)=(GT(I)+GL(I))/2.E0                                                                                                  
  260 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GT,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),2,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("TBAR"),3,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GL,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * ENVELOPE OROGRAPHY (VARIANCE IN M2).                                                                                        
C     * PUT VALUES TO ZERO OVER SEA ICE AND OCEAN POINTS.                                                                           
C     * IN ORDER TO DO THIS, THE HIGH-RESOLUTION GROUND COVER FIELD FOR IDAY                                                        
C     * IS READ BACK IN AND REDUCED TO THE GAUSSIAN-GRID. BOTH OF THESE FIELDS                                                      
C     * ARE SAVED FOR LATER USE IN THE PROGRAM.                                                                                     
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8(" ENV"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITGG8',-7)                                                                
      WRITE(6,6025) IBUF                                                                                                            
                                                                                                                                    
      CALL GETFLD2(-1,LLGC,NC4TO8("GRID"),IDAY,NC4TO8("  GC"),1,                                                                    
     +                                             IBUF,MAXX,OK)                                                                    
      IF(.NOT.OK) CALL                             XIT('INITGG8',-8)                                                                
C                                                                                                                                   
      IOPTION=0                                                                                                                     
      ICHOICE=2                                                                                                                     
      CALL HRTOLR2(GC,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             LLGC,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                        
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
            CALL                                   XIT('INITGG8',-9)                                                                
      ENDIF                                                                                                                         
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-10)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 270 I=1,LGG                                                                                                                
        GH(I) = MERGE(MAX(GH(I),0.0E0), 0.0E0, GC(I).LT.0.0E0)                                                                      
  270 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8(" ENV"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * GLACIER CONSISTENCY CHECK FIELD (NOT OUTPUT).                                                                               
C     * THE CONSISTENCY CHECKS FOR GLACIER ARE PROPERLY                                                                             
C     * DONE WHERE THE FRACTION OF GLACIER IS GREATER THAN 0.5.                                                                     
C     * HENCE, THE ARRAY "GL" IS DEFINED TO BE EQUAL TO ONE IN THIS                                                                 
C     * CASE, OTHERWISE IT IS SET TO ZERO. THIS REQUIRES READING                                                                    
C     * IN OF THE FRACTION OF GLACIER FIELD AND REDUCING IT TO THE                                                                  
C     * GAUSSIAN GRID.                                                                                                              
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),1,NC4TO8("PCNT"),1,IBUF,                                                                   
     +                                                   MAXX,OK)                                                                   
      IF(.NOT.OK) CALL                             XIT('INITGG8',-11)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GWL,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                  
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-12)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 350 I=1,LGG                                                                                                                
        IF(GWL(I).GT.0.5E0)    THEN                                                                                                 
          GL(I)=1.E0                                                                                                                
        ELSE                                                                                                                        
          GL(I)=0.E0                                                                                                                
        ENDIF                                                                                                                       
  350 CONTINUE                                                                                                                      
C---------------------------------------------------------------------                                                              
C     * SNOW DEPTH (KG/M**2 WATER EQUIVALENT = MM SNOW).                                                                            
C     * MAKE SURE SNOW IS NOT NEGATIVE, AND IS 0. OVER WATER.                                                                       
C     * SELECT DAY IDAY ONLY.                                                                                                       
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),IDAY,NC4TO8(" SNO"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITGG8',-13)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-14)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 400 I=1,LGG                                                                                                                
        GH(I)=MERGE(0.0E0,MAX(0.0E0,GH(I)),GC(I).EQ.0.0E0)                                                                          
  400 CONTINUE                                                                                                                      
      NPACK=MIN(2,IBUF(8))                                                                                                          
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8(" SNO"),1,                                                                        
     +                                    ILG1,ILAT,0,NPACK)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * FROZEN WATER (FRACTION OF SOIL CAPACITY).                                                                                   
C     * IT MUST LIE BETWEEN 0. AND 1, AND BE 0.,1. OVER SEA,ICE.                                                                    
C     * SELECT DAY IDAY ONLY.                                                                                                       
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),IDAY,NC4TO8("  WF"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITGG8',-15)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-16)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 540 I=1,LGG                                                                                                                
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                                                                                     
        GH(I) = MERGE(1.0E0, GH(I), GC(I).EQ.1.0E0)                                                                                 
        GH(I) = MERGE(0.0E0, GH(I), GC(I).EQ.0.0E0)                                                                                 
        GH(I) = MERGE(1.0E0, GH(I), GL(I).EQ.1.0E0)                                                                                 
  540 CONTINUE                                                                                                                      
                                                                                                                                    
      NPACK=MIN(4,IBUF(8))                                                                                                          
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("  WF"),1,                                                                        
     +                                    ILG1,ILAT,0,NPACK)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * LIQUID WATER (FRACTION OF SOIL CAPACITY).                                                                                   
C     * IT MUST LIE BETWEEN 0. AND 1, AND BE 1.,0. OVER SEA,ICE.                                                                    
C     * SELECT DAY IDAY ONLY.                                                                                                       
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),IDAY,NC4TO8("  WL"),1,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
      IF(.NOT.OK) CALL                             XIT('INITGG8',-17)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-18)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 550 I=1,LGG                                                                                                                
        GH(I) = MAX (MIN (GH(I), 1.0E0), 0.0E0)                                                                                     
        GH(I) = MERGE(0.0E0, GH(I), GC(I).EQ.1.0E0)                                                                                 
        GH(I) = MERGE(1.0E0, GH(I), GC(I).EQ.0.0E0)                                                                                 
        GH(I) = MERGE(0.0E0, GH(I), GL(I).EQ.1.0E0)                                                                                 
  550 CONTINUE                                                                                                                      
                                                                                                                                    
      NPACK=MIN(4,IBUF(8))                                                                                                          
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("  WL"),1,                                                                        
     +                                    ILG1,ILAT,0,NPACK)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * SOIL (CLASSES 11 THROUGH 32).                                                                                               
C     * ENSURE CONSISTENCY WITH PRIMARY VEGETATION FIELD OVER GLACIER                                                               
C     * ICE AND WITH GROUND COVER OVER OTHER NON-LAND POINTS.                                                                       
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("SOIL"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITGG8',-19)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
C     * PRODUCE LOW-RESOLUTION COLOUR, SANDINESS, CLAYINESS AND DRAINAGE                                                            
C     * FIELDS IN TURN AND STORE THEM INTO THE LOW-RESOLUTION OUTPUT                                                                
C     * FIELDS.                                                                                                                     
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("SOIL"),0,                                                                        
     +                                        ILG1,ILAT,0,1)                                                                        
C                                                                                                                                   
      DO 620 K = 1, 4                                                                                                               
                                                                                                                                    
C                                                                                                                                   
C         * INITIALIZE OUTPUT FIELD.                                                                                                
C                                                                                                                                   
          DO 590 I = 1,LGG                                                                                                          
              GH(I) = 0.E0                                                                                                          
  590     CONTINUE                                                                                                                  
C                                                                                                                                   
C         * LOAD HIGH-RES PROPERTY FIELD INTO HIGH-RES WORKSPACE.                                                                   
C                                                                                                                                   
          IF(K.EQ.1) THEN                                                                                                           
              DO 595 I = 1,LLL                                                                                                      
                  GWH(I) = COLOUR(NINT(GLL(I)))                                                                                     
  595         CONTINUE                                                                                                              
          ELSEIF(K.EQ.2) THEN                                                                                                       
              DO 600 I = 1,LLL                                                                                                      
                  GWH(I) = SAND(NINT(GLL(I)))                                                                                       
  600         CONTINUE                                                                                                              
          ELSEIF(K.EQ.3) THEN                                                                                                       
              DO 605 I = 1,LLL                                                                                                      
                  GWH(I) = CLAY(NINT(GLL(I)))                                                                                       
  605         CONTINUE                                                                                                              
          ELSEIF(K.EQ.4) THEN                                                                                                       
              DO 610 I = 1,LLL                                                                                                      
                  GWH(I) = DRAIN(NINT(GLL(I)))                                                                                      
  610         CONTINUE                                                                                                              
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * CONSTRUCT LOW-RES PROPERTY FIELD IN LOW-RES WORKSPACE.                                                                  
C                                                                                                                                   
          IOPTION=1                                                                                                                 
          ICHOICE=1                                                                                                                 
          CALL HRTOLR2(GWL,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                              
     1                 GWH,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2                 OK,LONBAD,LATBAD,                                                                                            
     3                 GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                               
     4                 VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                             
C                                                                                                                                   
          IF(.NOT.OK)THEN                                                                                                           
            WRITE(6,6030) LONBAD,LATBAD                                                                                             
            CALL                                   XIT('INITGG8',-20)                                                               
          ENDIF                                                                                                                     
C                                                                                                                                   
C         * ADD LOW-RES PROPERTY FIELD TO LOW-RES OUTPUT FIELD.                                                                     
C         * PERFORM CONSISTENCY CHECK VERSUS FRACTION OF VEGETATION TYPE                                                            
C         * #1 (GLACIER). IF FRACTION IS GREATER THAN 0.5, REDEFINE                                                                 
C         * RESULTING VALUES TO BE SPECIAL INDICATORS FOR COLOUR AND                                                                
C         * SANDINESS.                                                                                                              
C                                                                                                                                   
          DO 615 I = 1, LGG                                                                                                         
              IF(GC(I).EQ.-1.E0 .AND. GL(I).EQ.1.E0)              THEN                                                              
                  IF(K.EQ.1)       THEN                                                                                             
                      GH(I)=32.E0                                                                                                   
                  ELSE IF(K.EQ.2)  THEN                                                                                             
                      GH(I)=16.E0                                                                                                   
                  ENDIF                                                                                                             
              ELSE IF(GC(I).EQ.-1.E0) THEN                                                                                          
                  GH(I)    = FLOAT(NINT(GWL(I)))                                                                                    
              ENDIF                                                                                                                 
  615     CONTINUE                                                                                                                  
          IBUF(4)=K                                                                                                                 
          CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                              
          WRITE(6,6026) IBUF                                                                                                        
  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('INITGG8',-21)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GWL,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INITGG8',-22)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 730 I=1,LGG                                                                                                              
            IF(GL(I).EQ.1.E0.OR.GC(I).GT.-0.5E0) GWL(I)= 0.E0                                                                       
  730   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("FCAN"),IC,                                                                     
     +                                           ILG1,ILAT,0,1)                                                                     
        CALL PUTFLD2(2,GWL,IBUF,MAXX)                                                                                               
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * VISIBLE ALBEDO OF EACH CANOPY TYPE.                                                                                       
C       * CONVERT FROM PERCENT TO FRACTION AND COMPLETE WEIGHTING                                                                   
C       * CALCULATION OVER CANOPY TYPES.                                                                                            
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8(" AVW"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-23)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-24)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 735 I=1,LGG                                                                                                              
            IF(GWL(I).GT.0.0E0) THEN                                                                                                
                GH(I) = 0.01E0*GH(I)/GWL(I)                                                                                         
            ELSE                                                                                                                    
                GH(I)=0.0E0                                                                                                         
            ENDIF                                                                                                                   
  735   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("ALVC"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * NEAR-IR ALBEDO OF EACH CANOPY TYPE.                                                                                       
C       * CONVERT FROM PERCENT TO FRACTION AND COMPLETE WEIGHTING                                                                   
C       * CALCULATION OVER CANOPY TYPES.                                                                                            
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8(" AIW"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-25)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-26)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 740 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = 0.01E0*GH(I)/GWL(I)                                                                                             
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  740   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("ALIC"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C---------------------------------------------------------------------                                                              
C       * LN OF ROUGHNESS LENGTH OF EACH CANOPY TYPE.                                                                               
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LNZ0"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-27)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-28)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 745 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  745   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LNZ0"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C                                                                                                                                   
C       * FOLLOWING FIELDS IN VEGETATION CLASS LOOP NOT DEFINED FOR                                                                 
C       * URBAN CLASS (IC=ICAN+1).                                                                                                  
C                                                                                                                                   
        IF(IC.EQ.ICANP1) GO TO 780                                                                                                  
C                                                                                                                                   
C-----------------------------------------------------------------------                                                            
C       * MAXIMUM LEAF AREA INDEX OF EACH CANOPY TYPE.                                                                              
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LAMX"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-29)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-30)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 750 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  750   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LAMX"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * MINIMUM LEAF AREA INDEX OF EACH CANOPY TYPE.                                                                              
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("LAMN"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-31)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-32)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 755 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  755   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("LAMN"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * CANOPY MASS OF EACH CANOPY TYPE.                                                                                          
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("CMAS"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-33)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-34)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 760 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  760   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("CMAS"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C-----------------------------------------------------------------------                                                            
C       * ROOTING DEPTH OF EACH CANOPY TYPE.                                                                                        
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ROOT"),IC,                                                                     
     +                                            IBUF,MAXX,OK)                                                                     
        IF(.NOT.OK) CALL                           XIT('INITGG8',-35)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1               GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                               
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
          CALL                                     XIT('INITGG8',-36)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        DO 765 I=1,LGG                                                                                                              
          IF(GWL(I).GT.0.0E0) THEN                                                                                                  
            GH(I) = GH(I)/GWL(I)                                                                                                    
          ELSE                                                                                                                      
            GH(I)=0.0E0                                                                                                             
          ENDIF                                                                                                                     
  765   CONTINUE                                                                                                                    
        CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("ROOT"),IC,                                                                     
     +                                        ILG1,ILAT,0,NPGG)                                                                     
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
                                                                                                                                    
  780 CONTINUE                                                                                                                      
C*********************************************************************                                                              
C---------------------------------------------------------------------                                                              
C     * VISIBLE ALBEDO (CONVERT FROM PER-CENT TO FRACTION 0. TO 1.)                                                                 
                                                                                                                                    
C     * FIRST CONVERT HIGH AND LOW RESOLUTION GROUND COVERS TO LAND/                                                                
C     * NO-LAND MASK, SINCE SEA-ICE ALBEDO CALCULATION DONE INSIDE                                                                  
C     * MODEL (LAND:GC=1., NO-LAND:GC=0.)                                                                                           
C                                                                                                                                   
      DO 870 I=1,LLL                                                                                                                
          IF(LLGC(I).GE.0.E0) THEN                                                                                                  
              LLGC(I)=0.E0                                                                                                          
          ELSE                                                                                                                      
              LLGC(I)=1.E0                                                                                                          
          ENDIF                                                                                                                     
  870 CONTINUE                                                                                                                      
                                                                                                                                    
      DO 880 I=1,LGG                                                                                                                
          IF(GC(I).GE.0.E0) THEN                                                                                                    
              GC(I)=0.E0                                                                                                            
          ELSE                                                                                                                      
              GC(I)=1.E0                                                                                                            
          ENDIF                                                                                                                     
  880 CONTINUE                                                                                                                      
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ALSW"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITGG8',-37)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-38)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 920 I=1,LGG                                                                                                                
        GH(I) = GH(I)*0.01E0                                                                                                        
  920 CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("ALSW"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * NEAR-IR ALBEDO (CONVERT FROM PERCENT TO FRACTION 0. TO 1.)                                                                  
                                                                                                                                    
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ALLW"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INITGG8',-39)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR2(GH,GC,ILG1,ILAT,DLON,DLAT,ILG,                                                                                   
     1             GLL,LLGC,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                         
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,NMAX)                                                                                 
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INITGG8',-40)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      DO 930 I=1,LGG                                                                                                                
          GH(I) = GH(I)*0.01E0                                                                                                      
  930 CONTINUE                                                                                                                      
      CALL SETLAB(IBUF,NC4TO8("GRID"),IDAY,NC4TO8("ALLW"),1,                                                                        
     +                                     ILG1,ILAT,0,NPGG)                                                                        
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * SURFACE HEIGHT (FROM CONTROL FILE).                                                                                         
C     * CONVERT BACK TO HEIGHT IN METRES FOR DISPLAY PURPOSES.                                                                      
                                                                                                                                    
      CALL GETFLD2(99,GL,NC4TO8("GRID"),0,NC4TO8("PHIS"),1,IBUF,MAXX,OK)                                                            
      IF(.NOT.OK) CALL                             XIT('INITGG8',-41)                                                               
      WRITE(6,6025) IBUF                                                                                                            
      LG=IBUF(5)*IBUF(6)                                                                                                            
      DO 940 I=1,LG                                                                                                                 
        GL(I)=GL(I)/9.80616E0                                                                                                       
  940 CONTINUE                                                                                                                      
      IBUF(2)=IDAY                                                                                                                  
      IBUF(3)=NC4TO8("  ZS")                                                                                                        
      IBUF(8)=1                                                                                                                     
      CALL PUTFLD2(2,GL,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
                                                                                                                                    
C     * E.O.F. ON FILE LL.                                                                                                          
                                                                                                                                    
      CALL                                         XIT('INITGG8',0)                                                                 
                                                                                                                                    
C     * E.O.F. ON FILE ICTL.                                                                                                        
                                                                                                                                    
  910 CALL                                         XIT('INITGG8',-42)                                                               
  911 CALL                                         XIT('INITGG8',-43)                                                               
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0IDAY,ILG1,ILAT =',3I6)                                                                                               
 6025 FORMAT(' ',A4,I10,1X,A4,5I6)                                                                                                  
 6026 FORMAT(' ',60X,A4,I10,1X,A4,5I6)                                                                                              
 6030 FORMAT('0NO POINTS FOUND WITHIN GRID SQUARE CENTRED AT (',I3,',',                                                             
     1       I3,')')                                                                                                                
      END                                                                                                                           
