      SUBROUTINE    LUC(     ICC,      ILG,      IL1,       IL2,   
     1                        IC, NOL2PFTS,    L2MAX,   
     2                  GRCLAREA, PFCANCMX, NFCANCMX,      IDAY,
     3                   TODFRAC,  YESFRAC, INTERPOL,  
C    ----------------------- INPUTS ABOVE THIS LINE -------------
     4                   GLEAFMAS, BLEAFMAS, STEMMASS, ROOTMASS,      
     5                   LITRMASS, SOILCMAS, VGBIOMAS, GAVGLTMS,
     6                   GAVGSCMS,  FCANCMX,   FCANMX,
C    ----------- UPDATES ABOVE THIS LINE, OUTPUTS BELOW ---------
     7                   LUCEMCOM, LUCLTRIN, LUCSOCIN)
C
C     ----------------------------------------------------------------
C
C           CANADIAN TERRESTRIAL ECOSYSTEM MODEL (CTEM) V1.1
C                       LAND USE CHANGE SUBROUTINE 
C
C     SK: MAY  2018 - REVISE TOLERANCES FOR 32-BIT VERSION.
C     03  FEB. 2017 - ABORT CONDITION IN LOOP 100 CHANGED FROM ZERO TO
C                     1.E-5 LIKE OTHER CASES.
C     02  JAN. 2004 - THIS SUBROUTINE DEALS WITH THE CHANGES IN THE LAND
C     V. ARORA        COVER AND ESTIMATES LAND USE CHANGE (LUC)
C                     RELATED CARBON EMISSIONS. BASED ON WHETHER THERE
C                     IS CONVERSION OF FORESTS/GRASSLAND TO CROP AREA,
C                     OR CROPLANDS ABANDONMENT, THIS SUBROUTINE
C                     REALLOCATES CARBON FROM LIVE VEGETATION TO LITTER
C                     AND SOIL C COMPONENTS. THE DECOMPOSITION FROM THE
C                     LITTER AND SOIL C POOLS THUS IMPLICITLY MODELS LUC
C                     RELATED CARBON EMISSIONS. SET OF RULES ARE
C                     FOLLOWED TO DETERMINE THE FATE OF CARBON THAT
C                     RESULTS FROM DEFORESTATION OR REPLACEMENT OF
C                     GRASSLANDS BY CROPS. 
C
C     ----------------------------------------------------------------
C     INPUTS
C
C     ICC       - NO OF PFTs FOR USE BY CTEM, CURRENTLY 9
C     IC        - NO OF PFTs FOR USE BY CLASS, CURRENTLY 4
C     ILG       - NO. OF GRID CELLS IN LATITUDE CIRCLE
C     IL1, IL2  - IL1=1, IL2=ILG
C     NOL2PFTS  - NUMBER OF LEVEL 2 PFTs
C     L2MAX     - MAXIMUM NUMBER OF LEVEL 2 PFTs
C     FCANCMX   - MAX. FRACTIONAL COVERAGES OF CTEM's 9 PFTs. 
C     GRCLAREA  - GCM GRID CELL AREA, KM2
C     PFCANCMX  - PREVIOUS MAX. FRACTIONAL COVERAGES OF CTEM's 9 PFTs. 
C     NFCANCMX  - NEXT MAX. FRACTIONAL COVERAGES OF CTEM's 9 PFTs. 
C     IDAY      - DAY OF YEAR
C     TODFRAC   - TODAY'S FRACTIONAL COVERAGE OF ALL PFTs 
C     YESFRAC   - YESTERDAY'S FRACTIONAL COVERAGE OF ALL PFTs 
C     INTERPOL  - IF TODFRAC & YESFRAC ARE PROVIDED THEN INTERPOL MUST
C                 BE SET TO FALSE SO THAT THIS SUBROUTINE DOESN'T DO ITS
C                 OWN INTERPOLATION USING PFCANCMX AND NFCANCMX WHICH
C                 ARE YEAR END VALUES     
C     UPDATES
C
C     GLEAFMAS  - GREEN OR LIVE LEAF MASS IN KG C/M2, FOR THE 9 PFTs
C     BLEAFMAS  - BROWN OR DEAD LEAF MASS IN KG C/M2, FOR THE 9 PFTs
C     STEMMASS  - STEM BIOMASS IN KG C/M2, FOR THE 9 PFTs
C     ROOTMASS  - ROOT BIOMASS IN KG C/M2, FOR THE 9 PFTs
C     LITRMASS  - LITTER MASS IN KG C/M2, FOR THE 9 PFTs + BARE
C     SOILCMAS  - SOIL C MASS IN KG C/M2, FOR THE 9 PFTs + BARE
C     VGBIOMAS  - GRID AVERAGED VEGETATION BIOMASS, KG C/M2
C     GAVGLTMS  - GRID AVERAGED LITTER MASS, KG C/M2
C     GAVGSCMS  - GRID AVERAGED SOIL C MASS, KG C/M2
C
C     OUTPUTS
C
C     FCANMX   - FRACTIONAL COVERAGES OF CLASS 4 PFTs (THESE ARE FOUND BASED 
C                ON NEW FCANCMXs)
C     LUCEMCOM - LUC RELATED CARBON EMISSION LOSSES FROM COMBUSTION
C                u-MOL CO2/M2.SEC
C     LUCLTRIN - LUC RELATED INPUT TO LITTER POOL, u-MOL CO2/M2.SEC
C     LUCSOCIN - LUC RELATED INPUT TO SOIL CARBON POOL, u-MOL CO2/M2.SEC
C
C     ----------------------------------------------------------------    
C
      IMPLICIT NONE

      INTEGER ICC,  ILG, IL1, IL2, IC, I, J, K, M, N, KK, K1, K2, IDAY
      INTEGER    NOL2PFTS(IC),             L2MAX,       LUCTKPLC(ILG),
     1      FRACIORD(ILG,ICC), TREATIND(ILG,ICC),       BAREIORD(ILG)

      LOGICAL  INTERPOL 
