diff --git a/src/clm5/biogeochem/CNNDynamicsMod.F90 b/src/clm5/biogeochem/CNNDynamicsMod.F90 index b8796912a2..6fab2c247a 100644 --- a/src/clm5/biogeochem/CNNDynamicsMod.F90 +++ b/src/clm5/biogeochem/CNNDynamicsMod.F90 @@ -304,7 +304,7 @@ subroutine CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & ! ! !USES: use pftconMod, only : ntmp_soybean, nirrig_tmp_soybean - use pftconMod, only : ntrp_soybean, nirrig_trp_soybean + !use pftconMod, only : ntrp_soybean, nirrig_trp_soybean ! ! !ARGUMENTS: type(bounds_type) , intent(in) :: bounds @@ -362,9 +362,9 @@ subroutine CNSoyfix (bounds, num_soilc, filter_soilc, num_soilp, filter_soilp, & if (croplive(p) .and. & (patch%itype(p) == ntmp_soybean .or. & - patch%itype(p) == nirrig_tmp_soybean .or. & - patch%itype(p) == ntrp_soybean .or. & - patch%itype(p) == nirrig_trp_soybean) ) then + patch%itype(p) == nirrig_tmp_soybean)) then !.or. & + !patch%itype(p) == ntrp_soybean .or. & + !patch%itype(p) == nirrig_trp_soybean) ) then ! difference between supply and demand diff --git a/src/clm5/biogeochem/CNPhenologyMod.F90 b/src/clm5/biogeochem/CNPhenologyMod.F90 index 9d66373085..35ab02da01 100644 --- a/src/clm5/biogeochem/CNPhenologyMod.F90 +++ b/src/clm5/biogeochem/CNPhenologyMod.F90 @@ -1430,9 +1430,22 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & use clm_time_manager , only : get_curr_date, get_curr_calday, get_days_per_year, get_rad_step_size use pftconMod , only : ntmp_corn, nswheat, nwwheat, ntmp_soybean use pftconMod , only : nirrig_tmp_corn, nirrig_swheat, nirrig_wwheat, nirrig_tmp_soybean - use pftconMod , only : ntrp_corn, nsugarcane, ntrp_soybean, ncotton, nrice - use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane, nirrig_trp_soybean + use pftconMod , only : ntrp_corn, nsugarcane, ncotton, nrice + use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane use pftconMod , only : nirrig_cotton, nirrig_rice + use pftconMod , only : nbarley, nwbarley, nrye, nwrye, ncassava + use pftconMod , only : nirrig_barley, nirrig_wbarley, nirrig_rye, nirrig_wrye, nirrig_cassava + use pftconMod , only : ncitrus, ncocoa, ncoffee, ncotton, ndatepalm + use pftconMod , only : nirrig_citrus, nirrig_cocoa, nirrig_coffee, nirrig_cotton, nirrig_datepalm + use pftconMod , only : nfoddergrass, ngrapes, ngroundnuts, nmillet + use pftconMod , only : nirrig_foddergrass, nirrig_grapes, nirrig_groundnuts, nirrig_millet + use pftconMod , only : noilpalm, npotatoes, npulses, nrapeseed + use pftconMod , only : nirrig_oilpalm, nirrig_potatoes, nirrig_pulses, nirrig_rapeseed + use pftconMod , only : nrice, nsorghum, nsugarbeet, nsunflower + use pftconMod , only : nirrig_rice, nirrig_sorghum, nirrig_sugarbeet, nirrig_sunflower + use pftconMod , only : nmiscanthus, nswitchgrass, nc3crop + use pftconMod , only : nirrig_miscanthus, nirrig_switchgrass, nc3irrig + use pftconMod , only : ncovercrop_1, ncovercrop_2 use clm_varcon , only : spval, secspday use clm_varctl , only : use_fertilizer use clm_varctl , only : use_c13, use_c14 @@ -1483,6 +1496,7 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & hybgdd => pftcon%hybgdd , & ! Input: lfemerg => pftcon%lfemerg , & ! Input: grnfill => pftcon%grnfill , & ! Input: + covercrop => pftcon%covercrop , & ! Input: covercrop flag t_ref2m_min => temperature_inst%t_ref2m_min_patch , & ! Input: [real(r8) (:) ] daily minimum of average 2 m height surface air temperature (K) t10 => temperature_inst%t_a10_patch , & ! Input: [real(r8) (:) ] 10-day running mean of the 2 m temperature (K) @@ -1519,14 +1533,28 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & leafc_xfer => cnveg_carbonstate_inst%leafc_xfer_patch , & ! Output: [real(r8) (:) ] (gC/m2) leaf C transfer crop_seedc_to_leaf => cnveg_carbonflux_inst%crop_seedc_to_leaf_patch, & ! Output: [real(r8) (:) ] (gC/m2/s) seed source to leaf + frootc_xfer => cnveg_carbonstate_inst%frootc_xfer_patch , & ! Input: [real(r8) (:) ] (gC/m2) fine root C transfer + frootn_xfer => cnveg_nitrogenstate_inst%frootn_xfer_patch , & ! Input: [real(r8) (:) ] (gN/m2) fine root N transfer + frootcn => pftcon%frootcn , & ! Input: fine root C:N (gC/gN) fert_counter => cnveg_nitrogenflux_inst%fert_counter_patch , & ! Output: [real(r8) (:) ] >0 fertilize; <=0 not (seconds) leafn_xfer => cnveg_nitrogenstate_inst%leafn_xfer_patch , & ! Output: [real(r8) (:) ] (gN/m2) leaf N transfer crop_seedn_to_leaf => cnveg_nitrogenflux_inst%crop_seedn_to_leaf_patch, & ! Output: [real(r8) (:) ] (gN/m2/s) seed source to leaf cphase => crop_inst%cphase_patch , & ! Output: [real(r8) (:)] phenology phase - fert => cnveg_nitrogenflux_inst%fert_patch & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + fert => cnveg_nitrogenflux_inst%fert_patch , & ! Output: [real(r8) (:) ] (gN/m2/s) fertilizer applied each timestep + lt50 => crop_inst%lt50_patch , & ! Output: [real(r8) (:)] the lethal temperature at which 50% of the individuals are damaged + wdd => crop_inst%wdd_patch , & ! Output: [real(r8) (:)] winter wheat weighted cumulated degree days + rateh => crop_inst%rateh_patch , & ! Output: [real(r8) (:)] increaseof tolerance cuased byhardening + rated => crop_inst%rated_patch , & ! Output: [real(r8) (:)] loss of tolerance cause by dehardening + rates => crop_inst%rates_patch , & ! Output: [real(r8) (:)] loss of tolerance caused by low tempeature + rater => crop_inst%rater_patch , & ! Output: [real(r8) (:)] loss of tolerance caused by respiration under snow + fsurv => crop_inst%fsurv_patch , & ! Output: [real(r8) (:)] winter wheat survival rate + accfsurv => crop_inst%accfsurv_patch , & ! Output: [real(r8) (:)] accumulated winter wheat survival rate + countfsurv => crop_inst%countfsurv_patch & ! Output: [real(r8) (:)] numbers of accumulated winter wheat survival rate ) + !variables for coldtolerance subroutine modified after Lu (2017) (tboas) + ! get time info dayspyr = get_days_per_year() jday = get_curr_calday() @@ -1576,14 +1604,27 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! if we removed elseif, ! winter cereal grown continuously would amount to a cereal/fallow ! rotation because cereal would only be planted every other year - - else if (croplive(p) .and. (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then - cropplant(p) = .false. + ! (tboas) here, this only prevents the crop to be killed on the + ! first day of a new year and still results in a cereal-fallow + ! rotation + + else if (croplive(p) .and. (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed)) then + cropplant(p) = .true. ! else ! not possible to have croplive and ivt==cornORsoy? (slevis) end if end if + !(tboas) try to avaoid cereral/fallow rotation + if (.not. croplive(p) .and. jday >= 170._r8 .and. & + (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then + cropplant(p) = .false. + idop(p) = NOT_Planted + end if + if ( (.not. croplive(p)) .and. (.not. cropplant(p)) ) then ! gdd needed for * chosen crop and a likely hybrid (for that region) * @@ -1603,7 +1644,10 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! winter temperate cereal : use gdd0 as a limit to plant winter cereal - if (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat) then + if (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed) then ! add check to only plant winter cereal after other crops (soybean, maize) ! have been harvested @@ -1625,10 +1669,20 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & jday >= minplantjday(ivt(p),h) .and. & (gdd020(p) /= spval .and. & gdd020(p) >= gddmin(ivt(p)))) then - + write (iulog,*) 'planting winter crop' cumvd(p) = 0._r8 hdidx(p) = 0._r8 vf(p) = 0._r8 + !coldtolerance parameters modified after Lu (2017) (tboas) + lt50(p) = -5._r8 + wdd(p) = 0._r8 + rateh(p) = 0._r8 + rated(p) = 0._r8 + rater(p) = 0._r8 + rates(p) = 0._r8 + fsurv(p) = 1._r8 + accfsurv(p) = 1._r8 + countfsurv(p) = 1._r8 croplive(p) = .true. cropplant(p) = .true. idop(p) = jday @@ -1636,8 +1690,11 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & gddmaturity(p) = hybgdd(ivt(p)) leafc_xfer(p) = initial_seed_at_planting leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset - crop_seedc_to_leaf(p) = leafc_xfer(p)/dt - crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + frootc_xfer(p) = 0.1_r8 + frootn_xfer(p) = frootc_xfer(p) / frootcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + frootc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + frootn_xfer(p)/dt + ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise @@ -1664,10 +1721,20 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & else if (jday >= maxplantjday(ivt(p),h) .and. & gdd020(p) /= spval .and. & gdd020(p) >= gddmin(ivt(p))) then - + write (iulog,*) 'planting winter crop' cumvd(p) = 0._r8 hdidx(p) = 0._r8 vf(p) = 0._r8 + ! coldtolerance mod. after Lu (2017) (tboas) + rateh(p) = 0._r8 + rated(p) = 0._r8 + rater(p) = 0._r8 + rates(p) = 0._r8 + fsurv(p) = 1._r8 + accfsurv(p) = 1._r8 + countfsurv(p) = 1._r8 + lt50(p) = -5._r8 + wdd(p) = 0._r8 croplive(p) = .true. cropplant(p) = .true. idop(p) = jday @@ -1675,8 +1742,10 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & gddmaturity(p) = hybgdd(ivt(p)) leafc_xfer(p) = initial_seed_at_planting leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) ! with onset - crop_seedc_to_leaf(p) = leafc_xfer(p)/dt - crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + frootc_xfer(p) = 0.1_r8 + frootn_xfer(p) = frootc_xfer(p) / frootcn(ivt(p)) ! with onset + crop_seedc_to_leaf(p) = leafc_xfer(p)/dt + frootc_xfer(p)/dt + crop_seedn_to_leaf(p) = leafn_xfer(p)/dt + frootn_xfer(p)/dt ! because leafc_xfer is set above rather than incremneted through the normal process, must also set its isotope ! pools here. use totvegc_patch as the closest analogue if nonzero, and use initial value otherwise @@ -1721,10 +1790,10 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! go a specified amount of time before/after ! climatological date - if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & - ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then - gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) - end if + !if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & + ! ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + ! gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) + !end if if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & ivt(p) == ntrp_corn .or. ivt(p) == nirrig_trp_corn .or. & ivt(p) == nsugarcane .or. ivt(p) == nirrig_sugarcane) then @@ -1732,6 +1801,8 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & gddmaturity(p) = max(950._r8, min(gddmaturity(p)+150._r8, 1850._r8)) end if if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == nsugarbeet .or. ivt(p) == nirrig_sugarbeet .or. & + ivt(p) == npotatoes .or. ivt(p) == nirrig_potatoes .or. & ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & ivt(p) == nrice .or. ivt(p) == nirrig_rice) then gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) @@ -1770,8 +1841,8 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & idop(p) = jday harvdate(p) = NOT_Harvested - if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean .or. & - ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then + if (ivt(p) == ntmp_soybean .or. ivt(p) == nirrig_tmp_soybean) then !.or. & + !ivt(p) == ntrp_soybean .or. ivt(p) == nirrig_trp_soybean) then gddmaturity(p) = min(gdd1020(p), hybgdd(ivt(p))) end if if (ivt(p) == ntmp_corn .or. ivt(p) == nirrig_tmp_corn .or. & @@ -1780,6 +1851,8 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & gddmaturity(p) = max(950._r8, min(gdd820(p)*0.85_r8, hybgdd(ivt(p)))) end if if (ivt(p) == nswheat .or. ivt(p) == nirrig_swheat .or. & + ivt(p) == nsugarbeet .or. ivt(p) == nirrig_sugarbeet .or. & + ivt(p) == npotatoes .or. ivt(p) == nirrig_potatoes .or. & ivt(p) == ncotton .or. ivt(p) == nirrig_cotton .or. & ivt(p) == nrice .or. ivt(p) == nirrig_rice) then gddmaturity(p) = min(gdd020(p), hybgdd(ivt(p))) @@ -1902,17 +1975,46 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & if (croplive(p)) then cphase(p) = 1._r8 + ! old vernalization routine inactive + ! call vernalization if winter temperate cereal planted, living, and the ! vernalization factor is not 1; ! vf affects the calculation of gddtsoi & gddplant - if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. & - (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat)) then - call vernalization(p, & - canopystate_inst, temperature_inst, waterstate_inst, cnveg_state_inst, & - crop_inst) + !if (t_ref2m_min(p) < 1.e30_r8 .and. vf(p) /= 1._r8 .and. & + ! (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ! ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ! ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ! ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed)) then + ! write (iulog,*) 'call vernalization old' + ! call vernalization(p, & + ! canopystate_inst, temperature_inst, waterstate_inst, cnveg_state_inst, & + ! crop_inst) + !end if + + !new vernalization routine + if (vf(p) /= 1._r8 .and. & + (ivt(p) == nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed)) then + call vernalization_2(p, & + temperature_inst, waterstate_inst, cnveg_state_inst, & + crop_inst, cnveg_carbonflux_inst) end if + ! call cold tolerance in cphase 2 + ! if (ivt(p)== nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ! ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ! ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ! ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed) then + ! call coldtolerance(p,canopystate_inst,temperature_inst, & + ! waterstate_inst,cnveg_state_inst, crop_inst, & + ! cnveg_nitrogenflux_inst, cnveg_carbonflux_inst, & + ! cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + ! end if + + ! days past planting may determine harvest if (jday >= idop(p)) then @@ -1935,6 +2037,17 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & if (leafout(p) >= huileaf(p) .and. hui(p) < huigrain(p) .and. idpp < mxmat(ivt(p))) then cphase(p) = 2._r8 + + if (ivt(p)==nwwheat .or. ivt(p) == nirrig_wwheat .or. & + ivt(p) == ncovercrop_1 .or. ivt(p) == ncovercrop_2 .or. & + ivt(p) == nwbarley .or. ivt(p) == nirrig_wbarley .or. & + ivt(p) == nrapeseed .or. ivt(p) == nirrig_rapeseed) then + call coldtolerance(p,canopystate_inst,temperature_inst, & + waterstate_inst,cnveg_state_inst, crop_inst, & + cnveg_nitrogenflux_inst, cnveg_carbonflux_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + end if + if (abs(onset_counter(p)) > 1.e-6_r8) then onset_flag(p) = 1._r8 onset_counter(p) = dt @@ -1960,10 +2073,17 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! changes to the offset subroutine below else if (hui(p) >= gddmaturity(p) .or. idpp >= mxmat(ivt(p))) then - if (harvdate(p) >= NOT_Harvested) harvdate(p) = jday - croplive(p) = .false. ! no re-entry in greater if-block - cphase(p) = 4._r8 + if (harvdate(p) >= NOT_Harvested)then + harvdate(p) = jday + if (covercrop(ivt(p)) == 1) then + call covercropping(p, crop_inst, cnveg_state_inst) + else + croplive(p) = .false. ! no re-entry in greater if-block + cphase(p) = 4._r8 + end if + endif if (tlai(p) > 0._r8) then ! plant had emerged before harvest + write (iulog,*) 'plant emerged' offset_flag(p) = 1._r8 offset_counter(p) = dt else ! plant never emerged from the ground @@ -1972,10 +2092,13 @@ subroutine CropPhenology(num_pcropp, filter_pcropp , & ! crop_seedn_to_leaf in the unlikely event that we enter this block of ! code in the same time step where the planting transfer originally ! occurred. + !write (iulog,*) 'plant not emerged' crop_seedc_to_leaf(p) = crop_seedc_to_leaf(p) - leafc_xfer(p)/dt crop_seedn_to_leaf(p) = crop_seedn_to_leaf(p) - leafn_xfer(p)/dt leafc_xfer(p) = 0._r8 leafn_xfer(p) = leafc_xfer(p) / leafcn(ivt(p)) + frootc_xfer(p) = 0._r8 + frootn_xfer(p) = 0._r8 !frootc_xfer(p) / frootcn((ivt)p) ! with onset if (use_c13) then c13_cnveg_carbonstate_inst%leafc_xfer_patch(p) = 0._r8 endif @@ -2096,6 +2219,97 @@ subroutine CropPhenologyInit(bounds) end subroutine CropPhenologyInit + !----------------------------------------------------------------------- + subroutine covercropping(p, crop_inst, cnveg_state_inst) + + ! + ! !DESCRIPTION: + ! !Covercropping subroutine allows second onset of phenology for cover crop after harvest of cash crops and immediate rotation to winter cash crop following a summer cash crop + ! * * * only call when covercrop(ivt(p)) == 1 * * * + ! + ! + + ! !USES: + use pftconMod , only : ntmp_corn, nswheat,nwwheat,ntmp_soybean,nbarley, nwbarley, nrye, nwrye, ncassava, ncitrus, ncocoa,ncoffee,ncotton,ndatepalm, nfoddergrass, ngrapes, ngroundnuts, nmillet,noilpalm,npotatoes,npulses, nrapeseed, nrice, nsorghum, nsugarbeet,nsunflower,nmiscanthus,nswitchgrass, nc3crop, ncovercrop_1, ncovercrop_2 + use pftconMod , only : nirrig_tmp_corn,nirrig_swheat,nirrig_wwheat,nirrig_tmp_soybean, nirrig_barley, nirrig_wbarley,nirrig_rye,nirrig_wrye,nirrig_cassava, nirrig_citrus, nirrig_cocoa,nirrig_coffee,nirrig_cotton,nirrig_datepalm, nirrig_foddergrass,nirrig_grapes,nirrig_groundnuts,nirrig_millet, nirrig_oilpalm, nirrig_potatoes,nirrig_pulses,nirrig_rapeseed,nirrig_rice, nirrig_sorghum,nirrig_sugarbeet,nirrig_sunflower,nirrig_miscanthus, nirrig_switchgrass,nc3irrig + use pftconMod , only : ntrp_corn, nsugarcane, ncotton, nrice + use pftconMod , only : nirrig_trp_corn, nirrig_sugarcane + use pftconMod , only : nirrig_cotton, nirrig_rice + use clm_varctl , only : use_grainproduct + use clm_time_manager, only: get_curr_calday + + ! !ARGUMENTS: + integer , intent(in) :: p ! PATCH index running over + type(crop_type) , intent(inout) :: crop_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + + ! + ! LOCAL VARAIBLES: + integer jday ! julian day of the year + integer cashcrop1 ! first cash crop in rotation cycle + integer cashcrop2 ! second cash crop in rotation cycle + integer covercrop1 ! first cover crop in rotation cycle + integer covercrop2 ! second cover crop in rotation cycle + !! list can be extended + + !------------------------------------------------------------------------ + + associate( & + ivt => patch%itype ,& ! Input:[integer (:) ] patch vegetation type + cphase => crop_inst%cphase_patch ,& ! Output:[real(r8) (:)] phenology phase + idop => cnveg_state_inst%idop_patch ,& ! Output:[integer (:) ] date of planting + croplive => crop_inst%croplive_patch ,& ! Output:[logical (:) ] Flag, true if planted, not harvested + cropplant => crop_inst%cropplant_patch ,& ! Output:[logical (:) ] Flag, true if crop may be planted + harvdate => crop_inst%harvdate_patch & ! Output:[integer (:) ] harvest date + ) + + jday = get_curr_calday() + ! add read in function from .txt file for flexible variable setting + ! define crop rotation: variable assignment can be changes and list can be extended + cashcrop1 = nswheat + cashcrop2 = nsugarbeet + covercrop1 = ncovercrop_1 + covercrop2 = ncovercrop_2 + + if (harvdate(p) >= 150._r8 .and. ivt(p) == cashcrop1) then + ivt(p)= covercrop1 + ! write (iulog,*) 'cft changed to covercrop' + croplive(p) = .false. + cropplant(p) = .false. + idop(p) = NOT_Planted + use_grainproduct = .false. + + else if (harvdate(p) <= 170._r8 .and. ivt(p) == covercrop1) then + ivt(p)= cashcrop2 + ! write (iulog,*) 'cft changed to cashcrop2' + croplive(p) = .false. + cropplant(p) = .false. + idop(p) = NOT_Planted + use_grainproduct = .true. + + else if (harvdate(p) >= 150._r8 .and. ivt(p) == cashcrop2) then + ivt(p)= covercrop2 + ! write (iulog,*) 'cft changed to covercrop2' + croplive(p) = .false. + cropplant(p) = .false. + idop(p) = NOT_Planted + use_grainproduct = .false. + + else if (harvdate(p) <= 170._r8 .and. ivt(p) == covercrop2) then + ivt(p)= cashcrop1 + ! write (iulog,*) 'cft changed back to cashcrop1 - beginning of next + ! rotatoin cycle' + croplive(p) = .false. + cropplant(p) = .false. + idop(p) = NOT_Planted + use_grainproduct = .true. + + end if + + end associate + + end subroutine covercropping + !----------------------------------------------------------------------- subroutine vernalization(p, & canopystate_inst, temperature_inst, waterstate_inst, cnveg_state_inst, crop_inst) @@ -2173,9 +2387,11 @@ subroutine vernalization(p, & cumvd(p) = cumvd(p) - 0.5_r8 * (t_ref2m_max(p) - tfrz - 30._r8) end if cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + write(iulog,*)'vernalization_old cumvd(p)=', cumvd(p) vf(p) = 1._r8 - p1v * (50._r8 - cumvd(p)) vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + write(iulog,*)'vernalization_old vf(p)=', vf(p) end if ! calculate cold hardening of plant @@ -2239,6 +2455,250 @@ subroutine vernalization(p, & end subroutine vernalization + !----------------------------------------------------------------------- + subroutine vernalization_2(p, & + temperature_inst, waterstate_inst, cnveg_state_inst, crop_inst, cnveg_carbonflux_inst) + + ! + ! !DESCRIPTION: + ! !Alternative vernalization routine tranfered from CLM 4.5 after Lu et al. (2017) (tboas) + ! * * * only call for winter temperate cereal * * * + ! + ! subroutine calculates vernalization and photoperiod effects on + ! gdd accumulation in winter temperate cereal varieties. Thermal time + ! accumulation is reduced in 1st period until plant is fully vernalized. + ! During this time of emergence to spikelet formation, photoperiod can also have a + ! drastic effect on plant development. + + use clm_time_manager, only: get_step_size,get_curr_date + + ! + ! !ARGUMENTS: + integer , intent(in) :: p ! PATCH index running over + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(inout) :: crop_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + + + ! + ! LOCAL VARAIBLES: + real(r8) vd, vd1, vd2 ! vernalization dependence + real(r8) vtmin,vtopt,vtmax ! vernalization minimum, optimum, maximumtemperature + real(r8) alpha ! parameter in calculating vernalization rate + real(r8) tc ! t_ref2m in degree C + !real(r8) tcrown ! ? + integer c ! column indices + integer g ! gridcell indices + real(r8) dt ! land model time step (sec) + real(r8) dtime ! convert dt from sec to hour + + associate( & + ivt => patch%itype , & ! Input: [integer (:)] pft vegetation type + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:)] cumulative vernalization d?ependence? + vf => crop_inst%vf_patch , & ! Output: [real(r8) (:)] vernalization factor for cereal + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:)] 2 m height surface air temperature (K) + tcrown => crop_inst%tcrown_patch , & ! Output: [real(r8) (:)] crown temperature + snow_depth => waterstate_inst%snow_depth_col , & ! Input: [real(r8) (:)] snow height (m) + hui => crop_inst%gddplant_patch , & ! Input: [real(r8) (:) ] gdd since planting (gddplant) + leafout => crop_inst%gddtsoi_patch , & ! Input: [real(r8) (:) ] gdd from top soil layer temperature + cpool_to_grainc => cnveg_carbonflux_inst%cpool_to_grainc_patch & ! Input: [real(r8) (:) ] allocation to grain C (gC/m2/s) + ) + + c = patch%column(p) + dt=real( get_step_size(), r8 ) + + if (t_ref2m(p) < tfrz) then + tcrown(p) = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snow_depth(c)*100._r8, 15._r8) - 15._r8)**2) + else + tcrown(p) = t_ref2m(p) - tfrz + end if + + ! write (iulog,*) 'subroutine vernalization_2' + + ! Vernalization factor calculation + ! if vf(p) = 1. then plant is fully vernalized - and thermal time + ! accumulation in phase 1 will be unaffected + ! refers to gddtsoi & gddplant, defined in the accumulation routines (slevis) + ! reset vf, cumvd, and hdidx to 0 at planting of crop (slevis) + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + ! ylu modified the vernalization function 10/16/15 + ! A generalized vernalization response function for winter wheat (Streck et al.,2003) was used here + ! Streck, N.A., Weiss, A., Baenziger, P.S., 2003. A generalized vernalization response & + ! function for winter wheat. Agron. J. 95 + + vtmin=-1.3_r8 + vtopt=4.9_r8 + vtmax=15.7_r8 + dtime=dt/3600.0_r8 !dtime is the time step in hour + + alpha=log(2._r8)/(log((vtmax-vtmin)/(vtopt-vtmin))) + write(iulog,*) 'alpha=',alpha + write(iulog,*) 'tcrown=',tcrown(p) + !tc = t_ref2m(p)-tfrz + if(tcrown(p) >=vtmin .and. tcrown(p) <= vtmax) then + cumvd(p)=cumvd(p) + ((2._r8*((tcrown(p)-vtmin)**alpha)*(vtopt-vtmin)**alpha & + - (tcrown(p)-vtmin)**(2._r8*alpha))/((vtopt-vtmin)**(2._r8*alpha)))*(dtime/24._r8) + end if + cumvd(p) = max(0._r8, cumvd(p)) ! must be > 0 + + write(iulog,*)'vernalization_2 cumvd(p)=', cumvd(p) + vf(p)=(cumvd(p)**5._r8)/(22.5_r8**5._r8+cumvd(p)**5._r8) + vf(p) = max(0._r8, min(vf(p), 1._r8)) ! must be between 0 - 1 + write(iulog,*)'vernalization_2 vf(p)=', vf(p) + + write(iulog,*)'vernalization_2 cpool_to_grainc(p),hui(p) ',hui(p),cpool_to_grainc(p) + + end associate + + end subroutine vernalization_2 + + !----------------------------------------------------------------------- + subroutine coldtolerance (p,canopystate_inst,temperature_inst, & + waterstate_inst,cnveg_state_inst, crop_inst, & + cnveg_nitrogenflux_inst, cnveg_carbonflux_inst, & + cnveg_carbonstate_inst, cnveg_nitrogenstate_inst) + + ! !DESCRIPTION: + ! !Subroutine for coldtolerance modified after Lu(2017): 'Representing witer wheat in the Community Land Model (version 4.5) (tboas) + ! * * * only call for winter temperate cereal * * * + ! + !the subroutine calculates the lethal temperature at 50% of crop alive, + !survival rate, winter degree days + + + use clm_time_manager, only: get_step_size,get_curr_date + + ! + ! !ARGUMENTS: + !implicit none + integer, intent(in) :: p ! PFT index running over + type(canopystate_type) , intent(in) :: canopystate_inst + type(temperature_type) , intent(in) :: temperature_inst + type(waterstate_type) , intent(in) :: waterstate_inst + type(cnveg_carbonstate_type) , intent(in) :: cnveg_carbonstate_inst + type(cnveg_nitrogenstate_type), intent(in) :: cnveg_nitrogenstate_inst + type(cnveg_state_type) , intent(inout) :: cnveg_state_inst + type(crop_type) , intent(inout) :: crop_inst + type(cnveg_nitrogenflux_type) , intent(inout) :: cnveg_nitrogenflux_inst + type(cnveg_carbonflux_type) , intent(inout) :: cnveg_carbonflux_inst + ! + + ! LOCAL VARAIBLES: + real(r8) tcrown ! crown temperature + logical :: end_cd ! temporary for is_end_curr_day() value + real(r8) tc ! t_ref2m in degree C + real(r8) prevleafc ! previous step leafc + real(r8) tempfsurv ! averaged survival rate + integer c ! column indices + integer g ! gridcell indices + real(r8) dt ! land model time step (sec) + real(r8) dtime ! convert dt from sec to hour + integer :: kyr ! current year + integer :: kmo ! month of year (1, ..., 12) + integer :: kda ! day of month (1, ..., 31) + integer :: mcsec ! seconds of day (0, ..., seconds/day) + real(r8), parameter :: Hparam=0.0093 + real(r8), parameter :: Dparam=2.7e-5 + real(r8), parameter :: Sparam=1.9 + real(r8), parameter :: Rparam=0.54 + real(r8), parameter :: T_S_max=12.5 + real(r8), parameter :: lt50max=-23 + !the calculation of frost tolerance is based on Bergjord et al.,(2008),Europ.J.Agronomuy + !the calculation of survival rate and WDD is based on Vico et al.,(2014),Agri and Forest Metero. + + !------------------------------------------------------------------------ + + associate( & + ivt => patch%itype , & ! Input: [integer (:)] pft vegetation type + croplive => crop_inst%croplive_patch , & ! Input: [logical (:)] Flag,true if planted, not harvested + hdidx => cnveg_state_inst%hdidx_patch , & ! Output: [real(r8) (:)] cold hardening index? + rateh => crop_inst%rateh_patch , & ! Output: [real(r8)(:)] increase of tolerance cuased byhardening + rated => crop_inst%rated_patch , & ! Output: [real(r8) (:)] loss of tolerance cause by dehardening + rates => crop_inst%rates_patch , & ! Output: [real(r8) (:)] loss of tolerance caused by low tempeature + rater => crop_inst%rater_patch , & ! Output: [real(r8) (:)] loss of tolerance caused by respiration under snow + lt50 => crop_inst%lt50_patch , & ! Output: [real(r8) (:)] the lethal temperature at which 50% of the individuals are damaged + fsurv => crop_inst%fsurv_patch , & ! Output: [real(r8) (:)] winter wheat survival rate + accfsurv => crop_inst%accfsurv_patch , & ! Output: [real(r8) (:)] accumulated winter wheat survival rate [0 crop_inst%countfsurv_patch , & ! Output: [real(r8) (:)] numbers of accumulated winter wheat survival rate + wdd => crop_inst%wdd_patch , & ! Output: [real(r8) (:)] winter wheat weighted cumulated degree days + ck => crop_inst%ck_patch , & ! Output: [real(r8) (:)] fraction of green leaf area killed + cumvd => cnveg_state_inst%cumvd_patch , & ! Output: [real(r8) (:)] cumulative vernalization d?ependence? + vf => crop_inst%vf_patch , & ! Output: [real(r8) (:)] vernalization factor for cereal + gddmaturity => cnveg_state_inst%gddmaturity_patch , & ! Output: [real(r8) (:)] gdd needed to harvest + huigrain => cnveg_state_inst%huigrain_patch , & ! Output: [real(r8) (:)] heat unit index needed to reach vegetative maturity + leafc_to_litter => cnveg_carbonflux_inst%leafc_to_litter_patch , & ! Output: [real(r8) (:)] leaf C litterfall (gC/m2/s) + leafn_to_litter => cnveg_nitrogenflux_inst%leafn_to_litter_patch , & ! Output: [real(r8) (:)] leaf N litterfall (gN/m2/s) + leafc => cnveg_carbonstate_inst%leafc_patch , & ! Input: [real(r8) (:)] (gC/m2) leaf C + leafcn => pftcon%leafcn , & ! Input: [real(r8) (:)] leaf C:N (gC/gN) + leafn => cnveg_nitrogenstate_inst%leafn_patch , & ! Input: [real(r8)(:)] (gN/m2) leaf N + lflitcn => pftcon%lflitcn , & ! Input: [real(r8) (:)] leaf litter C:N (gC/gN) + tlai => canopystate_inst%tlai_patch , & ! Input: [real(r8) (:)] one-sided leaf area index, no burying by snow + t_ref2m => temperature_inst%t_ref2m_patch , & ! Input: [real(r8) (:)] 2 m height surface air temperature (K) + tcrown => crop_inst%tcrown_patch , & ! Output: [real(r8) (:)] crown temperature + snow_depth => waterstate_inst%snow_depth_col & ! Input: [real(r8) (:)] snow height (m) + ) + + c = patch%column(p) + dt=real( get_step_size(), r8 ) + + if (t_ref2m(p) < tfrz) then !slevis: t_ref2m inst of td=daily avg (K) + tcrown(p) = 2._r8 + (t_ref2m(p) - tfrz) * (0.4_r8 + 0.0018_r8 * & + (min(snow_depth(c)*100._r8, 15._r8) - 15._r8)**2) + else !slevis: snow_depth inst of adsnod=daily average (m) + tcrown(p) = t_ref2m(p) - tfrz + end if + + dtime=dt/3600.0_r8 !dtime is the time step dt in hour + +!frost tolerance and survival rate calculation + + if(tcrown(p) < 10._r8) then + rateh(p)=Hparam*(10._r8-tcrown(p))*(lt50(p)-lt50max) + write(iulog,*) 'rateh=',rateh(p),'lt50=',lt50(p),'tcrown=',tcrown(p) + write(iulog,*) 'snow_depth=',snow_depth(c) + end if + + if((tcrown(p) >=-4._r8 .and. vf(p) == 1._r8) .or. (tcrown(p)>=10._r8 .and. vf(p) <1._r8)) then + rated(p)=Dparam*(-0.6_r8+0.142_r8*lt50max-lt50(p))*(tcrown(p)+4._r8)**3._r8 + end if + + rater(p)=Rparam*(exp(0.84+0.051*tcrown(p))-2._r8)/1.85_r8*(snow_depth(c)*100._r8)/12.5 + rates(p)=(lt50(p)-tcrown(p))/exp(-Sparam*(lt50(p)-tcrown(p))-3.74_r8) + lt50(p)=lt50(p)+(rated(p)+rates(p)+rater(p)-rateh(p))*(dtime/24._r8) + + fsurv(p)=2._r8**(-(abs(tcrown(p))/abs(lt50(p)))**4._r8) + wdd(p)=wdd(p)+(max(tbase-tcrown(p),0._r8)*(1._r8-fsurv(p)))*(dtime/24._r8) + + if(wdd(p) >0._r8) then + accfsurv(p) = accfsurv(p) + fsurv(p) + countfsurv(p) = countfsurv(p) + 1._r8 + end if + + call get_curr_date(kyr, kmo, kda, mcsec) + end_cd = (mcsec == 0) + if( end_cd .and. wdd(p) > 0._r8 .and. vf(p) <0.9_r8 .and. leafc(p) > 10._r8 ) then + leafc_to_litter(p)=leafc_to_litter(p)+5._r8*(1._r8-fsurv(p))/dt + leafn_to_litter(p)=leafn_to_litter(p)+(5._r8*(1._r8-fsurv(p)))/(dt*lflitcn(ivt(p))) + end if + + if(end_cd .and. wdd(p) > 1.0_r8 .and. vf(p)>0.9_r8 ) then + tempfsurv=accfsurv(p)/countfsurv(p) + prevleafc=leafc(p) + leafc_to_litter(p)=leafc_to_litter(p)+prevleafc*(1._r8-tempfsurv)/dt + leafn_to_litter(p)=leafn_to_litter(p)+(prevleafc*(1._r8-tempfsurv))/(dt*lflitcn(ivt(p))) + accfsurv(p) = 1._r8 + countfsurv(p) = 1._r8 + wdd(p) =0._r8 + write (iulog,*) 'subroutine coldtolerance ending' + end if + + end associate + end subroutine coldtolerance + !----------------------------------------------------------------------- subroutine CNOnsetGrowth (num_soilp, filter_soilp, & cnveg_state_inst, & diff --git a/src/clm5/biogeochem/CropType.F90 b/src/clm5/biogeochem/CropType.F90 index 0b2c0fc1db..36cd35a4de 100644 --- a/src/clm5/biogeochem/CropType.F90 +++ b/src/clm5/biogeochem/CropType.F90 @@ -28,6 +28,8 @@ module CropType type, public :: crop_type ! Note that cropplant and harvdate could be 2D to facilitate rotation + !!tbo added variables for vernalization and cold tolerance modified after YLu (2017) + integer , pointer :: nyrs_crop_active_patch (:) ! number of years this crop patch has been active (0 for non-crop patches) logical , pointer :: croplive_patch (:) ! patch Flag, true if planted, not harvested logical , pointer :: cropplant_patch (:) ! patch Flag, true if planted @@ -41,6 +43,17 @@ module CropType character(len=20) :: baset_mapping real(r8) :: baset_latvary_intercept real(r8) :: baset_latvary_slope + real(r8), pointer :: lt50_patch (:) !lethal temperature at which 50% of the individuals are damaged + real(r8), pointer :: wdd_patch (:) !winter wheat weighted cumulated degree days + real(r8), pointer :: rateh_patch (:) !winter wheat weighted cumulated degree days + real(r8), pointer :: rated_patch (:) !loss of tolerance cause by dehardening + real(r8), pointer :: rates_patch (:) !loss of tolerance caused by low tempeature + real(r8), pointer :: rater_patch (:) !loss of tolerance caused by respiration under snow + real(r8), pointer :: fsurv_patch (:) !winter wheat survival rate + real(r8), pointer :: accfsurv_patch (:) !accumulated winter wheat survival rate + real(r8), pointer :: countfsurv_patch (:) !numbers of accumulated winter wheat survival rate + real(r8), pointer :: ck_patch (:) ! fraction of green leaf area killed + real(r8), pointer :: tcrown_patch (:) ! tcrown contains ! Public routines @@ -186,6 +199,7 @@ subroutine InitAllocate(this, bounds) character(len=*), parameter :: subname = 'InitAllocate' !----------------------------------------------------------------------- + !!tbo added variables for vernalization and cold tolerance modified after !YLu (2017) begp = bounds%begp; endp = bounds%endp @@ -199,6 +213,17 @@ subroutine InitAllocate(this, bounds) allocate(this%vf_patch (begp:endp)) ; this%vf_patch (:) = 0.0_r8 allocate(this%cphase_patch (begp:endp)) ; this%cphase_patch (:) = 0.0_r8 allocate(this%latbaset_patch (begp:endp)) ; this%latbaset_patch (:) = spval + allocate(this%lt50_patch (begp:endp)) ; this%lt50_patch (:) = spval + allocate(this%wdd_patch (begp:endp)) ; this%wdd_patch (:) = spval + allocate(this%rateh_patch (begp:endp)) ; this%rateh_patch (:) = spval + allocate(this%rated_patch (begp:endp)) ; this%rated_patch (:) = spval + allocate(this%rates_patch (begp:endp)) ; this%rates_patch (:) = spval + allocate(this%rater_patch (begp:endp)) ; this%rater_patch (:) = spval + allocate(this%fsurv_patch (begp:endp)) ; this%fsurv_patch (:) = spval + allocate(this%accfsurv_patch (begp:endp)) ; this%accfsurv_patch (:) = spval + allocate(this%countfsurv_patch(begp:endp)) ; this%countfsurv_patch (:) = spval + allocate(this%ck_patch (begp:endp)) ; this%ck_patch (:) = spval + allocate(this%tcrown_patch (begp:endp)) ; this%ck_patch (:) = spval end subroutine InitAllocate @@ -529,7 +554,10 @@ subroutine CropUpdateAccVars(this, bounds, t_ref2m_patch, t_soisno_col) use clm_varpar , only : nlevsno, nlevgrnd use pftconMod , only : nswheat, nirrig_swheat, pftcon use pftconMod , only : nwwheat, nirrig_wwheat + use pftconMod , only : nwbarley, nirrig_wbarley + use pftconMod , only : nrapeseed, nirrig_rapeseed use pftconMod , only : nsugarcane, nirrig_sugarcane + use pftconMod , only : ncovercrop_1, ncovercrop_2 use ColumnType , only : col use PatchType , only : patch ! @@ -591,7 +619,10 @@ subroutine CropUpdateAccVars(this, bounds, t_ref2m_patch, t_soisno_col) t_ref2m_patch(p)-(SHR_CONST_TKFRZ + pftcon%baset(ivt)))) & * dtime/SHR_CONST_CDAY end if - if (ivt == nwwheat .or. ivt == nirrig_wwheat) then + if (ivt == nwwheat .or. ivt == nirrig_wwheat .or. & + ivt == ncovercrop_1 .or. ivt == ncovercrop_2 .or. & + ivt == nwbarley .or. ivt == nirrig_wbarley .or. & + ivt == nrapeseed .or. ivt == nirrig_rapeseed) then rbufslp(p) = rbufslp(p) * this%vf_patch(p) end if else @@ -613,7 +644,10 @@ subroutine CropUpdateAccVars(this, bounds, t_ref2m_patch, t_soisno_col) ((t_soisno_col(c,1)*col%dz(c,1) + & t_soisno_col(c,2)*col%dz(c,2))/(col%dz(c,1)+col%dz(c,2))) - & (SHR_CONST_TKFRZ + pftcon%baset(ivt)))) * dtime/SHR_CONST_CDAY - if (ivt == nwwheat .or. ivt == nwwheat) then + if (ivt == nwwheat .or. ivt == nwwheat .or. & + ivt == ncovercrop_1 .or. ivt == ncovercrop_2 .or. & + ivt == nwbarley .or. ivt == nirrig_wbarley .or. & + ivt == nrapeseed .or. ivt == nirrig_rapeseed) then rbufslp(p) = rbufslp(p) * this%vf_patch(p) end if else diff --git a/src/clm5/biogeochem/NutrientCompetitionCLM45defaultMod.F90 b/src/clm5/biogeochem/NutrientCompetitionCLM45defaultMod.F90 index 5d29efbeb5..d427d22ade 100644 --- a/src/clm5/biogeochem/NutrientCompetitionCLM45defaultMod.F90 +++ b/src/clm5/biogeochem/NutrientCompetitionCLM45defaultMod.F90 @@ -498,7 +498,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! !USES: use pftconMod , only : npcropmin, pftcon use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean - use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + !use pftconMod , only : ntrp_soybean, nirrig_trp_soybean use clm_varcon , only : secspday use clm_varctl , only : use_c13, use_c14 use clm_time_manager , only : get_step_size @@ -855,8 +855,8 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & !they all seemed to be going through the retranslocation loop for soybean - good news. if (astem(p) == astemf(ivt(p)) .or. & - (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& - ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean)) then ! .and.& + !ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then if (grain_flag(p) == 0._r8)then if(.not.use_fun) then t1 = 1 / dt diff --git a/src/clm5/biogeochem/NutrientCompetitionFlexibleCNMod.F90 b/src/clm5/biogeochem/NutrientCompetitionFlexibleCNMod.F90 index f404ac9611..6d81d2f1d1 100644 --- a/src/clm5/biogeochem/NutrientCompetitionFlexibleCNMod.F90 +++ b/src/clm5/biogeochem/NutrientCompetitionFlexibleCNMod.F90 @@ -1188,7 +1188,7 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & ! !USES: use pftconMod , only : npcropmin, pftcon use pftconMod , only : ntmp_soybean, nirrig_tmp_soybean - use pftconMod , only : ntrp_soybean, nirrig_trp_soybean + !use pftconMod , only : ntrp_soybean, nirrig_trp_soybean use clm_varcon , only : secspday, dzsoi_decomp use clm_varctl , only : use_c13, use_c14 use clm_varctl , only : nscalar_opt, plant_ndemand_opt, substrate_term_opt, temp_scalar_opt @@ -1574,8 +1574,8 @@ subroutine calc_plant_nitrogen_demand(this, bounds, num_soilp, filter_soilp, & !they all seemed to be going through the retranslocation loop for soybean - good news. if (astem(p) == astemf(ivt(p)) .or. & - (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean .and.& - ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then + (ivt(p) /= ntmp_soybean .and. ivt(p) /= nirrig_tmp_soybean) ) then !.and.& + !ivt(p) /= ntrp_soybean .and. ivt(p) /= nirrig_trp_soybean)) then if (grain_flag(p) == 0._r8) then t1 = 1 / dt leafn_to_retransn(p) = t1 * max(leafn(p)- (leafc(p) / fleafcn(ivt(p))),0._r8) diff --git a/src/clm5/main/pftconMod.F90 b/src/clm5/main/pftconMod.F90 index 0efa2053eb..3618948041 100644 --- a/src/clm5/main/pftconMod.F90 +++ b/src/clm5/main/pftconMod.F90 @@ -91,10 +91,10 @@ module pftconMod integer :: nirrig_miscanthus integer :: nswitchgrass integer :: nirrig_switchgrass - integer :: ntrp_corn !value for tropical corn (rf) - integer :: nirrig_trp_corn !value for tropical corn (ir) - integer :: ntrp_soybean !value for tropical soybean (rf) - integer :: nirrig_trp_soybean !value for tropical soybean (ir) + integer :: ntrp_corn ! value for tropical corn (rf) + integer :: nirrig_trp_corn ! value for tropical corn (ir) + integer :: ncovercrop_1 ! before value for tropical soybean (rf) + integer :: ncovercrop_2 ! before value for tropical soybean (if) integer :: npcropmax ! value for last prognostic crop in list integer :: nc3crop ! value for generic crop (rf) integer :: nc3irrig ! value for irrigated generic crop (ir) @@ -255,11 +255,15 @@ module pftconMod real(r8), allocatable :: fun_cn_flex_b (:) ! Parameter b of FUN-flexcn link code (def 200) real(r8), allocatable :: fun_cn_flex_c (:) ! Parameter b of FUN-flexcn link code (def 80) real(r8), allocatable :: FUN_fracfixers(:) ! Fraction of C that can be used for fixation. + integer , allocatable :: covercrop (:) ! Cover crop flag ! pft parameters for dynamic root code real(r8), allocatable :: root_dmx(:) !maximum root depth + ! pft parameters for cover crop routine + !integer, allocatable :: covercrop(:) !cover crop flag + contains procedure, public :: Init @@ -459,6 +463,7 @@ subroutine InitAllocate (this) allocate( this%fun_cn_flex_b (0:mxpft) ) allocate( this%fun_cn_flex_c (0:mxpft) ) allocate( this%FUN_fracfixers(0:mxpft) ) + allocate( this%covercrop (0:mxpft) ) end subroutine InitAllocate @@ -577,8 +582,8 @@ subroutine InitRead(this) expected_pftnames(74) = 'irrigated_switchgrass ' expected_pftnames(75) = 'tropical_corn ' expected_pftnames(76) = 'irrigated_tropical_corn ' - expected_pftnames(77) = 'tropical_soybean ' - expected_pftnames(78) = 'irrigated_tropical_soybean ' + expected_pftnames(77) = 'covercrop_1 ' + expected_pftnames(78) = 'covercrop_2 ' ! Set specific vegetation type values @@ -963,6 +968,11 @@ subroutine InitRead(this) call ncd_io('max_SH_planting_date', this%mxSHplantdate, 'read', ncid, readvar=readv) if ( .not. readv ) call endrun(msg=' ERROR: error in reading in pft data'//errMsg(sourcefile, __LINE__)) +!Cover crop flag read-in + + call ncd_io('covercrop', this%covercrop, 'read', ncid, readvar=readv) + if ( .not. readv ) call endrun(msg=' ERROR: error in reading in cover crop flag'//errMsg(sourcefile, __LINE__)) + ! ! Constants ! @@ -1093,8 +1103,9 @@ subroutine InitRead(this) if ( trim(pftname(i)) == 'irrigated_switchgrass' ) nirrig_switchgrass = i if ( trim(pftname(i)) == 'tropical_corn' ) ntrp_corn = i if ( trim(pftname(i)) == 'irrigated_tropical_corn' ) nirrig_trp_corn = i - if ( trim(pftname(i)) == 'tropical_soybean' ) ntrp_soybean = i - if ( trim(pftname(i)) == 'irrigated_tropical_soybean' ) nirrig_trp_soybean = i + if ( trim(pftname(i)) == 'covercrop_1' ) ncovercrop_1 = i + if ( trim(pftname(i)) == 'covercrop_2' ) ncovercrop_2 = i + end do ntree = nbrdlf_dcd_brl_tree ! value for last type of tree @@ -1139,8 +1150,7 @@ subroutine InitRead(this) i == nirrig_sugarbeet .or. i == nirrig_sugarcane .or. & i == nirrig_sunflower .or. & i == nirrig_miscanthus .or. i == nirrig_switchgrass .or. & - i == nirrig_trp_corn .or. & - i == nirrig_trp_soybean) )then + i == nirrig_trp_corn ) )then ! correct else if ( this%irrigated(i) == 0.0_r8 )then ! correct @@ -1194,6 +1204,16 @@ subroutine set_is_pft_known_to_model(this) ! so we can't handle it in the general loop below. But CLM always uses type 0, so ! handle it specially here. this%is_pft_known_to_model(0) = .true. + this%is_pft_known_to_model(27) = .true. + this%is_pft_known_to_model(28) = .true. + this%is_pft_known_to_model(55) = .true. + this%is_pft_known_to_model(56) = .true. + this%is_pft_known_to_model(59) = .true. + this%is_pft_known_to_model(60) = .true. + this%is_pft_known_to_model(65) = .true. + this%is_pft_known_to_model(66) = .true. + this%is_pft_known_to_model(78) = .true. + this%is_pft_known_to_model(79) = .true. ! NOTE(wjs, 2015-10-04) Currently, mergetoclmpft is only used for crop types. ! However, we handle it more generally here (treating ALL pft types), in case its use @@ -1374,6 +1394,7 @@ subroutine Clean(this) deallocate( this%fun_cn_flex_b) deallocate( this%fun_cn_flex_c) deallocate( this%FUN_fracfixers) + deallocate( this%covercrop) end subroutine Clean