      PROGRAM LPCRREV                                                                                                               
C     PROGRAM LPCRREV (GLC,        FCAN,          LNZ0,          AVW,           I2                                                  
C    1                 AIW,        LAIMAX,        LAIMIN,        CMASS,         I2                                                  
C    2                             ROOT,          GC,            OUTPUT,)       I2                                                  
C    3          TAPE12=GLC, TAPE13=FCAN,   TAPE14=LNZ0,   TAPE15=AVW,                                                               
C    4          TAPE16=AIW, TAPE17=LAIMAX, TAPE18=LAIMIN, TAPE19=CMASS,                                                             
C    5                      TAPE20=ROOT,   TAPE21=GC,      TAPE6=OUTPUT)                                                            
C     -------------------------------------------------------------             I2                                                  
C                                                                               I2                                                  
C     APR 05/08 - M.LAZARE                                                      I2                                                  
C                                                                               I2                                                  
CLPCRREV - PRODUCES FIELDS FOR CLASS FROM GLC2000 INPUT DATA            1  9    I1                                                  
C                                                                               I3                                                  
CAUTHORS - M.LAZARE                                                             I3                                                  
C                                                                               I3                                                  
CPURPOSE - FROM GLC2000 INPUT, USING LOOK-UP TABLES, GENERATE VARIOUS           I3                                                  
C          FIELDS FOR CLASS.                                                    I3                                                  
C                                                                               I3                                                  
CINPUT FILE ...                                                                 I3                                                  
C                                                                               I3                                                  
C      GLC   = GLC DATA                                                         I3                                                  
C                                                                               I3                                                  
COUTPUT FILES...                                                                I3                                                  
C                                                                               I3                                                  
C      FCAN    = FRACTION OF CANOPY IN EACH OF 5 CLASS TYPES                    I3                                                  
C      LNZ0    = LN OF SURFACE ROUGHNESS                                        I3                                                  
C      AVW     = VISIBLE ALBEDO                                                 I3                                                  
C      AIW     = NEAR-IR ALBEDO                                                 I3                                                  
C      LAIMAX  = MAXIMUM LEAF AREA INDEX                                        I3                                                  
C      LAIMIN  = MINIMUM LEAF AREA INDEX                                        I3                                                  
C      CMASS   = CANOPY MASS                                                    I3                                                  
C      ROOT    = ROOTING DEPTH                                                  I3                                                  
C      GC      = MASK                                                           I3                                                  
C                                                                                                                                   
C------------------------------------------------------------------------                                                           
C                                                                                                                                   
      PARAMETER(LON=1440, LAT=720, IGRID=LON*LAT, IGRIDP=IGRID,                                                                     
     1          NCLASS=22, ICAN=4, ICANP1=ICAN+1)                                                                                   
C                                                                                                                                   
      REAL GC(IGRID), PCNT(IGRID)                                                                                                   
                                                                                                                                    
      REAL PCNTC(IGRID,NCLASS)                                                                                                      
                                                                                                                                    
      REAL PCNTTOT(IGRID),PCNTSUM(IGRID)                                                                                            
C                                                                                                                                   
      REAL FCAN(IGRID,ICANP1),LNZ0(IGRID,ICANP1)                                                                                    
      REAL AVW (IGRID,ICANP1),AIW (IGRID,ICANP1)                                                                                    
      REAL LAIMAX(IGRID,ICAN),LAIMIN(IGRID,ICAN)                                                                                    
      REAL CMASS (IGRID,ICAN),ZROOT (IGRID,ICAN)                                                                                    
C                                                                                                                                   
      COMMON/ICOM/IBUF(8),IDAT(IGRIDP)                                                                                              
C                                                                                                                                   
      LOGICAL OK                                                                                                                    