C      
      REAL  GLEAFMAS(ILG,ICC), BLEAFMAS(ILG,ICC),   STEMMASS(ILG,ICC),
     1      ROOTMASS(ILG,ICC),  FCANCMX(ILG,ICC),   PFCANCMX(ILG,ICC),
     2          VGBIOMAS(ILG),              ZERO, SOILCMAS(ILG,ICC+1),
     3    LITRMASS(ILG,ICC+1),     GAVGLTMS(ILG),       GAVGSCMS(ILG),
     4      NFCANCMX(ILG,ICC),  FCANCMY(ILG,ICC),    TODFRAC(ILG,ICC),
     5       YESFRAC(ILG,ICC)
C
      REAL     FCANMX(ILG,IC),  DELFRAC(ILG,ICC),          COMBUST(3),
     1               PAPER(3),      FURNITURE(3),   ABVGMASS(ILG,ICC),
     2            BMASTHRS(2),     GRCLAREA(ILG),   COMBUSTC(ILG,ICC), 
     3        PAPERC(ILG,ICC), FURNTURC(ILG,ICC),   INCRLITR(ILG,ICC),
     4      INCRSOLC(ILG,ICC),          TOLRNCE1,            TOLRNCE2,
     5          CHOPEDBM(ILG),           KM2TOM2,                DIFF,
     6                   SUM1,              SUM2,                RDIF
C
      REAL          REDUBMAS1,              TERM,       BAREFRAC(ILG),  
     1          GRSUMCOM(ILG),     GRSUMPAP(ILG),       GRSUMFUR(ILG),
     2          GRSUMLIT(ILG),     GRSUMSOC(ILG),       PBAREFRA(ILG),
     3          GRDENCOM(ILG),     GRDENPAP(ILG),       GRDENFUR(ILG),
     4          GRDENLIT(ILG),     GRDENSOC(ILG),       TOTCMASS(ILG),
     5          TOTLMASS(ILG),     TOTDMAS1(ILG),       NTOTCMAS(ILG),
     6          NTOTLMAS(ILG),     NTOTDMS1(ILG),       LUCEMCOM(ILG),
     7          PVGBIOMS(ILG),     PGAVLTMS(ILG),       PGAVSCMS(ILG),
     8              REDUBMAS2,     LUCLTRIN(ILG),       LUCSOCIN(ILG),
     9          TOTDMAS2(ILG),     NTOTDMS2(ILG)

C
C     HOW MUCH DEFORESTED/CHOPPED OFF BIOMASS IS COMBUSTED
      DATA COMBUST/0.15, 0.30, 0.45/
C
C     HOW MUCH DEFORESTED/CHOPPED OFF BIOMASS GOES INTO SHORT TERM
C     STORAGE SUCH AS PAPER
      DATA PAPER/0.70, 0.70, 0.55/
C
C     HOW MUCH DEFORESTED/CHOPPED OFF BIOMASS GOES INTO LONG TERM
C     STORAGE SUCH AS FURNITURE
      DATA FURNITURE/0.15, 0.0, 0.0/
C
C     BIOMASS THRESHOLDS FOR DETERMINING IF DEFORESTED AREA IS A FOREST,
C     A SHRUBLAND, OR A BUSH KG C/M2
      DATA BMASTHRS/4.0, 1.0/
C
      DATA ZERO/1.0E-20/
C
      DATA TOLRNCE1/1.0E-06/    ! 32-BIT FRACTION SUM TOLERANCE
      DATA TOLRNCE2/1.0E-03/    ! 32-BIT RELATIVE TOLERANCE OF C BALANCE
C
      DATA KM2TOM2/1.0E+06/ ! CHANGES FROM KM2 TO M2
C     ---------------------------------------------------------------
C
      IF(ICC.NE.9)                               CALL XIT('LUC',-1)  
      IF(IC.NE.4)                                CALL XIT('LUC',-2)  
C
C     ------------------------------------------------------------------
C
C     CHECK IF FRACTIONS OF DEFORESTED BIOMASS THAT IS COMBUSTED, AND
C     TURNED INTO PAPER AND FURNITIRE ADD TO 1.0
C
      DO 100 K = 1, 3
        SUM1=COMBUST(K)+PAPER(K)+FURNITURE(K)
        IF( ABS(SUM1-1.0).GT.TOLRNCE1 )THEN
           WRITE(6,*)'COMBUST + PAPER + FURNITURE DO NOT ADD TO 1.0'
           WRITE(6,*)'COMBUST(',K,')=',COMBUST(K)
           WRITE(6,*)'PAPER(',K,')=',PAPER(K)
           WRITE(6,*)'FURNITURE(',K,')=',FURNITURE(K)
           WRITE(6,*)'SUM(',K,')=',SUM1
           WRITE(6,*)'DIFF(',K,')=',ABS(SUM1-1.0)
           CALL XIT('LUC',-3)
        ENDIF
100   CONTINUE
C
C     FIND/USE PROVIDED CURRENT AND PREVIOUS DAY'S FRACTIONAL COVERAGE 
C
      IF(INTERPOL) THEN ! PERFORM INTERPOLATION 
       DO 110 J = 1, ICC
        DO 111 I = IL1, IL2
          DELFRAC(I,J)=NFCANCMX(I,J)-PFCANCMX(I,J) !CHANGE IN FRACTION
          DELFRAC(I,J)=DELFRAC(I,J)/365.0
          FCANCMX(I,J)=PFCANCMX(I,J)+(REAL(IDAY)*DELFRAC(I,J)) !  CURRENT DAY
          FCANCMY(I,J)=PFCANCMX(I,J)+(REAL(IDAY-1)*DELFRAC(I,J)) ! PREVIOUS DAY
C
          IF(FCANCMX(I,J).LT.0.0)THEN
            IF(FCANCMX(I,J).GT.-TOLRNCE1)THEN
