c c decomp.for c c subroutine decomp(isr, stmno, stmht, dmsbm, dmfbm, dmgbm, dmrbm) subroutine decomp(isr) c c +++ PURPOSE + + + c c decomp.for calculates change in standing, flat and belowground c biomass. It carries three age pools of residues most recent, previous and c combined old material. Decomp also estimates the number of standing c stems and soil surface cover provided by the surface residues. c Data for each subregion that is needed following a harvest is c maintained within local variables on a daily basis. c c Authors: Harry Schomberg and Jean Steiner c USDA-ARS Bushland, TX c USDA-ARS Watkinsville, GA c c + + + KEYWORDS + + + c decompdays, standing residue, surface residue, buried residue, c soil cover, residue cover, decomposition day c c + + + PARAMTERS AND COMMON BLOCKS +++ include 'p1werm.inc' include 'w1clig.inc' include 's1layr.inc' include 'p1const.inc' include 'm1flag.inc' include 'm1dbug.inc' c These hydrology common blocks provide soil temp, moisture and irrigation include 'h1temp.inc' include 'h1db1.inc' include 'h1hydro.inc' c Werm $INCLUDE:file for decomp variables include 'c1db1.inc' include 'd1glob.inc' c Local $INCLUDE:file for decomp variables include 'decomp/decomp.inc' c + + + ARGUMENT DECLARATIONS + + + integer isr c c + + + ARGUMENT DEFINITIIONS + + + c isr - current subregion c c + + + LOCAL VARIABLES in DECOMP.inc + + + c aqua - sum of precip, irrigation and snow melt (m) c covfact - coeficient for converting mass to cover (m^2/kg) c covhrz - surface cover from flat residue by pool (m^2 / m^2) c cumddf - cummlative decomp days for surface res. by pool (days) c cumddg - cumm. decomp days below ground res by pool and layer (days) c cumdds - cumulative decomp days for standing res. by pool (days) c dasai - vertical surface area from standing residue by age pool (m^2/m^2) c dasait - total vertical surface area from standing residue (m^2/m^2) c ddsthrsh- threshhold number of decomp. days before stems begin to fall c diddf - decomposition day for surface residue (0. to 1.) c diddg - decomp. day for below ground residue by soil layer (0. to 1.) c didds - decomposition day for standing residue (0. to 1.) c ditca - temperature coef. for above ground res. (0. to 1.) c ditcg - temperature coef. below ground res. by soil layer (0. to 1.) c diwcf - daily water coefficient for surface residues (0. to 1.) c diwcg - water coef. for below ground res. by soil layer (0. to 1.) c diwcs - water coefficient for standing res. (0. to 1.) c diwcsy - water coefficient from previous day standing res. (0. to 1.) c dkrate - decomposition rate for each age pool and location (d < 1.) (g/g/day) c admf - surface biomass by age pool (kg / m^2) c dmfbmtot- total surface biomass (kg / m^2) c admbgz - below ground biomass by layer and pool (kg / m^2) c dmgbmtot- total below ground non-root biomass (kg / m^2) c admrtz - root biomass by layer and pool (kg / m^2) c dmrbmtot- total root biomass (kg / m^2) c admst - standing biomass by age pool (kg / m^2) c dmsbmtot- total standing biomass (sum of iage pools) (kg / m^2) c dmsbmy - yesterdays standing stem biomass by age pool (kg / m^2) c dweti - days since anticedent moisture (4. to 0.) index c hrvflag - harvest flag used to increment residue pools c hzcovflt- surface cover from flat residue (m^2 / m^2) c hzcovstd- surface cover from standing residue (m^2 / m^2) c hzcovtot- total horizontal surface cover (m^2 / m^2) c iage - residue pool age index c idtype - index of residue type 1 = standing 2 = flat or surface c 3 = buried (non root) 4 = root 5 =stem number c iht - index for standing residues vertical distribution c mnbpls - residue pool age variable for standing, buried, root, c flat, and stem number age pools. c isz - soil layer indexing variable c sai - stem area index by height (dasait/5) (m^2 / m^2) c starea - (pi*r^2*no stems) horizontal area of stems, by age pool ( m^2 / m^2) c adxstm - stem diameter for each pool (m) c stmht - stem height for each pool (m) c addstm - standing stem number by pool (no. / m^2) c stmnoy - standing stem number from yesterday (no. / m^2) c c + + + VARIABLES MAINTIANED BY SUBREGION + + + c C dweti(mnsub) C diwcsy(mnsub) c diwcg(mnsz) c ditcg(mnsz) c diddg(mnsz) c cumdds(mnbpls,mnsub) c cumddf(mnbpls,mnsub) c cumddg(mnbpls,mnsz,mnsub) cumddg(mnsz,mnbpls,mnsub) c dmsbm(mnbpls,mnsub) admst(mnbpls,mnsub) c dmsbmy(mnbpls,mnsub) c dmgbm(mnbpls,mnsz,mnsub) admbgz(mnsz,mnbpls,mnsub) c dmrbm(mnbpls,mnsz,mnsub) admrtz(mnsz,mnbpls,mnsub) c dmfbm(mnbpls,mnsub) admf(mnbpls,mnsub) c stmno(mnbpls,mnsub) addstm(mnbpls,mnsub) c stmnoy(mnbpls,mnsub) c sai(5,mnsub) adrsaz(mncz,mnbpls,mnsub) c + + + ADDITIONAL LOCAL VARIABLES NOT IN DECOMP.KOM + + + c These are used in tc function. c tavgsq - average temperature squared (C) c temp - average air or soil temp (C) c toptsq - optimum temperature for residue decomposition (32C) c c + + + FUNCTION CALLS +++ C c tc - Calculates temperature based scaling factor real tc logical dbgflg c c + + + DATA INITIALIZATIONS + + + c These data initializations are being done every day. Need to make c sure that when a harvest takes place that all the decomp pools are c updated correctly. c data dbgflg /.false./ if (am0ddb .eq. 1) call ddbug(isr, nslay(isr)) if (dbgflg) write(*,*) 'decomp 1' C if (flushunit(6).ne.0) write(*,*) 'error on flush' c + + + END SPECIFICATIONS + + + if (dbgflg) write(*,*) 'decomp 1a' C if (flushunit(6).ne.0) write(*,*) 'error on flush' c call initilization c if (am0dif .eqv. .true.) then c call decini (isr) c end if c am0dif = .false. c Calculation of water coefficent for decomp days c Standing residues water factor ( 0. to 1. ) c Steiner et al. 1994 Agronomy Journal Jan-Feb issue c sum rain, irr, snow melt if (dbgflg) write(*,*) 'decomp 2' C if (flushunit(6).ne.0) write(*,*) 'error on flush' aqua = awzdpt + ahzirr(isr) + ahzsmt(isr) c Test for water input day. if (aqua .gt. 0.) then dweti(isr) = 4.0 !set # of days for antecedent diwcs = aqua / 4.0 !4mm required to wet residues diwcs = diwcs + diwcsy(isr) * 0.4 !add previous antecdent moisture if (diwcs.gt.1.) diwcs = 1.0 !Limit no greater than 1. else if (dweti(isr).gt.0.) then !if No rain but recent water input dweti(isr) = dweti(isr) - 1.0 !decrement days since rain diwcs = diwcsy(isr)*0.4 !set diwcs to decremented value else !dry conditions diwcs = 0.0 endif diwcsy(isr) = diwcs !save diwcs for calc. of tomorrows water factor c Surface water factor same as standing (0. to 1.) c Need to set up better test of water factor (12-8-1993) c code changed to use hydrology global variables HHS 1- 4- 1994 c old code > diwcf = theta(1)/thetaf(1) diwcf = ahrwc(1,isr) / ahrwcf(1,isr) if (diwcf.gt.1.0) diwcf = 1.0 diwcf = max(diwcf,diwcs) c Belowground water factor (0. to 1.) c Stanford and Epstien 1974, SSSAJ 34:103-107 theta/thetaopt c code changed to use global hydrology variables HHS 1-4-1994 c c do 30 isz = 1 , nslay(isr) c diwcg(isz) = theta(isz)/ thetaf(isz) c if (diwcg(isz) .gt. 1.) diwcg(isz) = 1. c 30 continue if (dbgflg) write(*,*) 'decomp 3' C if (flushunit(6).ne.0) write(*,*) 'error on flush' do 30 isz = 1 , nslay(isr) diwcg(isz) = ahrwc(isz,isr)/ ahrwcf(isz,isr) if (diwcg(isz) .gt. 1.0) diwcg(isz) = 1.0 30 continue c Calculate temperature coefficient (0. to 1.) c Stroo et al., 1989, SSSAJ 53:91-99 used in the tc function c Above ground and surface biomass tc uses avg air temp ditca = tc(awtdav) c Below ground biomass tc calculated for each soil layer c use average of max and min for calculation do 40 isz = 1, nslay(isr) c Code changed to use global hydrology soil temp variable c tsavg= (tsmax(isz) + tsmin(isz))/2. c ditcg(isz) = tc(tsavg) ditcg(isz) = tc(ahtsav(isz,isr)) 40 continue c Select minimum of temperature or water functions for c the quantity (fraction) of a decomposition day accumulated c during the current 24 hr period. c for standing flat and buried residues didds = min(diwcs,ditca) diddf = min(diwcf,ditca) do 50 isz = 1, nslay(isr) diddg(isz) = min(diwcg(isz),ditcg(isz)) 50 continue c Summation of DECOMPOSITION days for graphing c this is indexed based on the number of residue age pools c standing and below ground do 70 iage = 1,mnbpls cumdds(iage,isr) = cumdds(iage,isr) + didds do 60 isz = 1, nslay(isr) cumddg(isz,iage,isr)=cumddg(isz,iage,isr) & + diddg(isz) 60 continue 70 continue c flat residues (3 pools) do 80 iage = 1,mnbpls cumddf(iage,isr) = cumddf(iage,isr) + diddf 80 continue c flat pool 3 always accumulates ddays for graphing c even from the begining of the simulation when no residue is in the pool c this is because all non-decomposed residue ends up in this pool if (dbgflg) write(*,*) 'decomp 4' C if (flushunit(6).ne.0) write(*,*) 'error on flush' cumddf(3,isr)=cumddf(3,isr)+diddf c Decompose each age pool of residue based on decomp days accumulated in c the present 24 hr using the numerical formula for exponential decay c Mass(t) = mass(t-1) * (1 - k * dday) do 100 iage = 1,mnbpls !standing residue admst(iage,isr) = admst(iage,isr) * & (1.0-dkrate(1,iage,isr)*didds) if(admst(iage,isr) .lt. 0.0) admst(iage,isr)=0.0 do 90 isz = 1, nslay(isr) !belowground and !root residue admbgz(isz,iage,isr)=admbgz(isz,iage,isr)* & (1.0-dkrate(3,iage,isr)*diddg(isz)) if(admbgz(isz,iage,isr) .lt. 0.0) admbgz(isz,iage,isr)=0.0 admrtz(isz,iage,isr)=admrtz(isz,iage,isr)* & (1.0-dkrate(4,iage,isr)*diddg(isz)) if(admrtz(isz,iage,isr) .lt. 0.0) admrtz(isz,iage,isr)=0.0 90 continue 100 continue do 110 iage = 1,mnbpls !flat residue admf(iage,isr) = admf(iage,isr)* & (1.0-dkrate(2,iage,isr)*diddf) if(admf(iage,isr) .lt. 0.0) admf(iage,isr) = 0.0 110 continue c Change standing stem number and adjust the mass for standing c and surface biomass Steiner et al., 1994 Agronomy Journal if (dbgflg) write(*,*) 'decomp 5' C if (flushunit(6).ne.0) write(*,*) 'error on flush' do 120 iage = 1,mnbpls !check for threshold ddays value before allowing stems to decline if (cumdds(iage,isr).gt.ddsthrsh(iage,isr)) then dmsbmy(iage,isr) = admst(iage,isr) !keep current standing biomass stmnoy(iage,isr) = addstm(iage,isr) !keep current stem number if (addstm(iage,isr) .gt. 0.0) then !Calculate stem fall new stemno addstm(iage,isr) = addstm(iage,isr) & * (1.0-dkrate(5,iage,isr)* didds) !Loss of standing mass admst(iage,isr) = admst(iage,isr) & * (addstm(iage,isr)/stmnoy(iage,isr)) !Gain of flat mass admf(iage,isr) = admf(iage,isr) + & (dmsbmy(iage,isr)-admst(iage,isr)) end if end if 120 continue c Calculate surface cover due to standing and flat residues c standing stem contribution (m2/m2) do 130 iage = 1,mnbpls starea(iage,isr) = pi * ((adxstm (iage,isr)/2.)**2.) & * addstm(iage,isr) 130 continue if (dbgflg) write(*,*) 'decomp 6' hzcovstd = starea(1,isr) + starea (2,isr) + starea (3,isr) C adfscv(isr) = hzcovstd C adfscv is for each pool (at least now it is) - LEW 04/23/99 do 131 iage = 1,mnbpls adfscv(iage,isr) = starea(iage,isr) 131 continue c FLAT cover c estimated using Gregory, 1982. Trans. ASAE 25:1333-1337 c fraction (m2/m2) hzcovflt = 0. do 140 iage = 1,mnbpls covhrz(iage) = 1.0 - exp(-covfact(iage,isr)*admf(iage,isr)) hzcovflt = hzcovflt + covhrz(iage) 140 continue C adffcv(isr) = hzcovflt C adffcv is for each pool (at least now it is) - LEW 04/23/99 do 141 iage = 1,mnbpls adffcv(iage,isr) = covhrz(iage) 141 continue c write(*,*) hzcovflt, admf(1,1) c Total horizontal cover add standing stem contribution to flat cover c m2/m2 ! compute the total ground cover for each age pool do 142 iage = 1,mnbpls adftcv(iage,isr) = adfscv(iage,isr) * adffcv(iage,isr) 142 continue hzcovtot = hzcovstd + hzcovflt C Stem silhouett estimations and area divided into five vertical layers dasait = 0.0 do 150 iage = 1,mnbpls dasai(iage) = addstm(iage,isr) * stmht(iage,isr) * & adxstm (iage,isr) dasait = dasait + dasai(iage) ! put a copy of the decomp SAI in the WEPS global variable adrsai(iage,isr) = dasai(iage) ! we don't carry LAI within decomp yet adrlai(iage,isr) = 0.0 150 continue C this isn't what we want, we want them by pool - LEW c represents the 5 vertical layers do 160 iht = 1,5 sai(iht,isr) = dasait / 5. 160 continue if (dbgflg) write(*,*) 'decomp 7' c Assign values to variables in d1glob.inc c adma(h,p), admbgz (z), admf(s) c kg/m2 kg/m2 kg/ha c Total flat residue mass = sum mass from each age pool dmfbmtot = admf(1,isr) + admf(2,isr) + admf(3,isr) c Changed from adma(0,isr) to admf(iage,isr) - flat residue only by pool now C adma(0,isr)=dmfbmtot C admf is for each pool - LEW 04/23/99 C do 161 iage = 1,mnbpls C admf(iage,isr)=admf(iage,isr) C 161 continue c Above ground standing residue by layer sum mass from each age pool c and divide total mass into 5 portions dmsbmtot = admst(1,isr) + admst(2,isr) + admst(3,isr) C we don't use this - LEW 04/23/99 C do 200 iht = 1,5 C adma(iht,isr) = dmsbmtot/5. C200 continue c Total mass belowground is sum each age pool of bg and root c *TOT are reset to 0 each time because admbgz is sum for each soil layer do 220 isz = 1,nslay(isr) dmgbmtot=0.0 dmrbmtot=0.0 dmgbmtot=admbgz(isz,1,isr)+admbgz(isz,2,isr)+admbgz(isz,3,isr) dmrbmtot=admrtz(isz,1,isr)+admrtz(isz,2,isr)+admrtz(isz,3,isr) C we don't need the total below ground residue (bg + roots) c admbt(isr) = admbt(isr) + dmgbmtot + dmrbmtot 220 continue c Total aboveground biomass per hectar if (dbgflg) write(*,*) 'decomp 9' C Looks like they are totaling all residue above ground (standing and flat) C among all pools. We currently aren't carrying these values in the global C variables anymore. - LEW 04/23/99 C admres(isr) = (dmsbmtot + dmfbmtot) c Assign vlaues to variables in d1glob.inc c adrsai(s), adrsaz(h,s), adffcv(s), adfscv(s) c this section will need some evaluation for c what is needed by the erosion submodel c C We currently aren't carrying a combined SAI value which includes all C decomp pools anymore. We also don't carry that value split by height C either (that is what adrsaz used to be - it now is defined differently C and has different dimensions). - LEW 04/23/99 C adrsai(isr)=dasait C do 225 iht=1,5 C adrsaz(iht,isr)=sai(iht,isr) C 225 continue c adffcv=hzcovtot c adfscv=??????? if (dbgflg) write(*,*) 'decomp 10' if (am0ddb .eq. 1) call ddbug(isr, nslay(isr)) if ((am0dfl .eq. 1).or.(am0dfl .eq. 2).or.(am0dfl .eq.3)) * call decout return end c + + + Function tc real function tc (temp) c + + + PURPOSE + + + c c Calculate temperature coefficients for estimation of decompsition days c using the temperature of the environment the residues are in. c c Equation form is from Stroo et. al, 1989. SSSAJ 53:91-99 c we used a different optimum temperature and set the "a" value c to zero to make the minimum microbial activity corespond to 0 C c In their equation the entire value was multiplied by 1.32 to c broaden the temperature range where temperature was optimum. c We felt that this parameter should be dropped c to allow greater interacting effects of water and moisture. c c + + + DECLARATION OF ARGUMENT + + + real temp c + + + DECLARATION OF VARIABLES + + + real toptsq, tavgsq c + + + DEFINITION OF VARIABLEES AND ARGUMENTS + + + c all in degrees C c temp - temperature of air or soil layer c toptsq - optimum temperature squared c tavgsq - temp variable squared c + + + END OF SPECIFICATION + + + if (temp .lt. 0.0) then tc = 0.0 else toptsq = 32.0 * 32.0 tavgsq = temp * temp tc = (2.0*tavgsq*toptsq-tavgsq*tavgsq) / (toptsq*toptsq) endif if (tc .gt. 1.0) tc = 1.0 return end