!$Author$ !$Date$ !$Revision$ !$HeadURL$ module crop_mod integer, dimension(:), allocatable :: cprevseasonrotation ! rotation count number previously printed in crop season report contains subroutine callcrop(daysim, sr, soil, plant, restot, h1et) ! ***************************************************************** wjr ! Wrapper to call crop use soil_data_struct_defs, only: soil_def use biomaterial, only: plant_pointer, residue_pointer, biototal, residueAdd use crop_data_struct_defs, only: am0cdb, crop_residue, create_crop_residue, destroy_crop_residue use hydro_data_struct_defs, only: hydro_derived_et use crop_growth_mod, only: cropgrow use update_mod, only: plantupdate use WEPS_UPGM_mod, only: run_UPGM ! + + + ARGUMENT DECLARATIONS + + + integer daysim integer sr type(soil_def), intent(in) :: soil ! soil for this subregion type(plant_pointer), pointer :: plant ! pointer to youngest plant data, which chains to older plant data type(biototal), intent(inout) :: restot type(hydro_derived_et), intent(in) :: h1et ! Local Variables integer lay type(crop_residue) :: cropres type(plant_pointer), pointer :: thisPlant ! pointer used to interate plant pointer chain ! + + + END OF SPECIFICATIONS + + + ! Note that crop "may" really require (admbgz + admrtz) in place of admbgz ! because crop wants to know the amount of biomass in each soil layer ! for nutrient cycling. However, since the nutrient cycling is supposed ! to be disabled, we won't worry about it right now. LEW - 04/23/99 thisPlant => plant do while ( associated(thisPlant) ) ! plant exists ! check for a valid growing crop if( (thisPlant%database%shoot .le. 0.0) & .or. (thisPlant%geometry%dpop .le. 0.0) ) then ! this is not a valid growing crop thisPlant%growth%living = .false. end if if( thisPlant%growth%living ) then if( associated(thisPlant%upgm_grow%plant) ) then call run_UPGM( sr, soil, thisPlant ) else cropres = create_crop_residue(soil%nslay) if (am0cdb(sr).eq.1) call cdbug(.false., sr, soil, thisPlant, restot, h1et) call cropgrow(sr, soil%nslay, soil%aszlyd, & thisPlant%database%ck, thisPlant%database%grf, thisPlant%database%ehu0, thisPlant%database%zmxc, & thisPlant%bname, thisPlant%database%idc, thisPlant%geometry%xrow, & thisPlant%database%zmrt, thisPlant%database%tmin, thisPlant%database%topt, & thisPlant%database%fd1(1), thisPlant%database%fd2(1), thisPlant%database%fd1(2), thisPlant%database%fd2(2), & thisPlant%database%bceff, & thisPlant%database%alf, thisPlant%database%blf, thisPlant%database%clf, & thisPlant%database%dlf, thisPlant%database%arp, thisPlant%database%brp, thisPlant%database%crp, & thisPlant%database%drp, thisPlant%database%aht, thisPlant%database%bht, & thisPlant%database%sla, thisPlant%database%hue, thisPlant%database%tverndel, & soil%tsmx, soil%tsmn, & thisPlant%growth%fwsf, & thisPlant%growth%am0cif, & thisPlant%database%baf, & thisPlant%geometry%hyfg, thisPlant%database%thum, thisPlant%geometry%dpop, thisPlant%database%dmaxshoot, & thisPlant%database%storeinit, thisPlant%database%fshoot, & thisPlant%database%fleafstem, thisPlant%database%shoot, & thisPlant%database%diammax, thisPlant%database%ssa, thisPlant%database%ssb, & thisPlant%database%fleaf2stor, thisPlant%database%fstem2stor, thisPlant%database%fstor2stor, & thisPlant%database%yld_coef, thisPlant%database%resid_int, & thisPlant%mass%standstem, thisPlant%mass%standleaflive, thisPlant%mass%standleafdead, thisPlant%mass%standstore, & thisPlant%mass%flatstem, thisPlant%mass%flatleaf, thisPlant%mass%flatstore, & thisPlant%growth%mshoot, thisPlant%growth%mtotshoot, thisPlant%mass%stemz, & thisPlant%mass%rootstorez, thisPlant%mass%rootfiberz, & thisPlant%geometry%zht, thisPlant%geometry%zshoot, thisPlant%geometry%dstm, thisPlant%geometry%zrtd, & thisPlant%growth%dayap, thisPlant%growth%dayam, & thisPlant%growth%thucum, thisPlant%growth%trthucum, & thisPlant%geometry%grainf, thisPlant%growth%zgrowpt, & thisPlant%growth%leafareatrend, thisPlant%growth%stemmasstrend, & thisPlant%growth%twarmdays, thisPlant%growth%tcolddays, & thisPlant%growth%tchillucum, thisPlant%growth%thardnx, thisPlant%growth%thu_shoot_beg, & thisPlant%growth%thu_shoot_end, thisPlant%growth%mtotleaf, thisPlant%growth%thu_leaf_beg, & thisPlant%growth%thu_leaf_end, thisPlant%geometry%xstmrep, & thisPlant%prev%standstem, thisPlant%prev%standleaflive, thisPlant%prev%standleafdead, thisPlant%prev%standstore, & thisPlant%prev%flatstem, thisPlant%prev%flatleaf, thisPlant%prev%flatstore, & thisPlant%prev%mshoot, thisPlant%prev%stemz, & thisPlant%prev%rootstorez, thisPlant%prev%rootfiberz, & thisPlant%prev%ht, thisPlant%prev%zshoot, thisPlant%prev%stm, thisPlant%prev%rtd, & thisPlant%prev%dayap, thisPlant%prev%hucum, thisPlant%prev%rthucum, & thisPlant%prev%grainf, thisPlant%prev%chillucum, & thisPlant%prev%dayspring, thisPlant%prev%dayleafon, thisPlant%prev%dayleafoff, & daysim, thisPlant%growth%dayspring, thisPlant%growth%dayleafon, thisPlant%growth%dayleafoff, & thisPlant%database%zloc_regrow, & cropres%standstem, cropres%standleaf, cropres%standstore, & cropres%flatstem, cropres%flatleaf, cropres%flatstore, & cropres%stemz, & cropres%zht, cropres%dstm, cropres%xstmrep, cropres%grainf ) ! check for abandoned stems in crop regrowth if( ( cropres%standstem + cropres%standleaf + cropres%standstore & + cropres%flatstem + cropres%flatleaf + cropres%flatstore ) & .gt. 0.0 ) then ! create new residue pool and transfer cropres into it thisPlant%residue => residueAdd( thisPlant%residue, thisPlant%residueIndex, soil%nslay ) thisPlant%residue%standstem = cropres%standstem thisPlant%residue%standleaf = cropres%standleaf thisPlant%residue%standstore = cropres%standstore thisPlant%residue%flatstem = cropres%flatstem thisPlant%residue%flatleaf = cropres%flatleaf thisPlant%residue%flatstore = cropres%flatstore do lay = 1, soil%nslay thisPlant%residue%stemz(lay) = cropres%stemz(lay) end do thisPlant%residue%zht = cropres%zht thisPlant%residue%dstm = cropres%dstm thisPlant%residue%xstmrep = cropres%xstmrep thisPlant%residue%grainf = cropres%grainf end if call destroy_crop_residue(cropres) end if if (am0cdb(sr).eq.1) call cdbug(.true., sr, soil, thisPlant, restot, h1et) end if !if( associated(thisPlant) ) then ! point to next older thisPlant thisPlant => thisPlant%olderPlant !end if end do end subroutine callcrop subroutine plant_endseason ( isr, bmrotation, bmperod, bm0cfl, & bnslay, mature_warn_flg, plant ) ! + + + PURPOSE + + + ! Prints out crop status variables that are of interest at the end of the season ! + + + KEYWORDS + + + ! crop model status use weps_cmdline_parms, only: report_info use weps_main_mod, only: init_loop, calib_loop use datetime_mod, only: julday, get_psim_day, get_psim_mon, get_psim_year use file_io_mod, only: luoseason use manage_data_struct_defs, only: lastoper use biomaterial, only: plant_pointer ! + + + ARGUMENT DECLARATIONS + + + integer, intent(in) :: isr ! subregion number integer, intent(in) :: bmrotation ! rotation count updated in manage.for integer, intent(in) :: bmperod ! number of years for a management cycle integer, intent(in) :: bm0cfl ! flag to print CROP output ! 0 = no output ! 1 = detailed output file created integer, intent(in) :: bnslay ! number of soil layers integer, intent(in) :: mature_warn_flg ! flag to indicate use of crop maturity warning ! 0 - no crop maturity warning given for any crop ! 1 - Warnings generated for any crop unless supressed by crop type type(plant_pointer), pointer :: plant ! pointer to youngest plant data, which chains to older plant data ! + + + LOCAL VARIABLES + + + integer lay real :: hui real bg_stem_sum, root_store_sum, root_fiber_sum integer adj_plant_yr type(plant_pointer), pointer :: thisPlant ! + + + LOCAL VARIABLE DEFINITIONS + + + ! lay - index used to loop through layers ! hui - heat unit index ! bg_stem_sum - sum of below ground stem ! root_store_sum - sum of root storage ! root_fiber_sum - sum of root fiber ! adj_plant_yr - planting year adjusted to be less than the operation year that triggered this report ! + + + OUTPUT FORMATS + + + 2010 format(1x,i2,'/',i2,'/',i3,'|',1x,i2,'/',i2,'/',i2,'|',a40,'|', & 10(f7.3,'|'),f7.2,'|',2(f7.3,'|'),f7.5,'|',f7.3,'|',i6,'|') 2011 format(f8.1,'|') 2020 format(2(f8.1,'|'),f5.3,'|',i4,'|') 2021 format(i6,'|') ! + + + END OF SPECIFICATIONS + + + if( init_loop(isr) .or. calib_loop(isr) ) then !initializing or calibrating cycle ! set to the beginning of simulation ! to eliminate newline at beginning of file cprevseasonrotation(isr) = 1 else !done when initializing and calibrating cycle(s) are completed if( bmrotation .gt. cprevseasonrotation(isr) ) then ! write newline write(unit=luoseason(isr),fmt="(a)") '' end if ! end of season print statements when crop submodel output flag set ! added initialization flag to prevent printing if crop not yet initialized ! loop to find plant for report thisPlant => plant do while( associated(thisPlant) ) ! plant exists if( thisPlant%database%plant_doy .gt. 0 ) then ! this is a plant, not some added residue if( thisPlant%database%thum .gt. 0.0 ) then hui = thisPlant%prev%hucum / thisPlant%database%thum else hui = 0.0 end if ! print end-of-season (before harvest) crop state if( (bm0cfl .ge. 0) ) then ! Always print this one now - LEW bg_stem_sum = 0.0 root_store_sum = 0.0 root_fiber_sum = 0.0 do lay = 1, bnslay bg_stem_sum = bg_stem_sum + thisPlant%prev%stemz(lay) root_store_sum = root_store_sum + thisPlant%prev%rootstorez(lay) root_fiber_sum = root_fiber_sum + thisPlant%prev%rootfiberz(lay) end do ! adjust planting year to be less than the operation year that triggered this report if( julday(thisPlant%database%plant_day, thisPlant%database%plant_month, thisPlant%database%plant_rotyr) & .ge. julday(lastoper(isr)%day,lastoper(isr)%mon,lastoper(isr)%yr) ) then adj_plant_yr = thisPlant%database%plant_rotyr - bmperod else adj_plant_yr = thisPlant%database%plant_rotyr end if write(UNIT=luoseason(isr),FMT=2010,advance='NO') & thisPlant%database%plant_day, thisPlant%database%plant_month, adj_plant_yr, & lastoper(isr)%day, lastoper(isr)%mon, lastoper(isr)%yr, thisPlant%bname, & thisPlant%prev%standstem, thisPlant%prev%standleaflive + thisPlant%prev%standleafdead, thisPlant%prev%standstore, & thisPlant%prev%flatstem, thisPlant%prev%flatleaf, thisPlant%prev%flatstore, & bg_stem_sum, root_store_sum, root_fiber_sum, & thisPlant%prev%ht, thisPlant%prev%stm, thisPlant%prev%rtd, thisPlant%prev%grainf, & thisPlant%geometry%xstmrep, thisPlant%prev%cancov, thisPlant%prev%dayap write(UNIT=luoseason(isr),FMT=2011,advance='NO') & thisPlant%prev%chillucum write(UNIT=luoseason(isr),FMT=2020,advance='NO') & thisPlant%prev%hucum, thisPlant%database%thum, hui, thisPlant%growth%dayam write(UNIT=luoseason(isr),FMT=2021,advance='NO') & max( thisPlant%prev%dayleafon, thisPlant%prev%dayspring ) end if ! for crops that cannot regrow, ALWAYS write out warning message ! if harvested before maturity ! Note: this is reported back to the WEPS GUI ! So, 'report_info' should be set to 1 (default) or greater under normal run conditions if( (hui < 1.0) .and. (mature_warn_flg .gt. 0) & .and. (thisPlant%database%fleaf2stor .le. 0.0) & .and. (thisPlant%database%fstem2stor .le. 0.0) & .and. (thisPlant%database%fstor2stor .le. 0.0) ) then if (report_info >= 1) then write(UNIT=6,FMT="(3(a),i0,'/',i0,'/',i0,a,f5.1,a,a)") & 'Warning: ', & thisPlant%bname(1:len_trim(thisPlant%bname)), & ' harvested ', & get_psim_day(isr), get_psim_mon(isr), get_psim_year(isr), & ' only reached ', hui*100.0, '% of maturity', & ' (Check crop selection, planting, harvest dates)' end if end if ! updated every call to get newline in right place cprevseasonrotation(isr) = bmrotation ! only dealing with one plant in this report, exit do loop on first valid plant exit end if ! go to next older plant thisPlant => thisPlant%olderPlant end do end if return end subroutine plant_endseason subroutine cpout( isr ) ! Author : A. Retta - 11/19/96 ! + + + PURPOSE + + + ! Prints headers for the CROP submodel output files use file_io_mod, only: luoseason, luocrop, luoshoot, luoinpt use crop_data_struct_defs, only: am0cfl integer, intent(in) :: isr ! subregion number ! + + + OUTPUT FORMATS + + + 2131 format ('# - - - - - stand stand stand flat & & flat flat root root bel.grnd total total') 2132 format ('# daysim doy year dap heatui stem leaf store stem& & leaf store store fiber stem leaf stem height& & stem lai eff_lai rootd grainf tempst watstf frost ffa & & ffw par apar massinc p_rw p_st p_lf p_rp st& &dflt pdiam parea fpdiam fparea hu_del frzhrd sai repstmd rgflg f& &livelf warmdays crop') 2133 format ('# - - - - - kg/m^2 kg/m^2 kg/m^2 kg/m^& &2 kg/m^2 kg/m^2 kg/m^2 kg/m^2 kg/m^2 kg/m^2 kg/m^2 meters & & - m^2/m^2 m^2/m^2 meters - - - - - & & #/m^2 MJ/m^2 MJ/m^2 kg/plnt - - - - & & - meters m^2') 2231 format ('# daysim doy year dap heatui ', & & 's_root_sum f_root_sum tot_mass_req end_shoot_mass ', & & 'end_root_mass d_root_mass d_shoot_mass d_s_root_mass ', & & 'end_stem_mass end_stem_area end_shoot_len bczshoot ', & & 'bcmshoot bcdstm crop%bname') 2232 format ('# (dy) (dy) (yr) (dy) (C) ', & & '(kg/m^2) (kg/m^2) (mg/shoot) (mg/shoot) ', & & '(mg/shoot) (mg/shoot) (mg/shoot) (mg/shoot) ', & & '(mg/shoot) (m^2/shoot) (m) (m) ', & & '(kg/m^2) (#/m^2)') 2043 format('# Planting |Harv/Term |') 2044 format('#dy mo year|dy mo year |') 2045 format('# | |') 2053 format(' |') 2054 format('crop_name |') 2055 format(' |') 2063 format('standing| | |flat | | |root |') 2064 format('stem |leaf |store |stem |leaf |store |stem |') 2065 format('kg/m^2 |------|-------|-------|-------|-------|------|') 2073 format(' | | | |root |') 2074 format('store |fiber |height|stemcount|depth |') 2075 format('-------|-------|meters|#/m^2 |meters|') 2084 format('grainf |stmrepd|cancov|dapl |chill |hucum |mxhu |') 2085 format('-------|meters |----- |days |deg_C |deg_C |deg_C|') 2094 format('huind|dafm|spring') 2095 format('-----|days|------') 6000 format('#plant harvest 0=days_mat calc_d_mat db_d_mat calc_heatu d& &b_heatu') 6001 format('# doy doy 1=heatunit days days degree_C d& &egree_C') ! season.out headers write(luoseason(isr),2043,ADVANCE="NO") write(luoseason(isr),2053,ADVANCE="NO") write(luoseason(isr),2063,ADVANCE="NO") write(luoseason(isr),2073,ADVANCE="YES") write(luoseason(isr),2044,ADVANCE="NO") write(luoseason(isr),2054,ADVANCE="NO") write(luoseason(isr),2064,ADVANCE="NO") write(luoseason(isr),2074,ADVANCE="NO") write(luoseason(isr),2084,ADVANCE="NO") write(luoseason(isr),2094,ADVANCE="YES") write(luoseason(isr),2045,ADVANCE="NO") write(luoseason(isr),2055,ADVANCE="NO") write(luoseason(isr),2065,ADVANCE="NO") write(luoseason(isr),2075,ADVANCE="NO") write(luoseason(isr),2085,ADVANCE="NO") write(luoseason(isr),2095,ADVANCE="YES") if (am0cfl(isr).gt.0) then ! crop.out headers write(luocrop(isr), 2131) write(luocrop(isr), 2132) write(luocrop(isr), 2133) ! shoot.out headers write(luoshoot(isr), 2231) write(luoshoot(isr), 2232) ! inpt.out headers write(luoinpt(isr), 6000) write(luoinpt(isr), 6001) endif return end subroutine cpout subroutine cdbug(aflg, isr, soil, plant, restot, h1et) ! + + + PURPOSE + + + ! This program prints out many of the global variables before ! and after the call to CROP provide a comparison of values ! which may be changed by CROP ! author: John Tatarko ! version: 09/01/92 ! + + + KEY WORDS + + + ! wind, erosion, hydrology, tillage, soil, crop, decomposition ! management use file_io_mod, only: luocdb use soil_data_struct_defs, only: soil_def use biomaterial, only: plant_pointer, biototal use hydro_data_struct_defs, only: hydro_derived_et use climate_input_mod, only: cli_day, wind_day use datetime_mod, only: get_psim_juld, get_psim_doy, get_psim_year ! + + + ARGUMENT DECLARATIONS + + + logical, intent(in) :: aflg ! False, before call to crop, True, after call to crop integer, intent(in) :: isr ! subregion index type(soil_def), intent(in) :: soil ! soil for this subregion type(plant_pointer), pointer :: plant ! pointer to youngest plant data, which chains to older plant data type(biototal), intent(in) :: restot ! structure containing residue totals type(hydro_derived_et), intent(in) :: h1et ! + + + LOCAL VARIABLES + + + integer :: l ! loop index soil layers integer :: pjuld ! present julian day ! + + + DATA INITIALIZATIONS + + + pjuld = get_psim_juld(isr) ! + + + INPUT FORMATS + + + ! + + + OUTPUT FORMATS + + + 2030 format ('**',1x,'Day ',i2,'of Year ',i4,' After call to CROP Subregion No. ',i3) 2031 format ('**',1x,'Day ',i2,'of Year ',i4,' Before call to CROP Subregion No. ',i3) 2032 format (' awzdpt awtdmx awtdmn aweirr awudmx awudmn ',' awtdpt awadir awhrmx') 2038 format (f7.2,9f8.2) ! 2045 format ('Subregion Number',i3) 2050 format ('amrslp(',i2,') acftcv(',i2,') acrlai(',i2,')',' aczrtd(',i2,') admftot(',i2,') fwsf(',i2,')',' ac0nam(',i2,')') 2051 format (2f10.2,2f10.5,2x,f10.2,f10.2,3x,a12) 2052 format ('actdtm(',i2,') sum-phu(',i2,') acmst(',i2,')',' acmrt(',i2,') h1et%zeta h1et%zetp',' h1et%zpta ') 2053 format (i10, 4f10.2,2f12.2) 2054 format (' h1et%zea h1et%zep h1et%zptp ',' actmin(',i2,') actopt(',i2,') aslrr(',i2,')') 2055 format (2f10.2,2f10.3,3f12.2) 2056 format('layer aszlyt ahrsk ahrwc ahrwcs ahrwca',' ahrwcf ahrwcw ah0cb aheaep ahtsmx ahtsmn') 2060 format (i4,1x,f7.2,1x,e7.1,f6.2,4f7.2,f6.2,3f7.2) 2065 format(' layer asfsan asfsil asfcla asfom asdblk aslagm as0ags',' aslagn aslagx aseags') 2070 format (i4,2x,3f7.2,f7.3,2f7.2,f8.2,f7.3,2f8.2) ! + + + END SPECIFICATIONS + + + ! write weather cligen and windgen variables if( aflg ) then write(luocdb(isr),2030) get_psim_doy(isr),get_psim_year(isr),isr else write(luocdb(isr),2031) get_psim_doy(isr),get_psim_year(isr),isr end if write(luocdb(isr),2032) write(luocdb(isr),2038) cli_day(pjuld)%zdpt, cli_day(pjuld)%tdmx, cli_day(pjuld)%tdmn, & cli_day(pjuld)%eirr, wind_day(pjuld)%wwudmx, wind_day(pjuld)%wwudmn, cli_day(pjuld)%tdpt, & wind_day(pjuld)%wwadir, wind_day(pjuld)%wwhrmx ! write(luocdb(isr),2045) isr write(luocdb(isr),2050) isr, isr, isr, isr, isr, isr, isr write(luocdb(isr),2051) soil%amrslp, plant%deriv%ftcv, plant%deriv%rlai, & plant%geometry%zrtd, restot%mftot, plant%growth%fwsf, plant%bname write(luocdb(isr),2052) isr, isr, isr, isr write(luocdb(isr),2053) & plant%database%tdtm, plant%growth%thucum, plant%deriv%mst, plant%deriv%mrt, & h1et%zeta, h1et%zetp, h1et%zpta write(luocdb(isr),2054) isr, isr, isr, isr write(luocdb(isr),2055) h1et%zea, h1et%zep, h1et%zptp, plant%database%tmin, & plant%database%topt, soil%aslrr write(luocdb(isr),2056) do 200 l = 1,soil%nslay write(luocdb(isr),2060) l,soil%aszlyt(l), soil%ahrsk(l), soil%ahrwc(l), & soil%ahrwcs(l), soil%ahrwca(l), soil%ahrwcf(l), & soil%ahrwcw(l), soil%ah0cb(l), soil%aheaep(l), & soil%tsmx(l), soil%tsmn(l) 200 continue write(luocdb(isr),2065) do 300 l=1,soil%nslay write(luocdb(isr),2070) l,soil%asfsan(l),soil%asfsil(l), & soil%asfcla(l), soil%asfom(l), soil%asdblk(l), & soil%aslagm(l), soil%as0ags(l), soil%aslagn(l), & soil%aslagx(l), soil%aseags(l) 300 continue return end subroutine cdbug end module crop_mod