      PROGRAM GGMAP                                                                                                                 
C     PROGRAM GGMAP (GGIN,       INPUT,       OUTPUT,                   )       A2                                                  
C    1         TAPE1=GGIN, TAPE5=INPUT, TAPE6=OUTPUT)                                                                               
C     -----------------------------------------------                           A2                                                  
C                                                                               A2                                                  
C     JUL 03/03 - A.IRWIN,F.MAJAESS (REVISED FOR F90 AND LINUX PLATFORMS)       A2                                                  
C     JAN 29/92 - E. CHAN  (CONVERT HOLLERITH LITERALS TO ASCII)                                                                    
C     APR 07/86 - M.LAZARE.                                                                                                         
C                                                                               A2                                                  
CGGMAP   - MAPS A GRID FILE BASED ON FIELD'S DISCETE RANGES             1  0 C GA1                                                  
C                                                                               A3                                                  
CAUTHOR  - M.LAZARE                                                             A3                                                  
C                                                                               A3                                                  
CPURPOSE - MAPS A GRID FILE BASED ON DISCRETE RANGES COMPRISING THE GRID FIELD. A3                                                  
C          THE VALUES IN THE FILE ARE PLACED INTO (NPTS+1) "BINS", WHERE A "BIN"A3                                                  
C          IS A DISCRETE RANGE OF VALUES GREATER THAN A LOWER LIMIT AND LESS    A3                                                  
C          THAN OR EQUAL TO AN UPPER LIMIT (XCP FOR THE LOWEST AND HIGHEST BINS A3                                                  
C          WHICH ARE ONE-SIDED). EACH "BIN" IS REPRESENTED BY A CHARACTER SYMBOLA3                                                  
C          ON THE MAP, AS DEFINED BY THE DATA STATEMENT FOR MATRIX "CHAR".      A3                                                  
C                                                                               A3                                                  
C                                                                               A3                                                  
C          UNLESS OTHERWISE SPECIFIED (IFLG.NE.0), AUTOMATIC "BIN" LIMITS ARE   A3                                                  
C          CALCULATED BY DIVIDING THE RANGE OF VALUES INTO EQUALLY-SPACED       A3                                                  
C          INTERVALS. IN THIS CASE, NO "BIN LIMITS" CARD IS READ. IF A VALUE    A3                                                  
C          FOR NPTS IS READ AND IT IS NOT BETWEEN 1 AND 10 (I.E. POSSIBLY       A3                                                  
C          DEFAULTED), NPTS IS DEFAULTED TO 10.                                 A3                                                  
C                                                                               A3                                                  
C          OTHERWISE, THE BIN LIMITS ARE READ IN 7 TO A LINE. THE MAXIMUM       A3                                                  
C          NUMBER IS 10 (GIVING 11 BINS).                                       A3                                                  
C                                                                               A3                                                  
C          THIS PROGRAM WILL WORK FOR ANY TYPE OF GRID (I.E. GAUSSIAN OR        A3                                                  
C          LAT-LONG) OF SIZE UP TO AND INCLUDING THE T40 TRANSFORM GRID.        A3                                                  
C                                                                               A3                                                  
C          VALUES MUST BE REQUESTED ON INPUT CARDS IN THE SAME ORDER            A3                                                  
C          AS THEY APPEAR ON THE FILE SINCE THE FILE IS SCANNED ONLY ONCE.      A3                                                  
C                                                                               A3                                                  
CINPUT FILE...                                                                  A3                                                  
C                                                                               A3                                                  
C      GGIN = GRID FILE TO BE MAPPED.                                           A3                                                  
C                                                                                                                                   
CINPUT PARAMETERS...                                                                                                                
C                                                                               A5                                                  
C      NPTS  = NUMBER OF POINTS DEFINING THE DISCRETE INTERVAL RANGES           A5                                                  
C              (RESULTING IN NPTS+1 INTERVALS).                                 A5                                                  
C      NSTEP = TIME LABEL (IBUF(2)) OF GRID TO BE MAPPED.                       A5                                                  
C      NAME  = NAME (IBUF(3)) OF GRID TO BE MAPPED.                             A5                                                  
C      LEVEL = LEVEL (IBUF(4)) OF GRID TO BE MAPPED.                            A5                                                  
C      IFLG  = SWITCH TO DETERMINE IF INTERVALS ARE TO BE AUTOMATICALLY         A5                                                  
C              DETERMINED (DEFAULT; IFLG=0) BY SUBDIVIDING RANGE INTO NPTS+1    A5                                                  
C              EQUALLY-SPACED INTERVALS, OR IF INTERVAL POINTS ARE TO BE READ   A5                                                  
C              IN ON SUBSEQUENT CARD (IFLG.NE.0).                               A5                                                  
C      BIN   = INTERVAL LIMIT POINTS IN ASCENDING ORDER (TO BE READ IN ONLY IF  A5                                                  
C              IFLG.NE.0).                                                      A5                                                  
C      LABEL = CHARACTER STRING DEFINING THE MAPPED GRID.                       A5                                                  
C                                                                               A5                                                  
CEXAMPLE OF INPUT CARDS...                                                      A5                                                  
C                                                                               A5                                                  
C*GGMAP.     10        -1   -1   -1    1                                        A5                                                  
C*    0.     1.5     2.5     3.5     4.5     5.5     6.5     7.5     8.5     9.5A5                                                  
C*  FILE=MINFZGS.   CCRN PRIMARY VEGETATION FIELD.                              A5                                                  
C-------------------------------------------------------------------------------                                                    
C                                                                                                                                   
      IMPLICIT REAL (A-H,O-Z),                                                                                                      
     +INTEGER (I-N)                                                                                                                 
      COMMON/BLANCK/F(18528)                                                                                                        
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
      INTEGER LABEL(10),ILHEAD(3,193)                                                                                               
      REAL BIN(10)                                                                                                                  
      CHARACTER*1 ROW(193),CHAR(11)                                                                                                 
      COMMON/ICOM/IBUF(8),IDAT(18528)                                                                                               
      DATA MAXX/18528/                                                                                                              
      DATA CHAR/'0','1','2','3','4','5','6','7','8','9','+'/                                                                        