C             ASSUME THIS IS ROUND-OFF
              FCANCMX(I,J)=0.0
            ELSE
              WRITE(6,*)'FCANCMX(',I,',',J,')=',FCANCMX(I,J)
              WRITE(6,*)'FRACTIONAL COVERAGE CANNOT BE NEGATIVE'
              CALL XIT('LUC',-4)
            ENDIF
          ENDIF
C
          IF(FCANCMY(I,J).LT.0.0)THEN
            IF(FCANCMY(I,J).GT.-TOLRNCE1)THEN
C             ASSUME THIS IS ROUND-OFF
              FCANCMY(I,J)=0.0
            ELSE
              WRITE(6,*)'FCANCMY(',I,',',J,')=',FCANCMY(I,J)
              WRITE(6,*)'FRACTIONAL COVERAGE CANNOT BE NEGATIVE'
              CALL XIT('LUC',-5)
            ENDIF
          ENDIF

111     CONTINUE
110    CONTINUE
      ELSE IF(.NOT. INTERPOL) THEN ! USE PROVIDED VALUES BUT STILL CHECK
C                                   THEY ARE NOT -VE
       DO 115 J = 1, ICC
        DO 116 I = IL1, IL2
          FCANCMX(I,J) = TODFRAC(I,J)   
          FCANCMY(I,J) = YESFRAC(I,J)   

          IF( FCANCMX(I,J).LT.0.0)THEN
            IF(FCANCMX(I,J).GT.-TOLRNCE2)THEN
C             ASSUME THIS IS ROUND-OFF
              FCANCMX(I,J)=0.0
            ELSE
              WRITE(6,*)'FCANCMX(',I,',',J,')=',FCANCMX(I,J)
              WRITE(6,*)'FRACTIONAL COVERAGE CANNOT BE NEGATIVE'
              CALL XIT('LUC',-6)
            ENDIF
          ENDIF
C
          IF(FCANCMY(I,J).LT.0.0)THEN
            IF(FCANCMY(I,J).GT.-TOLRNCE2)THEN
C             ASSUME THIS IS ROUND-OFF
              FCANCMY(I,J)=0.0
            ELSE
              WRITE(6,*)'FCANCMY(',I,',',J,')=',FCANCMY(I,J)
              WRITE(6,*)'FRACTIONAL COVERAGE CANNOT BE NEGATIVE'
              CALL XIT('LUC',-7)
            ENDIF
          ENDIF

116     CONTINUE
115    CONTINUE
      ELSE 
       WRITE(6,*)'INTERPOL MUST BE 0 OR 1'
       WRITE(6,*)'INTERPOL  = ',INTERPOL
       CALL XIT('LUC',-8)
      ENDIF
C
C     CHECK IF THIS YEAR'S FRACTIONAL COVERAGES HAVE CHANGED OR NOT
C     FOR ANY PFT
C
      DO 150 I = IL1, IL2
        LUCTKPLC(I)=0  ! DID LAND USE CHANGE TAKE PLACE FOR ANY PFT
150   CONTINUE         ! IN THIS GRID CELL
C
      DO 200 J = 1, ICC
        DO 250 I = IL1, IL2
          IF ( (ABS(FCANCMX(I,J)-FCANCMY(I,J))).GT.ZERO ) THEN
            LUCTKPLC(I)=1 ! YES, LUC DID TAKE PLACE IN THIS GRID CELL
          ENDIF
250     CONTINUE
200   CONTINUE
C
C     -------------------------------------------------------------------
C 
C     INITIALIZATION
C
      DO 260 J = 1, IC
        DO 261 I = IL1, IL2
          IF(LUCTKPLC(I).EQ.1)THEN
            FCANMX(I,J)=0.0 ! FRACTIONAL COVERAGE OF CLASS' PFTs
          ENDIF
261     CONTINUE      
260   CONTINUE      

C
      DO 270 J = 1, ICC
        DO 271 I = IL1, IL2
          FRACIORD(I,J)=0   !FRACTIONAL COVERAGE INCREASE OR DECREASE
C                           !INCREASE +1, DECREASE -1
          ABVGMASS(I,J)=0.0 !ABOVE-GROUND BIOMASS
          TREATIND(I,J)=0   !TREATMENT INDEX FOR COMBUST, PAPER, & FURNITURE
          COMBUSTC(I,J)=0.0 !TOTAL CARBON FROM DEFORESTATION- COMBUSTION
          PAPERC(I,J)=0.0   !TOTAL CARBON FROM DEFORESTATION- PAPER
          FURNTURC(I,J)=0.0 !TOTAL CARBON FROM DEFORESTATION- FURNITURE
271     CONTINUE      
270   CONTINUE      
C
      DO 280 I = IL1, IL2
        PVGBIOMS(I)=VGBIOMAS(I)  ! STORE GRID AVERAGE QUANTITIES IN
        PGAVLTMS(I)=GAVGLTMS(I)  ! TEMPORARY ARRAYS
        PGAVSCMS(I)=GAVGSCMS(I)
C
        VGBIOMAS(I)=0.0
        GAVGLTMS(I)=0.0
        GAVGSCMS(I)=0.0
C
        BAREFRAC(I)=1.0          ! INITIALIZE BARE FRACTION TO 1.0
        PBAREFRA(I)=1.0          ! INITIALIZE PREVIOUS YEARS'S BARE FRACTION TO 1.0
C
        GRSUMCOM(I)=0.0          ! GRID SUM OF COMBUSTION CARBON FOR ALL
                                 ! PFTs THAT ARE CHOPPED
        GRSUMPAP(I)=0.0          ! SIMILARLY FOR PAPER, 
        GRSUMFUR(I)=0.0          ! FURNITURE,
        GRSUMLIT(I)=0.0          ! LITTER, AND
        GRSUMSOC(I)=0.0          ! SOIL C
C
        GRDENCOM(I)=0.0          ! GRID AVERAGED DENSITIES FOR COMBUSTION CARBON,
        GRDENPAP(I)=0.0          ! PAPER,
        GRDENFUR(I)=0.0          ! FURNITURE, 
        GRDENLIT(I)=0.0          ! LITTER, AND
        GRDENSOC(I)=0.0          ! SOIL C
