      PROGRAM INTCHMO                                                                                                               
C     PROGRAM INTCHMO (ICTL,        MASK,       LLPHYS,       LLCHEM,           I2                                                  
C    1                                          GGCHEM,        OUTPUT,  )       I2                                                  
C    2          TAPE99=ICTL, TAPE88=MASK, TAPE77=LLPHYS,TAPE1=LLCHEM,                                                               
C    3                                    TAPE2=GGCHEM,  TAPE6=OUTPUT)                                                              
C     ----------------------------------------------------------------          I2                                                  
C                                                                               I2                                                  
C     FEB 22/05 - M. LAZARE. - RENAMED "INTCHMO" FROM A PREVIOUS VERSION OF     I2                                                  
C                              "INITCHM" PROGRAM IN ORDER TO PRESERVE THE SAME  I2                                                  
C                              OUTPUT FOR "GCM13D"/"GCM15C" AGCM MODEL VERSIONS I2                                                  
C     MAY 21/04 - M. LAZARE. - CHANGE THE DIMENSION OF "LONB(361),LATB(181)" TO                                                     
C                              "NLOMAX".                                                                                            
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)                                                           
C     JUN  6/00 - M.LAZARE.  - NEW PROGRAM BASED ON GRID PHYSICS                                                                    
C                              INITIALIZATION, EXCEPT DEDICATED TO                                                                  
C                              CHEMISTRY INPUT FIELDS (SUCH AS SULFUR                                                               
C                              CYCLE.                                                                                               
C                                                                               I2                                                  
CINTCHMO - GRID CHEMISTRY INITIALIZATION PROGRAM FOR GCM13D/GCM15C      2  1    I1                                                  
C                                                                               I3                                                  
CAUTHOR  - M.LAZARE                                                             I3                                                  
C                                                                               I3                                                  
CPURPOSE - CONVERTS HIGH-RESOLUTION LAT-LONG SURFACE CHEMISTRY GRIDS TO         I3                                                  
C          GAUSSIAN GRIDS.                                                      I3                                                  
C          NOTE - ALL INITIAL SURFACE FIELDS ARE AT 1X1 DEGREE OFFSET           I3                                                  
C                 RESOLUTION. THE BLACK/ORGANIC CARBON AND DMS (O/L)            I3                                                  
C                 MUST BE AVAILABLE FOR ALL MONTHS. THE IPCC A2_2000            I3                                                  
C                 FIELD HAS ONE BASIC ANNUAL VALUE.                             I3                                                  
C                                                                               I3                                                  
C                 INITIAL FIELDS AT 1X1 DEGREE RESOLUTION ARE                   I3                                                  
C                 AREA-AVERAGED USING THE SUBROUTINE HRTOLR3.                   I3                                                  
C                                                                               I3                                                  
CINPUT FILES...                                                                 I3                                                  
C                                                                               I3                                                  
C      ICTL   = CONTAINS GLOBAL LAT-LONG GRIDS WHICH ARE READ AND               I3                                                  
C               HORIZONTALLY SMOOTHED TO GLOBAL GAUSSIAN GRIDS. THE LAT-        I3                                                  
C               LONG GRIDS MAY BE IN ANY ORDER ON THIS FILE.                    I3                                                  
C                                                                               I3                                                  
C      MASK   = CONTAINS LAND MASK (NO SEA-ICE, I.E. -1/0) ON MODEL             I3                                                  
C               GAUSSIAN-GRID.                                                  I3                                                  
C                                                                               I3                                                  
C      LLPHYS = OFFSET LAT-LONG PHYSICS GRIDS(USED ONLY TO GET MASK)            I3                                                  
C                                                                               I3                                                  
C      LLCHEM = CONTAINS THE HIGH-RES CHEMISTRY EMISSION GRIDS:                 I3                                                  
C                                                                               I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C       EBC   BLACK CARBON EMISSIONS            KG/M2-S                         I3                                                  
C       EOC   ORGANIC CARBON EMISSIONS          KG/M2-S                         I3                                                  
C      EOCF   ORGANIC FOREST CARBON EMISSIONS   KG/M2-S                         I3                                                  
C      DMSO   KETTLE OCEANIC DMS CONCENTRATIONS NANOMOL/LITRE                   I3                                                  
C      EDMS   LAND DMS FLUXES                   KG/M2-S                         I3                                                  
C      ESO2   SO2 EMISSIONS (ANNUAL ONLY)       KG/M2-S                         I3                                                  
C      EVOL   VOLCANIC EMISSIONS (ANNUAL ONLY)  KG/M2-S                         I3                                                  
C      HVOL   VOLCANO MAX HEIGHT (ANNUAL ONLY)  METRES                          I3                                                  
                                                                                                                                    
C                                                                               I3                                                  
COUTPUT FILE...                                                                 I3                                                  
C                                                                               I3                                                  
C      GGCHEM = GAUSSIAN GRID SURFACE PHYSICS FIELDS:                           I3                                                  
C                                                                               I3                                                  
C      NAME            VARIABLE                   UNITS                         I3                                                  
C      ----            --------                   -----                         I3                                                  
C                                                                               I3                                                  
C       EBC   BLACK CARBON EMISSIONS            KG/M2-S                         I3                                                  
C       EOC   ORGANIC CARBON EMISSIONS          KG/M2-S                         I3                                                  
C      EOCF   ORGANIC FOREST CARBON EMISSIONS   KG/M2-S                         I3                                                  
C      DMSO   KETTLE OCEANIC DMS CONCENTRATIONS NANOMOL/LITRE                   I3                                                  
C      EDMS   LAND DMS FLUXES                   KG/M2-S                         I3                                                  
C      ESO2   SO2 EMISSIONS (ANNUAL ONLY)       KG/M2-S                         I3                                                  
C      EVOL   VOLCANIC EMISSIONS (ANNUAL ONLY)  KG/M2-S                         I3                                                  
C      HVOL   VOLCANO MAX HEIGHT (ANNUAL ONLY)  METRES                          I3                                                  
C-----------------------------------------------------------------------------                                                      
C     * IF NO HIGH-RESOLUTION POINTS ARE FOUND WITHIN A PARTICULAR LOW-                                                             
C     * RESOLUTION GRID SQUARE, EVEN AFTER CONSIDERING INFORMATION FROM                                                             
C     * NEAREST-NEIGHBOUR POINTS ON THE GAUSSIAN GRID, AN ABORT CONDITION                                                           
C     * IS GENERATED.                                                                                                               
                                                                                                                                    
C     * HRMASK IS THE HIGH-RESOLUTION OFFSET LAND MASK (LAND=-1., ELSE 0.)                                                          
C     * WHILE MASK IS THE STANDARD LAND MASK AT GAUSSIAN GRID RESOLUTION                                                            
C     * (READ IN).                                                                                                                  
                                                                                                                                    
C     * GH IS GENERALLY THE RESULTING OUTPUT FIELD ARRAY FOR ALL FIELDS.                                                            
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      PARAMETER (NLG=360,NLAT=180,IGND=3,NM=12,NM1=NM+1,NLOMAX=18528,                                                               
     1           NHIMAX=NLG*NLAT)                                                                                                   
C                                                                                                                                   
      REAL GLL(NHIMAX),HRMASK(NHIMAX)                                                                                               
      REAL  GH(NLOMAX),  MASK(NLOMAX)                                                                                               
      REAL DLAT(181), DLON(361)                                                                                                     
      REAL*8 SL(181), CL(181), WL(181), WOSSL(181), RAD(181)                                                                        
C                                                                                                                                   
      INTEGER NFDM(NM),MMD(NM)                                                                                                      
                                                                                                                                    
      LOGICAL OK                                                                                                                    
                                                                                                                                    
C     * WORK ARRAYS FOR SUBROUTINE GGFILL CALLED IN HRTOLR3.                                                                        
                                                                                                                                    
      INTEGER LONB(NLOMAX), LATB(NLOMAX)                                                                                            
C                                                                                                                                   
C     * WORK ARRAYS FOR SUBROUTINE HRTOLR3.                                                                                         
C     * NOTE THAT THE SIZES OF ARRAYS VAL,DIST,LOCAT,IVAL,LOCFST AND                                                                
C     * NMAX REALLY REPRESENT THE NUMBER OF HIGH-RESOLUTION GRID                                                                    
C     * POINTS WITHIN A LOW-RESOLUTION GRID SQUARE. FOR CONVENIENCE                                                                 
C     * SAKE, THEY ARE DIMENSIONED WITH SIZE "NLG" AND AN ABORT                                                                     
C     * CONDITION IS GENERATED WITHIN THE SUBROUTINE.                                                                               
C                                                                                                                                   
      REAL GCHRTMP(NLG,NLAT)                                                                                                        
      REAL RLON(NLG), RLAT(NLAT)                                                                                                    
                                                                                                                                    
      REAL GCLRTMP(361,181)                                                                                                         
      INTEGER LATL(181), LATH(181), LONL(361), LONH(361)                                                                            
                                                                                                                                    
      REAL VAL(NLG), DIST(NLG)                                                                                                      
      INTEGER LOCAT(NLG), IVAL(NLG), LOCFST(NLG), NMAX(NLG)                                                                         
                                                                                                                                    
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(65341)                                                                                               
                                                                                                                                    
      DATA NFDM/1,32,60,91,121,152,182,213,244,274,305,335/                                                                         
      DATA  MMD/16,46,75,106,136,167,197,228,259,289,320,350/                                                                       
      DATA MAXX,NPGG/65341,+1/                                                                                                      
C---------------------------------------------------------------------                                                              
      NFF=6                                                                                                                         
      CALL JCLPNT(NFF,99,88,77,1,2,6)                                                                                               
                                                                                                                                    
      INTERP=1                                                                                                                      
                                                                                                                                    
C     * READ DAY OF THE YEAR, GAUSSIAN GRID SIZE AND LAND SURFACE SCHEME                                                            
C     * CODE FROM CONTROL FILE.                                                                                                     
                                                                                                                                    
      REWIND 99                                                                                                                     
      READ(99,END=910) LABL                                                                                                         
      READ(99,END=911) LABL,IXX,IXX,ILG,ILAT,IXX,IDAY,IXX,IXX                                                                       
      ILG1  = ILG+1                                                                                                                 
      ILATH = ILAT/2                                                                                                                
      LGG   = ILG1*ILAT                                                                                                             
      WRITE(6,6010)  IDAY,ILG1,ILAT                                                                                                 
                                                                                                                                    
C     * GAUSSG COMPUTES THE VALUE OF THE GAUSSIAN LATITUDES AND THEIR                                                               
C     * SINES AND COSINES. TRIGL MAKES THEM GLOBAL (S TO N).                                                                        
                                                                                                                                    
      CALL GAUSSG(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
      CALL  TRIGL(ILATH,SL,WL,CL,RAD,WOSSL)                                                                                         
                                                                                                                                    
      DO 100 I=1,ILAT                                                                                                               
          DLAT(I) = RAD(I)*180.E0/3.14159E0                                                                                         
  100 CONTINUE                                                                                                                      
                                                                                                                                    
C     * DEFINE LONGITUDE VECTOR FOR GAUSSIAN GRID.                                                                                  
                                                                                                                                    
      DGX=360.E0/(FLOAT(ILG))                                                                                                       
      DO 120 I=1,ILG1                                                                                                               
          DLON(I)=DGX*FLOAT(I-1)                                                                                                    
  120 CONTINUE                                                                                                                      
                                                                                                                                    
      NMO=12                                                                                                                        
C                                                                                                                                   
C     * DEFINE TARGET GRID TYPE FOR SUBROUTINE HRTOLR3 (GAUSSIAN GRID).                                                             
C                                                                                                                                   
      IGRID=0                                                                                                                       
C                                                                                                                                   
C     * READ-IN THE STANDARD LAND MASK ON THE MODEL GAUSSIAN GRID.                                                                  
C     * IN CASE IT CONTAINS INFORMATION ON LAKES (GC=+2) AND IS PACKED,                                                             
C     * PROCESS THE FIELD TO GET ONLY VALUES OF (-1/0) FOR (LAND/NOLAND)                                                            
C     * BEFORE PROCESSING FURTHER.                                                                                                  
C                                                                                                                                   
      NDAY=0                                                                                                                        
      CALL GETFLD2(88,MASK,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),0,                                                                    
     +                                             IBUF,MAXX,OK)                                                                    
      IF(.NOT.OK) CALL                             XIT('INTCHMO',-1)                                                                
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      DO 125 I=1,LGG                                                                                                                
          IVALM=NINT(MASK(I))                                                                                                       
          MASK(I)=REAL(IVALM)                                                                                                       
  125 CONTINUE                                                                                                                      
C                                                                                                                                   
      DO 126 I=1,LGG                                                                                                                
          MASK(I)=MIN(0.E0, MASK(I))                                                                                                
  126 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * SAVE HIGH-RES LAND MASK (-1./0.) INTO ARRAY "HRMASK", FOR USE                                                               
C     * IN PROCESSING SUBSEQUENT FIELDS.                                                                                            
C     * SET HIGH-RES LAND MASK TO GLACIER LAND SOUTH OF 78.5S TO                                                                    
C     * MAKE ROSS AND WEDELL SEA ICE SHELVES "GLACIERS".                                                                            
C                                                                                                                                   
      CALL GETFLD2(-77,HRMASK,NC4TO8("GRID"),NDAY,NC4TO8("  GC"),                                                                   
     +                                            1,IBUF,MAXX,OK)                                                                   
      IF(.NOT.OK) CALL                             XIT('INTCHMO',-2)                                                                
      WRITE(6,6025) IBUF                                                                                                            
                                                                                                                                    
      IGLAC=IBUF(5)*12                                                                                                              
      LLL=IBUF(5)*IBUF(6)                                                                                                           
C                                                                                                                                   
      DO 127 I=1,LLL                                                                                                                
          IF(I.LE.IGLAC) HRMASK(I)=-1.E0                                                                                            
  127 CONTINUE                                                                                                                      
C=====================================================================                                                              
C     * FIELDS FOR EACH OF TWELVE MID-MONTHS:                                                                                       
C                                                                                                                                   
C     * LOOP OVER MONTHS.                                                                                                           
C                                                                                                                                   
      DO 250 N=1,NMO                                                                                                                
        NDAY=MMD(N)                                                                                                                 
C---------------------------------------------------------------------                                                              
C       * GET BLACK CARBON EMISSIONS AND AREA-AVERAGE TO GAUSSIAN GRID.                                                             
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),MMD(N),NC4TO8(" EBC"),                                                                   
     +                                            1,IBUF,MAXX,OK)                                                                   
        IF(.NOT.OK) CALL                           XIT('INTCHMO',-3)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INTCHMO',-4)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8(" EBC"),                                                                        
     +                                   1,ILG1,ILAT,0,NPGG)                                                                        
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C------------------------------------------------------------------------                                                           
C       * GET ORGANIC CARBON EMISSIONS AND AREA-AVERAGE TO GAUSSIAN GRID.                                                           
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),MMD(N),NC4TO8(" EOC"),                                                                   
     +                                            1,IBUF,MAXX,OK)                                                                   
        IF(.NOT.OK) CALL                           XIT('INTCHMO',-5)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INTCHMO',-6)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8(" EOC"),1,                                                                      
     +                                       ILG1,ILAT,0,NPGG)                                                                      
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C------------------------------------------------------------------------                                                           
C       * GET ORGANIC CARBON FOREST EMISSIONS AND AREA-AVERAGE                                                                      
C       * TO GAUSSIAN GRID.                                                                                                         
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),MMD(N),NC4TO8("EOCF"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
        IF(.NOT.OK) CALL                           XIT('INTCHMO',-7)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INTCHMO',-8)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8("EOCF"),1,                                                                      
     +                                       ILG1,ILAT,0,NPGG)                                                                      
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C------------------------------------------------------------------------                                                           
C       * GET OCEANIC DMS CONCENTRATIONS AND AREA-AVERAGE TO GAUSSIAN GRID.                                                         
C       * ENSURE DMS=0. OVER LAND AT HIGH RESOLUTION,                                                                               
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),MMD(N),NC4TO8("DMSO"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
        IF(.NOT.OK) CALL                           XIT('INTCHMO',-9)                                                                
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        DO 200 I=1,LLL                                                                                                              
          GLL(I)=MAX(GLL(I),0.E0)                                                                                                   
          IF(HRMASK(I).EQ.-1.E0) GLL(I)=0.E0                                                                                        
  200   CONTINUE                                                                                                                    
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INTCHMO',-10)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8("DMSO"),1,                                                                      
     +                                       ILG1,ILAT,0,NPGG)                                                                      
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C------------------------------------------------------------------------                                                           
C       * GET LAND DMS FLUXES AND AREA-AVERAGE TO GAUSSIAN GRID.                                                                    
C       * ENSURE DMS=0. OVER NON-LAND AT HIGH RESOLUTION,                                                                           
                                                                                                                                    
        CALL GETFLD2(-1,GLL,NC4TO8("GRID"),MMD(N),NC4TO8("EDMS"),1,                                                                 
     +                                                IBUF,MAXX,OK)                                                                 
        IF(.NOT.OK) CALL                           XIT('INTCHMO',-11)                                                               
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        DO 210 I=1,LLL                                                                                                              
          GLL(I)=MAX(GLL(I),0.E0)                                                                                                   
          IF(HRMASK(I).EQ.0.E0) GLL(I)=0.E0                                                                                         
  210   CONTINUE                                                                                                                    