C                                                                                                                                   
C     * LOOK-UP TABLE FOR DECIDING UPON VEGETATION TYPES.                                                                           
C     * VEGETATION CLASSES ARE DEFINED AS FOLLOWS:                                                                                  
C     *      CLASS 1: TALL CONIFEROUS.                                                                                              
C     *      CLASS 2: TALL BROADLEAF.                                                                                               
C     *      CLASS 3: ARABLE AND CROPS.                                                                                             
C     *      CLASS 4: GRASS, SWAMP AND TUNDRA (I.E. OTHER).                                                                         
C     *      BARE SOIL,ICE, WATER AND URBAN DO NOT FALL INTO ANY CLASS.                                                             
C     * VALUE OF UNITY IMPLIES VEGETATION CLASS FALLS INTO THAT                                                                     
C     * PARTICULAR CLASS I.E. COLUMN 1 FOR CLASS 1, ETC.                                                                            
C                                                                                                                                   
      REAL HYDCNTL(4,NCLASS)                                                                                                        
      DATA HYDCNTL /                                                                                                                
     1      0.,  1.,  0.,  0.,                   0.,  1.,  0.,  0.,                                                                 
     2      0.,  1.,  0.,  0.,                   1.,  0.,  0.,  0.,                                                                 
     3      1.,  0.,  0.,  0.,                   1.,  0.,  0.,  0.,                                                                 
     4      0.,  1.,  0.,  0.,                   0.,  1.,  0.,  0.,                                                                 
     5      0.,  1.,  0.,  0.,                   0.,  1.,  0.,  0.,                                                                 
     6      0.,  0.,  0.,  1.,                   0.,  1.,  0.,  0.,                                                                 
     7      0.,  0.,  0.,  1.,                   0.,  0.,  0.,  1.,                                                                 
     8      0.,  0.,  0.,  1.,                   0.,  0.,  1.,  0.,                                                                 
     9      0.,  0.,  0.,  1.,                   0.,  0.,  0.,  1.,                                                                 
     A      0.,  0.,  0.,  0.,                   0.,  0.,  0.,  0.,                                                                 
     B      0.,  0.,  0.,  0.,                   0.,  0.,  0.,  0./                                                                 
C                                                                                                                                   
C     * LOOK-UP TABLE FOR BACKGROUND VEGETATION ALBEDOES AND Z0.                                                                    
C     * FIRST COLUMN IS VISIBLE ALBEDO, SECOND COLUMN IS Z0 AND                                                                     
C     * THIRD COLUMN IS NEAR-IR ALBEDO.                                                                                             
C                                                                                                                                   
      REAL HYDFACT(3,NCLASS)                                                                                                        
      DATA HYDFACT /                                                                                                                
     1     03.0,    3.00,   23.0,       05.0,    2.00,   29.0,                                                                      
     2     05.0,    2.00,   29.0,       03.0,    1.50,   19.0,                                                                      
     3     03.0,    1.00,   19.0,       04.0,    2.00,   24.0,                                                                      
     4     03.0,    3.00,   23.0,       03.0,    3.00,   23.0,                                                                      
     5     05.0,    0.15,   29.0,       03.0,    0.75,   19.0,                                                                      
     6     03.0,    0.05,   19.0,       05.0,    0.15,   29.0,                                                                      
     7     06.0,    0.02,   34.0,       05.0,    0.01,   29.0,                                                                      
     8     06.0,    0.02,   34.0,       06.0,    0.08,   34.0,                                                                      
     9     05.0,    0.08,   32.0,       05.0,    0.08,   32.0,                                                                      
     A       0.,      0.,     0.,         0.,      0.,     0.,                                                                      
     B       0.,      0.,     0.,       09.0,    1.35,   15.0/                                                                      