C
        TOTCMASS(I)=0.0          ! TOTAL C MASS (LIVE+DEAD)
        TOTLMASS(I)=0.0          ! TOTAL C MASS (LIVE)
        TOTDMAS1(I)=0.0          ! TOTAL C MASS (DEAD) LITTER
        TOTDMAS2(I)=0.0          ! TOTAL C MASS (DEAD) SOIL C
C
C       AND THE SAME 3 QUANTITIES AS ABOVE AFTER LUC TREATMENT
C
        NTOTCMAS(I)=0.0          ! TOTAL C MASS (LIVE+DEAD)
        NTOTLMAS(I)=0.0          ! TOTAL C MASS (LIVE)
        NTOTDMS1(I)=0.0          ! TOTAL C MASS (DEAD) LITTER
        NTOTDMS2(I)=0.0          ! TOTAL C MASS (DEAD) SOIL C
C
        LUCEMCOM(I)=0.0          ! LUC RELATED COMBUSTION EMISSION LOSSES
        LUCLTRIN(I)=0.0          ! LUC RELATED INPUTS TO LITTER POOL
        LUCSOCIN(I)=0.0          ! LUC RELATED INPUTS TO SOIL C POOL
C
        BAREIORD(I)=0            ! BARE FRACTION INCREASES OR DECREASES
        CHOPEDBM(I)=0.0          ! CHOPPED OFF BIOMASS
280   CONTINUE
C
C     INITIALIZATION ENDS
C
C     -------------------------------------------------------------------
C
C     IF LAND USE CHANGE HAS TAKEN PLACE THEN GET FCANMXs FOR USE BY 
C     CLASS BASED ON THE NEW FCANCMXs
C
      K1=0
      DO 300 J = 1, IC
        IF(J.EQ.1) THEN
          K1 = K1 + 1
        ELSE
          K1 = K1 + NOL2PFTS(J-1)
        ENDIF
        K2 = K1 + NOL2PFTS(J) - 1
        DO 301 M = K1, K2
          DO 302 I = IL1, IL2
            IF(LUCTKPLC(I).EQ.1)THEN
              FCANMX(I,J)=FCANMX(I,J)+FCANCMX(I,M)
            ENDIF
            BAREFRAC(I)=BAREFRAC(I)-FCANCMX(I,M)
302       CONTINUE
301     CONTINUE
300   CONTINUE
C
C     FIND PREVIOUS DAY'S BARE FRACTION USING PREVIOUS DAY'S FCANCMXs
C
      DO 310 J = 1, ICC
        DO 311 I = IL1, IL2
          PBAREFRA(I)=PBAREFRA(I)-FCANCMY(I,J)
311     CONTINUE
310   CONTINUE
C
C     BASED ON SIZES OF 3 LIVE POOLS AND 2 DEAD POOLS WE ESTIMATE THE
C     TOTAL AMOUNT OF C IN EACH GRID CELL.
C
      DO 320 J = 1, ICC
        DO 321 I = IL1, IL2
          TOTLMASS(I)=TOTLMASS(I)+
     &                (FCANCMY(I,J)*(GLEAFMAS(I,J)+BLEAFMAS(I,J)+
     &                 STEMMASS(I,J)+ROOTMASS(I,J))*GRCLAREA(I)*KM2TOM2)
321     CONTINUE
320   CONTINUE
C
      DO 340 J = 1, ICC+1
        DO 341 I = IL1, IL2
          IF(J.LT.ICC+1) THEN
            TERM = FCANCMY(I,J)
          ELSE IF(J.EQ.ICC+1) THEN
            TERM = PBAREFRA(I)
          ENDIF
          TOTDMAS1(I)=TOTDMAS1(I)+
     &                (TERM*LITRMASS(I,J)*GRCLAREA(I)*KM2TOM2)
          TOTDMAS2(I)=TOTDMAS2(I)+
     &                (TERM*SOILCMAS(I,J)*GRCLAREA(I)*KM2TOM2)
341     CONTINUE
340   CONTINUE
C
      DO 350 I = IL1, IL2
        TOTCMASS(I)=TOTLMASS(I)+TOTDMAS1(I)+TOTDMAS2(I)
350   CONTINUE
C
C     BARE FRACTIONS CANNOT BE NEGATIVE
C
      DO 440 I = IL1, IL2
        IF( PBAREFRA(I).LT.0.0)THEN
          IF(PBAREFRA(I).GT.-TOLRNCE1 )THEN
C           ASSUME THIS IS ROUND-OFF
            PBAREFRA(I)=0.0
          ELSE
            WRITE(6,*)'BARE FRACTIONS CANNOT BE NEGATIVE'
            WRITE(6,*)'PREV. BARE FRACTION(',I,')  =',PBAREFRA(I)
            CALL XIT('LUC',-9)
         ENDIF
        ENDIF
C
        IF( BAREFRAC(I).LT.0.0)THEN
          IF(BAREFRAC(I).GT.-TOLRNCE1 )THEN
C           ASSUME THIS IS ROUND-OFF
            BAREFRAC(I)=0.0
          ELSE
            WRITE(6,*)'BARE FRACTIONS CANNOT BE NEGATIVE'
            WRITE(6,*)'BARE FRACTION(',I,')  =',BAREFRAC(I)
            CALL XIT('LUC',-10)
          ENDIF
        ENDIF
