! ! Soil dynamics. Essentially after Century. ! FOR THE MOMENT, NO VERTICAL DISCRETISATION !!!! ! ! $Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_soilcarbon.f90,v 1.7 2009/01/06 17:18:32 ssipsl Exp $ ! IPSL (2006) ! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC ! MODULE stomate_soilcarbon ! modules used: USE ioipsl USE stomate_constants IMPLICIT NONE ! private & public routines PRIVATE PUBLIC soilcarbon,soilcarbon_clear ! first call LOGICAL, SAVE :: firstcall = .TRUE. CONTAINS SUBROUTINE soilcarbon_clear firstcall=.TRUE. ENDSUBROUTINE soilcarbon_clear SUBROUTINE soilcarbon (npts, dt, clay, & soilcarbon_input, control_temp, control_moist, & carbon, & resp_hetero_soil) ! ! 0 declarations ! ! 0.1 input ! Domain size INTEGER(i_std), INTENT(in) :: npts ! time step in days REAL(r_std), INTENT(in) :: dt ! clay fraction (between 0 and 1) REAL(r_std), DIMENSION(npts), INTENT(in) :: clay ! quantity of carbon going into carbon pools from litter decomposition ! (gC/(m**2 of ground)/day) REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in) :: soilcarbon_input ! temperature control of heterotrophic respiration REAL(r_std), DIMENSION(npts,nlevs), INTENT(in) :: control_temp ! moisture control of heterotrophic respiration REAL(r_std), DIMENSION(npts,nlevs), INTENT(in) :: control_moist ! 0.2 modified fields ! carbon pool: active, slow, or passive, (gC/m**2 of ground) REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(inout) :: carbon ! 0.3 output ! soil heterotrophic respiration (first in gC/day/m**2 of ground ) REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: resp_hetero_soil ! 0.4 local ! residence time in carbon pools (days) REAL(r_std), SAVE, DIMENSION(ncarb) :: carbon_tau ! flux fractions within carbon pools REAL(r_std), DIMENSION(npts,ncarb,ncarb) :: frac_carb ! fraction of carbon flux which goes into heterotrophic respiration REAL(r_std), DIMENSION(npts,ncarb) :: frac_resp ! total flux out of carbon pools (gC/m**2) REAL(r_std), DIMENSION(npts,ncarb) :: fluxtot ! fluxes between carbon pools (gC/m**2) REAL(r_std), DIMENSION(npts,ncarb,ncarb) :: flux ! for messages CHARACTER*7, DIMENSION(ncarb) :: carbon_str ! Indices INTEGER(i_std) :: k,kk,m ! ========================================================================= IF (bavard.GE.3) WRITE(numout,*) 'Entering soilcarbon' ! ! 1 initializations ! ! ! 1.1 get soil "constants" ! ! 1.1.1 flux fractions between carbon pools: depend on clay content, recalculated ! each time ! 1.1.1.1 from active pool: depends on clay content frac_carb(:,iactive,iactive) = 0.0 frac_carb(:,iactive,ipassive) = 0.004 frac_carb(:,iactive,islow) = 1. - (.85-.68*clay(:)) - frac_carb(:,iactive,ipassive) ! 1.1.1.2 from slow pool frac_carb(:,islow,islow) = .0 frac_carb(:,islow,iactive) = .42 frac_carb(:,islow,ipassive) = .03 ! 1.1.1.3 from passive pool frac_carb(:,ipassive,ipassive) = .0 frac_carb(:,ipassive,iactive) = .45 frac_carb(:,ipassive,islow) = .0 IF ( firstcall ) THEN ! 1.1.2 residence times in carbon pools (days) carbon_tau(iactive) = .149 * one_year !!!!???? 1.5 years carbon_tau(islow) = 5.48 * one_year !!!!???? 25 years carbon_tau(ipassive) = 241. * one_year !!!!???? 1000 years ! ! 1.2 messages ! carbon_str(iactive) = 'active' carbon_str(islow) = 'slow' carbon_str(ipassive) = 'passive' WRITE(numout,*) 'soilcarbon:' WRITE(numout,*) ' > minimal carbon residence time in carbon pools (d):' DO k = 1, ncarb WRITE(numout,*) ' ',carbon_str(k),':',carbon_tau(k) ENDDO WRITE(numout,*) ' > flux fractions between carbon pools: depend on clay content' firstcall = .FALSE. ENDIF ! ! 1.3 set output to zero ! resp_hetero_soil(:,:) = 0.0 ! ! 2 input into carbon pools ! carbon(:,:,:) = carbon(:,:,:) + soilcarbon_input(:,:,:) * dt ! ! 3 fluxes within carbon reservoirs + respiration ! ! ! 3.1 determine fraction of flux that is respiration ! diagonal elements of frac_carb are zero ! VPP killer: ! frac_resp(:,:) = 1. - SUM( frac_carb(:,:,:), DIM=3 ) ! frac_resp(:,:) = 1. - frac_carb(:,:,iactive) - frac_carb(:,:,islow) - & frac_carb(:,:,ipassive) ! ! 3.2 calculate fluxes ! DO m = 2,nvm ! 3.2.1 flux out of pools DO k = 1, ncarb ! determine total flux out of pool ! shilong060505 for crop multiply tillage factor of decomposition IF ( natural(m) ) THEN fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * & control_moist(:,ibelow) * control_temp(:,ibelow) ELSEIF ( PFT_name(m)==' C3 agriculture' ) THEN fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * & control_moist(:,ibelow) * control_temp(:,ibelow) * 1.2 ELSEIF ( PFT_name(m)==' C4 agriculture' ) THEN fluxtot(:,k) = dt/carbon_tau(k) * carbon(:,k,m) * & control_moist(:,ibelow) * control_temp(:,ibelow) * 1.4 ENDIF ! end edit shilong IF ( k .EQ. iactive ) THEN fluxtot(:,k) = fluxtot(:,k) * ( 1. - .75 * clay(:) ) ENDIF ! decrease this carbon pool carbon(:,k,m) = carbon(:,k,m) - fluxtot(:,k) ! fluxes towards the other pools (k -> kk) DO kk = 1, ncarb flux(:,k,kk) = frac_carb(:,k,kk) * fluxtot(:,k) ENDDO ENDDO ! 3.2.2 respiration ! VPP killer: ! resp_hetero_soil(:,m) = SUM( frac_resp(:,:) * fluxtot(:,:), DIM=2 ) / dt resp_hetero_soil(:,m) = & ( frac_resp(:,iactive) * fluxtot(:,iactive) + & frac_resp(:,islow) * fluxtot(:,islow) + & frac_resp(:,ipassive) * fluxtot(:,ipassive) ) / dt ! 3.2.3 add fluxes to active, slow, and passive pools ! VPP killer: ! carbon(:,:,m) = carbon(:,:,m) + SUM( flux(:,:,:), DIM=2 ) DO k = 1, ncarb carbon(:,k,m) = carbon(:,k,m) + & flux(:,iactive,k) + flux(:,ipassive,k) + flux(:,islow,k) ENDDO ENDDO IF (bavard.GE.4) WRITE(numout,*) 'Leaving soilcarbon' END SUBROUTINE soilcarbon END MODULE stomate_soilcarbon