C                                                                                                                                   
C     * LOOK-UP TABLE FOR MAXIMUM LEAF AREA INDEX (COLUMN 1),                                                                       
C     * MINIMUM LEAF AREA INDEX (COLUMN 2), CANOPY MASS (COLUMN 3)                                                                  
C     * IN UNITS OF KG/M2 AND ROOTING DEPTH (COLUMN 4) IN UNITS OF                                                                  
C     * METRES.                                                                                                                     
C                                                                                                                                   
      REAL HYDCAN(4,NCLASS)                                                                                                         
      DATA HYDCAN  /                                                                                                                
     1      10.0,  10.0,  40.0,   5.0,         6.0,   0.5,  20.0,   2.0,                                                            
     2       3.0,   0.5,  20.0,   2.0,         2.0,   1.6,  12.0,   1.0,                                                            
     3       2.0,   0.5,  15.0,   1.0,         2.5,   1.0,  16.0,   1.5,                                                            
     4      10.0,  10.0,  40.0,   5.0,        10.0,  10.0,  40.0,   5.0,                                                            
     5       4.0,   0.5,   8.0,   1.0,         2.0,   0.5,   4.0,   0.5,                                                            
     6       2.0,   2.0,   2.0,   0.2,         4.0,   0.5,   8.0,   1.0,                                                            
     7       3.0,   3.0,   1.5,   1.2,         1.5,   1.5,   0.2,   0.1,                                                            
     8       3.0,   3.0,   1.5,   1.2,         4.0,   0.0,   2.0,   1.2,                                                            
     9       4.0,   4.0,   2.5,   1.2,         4.0,   4.0,   2.5,   1.2,                                                            
     A        0.,    0.,    0.,    0.,          0.,    0.,    0.,    0.,                                                            
     B        0.,    0.,    0.,    0.,          0.,    0.,    0.,    0./                                                            
C                                                                                                                                   
      DATA MAXX/IGRIDP/                                                                                                             
C---------------------------------------------------------------------                                                              
      NLU=11                                                                                                                        
      CALL JCLPNT(NLU,12,13,14,15,16,17,18,19,20,21,6)                                                                              
                                                                                                                                    
      DO I=12,21                                                                                                                    
       REWIND I                                                                                                                     
      ENDDO                                                                                                                         
C                                                                                                                                   
C     * READ THE FRACTION OF WATER AND CONVERT TO LAND-WATER MASK.                                                                  
C                                                                                                                                   
      CALL GETFLD2(12,PCNT,NC4TO8("GRID"),0,NC4TO8("LC20"),1,                                                                       
     1             IBUF,MAXX,OK)                                                                                                    
      IF(.NOT.OK) CALL                             XIT('LPCRREV',-1)                                                                
      WRITE(6,6025) IBUF                                                                                                            
      NWDS=IBUF(5)*IBUF(6)                                                                                                          
C                                                                                                                                   
      DO 100 I=1,NWDS                                                                                                               
        IF(PCNT(I).LE.0.5) THEN                                                                                                     
           GC(I)=-1.                                                                                                                
        ELSE                                                                                                                        
           GC(I)=0.                                                                                                                 
        ENDIF                                                                                                                       
  100 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * INITIALIZE OUTPUT ARRAYS.                                                                                                   
C                                                                                                                                   
      DO 125 IC=1,ICAN                                                                                                              
      DO 125 I=1,NWDS                                                                                                               
        FCAN  (I,IC)=0.                                                                                                             
        LNZ0  (I,IC)=0.                                                                                                             
        AVW   (I,IC)=0.                                                                                                             
        AIW   (I,IC)=0.                                                                                                             
        LAIMAX(I,IC)=0.                                                                                                             
        LAIMIN(I,IC)=0.                                                                                                             
        CMASS (I,IC)=0.                                                                                                             
        ZROOT (I,IC)=0.                                                                                                             
  125 CONTINUE                                                                                                                      
C                                                                                                                                   
      IC=ICANP1                                                                                                                     
      DO 130 I=1,NWDS                                                                                                               
        FCAN  (I,IC)=0.                                                                                                             
        AVW   (I,IC)=0.                                                                                                             
        LNZ0  (I,IC)=0.                                                                                                             
        AIW   (I,IC)=0.                                                                                                             
  130 CONTINUE                                                                                                                      
C                                                                                                                                   
      DO 150 I=1,NWDS                                                                                                               
        PCNTTOT(I)  =0.                                                                                                             
        PCNTSUM(I)  =0.                                                                                                             
  150 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * STORE CANOPY CLASSES PERCENTAGE AND ENSURE CONSISTENCY.                                                                     