440   CONTINUE
C
C     FIND ABOVE GROUND BIOMASS AND TREATMENT INDEX FOR COMBUST, PAPER,
C     AND FURNITURE
C
      K1=0
      DO 500 J = 1, IC
        IF(J.EQ.1) THEN
          K1 = K1 + 1
        ELSE
          K1 = K1 + NOL2PFTS(J-1)
        ENDIF
        K2 = K1 + NOL2PFTS(J) - 1
        DO 510 M = K1, K2
          DO 520 I = IL1, IL2
            ABVGMASS(I,M)=GLEAFMAS(I,M)+BLEAFMAS(I,M)+STEMMASS(I,M)
            IF(J.EQ.1.OR.J.EQ.2) THEN  ! TREES
              IF(ABVGMASS(I,M).GE.BMASTHRS(1)) THEN !FOREST
                TREATIND(I,M)=1
              ELSE IF (ABVGMASS(I,M).LE.BMASTHRS(2)) THEN !BUSH 
                TREATIND(I,M)=3
              ELSE  !SHRUBLAND
                TREATIND(I,M)=2
              ENDIF
            ELSE                       !CROPS AND GRASSES
              TREATIND(I,M)=3
            ENDIF
520       CONTINUE
510     CONTINUE
500   CONTINUE
C
C     IF TREATMENT INDEX IS ZERO THEN SOMETHING IS WRONG - WE EXIT
C
      DO 530 J = 1, ICC
        DO 531 I = IL1, IL2
          IF(TREATIND(I,J).EQ.0)THEN
            WRITE(6,*)'TREATMENT INDEX ZERO FOR GRID CELL ',I,' AND PFT 
     &',J
            CALL XIT('LUC',-11)
          ENDIF
531     CONTINUE
530   CONTINUE
C
C     CHECK IF A PFT's FRACTIONAL COVER IS INCREASING OR DECREASING
C
      DO 550 J = 1, ICC 
        DO 551 I = IL1, IL2
          IF( ( FCANCMX(I,J).GT.FCANCMY(I,J)) .AND.
     &        (ABS(FCANCMY(I,J)-FCANCMX(I,J)).GT.ZERO) ) THEN
              FRACIORD(I,J)=1  ! INCREASING
          ELSE IF( ( FCANCMX(I,J).LT.FCANCMY(I,J)) .AND. 
     &             (ABS(FCANCMY(I,J)-FCANCMX(I,J)).GT.ZERO) ) THEN
              FRACIORD(I,J)=-1 ! DECREASING
          ENDIF
551     CONTINUE
550   CONTINUE
C
C     CHECK IF BARE FRACTION INCREASES OF DECREASES
C
      DO 560 I = IL1, IL2
        IF( ( BAREFRAC(I).GT.PBAREFRA(I)) .AND.
     &      (ABS(PBAREFRA(I)-BAREFRAC(I)).GT.ZERO) ) THEN
              BAREIORD(I)=1  !INCREASING
        ELSE IF ( ( BAREFRAC(I).LT.PBAREFRA(I)) .AND.
     &            (ABS(PBAREFRA(I)-BAREFRAC(I)).GT.ZERO) ) THEN
              BAREIORD(I)=-1 !DECREASING
        ENDIF
560   CONTINUE
C
C     IF THE FRACTIONAL COVERAGE OF PFTs INCREASES THEN SPREAD THEIR
C     LIVE & DEAD BIOMASS UNIFORMLY OVER THE NEW FRACTION. THIS 
C     EFFECTIVELY REDUCES THEIR PER M2 C DENSITY. 
C
      DO 570 J = 1, ICC
        DO 571 I = IL1, IL2
          IF(FRACIORD(I,J).EQ.1)THEN
            TERM = FCANCMY(I,J)/FCANCMX(I,J)
            GLEAFMAS(I,J)=GLEAFMAS(I,J)*TERM
            BLEAFMAS(I,J)=BLEAFMAS(I,J)*TERM
            STEMMASS(I,J)=STEMMASS(I,J)*TERM
            ROOTMASS(I,J)=ROOTMASS(I,J)*TERM
            LITRMASS(I,J)=LITRMASS(I,J)*TERM
            SOILCMAS(I,J)=SOILCMAS(I,J)*TERM
          ENDIF 
571     CONTINUE
570   CONTINUE
C
C     IF BARE FRACTION INCREASES THEN SPREAD ITS LITTER AND SOIL C
C     UNIFORMLY OVER THE INCREASED FRACTION
C
      DO 580 I = IL1, IL2
        IF(BAREIORD(I).EQ.1)THEN
          TERM = PBAREFRA(I)/BAREFRAC(I)
          LITRMASS(I,ICC+1)=LITRMASS(I,ICC+1)*TERM
          SOILCMAS(I,ICC+1)=SOILCMAS(I,ICC+1)*TERM
        ENDIF
580   CONTINUE
C
C     IF ANY OF THE PFTs FRACTIONAL COVERAGE DECREASES, THEN WE CHOP THE
C     ABOVEGROUND BIOMASS AND TREAT IT ACCORDING TO OUR RULES (BURN IT,
C     AND CONVERT IT INTO PAPER AND FURNITURE). THE BELOW GROUND LIVE
C     BIOMASS AND LITTER OF THIS PFTs GETS ASSIMILATED INTO LITTER OF
C     ALL PFTs (UNIFORMLY SPREAD OVER THE WHOLE GRID CELL), AND SOIL C
C     FROM THE CHOPPED OFF FRACTION OF THIS PFT, GETS ASSIMILATED INTO
C     SOIL C OF ALL EXISTING PFTs AS WELL.
C
      K1=0
      DO 600 J = 1, IC
        IF(J.EQ.1) THEN
          K1 = K1 + 1
        ELSE
          K1 = K1 + NOL2PFTS(J-1)
        ENDIF
        K2 = K1 + NOL2PFTS(J) - 1
        DO 610 M = K1, K2
          DO 620 I = IL1, IL2
C
            IF(FRACIORD(I,M).EQ.-1)THEN
C             CHOP OFF ABOVE GROUND BIOMASS 
              REDUBMAS1=(FCANCMY(I,M)-FCANCMX(I,M))*GRCLAREA(I)
     &                  *ABVGMASS(I,M)*KM2TOM2
