subroutine gcurve(sdate,iplane,plant,iwarn,ifrost,t2,rgc,plive, 1 growth) c c + + + PURPOSE + + + c Estimates the amount of leaf biomass accrued today (GROWTH). c If a killing frost occurs, resets peak live plant biomass to c zero. c c GCURVE assumes a bell-shaped growth curve. The curve's falling c side is not required to be symetric to its rising side. GCURVE c models a bi-modal growth curve if requested, following the E-RHYME (sp?) c model's approach. This involves overlaying two bell-shaped c curves in the appropriate phase. The value of CF1 represents c the fraction of the season spent in the first growth period c (represented by the first curve). If CF1 is less than one, a c bi-modal curve is generated. c c NOTE: Since CS2 is always (1 - CF1), it can be eliminated from c GCURVE. This is a user input, and is used nowhere else c in the model, so CF2 can also be eliminated from common c block CLIM. Re: 2/9/93 telcon w/Weltz -- CRM -- 2/9/93. c c NOTE: PLANT is set to ITYPE(NOWCRP,IPLANE) in RANGE. It should c probably be changed to NOWCRP, and ITYPE(NOWCRP,IPLANE) c used in its place in RANGE. -- CRM -- 2/9/93. c c Called from RANGE c Author(s): Weltz, Meyer c Reference in User Guide: Chapter 8 c Also see: paper by Innis & Parton, CSU, c on mathematics used in E-RHYME c model. (Weltz will supply.) c c Changes: c 1) Introduced TMPVR1, TMPVR2, TMPVR3, & TMPVR4. c 2) Eliminated variable CF2. c 3) Eliminated local variable SHAPER. c 4) The code: c if(pscday(plant) .gt. (strrgc(plant)+t1-10.0)) then c pscday(plant) = pscday(plant) - 10.0 c changed to: c if(pscday(plant) .gt. (strrgc(plant)+t1*0.75)) then c pscday(plant) = strrgc(plant)+t1*0.75 c This eliminates the possibility that the growth peak c will occur after the growing season. RE: 3/16/93 telcon c w/Mark Weltz. c 5) Moved the 4th parameter to the 7th place to conform to c WEPP Coding Convention. c 6) Dimensioned SPRED & SPRED2 to MXCROP, since they are c only computed once, on the first day of growth, and c added include for PMXCRP.INC. c 7) Added RGC to list of parameters. RANGE prints it, so c it needs to receive it's value. RE: telcon w/Weltz c 3/23/93. c 8) Moved shape2 and prgc(mxplan) to common block crinpt2.inc c jca2 8/31/93 c c Version: This module recoded from WEPP Version 92.25. c Date recoded: 02/08/93 - 3/17/93. c Recoded by: Charles R. Meyer. c c + + + KEYWORDS + + + c c + + + PARAMETERS + + + include 'pmxhil.inc' include 'pmxpln.inc' include 'pntype.inc' include 'pmxcrp.inc' c c + + + ARGUMENT DECLARATIONS + + + real t2, rgc, plive, growth integer sdate, iplane, plant, iwarn, ifrost c c + + + ARGUMENT DEFINITIONS + + + c t2 - number of days in second growth period. c rgc - fraction of leaf biomass that has accrued to date for c first growing period. c plive - peak standing live plant plant biomass. c growth - amount of leaf biomass accrued today c sdate - current Julian date c iplane - current OFE c plant - set to ITYPE(NOWCRP,IPLANE) -- Should probably be changed. c iwarn - flag. 0=no warning generated by GCURVE this simulation year c ifrost - flag. 1=killing frost has occurred. c c + + + COMMON BLOCKS + + + include 'cclim.inc' c read: cf1, gtemp, tempmn(ntype), ffp(ntype) c modify: pscday(ntype), strrgc(ntype), cshape(ntype), dshape(ntype), c scday2(ntype), strgc2(ntype), eshape(ntype), fshape(ntype) c include 'crinpt2.inc' c read tmnavg c c + + + LOCAL VARIABLES + + + real spred(mxcrop), spred2(mxcrop), rgc2, t1, groper, ratioc, 1 ratiod, ratioe, ratiof, ex, tmpvr1, tmpvr2, tmpvr3, tmpvr4 c + + + LOCAL DEFINITIONS + + + c spred - growing days required to reach peak standing crop for c first growing period. c spred2 - growing days required to reach peak standing crop for c second growing period. c rgc2 - fraction of leaf biomass that has accrued to date for c second growing period. c t1 - days in first growth period c groper - days from start of growth period to today c ratioc - constant for rising side of first growth peak c ratiod - constant for falling side of first growth peak c ratioe - constant for rising side of second growth peak c ratiof - constant for falling side of second growth peak c ex - constant used to calculate RGC & RGC2. c c + + + SAVES + + + save spred, spred2 c c + + + DATA INITIALIZATIONS + + + c c + + + OUTPUT FORMATS + + + c c + + + END SPECIFICATIONS + + + c c c c Estimate plant growth with relative growth curve c c c *** L0 IF *** c (EXECUTED ONLY ON FIRST DAY OF GROWTH) c ---- Find first day of growth. If growth hasn't begun (STRRGC = zero), c and if temp. is now adequate, start growth (set STRRGC = current date). if ((strrgc(plant).le.0.0).and.(tmnavg.ge.gtemp(plant))) then strrgc(plant) = sdate c c ***************************************************** c * calculate coefficients for first growing season * c ***************************************************** c c ------ If the growing season ENDS before the day of peak growth, c set day of peak growth to middle of growing season. if (strrgc(plant)+ffp(plant).le.pscday(plant)) then pscday(plant) = strrgc(plant) + ffp(plant) / 2.0 c ------ Warn user. write (6,1000) pscday(plant) end if c c ------ days in 1st growing period c (WEPP Equation 8.5.5a) c Original Code: c (Changed because CF1 + CF2 = 1.) c t1 = (cf1(plant)*ffp(plant)) / (cf1(plant)+cf2(plant)) t1 = (cf1(plant)*ffp(plant)) c c ------ If growth peak is later than 75 percent of the way through the c growing season, set it there. if (pscday(plant).gt.(strrgc(plant)+t1*0.75)) then pscday(plant) = strrgc(plant) + t1 * 0.75 c ------ Warn user. write (6,1100) pscday(plant) end if c c ------ growing days required to reach peak standing crop (1st curve) c (WEPP Equation 8.5.5a) spred(plant) = pscday(plant) - strrgc(plant) c c ------ ratio: days_to_peak_1 / days_in_period_1 tmpvr1 = spred(plant) / t1 c ------ rising side of 1st curve c (WEPP Equation 8.5.4) cshape(plant) = 8.515 - 22.279 * tmpvr1 + 16.734 * tmpvr1 ** 2 c ------ descending side of 1st curve c (WEPP Equation 8.5.5) dshape(plant) = 12.605 - 63.229 * tmpvr1 + 87.93 * tmpvr1 ** 2 c c ****************************************************** c * calculate coefficients for second growing season * c ****************************************************** c if (cf1(plant).lt.1.0) then c -------- days in 2nd growing period c (WEPP Equation 8.5.10) t2 = ffp(plant) - t1 c -------- If the 2nd peak occurs before the second growth period starts... if (scday2(plant).le.strrgc(plant)+t1) then c ---------- growing days required to reach peak standing crop (2nd curve) scday2(plant) = strrgc(plant) + t1 + (0.5*t2) c ---------- Warn user. write (6,1200) scday2(plant) end if c c set begining of second growing season c c (WEPP Equation 8.5.10) strgc2(plant) = t1 + strrgc(plant) c -------- growing days required to reach peak standing crop (2nd curve) c (WEPP Equation 8.5.10) spred2(plant) = scday2(plant) - strgc2(plant) c -------- ratio: days_to_peak_2 / days_in_period_2 tmpvr2 = spred2(plant) / t2 c -------- rising side of 2nd curve c (WEPP Equation 8.5.4) eshape(plant) = 8.515 - 22.279 * tmpvr2 + 16.794 * tmpvr2 ** 2 c -------- descending side of 2nd curve c (WEPP Equation 8.5.5) fshape(plant) = 12.605 - 63.229 * tmpvr2 + 87.93 * tmpvr2 ** 2 shape2 = eshape(plant) / fshape(plant) end if c c *** L0 ENDIF *** end if c c c If the user does not want any plant growth at all to occur c (indicated by input of non-positive PSCDAY), the following c code will prevent any growth from occuring. c if (pscday(plant).le.0.) then strrgc(plant) = 0.0 plive = 0.0 pscday(plant) = 0.0 end if c c c -- XXX -- Perhaps this could be included in the L0-loop, and IWARN c would not be needed. -- CRM -- 3/17/93. c ---- warn user if growth peak occurs before growth season if ((iwarn.lt.1).and.(pscday(plant).lt.strrgc(plant))) then write (6,1300) pscday(plant) iwarn = iwarn + 1 end if c c c (THE REMAINING CODE IS EXECUTED EACH TIME "GCURVE" IS CALLED.) c c ---- If avg. temp. is below minimum for this plant, and it is after c the day of peak growth, assume there has been a killing frost. if (tmnavg.le.tempmn(plant).and.sdate.gt.pscday(plant)) ifrost = 1 c c c ************************************************************** c * Calculate single relative growth curve if temperature OK * c ************************************************************** c c *** M0 IF *** c ---- If growth has started; ie, temperature is adequate.... if (strrgc(plant).gt.0) then c c *** M1 IF *** c If there has NOT been a killing frost.... if (ifrost.eq.0) then c -------- growth days so far groper = sdate - strrgc(plant) if (groper.lt.0.0) groper = 0.0 if (cshape(plant).gt.15.0) cshape(plant) = 15.0 if (dshape(plant).gt.15.0) dshape(plant) = 15.0 if (cshape(plant).lt.0.7) cshape(plant) = 0.7 if (dshape(plant).lt.0.7) dshape(plant) = 0.7 c c -------- fraction of days completed to peak tmpvr3 = groper / spred(plant) if (tmpvr3.gt.0.0) then c (WEPP Equation 8.5.3) ratiod = tmpvr3 ** dshape(plant) c (WEPP Equation 8.5.2) ratioc = tmpvr3 ** cshape(plant) else ratiod = 0.0 ratioc = 0.0 end if c c -------- Unimodal Potential Growth Curve c (WEPP Equation 8.5.1) ex = cshape(plant) / dshape(plant) * (1.0-ratiod) if (ex.lt.-30.0) ex = -30.0 rgc = ratioc * exp(ex) * cf1(plant) c c *** M2 IF *** c Calculate bimodal relative growth curve if requested. if (t2.gt.1) then c -------- growth days so far in second growth period groper = sdate - strgc2(plant) if (groper.lt.0.) groper = 0.0 if (eshape(plant).gt.15.0) eshape(plant) = 15.0 if (fshape(plant).gt.15.0) fshape(plant) = 15.0 if (eshape(plant).lt.0.70) eshape(plant) = 0.70 if (fshape(plant).lt.0.70) fshape(plant) = 0.70 c c -------- fraction of days completed to peak of second growth period tmpvr4 = groper / spred2(plant) if (tmpvr4.gt.0.0) then c (WEPP Equation 8.5.2) ratioe = tmpvr4 ** eshape(plant) c (WEPP Equation 8.5.3) ratiof = tmpvr4 ** fshape(plant) else ratioe = 0.0 ratiof = 0.0 end if c c (WEPP Equation 8.5.1) ex = shape2 * (1.0-ratiof) if (ex.lt.-30.0) ex = -30.0 c (WEPP Equation 8.5.1) rgc2 = ratioe * exp(ex) * (1.0-cf1(plant)) if (rgc.lt.rgc2) rgc = rgc2 c c *** M2 ENDIF *** end if c c *** M1 ELSE *** c If there has been a killing frost.... else rgc = 0.0 prgc(iplane) = 0.0 c c *** M1 ENDIF *** end if c c *** M0 ENDIF *** end if c growth = rgc - prgc(iplane) prgc(iplane) = rgc c return 1000 format (/,' *** WARNING ***',' first peak (pscday) outside frost', 1 'free period.',/,' the model recalculated pscday.',f6.1,/, 1 ' *** WARNING ***',/) 1100 format (/,' *** WARNING ***',' first peak (pscday) is outside', 1 ' the first growing period.',/ 1 ' the model recalculated (pscday) =',f6.1,/, 1 ' *** WARNING ***',/) 1200 format (/,' *** ERROR ***',/,' second peak (scday2) too early.',/ 1 ' the model calculated a new value for scday2.',f6.1,/, 1 ' *** ERROR ***',/) 1300 format (/,' *** WARNING ***',/' warning: strrgc is greater than' 1 ' pscday. No plant growth will occur.',/ 1 ' reason maybe gtemp is too high or',' pscday is too small.', 1 f6.1,/,' *** WARNING ***',/) end