C---------------------------------------------------------------------                                                              
      NFF=3                                                                                                                         
      CALL JCLPNT(NFF,1,5,6)                                                                                                        
      REWIND 1                                                                                                                      
C                                                                                                                                   
C     * READ A CARD IDENTIFYING NPTS AND THE FIELD TO BE CONTOURED.                                                                 
C     * IF IFLG=0 NO BIN LIMITS CARDS ARE READ; OTHERWISE READ THE BIN LIMIT                                                        
C     * DEFINITIONS.                                                                                                                
C     * ALSO READ THE LABEL TO BE PRINTED UNDER THE MAP.                                                                            
C                                                                                                                                   
  110 READ(5,5010,END=900) NPTS,NSTEP,NAME,LEVEL,IFLG                           A4                                                  
      IF(IFLG.NE.0) READ(5,5011,END=901) (BIN(I),I=1,NPTS)                      A4                                                  
      READ(5,5012,END=902) LABEL                                                A4                                                  
      NBINS=NPTS+1                                                                                                                  
C                                                                                                                                   
C     * FIND THE REQUESTED FIELD.                                                                                                   
C                                                                                                                                   
      CALL GETFLD2(1,F,NC4TO8("GRID"),NSTEP,NAME,LEVEL,IBUF,MAXX,OK)                                                                
      IF(.NOT.OK)THEN                                                                                                               
        WRITE(6,6040) NSTEP,NAME,LEVEL                                                                                              
        WRITE(6,6070) IBUF                                                                                                          
        CALL                                       XIT('GGMAP',-1)                                                                  
      ENDIF                                                                                                                         
      LX=IBUF(5)                                                                                                                    
      LY=IBUF(6)                                                                                                                    
C                                                                                                                                   
      IF(IFLG.EQ.0) THEN                                                                                                            
C                                                                                                                                   
C     * DEFAULT VALUE OF NPTS IF OUTSIDE ALLOWABLE RANGE.                                                                           
C     * CALCULATE THE "BIN LIMITS" REPRESENTING (NPTS+1) EQUALLY-SPACED                                                             
C     * INTERVALS COMPRISING THE RANGE OF VALUES IN THE FIELD.                                                                      
C                                                                                                                                   
        IF(NPTS.LE.0.OR.NPTS.GT.10) NPTS=10                                                                                         
        NBINS=NPTS+1                                                                                                                
        NWDS=LX*LY                                                                                                                  
        IMAX=ISMAX(NWDS,F,1)                                                                                                        
        IMIN=ISMIN(NWDS,F,1)                                                                                                        
        FMAX=F(IMAX)                                                                                                                
        FMIN=F(IMIN)                                                                                                                
        DINT=(FMAX-FMIN)/(FLOAT(NBINS))                                                                                             
        DO 115 I=1,NBINS                                                                                                            
          BIN(I)=FMIN+DINT*FLOAT(I)                                                                                                 
  115   CONTINUE                                                                                                                    
        WRITE(6,6000) FMIN,FMAX                                                                                                     
      ENDIF                                                                                                                         