C
              IF(REDUBMAS1.LT.0.0)THEN
                WRITE(6,*)'REDUBMAS1 LESS THAN ZERO'
                WRITE(6,*)'FCANCMY-FCANCMX = ',
     &                     FCANCMY(I,M)-FCANCMX(I,M)
                WRITE(6,*)'GRID CELL = ',I,' PFT = ',M
                CALL XIT('LUC',-12)
              ENDIF
C
C             ROOTMASS NEEDS TO BE CHOPPED AS WELL AND ALL OF IT GOES TO
C             THE LITTER/PAPER POOL
C
              REDUBMAS2=(FCANCMY(I,M)-FCANCMX(I,M))*GRCLAREA(I)
     &                  *ROOTMASS(I,M)*KM2TOM2
C
C
C             KEEP ADDING CHOPPED OFF BIOMASS FOR EACH PFT TO GET THE TOTAL
C             FOR A GRID CELL FOR DIAGNOSTICS
C
              CHOPEDBM(I)=CHOPEDBM(I) + REDUBMAS1 + REDUBMAS2 
C
C             FIND WHAT'S BURNT, AND WHAT'S CONVERTED TO PAPER &
C             FURNITURE
              COMBUSTC(I,M)=COMBUST(TREATIND(I,M))*REDUBMAS1
              PAPERC(I,M)=PAPER(TREATIND(I,M))*REDUBMAS1 + REDUBMAS2
              FURNTURC(I,M)=FURNITURE(TREATIND(I,M))*REDUBMAS1
C
C             KEEP ADDING ALL THIS FOR A GIVEN GRID CELL
              GRSUMCOM(I)=GRSUMCOM(I)+COMBUSTC(I,M)
              GRSUMPAP(I)=GRSUMPAP(I)+PAPERC(I,M)
              GRSUMFUR(I)=GRSUMFUR(I)+FURNTURC(I,M)
C
C             LITTER FROM THE CHOPPED OFF FRACTION OF THE CHOPPED
C             OFF PFT NEEDS TO BE ASSIMILATED, AND SO DOES SOIL C FROM
C             THE CHOPPED OFF FRACTION OF THE CHOPPED PFT
C
              REDUBMAS1=(FCANCMY(I,M)-FCANCMX(I,M))*GRCLAREA(I)
     &                  *LITRMASS(I,M)*KM2TOM2
              INCRLITR(I,M)=REDUBMAS1
C
              REDUBMAS1=(FCANCMY(I,M)-FCANCMX(I,M))*GRCLAREA(I)
     &                  *SOILCMAS(I,M)*KM2TOM2
              INCRSOLC(I,M)=REDUBMAS1
C
              GRSUMLIT(I)=GRSUMLIT(I)+INCRLITR(I,M)
              GRSUMSOC(I)=GRSUMSOC(I)+INCRSOLC(I,M)
            ENDIF
C
620       CONTINUE
610     CONTINUE
600   CONTINUE
C
C     IF BARE FRACTION DECREASES THEN CHOP OFF THE LITTER AND SOIL C
C     FROM THE DECREASED FRACTION AND ADD IT TO GRSUMLIT & GRSUMSOC
C     FOR SPREADING OVER THE WHOLE GRID CELL
C
      DO 630 I = IL1, IL2
        IF(BAREIORD(I).EQ.-1)THEN

          REDUBMAS1=(PBAREFRA(I)-BAREFRAC(I))*GRCLAREA(I)
     &              *LITRMASS(I,ICC+1)*KM2TOM2
C
          REDUBMAS2=(PBAREFRA(I)-BAREFRAC(I))*GRCLAREA(I)
     &              *SOILCMAS(I,ICC+1)*KM2TOM2
C
          GRSUMLIT(I)=GRSUMLIT(I)+REDUBMAS1
          GRSUMSOC(I)=GRSUMSOC(I)+REDUBMAS2
        ENDIF
630   CONTINUE
C
C     CALCULATE IF THE CHOPPED OFF BIOMASS EQUALS THE SUM OF GRSUMCOM(I),
C     GRSUMPAP(I) & GRSUMFUR(I)
C
      DO 632 I = IL1, IL2
       SUM1=GRSUMCOM(I)+GRSUMPAP(I)+GRSUMFUR(I)
       DIFF=ABS(CHOPEDBM(I)-SUM1)
       IF(CHOPEDBM(I).EQ.0.)THEN
         IF(DIFF.EQ.0.)THEN
           RDIF=0.              ! RELATIVE ACCURACY
         ELSE
           RDIF=1.              ! RELATIVE ACCURACY
         ENDIF
       ELSE
         RDIF=DIFF/CHOPEDBM(I)  ! RELATIVE ACCURACY
       ENDIF
       IF(RDIF .GT. TOLRNCE2 ) THEN
           WRITE(6,*)'AT GRID CELL = ',I
           WRITE(6,*)'CHOPPED BIOMASS DOES NOT EQUALS SUM OF TOTAL'   
           WRITE(6,*)'LUC RELATED EMISSIONS'
           WRITE(6,*)'CHOPEDBM(I) = ',CHOPEDBM(I)
           WRITE(6,*)'GRSUMCOM(I) = ',GRSUMCOM(I)
           WRITE(6,*)'GRSUMPAP(I) = ',GRSUMPAP(I)
           WRITE(6,*)'GRSUMFUR(I) = ',GRSUMFUR(I)
           WRITE(6,*)'SUM OF GRSUMCOM, GRSUMPAP, GRSUMFUR(I) = ',
     &       SUM1
           WRITE(6,*)'ABS. DIFF. = ',DIFF
           WRITE(6,*)'REL. DIFF. = ',RDIF
           CALL XIT('LUC',-13)
       ENDIF
