*IF DEF,A19_2A DECAY2A.2 C *****************************COPYRIGHT****************************** DECAY2A.3 C (c) CROWN COPYRIGHT 1997, METEOROLOGICAL OFFICE, All Rights Reserved. DECAY2A.4 C DECAY2A.5 C Use, duplication or disclosure of this code is subject to the DECAY2A.6 C restrictions as set forth in the contract. DECAY2A.7 C DECAY2A.8 C Meteorological Office DECAY2A.9 C London Road DECAY2A.10 C BRACKNELL DECAY2A.11 C Berkshire UK DECAY2A.12 C RG12 2SZ DECAY2A.13 C DECAY2A.14 C If no contract has been raised with this copy of the code, the use, DECAY2A.15 C duplication or disclosure of it is strictly prohibited. Permission DECAY2A.16 C to do so must first be obtained in writing from the Head of Numerical DECAY2A.17 C Modelling at the above address. DECAY2A.18 C ******************************COPYRIGHT****************************** DECAY2A.19 !!! Subroutine DECAY -------------------------------------------------- DECAY2A.20 !!! DECAY2A.21 !!! Purpose : Updates carbon contents of the soil. DECAY2A.22 !!! DECAY2A.23 !!! DECAY2A.24 !!! Model Modification history: DECAY2A.25 !!! version Date DECAY2A.26 !!! 4.4 10/97 New Deck. Peter Cox DECAY2A.27 !!! 4.5 12/05/98 Operate only on points indexed with TRIF_INDEX. ABX1F405.1691 !!! Richard Betts ABX1F405.1692 !!! DECAY2A.28 !!!END ---------------------------------------------------------------- DECAY2A.29SUBROUTINE DECAY (LAND_FIELD,TRIF_PTS,TRIF_INDEX 1ABX1F405.1693 &, DPC_DCS,FORW,GAMMA,PC,CS) DECAY2A.31 DECAY2A.32 IMPLICIT NONE DECAY2A.33 DECAY2A.34 INTEGER DECAY2A.35 & LAND_FIELD ! IN Total number of land points. DECAY2A.36 &,TRIF_PTS ! IN Number of points on which ABX1F405.1694 ! ! TRIFFID may operate ABX1F405.1695 &,TRIF_INDEX(LAND_FIELD) ! IN Indices of land points on ABX1F405.1696 ! ! which TRIFFID may operate ABX1F405.1697 &,L,T ! WORK Loop counters ABX1F405.1698 DECAY2A.41 REAL DECAY2A.42 & DPC_DCS(LAND_FIELD) ! IN Rate of change of PC with DECAY2A.43 C ! soil carbon (yr). DECAY2A.44 &,FORW ! IN Forward timestep weighting. DECAY2A.45 &,GAMMA ! IN Inverse timestep (/360days). ABX1F405.1699 &,PC(LAND_FIELD) ! IN Net carbon flux into the DECAY2A.47 C ! soil (kg C/m2/360days). ABX1F405.1700 &,CS(LAND_FIELD) ! INOUT Soil carbon (kg C/m2). DECAY2A.49 &,DENOM ! WORK Denominator of update DECAY2A.50 C ! equation. DECAY2A.51 &,DENOM_MIN ! WORK Minimum value for the DECAY2A.52 C ! denominator of the update DECAY2A.53 C ! equation. Ensures that DECAY2A.54 C ! gradient descent does not DECAY2A.55 C ! lead to an unstable solution. DECAY2A.56 &,NUMER ! WORK Numerator of the update DECAY2A.57 C ! equation. DECAY2A.58 C---------------------------------------------------------------------- DECAY2A.59 C Local parameters DECAY2A.60 C---------------------------------------------------------------------- DECAY2A.61 *CALL CSMIN
DECAY2A.62 *CALL DESCENT
DECAY2A.63 DECAY2A.64 DO T=1,TRIF_PTS ABX1F405.1701 L=TRIF_INDEX(T) ABX1F405.1702 DECAY2A.66 NUMER = PC(L) DECAY2A.67 DENOM = GAMMA+FORW*DPC_DCS(L) DECAY2A.68 DENOM_MIN = GAMMA_EQ DECAY2A.69 DENOM = MAX(DENOM,DENOM_MIN) DECAY2A.70 DECAY2A.71 CS(L) = CS(L)+NUMER/DENOM DECAY2A.72 DECAY2A.73 CS(L) = MAX(CS_MIN,CS(L)) DECAY2A.74 DECAY2A.75 ENDDO DECAY2A.76 DECAY2A.77 RETURN DECAY2A.78 END DECAY2A.79 *ENDIF DECAY2A.80