C                                                                                                                                   
        IOPTION=1                                                                                                                   
        ICHOICE=1                                                                                                                   
        CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                               
     1               GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                     
     2               OK,LONBAD,LATBAD,                                                                                              
     3               GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                 
     4               VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                     
C                                                                                                                                   
        IF(.NOT.OK)THEN                                                                                                             
          WRITE(6,6030) LONBAD,LATBAD                                                                                               
          CALL                                     XIT('INTCHMO',-12)                                                               
        ENDIF                                                                                                                       
C                                                                                                                                   
        CALL SETLAB(IBUF,NC4TO8("GRID"),NDAY,NC4TO8("EDMS"),1,                                                                      
     +                                       ILG1,ILAT,0,NPGG)                                                                      
        CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                
        WRITE(6,6026) IBUF                                                                                                          
C------------------------------------------------------------------------                                                           
  250 CONTINUE                                                                                                                      
C=====================================================================                                                              
C     * INVARIANT FIELDS:                                                                                                           
C---------------------------------------------------------------------                                                              
C     * SO2 EMISSIONS.                                                                                                              
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("ESO2"),                                                                          
     +                                     1,IBUF,MAXX,OK)                                                                          
      IF(.NOT.OK) CALL                             XIT('INTCHMO',-13)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INTCHMO',-14)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("ESO2"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * VOLCANIC EMISSIONS.                                                                                                         
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("EVOL"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INTCHMO',-15)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INTCHMO',-16)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("EVOL"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * VOLCANIC HEIGHT.                                                                                                            
C                                                                                                                                   
      CALL GETFLD2(-1,GLL,NC4TO8("GRID"),0,NC4TO8("HVOL"),1,                                                                        
     +                                         IBUF,MAXX,OK)                                                                        
      IF(.NOT.OK) CALL                             XIT('INTCHMO',-17)                                                               
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      IOPTION=1                                                                                                                     
      ICHOICE=1                                                                                                                     
      CALL HRTOLR3(GH,MASK,ILG1,ILAT,DLON,DLAT,ILG,                                                                                 
     1             GLL,HRMASK,NLG,NLAT,IOPTION,ICHOICE,IGRID,                                                                       
     2             OK,LONBAD,LATBAD,                                                                                                
     3             GCLRTMP,GCHRTMP,RLON,RLAT,LATL,LATH,LONL,LONH,                                                                   
     4             VAL,DIST,LOCAT,IVAL,LOCFST,LONB,LATB,NMAX)                                                                       
C                                                                                                                                   
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6030) LONBAD,LATBAD                                                                                                 
        CALL                                       XIT('INTCHMO',-18)                                                               
      ENDIF                                                                                                                         