C     * FOR PROCESSING, PVEG=2,3 NOT DEFINED (NO INLAND WATER).                                                                     
C                                                                                                                                   
C     * IF SUBSEQUENT TOTAL PERCENTAGE AT ANY GRID POINT N.E. 1,                                                                    
C     * ADJUST EACH CLASS PERCENTAGE BY MAINTAINING SAME RELATIVE                                                                   
C     * PERCENTAGE FOR EACH CLASS.                                                                                                  
C     * ENSURE LAND POINTS HAVE AT LEAST SOME VEGETATION FROM CLASSES                                                               
C     * OTHER THAN 20, ELSE ABORT.                                                                                                  
C                                                                                                                                   
      REWIND 12                                                                                                                     
      DO 170 N=1,NCLASS                                                                                                             
        CALL GETFLD2(12,PCNT, -1 ,-1,-1,-1,IBUF,MAXX,OK)                                                                            
        IF(.NOT.OK) CALL                           XIT('LPCRREV',-1-N)                                                              
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        DO 160 I=1,NWDS                                                                                                             
          IF(GC(I).EQ.-1.)                                          THEN                                                            
            PCNTC(I,N)=PCNT(I)                                                                                                      
          ELSE                                                                                                                      
            PCNTC(I,N)=0.                                                                                                           
          ENDIF                                                                                                                     
          PCNTSUM(I)=PCNTSUM(I)+PCNTC(I,N)                                                                                          
          IF(N.NE.20)     THEN                                                                                                      
            PCNTTOT(I)=PCNTTOT(I)+PCNTC(I,N)                                                                                        
          ENDIF                                                                                                                     
  160   CONTINUE                                                                                                                    
  170 CONTINUE                                                                                                                      
C                                                                                                                                   
      DO 175 I=1,NWDS                                                                                                               
       IF(GC(I).EQ.-1.)                                          THEN                                                               
        IF(PCNTTOT(I).LT.0.001)                THEN                                                                                 
          JVAL=(I-1)/360 + 1                                                                                                        
          IVAL=I - (JVAL-1)*360                                                                                                     
          FI=0.5+FLOAT(IVAL-1)                                                                                                      
          FJ=-89.5+FLOAT(JVAL-1)                                                                                                    
          WRITE(6,6174) I,GC(I),PCNTTOT(I),FI,FJ,(PCNTC(I,N),N=1,NCLASS)                                                            
          CALL                                     XIT('LPCRREV',-3)                                                                
        ENDIF                                                                                                                       
C                                                                                                                                   
        IF(PCNTSUM(I).GT.1.000001 .OR. PCNTSUM(I).LE.0.999999) THEN                                                                 
          WRITE(6,6175) I,GC(I),PCNTSUM(I),(PCNTC(I,N),N=1,NCLASS)                                                                  
          CALL                                     XIT('LPCRREV',-4)                                                                
        ENDIF                                                                                                                       
       ENDIF                                                                                                                        
  175 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * LOOP OVER APPLICABLE CANOPY CLASSES AND ACCUMULATE OUTPUT FIELDS.                                                           
C                                                                                                                                   
      DO 600 I=1,NWDS                                                                                                               
       IF(GC(I).NE.0.)                                           THEN                                                               
C                                                                                                                                   
C       * STORE URBAN AREAL PERCENTAGE,VISIBLE AND NEAR-IR                                                                          
C       * ALBEDOES AND LN(ROUGHNESS) LOOK-UP TABLE VALUES IN                                                                        
C       * "ICANP1" COLUMN OF CORRESPONDING ARRAYS.                                                                                  
C                                                                                                                                   
        IC=ICANP1                                                                                                                   
        FCAN  (I,IC)=PCNTC(I,22)                                                                                                    
        AVW   (I,IC)=PCNTC(I,22)*HYDFACT(1,22)                                                                                      
        LNZ0  (I,IC)=PCNTC(I,22)*LOG(HYDFACT(2,22))                                                                                 
        AIW   (I,IC)=PCNTC(I,22)*HYDFACT(3,22)                                                                                      
C                                                                                                                                   
        DO 500 IC=1,ICAN                                                                                                            