C                                                                                                                                   
C     * PRINT OUT THE BIN LIMIT DEFINITIONS.                                                                                        
C                                                                                                                                   
      WRITE(6,6005) NBINS                                                                                                           
      WRITE(6,6010) BIN(1),CHAR(1)                                                                                                  
      IF(NPTS.GE.2) THEN                                                                                                            
        DO 120 I=1,NPTS-1                                                                                                           
          WRITE(6,6020) BIN(I),BIN(I+1),CHAR(I+1)                                                                                   
  120   CONTINUE                                                                                                                    
      ENDIF                                                                                                                         
      WRITE(6,6030) BIN(NPTS),CHAR(NBINS)                                                                                           
      WRITE(6,6050)                                                                                                                 
C                                                                                                                                   
C     * DEFINE AND PRINT OUT LONGITUDE COLUMN NUMBERS FOR EASIER                                                                    
C     * MAP IDENTIFICATION.                                                                                                         
C                                                                                                                                   
      DO 200 I=1,LX                                                                                                                 
        ILHEAD(1,I)=I/100                                                                                                           
        ILHEAD(2,I)=I/10-10*ILHEAD(1,I)                                                                                             
        ILHEAD(3,I)=I-10*ILHEAD(2,I)-100*ILHEAD(1,I)                                                                                
  200 CONTINUE                                                                                                                      
      DO 205 J=1,3                                                                                                                  
        WRITE(6,6060) (ILHEAD(J,I),I=1,LX)                                                                                          
  205 CONTINUE                                                                                                                      
      WRITE(6,6070)                                                                                                                 
C                                                                                                                                   
C     * MAP THE FIELD AND GO BACK FOR THE NEXT ONE.                                                                                 
C                                                                                                                                   
      DO 210 JR=1,LY                                                                                                                
        N=(LY-JR)*LX                                                                                                                
        DO 220 I=1,LX                                                                                                               
          K=N+I                                                                                                                     
          ROW(I)=CHAR(1)                                                                                                            
          DO 230 NJ=2,NPTS                                                                                                          
            IF ( F(K).GT.BIN(NJ-1).AND.F(K).LE.BIN(NJ) ) THEN                                                                       
             ROW(I)=CHAR(NJ)                                                                                                        
            ENDIF                                                                                                                   
  230     CONTINUE                                                                                                                  
          IF ( F(K).GT.BIN(NPTS)) THEN                                                                                              
           ROW(I)=CHAR(NBINS)                                                                                                       
          ENDIF                                                                                                                     
  220   CONTINUE                                                                                                                    
        J=LY+1-JR                                                                                                                   
        WRITE(6,6080) J,(ROW(I),I=1,LX)                                                                                             
  210 CONTINUE                                                                                                                      
      WRITE(6,6090) IBUF                                                                                                            
      WRITE(6,6095) LABEL                                                                                                           
      GO TO 110                                                                                                                     
C                                                                                                                                   
C     * E.O.F. ON INPUT.                                                                                                            
C                                                                                                                                   
  900 CALL                                         XIT('GGMAP',0)                                                                   
  901 CALL                                         XIT('GGMAP',-2)                                                                  
  902 CALL                                         XIT('GGMAP',-3)                                                                  
C---------------------------------------------------------------------                                                              
 5010 FORMAT(10X,I5,I10,1X,A4,2I5)                                              A4                                                  
 5011 FORMAT(10E8.0)                                                            A4                                                  
 5012 FORMAT(10A8)                                                              A4                                                  
 6000 FORMAT('0DEFAULT BIN LIMITS CALCULATED BETWEEN MIN AND MAX ',                                                                 
     1       'VALUES OF FIELD: ',1PE10.3,'  ;  ',1PE10.3)                                                                           
 6005 FORMAT('0THE MAP SYMBOLS DEFINE THESE ',I2,' INTERVALS:')                                                                     
 6010 FORMAT('0VAL.LE.',1PE10.3,19X,                '; CHARACTER= ',A1)                                                             
 6020 FORMAT(' VAL.GT.',1PE10.3,' .AND.LE.',1PE10.3,'; CHARACTER= ',A1)                                                             
 6030 FORMAT(' VAL.GT.',1PE10.3,19X,                '; CHARACTER= ',A1)                                                             
 6040 FORMAT('0..EOF LOOKING FOR',I10,2X,A4,I6)                                                                                     
 6050 FORMAT('1')                                                                                                                   
 6060 FORMAT(' ',3X,129I1)                                                                                                          
 6070 FORMAT('0')                                                                                                                   
 6080 FORMAT(' ',I2,1X,129A1)                                                                                                       
 6090 FORMAT('0', 8X,'    STEP  NAME     LEVEL  LX  LY  KHEM NPACK',                                                                
     1 /' ',2X, A4,I10,2X,A4,I10,2I4,2I6)                                                                                           
 6095 FORMAT('+',48X,10A8)                                                                                                          
      END                                                                                                                           