C                                                                                                                                   
      CALL SETLAB(IBUF,NC4TO8("GRID"),0,NC4TO8("HVOL"),1,                                                                           
     +                                  ILG1,ILAT,0,NPGG)                                                                           
      CALL PUTFLD2(2,GH,IBUF,MAXX)                                                                                                  
      WRITE(6,6026) IBUF                                                                                                            
C---------------------------------------------------------------------                                                              
C     * E.O.F. ON FILE LL.                                                                                                          
                                                                                                                                    
      CALL                                         XIT('INTCHMO',0)                                                                 
                                                                                                                                    
C     * E.O.F. ON FILE ICTL.                                                                                                        
                                                                                                                                    
  910 CALL                                         XIT('INTCHMO',-19)                                                               
  911 CALL                                         XIT('INTCHMO',-20)                                                               
C---------------------------------------------------------------------                                                              
 6010 FORMAT('0IDAY,ILG1,ILAT =',3I6)                                                                                               
 6025 FORMAT(' ',A4,I10,1X,A4,5I6)                                                                                                  
 6026 FORMAT(' ',60X,A4,I10,1X,A4,5I6)                                                                                              
 6030 FORMAT('0EXITING PROGRAM; NO POINTS FOUND WITHIN GRID SQUARE',                                                                
     1       ' CENTRED AT (',I3,',',I3,')')                                                                                         
      END                                                                                                                           