C                                                                                                                                   
C        * LOOP OVER REMAINING CANOPY TYPES AND DATA POINTS.                                                                        
C                                                                                                                                   
         DO 200 N=1,18                                                                                                              
           PCNT(I)     =PCNTC(I,N)                                                                                                  
           RLOGZ0      =LOG(HYDFACT(2,N))                                                                                           
           FCAN  (I,IC)=FCAN  (I,IC)+PCNT(I)*HYDCNTL(IC,N)                                                                          
           AVW   (I,IC)=AVW   (I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDFACT(1,N)                                                             
           LNZ0  (I,IC)=LNZ0  (I,IC)+PCNT(I)*HYDCNTL(IC,N)*RLOGZ0                                                                   
           AIW   (I,IC)=AIW   (I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDFACT(3,N)                                                             
           LAIMAX(I,IC)=LAIMAX(I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDCAN (1,N)                                                             
           LAIMIN(I,IC)=LAIMIN(I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDCAN (2,N)                                                             
           CMASS (I,IC)=CMASS (I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDCAN (3,N)                                                             
           ZROOT (I,IC)=ZROOT (I,IC)+PCNT(I)*HYDCNTL(IC,N)*HYDCAN (4,N)                                                             
           FCAN  (I,IC)=MIN(FCAN(I,IC),1.)                                                                                          
  200    CONTINUE                                                                                                                   
  500   CONTINUE                                                                                                                    
       ELSE                                                                                                                         
C                                                                                                                                   
C       * DEFAULT VALUE OF LNZ0 OVER OPEN WATER.                                                                                    
C                                                                                                                                   
        DO 550 IC=1,ICANP1                                                                                                          
            LNZ0  (I,IC)=-8.11                                                                                                      
  550   CONTINUE                                                                                                                    
       ENDIF                                                                                                                        
  600 CONTINUE                                                                                                                      
C                                                                                                                                   
C     * SAVE THE RESULTS.                                                                                                           
C                                                                                                                                   
      IBUF(2)=0                                                                                                                     
C                                                                                                                                   
      DO 800 IC=1,ICANP1                                                                                                            
        IBUF(4)=IC                                                                                                                  
C                                                                                                                                   
        IBUF(3)=NC4TO8("FCAN")                                                                                                      
        CALL PUTFLD2(13,FCAN  (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8("LNZ0")                                                                                                      
        CALL PUTFLD2(14,LNZ0  (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8(" AVW")                                                                                                      
        CALL PUTFLD2(15,AVW   (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8(" AIW")                                                                                                      
        CALL PUTFLD2(16,AIW   (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
C       * NO URBAN CLASS FIELDS FOR ENSUING FIELDS.                                                                                 
C                                                                                                                                   
        IF(IC.EQ.ICANP1) GO TO 800                                                                                                  
C                                                                                                                                   
        IBUF(3)=NC4TO8("LAMX")                                                                                                      
        CALL PUTFLD2(17,LAIMAX(1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8("LAMN")                                                                                                      
        CALL PUTFLD2(18,LAIMIN(1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8("CMAS")                                                                                                      
        CALL PUTFLD2(19,CMASS (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
C                                                                                                                                   
        IBUF(3)=NC4TO8("ROOT")                                                                                                      
        CALL PUTFLD2(20,ZROOT (1,IC),IBUF,MAXX)                                                                                     
        WRITE(6,6025) IBUF                                                                                                          
  800 CONTINUE                                                                                                                      
C                                                                                                                                   
      IBUF(3)=NC4TO8("  GC")                                                                                                        
      IBUF(4)=1                                                                                                                     
      CALL PUTFLD2(21,GC,IBUF,MAXX)                                                                                                 
      WRITE(6,6025) IBUF                                                                                                            
C                                                                                                                                   
      CALL                                         XIT('LPCRREV',0)                                                                 
C---------------------------------------------------------------------                                                              
 6025 FORMAT(' ',A4,I10,2X,A4,5I10)                                                                                                 
 6174 FORMAT('0I,GC,PCNTTOT,FI,FJ:',I5,4F12.5,/,' PCNT=',/,(6F12.5))                                                                
 6175 FORMAT('0INITIAL: I,GC,TOTPCNT ',I5,2F12.5,/,' PCNT=',/,(6F12.5))                                                             
      END                                                                                                                           