632   CONTINUE     
C
C     SPREAD CHOPPED OFF STUFF UNIFORMLY OVER THE LITTER AND SOIL C
C     POOLS OF ALL EXISTING PFTs, INCLUDING THE BARE FRACTION.
C
C     CONVERT THE AVAILABLE C INTO DENSITY 
C
      DO 640 I = IL1, IL2
        GRDENCOM(I)=GRSUMCOM(I)/(GRCLAREA(I)*KM2TOM2)
        GRDENPAP(I)=GRSUMPAP(I)/(GRCLAREA(I)*KM2TOM2)
        GRDENFUR(I)=GRSUMFUR(I)/(GRCLAREA(I)*KM2TOM2)
        GRDENLIT(I)=GRSUMLIT(I)/(GRCLAREA(I)*KM2TOM2)
        GRDENSOC(I)=GRSUMSOC(I)/(GRCLAREA(I)*KM2TOM2)
640   CONTINUE
C
      DO 650 J = 1, ICC
        DO 651 I = IL1, IL2
          IF(FCANCMX(I,J).GT.ZERO)THEN
            LITRMASS(I,J)=LITRMASS(I,J)+GRDENPAP(I)+GRDENLIT(I)
            SOILCMAS(I,J)=SOILCMAS(I,J)+GRDENFUR(I)+GRDENSOC(I)
          ELSE
            GLEAFMAS(I,J)=0.0
            BLEAFMAS(I,J)=0.0
            STEMMASS(I,J)=0.0
            ROOTMASS(I,J)=0.0
            LITRMASS(I,J)=0.0
            SOILCMAS(I,J)=0.0
          ENDIF
651     CONTINUE 
650   CONTINUE
C 
      DO 660 I = IL1, IL2
        IF(BAREFRAC(I).GT.ZERO)THEN
          LITRMASS(I,ICC+1)=LITRMASS(I,ICC+1)+GRDENPAP(I)+GRDENLIT(I)
          SOILCMAS(I,ICC+1)=SOILCMAS(I,ICC+1)+GRDENFUR(I)+GRDENSOC(I)
        ELSE
          LITRMASS(I,ICC+1)=0.0
          SOILCMAS(I,ICC+1)=0.0
        ENDIF
660   CONTINUE
C
C     THE COMBUSTED C IS USED TO FIND THE C FLUX THAT WE CAN RELEASE
C     INTO THE ATMOSPHERE.
C
      DO 670 I = IL1, IL2
        LUCEMCOM(I)=GRDENCOM(I)     ! THIS IS FLUX IN KG C/M2.DAY THAT
C                                   ! WILL BE EMITTED 
C       LUCLTRIN(I)=GRDENPAP(I)+GRDENLIT(I) ! FLUX IN KG C/M2.DAY
C       LUCSOCIN(I)=GRDENFUR(I)+GRDENSOC(I) ! FLUX IN KG C/M2.DAY
C
        LUCLTRIN(I)=GRDENPAP(I) ! FLUX IN KG C/M2.DAY
        LUCSOCIN(I)=GRDENFUR(I) ! FLUX IN KG C/M2.DAY
C
C       CONVERT ALL LAND USE CHANGE FLUXES TO u-MOL CO2-C/M2.SEC
        LUCEMCOM(I)=LUCEMCOM(I)*963.62
        LUCLTRIN(I)=LUCLTRIN(I)*963.62
        LUCSOCIN(I)=LUCSOCIN(I)*963.62
670   CONTINUE
C
C     AND FINALLY WE SEE IF THE TOTAL AMOUNT OF CARBON IS CONSERVED
C
      DO 700 J = 1, ICC
        DO 701 I = IL1, IL2
          NTOTLMAS(I)=NTOTLMAS(I)+
     &                (FCANCMX(I,J)*(GLEAFMAS(I,J)+BLEAFMAS(I,J)+
     &                STEMMASS(I,J)+ROOTMASS(I,J))*GRCLAREA(I)*KM2TOM2)
701     CONTINUE
700   CONTINUE
C
      DO 710 J = 1, ICC+1
        DO 711 I = IL1, IL2
          IF(J.LT.ICC+1) THEN
            TERM = FCANCMX(I,J)
          ELSE IF(J.EQ.ICC+1) THEN
            TERM = BAREFRAC(I)
          ENDIF
          NTOTDMS1(I)=NTOTDMS1(I)+
     &                (TERM*LITRMASS(I,J)*GRCLAREA(I)*KM2TOM2)
          NTOTDMS2(I)=NTOTDMS2(I)+
     &                (TERM*SOILCMAS(I,J)*GRCLAREA(I)*KM2TOM2)
711     CONTINUE
710   CONTINUE
C
      DO 720 I = IL1, IL2
        NTOTCMAS(I)=NTOTLMAS(I)+NTOTDMS1(I)+NTOTDMS2(I)
720   CONTINUE
C
C     TOTAL LITTER MASS (BEFORE + INPUT FROM CHOPPED OFF BIOMASS)
C     AND AFTER MUST BE SAME
C
      DO 722 I = IL1, IL2
        SUM1=TOTDMAS1(I)+GRSUMPAP(I)
        DIFF=ABS(SUM1-NTOTDMS1(I))
        IF(NTOTDMS1(I).EQ.0.)THEN
          IF(DIFF.EQ.0.)THEN
            RDIF=0.             ! RELATIVE ACCURACY
          ELSE
            RDIF=1.             ! RELATIVE ACCURACY
          ENDIF
        ELSE
          RDIF=DIFF/NTOTDMS1(I) ! RELATIVE ACCURACY
        ENDIF
        IF( RDIF.GT.TOLRNCE2 )THEN
           WRITE(6,*)'AT GRID CELL = ',I
           WRITE(6,*)'TOTAL LITTER CARBON DOES NOT BALANCE AFTER LUC'
           WRITE(6,*)'TOTDMAS1(I) = ',TOTDMAS1(I)
           WRITE(6,*)'GRSUMPAP(I) = ',GRSUMPAP(I)
           WRITE(6,*)'TOTDMAS1(I) + GRSUMPAP(I) = ',SUM1
           WRITE(6,*)'NTOTDMS1(I) = ',NTOTDMS1(I)
           WRITE(6,*)'ABS. DIFF. = ',DIFF
           WRITE(6,*)'REL. DIFF. = ',RDIF
           WRITE(6,*)'TOLRNCE2 = ',TOLRNCE2
           CALL XIT('LUC',-14)
        ENDIF
722   CONTINUE
C
C     FOR CONSERVATION TOTCMASS(I) MUST BE EQUAL TO NTOTCMAS(I) PLUS
C     COMBUSTION CARBON LOSSES
C
      DO 730 I = IL1, IL2
        SUM1=NTOTCMAS(I)+GRSUMCOM(I)
        DIFF=ABS(TOTCMASS(I)-SUM1)
        IF(TOTCMASS(I).EQ.0.)THEN
          IF(DIFF.EQ.0.)THEN
            RDIF=0.             ! RELATIVE ACCURACY
          ELSE
            RDIF=1.             ! RELATIVE ACCURACY
          ENDIF
        ELSE
          RDIF=DIFF/TOTCMASS(I) ! RELATIVE ACCURACY
        ENDIF
        IF( RDIF.GT.TOLRNCE2)THEN
           WRITE(6,*)'AT GRID CELL = ',I
           WRITE(6,*)'TOTAL CARBON DOES NOT BALANCE AFTER LUC'
           WRITE(6,*)'TOTCMASS(I) = ',TOTCMASS(I)
           WRITE(6,*)'NTOTCMAS(I) = ',NTOTCMAS(I)
           WRITE(6,*)'GRSUMCOM(I) = ',GRSUMCOM(I)
           WRITE(6,*)'NTOTCMAS(I) + GRSUMCOM(I) = ',SUM1
           WRITE(6,*)'ABS. DIFF. = ',DIFF
           WRITE(6,*)'REL. DIFF. = ',RDIF
           WRITE(6,*)'TOLRNCE2 = ',TOLRNCE2
           CALL XIT('LUC',-15)
        ENDIF
730   CONTINUE
C
C     UPDATE GRID AVERAGED VEGETATION BIOMASS, AND LITTER AND SOIL C
C     DENSITIES
C
      DO 750 J = 1, ICC
        DO 751 I = IL1, IL2
          VGBIOMAS(I)=VGBIOMAS(I)+FCANCMX(I,J)*(GLEAFMAS(I,J)+
     &                BLEAFMAS(I,J)+STEMMASS(I,J)+ROOTMASS(I,J))
          GAVGLTMS(I)=GAVGLTMS(I)+FCANCMX(I,J)*LITRMASS(I,J)
          GAVGSCMS(I)=GAVGSCMS(I)+FCANCMX(I,J)*SOILCMAS(I,J)
751     CONTINUE
750   CONTINUE
C
      DO 760 I = IL1, IL2
        GAVGLTMS(I)=GAVGLTMS(I)+( BAREFRAC(I)*LITRMASS(I,ICC+1) )
        GAVGSCMS(I)=GAVGSCMS(I)+( BAREFRAC(I)*SOILCMAS(I,ICC+1) )
760   CONTINUE
C
C     JUST LIKE TOTAL AMOUNT OF CARBON MUST BALANCE, THE GRID AVERAGRED
C     DENSITIES MUST ALSO BALANCE
C
      DO 780 I = IL1, IL2
       SUM1=PVGBIOMS(I)+PGAVLTMS(I)+PGAVSCMS(I)
       SUM2=VGBIOMAS(I)+GAVGLTMS(I)+GAVGSCMS(I)+GRDENCOM(I)
       DIFF=ABS(SUM1-SUM2)
       IF(SUM1.EQ.0.)THEN
         IF(DIFF.EQ.0.)THEN
           RDIF=0.              ! RELATIVE ACCURACY
         ELSE
           RDIF=1.              ! RELATIVE ACCURACY
         ENDIF
       ELSE
         RDIF=DIFF/SUM1         ! RELATIVE ACCURACY
       ENDIF
       IF( RDIF .GT.TOLRNCE2 ) THEN
           WRITE(6,*)'IDAY = ',IDAY
           WRITE(6,*)'AT GRID CELL = ',I
           WRITE(6,*)'PBAREFRA(I) = ',PBAREFRA(I)
           WRITE(6,*)'BAREFRAC(I) = ',BAREFRAC(I)
           WRITE(6,*)'PFCANCMX(I,J) = ',(PFCANCMX(I,J),J=1,ICC)
           WRITE(6,*)'NFCANCMX(I,J) = ',(NFCANCMX(I,J),J=1,ICC)
           WRITE(6,*)'TOTAL CARBON DENSITY DOES NOT BALANCE AFTER LUC'
           WRITE(6,*)'PVGBIOMS(I) = ',PVGBIOMS(I)
           WRITE(6,*)'PGAVLTMS(I) = ',PGAVLTMS(I)
           WRITE(6,*)'PGAVSCMS(I) = ',PGAVSCMS(I)
           WRITE(6,*)'VGBIOMAS(I) = ',VGBIOMAS(I)
           WRITE(6,*)'GAVGLTMS(I) = ',GAVGLTMS(I)
           WRITE(6,*)'GAVGSCMS(I) = ',GAVGSCMS(I)
           WRITE(6,*)'GRDENCOM(I) = ',GRDENCOM(I)
           WRITE(6,*)'PVGBIOMS + PGAVLTMS + PGAVSCMS = ',SUM1
           WRITE(6,*)'VGBIOMAS + GAVGLTMS + GAVGSCMS + GRDENCOM = ',SUM2
           WRITE(6,*)'ABS. DIFF. = ',DIFF
           WRITE(6,*)'REL. DIFF. = ',RDIF
           WRITE(6,*)'TOLRNCE2 = ',TOLRNCE2
           CALL XIT('LUC',-16)
       ENDIF
780   CONTINUE
C
      DO 800 J = 1, ICC
        DO 810 I = IL1, IL2
          IF(IDAY.EQ.365)THEN
            PFCANCMX(I,J)=NFCANCMX(I,J)
          ENDIF
810     CONTINUE
800   CONTINUE
C
      RETURN 
      END

