From e18817a709d5e930dea6a1a4d7493fabd887f9e1 Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 08:25:23 -0500 Subject: [PATCH 01/17] Refactor and enhance various modules and subroutines - Added new variables and cases in `actions.f90` for improved plant and grass management. - Removed and re-added unused variables in `basin_module.f90` with updated comments. - Updated `cal_conditions.f90` and `cal_parm_select.f90` with new cases and logic for parameter handling. - Enhanced calibration logic in `calsoft_*` files for better ET and water yield management. - Modified calculations and logic in `ch_*` files for improved water quality and sediment handling. - Updated `channel_control.f90` and `climate_control.f90` for better flow and climate data handling. - Refactored `conditional_module.f90` and `conditions.f90` for improved condition checks and logic. - Enhanced `constituent_mass_module.f90` and `dtbl_scen_read.f90` for better data allocation and handling. - Improved `hru_*` files for better HRU management and output. - Refactored `hyd_*` files for better allocation and initialization of variables. - Updated `mgt_*` files for better management of irrigation and plant growth. - Enhanced `nut_solp.f90` and `object_read_output.f90` for better nutrient and output handling. - Improved `organic_mineral_mass_module.f90` and `output_landscape_*` files for better mass and output management. - Refactored `pathogen_init.f90` and `pesticide_init.f90` for better pathogen and pesticide handling. - Enhanced `pl_*` files for better plant growth and partitioning logic. - Updated `recall_read.f90` and `res_*` files for better reservoir and nutrient management. - Refactored `sd_channel_*` files for better sediment and erosion handling. - Improved `soil_*` files for better soil nutrient and carbon initialization. - Updated `structure_set_parms.f90` and `swr_percmain.f90` for better parameter setting and water management. - Enhanced `time_control.f90` for better time and land use change handling. - Improved `wallo_demand.f90` and `water_allocation_read.f90` for better water allocation and demand handling. - Refactored `wet_*` files for better wetland management and output. --- src/actions.f90 | 39 ++- src/basin_module.f90 | 51 +-- src/cal_conditions.f90 | 9 +- src/cal_parm_select.f90 | 24 +- src/calsoft_chsed.f90 | 520 ---------------------------- src/calsoft_control.f90 | 6 +- src/calsoft_hyd_bfr.f90 | 16 +- src/calsoft_hyd_bfr_et.f90 | 61 ---- src/calsoft_hyd_bfr_pet.f90 | 96 +++++ src/ch_rtmusk.f90 | 1 + src/ch_rtpest.f90 | 2 +- src/ch_watqual4.f90 | 59 ++-- src/channel_control.f90 | 10 +- src/climate_control.f90 | 4 +- src/climate_module.f90 | 2 +- src/command.f90 | 5 + src/conditional_module.f90 | 1 + src/conditions.f90 | 46 ++- src/constituent_mass_module.f90 | 6 +- src/dtbl_scen_read.f90 | 2 + src/exco_read_om.f90 | 2 +- src/gwflow_read.f90 | 2 +- src/gwflow_soil.f90 | 2 +- src/hru_control.f90 | 34 +- src/hru_module.f90 | 4 +- src/hru_output.f90 | 2 - src/hru_read.f90 | 2 +- src/hrudb_init.f90 | 2 + src/hyd_connect.f90 | 40 +-- src/hyd_read_connect.f90 | 32 +- src/hydro_init.f90 | 1 - src/hydrograph_module.f90 | 10 +- src/mgt_sched.f90 | 12 +- src/mgt_transplant.f90 | 2 +- src/nut_solp.f90 | 4 - src/object_read_output.f90 | 10 +- src/organic_mineral_mass_module.f90 | 1 + src/output_landscape_init.f90 | 2 +- src/output_landscape_module.f90 | 2 +- src/pathogen_init.f90 | 6 +- src/pesticide_init.f90 | 6 +- src/pl_grow.f90 | 2 +- src/pl_leaf_gro.f90 | 10 +- src/pl_leaf_senes.f90 | 12 +- src/pl_partition.f90 | 64 +++- src/pl_root_gro.f90 | 2 +- src/plant_all_init.f90 | 14 +- src/plant_data_module.f90 | 1 - src/plant_init.f90 | 5 +- src/recall_read.f90 | 2 + src/res_hydro.f90 | 39 ++- src/res_nutrient.f90 | 14 +- src/res_read.f90 | 5 + src/res_sediment.f90 | 39 +-- src/res_weir_release.f90 | 43 ++- src/reservoir_data_module.f90 | 3 +- src/reservoir_module.f90 | 4 +- src/sd_channel_control.f90 | 26 +- src/sd_channel_control3.f90 | 4 +- src/sd_channel_module.f90 | 12 +- src/sd_channel_sediment.f90 | 6 +- src/sd_channel_sediment3.f90 | 139 ++++---- src/sd_hydsed_init.f90 | 7 +- src/soil_nutcarb_init.f90 | 14 +- src/soil_nutcarb_module.f90 | 2 +- src/soils_init.f90 | 1 + src/sq_canopyint.f90 | 2 +- src/structure_set_parms.f90 | 2 +- src/swr_percmain.f90 | 2 +- src/time_control.f90 | 11 +- src/wallo_demand.f90 | 4 + src/water_allocation_read.f90 | 2 +- src/wet_initial.f90 | 21 +- src/wet_irrp.f90 | 6 +- src/wet_read.f90 | 2 + src/wetland_control.f90 | 34 +- src/wetland_output.f90 | 2 +- 77 files changed, 692 insertions(+), 1004 deletions(-) delete mode 100644 src/calsoft_chsed.f90 create mode 100644 src/calsoft_hyd_bfr_pet.f90 diff --git a/src/actions.f90 b/src/actions.f90 index b13ae15..2cbfae8 100644 --- a/src/actions.f90 +++ b/src/actions.f90 @@ -71,6 +71,8 @@ subroutine actions (ob_cur, ob_num, idtbl) integer :: imallo = 0 integer :: idmd = 0 integer :: irec = 0 + integer :: iplt = 0 + integer :: num_plts_cur = 0 real :: hiad1 = 0. ! | real :: biomass = 0. ! | real :: frt_kg = 0. @@ -398,12 +400,13 @@ subroutine actions (ob_cur, ob_num, idtbl) harveff = d_tbl%act(iac)%const call mgt_harvresidue (j, harveff) case ("tree") + call mgt_harvbiomass (j, ipl, iharvop) case ("tuber") call mgt_harvtuber (j, ipl, iharvop) case ("peanuts") call mgt_harvtuber (j, ipl, iharvop) case ("stripper") - call mgt_harvgrain (j, ipl, iharvop) + call mgt_harvbiomass (j, ipl, iharvop) case ("picker") call mgt_harvgrain (j, ipl, iharvop) end select @@ -886,7 +889,10 @@ subroutine actions (ob_cur, ob_num, idtbl) case ("lu_change") j = d_tbl%act(iac)%ob_num if (j == 0) j = ob_cur + if (d_tbl%lu_chg_mx(iac) <= Int(d_tbl%act(iac)%const2)) then + d_tbl%lu_chg_mx(iac) = d_tbl%lu_chg_mx(iac) + 1 ilu = d_tbl%act_typ(iac) + hru(j)%land_use_mgt = ilu hru(j)%dbs%land_use_mgt = ilu lu_prev = hru(j)%land_use_mgt_c hru(j)%land_use_mgt_c = d_tbl%act(iac)%file_pointer @@ -902,6 +908,27 @@ subroutine actions (ob_cur, ob_num, idtbl) write (3612,*) j, time%yrc, time%mo, time%day_mo, " LU_CHANGE ", & lu_prev, hru(j)%land_use_mgt_c, " 0 0" + !! add new plants in simulation for yield output + do ipl = 1, pcom(j)%npl + if (basin_plants == 0) then + plts_bsn(1) = pcom(j)%pl(ipl) + basin_plants = 1 + else + num_plts_cur = basin_plants + do iplt = 1, num_plts_cur + if (pcom(j)%pl(ipl) == plts_bsn(iplt)) exit + if (iplt == basin_plants) then + plts_bsn(iplt+1) = pcom(j)%pl(ipl) + bsn_crop_yld(iplt+1) = bsn_crop_yld_z + bsn_crop_yld_aa(iplt+1) = bsn_crop_yld_z + basin_plants = basin_plants + 1 + pcom(j)%plcur(ipl)%bsn_num = basin_plants + end if + end do + end if + end do + !pcom(j)%dtbl(idtbl)%num_actions(iac) = pcom(j)%dtbl(idtbl)%num_actions(iac) + 1 + end if !land use change - contouring case ("p_factor") j = d_tbl%act(iac)%ob_num @@ -1033,7 +1060,8 @@ subroutine actions (ob_cur, ob_num, idtbl) do istr = 1, db_mx%grassop_db if (d_tbl%act(iac)%file_pointer == grwaterway_db(istr)%name) then - istr1 = istr + !istr1 = istr + hru(j)%lumv%grwat_i = 1 exit end if end do @@ -1045,6 +1073,13 @@ subroutine actions (ob_cur, ob_num, idtbl) write (3612,*) j, time%yrc, time%mo, time%day_mo, " GRASSWW_INSTALL ", & sdr(istr)%name, sdr(istr1)%name, " 0 0" + !install grass waterways + case ("grassww_uninstall") + j = d_tbl%act(iac)%ob_num + if (j == 0) j = ob_cur + hru(j)%lumv%grwat_i = 0 + write (3612,*) j, time%yrc, time%mo, time%day_mo, " GRASSWW_UNINSTALL ", & + sdr(istr)%name, sdr(istr1)%name, " 0 0" !user defined bmp reductions case ("user_def_bmp") j = d_tbl%act(iac)%ob_num diff --git a/src/basin_module.f90 b/src/basin_module.f90 index f7fa599..bfb0eb8 100644 --- a/src/basin_module.f90 +++ b/src/basin_module.f90 @@ -21,32 +21,24 @@ module basin_module !! 0 = Priestley-Taylor !! 1 = Penman-Monteith !! 2 = Hargreaves method - !! 3 = read in daily pot ET values - integer :: event = 0 !! event code + integer :: event = 0 !! not used integer :: crk = 0 !! crack flow code !! 1 = compute flow in cracks integer :: swift_out = 0 !! write to SWIFT input file !! 0 = do not write !! 1 = write to swift_hru.inp - integer :: sed_det = 0 !! max half-hour rainfall frac calc - !! 0 = gen from triangular dist - !! 1 = use monthly mean frac + integer :: sed_det = 0 !! not used integer :: rte = 0 !! water routing method !! 0 variable storage method !! 1 Muskingum method - integer :: deg = 0 !! channel degradation code - !! 0 = do not compute - !! 1 = compute (downcutting and widening) - integer :: wq = 0 !! stream water quality code - !! 0 do not model - !! 1 model (QUAL2E) + integer :: deg = 0 !! not used + integer :: wq = 0 !! not used integer :: nostress = 0 !! redefined to the sequence number -- changed to no nutrient stress !! 0 = all stresses applied !! 1 = turn off all plant stress !! 2 = turn off nutrient plant stress only integer :: cn = 0 !! not used - integer :: cfac = 0 !! 0 = C-factor calc using CMIN - !! 1 = for new C-factor from RUSLE (no min needed) + integer :: cfac = 0 !! not used integer :: cswat = 0 !! carbon code !! = 0 Static soil carbon (old mineralization routines) !! = 1 C-FARM one carbon pool model @@ -57,29 +49,20 @@ module basin_module integer :: uhyd = 1 !! Unit hydrograph method: !! 0 = triangular UH !! 1 = gamma function UH - integer :: sed_ch = 0 !! Instream sediment model - !! 0 = Bagnold model - !! 1 = Brownlie model - !! 2 = Yang model + integer :: sed_ch = 0 !! not used integer :: tdrn = 0 !! tile drainage eq code - !! 1 = sim tile flow using subsurface drains (wt_shall) - !! 0 = sim tile flow using subsurface origtile (wt_shall,d) - integer :: wtdn = 0 !! water table depth algorithms code - !! 1 = sim wt_shall using subsurface new water table depth routine - !! 0 = sim wt_shall using subsurface orig water table depth routine - integer :: sol_p_model=0 !! 1 = new soil P model + !! 0 = tile flow using drawdown days equation + !! 1 = tile flow using drainmod equations + integer :: wtdn = 0 !! shallow water table depth algorithms code + !! 0 = depth using orig water table depth routine - fill to upper limit + !! 1 = depth using drainmod water table depth routine + integer :: sol_p_model=0 !! 0 = original soil P model in SWAT documentation + !! 1 = new soil P model in Vadas and White (2010) integer :: gampt = 0 !! 0 = curve number; 1 = Green and Ampt - character(len=1) :: atmo = "a" !! atmospheric deposition interval - !! "m" = monthly - !! "y" = yearly - !! "a" = annual - integer :: smax = 0 !! max depressional storage selection code - !! 1 = dynamic stmaxd computed as a cunfction of random - !! roughness and rain intensity - !! 0 = static stmaxd read from .bsn for the global value or .sdr - !! for specific hrus - integer :: qual2e = 0 !! 0 = channel routine using QUAL2E - !! 1 = channel routing with simplified nutrient transformations + character(len=1) :: atmo = "a" !! not used + integer :: smax = 0 !! not used + integer :: qual2e = 0 !! 0 = instream nutrient routing using QUAL2E + !! 1 = instream nutrient routing using QUAL2E - with simplified nutrient transformations integer :: gwflow = 0 !! 0 = gwflow module not active; 1 = gwflow module active end type basin_control_codes type (basin_control_codes) :: bsn_cc diff --git a/src/cal_conditions.f90 b/src/cal_conditions.f90 index 0f503f8..926e18f 100644 --- a/src/cal_conditions.f90 +++ b/src/cal_conditions.f90 @@ -79,13 +79,8 @@ subroutine cal_conditions cond_met = "n" exit end if - case ("region") !for hru - if (cal_upd(ichg_par)%cond(ic)%targc /= hru(ielem)%region) then - cond_met = "n" - exit - end if - case ("region_lte") !for hru - if (cal_upd(ichg_par)%cond(ic)%targc /= hru(ielem)%region) then + case ("cal_group") !for hru + if (cal_upd(ichg_par)%cond(ic)%targc /= hru(ielem)%cal_group) then cond_met = "n" exit end if diff --git a/src/cal_parm_select.f90 b/src/cal_parm_select.f90 index 75ac6c3..23a235a 100644 --- a/src/cal_parm_select.f90 +++ b/src/cal_parm_select.f90 @@ -438,6 +438,9 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma chg_typ, chg_val, absmin, absmax) !! SWQ + case ("mumax") + ch_nut(ielem)%mumax = chg_par(ch_nut(ielem)%mumax, & + chg_typ, chg_val, absmin, absmax) case ("rs1") ch_nut(ielem)%rs1 = chg_par(ch_nut(ielem)%rs1, & chg_typ, chg_val, absmin, absmax) @@ -611,20 +614,16 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma sd_ch(ielem)%chk = chg_par(sd_ch(ielem)%chk, & chg_typ, chg_val, absmin, absmax) - case ("cherod") - sd_ch(ielem)%cherod = chg_par(sd_ch(ielem)%cherod, & + case ("bank_exp") + sd_ch(ielem)%bank_exp = chg_par(sd_ch(ielem)%bank_exp, & chg_typ, chg_val, absmin, absmax) case ("cov") sd_ch(ielem)%cov = chg_par(sd_ch(ielem)%cov, & chg_typ, chg_val, absmin, absmax) - ! case ("wd_rto") - ! sd_ch(ielem)%wd_rto = chg_par(sd_ch(ielem)%wd_rto, & - ! chg_typ, chg_val, absmin, absmax) - - case ("flood_sedfrac") - sd_ch(ielem)%chseq = chg_par(sd_ch(ielem)%chseq, & + case ("vcr_coef") + sd_ch(ielem)%vcr_coef = chg_par(sd_ch(ielem)%vcr_coef, & chg_typ, chg_val, absmin, absmax) case ("d50") @@ -712,8 +711,8 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma sd_ch(ielem)%arc_len_fr = chg_par(sd_ch(ielem)%arc_len_fr, & chg_typ, chg_val, absmin, absmax) - case ("part_size") - sd_ch(ielem)%part_size = chg_par(sd_ch(ielem)%part_size, & + case ("bed_exp") + sd_ch(ielem)%bed_exp = chg_par(sd_ch(ielem)%bed_exp, & chg_typ, chg_val, absmin, absmax) case ("wash_bed_fr") @@ -740,6 +739,11 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma case ("nsed") res_prm(ielem)%sed%nsed = chg_par(res_prm(ielem)%sed%nsed, & chg_typ, chg_val, absmin, absmax) + case ("res_d50") + res_prm(ielem)%sed%d50 = chg_par(res_prm(ielem)%sed%d50, & + chg_typ, chg_val, absmin, absmax) + !! d50 -micro meters + res_prm(ielem)%sed_stlr_co = exp(-0.184 * res_prm(ielem)%sed%d50) case ("sed_stlr") res_prm(ielem)%sed%sed_stlr = chg_par(res_prm(ielem)%sed%sed_stlr, & diff --git a/src/calsoft_chsed.f90 b/src/calsoft_chsed.f90 deleted file mode 100644 index 7524c2c..0000000 --- a/src/calsoft_chsed.f90 +++ /dev/null @@ -1,520 +0,0 @@ - subroutine calsoft_chsed - - use hydrograph_module - use ru_module - use aquifer_module - use channel_module - use hru_lte_module - use sd_channel_module - use basin_module - use maximum_data_module - use calibration_data_module - use conditional_module - use reservoir_module - use organic_mineral_mass_module - - implicit none - - integer :: ical_sed = 0 ! | - integer :: iter_all = 0 ! |end of loop - integer :: iterall = 0 !none |counter - integer :: isim = 0 ! | - integer :: ireg = 0 !none |counter - integer :: iord = 0 !none |counter - real :: soft = 0. ! | - real :: diff = 0. ! | - real :: chg_val = 0. ! | - integer :: ich_s = 0 !none |counter - integer :: iich = 0 ! | - integer :: icov = 0 !none |counter - real :: rmeas = 0. ! | - real :: denom = 0. ! | - integer :: iter_ind = 0 ! |end of loop - integer :: ierod = 0 !none |counter - - - !calibrate sediment - ical_sed = 0 - - !calibrate hydrology - ical_sed = 0 - iter_all = 1 - iter_ind = 1 - - do iterall = 1, iter_all - ! 1st cover adjustment for channel widening - isim = 0 - do ireg = 1, db_mx%ch_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chw - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%erod < 1.e-6) then - isim = 1 - - chcal(ireg)%ord(iord)%prm_prev = chcal(ireg)%ord(iord)%prm - chcal(ireg)%ord(iord)%prev = chcal(ireg)%ord(iord)%aa - - if (soft < chcal(ireg)%ord(iord)%aa%chw) then - chg_val = 1. / (abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) + 1.05) - else - chg_val = abs((chcal(ireg)%ord(iord)%aa%chw - soft) / chcal(ireg)%ord(iord)%aa%chw) + 1.05 - end if - chcal(ireg)%ord(iord)%prm_prev%erod = chcal(ireg)%ord(iord)%prm%erod - chcal(ireg)%ord(iord)%prm%erod = chg_val - chcal(ireg)%ord(iord)%prev%chw = chcal(ireg)%ord(iord)%aa%chw - - if (chcal(ireg)%ord(iord)%prm%erod >= ch_prms(1)%pos) then - chg_val = ch_prms(1)%pos - chcal(ireg)%ord(iord)%prm%erod = ch_prms(1)%pos - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%erod <= ch_prms(1)%neg) then - chg_val = ch_prms(1)%neg - chcal(ireg)%ord(iord)%prm%erod = ch_prms(1)%neg - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for 1st width calibration and rerun - sd_ch(iich)%cherod = sd_ch(iich)%cherod * chg_val - sd_ch(iich)%cherod = amin1 (sd_ch(iich)%cherod, ch_prms(1)%up) - sd_ch(iich)%cherod = Max (sd_ch(iich)%cherod, ch_prms(1)%lo) - sdch_init(iich)%cherod = sd_ch(iich)%cherod - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! 1st cover adjustment - if (isim > 0) then - cal_sim = " first chan erod adj " - cal_adj = chg_val - call time_control - end if - - ! cover adjustment for channel widening - do icov = 1, iter_ind - isim = 0 - do ireg = 1, db_mx%ch_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chw - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%erod < 1.e-6) then - isim = 1 - - chcal(ireg)%ord(iord)%prm_prev = chcal(ireg)%ord(iord)%prm - chcal(ireg)%ord(iord)%prev = chcal(ireg)%ord(iord)%aa - - if (soft < chcal(ireg)%ord(iord)%aa%chw) then - chg_val = 1. / (abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) + 1.05) - else - chg_val = abs((chcal(ireg)%ord(iord)%aa%chw - soft) / chcal(ireg)%ord(iord)%aa%chw) + 1.05 - end if - chcal(ireg)%ord(iord)%prm_prev%erod = chcal(ireg)%ord(iord)%prm%erod - chcal(ireg)%ord(iord)%prm%erod = chcal(ireg)%ord(iord)%prm%erod * chg_val - chcal(ireg)%ord(iord)%prev%chw = chcal(ireg)%ord(iord)%aa%chw - - if (chcal(ireg)%ord(iord)%prm%erod >= ch_prms(1)%pos) then - chg_val = ch_prms(1)%pos - chcal(ireg)%ord(iord)%prm%erod = ch_prms(1)%pos - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%erod <= ch_prms(1)%neg) then - chg_val = ch_prms(1)%neg - chcal(ireg)%ord(iord)%prm%erod = ch_prms(1)%neg - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for width calibration and rerun - sd_ch(iich)%cherod = sd_ch(iich)%cherod * chg_val - sd_ch(iich)%cherod = amin1 (sd_ch(iich)%cherod, ch_prms(1)%up) - sd_ch(iich)%cherod = Max (sd_ch(iich)%cherod, ch_prms(1)%lo) - sdch_init(iich)%cherod = sd_ch(iich)%cherod - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! cover adjustment - if (isim > 0) then - cal_sim = " chan erodibility adj " - cal_adj = chg_val - call time_control - end if - end do ! icov - - !! finish - but leave code in case i need to add back - go to 777 - - - ! 1st bank shear coefficient adjustment for channel widening - isim = 0 - do ireg = 1, db_mx%ch_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chw - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%shear_bnk < 1.e-6) then - isim = 1 - - chcal(ireg)%ord(iord)%prm_prev = chcal(ireg)%ord(iord)%prm - chcal(ireg)%ord(iord)%prev = chcal(ireg)%ord(iord)%aa - - chg_val = chcal(ireg)%ord(iord)%meas%chw / (chcal(ireg)%ord(iord)%aa%chw + 1.e-6) !assume same ratio of cover and width change - chcal(ireg)%ord(iord)%prm_prev%shear_bnk = chcal(ireg)%ord(iord)%prm%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk = chcal(ireg)%ord(iord)%prm%shear_bnk + chg_val - chcal(ireg)%ord(iord)%prev%chw = chcal(ireg)%ord(iord)%aa%chw - - if (chcal(ireg)%ord(iord)%prm%shear_bnk >= ch_prms(3)%pos) then - chg_val = ch_prms(3)%pos - chcal(ireg)%ord(iord)%prm_prev%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk = ch_prms(3)%pos - chcal(ireg)%ord(iord)%prm_lim%shear_bnk = 1. - end if - if (chcal(ireg)%ord(iord)%prm%shear_bnk <= ch_prms(3)%neg) then - chg_val = ch_prms(3)%neg - chcal(ireg)%ord(iord)%prm_prev%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk = ch_prms(3)%neg - chcal(ireg)%ord(iord)%prm_lim%shear_bnk = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for 1st width calibration and rerun - sdch_init(iich)%shear_bnk = sdch_init(iich)%shear_bnk + chg_val - sdch_init(iich)%shear_bnk = amin1 (sdch_init(iich)%shear_bnk, ch_prms(3)%up) - sdch_init(iich)%shear_bnk = Max (sdch_init(iich)%shear_bnk, ch_prms(3)%lo) - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! 1st bank shear coefficient adjustment - if (isim > 0) then - write (4601,*) " first bank shear coeff adj " - call time_control - end if - - ! bank shear coefficient adjustment for channel widening - do icov = 1, iter_ind - isim = 0 - do ireg = 1, db_mx%cha_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chw - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chw) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%shear_bnk < 1.e-6) then - isim = 1 - - rmeas = chcal(ireg)%ord(iord)%meas%chw - denom = chcal(ireg)%ord(iord)%prev%chw - chcal(ireg)%ord(iord)%aa%chw - if (abs(denom) > 1.e-6) then - chg_val = - (chcal(ireg)%ord(iord)%prm_prev%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk) & - * (chcal(ireg)%ord(iord)%aa%chw - rmeas) / denom - else - chg_val = chcal(ireg)%ord(iord)%meas%chw / chcal(ireg)%ord(iord)%aa%chw - end if - chcal(ireg)%ord(iord)%prm_prev%shear_bnk = chcal(ireg)%ord(iord)%prm%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk = chcal(ireg)%ord(iord)%prm%shear_bnk + chg_val - chcal(ireg)%ord(iord)%prev%chw = chcal(ireg)%ord(iord)%aa%chw - - if (chcal(ireg)%ord(iord)%prm%shear_bnk >= ch_prms(3)%pos) then - chg_val = ch_prms(3)%pos - chcal(ireg)%ord(iord)%prm_prev%shear_bnk - chcal(ireg)%ord(iord)%prm%shear_bnk = ch_prms(3)%pos - chcal(ireg)%ord(iord)%prm_lim%shear_bnk = 1. - end if - if (chcal(ireg)%ord(iord)%prm%shear_bnk <= ch_prms(3)%neg) then - chg_val = chcal(ireg)%ord(iord)%prm_prev%shear_bnk - ch_prms(3)%neg - chcal(ireg)%ord(iord)%prm%shear_bnk = ch_prms(3)%neg - chcal(ireg)%ord(iord)%prm_lim%shear_bnk = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for width calibration and rerun - sdch_init(iich)%shear_bnk = sdch_init(iich)%shear_bnk + chg_val - sdch_init(iich)%shear_bnk = amin1 (sdch_init(iich)%shear_bnk, ch_prms(3)%up) - sdch_init(iich)%shear_bnk = Max (sdch_init(iich)%shear_bnk, ch_prms(3)%lo) - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! bank shear coefficient adjustment - if (isim > 0) then - write (4601,*) " bank shear coeff adj " - call time_control - end if - end do ! icov - - ! 1st erodibility adjustment for channel downcutting - isim = 0 - do ireg = 1, db_mx%ch_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chd - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chd) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%erod < 1.e-6) then - isim = 1 - - chcal(ireg)%ord(iord)%prm_prev = chcal(ireg)%ord(iord)%prm - chcal(ireg)%ord(iord)%prev = chcal(ireg)%ord(iord)%aa - - chg_val = chcal(ireg)%ord(iord)%meas%chd / (chcal(ireg)%ord(iord)%aa%chd + 1.e-6) !assume same ratio of cover and width change - chcal(ireg)%ord(iord)%prm_prev%erod = chcal(ireg)%ord(iord)%prm%erod - chcal(ireg)%ord(iord)%prm%erod = chcal(ireg)%ord(iord)%prm%erod + chg_val - chcal(ireg)%ord(iord)%prev%chd = chcal(ireg)%ord(iord)%aa%chd - - if (chcal(ireg)%ord(iord)%prm%erod >= ch_prms(2)%pos) then - chg_val = ch_prms(2)%pos - chcal(ireg)%ord(iord)%prm_prev%erod - chcal(ireg)%ord(iord)%prm%erod = ch_prms(2)%pos - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%erod <= ch_prms(2)%neg) then - chg_val = ch_prms(2)%neg - chcal(ireg)%ord(iord)%prm_prev%erod - chcal(ireg)%ord(iord)%prm%erod = ch_prms(2)%neg - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for 1st erodibility calibration and rerun - sdch_init(iich)%cherod = sdch_init(iich)%cherod / chg_val - sdch_init(iich)%cherod = amin1 (sdch_init(iich)%cherod, ch_prms(2)%up) - sdch_init(iich)%cherod = Max (sdch_init(iich)%cherod, ch_prms(2)%lo) - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! 1st erodibility adjustment - if (isim > 0) then - write (4601,*) " first erodibility adj " - call time_control - end if - - ! erodibility adjustment for channel downcutting - do ierod = 1, iter_ind - isim = 0 - do ireg = 1, db_mx%cha_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%chd - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%chd) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%erod < 1.e-6) then - isim = 1 - - rmeas = chcal(ireg)%ord(iord)%meas%chd - denom = chcal(ireg)%ord(iord)%prev%chd - chcal(ireg)%ord(iord)%aa%chd - if (abs(denom) > 1.e-6) then - chg_val = (chcal(ireg)%ord(iord)%prm_prev%erod - chcal(ireg)%ord(iord)%prm%erod) & - * (chcal(ireg)%ord(iord)%aa%chd - rmeas) / denom - else - chg_val = chcal(ireg)%ord(iord)%meas%chd / chcal(ireg)%ord(iord)%aa%chd - end if - chcal(ireg)%ord(iord)%prm_prev%erod = chcal(ireg)%ord(iord)%prm%erod - chcal(ireg)%ord(iord)%prm%erod = chcal(ireg)%ord(iord)%prm%erod + chg_val - chcal(ireg)%ord(iord)%prev%chd = chcal(ireg)%ord(iord)%aa%chd - - if (chcal(ireg)%ord(iord)%prm%erod >= ch_prms(2)%pos) then - chg_val = ch_prms(2)%pos - chcal(ireg)%ord(iord)%prm_prev%erod - chcal(ireg)%ord(iord)%prm%erod = ch_prms(2)%pos - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%erod <= ch_prms(2)%neg) then - chg_val = chcal(ireg)%ord(iord)%prm_prev%erod - ch_prms(2)%neg - chcal(ireg)%ord(iord)%prm%erod = ch_prms(2)%neg - chcal(ireg)%ord(iord)%prm_lim%erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !set parms for depth calibration and rerun - sdch_init(iich)%cherod = sdch_init(iich)%cherod / chg_val - sdch_init(iich)%cherod = amin1 (sdch_init(iich)%cherod, ch_prms(2)%up) - sdch_init(iich)%cherod = Max (sdch_init(iich)%cherod, ch_prms(2)%lo) - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! erodibility adjustment - if (isim > 0) then - write (4601,*) " erodibility adj " - call time_control - end if - end do ! ierod - - ! 1st erodibility adjustment for head cut - isim = 0 - do ireg = 1, db_mx%ch_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%hc - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%hc) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%hc_erod < 1.e-6) then - isim = 1 - - chcal(ireg)%ord(iord)%prm_prev = chcal(ireg)%ord(iord)%prm - chcal(ireg)%ord(iord)%prev = chcal(ireg)%ord(iord)%aa - - chg_val = chcal(ireg)%ord(iord)%meas%hc / (chcal(ireg)%ord(iord)%aa%hc + 1.e-6) !assume same ratio of cover and width change - chcal(ireg)%ord(iord)%prm_prev%hc_erod = chcal(ireg)%ord(iord)%prm%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod = chcal(ireg)%ord(iord)%prm%hc_erod + chg_val - chcal(ireg)%ord(iord)%prev%hc = chcal(ireg)%ord(iord)%aa%hc - - if (chcal(ireg)%ord(iord)%prm%hc_erod >= ch_prms(4)%pos) then - chg_val = ch_prms(4)%pos - chcal(ireg)%ord(iord)%prm_prev%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod = ch_prms(4)%pos - chcal(ireg)%ord(iord)%prm_lim%hc_erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%hc_erod <= ch_prms(4)%neg) then - chg_val = ch_prms(4)%neg - chcal(ireg)%ord(iord)%prm_prev%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod = ch_prms(4)%neg - chcal(ireg)%ord(iord)%prm_lim%hc_erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !if height is 0 - no head cut advance - sdch_init(iich)%hc_erod = sdch_init(iich)%hc_erod / chg_val - sdch_init(iich)%hc_erod = amin1 (sdch_init(iich)%hc_erod, ch_prms(4)%up) - sdch_init(iich)%hc_erod = Max (sdch_init(iich)%hc_erod, ch_prms(4)%lo) - !end if - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - !initialize hru and hru_lte - - !! re-initialize all objects - call re_initialize - - ! 1st erodibility adjustment - if (isim > 0) then - write (4601,*) " first head cut erodibility adj " - call time_control - end if - - ! erodibility adjustment for head cut - do ierod = 1, iter_ind - isim = 0 - do ireg = 1, db_mx%cha_reg - do iord = 1, chcal(ireg)%ord_num - soft = chcal(ireg)%ord(iord)%meas%hc - diff = 0. - if (soft > 1.e-6) diff = abs((soft - chcal(ireg)%ord(iord)%aa%hc) / soft) - if (diff > .02 .and. chcal(ireg)%ord(iord)%length > 1.e-6 .and. chcal(ireg)%ord(iord)%prm_lim%hc_erod < 1.e-6) then - isim = 1 - - rmeas = chcal(ireg)%ord(iord)%meas%hc - denom = chcal(ireg)%ord(iord)%prev%hc - chcal(ireg)%ord(iord)%aa%hc - if (abs(denom) > 1.e-6) then - chg_val = - (chcal(ireg)%ord(iord)%prm_prev%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod) & - * (chcal(ireg)%ord(iord)%aa%hc - rmeas) / denom - else - chg_val = chcal(ireg)%ord(iord)%meas%hc / chcal(ireg)%ord(iord)%aa%hc - end if - chcal(ireg)%ord(iord)%prm_prev%hc_erod = chcal(ireg)%ord(iord)%prm%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod = chcal(ireg)%ord(iord)%prm%hc_erod + chg_val - chcal(ireg)%ord(iord)%prev%hc = chcal(ireg)%ord(iord)%aa%hc - - if (chcal(ireg)%ord(iord)%prm%hc_erod >= ch_prms(4)%pos) then - chg_val = ch_prms(4)%pos - chcal(ireg)%ord(iord)%prm_prev%hc_erod - chcal(ireg)%ord(iord)%prm%hc_erod = ch_prms(4)%pos - chcal(ireg)%ord(iord)%prm_lim%hc_erod = 1. - end if - if (chcal(ireg)%ord(iord)%prm%hc_erod <= ch_prms(4)%neg) then - chg_val = chcal(ireg)%ord(iord)%prm_prev%hc_erod - ch_prms(4)%neg - chcal(ireg)%ord(iord)%prm%hc_erod = ch_prms(4)%neg - chcal(ireg)%ord(iord)%prm_lim%hc_erod = 1. - end if - - !check all channels for proper order - do ich_s = 1, chcal(ireg)%num_tot - iich = chcal(ireg)%num(ich_s) - if (chcal(ireg)%ord(iord)%meas%name == sd_ch(iich)%order .or. chcal(ireg)%ord(iord)%meas%name == "basin") then - !if height is 0 - no head cut advance - if (sd_ch(iich)%hc_hgt > 1.e-6) then - sdch_init(iich)%hc_erod = sdch_init(iich)%hc_erod / chg_val - sdch_init(iich)%hc_erod = amin1 (sdch_init(iich)%hc_erod, ch_prms(4)%up) - sdch_init(iich)%hc_erod = Max (sdch_init(iich)%hc_erod, ch_prms(4)%lo) - end if - end if - end do - chcal(ireg)%ord(iord)%nbyr = 0 - chcal(ireg)%ord(iord)%aa = chcal_z - end if - end do - end do - - !! re-initialize all objects - call re_initialize - - ! erodibility adjustment - if (isim > 0) then - write (4601,*) " head cut erodibility adj " - call time_control - end if - end do ! ierod - -777 end do ! iter - - return - end subroutine calsoft_chsed \ No newline at end of file diff --git a/src/calsoft_control.f90 b/src/calsoft_control.f90 index 3a29827..0fddcb9 100644 --- a/src/calsoft_control.f90 +++ b/src/calsoft_control.f90 @@ -98,9 +98,9 @@ subroutine calsoft_control end if !calibrate channel sediment - if (cal_codes%chsed == "y") then - call calsoft_chsed - end if + !if (cal_codes%chsed == "y") then + ! call calsoft_chsed + !end if if (cal_codes%chsed == "y") then do ireg = 1, db_mx%ch_reg diff --git a/src/calsoft_hyd_bfr.f90 b/src/calsoft_hyd_bfr.f90 index 03cae4c..cc737c6 100644 --- a/src/calsoft_hyd_bfr.f90 +++ b/src/calsoft_hyd_bfr.f90 @@ -26,8 +26,22 @@ subroutine calsoft_hyd_bfr do iterall = 1, iter_all - ! calibrate harg_pet for potential ET + ! calibrate petco for actual ET + ! start with half the range + ls_prms(4)%neg = ls_prms(4)%neg / 2. + ls_prms(4)%pos = ls_prms(4)%pos / 2. + ls_prms(4)%lo = (1. - ls_prms(4)%lo) / 2. + ls_prms(4)%lo + ls_prms(4)%up = ls_prms(4)%up - (ls_prms(4)%up - 1.) / 2. + call calsoft_hyd_bfr_pet + ! calibrate esco for actual ET call calsoft_hyd_bfr_et + ! calibrate petco for actual ET + ! allow full range + ls_prms(4)%neg = 2. * ls_prms(4)%neg + ls_prms(4)%pos = 2. * ls_prms(4)%pos + ls_prms(4)%lo = ls_prms(4)%lo - (1. - ls_prms(4)%lo) + ls_prms(4)%up = ls_prms(4)%up + (ls_prms(4)%up - 1.) + call calsoft_hyd_bfr_pet ! calibrate cn3_swf for surface runoff call calsoft_hyd_bfr_surq diff --git a/src/calsoft_hyd_bfr_et.f90 b/src/calsoft_hyd_bfr_et.f90 index 945f27a..eeaf17f 100644 --- a/src/calsoft_hyd_bfr_et.f90 +++ b/src/calsoft_hyd_bfr_et.f90 @@ -36,76 +36,15 @@ subroutine calsoft_hyd_bfr_et ! calibrate esco and pet for water yield iter_ind = 1 - ! first calibrate potential et - do ietco = 1, 2 !iter_ind - isim = 0 - do ireg = 1, db_mx%lsu_reg - do ilum = 1, region(ireg)%nlum - soft = lscal(ireg)%lum(ilum)%meas%wyr * lscal(ireg)%lum(ilum)%precip_aa - pred = lscal(ireg)%lum(ilum)%aa%wyr - diff = 0. - if (soft > 1.e-6) diff = abs((soft - pred) / soft) - if (diff > .01 .and. lscal(ireg)%lum(ilum)%ha > 1.e-6) then - isim = 1 - lscal(ireg)%lum(ilum)%prm_prev = lscal(ireg)%lum(ilum)%prm - lscal(ireg)%lum(ilum)%prev = lscal(ireg)%lum(ilum)%aa - if (soft < pred) then - chg_val = 1. + abs((soft - pred) / soft) - else - chg_val = 1. - abs((pred - soft) / pred) - end if - lscal(ireg)%lum(ilum)%prm_prev%petco = lscal(ireg)%lum(ilum)%prm%petco - if (ietco == 1) then - lscal(ireg)%lum(ilum)%prm%petco = chg_val - else - lscal(ireg)%lum(ilum)%prm%petco = lscal(ireg)%lum(ilum)%prm%petco * chg_val - end if - lscal(ireg)%lum(ilum)%prm_prev%petco = pred - if (lscal(ireg)%lum(ilum)%prm%petco >= ls_prms(4)%pos) then - chg_val = ls_prms(4)%pos - lscal(ireg)%lum(ilum)%prm%petco = ls_prms(4)%pos - lscal(ireg)%lum(ilum)%prm_lim%petco = 1. - end if - if (lscal(ireg)%lum(ilum)%prm%petco <= ls_prms(4)%neg) then - chg_val = ls_prms(4)%neg - lscal(ireg)%lum(ilum)%prm%petco = ls_prms(4)%neg - lscal(ireg)%lum(ilum)%prm_lim%petco = 1. - end if - !check all hru"s for proper lum - do ihru_s = 1, region(ireg)%num_tot - iihru = region(ireg)%num(ihru_s) - if (lscal(ireg)%lum(ilum)%meas%name == hru(iihru)%lum_group_c .or. lscal(ireg)%lum(ilum)%meas%name == "basin") then - !set parms for pet adjustment - hru(iihru)%hyd%pet_co = hru(iihru)%hyd%pet_co * chg_val - hru(iihru)%hyd%pet_co = amin1 (hru(iihru)%hyd%pet_co, ls_prms(4)%up) - hru(iihru)%hyd%pet_co = Max (hru(iihru)%hyd%pet_co, ls_prms(4)%lo) - hru_init(iihru)%hyd%pet_co = hru(iihru)%hyd%pet_co - end if - end do - lscal(ireg)%lum(ilum)%nbyr = 0 - lscal(ireg)%lum(ilum)%precip_aa = 0. - lscal(ireg)%lum(ilum)%aa = lscal_z - end if - end do - end do - !! re-initialize all objects - call re_initialize - ! 1st cover adjustment - if (isim > 0) then - cal_sim = " first pet adj " - cal_adj = chg_val - call time_control - end if - end do ! petco iterations ! 1st esco adjustment isim = 0 diff --git a/src/calsoft_hyd_bfr_pet.f90 b/src/calsoft_hyd_bfr_pet.f90 new file mode 100644 index 0000000..f7d964b --- /dev/null +++ b/src/calsoft_hyd_bfr_pet.f90 @@ -0,0 +1,96 @@ + subroutine calsoft_hyd_bfr_pet + use hru_module, only : hru, hru_init + use soil_module + use plant_module + use hydrograph_module + use ru_module + use aquifer_module + use channel_module + use hru_lte_module + use sd_channel_module + use basin_module + use maximum_data_module + use calibration_data_module + use conditional_module + use reservoir_module + use organic_mineral_mass_module + use time_module + implicit none + integer :: isim = 0 ! | + integer :: ireg = 0 !none |counter + integer :: ilum = 0 !none |counter + integer :: iihru = 0 !none |counter + integer :: ihru_s = 0 !none |counter + integer :: iter_ind = 0 ! |end of loop + integer :: ietco = 0 !none |counter + real :: rmeas = 0. ! | + real :: denom = 0. ! | + real :: soft = 0. ! | + real :: diff = 0. ! | + real :: chg_val = 0. ! | + real :: pred = 0. + ! calibrate esco and pet for water yield + iter_ind = 1 + ! first calibrate potential et + do ietco = 1, 2 !iter_ind + isim = 0 + do ireg = 1, db_mx%lsu_reg + do ilum = 1, region(ireg)%nlum + soft = lscal(ireg)%lum(ilum)%meas%wyr * lscal(ireg)%lum(ilum)%precip_aa + pred = lscal(ireg)%lum(ilum)%aa%wyr + diff = 0. + if (soft > 1.e-6) diff = abs((soft - pred) / soft) + if (diff > .01 .and. lscal(ireg)%lum(ilum)%ha > 1.e-6) then + isim = 1 + lscal(ireg)%lum(ilum)%prm_prev = lscal(ireg)%lum(ilum)%prm + lscal(ireg)%lum(ilum)%prev = lscal(ireg)%lum(ilum)%aa + if (soft < pred) then + chg_val = 1. + abs((soft - pred) / soft) + else + chg_val = 1. - abs((pred - soft) / pred) + end if + lscal(ireg)%lum(ilum)%prm_prev%petco = lscal(ireg)%lum(ilum)%prm%petco + if (ietco == 1) then + lscal(ireg)%lum(ilum)%prm%petco = chg_val + else + lscal(ireg)%lum(ilum)%prm%petco = lscal(ireg)%lum(ilum)%prm%petco * chg_val + end if + lscal(ireg)%lum(ilum)%prm_prev%petco = pred + if (lscal(ireg)%lum(ilum)%prm%petco >= ls_prms(4)%pos) then + chg_val = ls_prms(4)%pos + lscal(ireg)%lum(ilum)%prm%petco = ls_prms(4)%pos + lscal(ireg)%lum(ilum)%prm_lim%petco = 1. + end if + if (lscal(ireg)%lum(ilum)%prm%petco <= ls_prms(4)%neg) then + chg_val = ls_prms(4)%neg + lscal(ireg)%lum(ilum)%prm%petco = ls_prms(4)%neg + lscal(ireg)%lum(ilum)%prm_lim%petco = 1. + end if + !check all hru"s for proper lum + do ihru_s = 1, region(ireg)%num_tot + iihru = region(ireg)%num(ihru_s) + if (lscal(ireg)%lum(ilum)%meas%name == hru(iihru)%lum_group_c .or. lscal(ireg)%lum(ilum)%meas%name == "basin") then + !set parms for pet adjustment + hru(iihru)%hyd%pet_co = hru(iihru)%hyd%pet_co * chg_val + hru(iihru)%hyd%pet_co = amin1 (hru(iihru)%hyd%pet_co, ls_prms(4)%up) + hru(iihru)%hyd%pet_co = Max (hru(iihru)%hyd%pet_co, ls_prms(4)%lo) + hru_init(iihru)%hyd%pet_co = hru(iihru)%hyd%pet_co + end if + end do + lscal(ireg)%lum(ilum)%nbyr = 0 + lscal(ireg)%lum(ilum)%precip_aa = 0. + lscal(ireg)%lum(ilum)%aa = lscal_z + end if + end do + end do + !! re-initialize all objects + call re_initialize + ! 1st cover adjustment + if (isim > 0) then + cal_sim = " first pet adj " + cal_adj = chg_val + call time_control + end if + end do ! petco iterations + return + end subroutine calsoft_hyd_bfr_pet \ No newline at end of file diff --git a/src/ch_rtmusk.f90 b/src/ch_rtmusk.f90 index c2b2a0e..52e2439 100644 --- a/src/ch_rtmusk.f90 +++ b/src/ch_rtmusk.f90 @@ -161,6 +161,7 @@ subroutine ch_rtmusk !! Variable Storage Coefficent method - sc=2*dt/(2*ttime+dt) - ttime=(in2+out1)/2 scoef = dthr / (ch_rcurv(jrch)%in2%ttime + ch_rcurv(jrch)%out1%ttime + dthr) + scoef = bsn_prm%scoef * 2. * dthr / (2.* ch_rcurv(jrch)%out1%ttime + dthr) !***jga scoef = Min (scoef, 1.) outflo = scoef * tot_stor(jrch)%flo end if diff --git a/src/ch_rtpest.f90 b/src/ch_rtpest.f90 index f039a51..c017659 100644 --- a/src/ch_rtpest.f90 +++ b/src/ch_rtpest.f90 @@ -160,7 +160,7 @@ subroutine ch_rtpest !! calculate amount of pesticide that undergoes chemical or biological degradation on day in reach pest_init = chpstmass if (pest_init > 1.e-12) then - pest_end = chpstmass * (pestcp(jpst)%decay_a * tday) + pest_end = chpstmass * (pestcp(jpst)%decay_a ** tday) chpstmass = pest_end chpst%pest(ipest)%react = pest_init - pest_end !! add decay to daughter pesticides diff --git a/src/ch_watqual4.f90 b/src/ch_watqual4.f90 index a80a79e..9a78b56 100644 --- a/src/ch_watqual4.f90 +++ b/src/ch_watqual4.f90 @@ -105,16 +105,6 @@ subroutine ch_watqual4 ht3%cbod = 1000. * ht1%cbod / ht1%flo ht3%dox = 1000. * ht1%dox / ht1%flo - !! ht5 is concentration from previous time step - ht5%orgn = 1000. * ob(icmd)%conc_prev%orgn / ht1%flo - ht5%sedp = 1000. * ob(icmd)%conc_prev%sedp / ht1%flo - ht5%no3 = 1000. * ob(icmd)%conc_prev%no3 / ht1%flo - ht5%solp = 1000. * ob(icmd)%conc_prev%solp / ht1%flo - ht5%chla = 1000. * ob(icmd)%conc_prev%chla / ht1%flo - ht5%nh3 = 1000. * ob(icmd)%conc_prev%nh3 / ht1%flo - ht5%no2 = 1000. * ob(icmd)%conc_prev%no2 / ht1%flo - ht5%cbod = 1000. * ob(icmd)%conc_prev%cbod / ht1%flo - ht5%dox = 1000. * ob(icmd)%conc_prev%dox / ht1%flo !! calculate temperature in stream Stefan and Preudhomme. 1993. Stream temperature estimation !! from air temperature. Water Res. Bull. p. 27-45 SWAT manual equation 2.3.13 @@ -123,6 +113,7 @@ subroutine ch_watqual4 ht2%temp = wtmp !! benthic sources/losses in mg + !ch_nut(jnut)%rs2 = 5. !!***jga rs2_s = Theta(ch_nut(jnut)%rs2,thrs2,wtmp) * ben_area !ch_hyd(jhyd)%l *ch_hyd(jhyd)%w * rt_delt rs3_s = Theta(ch_nut(jnut)%rs3,thrs3,wtmp) * ben_area !ch_hyd(jhyd)%l *ch_hyd(jhyd)%w * rt_delt rk4_s = Theta(ch_nut(jnut)%rk4,thrk4,wtmp) * ben_area !ch_hyd(jhyd)%l *ch_hyd(jhyd)%w * rt_delt @@ -192,6 +183,7 @@ subroutine ch_watqual4 (ch_nut(jnut)%k_l + algi * (Exp(-lambda * rchdep)))) fll = 0.92 * (wgn_pms(iwgn)%daylth / 24.) * fl_1 + !ch_nut(jnut)%mumax = 3. !***jga !! calculcate local algal growth rate if (algcon < 5000.) then select case (ch_nut(jnut)%igropt) @@ -244,13 +236,13 @@ subroutine ch_watqual4 cbodo = min (ht3%cbod, ht3%dox) cbodoin = min (ht3%cbod, ht3%dox) rk1_k = -Theta (ch_nut(jnut)%rk1, thrk1,wtmp) - rk1_m = wq_k2m (tday, rt_delt, rk1_k, ht5%cbod, ht3%cbod) + rk1_m = wq_k2m (tday, rt_delt, rk1_k, ht3%cbod, ht3%cbod) !! calculate corresponding m-term rk3_k=0. if (rchdep > 0.001) rk3_k = -Theta (ch_nut(jnut)%rk3, thrk3, wtmp) / rchdep factm = rk1_m factk = rk3_k - ht3%cbod = wq_semianalyt (tday, rt_delt, factm, factk, ht5%cbod, ht3%cbod) + ht3%cbod = wq_semianalyt (tday, rt_delt, factm, factk, ht3%cbod, ht3%cbod) !! nitrogen calculations !! calculate organic N concentration at end of day @@ -262,10 +254,10 @@ subroutine ch_watqual4 rs4_k = 0. if (rchdep > 0.001) rs4_k = Theta (ch_nut(jnut)%rs4, thrs4, wtmp) / rchdep - bc3_m = wq_k2m (tday, rt_delt, -bc3_k, ht5%orgn, ht3%orgn) + bc3_m = wq_k2m (tday, rt_delt, -bc3_k, ht3%orgn, ht3%orgn) factk = -rs4_k factm = bc3_m - ht3%orgn = wq_semianalyt (tday, rt_delt, factm, factk, ht5%orgn, ht3%orgn) + ht3%orgn = wq_semianalyt (tday, rt_delt, factm, factk, ht3%orgn, ht3%orgn) if (ht3%orgn <0.) ht3%orgn = 0. !! calculate dissolved oxygen concentration if reach at end of day QUAL2E section 3.6 equation III-28 @@ -277,10 +269,10 @@ subroutine ch_watqual4 factk = - rk2_k bc2_k = -Theta (ch_nut(jnut)%bc2, thbc2, wtmp) - bc1_m = wq_k2m (tday, rt_delt, factk, ht5%nh3, ammoin) - bc2_m = wq_k2m (tday, rt_delt, bc2_k, ht5%no2, ht3%no2) + bc1_m = wq_k2m (tday, rt_delt, factk, ht3%nh3, ammoin) + bc2_m = wq_k2m (tday, rt_delt, bc2_k, ht3%no2, ht3%no2) factm = rk1_m + rk2_m - rs4_k + bc1_m * ch_nut(jnut)%ai5 + bc2_m * ch_nut(jnut)%ai6 - ht3%dox = wq_semianalyt (tday, rt_delt, factm, factk, ht5%dox, ht3%dox) + ht3%dox = wq_semianalyt (tday, rt_delt, factm, factk, ht3%dox, ht3%dox) if (ht3%dox <0.) ht3%dox = 0. !! end oxygen calculations @@ -288,53 +280,52 @@ subroutine ch_watqual4 !! calculate ammonia nitrogen concentration at end of day QUAL2E section 3.3.2 equation III-17 factk = -bc1_k factm = bc1_m - bc3_m - ht3%nh3 = wq_semianalyt (tday, rt_delt, factm, 0., ht5%nh3, ammoin) + ht3%nh3 = wq_semianalyt (tday, rt_delt, factm, 0., ht3%nh3, ammoin) if (ht3%nh3 < 1.e-6) ht3%nh3 = 0. !! calculate concentration of nitrite at end of day QUAL2E section 3.3.3 equation III-19 factm = -bc1_m + bc2_m - ht3%no2 = wq_semianalyt (tday, rt_delt, factm, 0., ht5%no2, ht3%no2) + ht3%no2 = wq_semianalyt (tday, rt_delt, factm, 0., ht3%no2, ht3%no2) if (ht3%no2 < 1.e-6) ht3%no2 = 0. !! calculate nitrate concentration at end of day QUAL2E section 3.3.4 equation III-20 factk = 0. factm = -bc2_m - ht3%no3 = wq_semianalyt (tday, rt_delt, factm, 0., ht5%no3, ht3%no3) + ht3%no3 = wq_semianalyt (tday, rt_delt, factm, 0., ht3%no3, ht3%no3) if (ht3%no3 < 1.e-6) ht3%no3 = 0. !! end nitrogen calculations !! phosphorus calculations !! calculate organic phosphorus concentration at end of day QUAL2E section 3.3.6 equation III-24 bc4_k = Theta (ch_nut(jnut)%bc4, thbc4,wtmp) - bc4_m = wq_k2m (tday, rt_delt, -bc4_k, ht5%sedp, ht3%sedp) + bc4_m = wq_k2m (tday, rt_delt, -bc4_k, ht3%sedp, ht3%sedp) rs5_k = 0. + !ch_nut(jnut)%rs5 = 0. ! ***jga if (rchdep > 0.001) rs5_k = Theta (ch_nut(jnut)%rs5, thrs5, wtmp) / rchdep factk = -rs5_k factm = bc4_m - ht3%sedp = wq_semianalyt (tday, rt_delt, factm, factk, ht5%sedp, ht3%sedp) + ht3%sedp = wq_semianalyt (tday, rt_delt, factm, factk, ht3%sedp, ht3%sedp) if (ht3%sedp < 1.e-6) ht3%sedp = 0. + !! calculate dissolved phosphorus concentration at end of day QUAL2E section 3.4.2 equation III-25 + !factk = 0. + !factm = -bc4_m + ch_nut(jnut)%ai2 * alg_m + !ht3%solp = wq_semianalyt (tday, rt_delt, factm, 0., ht3%solp, dispin) + !if (ht3%solp < 1.e-6) ht3%solp = 0. !! calculate dissolved phosphorus concentration at end of day QUAL2E section 3.4.2 equation III-25 factk = 0. factm = -bc4_m + ch_nut(jnut)%ai2 * alg_m - ht3%solp = wq_semianalyt (tday, rt_delt, factm, 0., ht5%solp, dispin) + !ht3%solp = wq_semianalyt (tday, rt_delt, factm, 0., ht5%solp, dispin) + xx = Theta (ch_nut(jnut)%bc4, thbc4,wtmp) * ht3%sedp + yy = Theta(ch_nut(jnut)%rs2, thrs2, wtmp) / (sd_chd(jrch)%chd) + zz = ch_nut(jnut)%ai2 * Theta(gra,thgra,wtmp) * algin + ht3%solp = ht3%solp + (xx + yy - zz) * tday if (ht3%solp < 1.e-6) ht3%solp = 0. !! end phosphorus calculations - !! save concentration for next time step - ob(icmd)%conc_prev%orgn = ht3%orgn * ht1%flo / 1000. - ob(icmd)%conc_prev%sedp = ht3%sedp * ht1%flo / 1000. - ob(icmd)%conc_prev%no3 = ht3%no3 * ht1%flo / 1000. - ob(icmd)%conc_prev%solp = ht3%solp * ht1%flo / 1000. - ob(icmd)%conc_prev%chla = ht3%chla * ht1%flo / 1000. - ob(icmd)%conc_prev%nh3 = ht3%nh3 * ht1%flo / 1000. - ob(icmd)%conc_prev%no2 = ht3%no2 * ht1%flo / 1000. - ob(icmd)%conc_prev%cbod = ht3%cbod * ht1%flo / 1000. - ob(icmd)%conc_prev%dox = ht3%dox * ht1%flo / 1000. - !! convert back from concentration to mass for routing ht2%orgn = ht3%orgn * ht1%flo / 1000. ht2%sedp = ht3%sedp * ht1%flo / 1000. diff --git a/src/channel_control.f90 b/src/channel_control.f90 index 3d8cb7e..26223ca 100644 --- a/src/channel_control.f90 +++ b/src/channel_control.f90 @@ -95,25 +95,25 @@ subroutine channel_control ch(jrch)%dep_chan = 0. sedrch = 0. rch_san = 0. - rch_cla = 0. rch_sil = 0. + rch_cla = 0. rch_sag = 0. - rch_gra = 0. rch_lag = 0. + rch_gra = 0. wtrin = 0. - algin = 0. chlin = 0. + algin = 0. orgnin = 0. - nitritin = 0. ammoin = 0. + nitritin = 0. nitratin = 0. orgpin = 0. dispin = 0. cbodin = 0. disoxin = 0. + cinn = 0. !! route water through reach rtwtr_d=0. - cinn = 0. rttlc_d=0. rtevp_d =0. diff --git a/src/climate_control.f90 b/src/climate_control.f90 index 889e258..48c4210 100644 --- a/src/climate_control.f90 +++ b/src/climate_control.f90 @@ -211,9 +211,9 @@ subroutine climate_control xl = 2.501 - 2.361e-3 * wst(iwst)%weat%tave wst(iwst)%weat%pet = .0023 * (ramm / xl) * (wst(iwst)%weat%tave & + 17.8) * (wst(iwst)%weat%tmax - wst(iwst)%weat%tmin) ** 0.5 - wst(iwst)%weat%pet = Max(0., wst(iwst)%weat%pet) + wst(iwst)%weat%pet = Max(0.01, wst(iwst)%weat%pet) else - wst(iwst)%weat%pet = 0. + wst(iwst)%weat%pet = 0.01 endif if (wst(iwst)%weat%pet > 0.1) then wst(iwst)%weat%ppet = wst(iwst)%weat%ppet + wst(iwst)%weat%precip / wst(iwst)%weat%pet diff --git a/src/climate_module.f90 b/src/climate_module.f90 index 6670016..43c5fbb 100644 --- a/src/climate_module.f90 +++ b/src/climate_module.f90 @@ -120,7 +120,7 @@ module climate_module character (len=50) :: sgage = "" !! gage name for solar radiation character (len=50) :: hgage = "" !! gage name for relative humidity character (len=50) :: wgage = "" !! gage name for windspeed - character (len=50) :: petgage = "" !! name of pet gage ? + character (len=50) :: petgage = "" !! name of pet gage character (len=50) :: atmodep = "" !! atmospheric depostion data file locator end type weather_codes_station_char diff --git a/src/command.f90 b/src/command.f90 index a1e5be6..4258cc5 100644 --- a/src/command.f90 +++ b/src/command.f90 @@ -112,6 +112,11 @@ subroutine command if (cs_db%num_tot > 0 .and. obcs_alloc(icmd).eq.1) then obcs(icmd)%hin_sur(1) = obcs(icmd)%hin_sur(1) + frac_in * obcs(iob)%hd(3) end if + ! add to tile flow + ob(icmd)%hin_til = ob(icmd)%hin_til + frac_in * ob(iob)%hd(5) + if (cs_db%num_tot > 0 .and. obcs_alloc(icmd).eq.1) then + obcs(icmd)%hin_til(1) = obcs(icmd)%hin_til(1) + frac_in * obcs(iob)%hd(5) + end if ! add to lateral soil runon ob(icmd)%hin_lat = ob(icmd)%hin_lat + frac_in * ob(iob)%hd(4) if (cs_db%num_tot > 0 .and. obcs_alloc(icmd).eq.1) then diff --git a/src/conditional_module.f90 b/src/conditional_module.f90 index 523f2c7..37ad3b7 100644 --- a/src/conditional_module.f90 +++ b/src/conditional_module.f90 @@ -33,6 +33,7 @@ module conditional_module type (conditions_var), dimension(:), allocatable :: cond ! conditions character(len=25), dimension(:,:), allocatable :: alt ! condition alternatives type (actions_var), dimension(:), allocatable :: act ! actions + integer, dimension(:), allocatable :: lu_chg_mx ! max times lu change can occur character(len=1), dimension(:,:), allocatable :: act_outcomes ! action outcomes ("y" to perform action; "n" to not perform) character(len=1), dimension(:), allocatable :: act_hit ! "y" if all condition alternatives (rules) are met; "n" if not integer, dimension(:), allocatable :: act_typ ! pointer to action type (ie plant, fert type, tillage implement, release type, etc) diff --git a/src/conditions.f90 b/src/conditions.f90 index 507984c..8afbdff 100644 --- a/src/conditions.f90 +++ b/src/conditions.f90 @@ -191,7 +191,7 @@ subroutine conditions (ob_cur, idtbl) ipl = Max (Int(d_tbl%cond(ic)%lim_const), 1) do ialt = 1, d_tbl%alts if (d_tbl%alt(ic,ialt) == "=") then !determine if growing (y) or not (n) - if (pcom(ob_num)%plcur(ipl)%gro /= d_tbl%cond(ic)%lim_var) then + if (pcom(ob_num)%plcur(ipl)%gro == "n") then d_tbl%act_hit(ialt) = "n" end if end if @@ -343,6 +343,12 @@ subroutine conditions (ob_cur, idtbl) ivar_tbl = int(d_tbl%cond(ic)%lim_const) call cond_integer (ic, ivar_cur, ivar_tbl) + !sequential year of simulation + case ("year_start") + ivar_cur = time%yrc_start + ivar_tbl = int(d_tbl%cond(ic)%lim_const) + call cond_integer (ic, ivar_cur, ivar_tbl) + !current years of maturity for perennial plants case ("cur_yrs_mat") ob_num = d_tbl%cond(ic)%ob_num @@ -450,12 +456,12 @@ subroutine conditions (ob_cur, idtbl) do ialt = 1, d_tbl%alts if (d_tbl%alt(ic,ialt) == "=") then - if (hru(ob_num)%tiledrain /= Int(d_tbl%cond(ic)%lim_const)) then + if (hru(ob_num)%tiledrain == 0) then d_tbl%act_hit(ialt) = "n" end if end if if (d_tbl%alt(ic,ialt) == "/") then - if (hru(ob_num)%tiledrain == Int(d_tbl%cond(ic)%lim_const)) then + if (hru(ob_num)%tiledrain == 1) then d_tbl%act_hit(ialt) = "n" end if end if @@ -643,6 +649,17 @@ subroutine conditions (ob_cur, idtbl) end if end do + !calibration group in landuse.lum - ie: cropland, urban, forest, etc + case ("cal_group") + ob_num = d_tbl%cond(ic)%ob_num + if (ob_num == 0) ob_num = ob_cur + do ialt = 1, d_tbl%alts + if (d_tbl%alt(ic,ialt) == "=") then + if (hru(ob_num)%cal_group /= d_tbl%cond(ic)%lim_var) then + d_tbl%act_hit(ialt) = "n" + end if + end if + end do !tillage system - name of tillage decision table in lum.dtl case ("tillage") ob_num = d_tbl%cond(ic)%ob_num @@ -663,7 +680,7 @@ subroutine conditions (ob_cur, idtbl) end do !plants - if plant is in the cummunity - case ("plant") + case ("plant_com") ob_num = d_tbl%cond(ic)%ob_num if (ob_num == 0) ob_num = ob_cur @@ -692,7 +709,7 @@ subroutine conditions (ob_cur, idtbl) end do !channel management - case ("ch_use") + case ("ch_order") ob_num = d_tbl%cond(ic)%ob_num if (ob_num == 0) ob_num = ob_cur @@ -724,6 +741,8 @@ subroutine conditions (ob_cur, idtbl) targ = targ_val + 10000. * d_tbl%cond(ic)%lim_const case ("-") targ = targ_val - 10000. * d_tbl%cond(ic)%lim_const !convert ha-m to m3 + case ("/") + targ = targ_val / d_tbl%cond(ic)%lim_const end select case ("evol") !emergency storage volume targ_val = res_ob(ires)%evol @@ -735,6 +754,8 @@ subroutine conditions (ob_cur, idtbl) targ = targ_val + 10000. * d_tbl%cond(ic)%lim_const case ("-") targ = targ_val - 10000. * d_tbl%cond(ic)%lim_const !convert ha-m to m3 + case ("/") + targ = targ_val / d_tbl%cond(ic)%lim_const end select end select @@ -749,20 +770,15 @@ subroutine conditions (ob_cur, idtbl) iob = sp_ob1%res + ob_num - 1 flo_m3 = ob(iob)%hin%flo / 86400. call cond_real (ic, flo_m3, d_tbl%cond(ic)%lim_const, idtbl) - - !impounded water depth -paddy average water depth of water + !impounded water depth -paddy average water depth case ("wet_depth") !determine target variable ires = d_tbl%cond(ic)%ob_num if (ires == 0) ires = ob_cur - !set limit constant if comparing to weir height - if (d_tbl%cond(ic)%lim_var == "hwater") then - targ = d_tbl%cond(ic)%lim_const/1000. !m - else - targ = wet_ob(ires)%weir_hgt - end if + !convert depth to m + targ = d_tbl%cond(ic)%lim_const/1000. !check alternatives call cond_real (ic, wet_ob(ires)%depth, targ, idtbl) @@ -773,8 +789,8 @@ subroutine conditions (ob_cur, idtbl) ires = d_tbl%cond(ic)%ob_num if (ires == 0) ires = ob_cur - !set limit constant if comparing to weir height - targ = d_tbl%cond(ic)%lim_const/1000. !m + !convert depth to m + targ = d_tbl%cond(ic)%lim_const/1000. !check alternatives call cond_real (ic, wet_ob(ires)%weir_hgt, targ, idtbl) diff --git a/src/constituent_mass_module.f90 b/src/constituent_mass_module.f90 index b77313b..41bd6a5 100644 --- a/src/constituent_mass_module.f90 +++ b/src/constituent_mass_module.f90 @@ -596,9 +596,9 @@ function hydcsout_add (hydcs1, hydcs2) result (hydcs3) integer :: ics = 0 allocate (hydcs3%pest(cs_db%num_pests), source = 0.) allocate (hydcs3%path(cs_db%num_paths), source = 0.) + allocate (hydcs3%hmet(cs_db%num_metals), source = 0.) allocate (hydcs3%salt(cs_db%num_salts), source = 0.) allocate (hydcs3%cs(cs_db%num_cs), source = 0.) - allocate (hydcs3%hmet(cs_db%num_metals), source = 0.) do ipest = 1, cs_db%num_pests hydcs3%pest(ipest) = hydcs2%pest(ipest) + hydcs1%pest(ipest) @@ -629,10 +629,10 @@ function hydcsout_mult_const (const, hydcs1) result (hydcs2) integer :: ics = 0 allocate (hydcs2%pest(cs_db%num_pests), source = 0.) allocate (hydcs2%path(cs_db%num_paths), source = 0.) + allocate (hydcs2%hmet(cs_db%num_metals), source = 0.) allocate (hydcs2%salt(cs_db%num_salts), source = 0.) - allocate (hydcs2%cs(cs_db%num_cs), source = 0.) !rtb cs - allocate (hydcs2%hmet(cs_db%num_metals), source = 0.) + allocate (hydcs2%cs(cs_db%num_cs), source = 0.) !rtb cs do ipest = 1, cs_db%num_pests hydcs2%pest(ipest) = const * hydcs1%pest(ipest) diff --git a/src/dtbl_scen_read.f90 b/src/dtbl_scen_read.f90 index 4926b78..3bffe2a 100644 --- a/src/dtbl_scen_read.f90 +++ b/src/dtbl_scen_read.f90 @@ -51,6 +51,8 @@ subroutine dtbl_scen_read allocate (dtbl_scen(i)%act_hit(dtbl_scen(i)%alts)) allocate (dtbl_scen(i)%act_typ(dtbl_scen(i)%acts), source = 0) allocate (dtbl_scen(i)%act_app(dtbl_scen(i)%acts), source = 0) + allocate (dtbl_scen(i)%lu_chg_mx(dtbl_scen(i)%acts), source = 0) + allocate (dtbl_scen(i)%act_outcomes(dtbl_scen(i)%acts,dtbl_scen(i)%alts)) !read conditions and condition alternatives diff --git a/src/exco_read_om.f90 b/src/exco_read_om.f90 index cf65aab..922a010 100644 --- a/src/exco_read_om.f90 +++ b/src/exco_read_om.f90 @@ -42,7 +42,7 @@ subroutine exco_read_om db_mx%exco_om = imax - allocate (exco(0:imax)) ! + allocate (exco(0:imax)) !! change to exco_om allocate (exco_om_num(0:imax), source = 0) allocate (exco_om_name(0:imax)) rewind (107) diff --git a/src/gwflow_read.f90 b/src/gwflow_read.f90 index 9151681..0ee850c 100644 --- a/src/gwflow_read.f90 +++ b/src/gwflow_read.f90 @@ -2427,7 +2427,7 @@ subroutine gwflow_read write(out_hyd_sep,*) 'chan_satexsw: channel flow contributed from saturation excess runoff' write(out_hyd_sep,*) 'chan_tile: channel flow contributed from tile drain flow' write(out_hyd_sep,*) - hydsep_hdr = [character(len=16) :: " year"," day","channel","chan_surf","chan_lat","chan_gwsw","chan_swgw", & + hydsep_hdr = [character(len=10) :: " year"," day","channel","chan_surf","chan_lat","chan_gwsw","chan_swgw", & "chan_satexgw","chan_satexsw","chan_tile"] write(out_hyd_sep,121) (hydsep_hdr(j),j=1,10) diff --git a/src/gwflow_soil.f90 b/src/gwflow_soil.f90 index 5957deb..6ee7671 100644 --- a/src/gwflow_soil.f90 +++ b/src/gwflow_soil.f90 @@ -18,9 +18,9 @@ subroutine gwflow_soil(hru_id) !rtb gwflow integer :: cell_id = 0 ! |cell in connection with the channel real :: hru_Q = 0. !m3 |volume transferred from cell to the soil profile real :: hru_soilz = 0. !m |thickness of HRU soil profile + real :: vadose_z = 0. !m |thickness of cell vadose zone real :: poly_area = 0. !m2 |area of cell within the HRU real :: solmass(100) = 0. !g |solute mass transferred from cell - real :: vadose_z = 0. !m |thickness of cell vadose zone real :: water_depth(100) = 0. !m |depth of groundwater in each soil layer real :: water_depth_tot = 0. !m |total depth of groundwater in the soil profile real :: sol_thick = 0. !m |thickness of soil layer diff --git a/src/hru_control.f90 b/src/hru_control.f90 index 5e48e35..a4cbe3a 100644 --- a/src/hru_control.f90 +++ b/src/hru_control.f90 @@ -12,7 +12,7 @@ subroutine hru_control snofall, snomlt, usle, canev, ep_day, es_day, etday, inflpcp, isep, iwgen, ls_overq, & nd_30, pet_day, precip_eff, qday, latqrunon, gwsoilq, satexq, surf_bs, bss, bss_ex, brt, & gwsoiln, gwsoilp, satexn, satexq_chan, surqsalt, latqsalt, tilesalt, percsalt, urbqsalt, & !rtb gwflow; rtb salt - wetqsalt, wtspsalt,gwupsalt, & + wetqsalt, wtspsalt,gwupsalt, usle_cfac, & surqcs, latqcs, tilecs, perccs, gwupcs, sedmcs, urbqcs, wetqcs, wtspcs !rtb cs !HAK 7/27/22 use soil_module @@ -77,6 +77,9 @@ subroutine hru_control real :: sum_conc = 0. !rtb salt real :: sum_mass = 0. !rtb salt real :: sum_sorb = 0. !rtb salt + real :: saltcon = 0. !Jeong 2024 + real :: qsurf = 0. !Jeong 2024 + real :: sedppm = 0. !Jeong 2024 j = ihru @@ -254,9 +257,9 @@ subroutine hru_control end if !!add tile flow to tile (subirrigation and saturated buffer) - if (ob(icmd)%hin_til%flo > 1.e-6 .and. tile_fr_surf > 1.e-6) then - call rls_routetile (icmd, tile_fr_surf) - end if + !if (ob(icmd)%hin_til%flo > 1.e-6 .and. tile_fr_surf > 1.e-6) then + ! call rls_routetile (icmd, tile_fr_surf) + !end if !!add aquifer flow to bottom soil layer and redistribute upwards if (ob(icmd)%hin_aqu%flo > 0) then @@ -374,6 +377,13 @@ subroutine hru_control !! compute plant community partitions call pl_community + !if (j == 136) then + !write (7778,*) time%day, j, pl_mass(j)%tot(1)%m, pl_mass(j)%ab_gr(1)%m, pl_mass(j)%stem(1)%m, & + ! pl_mass(j)%leaf(1)%m, pl_mass(j)%root(1)%m, pl_mass(j)%seed(1)%m + !end if + !if (j == 173) then + ! write (7778,*) time%day, j, sedyld(j)/hru(j)%area_ha, usle_cfac(j), surfq(j), qp_cms + !end if !! check irrigation demand decision table for water allocation (after adding irrigation) if (hru(j)%irr_dmd_dtbl > 0) then @@ -517,6 +527,20 @@ subroutine hru_control !! compute nitrate movement leaching call nut_nlch + if (ires > 0) then + if (wet(j)%flo>0) then + sedppm=wet(j)%sed/wet(j)%flo*1000000. + else + sedppm=0. + end if + if (wet_dat_c(ires)%hyd.eq.'paddy') then !.and.time%yrs > pco%nyskip) then + if (wet_ob(j)%depth > 100.) then + write(100100,'(4(I6,","),20(f20.1,","))') time%yrc,time%mo,time%day_mo,j,w%precip,irrig(j)%applied,hru(j)%water_seep, & + pet_day,etday,wet_ob(j)%weir_hgt*1000,wet_ob(j)%depth*1000.,ht2%flo/(hru(j)%area_ha*10.),soil(j)%sw,sedppm,ht2%sed*1000, & + wet(j)%no3,ht2%no3,pcom(j)%lai_sum,saltcon + end if + end if + end if !! compute phosphorus movement call nut_solp @@ -582,6 +606,7 @@ subroutine hru_control !! ht2%flo is outflow from wetland or total saturation excess if no wetland if(ht2%flo > 0.) then wet_outflow = ht2%flo / hru(j)%area_ha / 10. !! mm = m3/ha *ha/10000m2 *1000mm/m + qday = qday + wet_outflow qdr(j) = qdr(j) + wet_outflow ht2%flo = 0. end if @@ -616,6 +641,7 @@ subroutine hru_control if (ob(iob)%ru_tot > 0) then iob_out = sp_ob1%ru + ob(iob)%ru(1) - 1 end if + qsurf=surfq(j) hwb_d(j)%surq_cha = 0. hwb_d(j)%latq_cha = 0. diff --git a/src/hru_module.f90 b/src/hru_module.f90 index 73b16bb..4a48382 100644 --- a/src/hru_module.f90 +++ b/src/hru_module.f90 @@ -184,7 +184,7 @@ module hru_module integer :: vfsi = 0 !! |none |on/off flag for vegetative filter strip real :: vfsratio = 0. !! |none |contouring USLE P factor real :: vfscon = 0. !! |none |fraction of the total runoff from the entire field - real :: vfsch = 0; !! |none |fraction of flow entering the most concentrated 10% of the VFS. + real :: vfsch = 0. !! |none |fraction of flow entering the most concentrated 10% of the VFS. !! which is fully channelized integer :: ngrwat = 0 integer :: grwat_i = 0 !! |none |On/off Flag for waterway simulation @@ -215,7 +215,7 @@ module hru_module character(len=40) :: land_use_mgt_c = "" integer :: lum_group = 0 character(len=40) :: lum_group_c = "" !land use group for soft cal and output - character(len=40) :: region = "" + character(len=40) :: cal_group = "" integer :: plant_cov = 0 integer :: mgt_ops = 0 integer :: tiledrain = 0 diff --git a/src/hru_output.f90 b/src/hru_output.f90 index 74239c5..0e4901b 100644 --- a/src/hru_output.f90 +++ b/src/hru_output.f90 @@ -244,9 +244,7 @@ subroutine hru_output (ihru) if (pcom(j)%plcur(ipl)%harv_num_yr > 0) then pl_mass(j)%yield_yr(ipl) = pl_mass(j)%yield_yr(ipl) / float(pcom(j)%plcur(ipl)%harv_num_yr) endif - if (pco%crop_yld == "y" .or. pco%crop_yld == "b") then write (4010,103) time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) - end if if (pco%csvout == "y") then write (4011,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) end if diff --git a/src/hru_read.f90 b/src/hru_read.f90 index e59f809..97d13b7 100644 --- a/src/hru_read.f90 +++ b/src/hru_read.f90 @@ -59,7 +59,7 @@ subroutine hru_read read (113,*,iostat=eof) header if (eof < 0) exit - do ihru = 1, sp_ob%hru + do ihru = 1, imax read (113,*,iostat=eof) i if (eof < 0) exit backspace (113) diff --git a/src/hrudb_init.f90 b/src/hrudb_init.f90 index abdce2f..155a948 100644 --- a/src/hrudb_init.f90 +++ b/src/hrudb_init.f90 @@ -21,6 +21,8 @@ subroutine hrudb_init hru(ihru)%area_ha = ob(iob)%area_ha hru(ihru)%km = ob(iob)%area_ha / 100. hru(ihru)%land_use_mgt_c = hru_db(ihru_db)%dbsc%land_use_mgt + ilu = hru(ihru)%dbs%land_use_mgt + hru(ihru)%cal_group = lum(ilu)%cal_group end do return diff --git a/src/hyd_connect.f90 b/src/hyd_connect.f90 index 834af9e..c079363 100644 --- a/src/hyd_connect.f90 +++ b/src/hyd_connect.f90 @@ -296,37 +296,37 @@ subroutine hyd_connect end do !! allocate zero arrays for constituents - allocate (hin_csz%pest(cs_db%num_pests), source = 0.) - allocate (hin_csz%path(cs_db%num_paths), source = 0.) - allocate (hin_csz%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hin_csz%pest(cs_db%num_pests), source = 0) + allocate (hin_csz%path(cs_db%num_paths), source = 0) + allocate (hin_csz%hmet(cs_db%num_metals), source = 0) - allocate (hin_csz%cs(cs_db%num_cs), source = 0.) !rtb se + allocate (hin_csz%salt(cs_db%num_salts), source = 0) !rtb salt - allocate (hcs1%pest(cs_db%num_pests), source = 0.) - allocate (hcs1%path(cs_db%num_paths), source = 0.) - allocate (hcs1%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hin_csz%cs(cs_db%num_cs), source = 0) !rtb se + allocate (hcs1%pest(cs_db%num_pests), source = 0) - allocate (hcs1%cs(cs_db%num_cs), source = 0.) !rtb cs - allocate (hcs2%pest(cs_db%num_pests), source = 0.) - allocate (hcs2%path(cs_db%num_paths), source = 0.) - allocate (hcs2%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hcs1%path(cs_db%num_paths), source = 0) + allocate (hcs1%hmet(cs_db%num_metals), source = 0) + allocate (hcs1%salt(cs_db%num_salts), source = 0) !rtb salt - allocate (hcs2%cs(cs_db%num_cs), source = 0.) !rtb cs + allocate (hcs1%cs(cs_db%num_cs), source = 0) !rtb cs - allocate (hcs3%pest(cs_db%num_pests), source = 0.) - allocate (hcs3%path(cs_db%num_paths), source = 0.) - allocate (hcs3%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hcs2%pest(cs_db%num_pests), source = 0) + allocate (hcs2%path(cs_db%num_paths), source = 0) + allocate (hcs2%hmet(cs_db%num_metals), source = 0) - allocate (hcs3%cs(cs_db%num_cs), source = 0.) !rtb cs + allocate (hcs2%salt(cs_db%num_salts), source = 0) !rtb salt - allocate (hcs1%hmet(cs_db%num_metals), source = 0.) - allocate (hcs2%hmet(cs_db%num_metals), source = 0.) + allocate (hcs2%cs(cs_db%num_cs), source = 0) !rtb cs - allocate (hcs3%hmet(cs_db%num_metals), source = 0.) - allocate (hin_csz%hmet(cs_db%num_metals), source = 0.) + allocate (hcs3%pest(cs_db%num_pests), source = 0) + allocate (hcs3%path(cs_db%num_paths), source = 0) + allocate (hcs3%hmet(cs_db%num_metals), source = 0) + allocate (hcs3%salt(cs_db%num_salts), source = 0) !rtb salt + allocate (hcs3%cs(cs_db%num_cs), source = 0) !rtb cs hin_csz%pest = 0. hin_csz%path = 0. diff --git a/src/hyd_read_connect.f90 b/src/hyd_read_connect.f90 index c97884a..3a87aa6 100644 --- a/src/hyd_read_connect.f90 +++ b/src/hyd_read_connect.f90 @@ -96,13 +96,14 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) allocate (obcs(i)%hin_sur(1)%pest(npests), source = 0.) allocate (obcs(i)%hin_lat(1)%pest(npests), source = 0.) allocate (obcs(i)%hin_til(1)%pest(npests), source = 0.) - allocate (obcs(i)%hin(1)%path(npaths), source = 0.) - allocate (obcs(i)%hin_sur(1)%path(npaths), source = 0.) - allocate (obcs(i)%hin_lat(1)%path(npaths), source = 0.) - allocate (obcs(i)%hin_til(1)%path(npaths), source = 0.) + end if npaths = cs_db%num_paths if (npaths > 0) then + allocate (obcs(i)%hin(1)%path(npaths), source = 0.) + allocate (obcs(i)%hin_sur(1)%path(npaths), source = 0.) + allocate (obcs(i)%hin_lat(1)%path(npaths), source = 0.) + allocate (obcs(i)%hin_til(1)%path(npaths), source = 0.) end if nmetals = cs_db%num_metals if (nmetals > 0) then @@ -141,18 +142,18 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) ncs = cs_db%num_cs !rtb cs if (ncs > 0) then allocate (obcs(i)%hin(1)%cs(ncs), source = 0.) - allocate (obcs(i)%hin_sur(1)%cs(ncs), source = 0.) - allocate (obcs(i)%hin_lat(1)%cs(ncs), source = 0.) - allocate (obcs(i)%hin_til(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin(1)%cs_sorb(ncs), source = 0.) - allocate (obcs(i)%hin(1)%csc(ncs), source = 0.) + allocate (obcs(i)%hin(1)%csc(ncs, source = 0.) allocate (obcs(i)%hin(1)%csc_sorb(ncs), source = 0.) + allocate (obcs(i)%hin_sur(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin_sur(1)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hin_sur(1)%csc(ncs), source = 0.) allocate (obcs(i)%hin_sur(1)%csc_sorb(ncs), source = 0.) + allocate (obcs(i)%hin_lat(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin_lat(1)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hin_lat(1)%csc(ncs), source = 0.) allocate (obcs(i)%hin_lat(1)%csc_sorb(ncs), source = 0.) + allocate (obcs(i)%hin_til(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin_til(1)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hin_til(1)%csc(ncs), source = 0.) allocate (obcs(i)%hin_til(1)%csc_sorb(ncs), source = 0.) @@ -249,12 +250,13 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) allocate (obcs(i)%hcsout_m(iout)%pest(npests), source = 0.) allocate (obcs(i)%hcsout_y(iout)%pest(npests), source = 0.) allocate (obcs(i)%hcsout_a(iout)%pest(npests), source = 0.) - allocate (obcs(i)%hcsout_m(iout)%path(npaths), source = 0.) - allocate (obcs(i)%hcsout_y(iout)%path(npaths), source = 0.) - allocate (obcs(i)%hcsout_a(iout)%path(npaths), source = 0.) + end if npaths = cs_db%num_paths if (npaths > 0) then + allocate (obcs(i)%hcsout_m(iout)%path(npaths), source = 0.) + allocate (obcs(i)%hcsout_y(iout)%path(npaths), source = 0.) + allocate (obcs(i)%hcsout_a(iout)%path(npaths), source = 0.) end if if (nmetals > 0) then @@ -264,25 +266,25 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) end if if (nsalts > 0) then !rtb salt allocate (obcs(i)%hcsout_m(iout)%salt(nsalts), source = 0.) - allocate (obcs(i)%hcsout_y(iout)%salt(nsalts), source = 0.) - allocate (obcs(i)%hcsout_a(iout)%salt(nsalts), source = 0.) allocate (obcs(i)%hcsout_m(iout)%salt_min(nsalts), source = 0.) allocate (obcs(i)%hcsout_m(iout)%saltc(nsalts), source = 0.) + allocate (obcs(i)%hcsout_y(iout)%salt(nsalts), source = 0.) allocate (obcs(i)%hcsout_y(iout)%salt_min(nsalts), source = 0.) allocate (obcs(i)%hcsout_y(iout)%saltc(nsalts), source = 0.) + allocate (obcs(i)%hcsout_a(iout)%salt(nsalts), source = 0.) allocate (obcs(i)%hcsout_a(iout)%salt_min(nsalts), source = 0.) allocate (obcs(i)%hcsout_a(iout)%saltc(nsalts), source = 0.) end if if (ncs > 0) then !rtb cs allocate (obcs(i)%hcsout_m(iout)%cs(ncs), source = 0.) - allocate (obcs(i)%hcsout_y(iout)%cs(ncs), source = 0.) - allocate (obcs(i)%hcsout_a(iout)%cs(ncs), source = 0.) allocate (obcs(i)%hcsout_m(iout)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hcsout_m(iout)%csc(ncs), source = 0.) allocate (obcs(i)%hcsout_m(iout)%csc_sorb(ncs), source = 0.) + allocate (obcs(i)%hcsout_y(iout)%cs(ncs), source = 0.) allocate (obcs(i)%hcsout_y(iout)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hcsout_y(iout)%csc(ncs), source = 0.) allocate (obcs(i)%hcsout_y(iout)%csc_sorb(ncs), source = 0.) + allocate (obcs(i)%hcsout_a(iout)%cs(ncs), source = 0.) allocate (obcs(i)%hcsout_a(iout)%cs_sorb(ncs), source = 0.) allocate (obcs(i)%hcsout_a(iout)%csc(ncs), source = 0.) allocate (obcs(i)%hcsout_a(iout)%csc_sorb(ncs), source = 0.) diff --git a/src/hydro_init.f90 b/src/hydro_init.f90 index e78d5bd..18f258b 100644 --- a/src/hydro_init.f90 +++ b/src/hydro_init.f90 @@ -88,7 +88,6 @@ subroutine hydro_init if (bsn_prm%ffcb <= 0.) then sffc = wgn_pms(iwgn)%pcp_an / (wgn_pms(iwgn)%pcp_an + Exp(9.043 - & .002135 * wgn_pms(iwgn)%pcp_an)) - !!S-curve equation Jeff made up. else sffc = bsn_prm%ffcb end if diff --git a/src/hydrograph_module.f90 b/src/hydrograph_module.f90 index ff837ef..2cc5618 100644 --- a/src/hydrograph_module.f90 +++ b/src/hydrograph_module.f90 @@ -362,6 +362,8 @@ module hydrograph_module real :: runoff = 0. !irrigation surface runoff |mm real :: eff = 1. !irrigation efficiency as a fraction of irrigation. Jaehak 2022 real :: frac_surq = 0. !fraction of irrigation lost in runoff flow. Jaehak 2022 + real :: no3 = 0. !nitrate concentration in irrigation water |kg Jaehak 2023 + real :: salt = 0. !salt concentration in irrigation water |ppm !hyd_output units are in mm and mg/L type (hyd_output) :: water !irrigation water end type irrigation_water_transfer @@ -681,7 +683,7 @@ module hydrograph_module type (sol_header) :: sol_hdr type plant_header - character (len=17) :: name = " name " !!none |plant name + character (len=15) :: name = " name " !!none |plant name character (len=15) :: growing = "growing" !!none |plant growing character (len=15) :: dormant = "dormant" !!none |plant dormant character (len=15) :: lai = "lai" !!none |leaf area index @@ -785,6 +787,9 @@ module hydrograph_module character (len=15) :: lag = " tons" !! tons |detached large ag character (len=15) :: grv = " tons" !! tons |gravel character (len=15) :: temp = " " !! deg c |temperature + !Jaehak 2023 + !character (len=15) :: salt = " kg" !! deg c |temperature + !character (len=15) :: pest = " mg" !! deg c |temperature end type hyd_header_units1 type (hyd_header_units1) :: hyd_hdr_units1 @@ -807,6 +812,9 @@ module hydrograph_module character (len=15) :: lag = " tons" !! tons |detached large ag character (len=15) :: grv = " tons" !! tons |gravel character (len=15) :: temp = " " !! deg c |temperature + !Jaehak 2023 + !character (len=15) :: salt = " kg" !! deg c |temperature + !character (len=15) :: pest = " mg" !! deg c |temperature end type hyd_header_units3 type (hyd_header_units3) :: hyd_hdr_units3 diff --git a/src/mgt_sched.f90 b/src/mgt_sched.f90 index cbbc30b..20861d1 100644 --- a/src/mgt_sched.f90 +++ b/src/mgt_sched.f90 @@ -155,12 +155,13 @@ subroutine mgt_sched (isched) harveff = mgt%op3 call mgt_harvresidue (j, harveff) case ("tree") + call mgt_harvbiomass (j, ipl, iharvop) case ("tuber") call mgt_harvtuber (j, ipl, iharvop) case ("peanuts") call mgt_harvtuber (j, ipl, iharvop) case ("stripper") - call mgt_harvgrain (j, ipl, iharvop) + call mgt_harvbiomass (j, ipl, iharvop) case ("picker") call mgt_harvgrain (j, ipl, iharvop) end select @@ -436,19 +437,24 @@ subroutine mgt_sched (isched) !! set weir height and adjust principal spillway storage and depth wet_ob(j)%weir_hgt = mgt%op3 / 1000. !weir height, m - wet_ob(j)%pvol = hru(j)%area_ha * wet_ob(j)%weir_hgt * 10. + wet_ob(j)%pvol = hru(j)%area_ha * wet_ob(j)%weir_hgt * 10000. !m3 if (wet_ob(j)%evol < wet_ob(j)%pvol*1.1) then wet_ob(j)%evol = wet_ob(j)%pvol * 1.1 endif case ("irrp") !! continuous irrigation to maintain surface ponding in rice fields Jaehak 2022 hru(j)%irr_src = mgt%op_plant !irrigation source: cha; res; aqu; or unlim - hru(j)%irr_hmin = irrop_db(mgt%op1)%dep_mm !threshold ponding depth, mm + hru(j)%irr_isc = mgt%op3 !irrigation source object ID: cha; res; aqu; or unlim + hru(j)%irr_hmax = irrop_db(mgt%op1)%amt_mm !irrigation amount in irr.org, mm + hru(j)%irr_hmin = hru(j)%irr_hmax * 0.9 !threshold ponding depth, mm irrig(j)%eff = irrop_db(mgt%op1)%eff irrig(j)%frac_surq = irrop_db(mgt%op1)%surq + irrig(j)%salt = irrop_db(mgt%op1)%salt !ppm salt Jaehak 2023 + irrig(j)%no3 = irrop_db(mgt%op1)%no3 !ppm no3 pcom(j)%days_irr = 1 ! reset days since last irrigation if (mgt%op3 < 0) then hru(j)%irr_hmax = irrop_db(mgt%op1)%amt_mm !irrigation amount in irr.org, mm + if (hru(j)%irr_hmax>0) hru(j)%paddy_irr = 1 !paddy irrigation is on with manual scheduling else hru(j)%irr_hmax = mgt%op3 !target ponding depth, mm if (mgt%op3 > 0) then diff --git a/src/mgt_transplant.f90 b/src/mgt_transplant.f90 index fd8b99e..2a5c21d 100644 --- a/src/mgt_transplant.f90 +++ b/src/mgt_transplant.f90 @@ -53,7 +53,7 @@ subroutine mgt_transplant (itrans) !! initialize plant mass call pl_root_gro(j) call pl_seed_gro(j) - call pl_partition(j) + call pl_partition(j, 1) return end subroutine mgt_transplant \ No newline at end of file diff --git a/src/nut_solp.f90 b/src/nut_solp.f90 index 8af6668..47c7894 100644 --- a/src/nut_solp.f90 +++ b/src/nut_solp.f90 @@ -34,7 +34,6 @@ subroutine nut_solp real :: plch = 0. !kg P/ha |amount of P leached from soil layer integer :: ly = 0 !none - real :: tmp_calc = 0. j = ihru @@ -67,9 +66,6 @@ subroutine nut_solp vap = 0. if (ly /= i_sep(j)) then vap = -soil(j)%ly(ly)%prk / (.01 * soil(j)%phys(ly)%st + .1 * bsn_prm%pperco * soil(j)%phys(ly)%bd) - if (vap < -80.0) then ! This check was added to prevent gfortran aborting on the Exp(ww) function below. - vap = -80 - endif plch = .001 * soil1(j)%mp(ly)%lab * (1. - Exp(vap)) plch = Min(plch, soil1(j)%mp(ly)%lab) soil1(j)%mp(ly)%lab = soil1(j)%mp(ly)%lab - plch diff --git a/src/object_read_output.f90 b/src/object_read_output.f90 index 54a4892..5430b30 100644 --- a/src/object_read_output.f90 +++ b/src/object_read_output.f90 @@ -86,15 +86,15 @@ subroutine object_read_output ob_out(i)%hydno = 4 case ("til") !tile ob_out(i)%hydno = 5 - case ("sol") !soil moisture by layer + case ("sol_water") !soil moisture by layer ob_out(i)%hydno = 6 - case ("soln") !soil n and p by layer + case ("solnut_ly") !soil n and p by layer ob_out(i)%hydno = 7 - case ("solpn") !soil n and p for profile + case ("solnut_pr") !soil n and p for profile ob_out(i)%hydno = 8 - case ("plt") !plants status + case ("plant") !plants status ob_out(i)%hydno = 9 - case ("ch_fp") !channel and flood plain water balance + case ("cha_fp") !channel and flood plain water balance ob_out(i)%hydno = 10 end select iunit = ob_out(i)%unitno diff --git a/src/organic_mineral_mass_module.f90 b/src/organic_mineral_mass_module.f90 index 9be7ae4..6afb70e 100644 --- a/src/organic_mineral_mass_module.f90 +++ b/src/organic_mineral_mass_module.f90 @@ -39,6 +39,7 @@ module organic_mineral_mass_module character (len=16) :: name = "" real :: tot_mn = 0. ! |total mineral n pool (no3+nh4) in soil profile real :: tot_mp = 0. ! |mineral p pool (wsol+lab+act+sta) in soil profile + real :: salt = 0. ! |total salt amount (kg/ha) in soil profile type (organic_mass) :: tot_org ! |total organics in soil profile real, dimension(:), allocatable :: sw !mm |soil water dimensioned by layer real, dimension(:), allocatable :: cbn !% |percent carbon diff --git a/src/output_landscape_init.f90 b/src/output_landscape_init.f90 index 2b22c1f..4da6412 100644 --- a/src/output_landscape_init.f90 +++ b/src/output_landscape_init.f90 @@ -477,8 +477,8 @@ subroutine output_landscape_init end if endif - open (4561,file = "hru_resc_stat.txt", recl = 1500) if (pco%nb_hru%a == "y") then + open (4561,file = "hru_resc_stat.txt", recl = 1500) write (4561,*) bsn%name, prog write (4561,*) resc_hdr write (4561,*) resc_hdr_units diff --git a/src/output_landscape_module.f90 b/src/output_landscape_module.f90 index cbbcaf4..cae8acd 100644 --- a/src/output_landscape_module.f90 +++ b/src/output_landscape_module.f90 @@ -415,8 +415,8 @@ module output_landscape_module character(len=17) :: rsd_laborg_p = " rsd_laborg_p" character(len=17) :: no3atmo = " no3atmo " character(len=17) :: nh4atmo = " nh4atmo " - character(len=17) :: puptake = " puptake " character(len=17) :: nuptake = " nuptake " + character(len=17) :: puptake = " puptake " character(len=17) :: gwsoiln = " gwsoiln " character(len=17) :: gwsoilp = " gwsoilp " end type output_nutbal_header diff --git a/src/pathogen_init.f90 b/src/pathogen_init.f90 index 4daf628..0e5ac71 100644 --- a/src/pathogen_init.f90 +++ b/src/pathogen_init.f90 @@ -54,11 +54,11 @@ subroutine pathogen_init !! allocate pathogens associated with soil and plant do ly = 1, soil(ihru)%nly allocate (cs_soil(ihru)%ly(ly)%path(mpath), source = 0.) - allocate (cs_pl(ihru)%pl_in(ipl)%pest(mpath), source = 0.) - allocate (cs_pl(ihru)%pl_on(ipl)%pest(mpath), source = 0.) - allocate (cs_pl(ihru)%pl_up(ipl)%pest(mpath), source = 0.) end do do ipl = 1, pcom(ihru)%npl + allocate (cs_pl(ihru)%pl_in(ipl)%path(mpath), source = 0.) + allocate (cs_pl(ihru)%pl_on(ipl)%path(mpath), source = 0.) + allocate (cs_pl(ihru)%pl_up(ipl)%path(mpath), source = 0.) end do allocate (cs_irr(ihru)%path(mpath)) end if diff --git a/src/pesticide_init.f90 b/src/pesticide_init.f90 index a68bd93..b3b2b0a 100644 --- a/src/pesticide_init.f90 +++ b/src/pesticide_init.f90 @@ -40,14 +40,14 @@ subroutine pesticide_init allocate (cs_pl(ihru)%pl_up(npl)) do ly = 1, nly allocate (cs_soil(ihru)%ly(ly)%pest(npmx), source = 0.) - allocate (cs_pl(ihru)%pl_in(ipl)%pest(npmx), source = 0.) - allocate (cs_pl(ihru)%pl_on(ipl)%pest(npmx), source = 0.) - allocate (cs_pl(ihru)%pl_up(ipl)%pest(npmx), source = 0.) cs_soil(ihru)%ly(ly)%pest = 0. end do do ipl = 1, npl + allocate (cs_pl(ihru)%pl_in(ipl)%pest(npmx), source = 0.) cs_pl(ihru)%pl_in(ipl)%pest = 0. + allocate (cs_pl(ihru)%pl_on(ipl)%pest(npmx), source = 0.) cs_pl(ihru)%pl_on(ipl)%pest = 0. + allocate (cs_pl(ihru)%pl_up(ipl)%pest(npmx), source = 0.) cs_pl(ihru)%pl_up(ipl)%pest = 0. end do allocate (cs_irr(ihru)%pest(npmx)) diff --git a/src/pl_grow.f90 b/src/pl_grow.f90 index 246a4fc..c2107de 100644 --- a/src/pl_grow.f90 +++ b/src/pl_grow.f90 @@ -40,7 +40,7 @@ subroutine pl_grow call pl_seed_gro(j) - call pl_partition(j) + call pl_partition(j, 0) end if diff --git a/src/pl_leaf_gro.f90 b/src/pl_leaf_gro.f90 index b6fe069..f1d5928 100644 --- a/src/pl_leaf_gro.f90 +++ b/src/pl_leaf_gro.f90 @@ -78,7 +78,6 @@ subroutine pl_leaf_gro real :: rto = 0. !none |ratio of current years of growth:years to maturity of perennial real :: sumlaiht = 0. ! | integer :: jpl = 0 !none |counter - real :: tmp_calc j = ihru idp = pcom(j)%plcur(ipl)%idplt @@ -89,14 +88,9 @@ subroutine pl_leaf_gro ff = f - pcom(j)%plg(ipl)%laimxfr pcom(j)%plg(ipl)%laimxfr = f - tmp_calc = plcp(idp)%leaf1 - plcp(idp)%leaf2 * pcom(j)%plcur(ipl)%phuacc_p !Changed by fg to prevent underflow in gfortran - if (tmp_calc < -20.) then !Changed by fg to prevent underflow in gfortran - tmp_calc = -20. !Changed by fg to prevent underflow in gfortran - endif - f_p = pcom(j)%plcur(ipl)%phuacc_p / (pcom(j)%plcur(ipl)%phuacc_p + Exp(tmp_calc)) !Changed by fg to prevent underflow in gfortran - !f_p = pcom(j)%plcur(ipl)%phuacc_p / (pcom(j)%plcur(ipl)%phuacc_p + & - ! Exp(plcp(idp)%leaf1 - plcp(idp)%leaf2 * pcom(j)%plcur(ipl)%phuacc_p)) + f_p = pcom(j)%plcur(ipl)%phuacc_p / (pcom(j)%plcur(ipl)%phuacc_p + & + Exp(plcp(idp)%leaf1 - plcp(idp)%leaf2 * pcom(j)%plcur(ipl)%phuacc_p)) !pcom(j)%plg(ipl)%laimxfr_p = amin1 (f_p, pcom(j)%plg(ipl)%laimxfr_p) !ff_p = f_p - pcom(j)%plg(ipl)%laimxfr_p diff --git a/src/pl_leaf_senes.f90 b/src/pl_leaf_senes.f90 index d7e2ed9..495557b 100644 --- a/src/pl_leaf_senes.f90 +++ b/src/pl_leaf_senes.f90 @@ -76,10 +76,11 @@ subroutine pl_leaf_senes end if lai_drop = max (0., lai_drop) lai_drop = amin1 (1., lai_drop) - leaf_drop%m = lai_drop * pl_mass(j)%leaf(ipl)%m - leaf_drop%n = leaf_drop%m * pcom(j)%plm(ipl)%n_fr + !! forest -- total tree n_conc = 1.75%; leaf = 2.25%, falling leaf = 50%*2.25% = 1.12% --> 1.12/1.75 = 0.68 + leaf_drop%m = pcom(j)%plcur(ipl)%leaf_tov * pl_mass(j)%leaf(ipl)%m + leaf_drop%n = 0.68 * leaf_drop%m * pcom(j)%plm(ipl)%n_fr leaf_drop%n = max (0., leaf_drop%n) - leaf_drop%p = leaf_drop%m * pcom(j)%plm(ipl)%p_fr + leaf_drop%p = 0.68 * leaf_drop%m * pcom(j)%plm(ipl)%p_fr leaf_drop%p = max (0., leaf_drop%p) end if end if @@ -109,10 +110,11 @@ subroutine pl_leaf_senes !pcom(j)%plg(ipl)%lai = max (pcom(j)%plg(ipl)%lai, pldb(idp)%alai_min) !! compute leaf biomass drop + !! forest -- total tree n_conc = 1.75%; leaf = 2.25%, falling leaf = 50%*2.25% = 1.12% --> 1.12/1.75 = 0.68 leaf_drop%m = pcom(j)%plcur(ipl)%leaf_tov * pl_mass(j)%leaf(ipl)%m - leaf_drop%n = leaf_drop%m * pcom(j)%plm(ipl)%n_fr + leaf_drop%n = 0.68 * leaf_drop%m * pcom(j)%plm(ipl)%n_fr leaf_drop%n = max (0., leaf_drop%n) - leaf_drop%p = leaf_drop%m * pcom(j)%plm(ipl)%p_fr + leaf_drop%p = 0.68 * leaf_drop%m * pcom(j)%plm(ipl)%p_fr leaf_drop%p = max (0., leaf_drop%p) end if diff --git a/src/pl_partition.f90 b/src/pl_partition.f90 index 76b5c56..434353a 100644 --- a/src/pl_partition.f90 +++ b/src/pl_partition.f90 @@ -1,4 +1,4 @@ - subroutine pl_partition(j) + subroutine pl_partition(j, init) use plant_data_module use basin_module @@ -10,6 +10,7 @@ subroutine pl_partition(j) implicit none integer, intent (in) :: j !none |HRU number + integer, intent (in) :: init !none |init=1 to intialize and transplant; init=0 during simulation integer :: idp = 0 ! | real :: root_frac = 0. !none |root mass fraction real :: ab_gr_frac = 0. !none |above ground mass fraction @@ -20,7 +21,9 @@ subroutine pl_partition(j) real :: n_frac = 0. !none |n fraction in remainder of plant real :: p_left = 0. !none |p left after seed is removed real :: p_frac = 0. !none |p fraction in remainder of plant - real :: m_left = 0. !none |mass left after seed is removed + real :: mass_left = 0. !none |mass left after plant component is removed + real :: mass_act = 0. !none |actual mass in each plant component + real :: mass_opt = 0. !none |optimal mass in each plant component real :: leaf_frac_veg = 0. !none |fraction veg mass (stem+leaf) that is leaf real :: leaf_mass_frac_veg = 0. !none |fraction veg mass (stem+leaf) that is leaf @@ -32,7 +35,7 @@ subroutine pl_partition(j) !! partition leaf and stem (stalk) and seed (grain) mass if (pldb(idp)%typ == "perennial") then - leaf_frac_veg = 0.05 !forest + leaf_frac_veg = 0.02 !forest else leaf_frac_veg = 0.30 !should be plant parm end if @@ -56,11 +59,50 @@ subroutine pl_partition(j) stem_mass_frac = 1. - (leaf_mass_frac_veg + seed_mass_frac) end if + !! check if initializing + if (init == 0) then + !! first maintain root fraction - root mass/total mass + mass_left = pl_mass_up%m + mass_act = pl_mass(j)%root(ipl)%m + mass_opt = root_frac * pl_mass(j)%tot(ipl)%m + if (mass_act > mass_opt) then + mass_left = mass_act - mass_opt + pl_mass(j)%root(ipl)%m = mass_opt + else + pl_mass(j)%root(ipl)%m = pl_mass(j)%root(ipl)%m + pl_mass_up%m + mass_left = 0. + end if + !! next maintain harvest index on yield (seed/fruit) component + mass_act = pl_mass(j)%seed(ipl)%m + mass_opt = seed_mass_frac * pl_mass(j)%tot(ipl)%m + if (mass_act > mass_opt) then + mass_left = mass_act - mass_opt + pl_mass(j)%seed(ipl)%m = mass_opt + else + pl_mass(j)%seed(ipl)%m = pl_mass(j)%seed(ipl)%m + pl_mass_up%m + mass_left = 0. + end if + !! next maintain leaf component + mass_act = pl_mass(j)%leaf(ipl)%m + mass_opt = leaf_mass_frac * pl_mass(j)%tot(ipl)%m + if (mass_act > mass_opt) then + mass_left = mass_act - mass_opt + pl_mass(j)%leaf(ipl)%m = mass_opt + else + pl_mass(j)%leaf(ipl)%m = pl_mass(j)%leaf(ipl)%m + pl_mass_up%m + mass_left = 0. + end if + !! remainder goes to stem + pl_mass(j)%stem(ipl)%m = pl_mass(j)%stem(ipl)%m + mass_left + pl_mass(j)%ab_gr(ipl)%m = pl_mass(j)%stem(ipl)%m + pl_mass(j)%leaf(ipl)%m + pl_mass(j)%seed(ipl)%m + else + !! initialize at initial fractions pl_mass(j)%ab_gr(ipl)%m = ab_gr_frac * pl_mass(j)%tot(ipl)%m pl_mass(j)%root(ipl)%m = root_frac * pl_mass(j)%tot(ipl)%m pl_mass(j)%leaf(ipl)%m = leaf_mass_frac * pl_mass(j)%ab_gr(ipl)%m pl_mass(j)%seed(ipl)%m = seed_mass_frac * pl_mass(j)%ab_gr(ipl)%m pl_mass(j)%stem(ipl)%m = stem_mass_frac * pl_mass(j)%ab_gr(ipl)%m + end if !! partition carbon with constant fractions pl_mass(j)%leaf(ipl)%c = c_frac%leaf * pl_mass(j)%leaf(ipl)%m @@ -73,8 +115,8 @@ subroutine pl_partition(j) !! partition n and p if (pldb(idp)%typ == "perennial") then !! partition leaves and seed (stem is woody biomass) - m_left = pl_mass(j)%leaf(ipl)%m + pl_mass(j)%stem(ipl)%m + pl_mass(j)%root(ipl)%m - if (m_left > 1.e-9) then + mass_left = pl_mass(j)%leaf(ipl)%m + pl_mass(j)%stem(ipl)%m + pl_mass(j)%root(ipl)%m + if (mass_left > 1.e-9) then pl_mass(j)%seed(ipl)%n = pldb(idp)%cnyld * pl_mass(j)%seed(ipl)%m n_left = pl_mass(j)%tot(ipl)%n - pl_mass(j)%seed(ipl)%n !! if n is neg after seed is removed - assume 0 n in seed - plant database cnyld and fr_n_mat are off @@ -83,9 +125,9 @@ subroutine pl_partition(j) n_left = pl_mass(j)%seed(ipl)%n + n_left end if !! partition n_left between remaining masses - assume equal concentrations - pl_mass(j)%leaf(ipl)%n = n_left * pl_mass(j)%leaf(ipl)%m / m_left - pl_mass(j)%stem(ipl)%n = n_left * pl_mass(j)%stem(ipl)%m / m_left - pl_mass(j)%root(ipl)%n = n_left * pl_mass(j)%root(ipl)%m / m_left + pl_mass(j)%leaf(ipl)%n = n_left * pl_mass(j)%leaf(ipl)%m / mass_left + pl_mass(j)%stem(ipl)%n = n_left * pl_mass(j)%stem(ipl)%m / mass_left + pl_mass(j)%root(ipl)%n = n_left * pl_mass(j)%root(ipl)%m / mass_left pl_mass(j)%ab_gr(ipl)%n = pl_mass(j)%seed(ipl)%n + pl_mass(j)%leaf(ipl)%n + pl_mass(j)%stem(ipl)%n pl_mass(j)%seed(ipl)%p = pldb(idp)%cpyld * pl_mass(j)%seed(ipl)%m @@ -96,9 +138,9 @@ subroutine pl_partition(j) p_left = pl_mass(j)%seed(ipl)%p + p_left end if !! partition p_left between remaining masses - assume equal concentrations - pl_mass(j)%leaf(ipl)%p = p_left * pl_mass(j)%leaf(ipl)%m / m_left - pl_mass(j)%stem(ipl)%p = p_left * pl_mass(j)%stem(ipl)%m / m_left - pl_mass(j)%root(ipl)%p = p_left * pl_mass(j)%root(ipl)%m / m_left + pl_mass(j)%leaf(ipl)%p = p_left * pl_mass(j)%leaf(ipl)%m / mass_left + pl_mass(j)%stem(ipl)%p = p_left * pl_mass(j)%stem(ipl)%m / mass_left + pl_mass(j)%root(ipl)%p = p_left * pl_mass(j)%root(ipl)%m / mass_left pl_mass(j)%ab_gr(ipl)%p = pl_mass(j)%seed(ipl)%p + pl_mass(j)%leaf(ipl)%p + pl_mass(j)%stem(ipl)%p end if else diff --git a/src/pl_root_gro.f90 b/src/pl_root_gro.f90 index f0df557..bbd9177 100644 --- a/src/pl_root_gro.f90 +++ b/src/pl_root_gro.f90 @@ -51,7 +51,7 @@ subroutine pl_root_gro(j) end if !! root mass - pl_mass(j)%root(ipl)%m = pcom(j)%plg(ipl)%root_frac * pl_mass(j)%tot(ipl)%m + !pl_mass(j)%root(ipl)%m = pcom(j)%plg(ipl)%root_frac * pl_mass(j)%tot(ipl)%m return end subroutine pl_root_gro \ No newline at end of file diff --git a/src/plant_all_init.f90 b/src/plant_all_init.f90 index f2f490f..2fd8741 100644 --- a/src/plant_all_init.f90 +++ b/src/plant_all_init.f90 @@ -15,6 +15,8 @@ subroutine plant_all_init integer :: num_plts_cur = 0 !none |temporary counter for number of different plants in basin allocate (plts_bsn(db_mx%plantparm)) + allocate (bsn_crop_yld(db_mx%plantparm)) + allocate (bsn_crop_yld_aa(db_mx%plantparm)) !!assign land use pointers for the hru !!allocate and initialize land use and management @@ -32,7 +34,7 @@ subroutine plant_all_init if (basin_plants == 0) then plts_bsn(1) = pcom(iihru)%pl(ipl) basin_plants = 1 - end if + else num_plts_cur = basin_plants do iplt = 1, num_plts_cur if (pcom(iihru)%pl(ipl) == plts_bsn(iplt)) exit @@ -41,26 +43,20 @@ subroutine plant_all_init basin_plants = basin_plants + 1 end if end do + end if end do end do - !! set all plants simulated in the basin - allocate (plants_bsn(basin_plants)) - allocate (bsn_crop_yld(basin_plants)) - allocate (bsn_crop_yld_aa(basin_plants)) - !! zero basin crop yields and harvested areas do ipl_bsn = 1, basin_plants bsn_crop_yld(ipl_bsn) = bsn_crop_yld_z bsn_crop_yld_aa(ipl_bsn) = bsn_crop_yld_z end do - plants_bsn = plts_bsn(1:basin_plants) - deallocate (plts_bsn) do iihru = 1, sp_ob%hru do ipl = 1, pcom(iihru)%npl do ipl_bsn = 1, basin_plants - if (pcom(iihru)%pl(ipl) == plants_bsn(ipl_bsn)) then + if (pcom(iihru)%pl(ipl) == plts_bsn(ipl_bsn)) then pcom(iihru)%plcur(ipl)%bsn_num = ipl_bsn exit end if diff --git a/src/plant_data_module.f90 b/src/plant_data_module.f90 index fa5f0c9..200e8eb 100644 --- a/src/plant_data_module.f90 +++ b/src/plant_data_module.f90 @@ -3,7 +3,6 @@ module plant_data_module implicit none character(len=16), dimension (:), allocatable :: plts_bsn !none |plant names simulated in current run - character(len=16), dimension (:), allocatable :: plants_bsn !none |plant names simulated in current run - final type plant_db character(len=40) :: plantnm = "" !none |crop name diff --git a/src/plant_init.f90 b/src/plant_init.f90 index 7520748..0030535 100644 --- a/src/plant_init.f90 +++ b/src/plant_init.f90 @@ -78,6 +78,9 @@ subroutine plant_init (init, iihru) deallocate (pcom(j)%plstr) deallocate (pcom(j)%plcur) deallocate (rsd1(j)%tot) + deallocate (rsd1(j)%meta) + deallocate (rsd1(j)%str) + deallocate (rsd1(j)%lignin) end if pcom(j)%npl = pcomdb(icom)%plants_com @@ -325,7 +328,7 @@ subroutine plant_init (init, iihru) if (pcom(j)%plcur(ipl)%gro == "y") then call pl_root_gro(j) call pl_seed_gro(j) - call pl_partition(j) + call pl_partition(j, 1) end if end do ! ipl loop diff --git a/src/recall_read.f90 b/src/recall_read.f90 index b1649c5..ba4f4c3 100644 --- a/src/recall_read.f90 +++ b/src/recall_read.f90 @@ -161,6 +161,8 @@ subroutine recall_read case (2) !! monthly read (108,*,iostat=eof) jday, mo, day_mo, iyr, ob_typ, ob_name, & recall(i)%hd(mo1,iyrs) + write (10108,*) jday, mo, day_mo, iyr, ob_typ, ob_name, & + recall(i)%hd(mo1,iyrs) case (3) !! annual read (108,*,iostat=eof) jday, mo, day_mo, iyr, ob_typ, ob_name, ht1 recall(i)%hd(1,iyrs) = ht1 diff --git a/src/res_hydro.f90 b/src/res_hydro.f90 index c5a97a2..340204f 100644 --- a/src/res_hydro.f90 +++ b/src/res_hydro.f90 @@ -21,23 +21,32 @@ subroutine res_hydro (jres, id, pvol_m3, evol_m3) integer :: tstep = 0 !none |hru number integer :: iac = 0 !none |counter integer :: ic = 0 !none |counter + !integer :: weir_flg=0 !none |counter integer, intent (in) :: id !none |hru number integer :: ial = 0 !none |counter integer :: irel = 0 ! | integer :: iob = 0 !none |hru or wro number real :: vol = 0. ! | + real :: vol_above = 0. ! | real :: b_lo = 0. ! | character(len=1) :: action = ""! | real :: res_h = 0. !m |water depth real :: demand = 0. !m3 |irrigation demand by hru or wro real :: wsa1 = 0. !m2 |water surface area + real :: qout = 0. !m3 |weir discharge during short time step + real :: hgt = 0. !m |height of bottom of weir above bottom of impoundment real :: hgt_above = 0. !m |height of water above the above bottom of weir - real :: alpha_e = 0. + real :: sto_max = 0. !m3 |maximum storage volume at the bank top !! store initial values vol = wbody%flo nstep = 1 wsa1 = wbody_wb%area_ha * 10000. !m2 + if (time%step>0) then !Jaehak 2024 + nstep = time%step + else + nstep = 1 + end if do tstep = 1, nstep @@ -90,6 +99,8 @@ subroutine res_hydro (jres, id, pvol_m3, evol_m3) end select ht2%flo = ht2%flo + (wbody%flo - b_lo) / d_tbl%act(iac)%const / nstep ht2%flo = max(0.,ht2%flo) + !wbody%flo = max(0.,wbody%flo - ht2%flo) + vol = wbody%flo case ("dyrt") !! release based on drawdown days + percentage of principal volume @@ -157,8 +168,32 @@ subroutine res_hydro (jres, id, pvol_m3, evol_m3) case ("weir") !! release based on weir equation - res_h = vol / (wbody_wb%area_ha * 10000.) !m + iweir = d_tbl%act_typ(iac) + res_h = vol / wsa1 !m hgt_above = max(0., res_h - wet_ob(jres)%weir_hgt) !m + if (nstep>24) then !hourly interval + ht2%flo = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s + ht2%flo = max(0.,86400. / nstep * ht2%flo) !m3 + vol = vol - ht2%flo + else + do ic = 1, 24 + vol_above = hgt_above * wsa1 !m3 water volume above weir height + qout = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s + qout = 3600. * qout !m3 + if (qout > vol_above) then + ht2%flo = ht2%flo + vol_above !weir discharge volume for the day, m3 + vol = vol - vol_above + else + ht2%flo = ht2%flo + qout + vol = vol - qout + end if + res_h = vol / wsa1 !m + hgt_above = max(0.,res_h - wet_ob(jres)%weir_hgt) !m Jaehak 2022 + if (vol_above<=0.001.or.hgt_above<=0.0001) exit + end do + endif + res_h = vol / wsa1 !m + wbody%flo = vol !m3 iweir = d_tbl%act_typ(iac) ht2%flo = ht2%flo + res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k / nstep !m3/s ht2%flo = ht2%flo + max(0.,ht2%flo) diff --git a/src/res_nutrient.f90 b/src/res_nutrient.f90 index cf009e1..6e4bd00 100644 --- a/src/res_nutrient.f90 +++ b/src/res_nutrient.f90 @@ -89,13 +89,13 @@ subroutine res_nutrient (iob) ht2%no2 = wbody%no2 * ht2%flo / (wbody%flo + ht2%flo) !! remove nutrients leaving reservoir - wbody%no3 = wbody%no3 - ht2%no3 - wbody%orgn = wbody%orgn - ht2%orgn - wbody%sedp = wbody%sedp - ht2%sedp - wbody%solp = wbody%solp - ht2%solp - wbody%chla = wbody%chla - ht2%chla - wbody%nh3 = wbody%nh3 - ht2%nh3 - wbody%no2 = wbody%no2 - ht2%no2 + wbody%no3 = max(0.,wbody%no3 - ht2%no3) !No less than zero, Jaehak 2024 + wbody%orgn = max(0.,wbody%orgn - ht2%orgn) + wbody%sedp = max(0.,wbody%sedp - ht2%sedp) + wbody%solp = max(0.,wbody%solp - ht2%solp) + wbody%chla = max(0.,wbody%chla - ht2%chla) + wbody%nh3 = max(0.,wbody%nh3 - ht2%nh3) + wbody%no2 = max(0.,wbody%no2 - ht2%no2) return end subroutine res_nutrient \ No newline at end of file diff --git a/src/res_read.f90 b/src/res_read.f90 index d75d649..80fb3b4 100644 --- a/src/res_read.f90 +++ b/src/res_read.f90 @@ -109,6 +109,7 @@ subroutine res_read do ihyd = 1, db_mx%res_hyd if (res_hyddb(ihyd)%name == res_dat_c(ires)%hyd) then res_hyd(ires) = res_hyddb(ihyd) + res_dat(ires)%hyd = ihyd exit end if end do @@ -134,6 +135,9 @@ subroutine res_read do ised = 1, db_mx%res_sed if (res_sed(ised)%name == res_dat_c(ires)%sed) then res_prm(ires)%sed = res_sed(ised) + !! d50 - micro meters + res_prm(ires)%sed_stlr_co = exp(-0.184 * res_prm(ires)%sed%d50) + res_dat(ires)%sed = ised exit end if end do @@ -141,6 +145,7 @@ subroutine res_read do inut = 1, db_mx%res_nut if (res_nut(inut)%name == res_dat_c(ires)%nut) then res_prm(ires)%nut = res_nut(inut) + res_dat(ires)%nut = inut exit end if end do diff --git a/src/res_sediment.f90 b/src/res_sediment.f90 index 35d0575..c8d157c 100644 --- a/src/res_sediment.f90 +++ b/src/res_sediment.f90 @@ -21,24 +21,6 @@ subroutine res_sediment wbody = hz else - !! compute new sediment concentration in reservoir - if (ht1%sed < 1.e-6) ht1%sed = 0.0 - !! velsetl = 1.35 for clay particle m/d - if (wbody_wb%area_ha > 1.e-6) then - velofl = (ht1%flo / wbody_wb%area_ha) / 10000. ! m3/d / ha * 10000. = m/d - if (velofl > 1.e-6) then - trapres = wbody_prm%sed%velsetlr / velofl - else - trapres = 1. - end if - if (trapres > 1.) trapres = 1. - else - trapres = 1. - end if - !wbody%sed = wbody%sed - (ht1%sed * trapres) - !wbody%sil = wbody%sil - (ht1%sil * trapres) - !wbody%cla = wbody%cla - (ht1%cla * trapres) - !! compute concentrations if (wbody%flo > 0.) then sed_ppm = 1000000. * wbody%sed / wbody%flo @@ -55,20 +37,17 @@ subroutine res_sediment !! compute change in sediment concentration due to settling if (sed_ppm > wbody_prm%sed%nsed) then - wbody_prm%sed%sed_stlr = exp(-wbody_prm%sed%sed_stlr) - sed_ppm = (sed_ppm - wbody_prm%sed%nsed) * wbody_prm%sed%sed_stlr + wbody_prm%sed%nsed + sed_ppm = (sed_ppm - wbody_prm%sed%nsed) * wbody_prm%sed_stlr_co + wbody_prm%sed%nsed sed_ppm = Max (sed_ppm, wbody_prm%sed%nsed) - !wbody%sed = sed_ppm * wbody%flo / 1000000. ! ppm -> t + !! update wetland sediment after settling + wbody%sed = sed_ppm * wbody%flo / 1000000. + !! calculate sediment in the outflow and subtract from wetland ht2%sed = sed_ppm * ht2%flo / 1000000. - wbody%sed = wbody%sed - ht2%sed + wbody%sed = Max(0.,wbody%sed - ht2%sed) - sil_ppm = (sil_ppm - wbody_prm%sed%nsed) * wbody_prm%sed%sed_stlr + wbody_prm%sed%nsed - wbody%sil = sil_ppm * wbody%flo / 1000000. ! ppm -> t - - cla_ppm = (cla_ppm - wbody_prm%sed%nsed) * wbody_prm%sed%sed_stlr + wbody_prm%sed%nsed - wbody%cla = cla_ppm * wbody%flo / 1000000. ! ppm -> t - !! assume all sand aggregates and gravel settles + wbody%sil = 0. + wbody%cla = 0. wbody%san = 0. wbody%sag = 0. wbody%lag = 0. @@ -78,10 +57,6 @@ subroutine res_sediment !! compute sediment leaving reservoir - ppm -> t ht2%sed = sed_ppm * ht2%flo / 1000000. wbody%sed = wbody%sed - ht2%sed - ht2%sil = sil_ppm * ht2%flo / 1000000. - wbody%sil = wbody%sil - ht2%sil - ht2%cla = cla_ppm * ht2%flo / 1000000. - wbody%cla = wbody%cla - ht2%cla end if diff --git a/src/res_weir_release.f90 b/src/res_weir_release.f90 index d72cb8e..3e30e45 100644 --- a/src/res_weir_release.f90 +++ b/src/res_weir_release.f90 @@ -31,11 +31,13 @@ subroutine res_weir_release (jres, id, ihyd, evol_m3, dep, weir_hgt) real :: wsa1 = 0. !m2 |water surface area real :: qout = 0. !m3 |weir discharge during short time step real :: hgt_above = 0. !m |height of water above the above bottom of weir + real :: vol_above = 0. !m3 |water volume above the bottom of weir !Jaehak 2024 !! store initial values vol = wbody%flo nstep = 1 - iweir = bsn_cc%cn + iweir = wet_ob(jres)%iweir + vol_above = 0 !water storage above weir height if (wet_hyd(ihyd)%name=='paddy') then !paddy @@ -54,15 +56,17 @@ subroutine res_weir_release (jres, id, ihyd, evol_m3, dep, weir_hgt) !endif !write(*,'(10f10.1)') w%precip,vol/wsa1*1000,ht2%flo/wsa1*1000,hru(jres)%water_seep,soil(jres)%sw !! check if reservoir decision table has a weir discharge command - do iac = 1, dtbl_res(id)%acts - if (dtbl_res(id)%act(iac)%option == "weir") then - weir_flg = 1 - exit - endif - end do + ! do iac = 1, dtbl_res(id)%acts + ! if (dtbl_res(id)%act(iac)%option == "weir") then + ! weir_flg = 1 + ! exit + ! endif + ! end do do tstep = 1, nstep + !! calculate weir discharge from scheduled management + if (hgt_above > 0 .and. iweir > 0) then !emergency spillway discharge Jaehak 2023 if (vol>evol_m3) then ht2%flo = ht2%flo + (wbody%flo - evol_m3) @@ -71,31 +75,36 @@ subroutine res_weir_release (jres, id, ihyd, evol_m3, dep, weir_hgt) res_h = vol / wsa1 !m hgt_above = max(0.,res_h - weir_hgt) !m endif + vol_above = hgt_above * wsa1 !m3 if (nstep>1) then !revised by Jaehak 2023 qout = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s qout = max(0.,86400. / nstep * qout) !m3 - if (qout > vol) then - ht2%flo = ht2%flo + vol !weir discharge volume for the day, m3 - vol = 0. + if (qout > vol_above) then + ht2%flo = ht2%flo + vol_above !weir discharge volume for the day, m3 + vol = vol - vol_above + vol_above = 0. else ht2%flo = ht2%flo + qout vol = vol - qout + vol_above = vol_above - qout end if res_h = vol / wsa1 !m hgt_above = max(0.,res_h - weir_hgt) !m Jaehak 2022 - if (vol==0.or.hgt_above==0) exit + if (vol_above<=0.001.or.hgt_above<=0.0001) exit else do ic = 1, 24 qout = res_weir(iweir)%c * res_weir(iweir)%w * hgt_above ** res_weir(iweir)%k !m3/s qout = 3600. * qout !m3 - if (qout > vol) then - ht2%flo = ht2%flo + vol !weir discharge volume for the day, m3 - vol = 0. + if (qout > vol_above) then + ht2%flo = ht2%flo + vol_above !weir discharge volume for the day, m3 + vol = vol - vol_above + vol_above = 0. else ht2%flo = ht2%flo + qout vol = vol - qout + vol_above = vol_above - qout end if if (wsa1 > 1.e-6) then @@ -104,9 +113,13 @@ subroutine res_weir_release (jres, id, ihyd, evol_m3, dep, weir_hgt) res_h = 0. end if hgt_above = max(0.,res_h - weir_hgt) !m Jaehak 2022 - if (vol==0.or.hgt_above==0) exit + if (vol_above<=0.001.or.hgt_above<=0.0001) exit end do endif + else + ht2%flo = 0. + endif + wbody%flo = vol !m3 end do return diff --git a/src/reservoir_data_module.f90 b/src/reservoir_data_module.f90 index fa3b706..b49c55d 100644 --- a/src/reservoir_data_module.f90 +++ b/src/reservoir_data_module.f90 @@ -98,7 +98,7 @@ module reservoir_data_module type reservoir_sed_data character(len=25) :: name = "" real :: nsed = 0. !kg/L |normal amt of sed in res (read in as mg/L and convert to kg/L) - real :: d50 = 0. !mm |median particle size of suspended and benthic sediment + real :: d50 = 0. !um |median particle size of suspended and benthic sediment real :: carbon = 0. !% |organic carbon in suspended and benthic sediment real :: bd = 0. !t/m^3 |bulk density of benthic sediment real :: sed_stlr = 0. !none |sediment settling rate @@ -126,6 +126,7 @@ module reservoir_data_module type water_body_data_parameters type (reservoir_sed_data) :: sed type (reservoir_nut_data) :: nut + real :: sed_stlr_co = 0. !none | end type water_body_data_parameters type (water_body_data_parameters), dimension(:), allocatable, target :: res_prm type (water_body_data_parameters), dimension(:), allocatable, target :: wet_prm diff --git a/src/reservoir_module.f90 b/src/reservoir_module.f90 index c8d321d..6ebe5f4 100644 --- a/src/reservoir_module.f90 +++ b/src/reservoir_module.f90 @@ -74,7 +74,7 @@ module reservoir_module character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" - character (len=9) :: j = " resnum " + character (len=8) :: j = " resnum " character (len=9) :: id = " gis_id " character (len=16) :: name = " name " character (len=13) :: flo = " flo" !! ha-m |volume of water @@ -166,7 +166,7 @@ module reservoir_module character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " - character (len=9) :: j = " " + character (len=8) :: j = " " character (len=9) :: id = " " character (len=16) :: name = " " character (len=13) :: flo = " ha-m" !! ha-m |volume of water diff --git a/src/sd_channel_control.f90 b/src/sd_channel_control.f90 index 974b763..26b97de 100644 --- a/src/sd_channel_control.f90 +++ b/src/sd_channel_control.f90 @@ -44,8 +44,10 @@ subroutine sd_channel_control real :: washld = 0. !tons |wash load real :: bedld = 0. !tons |bed load real :: dep = 0. !tons |deposition - real :: hc_sed = 0. !tons |headcut erosion - real :: chside = 0. !none |change in horizontal distance per unit + real :: sedp_dep = 0. !kg |Particulate P deposition MJW + real :: orgn_dep = 0. !kg |Particulate N deposition MJW + real :: hc_sed !tons |headcut erosion + real :: chside !none |change in horizontal distance per unit ! |change in vertical distance on channel side ! |slopes; always set to 2 (slope=1/2) real :: a = 0. !m^2 |cross-sectional area of channel @@ -413,7 +415,7 @@ subroutine sd_channel_control !! Peters latest channel erosion model !!vel = 1.37 * (sd_ch(ich)%chs ** 0.31) * (12. * sd_ch(ich)%chw) ** 0.32 !annual ave for SWIFT !! mean daily to peak ratio developed from GARDAY - THE STUDY OF MOST PROBABLE MEAN DAILY BANKFULL RUNOFF VOLUMES - !! IN SMALL WATERSHEDS DOMINATED BY CONVECTIVE/FRONTAL CHANNEL FORMING EVENTS AND THE CO-INCIDENT INNER BERM CHANNELS � PART I. + !! IN SMALL WATERSHEDS DOMINATED BY CONVECTIVE/FRONTAL CHANNEL FORMING EVENTS AND THE CO-INCIDENT INNER BERM CHANNELS – PART I. !! Another eq from Peter - Qmax=Qmean*(1+2.66*Drainage Area^-.3) pk_rto = 0.2 + 0.5 / 250. * ob(icmd)%area_ha pk_rto = amin1 (1., pk_rto) @@ -473,7 +475,7 @@ subroutine sd_channel_control shear_btm = 9800. * rcurv%dep * sd_ch(ich)%chs !! Pa = N/m^2 * m * m/m !! if bottom shear > d50 -> downcut - widen to maintain width depth ratio if (shear_btm > shear_btm_cr) then - ebtm_m = sd_ch(ich)%cherod * (shear_btm - shear_btm_cr) !! cm = hr * cm/hr/Pa * Pa + !ebtm_m = sd_ch(ich)%cherod * (shear_btm - shear_btm_cr) !! cm = hr * cm/hr/Pa * Pa !! calc mass of sediment eroded -> t = cm * m/100cm * width (m) * length (km) * 1000 m/km * bd (t/m3) ebtm_t = 10. * ebtm_m * sd_ch(ich)%chw * sd_ch(ich)%chl * sd_ch(ich)%ch_bd end if @@ -490,7 +492,10 @@ subroutine sd_channel_control !sd_ch(ich)%bankfull_flo = 1.0 !***jga bf_flow = sd_ch(ich)%bankfull_flo * ch_rcurv(ich)%elev(2)%flo_rate if (peakrate > bf_flow) then - dep = sd_ch(ich)%chseq * ht1%sed !((peakrate - bf_flow) / peakrate) * ht1%sed + !dep = sd_ch(ich)%chseq * ht1%sed !((peakrate - bf_flow) / peakrate) * ht1%sed + !! deposit Particulate P and N in the floodplain + !sedp_dep = sd_ch(ich)%chseq * ht1%sedp !MJW 2024 May need to include a enrichment factor for transported sediment + !orgn_dep = sd_ch(ich)%chseq * ht1%orgn !MJW 2024 end if !! compute sediment leaving the channel - washload only @@ -537,10 +542,13 @@ subroutine sd_channel_control !! reset sed to tons ht2%sed = sedout - !! add nutrients from bank erosion - t *ppm (1/1,000,000) * 1000. kg/t - ht2%orgn = ht2%orgn + ebank_t * sd_ch(ich)%n_conc * 1000. - ht2%sedp = ht2%sedp + ebank_t * sd_ch(ich)%p_conc * 1000. - ht2%solp = ht2%solp + ebank_t * sd_ch(ich)%p_bio * 1000. + !! subtract nutrients deposited in floodplain + ht2%sedp = ht2%sedp - sedp_dep !MJW 2024 + ht2%orgn = ht2%orgn - orgn_dep !MJW 2024 + !! add nutrients from bank erosion - t * mg/kg (ppm) * kg/1000 mg * 1000 kg/t = kg + ht2%orgn = ht2%orgn + ebank_t * sd_ch(ich)%n_conc + ht2%sedp = ht2%sedp + ebank_t * sd_ch(ich)%p_conc + ht2%solp = ht2%solp + ebank_t * sd_ch(ich)%p_bio !! route constituents call ch_rtpest diff --git a/src/sd_channel_control3.f90 b/src/sd_channel_control3.f90 index ca119e3..4465968 100644 --- a/src/sd_channel_control3.f90 +++ b/src/sd_channel_control3.f90 @@ -310,7 +310,9 @@ subroutine sd_channel_control3 end if ! ht1%flo > 0. !rtb hydrograph separation - if (rttime > det) then ! ht1 = incoming + storage + if (rttime > time%dtm / 60.) then ! travel time > routing time step (hours) + !! Variable Storage Coefficent method - sc=2*dt/(2*ttime+dt) - ttime=(in2+out1)/2 + scoef = 24. / (ch_rcurv(jrch)%in2%ttime + ch_rcurv(jrch)%out1%ttime + 24.) !! travel time > timestep -- then all incoming is stored and frac of stored is routed hdsep2%flo_surq = scoef * ch_stor_hdsep(ich)%flo_surq hdsep2%flo_latq = scoef * ch_stor_hdsep(ich)%flo_latq diff --git a/src/sd_channel_module.f90 b/src/sd_channel_module.f90 index 9662066..d6bd53d 100644 --- a/src/sd_channel_module.f90 +++ b/src/sd_channel_module.f90 @@ -24,10 +24,10 @@ module sd_channel_module real :: chl = 0. !km |channel length real :: chn = 0. ! |channel Manning's n real :: chk = 0. !mm/h |channel bottom conductivity - real :: cherod = 0. ! |channel erodibility + real :: bank_exp = 0. ! |bank erosion exponent real :: cov = 0. !0-1 |channel cover factor real :: sinu = 0. !none |sinuousity - ratio of channel length and straight line length - real :: chseq = 0. !m/m |equilibrium channel slope + real :: vcr_coef = 0. ! |critical velocity coefficient real :: d50 = 0. !mm |channel median sediment size real :: ch_clay = 0. !% |clay percent of bank and bed real :: carbon = 0. !% |carbon percent of bank and bed @@ -54,7 +54,7 @@ module sd_channel_module real :: n_dep_enr = 0.5 ! |enrichment of N in remaining water - deposition = 1/enrichment ratio real :: p_dep_enr = 0.5 ! |enrichment of P in remaining water - deposition = 1/enrichment ratio real :: arc_len_fr = 1.2 !frac |fraction of arc length where bank erosion occurs - real :: part_size = 0.002 !mm |particle size of channel washload + real :: bed_exp = 1.5 ! |bed erosion exponential coefficient real :: wash_bed_fr = 0.1 !frac |fraction of bank erosion that is washload end type swatdeg_sednut_data type (swatdeg_sednut_data), dimension (:), allocatable :: sd_chd1 @@ -172,7 +172,7 @@ module sd_channel_module real :: chk = 0. !mm/h |channel bottom conductivity real :: cov = 0. !0-1 |channel cover factor real :: sinu = 0. !none |sinuousity - ratio of channel length and straight line length - real :: chseq = 0. !m/m |equilibrium channel slope + real :: vcr_coef = 0. !m/m |critical velocity coefficient real :: d50 = 0. real :: ch_clay = 0. real :: carbon = 0. @@ -193,12 +193,12 @@ module sd_channel_module real :: n_dep_enr = 0.5 ! |enrichment of N in remaining water - deposition = 1/enrichment ratio real :: p_dep_enr = 0.5 ! |enrichment of P in remaining water - deposition = 1/enrichment ratio real :: arc_len_fr = 1.2 !frac |fraction of arc length where bank erosion occurs - real :: part_size = 0.002 !mm |particle size of channel washload + real :: bed_exp = 1.5 !mm |bed erosion exponent real :: wash_bed_fr = 0.2 !frac |fraction of bank erosion that is washload real :: hc_kh = 0. real :: hc_hgt = 0. !m |headcut height real :: hc_ini = 0. - real :: cherod = 0. ! |channel erodibility + real :: bank_exp = 0. ! |bank erosion exponent real :: shear_bnk = 0. !0-1 |bank shear coefficient - fraction of bottom shear real :: hc_erod = 0. ! |headcut erodibility real :: hc_co = 0. !m/m |proportionality coefficient for head cut diff --git a/src/sd_channel_sediment.f90 b/src/sd_channel_sediment.f90 index ed7048c..f066676 100644 --- a/src/sd_channel_sediment.f90 +++ b/src/sd_channel_sediment.f90 @@ -115,7 +115,7 @@ subroutine sd_channel_sediment (ts_int) shear_bank_cr = 0.493 * 10. ** (.0182 * sd_ch(ich)%ch_clay) e_bank = 0. if (shear_bank_adj > shear_bank_cr) then - e_bank = ts_hr * sd_ch(ich)%cherod * (shear_bank_adj - shear_bank_cr) !! cm = hr * cm/hr/Pa * Pa + !e_bank = ts_hr * sd_ch(ich)%cherod * (shear_bank_adj - shear_bank_cr) !! cm = hr * cm/hr/Pa * Pa erode_bank = erode_bank + e_bank !! calc mass of sediment eroded -> t = cm * m/100cm * width (m) * length (km) * 1000 m/km * bd (t/m3) !! apply to only one side (perim_bank / 2.) @@ -128,7 +128,7 @@ subroutine sd_channel_sediment (ts_int) if (sd_ch(ich)%chs > 0.000001) then ! sd_ch(ich)%chseq) then !! if bottom shear > d50 -> downcut - widen to maintain width depth ratio if (shear_btm > shear_btm_cr) then - e_btm = ts_hr * sd_ch(ich)%cherod * (shear_btm - shear_btm_cr) !! cm = hr * cm/hr/Pa * Pa + !e_btm = ts_hr * sd_ch(ich)%cherod * (shear_btm - shear_btm_cr) !! cm = hr * cm/hr/Pa * Pa !! if downcutting - check width depth ratio to see if widens !if (sd_ch(ich)%chw / sd_ch(ich)%chd < sd_ch(ich)%wd_rto) then ! erode_bank_cut = e_btm * sd_ch(ich)%wd_rto @@ -165,7 +165,7 @@ subroutine sd_channel_sediment (ts_int) !! compute flood plain deposition bf_flow = sd_ch(ich)%bankfull_flo * ch_rcurv(ich)%elev(2)%flo_rate if (peakrate > bf_flow) then - dep = sd_ch(ich)%chseq * ht1%sed !((peakrate - bf_flow) / peakrate) * ht1%sed + !dep = sd_ch(ich)%chseq * ht1%sed !((peakrate - bf_flow) / peakrate) * ht1%sed end if !! output channel morphology diff --git a/src/sd_channel_sediment3.f90 b/src/sd_channel_sediment3.f90 index a6ea481..55b9423 100644 --- a/src/sd_channel_sediment3.f90 +++ b/src/sd_channel_sediment3.f90 @@ -2,6 +2,7 @@ subroutine sd_channel_sediment3 use climate_module use sd_channel_module + use channel_module use hydrograph_module use time_module use hru_module, only : hru @@ -22,18 +23,20 @@ subroutine sd_channel_sediment3 real :: vel_fall = 0. !m/s |fall velocity of sediment particles in channel real :: dep_fall = 0. !m |fall depth of sediment particles in channel real :: del_rto = 0. !frac |fraction of sediment deposited in channel - real :: conc_chng = 0. ! |change in concentration (and mass) in channel sol and org N and P real :: ebtm_m = 0. !m |erosion of bottom of channel real :: ebank_m = 0. !m |meander cut on one side real :: ebtm_t = 0. !tons |bottom erosion real :: ebank_t = 0. !tons |bank erosion real :: shear_btm_cr = 0. ! | real :: shear_btm = 0. ! | + real :: inflo = 0. !m^3 |inflow water volume + real :: inflo_rate = 0. !m^3/s |inflow rate + real :: flo_time = 0. !s |estimate of total flow time through the channel real :: bf_flow = 0. !m3/s |bankfull flow rate * adjustment factor real :: pk_rto = 0. !ratio |peak to mean flow rate ratio real :: bd_fac = 0. ! |bulk density factor for critical velocity calculation real :: cohes_fac = 0. ! |cohesion factor for critical velocity calculation - !real :: qman !m^3/s or m/s |flow rate or flow velocity + real :: florate !m^3/s |flow rate below the triangle for flow lasting more than a day real :: vel = 0. real :: veg = 0. real :: vel_cr = 0. @@ -67,35 +70,16 @@ subroutine sd_channel_sediment3 !! calculate channel sed and nutrient processes if inflow > 0 if (ht1%flo > 1.e-6) then - !! Another eq from Peter - Qmax=Qmean*(1+2.66*Drainage Area^-.3) - pk_rto = 0.2 + 0.5 / 250. * ob(icmd)%area_ha - pk_rto = Max (1., pk_rto) - pk_rto = 1. + 2.66 * (ob(icmd)%area_ha / 100.) ** (-.3) - !pk_rto = 1. + 1.33 * (ob(icmd)%area_ha / 100.) ** (-.3) - !pk_rto = 1. + 2. * (ob(icmd)%area_ha / 100.) ** (-.3) - !pk_rto = Min (2., pk_rto) - !pk_rto = 1.5 - peakrate = pk_rto * ht1%flo / 86400. !m3/s + !! calculate peak daily flow + peakrate = sd_ch(ich)%pk_rto * ht1%flo / 86400. !m3/s !! interpolate rating curve using peak rate call rcurv_interp_flo (ich, peakrate) !! use peakrate as flow rate h_rad = rcurv%xsec_area / rcurv%wet_perim - sd_ch(ich)%chn = 0.39 * sd_ch(ich)%chs ** 0.38 * h_rad ** (-0.16) - sd_ch(ich)%chn = 0.5 + 0.2 * (ob(icmd)%area_ha / 100.) ** (-.3) - if (ob(icmd)%area_ha <= 5.) then - sd_ch(ich)%chn = 0.13 - end if - if (ob(icmd)%area_ha >= 2500.) then - sd_ch(ich)%chn = 0.03 - end if - if (ob(icmd)%area_ha > 5. .and. ob(icmd)%area_ha >= 2500.) then - sd_ch(ich)%chn = 0.2 / log(ob(icmd)%area_ha / 100.) - end if - sd_ch(ich)%chn = Min (0.15, sd_ch(ich)%chn) - sd_ch(ich)%chn = Max (0.02, sd_ch(ich)%chn) vel = h_rad ** .6666 * Sqrt(sd_ch(ich)%chs) / (sd_ch(ich)%chn + .001) !vel = peakrate / rcurv%xsec_area + rttime = sd_ch(ich)%chl / (3.6 * vel) !! add precip to inflow - km * m * 1000 m/km * ha/10000 m2 = ha ch_wat_d(ich)%area_ha = sd_ch(ich)%chl * sd_ch(ich)%chw / 10. @@ -109,12 +93,21 @@ subroutine sd_channel_sediment3 !! compute flood plain deposition bf_flow = sd_ch(ich)%bankfull_flo * ch_rcurv(ich)%elev(2)%flo_rate florate_ob = peakrate - bf_flow - flovol_ob = florate_ob * 86400. - flovol_ob = Min (flovol_ob, ht1%flo) - if (flovol_ob > 0.) then - trap_eff = 0.05 * log(sd_ch(ich)%fp_inun_days) + 0.1 + if (florate_ob > 0.) then + flo_time = 2. * ht1%flo / peakrate + !! assume a triangular distribution + if (flo_time < 86400.) then + !! flow is over within the day + flovol_ob = ht1%flo * (((peakrate - bf_flow) / peakrate) ** 2) + else + !! flow continues over the day - florate is the rate under the triangle + florate = 2. * ht1%flo - peakrate + flovol_ob = ht1%flo * (((peakrate - bf_flow) / (peakrate - florate)) ** 2) + end if + !trap_eff = 0.05 * log(sd_ch(ich)%fp_inun_days) + 0.1 + !! trap efficiency from Dynamic SedNet Component Model Reference Guide: Update 2017 fp_m2 = 3. * sd_ch(ich)%chw * sd_ch(ich)%chl * 1000. - exp_co = 0.00001 * fp_m2 / florate_ob + exp_co = 0.0007 * fp_m2 / florate_ob trap_eff = sd_ch(ich)%fp_inun_days * (florate_ob / peakrate) * (1. - exp(-exp_co)) trap_eff = Min (1., trap_eff) fp_dep%sed = trap_eff * ht1%sed @@ -123,8 +116,8 @@ subroutine sd_channel_sediment3 fp_dep%orgn = trap_eff * sd_ch(ich)%n_dep_enr * ht1%orgn fp_dep%sedp = trap_eff * sd_ch(ich)%p_dep_enr * ht1%sedp !! trap nitrate and sol P in flood plain - when not simulating flood plain interactions? - fp_dep%no3 = trap_eff * ht1%no3 - fp_dep%solp = trap_eff * ht1%solp + fp_dep%no3 = 0. !trap_eff * ht1%no3 + fp_dep%solp = 0. !trap_eff * ht1%solp ht1 = ht1 - fp_dep !! if flood plain link - fill wetlands to emergency @@ -144,6 +137,7 @@ subroutine sd_channel_sediment3 rto = Min (1., rto) if (rto > 1.e-6) then wet(iihru) = wet(iihru) + rto * ht1 + wet_in_d(iihru) = wet_in_d(iihru) + rto * ht1 hru(iihru)%wet_obank_in = (rto * ht1%flo) / (10. * hru(iihru)%area_ha) rto1 = 1. - rto ob(icmd)%tsin(:) = rto1 * ob(icmd)%tsin(:) @@ -157,23 +151,7 @@ subroutine sd_channel_sediment3 !! add sediment deposition to calculate mm of deposition over the flood plain later ch_morph(ich)%fp_mm = ch_morph(ich)%fp_mm + fp_dep%sed - !! calculate channel deposition based on fall velocity - SWRRB book - !! assume particle size = 0.03 mm -- median silt size - vel_fall = 411. * sd_ch(ich)%part_size ** 2 ! m/h - dep_fall = vel_fall * rcurv%ttime - !! assume bankfull flow depth - if (dep_fall < sd_ch(ich)%chd) then - del_rto = 1. - .5 * dep_fall / sd_ch(ich)%chd - else - del_rto = .5 * sd_ch(ich)%chd / dep_fall - end if - ch_dep%sed = (1. - del_rto) * ht1%sed - ch_dep%orgn = sd_ch(ich)%n_dep_enr * (1. - del_rto) * ht1%orgn - ch_dep%sedp = sd_ch(ich)%p_dep_enr * (1. - del_rto) * ht1%sedp - rto = ch_dep%flo / ht1%flo - ob(icmd)%tsin(:) = (1. - rto) * ob(icmd)%tsin(:) - ht1 = ht1 - ch_dep !! calc bank erosion cohesion = (-87.1 + (42.82 * sd_ch(ich)%ch_clay) - (0.261 * sd_ch(ich)%ch_clay ** 2.) & @@ -183,64 +161,71 @@ subroutine sd_channel_sediment3 bd_fac = Max (0.001, 0.03924 * sd_ch(ich)%ch_bd * 1000. - 1000.) cohes_fac = 0.021 * cohesion + veg vel_cr = log10 (2200. * sd_ch(ich)%chd) * (0.0004 * (bd_fac + cohes_fac)) ** 0.5 - - !cohesion = (15. / (15.3 - 0.438 * sd_ch(ich)%ch_clay + 0.0044 * sd_ch(ich)%ch_clay ** 2.)) * 1000. - !veg = exp (-5. * sd_ch(ich)%chd) * cha1(icha)%dat%cov !function of cover factor - !vel_cr = log10 (8.8 * sd_ch(ich)%chd / 0.004) * (0.0004 * ((sd_ch(ich)%ch_bd * & - ! 1000. - 1000.) * 9.81 * 0.004 + 0.021 * cohesion + veg)) ** 0.5 + vel_cr = sd_ch(ich)%vcr_coef * vel_cr !! calculate radius of curvature - rad_curv = ((12. * sd_ch(ich)%chw) * sd_ch(ich)%sinu ** 1.5) / (13. * (sd_ch(ich)%sinu -1.) ** 0.5) + rad_curv = ((12. * sd_ch(ich)%chw) * sd_ch(ich)%sinu ** 1.5) / & + (13. * (sd_ch(ich)%sinu -1.) ** 0.5) vel_bend = vel * (1. / rad_curv + 1.) vel_rch = 0.33 * vel_bend + 0.66 * vel b_exp = 12.3 / sqrt (sd_ch(ich)%ch_clay + 1.) b_exp = min (3.5, b_exp) - if (vel_rch > vel_cr) then ! .and. rcurv%dep / sd_ch(ich)%chd > 0.1) then - ebank_m = 0.0024 * (vel_rch / vel_cr) ** b_exp !bank erosion m/yr + if (vel_rch > vel_cr) then + !! bank erosion m/yr + ebank_m = 0.0024 * (vel_rch / vel_cr) ** sd_ch(ich)%bank_exp else ebank_m = 0. end if ch_morph(ich)%w_yr = ch_morph(ich)%w_yr + ebank_m !! calc mass of sediment eroded -> t = bankcut (m) * depth (m) * lengthcut (m) * bd (t/m3) - !! arc length = 0.33 * meander wavelength * sinuosity -> protected length + !! arc length = 0.33 * meander wavelength * sinuosity arc_len = 0.33 * (12. * sd_ch(ich)%chw) * sd_ch(ich)%sinu prot_len = arc_len * sd_ch(ich)%arc_len_fr - prot_len = 0.2 * sd_ch(ich)%chl * 1000. - !rad_curv = (12. * sd_ch(ich)%chw * sd_ch(ich)%sinu ** 1.5) / & - ! (13. * (sd_ch(ich)%sinu - 0.999) ** 0.5) - !cutbank_adj = 2.57 - 0.36 * log(rad_curv / sd_ch(ich)%chw) - !ebank_t = ebank_m * sd_ch(ich)%chd * sd_ch(ich)%arc_len_fr * prot_len * sd_ch(ich)%ch_bd - !ebank_t = 0.8 * ebank_t !assume 80% wash load and 20% bed deposition - !ebank_t = max (0., ebank_t) - !ebank_t = 1000. * (vel_rch * sd_ch(ich)%chs) ** 2. * (1. - sd_ch(ich)%cov) * (sd_ch(ich)%ch_clay + 1.) - !sd_ch(ich)%pk_rto = 500. - ebank_t = (1000. * sd_ch(ich)%pk_rto * vel_rch * sd_ch(ich)%chs) ** 2. * & - (1. - sd_ch(ich)%ch_clay / 100.) - prot_len = 0.2 * sd_ch(ich)%chl - ebank_t = ebank_t * prot_len + ebank_t = ebank_m * sd_ch(ich)%chd * sd_ch(ich)%arc_len_fr * prot_len * sd_ch(ich)%ch_bd bank_ero%sed = ebank_t !! calculate associated nutrients - bank_ero%orgn = bank_ero%sed * sd_ch(ich)%n_conc - bank_ero%sedp = (1. - sd_ch(ich)%p_bio) * bank_ero%sed * sd_ch(ich)%p_conc + bank_ero%orgn = bank_ero%sed * sd_ch(ich)%n_conc / 1000. + bank_ero%sedp = (1. - sd_ch(ich)%p_bio) * bank_ero%sed * sd_ch(ich)%p_conc / 1000. bank_ero%no3 = 0. - bank_ero%solp = sd_ch(ich)%p_bio * bank_ero%sed * sd_ch(ich)%p_conc + bank_ero%solp = sd_ch(ich)%p_bio * bank_ero%sed * sd_ch(ich)%p_conc / 1000. bank_ero%no2 = 0. rto = bank_ero%flo / ht1%flo ob(icmd)%tsin(:) = (1. - rto) * ob(icmd)%tsin(:) ht1 = ht1 + bank_ero + !! calculate channel deposition based on fall velocity - SWRRB book + !! assume particle size = 0.03 mm -- median silt size + !vel_fall = 411. * sd_ch(ich)%part_size ** 2 ! m/h + !dep_fall = vel_fall * rcurv%ttime + !! assume bankfull flow depth + !if (dep_fall < sd_ch(ich)%chd) then + ! del_rto = 1. - .5 * dep_fall / sd_ch(ich)%chd + !else + ! del_rto = .5 * sd_ch(ich)%chd / dep_fall + !end if + !ch_dep%sed = (1. - del_rto) * ht1%sed + !ch_dep%orgn = sd_ch(ich)%n_dep_enr * (1. - del_rto) * ht1%orgn + !ch_dep%sedp = sd_ch(ich)%p_dep_enr * (1. - del_rto) * ht1%sedp + !rto = ch_dep%flo / ht1%flo + !ob(icmd)%tsin(:) = (1. - rto) * ob(icmd)%tsin(:) + !ht1 = ht1 - ch_dep + !! calculate channel deposition as the bedload fraction of bank erosion + ch_dep%sed = sd_ch(ich)%wash_bed_fr * bank_ero%sed + ch_dep%orgn = sd_ch(ich)%n_dep_enr * sd_ch(ich)%wash_bed_fr * bank_ero%orgn + ch_dep%sedp = sd_ch(ich)%p_dep_enr * sd_ch(ich)%wash_bed_fr * bank_ero%sedp + ht1 = ht1 - ch_dep !! calculate bed erosion !! no downcutting below equilibrium slope - if (sd_ch(ich)%chs > 0.000001) then !sd_ch(ich)%chseq) then + if (sd_ch(ich)%chs > 0.000001) then !! calc critical shear and shear on bottom of channel shear_btm_cr = sd_ch(ich)%d50 shear_btm = 9800. * rcurv%dep * sd_ch(ich)%chs !! Pa = N/m^2 * m * m/m !! critical shear function of d50 vel_cr = 0.293 * (sd_ch(ich)%d50) ** 0.5 - vel_cr = 1. if (vel > vel_cr) then - ebtm_m = 0.0001 * (vel_rch / vel_cr) ** 1.5 !bed erosion m/yr + !! bed erosion m/yr + ebtm_m = 0.0001 * (vel_rch / vel_cr) ** sd_ch(ich)%bed_exp end if !! calc mass of sediment eroded -> t = m * width (m) * length (km) * 1000 m/km * bd (t/m3) ebtm_t = 1000. * ebtm_m * sd_ch(ich)%chw * sd_ch(ich)%chl * sd_ch(ich)%ch_bd @@ -255,8 +240,8 @@ subroutine sd_channel_sediment3 bed_ero%solp = sd_ch(ich)%p_bio * bed_ero%sed * sd_ch(ich)%p_conc bed_ero%no2 = 0. rto = bed_ero%flo / ht1%flo - ob(icmd)%tsin(:) = (1. - rto) * ob(icmd)%tsin(:) - ht1 = ht1 + bed_ero + !ob(icmd)%tsin(:) = (1. - rto) * ob(icmd)%tsin(:) + !ht1 = ht1 + bed_ero end if ! inflow>0 diff --git a/src/sd_hydsed_init.f90 b/src/sd_hydsed_init.f90 index 9bc7cff..3edca75 100644 --- a/src/sd_hydsed_init.f90 +++ b/src/sd_hydsed_init.f90 @@ -79,12 +79,11 @@ subroutine sd_hydsed_init sd_ch(i)%chn = sd_chd(idb)%chn if (sd_ch(i)%chn < .05) sd_ch(i)%chn = .05 !***jga sd_ch(i)%chk = sd_chd(idb)%chk - sd_ch(i)%cherod = sd_chd(idb)%cherod + sd_ch(i)%bank_exp = sd_chd(idb)%bank_exp sd_ch(i)%cov = sd_chd(idb)%cov sd_ch(i)%sinu = sd_chd(idb)%sinu if (sd_ch(i)%sinu < 1.05) sd_ch(i)%sinu = 1.05 - sd_ch(i)%chseq = sd_chd(idb)%chseq - if (sd_ch(i)%chseq < 1.e-6) sd_ch(i)%chseq = 0.5 + sd_ch(i)%vcr_coef = sd_chd(idb)%vcr_coef sd_ch(i)%d50 = sd_chd(idb)%d50 sd_ch(i)%ch_clay = sd_chd(idb)%ch_clay sd_ch(i)%carbon = sd_chd(idb)%carbon @@ -111,7 +110,7 @@ subroutine sd_hydsed_init sd_ch(i)%n_dep_enr = sd_chd1(idb1)%n_dep_enr sd_ch(i)%p_dep_enr = sd_chd1(idb1)%p_dep_enr sd_ch(i)%arc_len_fr = sd_chd1(idb1)%arc_len_fr - sd_ch(i)%part_size = sd_chd1(idb1)%part_size + sd_ch(i)%bed_exp = sd_chd1(idb1)%bed_exp sd_ch(i)%wash_bed_fr = sd_chd1(idb1)%wash_bed_fr !! compute headcut parameters diff --git a/src/soil_nutcarb_init.f90 b/src/soil_nutcarb_init.f90 index 1cf8db1..c911954 100644 --- a/src/soil_nutcarb_init.f90 +++ b/src/soil_nutcarb_init.f90 @@ -34,11 +34,19 @@ subroutine soil_nutcarb_init (isol) isolt = sol_plt_ini(isol_pl)%nut ! isolt = 0 = default in type !! set soil carbon - soil1(ihru)%cbn(1) = max(.001, soildb(isol)%ly(1)%cbn) !! assume 0.001% carbon if zero + soil1(ihru)%cbn(1) = max(0.001, soildb(isol)%ly(1)%cbn) !! assume 0.001% carbon if zero !! calculate percent carbon for lower layers using exponential decrease + !do ly = 2, nly + !dep_frac = Exp(-solt_db(isolt)%exp_co * soil(ihru)%phys(ly)%d) + !soil1(ihru)%cbn(ly) = soil1(ihru)%cbn(1) * dep_frac + !end do + !! use carbon content in the soils database do ly = 2, nly - dep_frac = Exp(-solt_db(isolt)%exp_co * soil(ihru)%phys(ly)%d) - soil1(ihru)%cbn(ly) = soil1(ihru)%cbn(1) * dep_frac + if (ly - 1 <= soildb(isol)%s%nly) then + soil1(ihru)%cbn(ly) = soildb(isol)%ly(ly-1)%cbn + else + soil1(ihru)%cbn(ly) = soildb(isol)%ly(soildb(isol)%s%nly)%cbn + end if end do !! calculate initial nutrient contents of layers, profile and diff --git a/src/soil_nutcarb_module.f90 b/src/soil_nutcarb_module.f90 index 808b3e4..3b6591c 100644 --- a/src/soil_nutcarb_module.f90 +++ b/src/soil_nutcarb_module.f90 @@ -36,7 +36,7 @@ module soil_nutcarb_module character (len=15) :: man_c = " kg/ha" character (len=15) :: hum_c = " kg/ha" character (len=15) :: phum_c = " kg/ha" - character (len=15) :: mb_c = " kg/ha" + character (len=12) :: mb_c = " kg/ha" end type organic_carbon_units type (organic_carbon_units) :: orgc_units diff --git a/src/soils_init.f90 b/src/soils_init.f90 index b2ca507..4240763 100644 --- a/src/soils_init.f90 +++ b/src/soils_init.f90 @@ -200,6 +200,7 @@ subroutine soils_init allocate (soil1_init(ihru)%man(nly)) allocate (soil1_init(ihru)%water(nly)) + call soil_nutcarb_init(isol) !! initialize soil nutrient/carbon parameters Jaehak 2024 end do return diff --git a/src/sq_canopyint.f90 b/src/sq_canopyint.f90 index 1368e81..cf8d3ec 100644 --- a/src/sq_canopyint.f90 +++ b/src/sq_canopyint.f90 @@ -87,7 +87,7 @@ subroutine sq_canopyint precip_eff = precip_eff - (canmxl - canstor(j)) canstor(j) = canmxl endif - end if + end if ! time%step > 1 return end subroutine sq_canopyint \ No newline at end of file diff --git a/src/structure_set_parms.f90 b/src/structure_set_parms.f90 index 6a9c030..fe0b89c 100644 --- a/src/structure_set_parms.f90 +++ b/src/structure_set_parms.f90 @@ -63,7 +63,7 @@ subroutine structure_set_parms (str_name, istr, j) case ("grassww") hru(j)%lumv%ngrwat = istr if (istr > 0) then - hru(j)%lumv%grwat_i = grwaterway_db(istr)%grwat_i + hru(j)%lumv%grwat_i = 1 hru(j)%lumv%grwat_n = grwaterway_db(istr)%grwat_n hru(j)%lumv%grwat_spcon = grwaterway_db(istr)%grwat_spcon hru(j)%lumv%grwat_d = grwaterway_db(istr)%grwat_d diff --git a/src/swr_percmain.f90 b/src/swr_percmain.f90 index 4f8b17f..9296186 100644 --- a/src/swr_percmain.f90 +++ b/src/swr_percmain.f90 @@ -68,7 +68,7 @@ subroutine swr_percmain !! initialize water entering first soil layer !! ht1%flo is infiltration from overland flow routing if (ires==0) then - sepday = inflpcp + irrig(j)%applied + ht1%flo !mm + sepday = inflpcp + irrig(j)%applied + ht1%flo / (hru(j)%area_ha * 10.) else sepday = inflpcp + ht1%flo / (hru(j)%area_ha * 10.) endif diff --git a/src/time_control.f90 b/src/time_control.f90 index c722016..623fccb 100644 --- a/src/time_control.f90 +++ b/src/time_control.f90 @@ -228,13 +228,18 @@ subroutine time_control call conditions (j, id) call actions (j, iob, id) end if - !! have to check every hru for land use change + !! check every hru for land use change if (upd_cond(iupd)%typ == "lu_change") then do j = 1, sp_ob%hru call conditions (j, id) call actions (j, iob, id) end do end if + !! change the land use that is specified + if (upd_cond(iupd)%typ == "lu_change1") then + call conditions (j, id) + call actions (j, iob, id) + end if !end if end do @@ -285,7 +290,7 @@ subroutine time_control if (sp_ob%hru > 0) then do iplt = 1, basin_plants crop_yld_t_ha = bsn_crop_yld(iplt)%yield / (bsn_crop_yld(iplt)%area_ha + 1.e-6) - write (5100,*) time%yrc, iplt, plants_bsn(iplt), bsn_crop_yld(iplt)%area_ha, & + write (5100,*) time%yrc, iplt, plts_bsn(iplt), bsn_crop_yld(iplt)%area_ha, & bsn_crop_yld(iplt)%yield, crop_yld_t_ha bsn_crop_yld_aa(iplt)%area_ha = bsn_crop_yld_aa(iplt)%area_ha + bsn_crop_yld(iplt)%area_ha bsn_crop_yld_aa(iplt)%yield = bsn_crop_yld_aa(iplt)%yield + bsn_crop_yld(iplt)%yield @@ -294,7 +299,7 @@ subroutine time_control crop_yld_t_ha = bsn_crop_yld_aa(iplt)%yield / (bsn_crop_yld_aa(iplt)%area_ha + 1.e-6) bsn_crop_yld_aa(iplt)%area_ha = bsn_crop_yld_aa(iplt)%area_ha / time%yrs_prt bsn_crop_yld_aa(iplt)%yield = bsn_crop_yld_aa(iplt)%yield / time%yrs_prt - write (5101,*) time%yrc, iplt, plants_bsn(iplt), bsn_crop_yld_aa(iplt)%area_ha, & + write (5101,*) time%yrc, iplt, plts_bsn(iplt), bsn_crop_yld_aa(iplt)%area_ha, & bsn_crop_yld_aa(iplt)%yield, crop_yld_t_ha bsn_crop_yld_aa(iplt) = bsn_crop_yld_z end if diff --git a/src/wallo_demand.f90 b/src/wallo_demand.f90 index dfd40b6..633ee69 100644 --- a/src/wallo_demand.f90 +++ b/src/wallo_demand.f90 @@ -75,7 +75,11 @@ subroutine wallo_demand (iwallo, idmd) j = wallo(iwallo)%dmd(idmd)%ob_num !! if there is demand, use amount from water allocation file if (irrig(j)%demand > 0.) then + if (hru(j)%irr_hmax > 0.) then + wallod_out(iwallo)%dmd(idmd)%dmd_tot = irrig(j)%demand !m3 Irrigation demand based on paddy/wetland target ponding depth Jaehak 2023 + else wallod_out(iwallo)%dmd(idmd)%dmd_tot = wallo(iwallo)%dmd(idmd)%amount * hru(j)%area_ha * 10. !m3 = mm * ha * 10. + endif else wallod_out(iwallo)%dmd(idmd)%dmd_tot = 0. end if diff --git a/src/water_allocation_read.f90 b/src/water_allocation_read.f90 index 56a80a5..fd4b442 100644 --- a/src/water_allocation_read.f90 +++ b/src/water_allocation_read.f90 @@ -116,7 +116,7 @@ subroutine water_allocation_read allocate (walloy_out(iwro)%dmd(i)%src(num_objs)) allocate (walloa_out(iwro)%dmd(i)%src(num_objs)) - !! for hru irrigtion, need to xwalk with irrigation demand decision table + !! for hru irrigation, need to xwalk with irrigation demand decision table if (wallo(iwro)%dmd(i)%ob_typ == "hru") then !! xwalk with lum decision table do idb = 1, db_mx%dtbl_lum diff --git a/src/wet_initial.f90 b/src/wet_initial.f90 index 01d13b7..6d41cba 100644 --- a/src/wet_initial.f90 +++ b/src/wet_initial.f90 @@ -31,15 +31,14 @@ subroutine wet_initial (iihru) iweir = wet_ob(iihru)%iweir if (iprop > 0) then - ihyd = wet_dat(iprop)%hyd - !if (wet_hyd(ihyd)%k > 0.) then - hru(iihru)%wet_hc = wet_hyd(ihyd)%k !mm/hr + !if (wet_hyd(iihru)%k > 0.) then + hru(iihru)%wet_hc = wet_hyd(iihru)%k !mm/hr !else ! hru(iihru)%wet_hc = soil(iihru)%phys(1)%k !endif !! ha*mm*10. => m**3 - assume entire hru is wet and don't use fractional inputs (for simplicity) - wet_ob(iihru)%evol = hru(iihru)%area_ha * wet_hyd(iihru)%edep * 10. ! * wet_hyd(ihyd)%esa - wet_ob(iihru)%pvol = hru(iihru)%area_ha * wet_hyd(iihru)%pdep * 10. ! * wet_hyd(ihyd)%psa + wet_ob(iihru)%evol = hru(iihru)%area_ha * wet_hyd(iihru)%edep * 10. ! * wet_hyd(iihru)%esa + wet_ob(iihru)%pvol = hru(iihru)%area_ha * wet_hyd(iihru)%pdep * 10. ! * wet_hyd(iihru)%psa wet_ob(iihru)%psa = wet_hyd(iihru)%psa * hru(iihru)%area_ha wet_ob(iihru)%esa = wet_hyd(iihru)%esa * hru(iihru)%area_ha !! set initial weir height to principal depth - m @@ -47,7 +46,7 @@ subroutine wet_initial (iihru) wet_ob(iihru)%weir_hgt = res_weir(iweir)%h !m weir height wet_ob(iihru)%weir_wid = res_weir(iweir)%w !m, weir width !update pvol/evol according to weir height for paddy weir discharge. Jaehak 2023 - wet_ob(iihru)%pvol = hru(iihru)%area_ha * wet_ob(iihru)%weir_hgt * 10.**4 ! m3 + wet_ob(iihru)%pvol = hru(iihru)%area_ha * res_weir(iweir)%h * 10.**4 ! m3 if (wet_ob(iihru)%evol < wet_ob(iihru)%pvol*1.2) then wet_ob(iihru)%evol = wet_ob(iihru)%pvol * 1.2 endif @@ -111,16 +110,16 @@ subroutine wet_initial (iihru) !! wetland on hru - solve quadratic to find new depth wet_wat_d(iihru)%area_ha = 0. if (wet(iihru)%flo > 0.) then - x1 = wet_hyd(ihyd)%bcoef ** 2 + 4. * wet_hyd(ihyd)%ccoef * (1. - wet(iihru)%flo / wet_ob(iihru)%pvol) + x1 = wet_hyd(iihru)%bcoef ** 2 + 4. * wet_hyd(iihru)%ccoef * (1. - wet(iihru)%flo / wet_ob(iihru)%pvol) if (x1 < 1.e-6) then wet_h = 0. else - wet_h1 = (-wet_hyd(ihyd)%bcoef - sqrt(x1)) / (2. * wet_hyd(ihyd)%ccoef) - wet_h = wet_h1 + wet_hyd(ihyd)%bcoef + wet_h1 = (-wet_hyd(iihru)%bcoef - sqrt(x1)) / (2. * wet_hyd(iihru)%ccoef) + wet_h = wet_h1 + wet_hyd(iihru)%bcoef end if - wet_fr = (1. + wet_hyd(ihyd)%acoef * wet_h) + wet_fr = (1. + wet_hyd(iihru)%acoef * wet_h) wet_fr = min(wet_fr,1.) - wet_wat_d(iihru)%area_ha = hru(iihru)%area_ha * wet_hyd(ihyd)%psa * wet_fr + wet_wat_d(iihru)%area_ha = hru(iihru)%area_ha * wet_hyd(iihru)%psa * wet_fr end if end if diff --git a/src/wet_irrp.f90 b/src/wet_irrp.f90 index bb0e2c8..10c263a 100644 --- a/src/wet_irrp.f90 +++ b/src/wet_irrp.f90 @@ -9,6 +9,7 @@ subroutine wet_irrp() use aquifer_module use mgt_operations_module use hru_module, only : hru, ihru + use climate_module implicit none @@ -24,7 +25,7 @@ subroutine wet_irrp() wsa1 = hru(j)%area_ha * 10. !! store initial values - irrig(j)%demand = max(0., hru(j)%irr_hmax - wet_ob(j)%depth*1000.) * wsa1 !m3 + irrig(j)%demand = max(0., hru(j)%irr_hmax - wet_ob(j)%depth*1000. - w%precip) * wsa1 !m3 rto = 0. if (.not. allocated(ob(j)%ru)) then @@ -89,7 +90,8 @@ subroutine wet_irrp() if (aqu_d(isrc)%stor > 0.001) then rto = min(0.99, irrig(j)%demand / aqu_d(isrc)%stor) ! ratio of water removed from aquifer volume end if - irrig(j)%water%flo = rto * aqu_d(isrc)%flo ! organics in irrigation water + ! irrig(j)%water%flo = rto * aqu_d(isrc)%flo ! organics in irrigation water + irrig(j)%water%flo = rto * aqu_d(isrc)%stor ! organics in irrigation water Jaehak 2024 cs_irr(isrc) = rto * cs_aqu(isrc) ! constituents in irrigation water aqu_d(isrc)%stor = (1. - rto) * aqu_d(isrc)%stor ! remainder stays in aquifer cs_aqu(isrc) = (1. - rto) * cs_aqu(isrc) diff --git a/src/wet_read.f90 b/src/wet_read.f90 index 6ddbc4a..efc1c49 100644 --- a/src/wet_read.f90 +++ b/src/wet_read.f90 @@ -132,6 +132,8 @@ subroutine wet_read do ised = 1, db_mx%res_sed if (res_sed(ised)%name == wet_dat_c(isstor)%sed) then wet_prm(i)%sed = res_sed(ised) + !! d50 -micro meters + wet_prm(i)%sed_stlr_co = exp(-0.184 * wet_prm(i)%sed%d50) wet_dat(isstor)%sed = ised exit end if diff --git a/src/wetland_control.f90 b/src/wetland_control.f90 index a4a0e58..cf06571 100644 --- a/src/wetland_control.f90 +++ b/src/wetland_control.f90 @@ -31,6 +31,8 @@ subroutine wetland_control integer :: ires = 0 integer :: j1 = 0 integer :: ii = 0 !none |sub daily time step counter + integer :: ihyd = 0 !none |counter !Jaehak 2024 + integer :: isched = 0 !none |counter !Jaehak 2024 real :: wet_fr = 0. real :: pvol_m3 = 0. real :: evol_m3 = 0. @@ -47,9 +49,12 @@ subroutine wetland_control real :: swst(20) = 0. j = ihru ires = hru(j)%dbs%surf_stor + ihyd = wet_dat(ires)%hyd ised = wet_dat(ires)%sed irel = wet_dat(ires)%release wsa1 = hru(j)%area_ha * 10. + isched = hru(j)%mgt_ops + wet_wat_d(j)%area_ha = hru(j)%area_ha !! zero outgoing flow ht2 = resz @@ -73,7 +78,7 @@ subroutine wetland_control !! add irrigation water to the paddy/wetland storage wet(j)%flo = wet(j)%flo + irrig(j)%applied * wsa1 !m3 - + wet(j)%no3 = wet(j)%no3 + irrig(j)%no3 * irrig(j)%applied * wsa1 * 0.001 !kg wet_wat_d(j)%area_ha = 0. if (wet(j)%flo > 0.) then !paddy is assumed flat !! update wetland surface area - solve quadratic to find new depth @@ -133,7 +138,11 @@ subroutine wetland_control hru(j)%water_seep = wet_wat_d(j)%seep / wsa1 !mm=m3/(10*ha) ! calculate dissolved nutrient infiltration Jaehak 2022 - seep_rto = wet_wat_d(j)%seep / (wet_wat_d(j)%seep + wet(j)%flo) + if (wet_wat_d(j)%seep + wet(j)%flo > 0.01)then + seep_rto = wet_wat_d(j)%seep / (wet_wat_d(j)%seep + wet(j)%flo) + else + seep_rto = 0. + endif soil1(j)%mn(1)%no3 = soil1(j)%mn(1)%no3 + wet(j)%no3 * seep_rto / hru(j)%area_ha !kg/ha soil1(j)%mn(1)%nh4 = soil1(j)%mn(1)%nh4 + wet(j)%nh3 * seep_rto / hru(j)%area_ha !kg/ha soil1(j)%mp(1)%act = soil1(j)%mp(1)%act + wet(j)%solp * seep_rto / hru(j)%area_ha !kg/ha @@ -159,6 +168,8 @@ subroutine wetland_control !if (hru(j)%wet_fp == "n") then !! calc release from decision table d_tbl => dtbl_res(irel) + wbody => wet(j) + wbody_wb => wet_wat_d(j) pvol_m3 = wet_ob(j)%pvol evol_m3 = wet_ob(j)%evol !if (wet_ob(j)%area_ha > 1.e-6) then @@ -193,21 +204,22 @@ subroutine wetland_control end do end if - !end if wet_ob(j)%depth = wet(j)%flo / wsa1 / 1000. !m !! compute sediment deposition call res_sediment - !!! subtract sediment leaving from reservoir - !wet(j)%sed = wet(j)%sed - ht2%sed - !wet(j)%sil = wet(j)%sil - ht2%sil - !wet(j)%cla = wet(j)%cla - ht2%cla + wet(j)%sed = wbody%sed !t !! perform reservoir nutrient balance call res_nutrient (j) + wet(j)%no3 = wbody%no3 + wet(j)%nh3 = wbody%nh3 + wet(j)%orgn =wbody%orgn + wet(j)%sedp = wbody%sedp + wet(j)%solp = wbody%solp !! perform salt ion constituent balance call wet_salt(icmd,j) @@ -236,10 +248,6 @@ subroutine wetland_control - !write(100100,'(3(I6,","),11(f10.1,","))') time%yrc,time%mo,time%day_mo,w%precip,irrig(j)%applied,hru(j)%water_seep,& - ! weir_hgt*1000,wet(j)%flo/wsa1,ht2%flo/wsa1,soil(j)%sw,wet(j)%sed*1000,ht2%sed*1000,no3ppm,ht2%no3 - !write(*,'(3(I6),11(f10.1))') time%yrc,time%mo,time%day_mo,w%precip,irrig(j)%applied,hru(j)%water_seep,& - ! weir_hgt*1000,wet(j)%flo/wsa1,ht2%flo/wsa1,soil(j)%sw,wet(j)%sed*1000,ht2%sed*1000,wet(j)%no3,ht2%no3 !! perform reservoir pesticide transformations !call res_pest (ires) @@ -267,10 +275,8 @@ subroutine wetland_control !! set inflow and outflow variables for reservoir_output if (time%yrs > pco%nyskip) then - wet_in_d(j) = ht1 + wet_in_d(j) = wet_in_d(j) + ht1 wet_out_d(j) = ht2 - !wet_in_d(j)%flo = wet(j)%flo / 10000. !m^3 -> ha-m - !wet_out_d(j)%flo = wet(j)%flo / 10000. !m^3 -> ha-m end if return diff --git a/src/wetland_output.f90 b/src/wetland_output.f90 index e43828b..af92a79 100644 --- a/src/wetland_output.f90 +++ b/src/wetland_output.f90 @@ -90,6 +90,6 @@ subroutine wetland_output(j) return -100 format (4i6,2i10,2x,a,63e15.4) +100 format (4i6,2i10,2x,a,64e15.4) end subroutine wetland_output \ No newline at end of file From f1e61a3da86bc4a6457b0e3b69a733fd95b2b75b Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 08:32:20 -0500 Subject: [PATCH 02/17] fixed tabs --- src/allocate_parms.f90 | 2 +- src/aqu_cs_output.f90 | 2 +- src/aqu_salt_output.f90 | 2 +- src/cal_parm_select.f90 | 76 +++++----- src/cal_parmchg_read.f90 | 6 +- src/calsoft_hyd_bfr_pet.f90 | 2 +- src/carbon_module.f90 | 70 ++++----- src/cbn_zhang2.f90 | 32 ++-- src/ch_initial.f90 | 92 ++++++------ src/ch_read_elements.f90 | 4 +- src/ch_read_sed.f90 | 28 ++-- src/ch_rtday.f90 | 172 +++++++++++----------- src/ch_rthr.f90 | 4 +- src/ch_rtmusk.f90 | 2 +- src/ch_rtpath.f90 | 6 +- src/channel_control.f90 | 16 +- src/cli_precip_control.f90 | 16 +- src/cli_read_atmodep_cs.f90 | 2 +- src/cli_read_atmodep_salt.f90 | 2 +- src/cs_balance.f90 | 2 +- src/cs_divert.f90 | 2 +- src/cs_lch.f90 | 4 +- src/ero_ovrsed.f90 | 148 +++++++++---------- src/gwflow_chem.f90 | 8 +- src/gwflow_module.f90 | 2 +- src/gwflow_read.f90 | 6 +- src/gwflow_resv.f90 | 10 +- src/gwflow_simulate.f90 | 22 +-- src/gwflow_soil.f90 | 2 +- src/hcsout_output.f90 | 58 ++++---- src/header_sd_channel.f90 | 2 +- src/header_write.f90 | 10 +- src/hru_control.f90 | 24 +-- src/hru_cs_output.f90 | 2 +- src/hru_hyds.f90 | 4 +- src/hru_lte_control.f90 | 14 +- src/hru_module.f90 | 16 +- src/hru_salt_output.f90 | 2 +- src/hru_urb_bmp.f90 | 14 +- src/hru_urbanhr.f90 | 36 ++--- src/hrudb_init.f90 | 3 + src/hyd_connect.f90 | 48 +++--- src/hyd_read_connect.f90 | 6 +- src/hydrograph_module.f90 | 74 +++++----- src/input_file_module.f90 | 40 ++--- src/lcu_read_softcal.f90 | 2 +- src/ls_read_parms_cal.f90 | 2 +- src/lsu_read_elements.f90 | 2 +- src/manure_allocation_module.f90 | 64 ++++---- src/mgt_killop.f90 | 2 +- src/mgt_newtillmix.f90 | 40 ++--- src/mgt_newtillmix_wet.f90 | 38 ++--- src/mgt_sched.f90 | 2 +- src/mgt_tillfactor.f90 | 98 ++++++------- src/nut_denit.f90 | 14 +- src/nut_nlch.f90 | 2 +- src/nut_nminrl.f90 | 20 +-- src/nut_orgnc.f90 | 8 +- src/nut_orgnc2.f90 | 26 ++-- src/nut_pminrl2.f90 | 178 +++++++++++----------- src/nut_solp.f90 | 4 +- src/orgncswat2.f90 | 26 ++-- src/output_landscape_module.f90 | 2 +- src/pl_burnop.f90 | 2 +- src/pl_fert.f90 | 20 +-- src/pl_fert_wet.f90 | 20 +-- src/pl_leaf_drop.f90 | 18 +-- src/pl_read_parms_cal.f90 | 4 +- src/pl_read_regions_cal.f90 | 4 +- src/pl_rootfr.f90 | 88 +++++------ src/plantparm_init.f90 | 8 +- src/proc_bsn.f90 | 2 +- src/rec_read_elements.f90 | 4 +- src/recall_salt.f90 | 2 +- src/reg_read_elements.f90 | 2 +- src/res_control.f90 | 4 +- src/res_cs.f90 | 8 +- src/res_cs_module.f90 | 2 +- src/res_hydro.f90 | 8 +- src/res_salt_module.f90 | 2 +- src/res_sediment.f90 | 6 +- src/ru_cs_output.f90 | 4 +- src/ru_salt_output.f90 | 4 +- src/salt_balance.f90 | 2 +- src/salt_chem_hru.f90 | 20 +-- src/salt_chem_soil_single.f90 | 20 +-- src/sd_channel_control.f90 | 2 +- src/sd_channel_control3.f90 | 2 +- src/sd_channel_sediment.f90 | 2 +- src/sd_hydsed_init.f90 | 6 +- src/sep_biozone.f90 | 244 +++++++++++++++---------------- src/smp_bmpfixed.f90 | 16 +- src/smp_filter.f90 | 162 ++++++++++---------- src/smp_grass_wway.f90 | 150 +++++++++---------- src/soil_data_module.f90 | 4 +- src/soil_nutcarb_init.f90 | 36 ++--- src/soil_phys_init.f90 | 20 +-- src/soil_text_init.f90 | 12 +- src/soils_init.f90 | 2 +- src/sq_surfst.f90 | 32 ++-- src/stmp_solt.f90 | 8 +- src/stor_surfstor.f90 | 24 +-- src/surface.f90 | 4 +- src/swr_depstor.f90 | 62 ++++---- src/swr_drains.f90 | 44 +++--- src/swr_percmain.f90 | 42 +++--- src/swr_percmicro.f90 | 8 +- src/tiles_data_module.f90 | 2 +- src/time_conc_init.f90 | 2 +- src/topography_data_module.f90 | 2 +- src/varinit.f90 | 8 +- src/wallo_withdraw.f90 | 2 +- src/water_allocation_module.f90 | 72 ++++----- src/wet_cs.f90 | 6 +- src/wetland_control.f90 | 6 +- 115 files changed, 1428 insertions(+), 1433 deletions(-) diff --git a/src/allocate_parms.f90 b/src/allocate_parms.f90 index c4f2f39..471ae33 100644 --- a/src/allocate_parms.f90 +++ b/src/allocate_parms.f90 @@ -213,7 +213,7 @@ subroutine allocate_parms !! By Zhang for C/N cycling !! ============================ - + call zero0 call zero1 call zero2 diff --git a/src/aqu_cs_output.f90 b/src/aqu_cs_output.f90 index 3c72527..12035db 100644 --- a/src/aqu_cs_output.f90 +++ b/src/aqu_cs_output.f90 @@ -49,7 +49,7 @@ subroutine aqu_cs_output(iaq) !rtb cs (acsb_d(iaq)%cs(ics)%srbd,ics=1,cs_db%num_cs) if (pco%csvout == "y") then write (6061,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iaq, ob(iob)%gis_id, & - (acsb_d(iaq)%cs(ics)%csgw,ics=1,cs_db%num_cs), & + (acsb_d(iaq)%cs(ics)%csgw,ics=1,cs_db%num_cs), & (acsb_d(iaq)%cs(ics)%rchrg,ics=1,cs_db%num_cs), & (acsb_d(iaq)%cs(ics)%seep,ics=1,cs_db%num_cs), & (acsb_d(iaq)%cs(ics)%irr,ics=1,cs_db%num_cs), & diff --git a/src/aqu_salt_output.f90 b/src/aqu_salt_output.f90 index fdef427..70ca55d 100644 --- a/src/aqu_salt_output.f90 +++ b/src/aqu_salt_output.f90 @@ -44,7 +44,7 @@ subroutine aqu_salt_output(iaq) asaltb_d(iaq)%salt(1)%diss if (pco%csvout == "y") then write (5061,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iaq, ob(iob)%gis_id, & - (asaltb_d(iaq)%salt(isalt)%saltgw,isalt=1,cs_db%num_salts), & + (asaltb_d(iaq)%salt(isalt)%saltgw,isalt=1,cs_db%num_salts), & (asaltb_d(iaq)%salt(isalt)%rchrg,isalt=1,cs_db%num_salts), & (asaltb_d(iaq)%salt(isalt)%seep,isalt=1,cs_db%num_salts), & (asaltb_d(iaq)%salt(isalt)%irr,isalt=1,cs_db%num_salts), & diff --git a/src/cal_parm_select.f90 b/src/cal_parm_select.f90 index 23a235a..43ac894 100644 --- a/src/cal_parm_select.f90 +++ b/src/cal_parm_select.f90 @@ -34,7 +34,7 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma use hydrograph_module use pesticide_data_module use plant_module - use gwflow_module + use gwflow_module implicit none @@ -956,45 +956,45 @@ subroutine cal_parm_select (ielem, ly, chg_parm, chg_typ, chg_val, absmin, absma hlt_db(ielem)%uslels = chg_par (hlt_db(ielem)%uslels, chg_typ, chg_val, absmin, absmax) - !!gwflow (rtb) + !!gwflow (rtb) case ("aquifer_K") - if(bsn_cc%gwflow.eq.1) then - gw_state(ielem)%hydc = chg_par(gw_state(ielem)%hydc, chg_typ, chg_val, absmin, absmax) - endif - - case ("aquifer_Sy") - if(bsn_cc%gwflow.eq.1) then - gw_state(ielem)%spyd = chg_par(gw_state(ielem)%spyd, chg_typ, chg_val, absmin, absmax) - endif - - case ("aquifer_delay") - if(bsn_cc%gwflow.eq.1) then - gw_delay(ielem) = chg_par(gw_delay(ielem), chg_typ, chg_val, absmin, absmax) + if(bsn_cc%gwflow.eq.1) then + gw_state(ielem)%hydc = chg_par(gw_state(ielem)%hydc, chg_typ, chg_val, absmin, absmax) + endif + + case ("aquifer_Sy") + if(bsn_cc%gwflow.eq.1) then + gw_state(ielem)%spyd = chg_par(gw_state(ielem)%spyd, chg_typ, chg_val, absmin, absmax) + endif + + case ("aquifer_delay") + if(bsn_cc%gwflow.eq.1) then + gw_delay(ielem) = chg_par(gw_delay(ielem), chg_typ, chg_val, absmin, absmax) endif - - case ("aquifer_exdp") - if(bsn_cc%gwflow.eq.1) then - gw_state(ielem)%exdp = chg_par(gw_state(ielem)%exdp, chg_typ, chg_val, absmin, absmax) - endif - - case ("stream_K") - if(bsn_cc%gwflow.eq.1) then - do icell=1,gw_chan_info(ielem)%ncon !loop through cells connected to channel - gw_chan_info(ielem)%hydc(icell) = chg_par(gw_chan_info(ielem)%hydc(icell), chg_typ, chg_val, absmin, absmax) - enddo - endif - - case ("stream_thk") - if(bsn_cc%gwflow.eq.1) then - do icell=1,gw_chan_info(ielem)%ncon !loop through cells connected to channel - gw_chan_info(ielem)%thck(icell) = chg_par(gw_chan_info(ielem)%thck(icell), chg_typ, chg_val, absmin, absmax) - enddo - endif - - case ("stream_bed") - if(bsn_cc%gwflow.eq.1) then - gw_bed_change = chg_par(gw_bed_change, chg_typ, chg_val, absmin, absmax) - endif + + case ("aquifer_exdp") + if(bsn_cc%gwflow.eq.1) then + gw_state(ielem)%exdp = chg_par(gw_state(ielem)%exdp, chg_typ, chg_val, absmin, absmax) + endif + + case ("stream_K") + if(bsn_cc%gwflow.eq.1) then + do icell=1,gw_chan_info(ielem)%ncon !loop through cells connected to channel + gw_chan_info(ielem)%hydc(icell) = chg_par(gw_chan_info(ielem)%hydc(icell), chg_typ, chg_val, absmin, absmax) + enddo + endif + + case ("stream_thk") + if(bsn_cc%gwflow.eq.1) then + do icell=1,gw_chan_info(ielem)%ncon !loop through cells connected to channel + gw_chan_info(ielem)%thck(icell) = chg_par(gw_chan_info(ielem)%thck(icell), chg_typ, chg_val, absmin, absmax) + enddo + endif + + case ("stream_bed") + if(bsn_cc%gwflow.eq.1) then + gw_bed_change = chg_par(gw_bed_change, chg_typ, chg_val, absmin, absmax) + endif !! initial soil properties case ("lab_p") diff --git a/src/cal_parmchg_read.f90 b/src/cal_parmchg_read.f90 index 8e46356..aa96f53 100644 --- a/src/cal_parmchg_read.f90 +++ b/src/cal_parmchg_read.f90 @@ -128,9 +128,9 @@ subroutine cal_parmchg_read cal_upd(i)%num_elem = db_mx%pcpfiles case ("tmp") cal_upd(i)%num_elem = db_mx%tmpfiles - case ("gwf") !rtb - all gwflow cells - cal_upd(i)%num_elem = ncell - case ("gwf_riv") !rtb - all channels + case ("gwf") !rtb - all gwflow cells + cal_upd(i)%num_elem = ncell + case ("gwf_riv") !rtb - all channels cal_upd(i)%num_elem = sp_ob%chandeg case ("gwf_sgl") !rtb - single value cal_upd(i)%num_elem = 1 diff --git a/src/calsoft_hyd_bfr_pet.f90 b/src/calsoft_hyd_bfr_pet.f90 index f7d964b..8121cad 100644 --- a/src/calsoft_hyd_bfr_pet.f90 +++ b/src/calsoft_hyd_bfr_pet.f90 @@ -92,5 +92,5 @@ subroutine calsoft_hyd_bfr_pet call time_control end if end do ! petco iterations - return + return end subroutine calsoft_hyd_bfr_pet \ No newline at end of file diff --git a/src/carbon_module.f90 b/src/carbon_module.f90 index cf31b6a..b3b0ccd 100644 --- a/src/carbon_module.f90 +++ b/src/carbon_module.f90 @@ -1,27 +1,27 @@ module carbon_module - + implicit none type carbon_terrestrial_inputs real :: er_POC_para = 1.5 ! |POC enrichment ratio ! 0-10 ! 0.0-5.0 MOST SENSITIVE real :: CFB_para = 0.42 ! |Carbon fraction of residue (0.42; from data of Pinck et al., 1950) - real :: Sf_para_sur = 0.05 ! |Fraction of mineral N sorbed to litter: 0.05 for surface litter, 0.1 for below ground litter - real :: Sf_para_sub = 0.10 ! |Fraction of mineral N sorbed to litter: 0.05 for surface litter, 0.1 for belowg round litter + real :: Sf_para_sur = 0.05 ! |Fraction of mineral N sorbed to litter: 0.05 for surface litter, 0.1 for below ground litter + real :: Sf_para_sub = 0.10 ! |Fraction of mineral N sorbed to litter: 0.05 for surface litter, 0.1 for belowg round litter !Dissovled carbon - real :: ABL_para = 0.0 ! |Calculated - Carbon allocation from Microbial Biomass to Leaching + real :: ABL_para = 0.0 ! |Calculated - Carbon allocation from Microbial Biomass to Leaching real :: peroc_DIC_para = 0.95 !0-1 |DIC percolation coefficient - real :: peroc_DOC_para = 0.70 !0-1 |DOC percolation coefficient + real :: peroc_DOC_para = 0.70 !0-1 |DOC percolation coefficient real :: part_DOC_para = 4000. ! |organic carbon partition coefficient 1000 to 1200 ! 500-2000 !replacing KOC=Liquid-solid partition coefficient for Microbial Biomass (10^3 m3 Mg-1) real :: hlife_doc_para = 50. !days |DOC half life in groundwater, calculating DOC decay in groundwater ! 0-100 !Allocation of CO2 and Carbon transformation - real :: ABCO2_para_sur = 0.6 ! |Allocation from Microbial Biomass C pool to CO2; 0.6 (surface Litter), 0.85 - 0.68 x (CLAY+SILT) (all other layers) (Parton et al., 1993, 1994) + real :: ABCO2_para_sur = 0.6 ! |Allocation from Microbial Biomass C pool to CO2; 0.6 (surface Litter), 0.85 - 0.68 x (CLAY+SILT) (all other layers) (Parton et al., 1993, 1994) real :: ABCO2_para_sub = 0. ! |Calculated -Allocation from Microbial Biomass C pool to CO2; 0.6 (surface Litter), 0.85 - 0.68 x (CLAY+SILT) (all other layers) (Parton et al., 1993, 1994) - real :: ABP_para_sur = 0.0 ! |Allocation from Biomass to passive Humus; 0 (surface Litter), 0.003 + 0.032 x SOL_CLAY (all other layers) (Parton et al., 1993, 1994) + real :: ABP_para_sur = 0.0 ! |Allocation from Biomass to passive Humus; 0 (surface Litter), 0.003 + 0.032 x SOL_CLAY (all other layers) (Parton et al., 1993, 1994) real :: ABP_para_sub = 0.0 ! |Calculated - Allocation from Biomass to passive Humus; 0 (surface Litter), 0.003 + 0.032 x SOL_CLAY (all other layers) (Parton et al., 1993, 1994) - real :: ALMCO2_para_sur = 0.6 ! |Allocation from metabolic Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) - real :: ALMCO2_para_sub = 0.55 ! |Allocation from metabolic Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) + real :: ALMCO2_para_sur = 0.6 ! |Allocation from metabolic Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) + real :: ALMCO2_para_sub = 0.55 ! |Allocation from metabolic Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) real :: ALSLNCO2_para_sur = 0.6 ! |Allocation from non-lignin of structural Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) - real :: ALSLNCO2_para_sub =0.55 ! |Allocation from non-lignin of structural Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) + real :: ALSLNCO2_para_sub =0.55 ! |Allocation from non-lignin of structural Litter to CO2; 0.6 (surface Litter), 0.55 (all other layers) (Parton et al., 1993, 1994) real :: ASP_para_sur = 0.0 ! |Allocation from slow Humus to passive; 0 (surface Litter), 0.003 + 0.00009 x CLAF (all other layers) (Parton et al., 1993, 1994) real :: ASP_para_sub = 0.0 ! |Calculated - Allocation from slow Humus to passive; 0 (surface Litter), 0.003 + 0.00009 x CLAF (all other layers) (Parton et al., 1993, 1994) real :: ALSLCO2_para = 0.3 ! |Allocation from lignin of structural Litter to CO2; 0.3 (Parton et al., 1993, 1994) @@ -30,8 +30,8 @@ module carbon_module !decomposition rates real :: PRMT_51_para = 1.0 ! |COEF ADJUSTS MICROBIAL ACTIVITY FUNCTION IN TOP SOIL LAYER (0.1_1.), real :: PRMT_45_para = 0.003 ! |COEF IN CENTURY EQ ALLOCATING SLOW TO PASSIVE HUMUS(0.001_0.05) ORIGINAL VALUE = 0.003, ASP=MAX(.001,PRMT_45-.00009*sol_clay(k,j)), ASP=MAX(.001,PRMT_45+.009*sol_clay(k,j)/100) - real :: BMR_para_sur = 0.0164 ! |Rate of transformation of microbial Biomass and associated products under optimal conditions (surface = 0.0164 d-1; all other layers = 0.02 d-1) (Parton et al., 1993, 1994) - real :: BMR_para_sub = 0.02 ! |Rate of transformation of microbial Biomass and associated products under optimal conditions (surface = 0.0164 d-1; all other layers = 0.02 d-1) (Parton et al., 1993, 1994) + real :: BMR_para_sur = 0.0164 ! |Rate of transformation of microbial Biomass and associated products under optimal conditions (surface = 0.0164 d-1; all other layers = 0.02 d-1) (Parton et al., 1993, 1994) + real :: BMR_para_sub = 0.02 ! |Rate of transformation of microbial Biomass and associated products under optimal conditions (surface = 0.0164 d-1; all other layers = 0.02 d-1) (Parton et al., 1993, 1994) real :: HPR_para = 0.000012 ! |Rate of transformation of passive Humus under optimal conditions (subsurface layers = 0.000012 d-1) (Parton et al., 1993, 1994) real :: HSR_para = 0.000548 ! |Rate of transformation of slow Humus under optimal conditions (all layers = 0.0005 d-1) (Parton et al., 1993, 1994; Vitousek et al., 1993) real :: LMR_para_sur = 0.0405 ! |Rate of transformation of metabolic Litter under optimal conditions (surface = 0.0405 d-1; all other layers = 0.0507 d-1) (Parton et al., 1994) @@ -62,32 +62,32 @@ module carbon_module end type carbon_inputs type (carbon_inputs) :: carbdb type (carbon_inputs) :: carbz - + type organic_allocations real :: abco2 = 0. ! |Fraction of decomposed microbial biomass allocated to CO2 - real :: abl = 0. ! |Fraction of microbial biomass loss due to leaching - real :: abp = 0. ! |Fraction of decomposed microbial biomass allocated to passive humus - real :: almco2 = 0. ! |Fraction of decomposed metabolic litter allocated to CO2 - real :: alslco2 = 0. ! |Fraction of decomposed lignin of structural litter allocated to CO2 - real :: alslnco2 = 0. ! |Fraction of decomposed lignin of structural litter allocated to CO2 - real :: apco2 = 0. ! |Fraction of decomposed passive humus allocated to CO2 - real :: asco2 = 0. ! |Fraction of decomposed slow humus allocated to CO2 - real :: asp = 0. ! |Fraction of decomposed slow humus allocated to passive + real :: abl = 0. ! |Fraction of microbial biomass loss due to leaching + real :: abp = 0. ! |Fraction of decomposed microbial biomass allocated to passive humus + real :: almco2 = 0. ! |Fraction of decomposed metabolic litter allocated to CO2 + real :: alslco2 = 0. ! |Fraction of decomposed lignin of structural litter allocated to CO2 + real :: alslnco2 = 0. ! |Fraction of decomposed lignin of structural litter allocated to CO2 + real :: apco2 = 0. ! |Fraction of decomposed passive humus allocated to CO2 + real :: asco2 = 0. ! |Fraction of decomposed slow humus allocated to CO2 + real :: asp = 0. ! |Fraction of decomposed slow humus allocated to passive end type organic_allocations type (organic_allocations) :: org_allo type (organic_allocations) :: org_alloz - + type organic_controls - real :: cdg = 0. ! |soil temperature control on biological processes - real :: cs = 0. ! |combined factor controlling biological processes - real :: ox = 0. ! |oxygen control on biological processes - real :: sut = 0. ! |soil water control on biological processes - real :: x1 = 0. ! |tillage control on residue decomposition + real :: cdg = 0. ! |soil temperature control on biological processes + real :: cs = 0. ! |combined factor controlling biological processes + real :: ox = 0. ! |oxygen control on biological processes + real :: sut = 0. ! |soil water control on biological processes + real :: x1 = 0. ! |tillage control on residue decomposition real :: xbmt = 0. ! |control on transformation of microbial biomass by soil texture and structure real :: xlslf = 0. ! |control on potential transformation of structural litter by lignin fraction end type organic_controls type (organic_controls) :: org_con - + type organic_fractions real :: lmf = 0. !frac |fraction of the litter that is metabolic real :: lmnf = 0. !kg kg-1 |fraction of metabolic litter that is N @@ -101,23 +101,23 @@ module carbon_module real :: cnr = 0. ! |c/n ratio of standing dead real :: ncbm = 0. ! |n/c ratio of biomass real :: nchp = 0. ! |n/c ratio of passive humus - real :: nchs = 0. ! |n/c ration of slow humus + real :: nchs = 0. ! |n/c ration of slow humus end type organic_ratio type (organic_ratio) :: org_ratio - + type organic_transformations real :: bmctp = 0. !kg ha-1 day-1 |potential transformation of C in microbial biomass - real :: bmntp = 0. !kg ha-1 day-1 |potential transformation of N in microbial biomass - real :: hsctp = 0. !kg ha-1 day-1 |potential transformation of C in slow humus - real :: hsntp = 0. !kg ha-1 day-1 |potential transformation of N in slow humus + real :: bmntp = 0. !kg ha-1 day-1 |potential transformation of N in microbial biomass + real :: hsctp = 0. !kg ha-1 day-1 |potential transformation of C in slow humus + real :: hsntp = 0. !kg ha-1 day-1 |potential transformation of N in slow humus real :: hpctp = 0. !kg ha-1 day-1 |potential transformation of C in passive humus real :: hpntp = 0. !kg ha-1 day-1 |potential transformation of N in passive humus real :: lmctp = 0. !kg ha-1 day-1 |potential transformation of C in metabolic litter - real :: lmntp = 0. !kg ha-1 day-1 |potential transformation of N in metabolic litter + real :: lmntp = 0. !kg ha-1 day-1 |potential transformation of N in metabolic litter real :: lsctp = 0. !kg ha-1 day-1 |potential transformation of C in structural litter real :: lslctp = 0. !kg ha-1 day-1 |potential transformation of C in lignin of structural litter real :: lslnctp = 0. !kg ha-1 day-1 |potential transformation of C in nonlignin structural litter - real :: lsntp = 0. !kg ha-1 day-1 |potential transformation of N in structural litter + real :: lsntp = 0. !kg ha-1 day-1 |potential transformation of N in structural litter end type organic_transformations type (organic_transformations) :: org_tran diff --git a/src/cbn_zhang2.f90 b/src/cbn_zhang2.f90 index 1317247..9113c91 100644 --- a/src/cbn_zhang2.f90 +++ b/src/cbn_zhang2.f90 @@ -284,7 +284,7 @@ subroutine cbn_zhang2 tillage_factor(j) = 1.6 else tillage_factor(j) = 1.0 - end if + end if !!calculate c/n dynamics for each soil layer !!=========================================== @@ -333,11 +333,11 @@ subroutine cbn_zhang2 till_eff = 1.6 else if (soil(j)%phys(k-1)%d .lt. tillage_depth(j)) then till_eff = 1.0 + 0.6 * (tillage_depth(j) - soil(j)%phys(k-1)%d) / (soil(j)%phys(k)%d - soil(j)%phys(k-1)%d) - end if + end if end if else till_eff = 1.0 - end if + end if !!compute soil temperature factor - when sol_tep is larger than 35, cdg is negative? org_con%cdg = soil(j)%phys(k)%tmp / (soil(j)%phys(k)%tmp + exp(5.058459 - 0.2503591 * soil(j)%phys(k)%tmp)) @@ -630,16 +630,16 @@ subroutine cbn_zhang2 ! update if (rnmn > 0.) then soil1(j)%mn(k)%nh4 = soil1(j)%mn(k)%nh4 + rnmn - min_n = soil1(j)%mn(k)%no3 + rnmn - if (min_n < 0.) then - rnmn = -soil1(j)%mn(k)%no3 - soil1(j)%mn(k)%no3 = 1.e-10 - else - soil1(j)%mn(k)%no3 = min_n + min_n = soil1(j)%mn(k)%no3 + rnmn + if (min_n < 0.) then + rnmn = -soil1(j)%mn(k)%no3 + soil1(j)%mn(k)%no3 = 1.e-10 + else + soil1(j)%mn(k)%no3 = min_n end if end if - ! calculate p flows + ! calculate p flows ! compute humus mineralization on active organic p hmp_rate = 1.4 * (hsnta + hpnta) / (soil1(j)%hs(k)%n + soil1(j)%hp(k)%n + 1.e-6) @@ -647,9 +647,9 @@ subroutine cbn_zhang2 hmp = hmp_rate * soil1(j)%hp(k)%p hmp = min(hmp, soil1(j)%hp(k)%p) soil1(j)%hp(k)%p = soil1(j)%hp(k)%p - hmp - soil1(j)%mp(k)%lab = soil1(j)%mp(k)%lab + hmp - - !! compute residue decomp and mineralization of + soil1(j)%mp(k)%lab = soil1(j)%mp(k)%lab + hmp + + !! compute residue decomp and mineralization of !! fresh organic n and p (upper two layers only) decr = (lscta + lmcta) / (soil1(j)%str(k)%c + soil1(j)%meta(k)%c + 1.e-6) decr = min(1., decr) @@ -657,12 +657,12 @@ subroutine cbn_zhang2 soil1(j)%tot(k)%p = soil1(j)%tot(k)%p - rmp soil1(j)%mp(k)%lab = soil1(j)%mp(k)%lab + .8 * rmp - soil1(j)%hp(k)%p = soil1(j)%hp(k)%p + .2 * rmp + soil1(j)%hp(k)%p = soil1(j)%hp(k)%p + .2 * rmp !!!================================= !!determine the final rate of the decomposition of each carbon pool and !!allocation of c and nutrients to different som pools, as well as co2 emissions from different pools - lscta = min(soil1(j)%str(k)%c, lscta) + lscta = min(soil1(j)%str(k)%c, lscta) lslcta = min(soil1(j)%lig(k)%c, lslcta) org_flux%co2fstr = .3 * lslcta @@ -775,7 +775,7 @@ subroutine cbn_zhang2 !!epic procedures (not used): calculating n supply - n demand !!df1 is the supply of n during structural litter decomposition (lsnta) - demand of n to meet the transformaitons of other pools !! c pools into structural litter (0 as no other pools transformed into structural litter) - df1 = lsnta + df1 = lsnta !!df2 is the supply of n during metabolic litter decomposition (lsnta) - demand of n to meet the transformaitons of other pools !! c pools into metabolic litter (0 as no other pools transformed into structural litter) diff --git a/src/ch_initial.f90 b/src/ch_initial.f90 index f350e01..fd0edf3 100644 --- a/src/ch_initial.f90 +++ b/src/ch_initial.f90 @@ -16,84 +16,84 @@ subroutine ch_initial (idat, irch) bnksize = ch_sed(ised)%bnk_d50 / 1000. !! Units conversion Micrometer to Millimeters !! Channel sediment particle size distribution !! Clayey bank - if (bnksize <= 0.005) then - ch(irch)%bnk_cla = 0.65 + if (bnksize <= 0.005) then + ch(irch)%bnk_cla = 0.65 ch(irch)%bnk_sil = 0.15 - ch(irch)%bnk_san = 0.15 - ch(irch)%bnk_gra = 0.05 - end if + ch(irch)%bnk_san = 0.15 + ch(irch)%bnk_gra = 0.05 + end if !! Silty bank - if (bnksize > 0.005 .and. bnksize <= 0.05) then + if (bnksize > 0.005 .and. bnksize <= 0.05) then ch(irch)%bnk_sil = 0.65 - ch(irch)%bnk_cla = 0.15 - ch(irch)%bnk_san = 0.15 - ch(irch)%bnk_gra = 0.05 - end if + ch(irch)%bnk_cla = 0.15 + ch(irch)%bnk_san = 0.15 + ch(irch)%bnk_gra = 0.05 + end if !! Sandy bank - if (bnksize > 0.05 .and. bnksize <= 2.) then - ch(irch)%bnk_san = 0.65 + if (bnksize > 0.05 .and. bnksize <= 2.) then + ch(irch)%bnk_san = 0.65 ch(irch)%bnk_sil = 0.15 - ch(irch)%bnk_cla = 0.15 - ch(irch)%bnk_gra = 0.05 - end if + ch(irch)%bnk_cla = 0.15 + ch(irch)%bnk_gra = 0.05 + end if !! Gravel bank - if (bnksize > 2.) then - ch(irch)%bnk_gra = 0.65 - ch(irch)%bnk_san = 0.15 + if (bnksize > 2.) then + ch(irch)%bnk_gra = 0.65 + ch(irch)%bnk_san = 0.15 ch(irch)%bnk_sil = 0.15 - ch(irch)%bnk_cla = 0.05 - end if + ch(irch)%bnk_cla = 0.05 + end if !! Channel sediment particle size distribution !! Clayey bed bedsize = ch_sed(ised)%bed_d50 / 1000. !! Units conversion Micrometer to Millimeters - if (bedsize <= 0.005) then - ch(irch)%bed_cla = 0.65 + if (bedsize <= 0.005) then + ch(irch)%bed_cla = 0.65 ch(irch)%bed_sil = 0.15 - ch(irch)%bed_san = 0.15 - ch(irch)%bed_gra = 0.05 - end if + ch(irch)%bed_san = 0.15 + ch(irch)%bed_gra = 0.05 + end if !! Silty bed - if (bedsize > 0.005 .and. bedsize <= 0.05) then + if (bedsize > 0.005 .and. bedsize <= 0.05) then ch(irch)%bed_sil = 0.65 - ch(irch)%bed_cla = 0.15 - ch(irch)%bed_san = 0.15 - ch(irch)%bed_gra = 0.05 - end if + ch(irch)%bed_cla = 0.15 + ch(irch)%bed_san = 0.15 + ch(irch)%bed_gra = 0.05 + end if !! Sandy bed - if (bedsize > 0.05 .and. bedsize <= 2.) then - ch(irch)%bed_san = 0.65 + if (bedsize > 0.05 .and. bedsize <= 2.) then + ch(irch)%bed_san = 0.65 ch(irch)%bed_sil = 0.15 - ch(irch)%bed_cla = 0.15 - ch(irch)%bed_gra = 0.05 - end if + ch(irch)%bed_cla = 0.15 + ch(irch)%bed_gra = 0.05 + end if !! Gravel bed - if (bedsize > 2.) then - ch(irch)%bed_gra = 0.65 - ch(irch)%bed_san = 0.15 + if (bedsize > 2.) then + ch(irch)%bed_gra = 0.65 + ch(irch)%bed_san = 0.15 ch(irch)%bed_sil = 0.15 - ch(irch)%bed_cla = 0.05 + ch(irch)%bed_cla = 0.05 end if !! An estimate of Critical shear stress if it is not given (N/m^2) -!! Critical shear stress based on silt and clay % -!! Critical Shear Stress based on Julian and Torres (2005) +!! Critical shear stress based on silt and clay % +!! Critical Shear Stress based on Julian and Torres (2005) !! Units of critical shear stress (N/m^2) - SC = 0. - if (ch_sed(ised)%tc_bnk <= 1.e-6) then - SC = (ch(irch)%bnk_sil + ch(irch)%bnk_cla) * 100. + SC = 0. + if (ch_sed(ised)%tc_bnk <= 1.e-6) then + SC = (ch(irch)%bnk_sil + ch(irch)%bnk_cla) * 100. ch_sed(ised)%tc_bnk = (0.1 + (0.1779*SC) + (0.0028*(SC)**2) & - ((2.34E-05)*(SC)**3)) * ch_sed(ised)%cov1 end if - if (ch_sed(ised)%tc_bed <= 1.e-6) then - SC = (ch(irch)%bed_sil + ch(irch)%bed_cla) * 100. + if (ch_sed(ised)%tc_bed <= 1.e-6) then + SC = (ch(irch)%bed_sil + ch(irch)%bed_cla) * 100. ch_sed(ised)%tc_bed = (0.1 + (0.1779*SC) + (0.0028*(SC)**2) & - ((2.34E-05)*(SC)**3)) * ch_sed(ised)%cov2 end if diff --git a/src/ch_read_elements.f90 b/src/ch_read_elements.f90 index d0a6ba7..f2a6af7 100644 --- a/src/ch_read_elements.f90 +++ b/src/ch_read_elements.f90 @@ -74,7 +74,7 @@ subroutine ch_read_elements db_mx%cha_reg = mreg end do - end if + end if !! setting up regions for channel soft cal and/or output by order inquire (file=in_regs%def_cha_reg, exist=i_exist) @@ -118,7 +118,7 @@ subroutine ch_read_elements db_mx%cha_reg = mreg end do - end if + end if !! if no regions are input, don"t need elements if (mreg > 0) then diff --git a/src/ch_read_sed.f90 b/src/ch_read_sed.f90 index 6b66358..b57b597 100644 --- a/src/ch_read_sed.f90 +++ b/src/ch_read_sed.f90 @@ -66,13 +66,13 @@ subroutine ch_read_sed if (ch_sed(ich)%cov2 <= 0.0) ch_sed(ich)%cov2 = 0.0 if (ch_sed(ich)%cov1 >= 1.0) ch_sed(ich)%cov1 = 1.0 if (ch_sed(ich)%cov2 >= 1.0) ch_sed(ich)%cov2 = 1.0 - else + else if (ch_sed(ich)%cov1 <= 0.0) ch_sed(ich)%cov1 = 1.0 if (ch_sed(ich)%cov2 <= 0.0) ch_sed(ich)%cov2 = 1.0 if (ch_sed(ich)%cov1 >= 25.) ch_sed(ich)%cov1 = 25. if (ch_sed(ich)%cov2 >= 25.) ch_sed(ich)%cov2 = 25. - end if - + end if + !! Bank material is assumed to be silt type partcile if not given. if (ch_sed(ich)%bnk_d50 <= 1.e-6) ch_sed(ich)%bnk_d50 = 50. !! Units are in Micrometer @@ -83,31 +83,31 @@ subroutine ch_read_sed if (ch_sed(ich)%bed_d50 > 10000) ch_sed(ich)%bed_d50 = 10000. !! Bulk density of channel bank sediment - if (ch_sed(ich)%bnk_bd <= 1.e-6) ch_sed(ich)%bnk_bd = 1.40 !! Silty loam bank + if (ch_sed(ich)%bnk_bd <= 1.e-6) ch_sed(ich)%bnk_bd = 1.40 !! Silty loam bank !! Bulk density of channel bed sediment - if (ch_sed(ich)%bed_bd <= 1.e-6) ch_sed(ich)%bed_bd = 1.50 !! Sandy loam bed + if (ch_sed(ich)%bed_bd <= 1.e-6) ch_sed(ich)%bed_bd = 1.50 !! Sandy loam bed !! An estimate of channel bank erodibility coefficient from jet test if it is not available !! Units of kd is (cm^3/N/s) !! Base on Hanson and Simon, 2001 if (ch_sed(ich)%bnk_kd <= 1.e-6) then - if (ch_sed(ich)%tc_bnk <= 1.e-6) then - ch_sed(ich)%bnk_kd = 0.2 - else + if (ch_sed(ich)%tc_bnk <= 1.e-6) then + ch_sed(ich)%bnk_kd = 0.2 + else ch_sed(ich)%bnk_kd = 0.2 / sqrt(ch_sed(ich)%tc_bnk) - end if - end if + end if + end if !! An estimate of channel bed erodibility coefficient from jet test if it is not available !! Units of kd is (cm^3/N/s) !! Base on Hanson and Simon, 2001 if (ch_sed(ich)%bed_kd <= 1.e-6) then - if (ch_sed(ich)%tc_bed <= 1.e-6) then - ch_sed(ich)%bed_kd = 0.2 - else + if (ch_sed(ich)%tc_bed <= 1.e-6) then + ch_sed(ich)%bed_kd = 0.2 + else ch_sed(ich)%bed_kd = 0.2 / sqrt(ch_sed(ich)%tc_bed) - end if + end if end if sumerod = 0. diff --git a/src/ch_rtday.f90 b/src/ch_rtday.f90 index 7eac0d3..050a6c1 100644 --- a/src/ch_rtday.f90 +++ b/src/ch_rtday.f90 @@ -101,15 +101,15 @@ subroutine ch_rtday !! Find maximum flow capacity of the channel at bank full c = ch_hyd(jhyd)%side - p = ch_vel(jrch)%wid_btm + 2. * ch_hyd(jhyd)%d * Sqrt(1. + c * c) - rh = ch_vel(jrch)%area / p - maxrt = Qman(ch_vel(jrch)%area, rh, ch_hyd(jhyd)%n, ch_hyd(jhyd)%s) + p = ch_vel(jrch)%wid_btm + 2. * ch_hyd(jhyd)%d * Sqrt(1. + c * c) + rh = ch_vel(jrch)%area / p + maxrt = Qman(ch_vel(jrch)%area, rh, ch_hyd(jhyd)%n, ch_hyd(jhyd)%s) sdti = 0. - rchdep = 0. - p = 0. - rh = 0. - vc = 0. + rchdep = 0. + p = 0. + rh = 0. + vc = 0. ch(jrch)%chfloodvol = 0. !! If average flowrate is greater than than the channel capacity at bank full @@ -139,44 +139,44 @@ subroutine ch_rtday end if if (volrt > maxrt) then - rcharea = ch_vel(jrch)%area - rchdep = ch_hyd(jhyd)%d - p = ch_vel(jrch)%wid_btm + 2. * ch_hyd(jhyd)%d * Sqrt(1. + c * c) - rh = ch_vel(jrch)%area / p - sdti = maxrt - adddep = 0 - !! find the crossectional area and depth for volrt - !! by iteration method at 1cm interval depth - !! find the depth until the discharge rate is equal to volrt + rcharea = ch_vel(jrch)%area + rchdep = ch_hyd(jhyd)%d + p = ch_vel(jrch)%wid_btm + 2. * ch_hyd(jhyd)%d * Sqrt(1. + c * c) + rh = ch_vel(jrch)%area / p + sdti = maxrt + adddep = 0 + !! find the crossectional area and depth for volrt + !! by iteration method at 1cm interval depth + !! find the depth until the discharge rate is equal to volrt itermx = 0 - Do While (sdti < volrt) + Do While (sdti < volrt) adddep = adddep + 0.01 addarea = rcharea + ((ch_hyd(jhyd)%w * 5) + 4 * adddep) * adddep addp = p + (ch_hyd(jhyd)%w * 4) + 2. * adddep * Sqrt(1. + 4 * 4) - rh = addarea / addp + rh = addarea / addp sdti = Qman(addarea, rh, ch_hyd(jhyd)%n, ch_hyd(jhyd)%s) itermx = itermx + 1 if (itermx > 100) exit - end do - rcharea = addarea - rchdep = ch_hyd(jhyd)%d + adddep - p = addp - sdti = volrt + end do + rcharea = addarea + rchdep = ch_hyd(jhyd)%d + adddep + p = addp + sdti = volrt ! store floodplain water that can be used by riparian HRU"s - else - !! find the crossectional area and depth for volrt - !! by iteration method at 1cm interval depth - !! find the depth until the discharge rate is equal to volrt - Do While (sdti < volrt) - rchdep = rchdep + 0.01 - rcharea = (ch_vel(jrch)%wid_btm + c * rchdep) * rchdep - p = ch_vel(jrch)%wid_btm + 2. * rchdep * Sqrt(1. + c * c) - rh = rcharea / p + else + !! find the crossectional area and depth for volrt + !! by iteration method at 1cm interval depth + !! find the depth until the discharge rate is equal to volrt + Do While (sdti < volrt) + rchdep = rchdep + 0.01 + rcharea = (ch_vel(jrch)%wid_btm + c * rchdep) * rchdep + p = ch_vel(jrch)%wid_btm + 2. * rchdep * Sqrt(1. + c * c) + rh = rcharea / p sdti = Qman(rcharea, rh, ch_hyd(jhyd)%n, ch_hyd(jhyd)%s) - end do - sdti = volrt - end if + end do + sdti = volrt + end if !! calculate top width of channel at water level topw = 0. @@ -193,9 +193,9 @@ subroutine ch_rtday if (sdti > 0.) then !! calculate velocity and travel time - vc = sdti / rcharea + vc = sdti / rcharea ch(jrch)%vel_chan = vc - rttime = ch_hyd(jhyd)%l * 1000. / (3600. * vc) + rttime = ch_hyd(jhyd)%l * 1000. / (3600. * vc) !! calculate volume of water leaving reach on day scoef = 2. * det / (2. * rttime + det) @@ -217,77 +217,77 @@ subroutine ch_rtday !! channel storage and from volume flowing out !! calculate transmission losses - rttlc = 0. + rttlc = 0. - if (rtwtr > 0.) then + if (rtwtr > 0.) then - !! Total time in hours to clear the water + !! Total time in hours to clear the water rttlc = det * ch_hyd(jhyd)%k * ch_hyd(jhyd)%l * p - if (ch(jrch)%rchstor <= rttlc) then - rttlc1 = min(rttlc, ch(jrch)%rchstor) - ch(jrch)%rchstor = ch(jrch)%rchstor - rttlc1 - rttlc2 = rttlc - rttlc1 - if (rtwtr <= rttlc2) then - rttlc2 = min(rttlc2, rtwtr) - rtwtr = rtwtr - rttlc2 - else - rtwtr = rtwtr - rttlc2 + if (ch(jrch)%rchstor <= rttlc) then + rttlc1 = min(rttlc, ch(jrch)%rchstor) + ch(jrch)%rchstor = ch(jrch)%rchstor - rttlc1 + rttlc2 = rttlc - rttlc1 + if (rtwtr <= rttlc2) then + rttlc2 = min(rttlc2, rtwtr) + rtwtr = rtwtr - rttlc2 + else + rtwtr = rtwtr - rttlc2 end if rttlc = rttlc1 + rttlc2 - else - ch(jrch)%rchstor = ch(jrch)%rchstor - rttlc - end if + else + ch(jrch)%rchstor = ch(jrch)%rchstor - rttlc + end if end if !! calculate evaporation - rtevp = 0. + rtevp = 0. if (rtwtr > 0.) then aaa = bsn_prm%evrch * pet_ch / 1000. * rt_delt - if (rchdep <= ch_hyd(jhyd)%d) then + if (rchdep <= ch_hyd(jhyd)%d) then rtevp = aaa * ch_hyd(jhyd)%l * 1000. * topw - else - if (aaa <= (rchdep - ch_hyd(jhyd)%d)) then + else + if (aaa <= (rchdep - ch_hyd(jhyd)%d)) then rtevp = aaa * ch_hyd(jhyd)%l * 1000. * topw - else - rtevp = (rchdep - ch_hyd(jhyd)%d) - rtevp = rtevp + (aaa - (rchdep - ch_hyd(jhyd)%d)) + else + rtevp = (rchdep - ch_hyd(jhyd)%d) + rtevp = rtevp + (aaa - (rchdep - ch_hyd(jhyd)%d)) topw = ch_vel(jrch)%wid_btm + 2. * ch_hyd(jhyd)%d * c - rtevp = rtevp * ch_hyd(jhyd)%l * 1000. * topw - end if - end if + rtevp = rtevp * ch_hyd(jhyd)%l * 1000. * topw + end if + end if - rtevp2 = rtevp * ch(jrch)%rchstor / (rtwtr + ch(jrch)%rchstor) + rtevp2 = rtevp * ch(jrch)%rchstor / (rtwtr + ch(jrch)%rchstor) - if (ch(jrch)%rchstor <= rtevp2) then - rtevp2 = min(rtevp2, ch(jrch)%rchstor) - ch(jrch)%rchstor = ch(jrch)%rchstor - rtevp2 - rtevp1 = rtevp - rtevp2 - if (rtwtr <= rtevp1) then - rtevp1 = min(rtevp1, rtwtr) - rtwtr = rtwtr - rtevp1 - else - rtwtr = rtwtr - rtevp1 - end if - else - ch(jrch)%rchstor = ch(jrch)%rchstor - rtevp2 - rtevp1 = rtevp - rtevp2 - if (rtwtr <= rtevp1) then - rtevp1 = min(rtevp1, rtwtr) - rtwtr = rtwtr - rtevp1 - else - rtwtr = rtwtr - rtevp1 - end if - end if - rtevp = rtevp1 + rtevp2 + if (ch(jrch)%rchstor <= rtevp2) then + rtevp2 = min(rtevp2, ch(jrch)%rchstor) + ch(jrch)%rchstor = ch(jrch)%rchstor - rtevp2 + rtevp1 = rtevp - rtevp2 + if (rtwtr <= rtevp1) then + rtevp1 = min(rtevp1, rtwtr) + rtwtr = rtwtr - rtevp1 + else + rtwtr = rtwtr - rtevp1 + end if + else + ch(jrch)%rchstor = ch(jrch)%rchstor - rtevp2 + rtevp1 = rtevp - rtevp2 + if (rtwtr <= rtevp1) then + rtevp1 = min(rtevp1, rtwtr) + rtwtr = rtwtr - rtevp1 + else + rtwtr = rtwtr - rtevp1 + end if + end if + rtevp = rtevp1 + rtevp2 end if else rtwtr = 0. sdti = 0. - ch(jrch)%rchstor = 0. - ch(jrch)%vel_chan = 0. + ch(jrch)%rchstor = 0. + ch(jrch)%vel_chan = 0. ch(jrch)%flwin = 0. ch(jrch)%flwout = 0. end if diff --git a/src/ch_rthr.f90 b/src/ch_rthr.f90 index 5c2f5b1..6ede8b5 100644 --- a/src/ch_rthr.f90 +++ b/src/ch_rthr.f90 @@ -3,7 +3,7 @@ subroutine ch_rthr !! ~ ~ ~ PURPOSE ~ ~ ~ !! This subroutine routes flow at any required time step through the reach !! using a constant storage coefficient -!! Routing method: Variable Storage routing +!! Routing method: Variable Storage routing !! ~ ~ ~ INCOMING VARIABLES ~ ~ ~ !! name |units |definition @@ -34,7 +34,7 @@ subroutine ch_rthr !! subroutine developed by A. Van Griensven, !! Hydrology-Vrije Universiteit Brussel, Belgium -!! Modified by Jeahak Jeong, Blackland Research, Temple, USA +!! Modified by Jeahak Jeong, Blackland Research, Temple, USA use basin_module use climate_module diff --git a/src/ch_rtmusk.f90 b/src/ch_rtmusk.f90 index 52e2439..6ebac06 100644 --- a/src/ch_rtmusk.f90 +++ b/src/ch_rtmusk.f90 @@ -151,7 +151,7 @@ subroutine ch_rtmusk !! Muskingum flood routing method outflo = sd_ch(jrch)%msk%c1 * inflo + sd_ch(jrch)%msk%c2 * sd_ch(jrch)%in1_vol + & sd_ch(jrch)%msk%c3 * sd_ch(jrch)%out1_vol - outflo = Min (outflo, tot_stor(jrch)%flo) + outflo = Min (outflo, tot_stor(jrch)%flo) outflo = Max (outflo, 0.) !! save inflow/outflow volumes for next time step (and day) for Muskingum diff --git a/src/ch_rtpath.f90 b/src/ch_rtpath.f90 index b6b815d..c458a69 100644 --- a/src/ch_rtpath.f90 +++ b/src/ch_rtpath.f90 @@ -89,9 +89,9 @@ subroutine ch_rtpath !! new concentration netwtr = ob(icmd)%hin%flo + rchwtr - - !! change made by CS while running region 4; date 2 jan 2006 - if (path_tot < 1.e-6) path_tot = 0.0 + + !! change made by CS while running region 4; date 2 jan 2006 + if (path_tot < 1.e-6) path_tot = 0.0 if (netwtr >= 1.) then ch_water(jrch)%path(ipath) = path_tot / netwtr else diff --git a/src/channel_control.f90 b/src/channel_control.f90 index 26223ca..97ff681 100644 --- a/src/channel_control.f90 +++ b/src/channel_control.f90 @@ -186,16 +186,16 @@ subroutine channel_control !! Channel Deposition (Only new deposits during the current time step) if (ch(jrch)%depch >= ch(jrch)%depprch) then - ch_d(jrch)%ch_dep = ch(jrch)%depch - ch(jrch)%depprch - else - ch_d(jrch)%ch_dep = 0. - end if + ch_d(jrch)%ch_dep = ch(jrch)%depch - ch(jrch)%depprch + else + ch_d(jrch)%ch_dep = 0. + end if !! Floodplain Deposition (Only new deposits during the current time step) if (ch(jrch)%depfp >= ch(jrch)%depprfp) then - ch_d(jrch)%fp_dep = ch(jrch)%depfp - ch(jrch)%depprfp - else - ch_d(jrch)%fp_dep = 0. - end if + ch_d(jrch)%fp_dep = ch(jrch)%depfp - ch(jrch)%depprfp + else + ch_d(jrch)%fp_dep = 0. + end if !! Total suspended sediments (only silt and clay) if (ch_sed(jsed)%eqn == 0) then ch_d(jrch)%tot_ssed = sedrch diff --git a/src/cli_precip_control.f90 b/src/cli_precip_control.f90 index 6c90e3d..2582759 100644 --- a/src/cli_precip_control.f90 +++ b/src/cli_precip_control.f90 @@ -89,16 +89,16 @@ subroutine cli_precip_control (istart) do ist = 1, time%step wst(iwst)%weat%ts_next(ist) = pcp(ipg)%tss(ist,cur_day,time%yrs) if (wst(iwst)%weat%ts_next(ist) <= -97.) then - !! simulate missing data - call cli_pgen(iwgn) - call cli_pgenhr - exit - end if - wst(iwst)%weat%precip_next = wst(iwst)%weat%precip_next + wst(iwst)%weat%ts_next(ist) + !! simulate missing data + call cli_pgen(iwgn) + call cli_pgenhr + exit + end if + wst(iwst)%weat%precip_next = wst(iwst)%weat%precip_next + wst(iwst)%weat%ts_next(ist) end do wst(iwst)%weat%precip_next = sum (pcp(ipg)%tss(:,cur_day,time%yrs)) else - !! daily precip + !! daily precip if (out_bounds == "y") then wst(iwst)%weat%precip_next = -98. else @@ -109,7 +109,7 @@ subroutine cli_precip_control (istart) if (wst(iwst)%weat%precip_next <= -97.) then call cli_pgen(iwgn) pcp(ipg)%days_gen = pcp(ipg)%days_gen + 1 - end if + end if end if end if diff --git a/src/cli_read_atmodep_cs.f90 b/src/cli_read_atmodep_cs.f90 index 2322c97..f5ddfe2 100644 --- a/src/cli_read_atmodep_cs.f90 +++ b/src/cli_read_atmodep_cs.f90 @@ -79,7 +79,7 @@ subroutine cli_read_atmodep_cs read(5050,*) (atmodep_cs(iadep)%cs(ics)%drymo(imo),imo=1,atmodep_cont%num) enddo end if - + !yearly values if (atmodep_cont%timestep == "yr") then read(5050,*) station_name !station name diff --git a/src/cli_read_atmodep_salt.f90 b/src/cli_read_atmodep_salt.f90 index 50000d0..83c3e74 100644 --- a/src/cli_read_atmodep_salt.f90 +++ b/src/cli_read_atmodep_salt.f90 @@ -77,7 +77,7 @@ subroutine cli_read_atmodep_salt read(5050,*) salt_ion,(atmodep_salt(iadep)%salt(isalt)%drymo(imo),imo=1,atmodep_cont%num) enddo end if - + !yearly values if (atmodep_cont%timestep == "yr") then read(5050,*) station_name !station name diff --git a/src/cs_balance.f90 b/src/cs_balance.f90 index 335db27..6c0519b 100644 --- a/src/cs_balance.f90 +++ b/src/cs_balance.f90 @@ -682,7 +682,7 @@ subroutine cs_balance !rtb cs gwsol_ss(i)%solute(sol_index)%sorb = 0. enddo sol_index = sol_index + 1 - enddo !go to next constituent + enddo !go to next constituent endif endif diff --git a/src/cs_divert.f90 b/src/cs_divert.f90 index 4f09489..18ffe30 100644 --- a/src/cs_divert.f90 +++ b/src/cs_divert.f90 @@ -45,7 +45,7 @@ subroutine cs_divert(iwallo,idmd,dem_id) !rtb cs !determine number of water sources nsource = wallo(iwallo)%dmd(idmd)%dmd_src_obs - + !demand object type obj_type_dem = wallo(iwallo)%dmd(idmd)%rcv_ob diff --git a/src/cs_lch.f90 b/src/cs_lch.f90 index 6f1057b..e85c6a1 100644 --- a/src/cs_lch.f90 +++ b/src/cs_lch.f90 @@ -106,7 +106,7 @@ subroutine cs_lch !rtb cs ro_mass = surfq(j) * cosurfcs ro_mass = Min(ro_mass, cs_soil(j)%ly(jj)%cs(ics)) cs_soil(j)%ly(jj)%cs(ics) = cs_soil(j)%ly(jj)%cs(ics) - ro_mass - surqcs(j,ics) = ro_mass + surqcs(j,ics) = ro_mass endif !Daniel 1/2012 @@ -155,7 +155,7 @@ subroutine cs_lch !rtb cs hru_area_m2 = hru(j)%area_ha * 10000. !ha --> m2 water_volume = (soil(j)%phys(jj)%st/1000.) * hru_area_m2 if(cs_soil(j)%ly(jj)%cs(ics).lt.0) then - cs_soil(j)%ly(jj)%cs(ics) = 0. + cs_soil(j)%ly(jj)%cs(ics) = 0. endif cs_mass_kg = cs_soil(j)%ly(jj)%cs(ics) * hru(j)%area_ha !kg !calculate concentration in mg/L diff --git a/src/ero_ovrsed.f90 b/src/ero_ovrsed.f90 index 658eea6..1827630 100644 --- a/src/ero_ovrsed.f90 +++ b/src/ero_ovrsed.f90 @@ -11,7 +11,7 @@ subroutine ero_ovrsed() !! hru_km(:) |km2 |area of HRU in square kilometers !! rwst(:)%weat%ts(:) |mm H2O |precipitation for the time step during the !! |day in HRU -!! eros_spl |none |coefficient of splash erosion varing 0.9-3.1 +!! eros_spl |none |coefficient of splash erosion varing 0.9-3.1 !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~ @@ -25,8 +25,8 @@ subroutine ero_ovrsed() !! ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~ !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! jj |none |HRU number -!! kk |none |time step of the day +!! jj |none |HRU number +!! kk |none |time step of the day !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ @@ -35,7 +35,7 @@ subroutine ero_ovrsed() !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ !! Splash erosion model is adopted from EUROSEM model developed by Morgan (2001). -!! Rill/interill erosion model is adoped from Modified ANSWERS model by Park et al.(1982) +!! Rill/interill erosion model is adoped from Modified ANSWERS model by Park et al.(1982) !! Code developed by J. Jeong and N. Kannan, BRC. use urban_data_module @@ -73,114 +73,114 @@ subroutine ero_ovrsed() real :: rintnsty = 0. !mm/hr |rainfall intensity real :: cover = 0. !kg/ha |soil cover - j = ihru - ulu = hru(j)%luse%urb_lu + j = ihru + ulu = hru(j)%luse%urb_lu !! Fraction of sand percent_clay = soil(j)%phys(1)%clay - percent_silt = soil(j)%phys(1)%silt - percent_sand = 100. - percent_clay - percent_silt + percent_silt = soil(j)%phys(1)%silt + percent_sand = 100. - percent_clay - percent_silt !! Soil detachability values adopted from EUROSEM User Guide (Table 1) - if ((percent_clay>=40.) .and. (percent_sand>=20.) .and. & + if ((percent_clay>=40.) .and. (percent_sand>=20.) .and. & (percent_sand<=45.)) then - erod_k = 2.0 !clay + erod_k = 2.0 !clay elseif ((percent_clay>=27.) .and. (percent_sand>=20.) .and. & (percent_sand<=45.)) then - erod_k = 1.7 !Clay loam + erod_k = 1.7 !Clay loam elseif ((percent_silt<=40.).and.(percent_sand<=20.)) then - erod_k = 2.0 !Clay + erod_k = 2.0 !Clay elseif ((percent_silt>40.).and.(percent_clay>=40.)) then - erod_k = 1.6 !Silty clay + erod_k = 1.6 !Silty clay elseif ((percent_clay>=35.).and.(percent_sand>=45.)) then - erod_k = 1.9 !Sandy clay + erod_k = 1.9 !Sandy clay elseif ((percent_clay>=27.).and.(percent_sand<20.)) then - erod_k = 1.6 !Silty clay loam + erod_k = 1.6 !Silty clay loam elseif ((percent_clay<=10.).and.(percent_silt>=80.)) then - erod_k = 1.2 !Silt + erod_k = 1.2 !Silt elseif (percent_silt>=50.) then - erod_k = 1.5 !Silt loam + erod_k = 1.5 !Silt loam elseif ((percent_clay>=7.) .and. (percent_sand<=52.) .and. & (percent_silt>=28.)) then - erod_k = 2.0 !Loam + erod_k = 2.0 !Loam elseif (percent_clay>=20.) then - erod_k = 2.1 !Sandy clay loam + erod_k = 2.1 !Sandy clay loam elseif (percent_clay>=percent_sand-70.) then - erod_k = 2.6 !Sandy loam + erod_k = 2.6 !Sandy loam elseif (percent_clay>=(2. * percent_sand) - 170.) then - erod_k = 3.0 !Loamy sand + erod_k = 3.0 !Loamy sand else - erod_k = 1.9 !Sand + erod_k = 1.9 !Sand end if - - !! canopy cover based on leaf area index -!! canopy cover is assumed to be 100% if LAI>=1 - if(pcom(j)%lai_sum >= 1.) then - canopy_cover = 1. - else - canopy_cover = pcom(j)%lai_sum + + !! canopy cover based on leaf area index +!! canopy cover is assumed to be 100% if LAI>=1 + if(pcom(j)%lai_sum >= 1.) then + canopy_cover = 1. + else + canopy_cover = pcom(j)%lai_sum end if if (bsn_cc%gampt > 0) then do k = 1, time%step - rintnsty = 60. * wst(iwst)%weat%ts(k) / Real(time%dtm) - rain_d50 = 0.188 * rintnsty ** 0.182 + rintnsty = 60. * wst(iwst)%weat%ts(k) / Real(time%dtm) + rain_d50 = 0.188 * rintnsty ** 0.182 - if (rintnsty > 0) then - + if (rintnsty > 0) then + !! Rainfall kinetic energy generated by direct throughfall (J/m^2/mm) - ke_direct = 8.95 + 8.44 * log10(rintnsty) + ke_direct = 8.95 + 8.44 * log10(rintnsty) if(ke_direct<0.) ke_direct = 0. - !! Rainfall kinetic energy generated by leaf drainage (J/m^2) - pheff = 0.5 * pcom(j)%cht_mx - ke_leaf = 15.8 * pheff ** 0.5 - 5.87 - if (ke_leaf<0) ke_leaf = 0. - - !! Depth of rainfall - rdepth_tot = wst(iwst)%weat%ts(k) / (time%dtm * 60.) - rdepth_leaf = rdepth_tot * canopy_cover - rdepth_direct = rdepth_tot - rdepth_leaf - else - ke_direct = 0. - ke_leaf = 0. - rdepth_tot = 0. - rdepth_leaf = 0. - rdepth_direct = 0. - endif - - !! total kinetic energy by rainfall (J/m^2) - ke_total = 0.001 * (rdepth_direct * ke_direct + rdepth_leaf * ke_leaf) - - !! total soil detachment by raindrop impact - sedspl = erod_k * ke_total * exp(-bsn_prm%eros_spl * & + !! Rainfall kinetic energy generated by leaf drainage (J/m^2) + pheff = 0.5 * pcom(j)%cht_mx + ke_leaf = 15.8 * pheff ** 0.5 - 5.87 + if (ke_leaf<0) ke_leaf = 0. + + !! Depth of rainfall + rdepth_tot = wst(iwst)%weat%ts(k) / (time%dtm * 60.) + rdepth_leaf = rdepth_tot * canopy_cover + rdepth_direct = rdepth_tot - rdepth_leaf + else + ke_direct = 0. + ke_leaf = 0. + rdepth_tot = 0. + rdepth_leaf = 0. + rdepth_direct = 0. + endif + + !! total kinetic energy by rainfall (J/m^2) + ke_total = 0.001 * (rdepth_direct * ke_direct + rdepth_leaf * ke_leaf) + + !! total soil detachment by raindrop impact + sedspl = erod_k * ke_total * exp(-bsn_prm%eros_spl * & hhqday(j,k) / 1000.) * hru(j)%km ! tons - !! Impervious area of HRU - if(hru(j)%luse%urb_lu > 0) sedspl = sedspl * (1.- urbdb(ulu)%fimp) + !! Impervious area of HRU + if(hru(j)%luse%urb_lu > 0) sedspl = sedspl * (1.- urbdb(ulu)%fimp) - !! maximum water depth that allows splash erosion - if(hhqday(j,k)>=3.* rain_d50.or.hhqday(j,k)<=1.e-3) sedspl = 0. + !! maximum water depth that allows splash erosion + if(hhqday(j,k)>=3.* rain_d50.or.hhqday(j,k)<=1.e-3) sedspl = 0. - !! Overland flow erosion + !! Overland flow erosion !! cover and management factor used in usle equation (ysed.f) cover = pl_mass(j)%ab_gr_com%m + rsd1(j)%tot_com%m - c = Exp((-.2231 - cvm_com(j)) * Exp(-.00115 * cover) + cvm_com(j)) - !! specific weight of water at 5 centigrate =9807N/m3 - bed_shear = 9807 * (hhqday(j,k) / 1000.) * hru(j)%topo%slope ! N/m2 - sedov = 11.02 * bsn_prm%rill_mult * soil(j)%ly(1)%usle_k * & + c = Exp((-.2231 - cvm_com(j)) * Exp(-.00115 * cover) + cvm_com(j)) + !! specific weight of water at 5 centigrate =9807N/m3 + bed_shear = 9807 * (hhqday(j,k) / 1000.) * hru(j)%topo%slope ! N/m2 + sedov = 11.02 * bsn_prm%rill_mult * soil(j)%ly(1)%usle_k * & bsn_prm%c_factor * c * bed_shear ** bsn_prm%eros_expo ! kg/hour/m2 - if (time%step > 1) then - sedov = 16.667 * sedov * hru(j)%km * time%dtm ! tons per time step - else - sedov = 24000. * sedov * hru(j)%km ! tons per day - end if + if (time%step > 1) then + sedov = 16.667 * sedov * hru(j)%km * time%dtm ! tons per time step + else + sedov = 24000. * sedov * hru(j)%km ! tons per day + end if - !! Impervious area of HRU - if (hru(j)%luse%urb_lu > 0) sedov = sedov * (1.- urbdb(ulu)%fimp) + !! Impervious area of HRU + if (hru(j)%luse%urb_lu > 0) sedov = sedov * (1.- urbdb(ulu)%fimp) - hhsedy(j,k) = (sedspl + sedov) - if (hhsedy(j,k) < 1.e-10) hhsedy(j,k) = 0. + hhsedy(j,k) = (sedspl + sedov) + if (hhsedy(j,k) < 1.e-10) hhsedy(j,k) = 0. end do end if diff --git a/src/gwflow_chem.f90 b/src/gwflow_chem.f90 index e6a081a..62b4e32 100644 --- a/src/gwflow_chem.f90 +++ b/src/gwflow_chem.f90 @@ -39,17 +39,17 @@ subroutine gwflow_chem(cell_id,gw_vol) !rtb gwflow mass_rct = 0. !no3 - mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day + mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day !p sol_index = sol_index + 1 - mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day + mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day !salt ions if (gwsol_salt == 1) then do isalt=1,cs_db%num_salts sol_index = sol_index + 1 - mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day + mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day enddo endif @@ -107,7 +107,7 @@ subroutine gwflow_chem(cell_id,gw_vol) !rtb gwflow !boron sol_index = sol_index + 1 - mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day + mass_rct(sol_index) = gwsol_state(cell_id)%solute(sol_index)%conc * gw_vol * gwsol_rctn(sol_index) !g/day endif !if constituents are active diff --git a/src/gwflow_module.f90 b/src/gwflow_module.f90 index d3411b5..7afabb9 100644 --- a/src/gwflow_module.f90 +++ b/src/gwflow_module.f90 @@ -146,7 +146,7 @@ module gwflow_module real, dimension (:), allocatable :: gw_delay ! | real, dimension (:), allocatable :: gw_rech ! | real, dimension (:), allocatable :: delay ! | - + !gwet: variables for groundwater evapotranspiration ----------------------------------------- integer :: gw_et_flag = 0 ! | real, dimension (:), allocatable :: etremain ! | diff --git a/src/gwflow_read.f90 b/src/gwflow_read.f90 index 0ee850c..5df47f1 100644 --- a/src/gwflow_read.f90 +++ b/src/gwflow_read.f90 @@ -323,7 +323,7 @@ subroutine gwflow_read gw_state(i)%xcrd = 0. gw_state(i)%ycrd = 0. gw_state(i)%area = 0. - gw_state(i)%init = 0. + gw_state(i)%init = 0. gw_state(i)%head = 0. gw_state(i)%hydc = 0. gw_state(i)%spyd = 0. @@ -532,7 +532,7 @@ subroutine gwflow_read gw_state(i)%xcrd = 0. gw_state(i)%ycrd = 0. gw_state(i)%area = 0. - gw_state(i)%init = 0. + gw_state(i)%init = 0. gw_state(i)%head = 0. gw_state(i)%hydc = 0. gw_state(i)%spyd = 0. @@ -1929,7 +1929,7 @@ subroutine gwflow_read write(out_gwbal,*) 'ppex: mm groundwater pumping specified by user' write(out_gwbal,*) 'tile: mm groundwater removed via tile drains' write(out_gwbal,*) 'resv: mm groundwater exchanged with reservoirs' - write(out_gwbal,*) 'wetl: mm groundwater outflow to wetlands' + write(out_gwbal,*) 'wetl: mm groundwater outflow to wetlands' write(out_gwbal,*) 'canl: mm canal seepage to groundwater' write(out_gwbal,*) 'fpln: mm floodplain exchange' write(out_gwbal,*) 'error: -- water balance error for aquifer' diff --git a/src/gwflow_resv.f90 b/src/gwflow_resv.f90 index bf1bd0a..b895515 100644 --- a/src/gwflow_resv.f90 +++ b/src/gwflow_resv.f90 @@ -59,10 +59,10 @@ subroutine gwflow_resv(res_id) !rtb gwflow conn_length = sqrt(min_area) !exchange volume (m3/day) using Darcy's Law - head_diff = gw_resv_info(res_id)%elev(k) - gw_state(cell_id)%head + head_diff = gw_resv_info(res_id)%elev(k) - gw_state(cell_id)%head res_K = gw_resv_info(res_id)%hydc(k) res_thick = gw_resv_info(res_id)%thck(k) - Q = res_K * (head_diff / res_thick) * (res_thick * conn_length) + Q = res_K * (head_diff / res_thick) * (res_thick * conn_length) !check against available storage volumes (m3) if(Q > 0) then !reservoir --> aquifer @@ -73,9 +73,9 @@ subroutine gwflow_resv(res_id) !rtb gwflow !if((Q*-1 == 1).ge.gw_state(cell_id)%stor) then if (-Q .ge.gw_state(cell_id)%stor) then !Q = gw_state(cell_id)%stor * (-1) - Q = -gw_state(cell_id)%stor - gw_state(cell_id)%stor = gw_state(cell_id)%stor + Q - endif + Q = -gw_state(cell_id)%stor + gw_state(cell_id)%stor = gw_state(cell_id)%stor + Q + endif endif !store for gwflow water balance calculations (in gwflow_simulate) diff --git a/src/gwflow_simulate.f90 b/src/gwflow_simulate.f90 index 304a411..2111c61 100644 --- a/src/gwflow_simulate.f90 +++ b/src/gwflow_simulate.f90 @@ -1555,7 +1555,7 @@ subroutine gwflow_simulate write(out_gw_res,101) (grid_val(i,j),j=1,grid_ncol) enddo else - write(out_gw_res,121) (gw_ss_sum(i)%resv,i=1,ncell) + write(out_gw_res,121) (gw_ss_sum(i)%resv,i=1,ncell) endif write(out_gw_res,*) if (gw_solute_flag == 1) then !solute mass flux @@ -1582,7 +1582,7 @@ subroutine gwflow_simulate endif !groundwater-wetland exchange if (gw_wet_flag == 1) then - write(out_gw_wet,*) 'Groundwater outflow to wetlands for:',time%yrc + write(out_gw_wet,*) 'Groundwater outflow to wetlands for:',time%yrc if(grid_type == "structured") then grid_val = 0. do i=1,grid_nrow @@ -1596,7 +1596,7 @@ subroutine gwflow_simulate write(out_gw_wet,101) (grid_val(i,j),j=1,grid_ncol) enddo else - write(out_gw_wet,121) (gw_ss_sum(i)%wetl,i=1,ncell) + write(out_gw_wet,121) (gw_ss_sum(i)%wetl,i=1,ncell) endif write(out_gw_wet,*) if (gw_solute_flag == 1) then !solute mass flux @@ -1622,8 +1622,8 @@ subroutine gwflow_simulate endif endif !groundwater-canal exchange - if (gw_canal_flag == 1) then - write(out_gw_canal,*) 'Groundwater-Canal Exchange Volumes for:',time%yrc + if (gw_canal_flag == 1) then + write(out_gw_canal,*) 'Groundwater-Canal Exchange Volumes for:',time%yrc if(grid_type == "structured") then grid_val = 0. do i=1,grid_nrow @@ -1637,7 +1637,7 @@ subroutine gwflow_simulate write(out_gw_canal,101) (grid_val(i,j),j=1,grid_ncol) enddo else - write(out_gw_canal,121) (gw_ss_sum(i)%canl,i=1,ncell) + write(out_gw_canal,121) (gw_ss_sum(i)%canl,i=1,ncell) endif write(out_gw_canal,*) if (gw_solute_flag == 1) then !solute mass flux @@ -1664,7 +1664,7 @@ subroutine gwflow_simulate endif !floodplain exchange if (gw_fp_flag == 1) then - write(out_gw_fp,*) 'Floodplain Exchange Volumes for:',time%yrc + write(out_gw_fp,*) 'Floodplain Exchange Volumes for:',time%yrc if(grid_type == "structured") then grid_val = 0. do i=1,grid_nrow @@ -1678,7 +1678,7 @@ subroutine gwflow_simulate write(out_gw_fp,101) (grid_val(i,j),j=1,grid_ncol) enddo else - write(out_gw_fp,121) (gw_ss_sum(i)%fpln,i=1,ncell) + write(out_gw_fp,121) (gw_ss_sum(i)%fpln,i=1,ncell) endif write(out_gw_fp,*) if (gw_solute_flag == 1) then !solute mass flux @@ -1884,7 +1884,7 @@ subroutine gwflow_simulate if(gwflag_yr.eq.1) then write(out_solbal_yr+s,105) time%yrc, & sol_grid_chng_yr,sol_grid_rech_yr,sol_grid_gwsw_yr,sol_grid_swgw_yr,sol_grid_satx_yr, & - sol_grid_soil_yr,sol_grid_advn_yr,sol_grid_disp_yr, & + sol_grid_soil_yr,sol_grid_advn_yr,sol_grid_disp_yr, & sol_grid_rcti_yr,sol_grid_rcto_yr,sol_grid_minl_yr,sol_grid_sorb_yr, & sol_grid_ppag_yr,sol_grid_ppex_yr,sol_grid_tile_yr,sol_grid_resv_yr,sol_grid_wetl_yr, & sol_grid_canl_yr,sol_grid_fpln_yr @@ -2529,9 +2529,9 @@ subroutine gwflow_simulate !121 format((e12.3)) 120 format(f12.3) 121 format(e12.3) -125 format(3x,i8,2x,i8,7x,f15.1,50(e13.4)) +125 format(3x,i8,2x,i8,7x,f15.1,50(e13.4)) return end subroutine gwflow_simulate - \ No newline at end of file + \ No newline at end of file diff --git a/src/gwflow_soil.f90 b/src/gwflow_soil.f90 index 6ee7671..ed3d558 100644 --- a/src/gwflow_soil.f90 +++ b/src/gwflow_soil.f90 @@ -18,7 +18,7 @@ subroutine gwflow_soil(hru_id) !rtb gwflow integer :: cell_id = 0 ! |cell in connection with the channel real :: hru_Q = 0. !m3 |volume transferred from cell to the soil profile real :: hru_soilz = 0. !m |thickness of HRU soil profile - real :: vadose_z = 0. !m |thickness of cell vadose zone + real :: vadose_z = 0. !m |thickness of cell vadose zone real :: poly_area = 0. !m2 |area of cell within the HRU real :: solmass(100) = 0. !g |solute mass transferred from cell real :: water_depth(100) = 0. !m |depth of groundwater in each soil layer diff --git a/src/hcsout_output.f90 b/src/hcsout_output.f90 index 7f0bb79..e5f578a 100644 --- a/src/hcsout_output.f90 +++ b/src/hcsout_output.f90 @@ -35,29 +35,29 @@ subroutine hcsout_output ob(iob)%frac_out(iiout), (hcs1%path(ipath), ipath = 1, cs_db%num_paths) if (pco%csvout == "y") then write (2760,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (hcs1%path(ipath), ipath = 1, cs_db%num_paths) end if !! cvs paths end if !! paths if (cs_db%num_metals > 0) then !! metals write (2748,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (hcs1%hmet(imetal), imetal = 1, cs_db%num_metals) if (pco%csvout == "y") then write (2764,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (hcs1%hmet(imetal), imetal = 1, cs_db%num_metals) end if !! cvs metals end if !! metals if (cs_db%num_salts > 0) then !! salts write (2752,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (hcs1%salt(isalt), isalt = 1, cs_db%num_salts) if (pco%csvout == "y") then write (2768,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (hcs1%salt(isalt), isalt = 1, cs_db%num_salts) end if !! cvs salts end if !! salts @@ -71,44 +71,44 @@ subroutine hcsout_output if (pco%hyd%m == "y") then if (cs_db%num_pests > 0) then !! pests write (2741,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) if (pco%csvout == "y") then write (2757,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) end if !! cvs pests end if !! pests if (cs_db%num_paths > 0) then !! paths write (2745,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%path(ipath), ipath = 1, cs_db%num_paths) if (pco%csvout == "y") then write (2761,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%path(ipath), ipath = 1, cs_db%num_paths) end if !! cvs paths end if !! paths if (cs_db%num_metals > 0) then !! metals write (2749,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) if (pco%csvout == "y") then write (2765,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) end if !! cvs metals end if !! metals if (cs_db%num_salts > 0) then !! salts write (2753,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) if (pco%csvout == "y") then write (2769,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_m(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) end if !! cvs salts end if !! salts @@ -122,44 +122,44 @@ subroutine hcsout_output if (pco%hyd%y == "y") then if (cs_db%num_pests > 0) then !! pests write (2742,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) if (pco%csvout == "y") then write (2752,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) end if !! cvs pests end if !! pests if (cs_db%num_paths > 0) then !! paths write (2746,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%path(ipath), ipath = 1, cs_db%num_paths) if (pco%csvout == "y") then write (2762,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%path(ipath), ipath = 1, cs_db%num_paths) end if !! cvs paths end if !! paths if (cs_db%num_metals > 0) then !! metals write (2750,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) if (pco%csvout == "y") then write (2766,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) end if !! cvs metals end if !! metals if (cs_db%num_salts > 0) then !! salts write (2754,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) if (pco%csvout == "y") then write (2770,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_y(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) end if !! cvs salts end if !! salts @@ -173,44 +173,44 @@ subroutine hcsout_output ob(iob)%hin_a(iiout) = ob(iob)%hin_a(iiout) / time%yrs_prt if (cs_db%num_pests > 0) then !! pests write (2743,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) if (pco%csvout == "y") then write (2759,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%pest(ipest), ipest = 1, cs_db%num_pests) end if !! cvs pests end if !! pests if (cs_db%num_paths > 0) then !! paths write (2747,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%path(ipath), ipath = 1, cs_db%num_paths) if (pco%csvout == "y") then write (2763,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%path(ipath), ipath = 1, cs_db%num_paths) end if !! cvs paths end if !! paths if (cs_db%num_metals > 0) then !! metals write (2751,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) if (pco%csvout == "y") then write (2767,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%hmet(imetal), imetal = 1, cs_db%num_metals) end if !! cvs metals end if !! metals if (cs_db%num_salts > 0) then !! salts write (2755,*) time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) if (pco%csvout == "y") then write (2771,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iob, ob(iob)%gis_id, ob(iob)%typ, & - ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & + ob(iob)%num, ob(iob)%obtyp_out(iiout), ob(iob)%obtypno_out(iiout), ob(iob)%htyp_out(iiout), & ob(iob)%frac_out(iiout), (obcs(iob)%hcsout_a(iiout)%salt(isalt), isalt = 1, cs_db%num_salts) end if !! cvs salts end if !! salts diff --git a/src/header_sd_channel.f90 b/src/header_sd_channel.f90 index 28a3cfc..3bc1562 100644 --- a/src/header_sd_channel.f90 +++ b/src/header_sd_channel.f90 @@ -23,7 +23,7 @@ subroutine header_sd_channel write (4814,'(*(G0.3,:,","))') sdch_hdr_units_sub write (9000,*) "SWAT-DEG_CHANNEL channel_sd_subday.csv" end if - end if + end if end if open (2500,file="channel_sd_day.txt",recl = 1500) diff --git a/src/header_write.f90 b/src/header_write.f90 index 12037f4..2b129d7 100644 --- a/src/header_write.f90 +++ b/src/header_write.f90 @@ -45,14 +45,14 @@ subroutine header_write !!!!!! hru-lte-out.cal - hru lte soft calibration output including soft and predicted budgets and !!!!!! calibration parameter adjustments !open (5003,file="hru-lte-out.cal", recl = 800) - !write (9000,*) "LTE SOFT OUT CALIB hru-lte-out.cal" - !write (5003,*) calb_hdr - + !write (9000,*) "LTE SOFT OUT CALIB hru-lte-out.cal" + !write (5003,*) calb_hdr + !!!!!! hru-lte-new.cal - hru lte soft calibration output file. The same format as hru-lte.hru and !!!!!! can be used as input (hru-lte.hru) in subsequent simulations !open (5002,file="hru-lte-new.cal", recl = 800) - !write (9000,*) "LTE SOFT CAL INPUT hru-lte-new.cal" - !write (5002,*) calb2_hdr + !write (9000,*) "LTE SOFT CAL INPUT hru-lte-new.cal" + !write (5002,*) calb2_hdr !! BASIN AQUIFER OUTPUT if (pco%aqu_bsn%d == "y") then diff --git a/src/hru_control.f90 b/src/hru_control.f90 index a4cbe3a..d006e7c 100644 --- a/src/hru_control.f90 +++ b/src/hru_control.f90 @@ -77,9 +77,9 @@ subroutine hru_control real :: sum_conc = 0. !rtb salt real :: sum_mass = 0. !rtb salt real :: sum_sorb = 0. !rtb salt - real :: saltcon = 0. !Jeong 2024 - real :: qsurf = 0. !Jeong 2024 - real :: sedppm = 0. !Jeong 2024 + real :: saltcon = 0. !Jeong 2024 + real :: qsurf = 0. !Jeong 2024 + real :: sedppm = 0. !Jeong 2024 j = ihru @@ -371,8 +371,8 @@ subroutine hru_control !! compute biozone processes in septic HRUs !! if 1) current is septic hru and 2) soil temperature is above zero isep = iseptic(j) - if (sep(isep)%opt /= 0. .and. time%yrc >= sep(isep)%yr) then - if (soil(j)%phys(i_sep(j))%tmp > 0.) call sep_biozone + if (sep(isep)%opt /= 0. .and. time%yrc >= sep(isep)%yr) then + if (soil(j)%phys(i_sep(j))%tmp > 0.) call sep_biozone endif !! compute plant community partitions @@ -571,12 +571,12 @@ subroutine hru_control !! compute loadings from urban areas if (hru(j)%luse%urb_lu > 0) then - if (time%step == 1) then + if (time%step == 1) then call hru_urban ! daily simulation - else + else call hru_urbanhr ! subdaily simulation J.Jeong 4/20/2009 - endif - endif + endif + endif !! compute sediment loading in lateral flow and add to sedyld call swr_latsed @@ -593,13 +593,13 @@ subroutine hru_control if (filterw(j) > 0.) call smp_buffer end if - !! compute reduction in pollutants due to in field grass waterway + !! compute reduction in pollutants due to in field grass waterway if (hru(j)%lumv%grwat_i == 1) then call smp_grass_wway end if - !! compute reduction in pollutants due to in fixed BMP eff - if (hru(j)%lumv%bmp_flag == 1) then + !! compute reduction in pollutants due to in fixed BMP eff + if (hru(j)%lumv%bmp_flag == 1) then call smp_bmpfixed end if diff --git a/src/hru_cs_output.f90 b/src/hru_cs_output.f90 index 7de4ed7..5b1c3af 100644 --- a/src/hru_cs_output.f90 +++ b/src/hru_cs_output.f90 @@ -69,7 +69,7 @@ subroutine hru_cs_output(ihru) !rtb cs (hcsb_d(j)%cs(ics)%srbd,ics=1,cs_db%num_cs) if (pco%csvout == "y") then write (6022,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, & - (hcsb_d(j)%cs(ics)%soil,ics=1,cs_db%num_cs), & + (hcsb_d(j)%cs(ics)%soil,ics=1,cs_db%num_cs), & (hcsb_d(j)%cs(ics)%surq,ics=1,cs_db%num_cs), & (hcsb_d(j)%cs(ics)%sedm,ics=1,cs_db%num_cs), & (hcsb_d(j)%cs(ics)%latq,ics=1,cs_db%num_cs), & diff --git a/src/hru_hyds.f90 b/src/hru_hyds.f90 index b1d1138..8c9cf74 100644 --- a/src/hru_hyds.f90 +++ b/src/hru_hyds.f90 @@ -93,10 +93,10 @@ subroutine hru_hyds obcs(icmd)%hd(3)%path(ipath) = 0 end do do isalt = 1, cs_db%num_salts !rtb salt - obcs(icmd)%hd(3)%salt(isalt) = (surqsalt(j,isalt)+urbqsalt(j,isalt)+wetqsalt(j,isalt)) * cnv_kg !kg of each salt ion + obcs(icmd)%hd(3)%salt(isalt) = (surqsalt(j,isalt)+urbqsalt(j,isalt)+wetqsalt(j,isalt)) * cnv_kg !kg of each salt ion enddo do ics = 1, cs_db%num_cs !rtb cs - obcs(icmd)%hd(3)%cs(ics) = (surqcs(j,ics)+sedmcs(j,ics)+urbqcs(j,ics)+wetqcs(j,ics)) * cnv_kg !kg of each constituent (surface runoff + attached) + obcs(icmd)%hd(3)%cs(ics) = (surqcs(j,ics)+sedmcs(j,ics)+urbqcs(j,ics)+wetqcs(j,ics)) * cnv_kg !kg of each constituent (surface runoff + attached) enddo !recharge hydrograph (2) diff --git a/src/hru_lte_control.f90 b/src/hru_lte_control.f90 index e6a9989..f773e51 100644 --- a/src/hru_lte_control.f90 +++ b/src/hru_lte_control.f90 @@ -347,19 +347,19 @@ subroutine hru_lte_control (isd) !! compute channel peak rate using SCS triangular unit hydrograph chflow_m3 = 1000. * chflow * ob(icmd)%area_ha - runoff_m3 = 1000. * runoff * ob(icmd)%area_ha - bf_m3 = 1000. * (flowlat + hlt(isd)%gwflow)*ob(icmd)%area_ha + runoff_m3 = 1000. * runoff * ob(icmd)%area_ha + bf_m3 = 1000. * (flowlat + hlt(isd)%gwflow)*ob(icmd)%area_ha peakr = 2. * runoff_m3 / (1.5 * hlt_db(ihlt_db)%tc) - peakrbf = bf_m3 / 86400. + peakrbf = bf_m3 / 86400. peakr = (peakr + peakrbf) !* prf !! compute sediment yield with MUSLE sedin = (runoff * peakr * 1000. * ob(icmd)%area_ha) ** .56 * hlt(isd)%uslefac - !! add subsurf sediment - t=ppm*mm*km2/1000. - qssubconc = 500. - qssub = qssubconc * (flowlat + hlt(isd)%gwflow) * ob(icmd)%area_ha / 1000. - sedin = sedin + qssub + !! add subsurf sediment - t=ppm*mm*km2/1000. + qssubconc = 500. + qssub = qssubconc * (flowlat + hlt(isd)%gwflow) * ob(icmd)%area_ha / 1000. + sedin = sedin + qssub cnv = ob(icmd)%area_ha * 1000. diff --git a/src/hru_module.f90 b/src/hru_module.f90 index 4a48382..21808fd 100644 --- a/src/hru_module.f90 +++ b/src/hru_module.f90 @@ -28,7 +28,7 @@ module hru_module type topography character(len=40) :: name = "" real :: elev = 0. !! |m |elevation of HRU - real :: slope = 0. !! hru_slp(:) |m/m |average slope steepness in HRU + real :: slope = 0. !! hru_slp(:) |m/m |average slope steepness in HRU real :: slope_len = 0. !! slsubbsn(:) |m |average slope length for erosion real :: dr_den = 0. !! |km/km2 |drainage density real :: lat_len = 0. !! slsoil(:) |m |slope length for lateral subsurface flow @@ -489,15 +489,15 @@ module hru_module ! Modifications to Pesticide and Water routing routines by Balaji Narasimhan !Additional buffer and filter strip variables Mike White - real, dimension (:), allocatable :: ubnrunoff - real, dimension (:), allocatable :: ubntss - real, dimension (:,:), allocatable :: ovrlnd_dt - real, dimension (:,:), allocatable :: hhsurfq - real, dimension (:,:,:), allocatable :: hhsurf_bs + real, dimension (:), allocatable :: ubnrunoff + real, dimension (:), allocatable :: ubntss + real, dimension (:,:), allocatable :: ovrlnd_dt + real, dimension (:,:), allocatable :: hhsurfq + real, dimension (:,:,:), allocatable :: hhsurf_bs !! subdaily erosion modeling by Jaehak Jeong - real, dimension(:,:), allocatable:: hhsedy - real, dimension(:), allocatable:: init_abstrc + real, dimension(:,:), allocatable:: hhsedy + real, dimension(:), allocatable:: init_abstrc integer, dimension(:), allocatable :: tillage_switch real, dimension(:), allocatable :: tillage_depth diff --git a/src/hru_salt_output.f90 b/src/hru_salt_output.f90 index 5034569..c3f6128 100644 --- a/src/hru_salt_output.f90 +++ b/src/hru_salt_output.f90 @@ -67,7 +67,7 @@ subroutine hru_salt_output(ihru) hsaltb_d(j)%salt(1)%diss if (pco%csvout == "y") then write (5022,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, & - (hsaltb_d(j)%salt(isalt)%soil,isalt=1,cs_db%num_salts), & + (hsaltb_d(j)%salt(isalt)%soil,isalt=1,cs_db%num_salts), & (hsaltb_d(j)%salt(isalt)%surq,isalt=1,cs_db%num_salts), & (hsaltb_d(j)%salt(isalt)%latq,isalt=1,cs_db%num_salts), & (hsaltb_d(j)%salt(isalt)%urbq,isalt=1,cs_db%num_salts), & diff --git a/src/hru_urb_bmp.f90 b/src/hru_urb_bmp.f90 index 25c63a3..5606b72 100644 --- a/src/hru_urb_bmp.f90 +++ b/src/hru_urb_bmp.f90 @@ -14,12 +14,12 @@ subroutine hru_urb_bmp real :: sednppm = 0. ! | real :: sedpppm = 0. ! | - j = 0 - j = ihru + j = 0 + j = ihru !! convert to ppm -> (kg/ha)*100./mm = ppm if (qdr(j) > 0.1) then - xx = 100. / qdr(j) + xx = 100. / qdr(j) sedppm = 1000. * xx * sedyld(j) / hru(j)%area_ha solnppm = xx * (surqno3(j) + latno3(j)) solpppm = xx * surqsolp(j) @@ -31,7 +31,7 @@ subroutine hru_urb_bmp endif if (solnppm > soln_con(j)) then - surqno3(j) = soln_con(j) / xx + surqno3(j) = soln_con(j) / xx latno3(j) = soln_con(j) / xx endif @@ -44,12 +44,12 @@ subroutine hru_urb_bmp endif if (sedpppm > orgp_con(j)) then - sedorgn(j)= orgp_con(j) / xx + sedorgn(j)= orgp_con(j) / xx sedminpa(j)= orgp_con(j) / xx - sedminps(j)= orgp_con(j) / xx + sedminps(j)= orgp_con(j) / xx endif - endif + endif return end subroutine hru_urb_bmp \ No newline at end of file diff --git a/src/hru_urbanhr.f90 b/src/hru_urbanhr.f90 index 042121b..a8924f2 100644 --- a/src/hru_urbanhr.f90 +++ b/src/hru_urbanhr.f90 @@ -68,7 +68,7 @@ subroutine hru_urbanhr ! |surfaces at the beginning of time step integer :: j = 0 !none |HRU number real :: qdt = 0. ! | - real*8 :: dirt = 0.d0 !kg/curb km |amount of solids built up on impervious + real*8 :: dirt = 0.d0 !kg/curb km |amount of solids built up on impervious ! |surfaces integer :: k = 0 !none |counter integer :: tno3 = 0 ! | @@ -76,14 +76,14 @@ subroutine hru_urbanhr j = ihru ulu = hru(j)%luse%urb_lu - do k = 1, time%step + do k = 1, time%step !! build-up/wash-off algorithm !! rainy day: no build-up, street cleaning allowed - - qdt = ubnrunoff(k) * 60./ real(time%dtm) !urban runoff in mm/hr - if (qdt > 0.025 .and. surfq(j) > 0.1) then ! SWMM : 0.001 in/hr (=0.0254mm/hr) + + qdt = ubnrunoff(k) * 60./ real(time%dtm) !urban runoff in mm/hr + if (qdt > 0.025 .and. surfq(j) > 0.1) then ! SWMM : 0.001 in/hr (=0.0254mm/hr) !! calculate amount of dirt on streets prior to wash-off dirt = 0. @@ -91,7 +91,7 @@ subroutine hru_urbanhr dirto = urbdb(ulu)%dirtmx * twash(j) / (urbdb(ulu)%thalf + twash(j)) !! calculate wash-off of solids - urbk = 0. ! qp_cms -> hhqday for subdaily time steps 6/19/09 JJ + urbk = 0. ! qp_cms -> hhqday for subdaily time steps 6/19/09 JJ urbk = urbdb(ulu)%urbcoef * qdt dirt=dirto * Exp (- urbk * real(time%dtm) / 60.) @@ -119,7 +119,7 @@ subroutine hru_urbanhr (1. - urbdb(ulu)%fimp) surqsolp(j) = .25 * tp * urbdb(ulu)%fimp + surqsolp(j) * & (1. - urbdb(ulu)%fimp) - else + else !! no surface runoff twash(j) = twash(j) + time%dtm / 1440. @@ -135,26 +135,26 @@ subroutine hru_urbanhr end if end if - sus_sol=0 - - ! Compute evaporation of water (initial abstraction) from impervious cover - init_abstrc(j) = init_abstrc(j) - etday / time%step - init_abstrc(j) = max(0.,init_abstrc(j)) - end do + sus_sol=0 + + ! Compute evaporation of water (initial abstraction) from impervious cover + init_abstrc(j) = init_abstrc(j) - etday / time%step + init_abstrc(j) = max(0.,init_abstrc(j)) + end do !! perform street sweeping if(surfq(j) < 0.1) then - if (isweep(j) > 0 .and. time%day >= isweep(j)) then + if (isweep(j) > 0 .and. time%day >= isweep(j)) then call hru_sweep else if (phusw(j) > 0.0001) then if (pcom(j)%plcur(ipl)%gro == "n") then if (phubase(j) > phusw(j)) then - call hru_sweep - endif + call hru_sweep + endif else if (pcom(j)%plcur(1)%phuacc > phusw(j)) then - call hru_sweep - endif + call hru_sweep + endif end if end if end if diff --git a/src/hrudb_init.f90 b/src/hrudb_init.f90 index 155a948..e70a5b4 100644 --- a/src/hrudb_init.f90 +++ b/src/hrudb_init.f90 @@ -2,6 +2,7 @@ subroutine hrudb_init use hydrograph_module, only : sp_ob, sp_ob1, ob use hru_module, only : hru, hru_db + use landuse_data_module implicit none @@ -9,6 +10,8 @@ subroutine hrudb_init integer :: ihru = 0 !none |counter integer :: iob = 0 ! | integer :: ihru_db = 0 ! | + integer :: ilu = 0 ! | + !!assign database pointers for the hru imp = 0 diff --git a/src/hyd_connect.f90 b/src/hyd_connect.f90 index c079363..793f0fd 100644 --- a/src/hyd_connect.f90 +++ b/src/hyd_connect.f90 @@ -296,37 +296,29 @@ subroutine hyd_connect end do !! allocate zero arrays for constituents - allocate (hin_csz%pest(cs_db%num_pests), source = 0) - allocate (hin_csz%path(cs_db%num_paths), source = 0) - allocate (hin_csz%hmet(cs_db%num_metals), source = 0) - - allocate (hin_csz%salt(cs_db%num_salts), source = 0) !rtb salt - - allocate (hin_csz%cs(cs_db%num_cs), source = 0) !rtb se - allocate (hcs1%pest(cs_db%num_pests), source = 0) - - - allocate (hcs1%path(cs_db%num_paths), source = 0) - allocate (hcs1%hmet(cs_db%num_metals), source = 0) - allocate (hcs1%salt(cs_db%num_salts), source = 0) !rtb salt - - allocate (hcs1%cs(cs_db%num_cs), source = 0) !rtb cs - - allocate (hcs2%pest(cs_db%num_pests), source = 0) - allocate (hcs2%path(cs_db%num_paths), source = 0) - allocate (hcs2%hmet(cs_db%num_metals), source = 0) - - allocate (hcs2%salt(cs_db%num_salts), source = 0) !rtb salt - + allocate (hin_csz%pest(cs_db%num_pests), source = 0.) + allocate (hin_csz%path(cs_db%num_paths), source = 0.) + allocate (hin_csz%hmet(cs_db%num_metals), source = 0.) + allocate (hin_csz%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hin_csz%cs(cs_db%num_cs), source = 0.) !rtb se + allocate (hcs1%pest(cs_db%num_pests), source = 0.) + allocate (hcs1%path(cs_db%num_paths), source = 0.) + allocate (hcs1%hmet(cs_db%num_metals), source = 0.) + allocate (hcs1%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hcs1%cs(cs_db%num_cs), source = 0.) !rtb cs - allocate (hcs2%cs(cs_db%num_cs), source = 0) !rtb cs + allocate (hcs2%pest(cs_db%num_pests), source = 0.) + allocate (hcs2%path(cs_db%num_paths), source = 0.) + allocate (hcs2%hmet(cs_db%num_metals), source = 0.) + allocate (hcs2%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hcs2%cs(cs_db%num_cs), source = 0.) !rtb cs - allocate (hcs3%pest(cs_db%num_pests), source = 0) - allocate (hcs3%path(cs_db%num_paths), source = 0) - allocate (hcs3%hmet(cs_db%num_metals), source = 0) - allocate (hcs3%salt(cs_db%num_salts), source = 0) !rtb salt - allocate (hcs3%cs(cs_db%num_cs), source = 0) !rtb cs + allocate (hcs3%pest(cs_db%num_pests), source = 0.) + allocate (hcs3%path(cs_db%num_paths), source = 0.) + allocate (hcs3%hmet(cs_db%num_metals), source = 0.) + allocate (hcs3%salt(cs_db%num_salts), source = 0.) !rtb salt + allocate (hcs3%cs(cs_db%num_cs), source = 0.) !rtb cs hin_csz%pest = 0. hin_csz%path = 0. diff --git a/src/hyd_read_connect.f90 b/src/hyd_read_connect.f90 index 3a87aa6..8e81a69 100644 --- a/src/hyd_read_connect.f90 +++ b/src/hyd_read_connect.f90 @@ -73,7 +73,7 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) ob(i)%trans = hz ob(i)%hin_tot = hz ob(i)%hout_tot = hz - + ob(i)%hd_aa(:) = hz if (cs_db%num_tot > 0) then @@ -100,7 +100,7 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) end if npaths = cs_db%num_paths if (npaths > 0) then - allocate (obcs(i)%hin(1)%path(npaths), source = 0.) + allocate (obcs(i)%hin(1)%path(npaths), source = 0.) allocate (obcs(i)%hin_sur(1)%path(npaths), source = 0.) allocate (obcs(i)%hin_lat(1)%path(npaths), source = 0.) allocate (obcs(i)%hin_til(1)%path(npaths), source = 0.) @@ -143,7 +143,7 @@ subroutine hyd_read_connect(con_file, obtyp, nspu1, nspu, nhyds, ndsave) if (ncs > 0) then allocate (obcs(i)%hin(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin(1)%cs_sorb(ncs), source = 0.) - allocate (obcs(i)%hin(1)%csc(ncs, source = 0.) + allocate (obcs(i)%hin(1)%csc(ncs), source = 0.) allocate (obcs(i)%hin(1)%csc_sorb(ncs), source = 0.) allocate (obcs(i)%hin_sur(1)%cs(ncs), source = 0.) allocate (obcs(i)%hin_sur(1)%cs_sorb(ncs), source = 0.) diff --git a/src/hydrograph_module.f90 b/src/hydrograph_module.f90 index 2cc5618..c67617c 100644 --- a/src/hydrograph_module.f90 +++ b/src/hydrograph_module.f90 @@ -683,7 +683,7 @@ module hydrograph_module type (sol_header) :: sol_hdr type plant_header - character (len=15) :: name = " name " !!none |plant name + character (len=17) :: name = " name " !!none |plant name character (len=15) :: growing = "growing" !!none |plant growing character (len=15) :: dormant = "dormant" !!none |plant dormant character (len=15) :: lai = "lai" !!none |leaf area index @@ -975,47 +975,47 @@ module hydrograph_module character (len=11) :: min = " min " end type output_flow_duration_header type (output_flow_duration_header) :: fdc_hdr - + type calibration_header character (len=16) :: name = " name " character (len=12) :: ha = " ha " character (len=12) :: nbyr = " nbyr " character (len=12) :: prec = " precip " - character (len=16) :: meas = " name " - character (len=12) :: srr = " srr " - character (len=12) :: lfr = " lfr " - character (len=12) :: pcr = " pcr " - character (len=12) :: etr = " etr " - character (len=12) :: tfr = " tfr " - character (len=12) :: sed = " sed " - character (len=12) :: orgn = " orgn " - character (len=12) :: orgp = " orgp " - character (len=12) :: no3 = " no3 " - character (len=12) :: solp = " solp " - character (len=16) :: aa = " name " - character (len=12) :: srr_aa = " srr " - character (len=12) :: lfr_aa = " lfr " - character (len=12) :: pcr_aa = " pcr " - character (len=12) :: etr_aa = " etr " - character (len=12) :: tfr_aa = " tfr " - character (len=12) :: sed_aa = " sed " - character (len=12) :: orgn_aa = " orgn " - character (len=12) :: orgp_aa = " orgp " - character (len=12) :: no3_aa = " no3 " - character (len=12) :: solp_aa = " solp " - character (len=12) :: cn_prm_aa = " cn " - character (len=12) :: esco = " esco " - character (len=12) :: lat_len = "lat_len " - character (len=12) :: petco = " petco " - character (len=12) :: slope = " slope " - character (len=12) :: tconc = " tconc " - character (len=12) :: etco = " etco " - character (len=12) :: perco = " perco " - character (len=12) :: revapc = " revapc " - character (len=12) :: cn3_swf = " cn3_swf " + character (len=16) :: meas = " name " + character (len=12) :: srr = " srr " + character (len=12) :: lfr = " lfr " + character (len=12) :: pcr = " pcr " + character (len=12) :: etr = " etr " + character (len=12) :: tfr = " tfr " + character (len=12) :: sed = " sed " + character (len=12) :: orgn = " orgn " + character (len=12) :: orgp = " orgp " + character (len=12) :: no3 = " no3 " + character (len=12) :: solp = " solp " + character (len=16) :: aa = " name " + character (len=12) :: srr_aa = " srr " + character (len=12) :: lfr_aa = " lfr " + character (len=12) :: pcr_aa = " pcr " + character (len=12) :: etr_aa = " etr " + character (len=12) :: tfr_aa = " tfr " + character (len=12) :: sed_aa = " sed " + character (len=12) :: orgn_aa = " orgn " + character (len=12) :: orgp_aa = " orgp " + character (len=12) :: no3_aa = " no3 " + character (len=12) :: solp_aa = " solp " + character (len=12) :: cn_prm_aa = " cn " + character (len=12) :: esco = " esco " + character (len=12) :: lat_len = "lat_len " + character (len=12) :: petco = " petco " + character (len=12) :: slope = " slope " + character (len=12) :: tconc = " tconc " + character (len=12) :: etco = " etco " + character (len=12) :: perco = " perco " + character (len=12) :: revapc = " revapc " + character (len=12) :: cn3_swf = " cn3_swf " end type calibration_header - type (calibration_header) :: calb_hdr - + type (calibration_header) :: calb_hdr + type calibration2_header character (len=16) :: name = " name " character (len=12) :: dakm2 = " da_km2 " @@ -1050,7 +1050,7 @@ module hydrograph_module character (len=12) :: uslep = " uslep " character (len=12) :: uslels = " uslels " end type calibration2_header - type (calibration2_header) :: calb2_hdr + type (calibration2_header) :: calb2_hdr type calibration3_header character (len=16) :: name = " name " diff --git a/src/input_file_module.f90 b/src/input_file_module.f90 index 80e5f56..3154700 100644 --- a/src/input_file_module.f90 +++ b/src/input_file_module.f90 @@ -20,7 +20,7 @@ module input_file_module character(len=25) :: parms_bas = "parameters.bsn" end type input_basin type (input_basin) :: in_basin - + !! climate type input_cli character(len=25) :: weat_sta = "weather-sta.cli" @@ -95,7 +95,7 @@ module input_file_module character(len=25) :: hru_ez = "hru-lte.hru" end type input_hru type (input_hru) :: in_hru - + !! exco (recall constant) type input_exco character(len=25) :: exco = "exco.exc" @@ -106,7 +106,7 @@ module input_file_module character(len=25) :: salt = "exco_salt.exc" end type input_exco type (input_exco) :: in_exco - + !! recall (daily, monthly and annual) type input_rec character(len=25) :: recall_rec = "recall.rec" @@ -116,11 +116,11 @@ module input_file_module !! delivery ratio type input_delr character(len=25) :: del_ratio = "delratio.del" - character(len=25) :: om = "dr_om.del" - character(len=25) :: pest = "dr_pest.del" - character(len=25) :: path = "dr_path.del" - character(len=25) :: hmet = "dr_hmet.del" - character(len=25) :: salt = "dr_salt.del" + character(len=25) :: om = "dr_om.del" + character(len=25) :: pest = "dr_pest.del" + character(len=25) :: path = "dr_path.del" + character(len=25) :: hmet = "dr_hmet.del" + character(len=25) :: salt = "dr_salt.del" end type input_delr type (input_delr) :: in_delr @@ -178,9 +178,9 @@ module input_file_module character(len=25) :: fert_frt = "fertilizer.frt" character(len=25) :: till_til = "tillage.til" character(len=25) :: pest = "pesticide.pes" - character(len=25) :: pathcom_db = "pathogens.pth" - character(len=25) :: hmetcom_db = "metals.mtl" - character(len=25) :: saltcom_db = "salt.slt" + character(len=25) :: pathcom_db = "pathogens.pth" + character(len=25) :: hmetcom_db = "metals.mtl" + character(len=25) :: saltcom_db = "salt.slt" character(len=25) :: urban_urb = "urban.urb" character(len=25) :: septic_sep = "septic.sep" character(len=25) :: snow = "snow.sno" @@ -224,17 +224,17 @@ module input_file_module !! initial conditions type input_init - character(len=25) :: plant = "plant.ini" + character(len=25) :: plant = "plant.ini" character(len=25) :: soil_plant_ini = "soil_plant.ini" character(len=25) :: om_water = "om_water.ini" - character(len=25) :: pest_soil = "pest_hru.ini" - character(len=25) :: pest_water = "pest_water.ini" - character(len=25) :: path_soil = "path_hru.ini" - character(len=25) :: path_water = "path_water.ini" - character(len=25) :: hmet_soil = "hmet_hru.ini" - character(len=25) :: hmet_water = "hmet_water.ini" - character(len=25) :: salt_soil = "salt_hru.ini" - character(len=25) :: salt_water = "salt_water.ini" + character(len=25) :: pest_soil = "pest_hru.ini" + character(len=25) :: pest_water = "pest_water.ini" + character(len=25) :: path_soil = "path_hru.ini" + character(len=25) :: path_water = "path_water.ini" + character(len=25) :: hmet_soil = "hmet_hru.ini" + character(len=25) :: hmet_water = "hmet_water.ini" + character(len=25) :: salt_soil = "salt_hru.ini" + character(len=25) :: salt_water = "salt_water.ini" end type input_init type (input_init) :: in_init diff --git a/src/lcu_read_softcal.f90 b/src/lcu_read_softcal.f90 index 033969d..c001615 100644 --- a/src/lcu_read_softcal.f90 +++ b/src/lcu_read_softcal.f90 @@ -25,7 +25,7 @@ subroutine lcu_read_softcal imax = 0 mcal = 0 mreg = 0 - + inquire (file=in_chg%water_balance_sft, exist=i_exist) if (.not. i_exist .or. in_chg%water_balance_sft == "null") then allocate (lscal(0:0)) diff --git a/src/ls_read_parms_cal.f90 b/src/ls_read_parms_cal.f90 index 266c50d..8ff6629 100644 --- a/src/ls_read_parms_cal.f90 +++ b/src/ls_read_parms_cal.f90 @@ -38,7 +38,7 @@ subroutine ls_read_lsparms_cal if (eof < 0) exit end do - end if + end if close(107) return diff --git a/src/lsu_read_elements.f90 b/src/lsu_read_elements.f90 index 9bc6af1..1d6346c 100644 --- a/src/lsu_read_elements.f90 +++ b/src/lsu_read_elements.f90 @@ -90,7 +90,7 @@ subroutine lsu_read_elements exit end do - end if + end if !!read data for each element in all landscape cataloging units inquire (file=in_regs%ele_lsu, exist=i_exist) diff --git a/src/manure_allocation_module.f90 b/src/manure_allocation_module.f90 index c891a13..e6401bf 100644 --- a/src/manure_allocation_module.f90 +++ b/src/manure_allocation_module.f90 @@ -66,55 +66,55 @@ module manure_allocation_module type (manure_allocation), dimension(:), allocatable :: mallo !dimension by water allocation objects type mallo_header - character(len=6) :: day = " jday" - character(len=6) :: mo = " mon" - character(len=6) :: day_mo = " day " - character(len=6) :: yrc = " yr " - character(len=8) :: idmd = " unit " - character(len=16) :: dmd_typ = "dmd_typ " - character(len=16) :: dmd_num = " dmd_num " + character(len=6) :: day = " jday" + character(len=6) :: mo = " mon" + character(len=6) :: day_mo = " day " + character(len=6) :: yrc = " yr " + character(len=8) :: idmd = " unit " + character(len=16) :: dmd_typ = "dmd_typ " + character(len=16) :: dmd_num = " dmd_num " character(len=12) :: src1_obj = " src1_obj " - character(len=12) :: src1_typ = " src1_typ " - character(len=12) :: src1_num = " src1_num " - character(len=15) :: dmd1 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src1_typ = " src1_typ " + character(len=12) :: src1_num = " src1_num " + character(len=15) :: dmd1 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s1out = "src1_withdraw " !! ha-m |withdrawal from source 1 character(len=12) :: s1un = " src1_unmet" !! ha-m |unmet from source 1 - character(len=12) :: src2_typ = " src2_typ " - character(len=12) :: src2_num = " src2_num " - character(len=15) :: dmd2 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src2_typ = " src2_typ " + character(len=12) :: src2_num = " src2_num " + character(len=15) :: dmd2 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s2out = "src2_withdraw " !! ha-m |withdrawal from source 2 character(len=12) :: s2un = " src2_unmet" !! ha-m |unmet from source 2 - character(len=12) :: src3_typ = " src3_typ " - character(len=12) :: src3_num = " src3_num " - character(len=15) :: dmd3 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src3_typ = " src3_typ " + character(len=12) :: src3_num = " src3_num " + character(len=15) :: dmd3 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s3out = "src3_withdraw " !! ha-m |withdrawal from source 3 character(len=12) :: s3un = " src3_unmet" !! ha-m |unmet from source 3 end type mallo_header type (mallo_header) :: mallo_hdr type mallo_header_units - character (len=8) :: day = " " - character (len=8) :: mo = " " - character (len=8) :: day_mo = " " - character (len=8) :: yrc = " " - character (len=8) :: idmd = " " - character (len=16) :: dmd_typ = " " - character (len=16) :: dmd_num = " " + character (len=8) :: day = " " + character (len=8) :: mo = " " + character (len=8) :: day_mo = " " + character (len=8) :: yrc = " " + character (len=8) :: idmd = " " + character (len=16) :: dmd_typ = " " + character (len=16) :: dmd_num = " " character (len=12) :: src1_obj = " " - character (len=12) :: src1_typ = " " - character (len=8) :: src1_num = " " + character (len=12) :: src1_typ = " " + character (len=8) :: src1_num = " " character (len=15) :: dmd1 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s1out = "m^3 " !! ha-m |withdrawal from source 1 + character (len=15) :: s1out = "m^3 " !! ha-m |withdrawal from source 1 character (len=9) :: s1un = "m^3 " !! ha-m |unmet from source 1 - character (len=15) :: src2_typ = " " - character (len=15) :: src2_num = " " + character (len=15) :: src2_typ = " " + character (len=15) :: src2_num = " " character (len=15) :: dmd2 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 + character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 character (len=10) :: s2un = "m^3 " !! ha-m |unmet from source 2 - character (len=15) :: src3_typ = " " - character (len=15) :: src3_num = " " + character (len=15) :: src3_typ = " " + character (len=15) :: src3_num = " " character (len=15) :: dmd3 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 + character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 character (len=10) :: s3un = "m^3 " !! ha-m |unmet from source 3 end type mallo_header_units type (mallo_header_units) :: mallo_hdr_units diff --git a/src/mgt_killop.f90 b/src/mgt_killop.f90 index 10ad6fc..8dc7aff 100644 --- a/src/mgt_killop.f90 +++ b/src/mgt_killop.f90 @@ -27,7 +27,7 @@ subroutine mgt_killop (jj, iplant) !! allocate dead roots, N, P to soil layers do ly = 1, soil(j)%nly - soil1(j)%rsd(ly) = soil(j)%ly(ly)%rtfr * pl_mass(j)%root(ipl) + soil1(j)%rsd(ly) + soil1(j)%rsd(ly) = soil(j)%ly(ly)%rtfr * pl_mass(j)%root(ipl) + soil1(j)%rsd(ly) end do !! add above ground mass to residue pool diff --git a/src/mgt_newtillmix.f90 b/src/mgt_newtillmix.f90 index 282ccc5..e18d202 100644 --- a/src/mgt_newtillmix.f90 +++ b/src/mgt_newtillmix.f90 @@ -124,8 +124,8 @@ subroutine mgt_newtillmix (jj, bmix, idtill) if (soil(jj)%phys(l)%d <= dtil) then !! msm = mass of soil mixed for the layer - !! msn = mass of soil not mixed for the layer - sol_msm(l) = emix * sol_mass(l) + !! msn = mass of soil not mixed for the layer + sol_msm(l) = emix * sol_mass(l) sol_msn(l) = sol_mass(l) - sol_msm(l) frac_dep(l) = soil(jj)%phys(l)%thick / dtil else if (soil(jj)%phys(l)%d > dtil .and. soil(jj)%phys(l-1)%d < dtil) then @@ -165,21 +165,21 @@ subroutine mgt_newtillmix (jj, bmix, idtill) !!by zhang !!============== if (bsn_cc%cswat == 2) then - smix(20+npmx+1) = smix(20+npmx+1) + soil1(jj)%str(l)%c * frac_mixed - smix(20+npmx+2) = smix(20+npmx+2) + soil1(jj)%lig(l)%c * frac_mixed - smix(20+npmx+3) = smix(20+npmx+3) + soil1(jj)%lig(l)%n* frac_mixed - smix(20+npmx+4) = smix(20+npmx+4) + soil1(jj)%meta(l)%c * frac_mixed - smix(20+npmx+5) = smix(20+npmx+5) + soil1(jj)%meta(l)%m * frac_mixed - smix(20+npmx+6) = smix(20+npmx+6) + soil1(jj)%lig(l)%m * frac_mixed - smix(20+npmx+7) = smix(20+npmx+7) + soil1(jj)%str(l)%m * frac_mixed - - smix(20+npmx+8) = smix(20+npmx+8) + soil1(jj)%str(l)%n * frac_mixed - smix(20+npmx+9) = smix(20+npmx+9) + soil1(jj)%meta(l)%n * frac_mixed - smix(20+npmx+10) = smix(20+npmx+10) +soil1(jj)%microb(l)%n* frac_mixed - smix(20+npmx+11) = smix(20+npmx+11) + soil1(jj)%hact(l)%n * frac_mixed - smix(20+npmx+12) = smix(20+npmx+12) + soil1(jj)%hsta(l)%n * frac_mixed - end if - !!by zhang + smix(20+npmx+1) = smix(20+npmx+1) + soil1(jj)%str(l)%c * frac_mixed + smix(20+npmx+2) = smix(20+npmx+2) + soil1(jj)%lig(l)%c * frac_mixed + smix(20+npmx+3) = smix(20+npmx+3) + soil1(jj)%lig(l)%n* frac_mixed + smix(20+npmx+4) = smix(20+npmx+4) + soil1(jj)%meta(l)%c * frac_mixed + smix(20+npmx+5) = smix(20+npmx+5) + soil1(jj)%meta(l)%m * frac_mixed + smix(20+npmx+6) = smix(20+npmx+6) + soil1(jj)%lig(l)%m * frac_mixed + smix(20+npmx+7) = smix(20+npmx+7) + soil1(jj)%str(l)%m * frac_mixed + + smix(20+npmx+8) = smix(20+npmx+8) + soil1(jj)%str(l)%n * frac_mixed + smix(20+npmx+9) = smix(20+npmx+9) + soil1(jj)%meta(l)%n * frac_mixed + smix(20+npmx+10) = smix(20+npmx+10) +soil1(jj)%microb(l)%n* frac_mixed + smix(20+npmx+11) = smix(20+npmx+11) + soil1(jj)%hact(l)%n * frac_mixed + smix(20+npmx+12) = smix(20+npmx+12) + soil1(jj)%hsta(l)%n * frac_mixed + end if + !!by zhang !!============= end do @@ -189,7 +189,7 @@ subroutine mgt_newtillmix (jj, bmix, idtill) smix(19) = smix(19) / dtil do l = 1, soil(jj)%nly - + ! reconstitute each soil layer frac_non_mixed = sol_msn(l) / sol_mass(l) @@ -234,8 +234,8 @@ subroutine mgt_newtillmix (jj, bmix, idtill) !!by zhang !!============== - end do - + end do + if (bsn_cc%cswat == 1) then call mgt_tillfactor(jj,bmix,emix,dtil) end if diff --git a/src/mgt_newtillmix_wet.f90 b/src/mgt_newtillmix_wet.f90 index 80d84bc..95cd2e6 100644 --- a/src/mgt_newtillmix_wet.f90 +++ b/src/mgt_newtillmix_wet.f90 @@ -94,8 +94,8 @@ subroutine mgt_newtillmix_wet (jj, idtill) if (soil(jj)%phys(l)%d <= dtil) then !! msm = mass of soil mixed for the layer - !! msn = mass of soil not mixed for the layer - sol_msm(l) = emix * sol_mass(l) + !! msn = mass of soil not mixed for the layer + sol_msm(l) = emix * sol_mass(l) sol_msn(l) = sol_mass(l) - sol_msm(l) frac_dep(l) = soil(jj)%phys(l)%thick / dtil frac_dep1(l) = soil(jj)%phys(l)%thick / tdep @@ -137,20 +137,20 @@ subroutine mgt_newtillmix_wet (jj, idtill) !!by zhang !!============== if (bsn_cc%cswat == 2) then - smix(20+npmx+1) = smix(20+npmx+1) + soil1(jj)%str(l)%c * frac_mixed - smix(20+npmx+2) = smix(20+npmx+2) + soil1(jj)%lig(l)%c * frac_mixed - smix(20+npmx+3) = smix(20+npmx+3) + soil1(jj)%lig(l)%n* frac_mixed - smix(20+npmx+4) = smix(20+npmx+4) + soil1(jj)%meta(l)%c * frac_mixed - smix(20+npmx+5) = smix(20+npmx+5) + soil1(jj)%meta(l)%m * frac_mixed - smix(20+npmx+6) = smix(20+npmx+6) + soil1(jj)%lig(l)%m * frac_mixed - smix(20+npmx+7) = smix(20+npmx+7) + soil1(jj)%str(l)%m * frac_mixed - - smix(20+npmx+8) = smix(20+npmx+8) + soil1(jj)%str(l)%n * frac_mixed - smix(20+npmx+9) = smix(20+npmx+9) + soil1(jj)%meta(l)%n * frac_mixed - smix(20+npmx+10) = smix(20+npmx+10) +soil1(jj)%microb(l)%n* frac_mixed - smix(20+npmx+11) = smix(20+npmx+11) + soil1(jj)%hact(l)%n * frac_mixed - smix(20+npmx+12) = smix(20+npmx+12) + soil1(jj)%hsta(l)%n * frac_mixed - end if + smix(20+npmx+1) = smix(20+npmx+1) + soil1(jj)%str(l)%c * frac_mixed + smix(20+npmx+2) = smix(20+npmx+2) + soil1(jj)%lig(l)%c * frac_mixed + smix(20+npmx+3) = smix(20+npmx+3) + soil1(jj)%lig(l)%n* frac_mixed + smix(20+npmx+4) = smix(20+npmx+4) + soil1(jj)%meta(l)%c * frac_mixed + smix(20+npmx+5) = smix(20+npmx+5) + soil1(jj)%meta(l)%m * frac_mixed + smix(20+npmx+6) = smix(20+npmx+6) + soil1(jj)%lig(l)%m * frac_mixed + smix(20+npmx+7) = smix(20+npmx+7) + soil1(jj)%str(l)%m * frac_mixed + + smix(20+npmx+8) = smix(20+npmx+8) + soil1(jj)%str(l)%n * frac_mixed + smix(20+npmx+9) = smix(20+npmx+9) + soil1(jj)%meta(l)%n * frac_mixed + smix(20+npmx+10) = smix(20+npmx+10) +soil1(jj)%microb(l)%n* frac_mixed + smix(20+npmx+11) = smix(20+npmx+11) + soil1(jj)%hact(l)%n * frac_mixed + smix(20+npmx+12) = smix(20+npmx+12) + soil1(jj)%hsta(l)%n * frac_mixed + end if end do ! sand, silt and clay are % so divide by tillage depth @@ -167,7 +167,7 @@ subroutine mgt_newtillmix_wet (jj, idtill) do l = 1, soil(jj)%nly - + ! reconstitute each soil layer frac_non_mixed = sol_msn(l) / sol_mass(l) @@ -209,8 +209,8 @@ subroutine mgt_newtillmix_wet (jj, idtill) soil1(jj)%hact(l)%n = soil1(jj)%hact(l)%n * frac_non_mixed + smix(20 + npmx + 11) * frac_dep(l) soil1(jj)%hsta(l)%n = soil1(jj)%hsta(l)%n * frac_non_mixed + smix(20 + npmx+12) * frac_dep(l) end if - end do - + end do + !if (bsn_cc%cswat == 1) then ! call mgt_tillfactor(jj,bmix,emix,dtil) !end if diff --git a/src/mgt_sched.f90 b/src/mgt_sched.f90 index 20861d1..9484244 100644 --- a/src/mgt_sched.f90 +++ b/src/mgt_sched.f90 @@ -443,7 +443,7 @@ subroutine mgt_sched (isched) endif case ("irrp") !! continuous irrigation to maintain surface ponding in rice fields Jaehak 2022 - hru(j)%irr_src = mgt%op_plant !irrigation source: cha; res; aqu; or unlim + hru(j)%irr_src = mgt%op_plant !irrigation source: cha; res; aqu; or unlim hru(j)%irr_isc = mgt%op3 !irrigation source object ID: cha; res; aqu; or unlim hru(j)%irr_hmax = irrop_db(mgt%op1)%amt_mm !irrigation amount in irr.org, mm hru(j)%irr_hmin = hru(j)%irr_hmax * 0.9 !threshold ponding depth, mm diff --git a/src/mgt_tillfactor.f90 b/src/mgt_tillfactor.f90 index eff98c8..08d6df8 100644 --- a/src/mgt_tillfactor.f90 +++ b/src/mgt_tillfactor.f90 @@ -1,24 +1,24 @@ subroutine mgt_tillfactor(jj,bmix,emix,dtil) - !!!!!!!!!!!!!!!!!!!!!!! - ! Armen 16 January 2008 - ! This procedure increases tillage factor (tillagef(l,jj) per layer for each operation - ! The tillage factor settling will depend of soil moisture (tentatively) and must be called every day - ! For simplicity the settling is calculated now at the soil carbon subroutine because soil water content is available + !!!!!!!!!!!!!!!!!!!!!!! + ! Armen 16 January 2008 + ! This procedure increases tillage factor (tillagef(l,jj) per layer for each operation + ! The tillage factor settling will depend of soil moisture (tentatively) and must be called every day + ! For simplicity the settling is calculated now at the soil carbon subroutine because soil water content is available - ! The tillage factor depends on the cumulative soil disturbance rating = csdr - ! For simplicity, csdr is a function of emix - ! First step is to calculate "current" csdr by inverting tillage factor function - ! The effect of texture on tillage factor (ZZ) is removed first (and recovered at the end of the procedure) - ! YY = tillagef(l,jj) / ZZ - ! Since the tillage factor function is non linear, iterations are needed - ! XX = 0.5 is the initial value that works OK for the range of values observed - ! If a layer is only partially tilled then emix is corrected accordingly + ! The tillage factor depends on the cumulative soil disturbance rating = csdr + ! For simplicity, csdr is a function of emix + ! First step is to calculate "current" csdr by inverting tillage factor function + ! The effect of texture on tillage factor (ZZ) is removed first (and recovered at the end of the procedure) + ! YY = tillagef(l,jj) / ZZ + ! Since the tillage factor function is non linear, iterations are needed + ! XX = 0.5 is the initial value that works OK for the range of values observed + ! If a layer is only partially tilled then emix is corrected accordingly - use soil_module + use soil_module implicit none - integer, intent (in) :: jj !none |HRU number + integer, intent (in) :: jj !none |HRU number real, intent (in) :: bmix !none |biological mixing efficiency: this ! |number is zero for tillage operations integer :: l = 0 !none |counter @@ -34,43 +34,43 @@ subroutine mgt_tillfactor(jj,bmix,emix,dtil) real :: xx2 = 0. ! | real :: csdr = 0. ! | - emix = emix - bmix ! this is to avoid affecting tillage factor with biological mixing - - if (emix > 0.) then + emix = emix - bmix ! this is to avoid affecting tillage factor with biological mixing + + if (emix > 0.) then - do l = 1, soil(j)%nly - - if (soil(jj)%phys(l)%d <= dtil) then - emix = emix + do l = 1, soil(j)%nly + + if (soil(jj)%phys(l)%d <= dtil) then + emix = emix else if (soil(jj)%phys(l)%d > dtil .and. soil(jj)%phys(l-1)%d < dtil) then - emix = emix * (dtil - soil(jj)%phys(l-1)%d) / soil(jj)%phys(l)%thick - else - emix = 0. - end if - - ! to save computation time if emix = 0 here then the other layers can be avoided - ! tillage always proceeds from top to bottom - if (emix == 0.) exit + emix = emix * (dtil - soil(jj)%phys(l-1)%d) / soil(jj)%phys(l)%thick + else + emix = 0. + end if + + ! to save computation time if emix = 0 here then the other layers can be avoided + ! tillage always proceeds from top to bottom + if (emix == 0.) exit - xx = 0. - zz = 3. + (8. - 3.)*exp(-5.5*soil(jj)%phys(1)%clay/100.) - yy = soil(jj)%ly(l)%tillagef / zz - m1 = 1 - m2 = 2 + xx = 0. + zz = 3. + (8. - 3.)*exp(-5.5*soil(jj)%phys(1)%clay/100.) + yy = soil(jj)%ly(l)%tillagef / zz + m1 = 1 + m2 = 2 - ! empirical solution for x when y is known and y=x/(x+exp(m1-m2*x)) - if (yy > 0.01) then - xx1 = yy ** exp(-0.13 + 1.06 * yy) - xx2 = exp(0.64 + 0.64 * yy ** 100.) - xx = xx1 * xx2 - end if + ! empirical solution for x when y is known and y=x/(x+exp(m1-m2*x)) + if (yy > 0.01) then + xx1 = yy ** exp(-0.13 + 1.06 * yy) + xx2 = exp(0.64 + 0.64 * yy ** 100.) + xx = xx1 * xx2 + end if - csdr = xx + emix - soil(jj)%ly(l)%tillagef = zz * (csdr / (csdr + exp(m1 - m2*csdr))) + csdr = xx + emix + soil(jj)%ly(l)%tillagef = zz * (csdr / (csdr + exp(m1 - m2*csdr))) - end do - - end if - - return - end subroutine mgt_tillfactor \ No newline at end of file + end do + + end if + + return + end subroutine mgt_tillfactor \ No newline at end of file diff --git a/src/nut_denit.f90 b/src/nut_denit.f90 index 57f1821..8271a18 100644 --- a/src/nut_denit.f90 +++ b/src/nut_denit.f90 @@ -7,19 +7,19 @@ subroutine nut_denit(k,j,cdg,wdn,void) implicit none - integer :: k !none |counter + integer :: k !none |counter integer :: j !none |HRU number - real :: cdg !none |soil temperature factor + real :: cdg !none |soil temperature factor real :: wdn !kg N/ha |amount of nitrogen lost from nitrate pool in ! |layer due to denitrification real :: void ! | real :: vof = 0. ! | wdn = 0. - vof = 1. / (1. + (void/0.04)**5) - wdn = soil1(j)%mn(k)%no3 * (1. - Exp(-bsn_prm%cdn * cdg * vof * & + vof = 1. / (1. + (void/0.04)**5) + wdn = soil1(j)%mn(k)%no3 * (1. - Exp(-bsn_prm%cdn * cdg * vof * & soil1(j)%tot(k)%c)) - soil1(j)%mn(k)%no3 = max(0.0001,soil1(j)%mn(k)%no3 - wdn) + soil1(j)%mn(k)%no3 = max(0.0001,soil1(j)%mn(k)%no3 - wdn) - return - end subroutine nut_denit \ No newline at end of file + return + end subroutine nut_denit \ No newline at end of file diff --git a/src/nut_nlch.f90 b/src/nut_nlch.f90 index 382f434..6c5acb5 100644 --- a/src/nut_nlch.f90 +++ b/src/nut_nlch.f90 @@ -71,7 +71,7 @@ subroutine nut_nlch !! add nitrate leached from layer above soil1(j)%mn(jj)%no3 = soil1(j)%mn(jj)%no3 + percnlyr - if (soil1(j)%mn(jj)%no3 < 1.e-6) soil1(j)%mn(jj)%no3 = 0.0 + if (soil1(j)%mn(jj)%no3 < 1.e-6) soil1(j)%mn(jj)%no3 = 0.0 !! determine concentration of nitrate in mobile water if (jj == 1) then diff --git a/src/nut_nminrl.f90 b/src/nut_nminrl.f90 index 6e7204e..5ffc610 100644 --- a/src/nut_nminrl.f90 +++ b/src/nut_nminrl.f90 @@ -104,7 +104,7 @@ subroutine nut_nminrl end if !! compute soil water factor - if (soil(j)%phys(1)%st < 0.) soil(j)%phys(1)%st = .0000001 + if (soil(j)%phys(1)%st < 0.) soil(j)%phys(1)%st = .0000001 sut = .1 + .9 * Sqrt(soil(j)%phys(1)%st / soil(j)%phys(1)%fc) sut = Max(.05, sut) @@ -170,8 +170,8 @@ subroutine nut_nminrl if (soil(j)%phys(kk)%tmp > 0.) then !! compute soil water factor sut = 0. - !! change for domain error 1/29/09 gsm check with Jeff !!! - if (soil(j)%phys(kk)%st < 0.) soil(j)%phys(kk)%st = .0000001 + !! change for domain error 1/29/09 gsm check with Jeff !!! + if (soil(j)%phys(kk)%st < 0.) soil(j)%phys(kk)%st = .0000001 sut = .1 + .9 * Sqrt(soil(j)%phys(kk)%st / soil(j)%phys(kk)%fc) sut = Max(.05, sut) @@ -269,13 +269,13 @@ subroutine nut_nminrl !! compute denitrification wdn = 0. - if (i_sep(j) /= k .or. sep(isep)%opt /= 1) then - if (sut >= bsn_prm%sdnco) then - wdn = soil1(j)%mn(k)%no3 * (1.-Exp(-bsn_prm%cdn * cdg * soil1(j)%cbn(k) / 100.)) - else - wdn = 0. - endif - soil1(j)%mn(k)%no3 = max(0.0001,soil1(j)%mn(k)%no3 - wdn) + if (i_sep(j) /= k .or. sep(isep)%opt /= 1) then + if (sut >= bsn_prm%sdnco) then + wdn = soil1(j)%mn(k)%no3 * (1.-Exp(-bsn_prm%cdn * cdg * soil1(j)%cbn(k) / 100.)) + else + wdn = 0. + endif + soil1(j)%mn(k)%no3 = max(0.0001,soil1(j)%mn(k)%no3 - wdn) end if hnb_d(j)%denit = hnb_d(j)%denit + wdn diff --git a/src/nut_orgnc.f90 b/src/nut_orgnc.f90 index e2997a9..7e752ea 100644 --- a/src/nut_orgnc.f90 +++ b/src/nut_orgnc.f90 @@ -42,12 +42,12 @@ subroutine nut_orgnc conc = xx * er / wt1 sedorgn(j) = .001 * conc * sedyld(j) / hru(j)%area_ha - !! update soil nitrogen pools only for HRU calculations + !! update soil nitrogen pools only for HRU calculations if (xx > 1.e-6) then xx1 = (1. - sedorgn(j) / xx) - soil1(j)%tot(1)%n = soil1(j)%tot(1)%n * xx1 - rsd1(j)%tot(1)%n = rsd1(j)%tot(1)%n * xx1 - rsd1(j)%man%n = rsd1(j)%man%n * xx1 + soil1(j)%tot(1)%n = soil1(j)%tot(1)%n * xx1 + rsd1(j)%tot(1)%n = rsd1(j)%tot(1)%n * xx1 + rsd1(j)%man%n = rsd1(j)%man%n * xx1 end if return diff --git a/src/nut_orgnc2.f90 b/src/nut_orgnc2.f90 index 6716e52..87b14ea 100644 --- a/src/nut_orgnc2.f90 +++ b/src/nut_orgnc2.f90 @@ -60,8 +60,8 @@ subroutine nut_orgnc2 latc_clyr = 0. perc_clyr = 0. - wt1 = 0. !! conversion factor - er = 0. !! enrichment ratio + wt1 = 0. !! conversion factor + er = 0. !! enrichment ratio !! HRU calculations c_ly1 = rsd1(j)%tot_str%n + rsd1(j)%tot_meta%n + soil1(j)%hp(1)%n + soil1(j)%hs(1)%n !wt = sol_bd(1,j) * sol_z(1,j) * 10. (tons/ha) @@ -79,17 +79,17 @@ subroutine nut_orgnc2 !! HRU calculations sedorgn(j) = .001 * conc * sedyld(j) / hru(j)%area_ha - !! update soil nitrogen pools only for HRU calculations + !! update soil nitrogen pools only for HRU calculations if (xx > 1.e-6) then xx1 = (1. - sedorgn(j) / xx) !!add by zhang to update soil nitrogen pools - rsd1(j)%tot_str%n = rsd1(j)%tot_str%n * xx1 - rsd1(j)%tot_meta%n = rsd1(j)%tot_meta%n * xx1 - soil1(j)%hp(1)%n = soil1(j)%hp(1)%n * xx1 - soil1(j)%hs(1)%n = soil1(j)%hs(1)%n * xx1 - !sol_BMN(1,j) = sol_BMN(1,j) * xx1 + rsd1(j)%tot_str%n = rsd1(j)%tot_str%n * xx1 + rsd1(j)%tot_meta%n = rsd1(j)%tot_meta%n * xx1 + soil1(j)%hp(1)%n = soil1(j)%hp(1)%n * xx1 + soil1(j)%hs(1)%n = soil1(j)%hs(1)%n * xx1 + !sol_BMN(1,j) = sol_BMN(1,j) * xx1 end if !return @@ -111,10 +111,10 @@ subroutine nut_orgnc2 ! Not sure whether should consider enrichment ratio or not! YEW = MIN((sedyld(j)/hru(j)%area_ha+YW/hru(j)%area_ha)/(sol_mass/1000.),.9) !fraction of soil erosion of total soil mass X1=1.-YEW - !YEW=MIN(ER*(YSD(NDRV)+YW)/WT(LD1),.9) - !ER enrichment ratio - !YSD water erosion - !YW wind erosion + !YEW=MIN(ER*(YSD(NDRV)+YW)/WT(LD1),.9) + !ER enrichment ratio + !YSD water erosion + !YW wind erosion YOC=YEW*TOT soil1(j)%hs(1)%c = soil1(j)%hs(1)%c * X1 soil1(j)%hp(1)%c = soil1(j)%hp(1)%c * X1 @@ -138,7 +138,7 @@ subroutine nut_orgnc2 XX=X1+DK !V=QD+Y4 V = surfq(j) + soil(j)%ly(1)%prk + soil(j)%ly(1)%flat - !QD surface runoff + !QD surface runoff X3=0. IF(V>1.E-10)THEN X3 = soil1(j)%microb(1)%c * (1.-EXP(-V/XX)) !loss of biomass C diff --git a/src/nut_pminrl2.f90 b/src/nut_pminrl2.f90 index 2ec1458..1e188c8 100644 --- a/src/nut_pminrl2.f90 +++ b/src/nut_pminrl2.f90 @@ -26,14 +26,14 @@ subroutine nut_pminrl2 ! |mineral to the stable mineral pool in the soil layer real :: wetness = 0. ! | real :: base = 0. ! | - real :: vara = 0. ! |Intermediate Variable - real :: varb = 0. ! |Intermediate Variable - real :: varc = 0. ! |Intermediate Variable + real :: vara = 0. ! |Intermediate Variable + real :: varb = 0. ! |Intermediate Variable + real :: varc = 0. ! |Intermediate Variable real :: as_p_coeff = 0. ! | - real :: solp = 0. !mg/kg |Solution pool phosphorous content - real :: actpp = 0. !mg/kg |Active pool phosphorous content - real :: stap = 0. !mg/kg |Stable pool phosphorous content - real :: arate = 0. ! |Intermediate Variable + real :: solp = 0. !mg/kg |Solution pool phosphorous content + real :: actpp = 0. !mg/kg |Active pool phosphorous content + real :: stap = 0. !mg/kg |Stable pool phosphorous content + real :: arate = 0. ! |Intermediate Variable real :: ssp = 0. ! | real :: psp = 0. ! | @@ -42,126 +42,126 @@ subroutine nut_pminrl2 hnb_d(j)%lab_min_p = 0. hnb_d(j)%act_sta_p = 0. do l = 1, soil(j)%nly !! loop through soil layers in this HRU - !! make sure that no zero or negative pool values come in - if (soil1(j)%mp(l)%lab <= 1.e-6) soil1(j)%mp(l)%lab = 1.e-6 - if (soil1(j)%mp(l)%act <= 1.e-6) soil1(j)%mp(l)%act = 1.e-6 + !! make sure that no zero or negative pool values come in + if (soil1(j)%mp(l)%lab <= 1.e-6) soil1(j)%mp(l)%lab = 1.e-6 + if (soil1(j)%mp(l)%act <= 1.e-6) soil1(j)%mp(l)%act = 1.e-6 if (soil1(j)%mp(l)%sta <= 1.e-6) soil1(j)%mp(l)%sta = 1.e-6 !! Convert kg/ha to ppm so that it is more meaningful to compare between soil layers - solp = soil1(j)%mp(l)%lab / soil(j)%phys(l)%conv_wt - actpp = soil1(j)%mp(l)%act / soil(j)%phys(l)%conv_wt - stap = soil1(j)%mp(l)%sta / soil(j)%phys(l)%conv_wt - -!! ***************Soluble - Active Transformations*************** - - !! Dynamic PSP Ratio - !!PSP = -0.045*log (% clay) + 0.001*(Solution P, mg kg-1) - 0.035*(% Organic C) + 0.43 - if (soil(j)%phys(l)%clay > 0.) then - psp = -0.045 * log(soil(j)%phys(l)%clay)+ (0.001 * solp) - psp = psp - (0.035 * soil1(j)%cbn(l)) + 0.43 - else - psp = 0.4 - end if - !! Limit PSP range - if (psp < .1) psp = 0.1 ! limits on PSP - if (psp > 0.7) psp = 0.7 + solp = soil1(j)%mp(l)%lab / soil(j)%phys(l)%conv_wt + actpp = soil1(j)%mp(l)%act / soil(j)%phys(l)%conv_wt + stap = soil1(j)%mp(l)%sta / soil(j)%phys(l)%conv_wt + +!! ***************Soluble - Active Transformations*************** + + !! Dynamic PSP Ratio + !!PSP = -0.045*log (% clay) + 0.001*(Solution P, mg kg-1) - 0.035*(% Organic C) + 0.43 + if (soil(j)%phys(l)%clay > 0.) then + psp = -0.045 * log(soil(j)%phys(l)%clay)+ (0.001 * solp) + psp = psp - (0.035 * soil1(j)%cbn(l)) + 0.43 + else + psp = 0.4 + end if + !! Limit PSP range + if (psp < .1) psp = 0.1 ! limits on PSP + if (psp > 0.7) psp = 0.7 !! Calculate smoothed PSP average - if (soil(j)%ly(l)%psp_store > 0.) then - psp = (soil(j)%ly(l)%psp_store * 29. + psp * 1.) / 30. - end if + if (soil(j)%ly(l)%psp_store > 0.) then + psp = (soil(j)%ly(l)%psp_store * 29. + psp * 1.) / 30. + end if !! Store PSP for tomrrows smoothing calculation - soil(j)%ly(l)%psp_store = psp + soil(j)%ly(l)%psp_store = psp !!***************Dynamic Active/Soluble Transformation Coeff****************** - !! on day 1 just set to a value of zero + !! on day 1 just set to a value of zero if ((time%day == 1) .and. (time%yrs == 1)) then soil(j)%ly(l)%a_days = 0 !! days since P Application soil(j)%ly(l)%b_days = 0 !! days since P deficit - end if + end if !! Calculate P balance rto = psp / (1. - psp) rmp1 = soil1(j)%mp(l)%lab - soil1(j)%mp(l)%act * rto !! P imbalance - !! Move P between the soluble and active pools based on Vadas et al., 2006 - if (rmp1 >= 0.) then !! Net movement from soluble to active - rmp1 = Max(rmp1, (-1 * soil1(j)%mp(l)%lab)) - !! Calculate Dynamic Coefficant + !! Move P between the soluble and active pools based on Vadas et al., 2006 + if (rmp1 >= 0.) then !! Net movement from soluble to active + rmp1 = Max(rmp1, (-1 * soil1(j)%mp(l)%lab)) + !! Calculate Dynamic Coefficant vara = 0.918 * (exp(-4.603 * psp)) - varb = (-0.238 * ALOG(vara)) - 1.126 - if (soil(j)%ly(l)%a_days >0) then - arate = vara * (soil(j)%ly(l)%a_days ** varb) - else - arate = vara * (1) ** varb - end if - !! limit rate coeff from 0.05 to .5 helps on day 1 when a_days is zero - if (arate > 0.5) arate = 0.5 - if (arate < 0.1) arate = 0.1 - rmp1 = arate * rmp1 - soil(j)%ly(l)%a_days = soil(j)%ly(l)%a_days + 1 !! add a day to the imbalance counter - soil(j)%ly(l)%b_days = 0 + varb = (-0.238 * ALOG(vara)) - 1.126 + if (soil(j)%ly(l)%a_days >0) then + arate = vara * (soil(j)%ly(l)%a_days ** varb) + else + arate = vara * (1) ** varb + end if + !! limit rate coeff from 0.05 to .5 helps on day 1 when a_days is zero + if (arate > 0.5) arate = 0.5 + if (arate < 0.1) arate = 0.1 + rmp1 = arate * rmp1 + soil(j)%ly(l)%a_days = soil(j)%ly(l)%a_days + 1 !! add a day to the imbalance counter + soil(j)%ly(l)%b_days = 0 end if - if (rmp1 < 0.) then !! Net movement from Active to Soluble - rmp1 = Min(rmp1, soil1(j)%mp(l)%act) - !! Calculate Dynamic Coefficant - base = (-1.08 * psp) + 0.79 - varc = base * (exp (-0.29)) - !! limit varc from 0.1 to 1 - if (varc > 1.0) varc = 1.0 - if (varc < 0.1) varc = 0.1 + if (rmp1 < 0.) then !! Net movement from Active to Soluble + rmp1 = Min(rmp1, soil1(j)%mp(l)%act) + !! Calculate Dynamic Coefficant + base = (-1.08 * psp) + 0.79 + varc = base * (exp (-0.29)) + !! limit varc from 0.1 to 1 + if (varc > 1.0) varc = 1.0 + if (varc < 0.1) varc = 0.1 rmp1 = rmp1 * varc - soil(j)%ly(l)%a_days = 0 - soil(j)%ly(l)%b_days = soil(j)%ly(l)%b_days + 1 !! add a day to the imbalance counter + soil(j)%ly(l)%a_days = 0 + soil(j)%ly(l)%b_days = soil(j)%ly(l)%b_days + 1 !! add a day to the imbalance counter End if !!*************** Active - Stable Transformations ****************** !! Estimate active stable transformation rate coeff - !! original value was .0006 - !! based on linear regression rate coeff = 0.005 @ 0% CaCo3 0.05 @ 20% CaCo3 - as_p_coeff = 0.0023 * soil(j)%ly(l)%cal + 0.005 + !! original value was .0006 + !! based on linear regression rate coeff = 0.005 @ 0% CaCo3 0.05 @ 20% CaCo3 + as_p_coeff = 0.0023 * soil(j)%ly(l)%cal + 0.005 if (as_p_coeff > 0.05) as_p_coeff = 0.05 if (as_p_coeff < 0.002) as_p_coeff = 0.002 !! Estimate active/stable pool ratio !! Generated from sharpley 2003 - ssp = 25.044 * (actpp + (actpp * rto))** (-0.3833) - ! limit ssp to range in measured data - if (ssp > 10.) ssp = 10. - if (ssp < 0.7) ssp = 0.7 + ssp = 25.044 * (actpp + (actpp * rto))** (-0.3833) + ! limit ssp to range in measured data + if (ssp > 10.) ssp = 10. + if (ssp < 0.7) ssp = 0.7 - ! Smooth ssp, no rapid changes - if (soil(j)%ly(l)%ssp_store > 0.) then - ssp = (ssp + soil(j)%ly(l)%ssp_store * 99.)/100. - end if + ! Smooth ssp, no rapid changes + if (soil(j)%ly(l)%ssp_store > 0.) then + ssp = (ssp + soil(j)%ly(l)%ssp_store * 99.)/100. + end if roc = ssp * (soil1(j)%mp(l)%act + soil1(j)%mp(l)%act * rto) - roc = roc - soil1(j)%mp(l)%sta - roc = as_p_coeff * roc - !! Store todays ssp for tomarrows calculation - soil(j)%ly(l)%ssp_store = ssp + roc = roc - soil1(j)%mp(l)%sta + roc = as_p_coeff * roc + !! Store todays ssp for tomarrows calculation + soil(j)%ly(l)%ssp_store = ssp !! **************** Account for Soil Water content, do not allow movement in dry soil************ wetness = (soil(j)%phys(l)%st/soil(j)%phys(l)%fc) !! range from 0-1 1 = field cap - if (wetness >1.) wetness = 1. - if (wetness <0.25) wetness = 0.25 - rmp1 = rmp1 * wetness - roc = roc * wetness - + if (wetness >1.) wetness = 1. + if (wetness <0.25) wetness = 0.25 + rmp1 = rmp1 * wetness + roc = roc * wetness + !! If total P is greater than 10,000 mg/kg do not allow transformations at all - If ((solp + actpp + stap) < 10000.) then - !! Allow P Transformations - soil1(j)%mp(l)%sta = soil1(j)%mp(l)%sta + roc - if (soil1(j)%mp(l)%sta < 0.) soil1(j)%mp(l)%sta = 0. - soil1(j)%mp(l)%act = soil1(j)%mp(l)%act - roc + rmp1 - if (soil1(j)%mp(l)%act < 0.) soil1(j)%mp(l)%act = 0. - soil1(j)%mp(l)%lab = soil1(j)%mp(l)%lab - rmp1 - if (soil1(j)%mp(l)%lab < 0.) soil1(j)%mp(l)%lab = 0. - end if + If ((solp + actpp + stap) < 10000.) then + !! Allow P Transformations + soil1(j)%mp(l)%sta = soil1(j)%mp(l)%sta + roc + if (soil1(j)%mp(l)%sta < 0.) soil1(j)%mp(l)%sta = 0. + soil1(j)%mp(l)%act = soil1(j)%mp(l)%act - roc + rmp1 + if (soil1(j)%mp(l)%act < 0.) soil1(j)%mp(l)%act = 0. + soil1(j)%mp(l)%lab = soil1(j)%mp(l)%lab - rmp1 + if (soil1(j)%mp(l)%lab < 0.) soil1(j)%mp(l)%lab = 0. + end if !! Add water soluble P pool assume 1:5 ratio based on sharpley 2005 et al - soil(j)%ly(l)%watp = soil1(j)%mp(l)%lab / 5. + soil(j)%ly(l)%watp = soil1(j)%mp(l)%lab / 5. hnb_d(j)%lab_min_p = hnb_d(j)%lab_min_p + rmp1 hnb_d(j)%act_sta_p = hnb_d(j)%act_sta_p + roc diff --git a/src/nut_solp.f90 b/src/nut_solp.f90 index 47c7894..2eceebe 100644 --- a/src/nut_solp.f90 +++ b/src/nut_solp.f90 @@ -64,11 +64,11 @@ subroutine nut_solp !! compute soluble P leaching do ly = 1, soil(j)%nly vap = 0. - if (ly /= i_sep(j)) then + if (ly /= i_sep(j)) then vap = -soil(j)%ly(ly)%prk / (.01 * soil(j)%phys(ly)%st + .1 * bsn_prm%pperco * soil(j)%phys(ly)%bd) plch = .001 * soil1(j)%mp(ly)%lab * (1. - Exp(vap)) plch = Min(plch, soil1(j)%mp(ly)%lab) - soil1(j)%mp(ly)%lab = soil1(j)%mp(ly)%lab - plch + soil1(j)%mp(ly)%lab = soil1(j)%mp(ly)%lab - plch if (ly == soil(j)%nly) then !! leach p from bottom layer hls_d(j)%lchlabp = plch diff --git a/src/orgncswat2.f90 b/src/orgncswat2.f90 index c4acf6d..3047430 100644 --- a/src/orgncswat2.f90 +++ b/src/orgncswat2.f90 @@ -59,8 +59,8 @@ subroutine orgncswat2 perc_clyr = 0. xx = 0. - wt1 = 0. !! conversion factor - er = 0. !! enrichment ratio + wt1 = 0. !! conversion factor + er = 0. !! enrichment ratio !! HRU calculations xx = rsd1(j)%tot_str%n + rsd1(j)%tot_meta%n + soil1(j)%hsta(1)%n + soil1(j)%hact(1)%n !wt = sol_bd(1,j) * sol_z(1,j) * 10. (tons/ha) @@ -78,17 +78,17 @@ subroutine orgncswat2 !! HRU calculations sedorgn(j) = .001 * conc * sedyld(j) / hru(j)%area_ha - !! update soil nitrogen pools only for HRU calculations + !! update soil nitrogen pools only for HRU calculations if (xx > 1.e-6) then xx1 = (1. - sedorgn(j) / xx) !!add by zhang to update soil nitrogen pools - rsd1(j)%str%n = rsd1(j)%str%n * xx1 - rsd1(j)%meta%n = rsd1(j)%meta%n * xx1 - soil1(j)%hsta(1)%n = soil1(j)%hsta(1)%n * xx1 - soil1(j)%hact(1)%n = soil1(j)%hact(1)%n * xx1 - !sol_BMN(1,j) = sol_BMN(1,j) * xx1 + rsd1(j)%str%n = rsd1(j)%str%n * xx1 + rsd1(j)%meta%n = rsd1(j)%meta%n * xx1 + soil1(j)%hsta(1)%n = soil1(j)%hsta(1)%n * xx1 + soil1(j)%hact(1)%n = soil1(j)%hact(1)%n * xx1 + !sol_BMN(1,j) = sol_BMN(1,j) * xx1 end if !return @@ -110,10 +110,10 @@ subroutine orgncswat2 ! Not sure whether should consider enrichment ratio or not! YEW = MIN((sedyld(j)/hru(j)%area_ha+YW/hru(j)%area_ha)/(sol_mass/1000.),.9) !fraction of soil erosion of total soil mass X1=1.-YEW - !YEW=MIN(ER*(YSD(NDRV)+YW)/WT(LD1),.9) - !ER enrichment ratio - !YSD water erosion - !YW wind erosion + !YEW=MIN(ER*(YSD(NDRV)+YW)/WT(LD1),.9) + !ER enrichment ratio + !YSD water erosion + !YW wind erosion YOC=YEW*TOT soil1(j)%hact(1)%c = soil1(j)%hact(1)%c * X1 soil1(j)%hsta(1)%c = soil1(j)%hsta(1)%c * X1 @@ -139,7 +139,7 @@ subroutine orgncswat2 XX=X1+DK !V=QD+Y4 V = surfq(j) + soil(j)%ly(k)%prk + soil(j)%ly(1)%flat - !QD surface runoff + !QD surface runoff X3=0. IF(V>1.E-10)THEN X3 = soil1(j)%microb(1)%c * (1.-EXP(-V/XX)) !loss of biomass C diff --git a/src/output_landscape_module.f90 b/src/output_landscape_module.f90 index cae8acd..b09a38a 100644 --- a/src/output_landscape_module.f90 +++ b/src/output_landscape_module.f90 @@ -416,7 +416,7 @@ module output_landscape_module character(len=17) :: no3atmo = " no3atmo " character(len=17) :: nh4atmo = " nh4atmo " character(len=17) :: nuptake = " nuptake " - character(len=17) :: puptake = " puptake " + character(len=17) :: puptake = " puptake " character(len=17) :: gwsoiln = " gwsoiln " character(len=17) :: gwsoilp = " gwsoilp " end type output_nutbal_header diff --git a/src/pl_burnop.f90 b/src/pl_burnop.f90 index 9ba0008..4ed13dd 100644 --- a/src/pl_burnop.f90 +++ b/src/pl_burnop.f90 @@ -46,7 +46,7 @@ subroutine pl_burnop (jj, iburn) soil1(j)%hact(1)%n = soil1(j)%hact(1)%n * fr_burn soil1(j)%hsta(1)%n = soil1(j)%hsta(1)%n* fr_burn - !!insert new biomss by zhang + !!insert new biomss by zhang !!================================= if (bsn_cc%cswat == 2) then rsd1(j)%tot_meta%m = rsd1(j)%tot_meta%m * fr_burn diff --git a/src/pl_fert.f90 b/src/pl_fert.f90 index d45e53a..f349305 100644 --- a/src/pl_fert.f90 +++ b/src/pl_fert.f90 @@ -81,18 +81,18 @@ subroutine pl_fert (ifrt, frt_kg, fertop) soil1(j)%hsta(l)%p = soil1(j)%hsta(l)%p + (1. - rtof)*xx*frt_kg * & fertdb(ifrt)%forgp end if - if (bsn_cc%cswat == 1) then - soil1(j)%man(l)%c = soil1(j)%man(l)%c + xx * frt_kg * & - fertdb(ifrt)%forgn * 10. - soil1(j)%man(l)%n = soil1(j)%man(l)%n + xx * frt_kg * & - fertdb(ifrt)%forgn - soil1(j)%man(l)%p = soil1(j)%man(l)%p + xx * frt_kg * & - fertdb(ifrt)%forgp - end if + if (bsn_cc%cswat == 1) then + soil1(j)%man(l)%c = soil1(j)%man(l)%c + xx * frt_kg * & + fertdb(ifrt)%forgn * 10. + soil1(j)%man(l)%n = soil1(j)%man(l)%n + xx * frt_kg * & + fertdb(ifrt)%forgn + soil1(j)%man(l)%p = soil1(j)%man(l)%p + xx * frt_kg * & + fertdb(ifrt)%forgp + end if !!By Zhang for C/N cycling !!=========================== - if (bsn_cc%cswat == 2) then + if (bsn_cc%cswat == 2) then soil1(j)%tot(l)%p = soil1(j)%tot(l)%p + rtof * xx * & frt_kg * fertdb(ifrt)%forgp soil1(j)%hsta(l)%p = soil1(j)%hsta(l)%p + (1. - rtof) * xx * & @@ -158,7 +158,7 @@ subroutine pl_fert (ifrt, frt_kg, fertop) !end if - end if + end if !!By Zhang for C/N cycling !!=========================== diff --git a/src/pl_fert_wet.f90 b/src/pl_fert_wet.f90 index 70eeb1b..6730b93 100644 --- a/src/pl_fert_wet.f90 +++ b/src/pl_fert_wet.f90 @@ -67,18 +67,18 @@ subroutine pl_fert_wet (ifrt, frt_kg) wet(j)%sedp = wet(j)%sedp + frt_kg * fertdb(ifrt)%forgp end if - ! if (bsn_cc%cswat == 1) then - ! soil1(j)%man(l)%c = soil1(j)%man(l)%c + xx * frt_kg * & - ! fertdb(ifrt)%forgn * 10. - ! soil1(j)%man(l)%n = soil1(j)%man(l)%n + xx * frt_kg * & - ! fertdb(ifrt)%forgn - ! soil1(j)%man(l)%p = soil1(j)%man(l)%p + xx * frt_kg * & - ! fertdb(ifrt)%forgp - ! end if + ! if (bsn_cc%cswat == 1) then + ! soil1(j)%man(l)%c = soil1(j)%man(l)%c + xx * frt_kg * & + ! fertdb(ifrt)%forgn * 10. + ! soil1(j)%man(l)%n = soil1(j)%man(l)%n + xx * frt_kg * & + ! fertdb(ifrt)%forgn + ! soil1(j)%man(l)%p = soil1(j)%man(l)%p + xx * frt_kg * & + ! fertdb(ifrt)%forgp + ! end if ! ! !!By Zhang for C/N cycling ! !!=========================== - ! if (bsn_cc%cswat == 2) then + ! if (bsn_cc%cswat == 2) then ! soil1(j)%tot(l)%p = soil1(j)%tot(l)%p + rtof * xx * & ! frt_kg * fertdb(ifrt)%forgp ! soil1(j)%hsta(l)%p = soil1(j)%hsta(l)%p + (1. - rtof) * xx * & @@ -144,7 +144,7 @@ subroutine pl_fert_wet (ifrt, frt_kg) ! ! !end if ! - !end if + !end if ! !!By Zhang for C/N cycling ! !!=========================== ! diff --git a/src/pl_leaf_drop.f90 b/src/pl_leaf_drop.f90 index 0bdd226..ecfcac1 100644 --- a/src/pl_leaf_drop.f90 +++ b/src/pl_leaf_drop.f90 @@ -49,7 +49,7 @@ subroutine pl_leaf_drop (resnew, resnew_n) real :: LSF = 0. !frac |fraction of the litter that is structural real :: LMNF = 0. !kg kg-1 |fraction of metabolic litter that is N real :: LSLF = 0. !kg kg-1 |fraction of structural litter that is lignin - real :: LSNF = 0. !kg kg-1 |fraction of structural litter that is N + real :: LSNF = 0. !kg kg-1 |fraction of structural litter that is N orgc_f = 0. BLG1 = 0. @@ -89,13 +89,13 @@ subroutine pl_leaf_drop (resnew, resnew_n) CLG=BLG3*pcom(j)%plcur(ipl)%phuacc/ (pcom(j)%plcur(ipl)%phuacc + & EXP(BLG1-BLG2*pcom(j)%plcur(ipl)%phuacc)) - sf = 0.05 - sol_min_n = (soil1(j)%mn(1)%no3 + soil1(j)%mn(1)%nh4) + sf = 0.05 + sol_min_n = (soil1(j)%mn(1)%no3 + soil1(j)%mn(1)%nh4) resnew_ne = resnew_n + sf * sol_min_n RLN = (resnew * CLG/(resnew_n+1.E-5)) RLR = MIN(.8, resnew * CLG/1000/(resnew/1000+1.E-5)) - + LMF = 0.85 - 0.018 * RLN if (LMF <0.01) then LMF = 0.01 @@ -103,17 +103,17 @@ subroutine pl_leaf_drop (resnew, resnew_n) if (LMF >0.7) then LMF = 0.7 end if - end if + end if LSF = 1 - LMF - + rsd1(j)%meta%m = rsd1(j)%meta%m + LMF * resnew rsd1(j)%str%m = rsd1(j)%str%m + LSF * resnew LSLF = CLG - + rsd1(j)%tot_str%c = rsd1(j)%tot_str%c + 0.42*LSF * resnew - + rsd1(j)%tot_lignin%c = rsd1(j)%tot_lignin%c + RLR * 0.42 * LSF * resnew rsd1(j)%tot_lignin%c = rsd1(j)%tot_str%c - rsd1(j)%tot_lignin%c @@ -124,7 +124,7 @@ subroutine pl_leaf_drop (resnew, resnew_n) else rsd1(j)%tot_str%n = rsd1(j)%tot_str%n + resnew_ne rsd1(j)%tot_meta%n = rsd1(j)%tot_meta%n + 1.E-25 - end if + end if rsd1(j)%tot_meta%c = rsd1(j)%tot_meta%c + 0.42 * LMF * resnew diff --git a/src/pl_read_parms_cal.f90 b/src/pl_read_parms_cal.f90 index 573abf8..4594720 100644 --- a/src/pl_read_parms_cal.f90 +++ b/src/pl_read_parms_cal.f90 @@ -109,10 +109,10 @@ subroutine pl_read_parms_cal exit end do - end if + end if db_mx%plcal_reg = mreg - + close(107) return end subroutine pl_read_parms_cal \ No newline at end of file diff --git a/src/pl_read_regions_cal.f90 b/src/pl_read_regions_cal.f90 index 9b4f509..9db82ff 100644 --- a/src/pl_read_regions_cal.f90 +++ b/src/pl_read_regions_cal.f90 @@ -90,10 +90,10 @@ subroutine pl_read_regions_cal exit end do - end if + end if db_mx%plcal_reg = mreg - + close(107) return end subroutine pl_read_regions_cal \ No newline at end of file diff --git a/src/pl_rootfr.f90 b/src/pl_rootfr.f90 index 6ee7e8e..03b780d 100644 --- a/src/pl_rootfr.f90 +++ b/src/pl_rootfr.f90 @@ -1,7 +1,7 @@ - subroutine pl_rootfr - !! This subroutine distributes dead root mass through the soil profile - !! code developed by Armen R. Kemanian in 2008 - !! March, 2009 further adjustments expected + subroutine pl_rootfr + !! This subroutine distributes dead root mass through the soil profile + !! code developed by Armen R. Kemanian in 2008 + !! March, 2009 further adjustments expected use hru_module, only : ihru use soil_module @@ -9,13 +9,13 @@ subroutine pl_rootfr implicit none - real :: sol_thick(soil(ihru)%nly) ! | - real :: cum_rd = 0. ! | + real :: sol_thick(soil(ihru)%nly) ! | + real :: cum_rd = 0. ! | real :: cum_d = 0. ! | real :: cum_rf = 0. ! | real :: x1 = 0. ! | real :: x2 = 0. ! | - integer :: k = 0 ! | + integer :: k = 0 ! | integer :: l = 0 !none |number of soil layer that manure applied integer :: jj = 0 !none |counter real :: a = 0. ! | @@ -26,61 +26,61 @@ subroutine pl_rootfr real :: xx1 = 0. ! | real :: xx2 = 0. ! | real :: xx = 0. ! | - - jj = ihru + + jj = ihru if (pcom(jj)%plg(1)%root_dep < 1.e-6) then soil(jj)%ly(1)%rtfr = 1 return endif - ! Normalized Root Density = 1.15*exp[-11.7*NRD] + 0.022, where NRD = normalized rooting depth - ! Parameters of Normalized Root Density Function from Dwyer et al 19xx - a = 1.15 - b = 11.7 - c = 0.022 - d = 0.12029 ! Integral of Normalized Root Distribution Function - ! from 0 to 1 (normalized depth) = 0.12029 + ! Normalized Root Density = 1.15*exp[-11.7*NRD] + 0.022, where NRD = normalized rooting depth + ! Parameters of Normalized Root Density Function from Dwyer et al 19xx + a = 1.15 + b = 11.7 + c = 0.022 + d = 0.12029 ! Integral of Normalized Root Distribution Function + ! from 0 to 1 (normalized depth) = 0.12029 - l = 0 - k = 0 - cum_d = 0. - cum_rf = 0. + l = 0 + k = 0 + cum_d = 0. + cum_rf = 0. sol_thick(:) = 0. rtfr = 0. - do l = 1, soil(jj)%nly - if (l == 1) then - sol_thick(l) = soil(jj)%phys(l)%d - else - sol_thick(l) = soil(jj)%phys(l)%d - soil(jj)%phys(l-1)%d - end if - - cum_d = cum_d + sol_thick(l) - if (cum_d >= pcom(jj)%plg(1)%root_dep) cum_rd = pcom(jj)%plg(1)%root_dep - if (cum_d < pcom(jj)%plg(1)%root_dep) cum_rd = cum_d - x1 = (cum_rd - sol_thick(l)) / pcom(jj)%plg(1)%root_dep - x2 = cum_rd / pcom(jj)%plg(1)%root_dep + do l = 1, soil(jj)%nly + if (l == 1) then + sol_thick(l) = soil(jj)%phys(l)%d + else + sol_thick(l) = soil(jj)%phys(l)%d - soil(jj)%phys(l-1)%d + end if + + cum_d = cum_d + sol_thick(l) + if (cum_d >= pcom(jj)%plg(1)%root_dep) cum_rd = pcom(jj)%plg(1)%root_dep + if (cum_d < pcom(jj)%plg(1)%root_dep) cum_rd = cum_d + x1 = (cum_rd - sol_thick(l)) / pcom(jj)%plg(1)%root_dep + x2 = cum_rd / pcom(jj)%plg(1)%root_dep xx1 = -b * x1 - if (xx1 > 20.) xx1 = 20. + if (xx1 > 20.) xx1 = 20. xx2 = -b * x2 if (xx2 > 20.) xx2 = 20. - soil(jj)%ly(l)%rtfr = (a/b*(Exp(xx1) - Exp(xx2)) + c *(x2 - x1))/d + soil(jj)%ly(l)%rtfr = (a/b*(Exp(xx1) - Exp(xx2)) + c *(x2 - x1))/d xx = cum_rf - cum_rf = cum_rf + soil(jj)%ly(l)%rtfr + cum_rf = cum_rf + soil(jj)%ly(l)%rtfr if (cum_rf > 1.) then - soil(jj)%ly(l)%rtfr = 1. - xx + soil(jj)%ly(l)%rtfr = 1. - xx cum_rf = 1.0 end if - k = l - if (cum_rd >= pcom(jj)%plg(1)%root_dep) Exit - - end do + k = l + if (cum_rd >= pcom(jj)%plg(1)%root_dep) Exit + + end do - !! ensures that cumulative fractional root distribution = 1 - do l = 1, soil(jj)%nly - soil(jj)%ly(l)%rtfr = soil(jj)%ly(l)%rtfr / cum_rf - If (l == k) Exit ! exits loop on the same layer as the previous loop + !! ensures that cumulative fractional root distribution = 1 + do l = 1, soil(jj)%nly + soil(jj)%ly(l)%rtfr = soil(jj)%ly(l)%rtfr / cum_rf + If (l == k) Exit ! exits loop on the same layer as the previous loop end do return diff --git a/src/plantparm_init.f90 b/src/plantparm_init.f90 index 88e4ff5..87f1c55 100644 --- a/src/plantparm_init.f90 +++ b/src/plantparm_init.f90 @@ -22,11 +22,11 @@ subroutine plantparm_init if (pldb(ic)%usle_c >= 1.0) pldb(ic)%usle_c = 1.0 if (pldb(ic)%blai <= 0.0) pldb(ic)%blai = 0.0 if (pldb(ic)%blai >= 10.0) pldb(ic)%blai = 10.0 - if (pldb(ic)%rsr1 <= 0.0) pldb(ic)%rsr1 = 0.4 - if (pldb(ic)%rsr2 <= 0.0) pldb(ic)%rsr2 = 0.2 + if (pldb(ic)%rsr1 <= 0.0) pldb(ic)%rsr1 = 0.4 + if (pldb(ic)%rsr2 <= 0.0) pldb(ic)%rsr2 = 0.2 if (pldb(ic)%aeration <= 0.0) pldb(ic)%aeration = 0.2 - if (pldb(ic)%rsd_pctcov <= 0.0) pldb(ic)%rsd_pctcov = 0.4 - if (pldb(ic)%rsd_covfac <= 0.0) pldb(ic)%rsd_covfac = 0.04 + if (pldb(ic)%rsd_pctcov <= 0.0) pldb(ic)%rsd_pctcov = 0.4 + if (pldb(ic)%rsd_covfac <= 0.0) pldb(ic)%rsd_covfac = 0.04 !! check if tuber, root to total biomass ratio = 0.7 if (pldb(ic)%typ == "warm_annual_tuber" .or. pldb(ic)%typ == "cold_annual_tuber") then diff --git a/src/proc_bsn.f90 b/src/proc_bsn.f90 index c50336a..3b4491b 100644 --- a/src/proc_bsn.f90 +++ b/src/proc_bsn.f90 @@ -12,7 +12,7 @@ subroutine proc_bsn write (9001,*) "DIAGNOSTICS.OUT FILE" !!! open drainage areas output file open (9004,file="area_calc.out", recl=8000) - + call basin_read_cc call basin_read_objs call time_read diff --git a/src/rec_read_elements.f90 b/src/rec_read_elements.f90 index 3b8f363..a9e56c7 100644 --- a/src/rec_read_elements.f90 +++ b/src/rec_read_elements.f90 @@ -72,7 +72,7 @@ subroutine rec_read_elements db_mx%rec_out = mreg end do - end if + end if !! setting up regions for recall soft cal and/or output by type inquire (file=in_regs%def_psc_reg, exist=i_exist) @@ -116,7 +116,7 @@ subroutine rec_read_elements db_mx%rec_reg = mreg end do - end if + end if !! if no regions are input, don"t need elements if (mreg > 0) then diff --git a/src/recall_salt.f90 b/src/recall_salt.f90 index c33f25a..594bd3a 100644 --- a/src/recall_salt.f90 +++ b/src/recall_salt.f90 @@ -81,7 +81,7 @@ subroutine recall_salt(irec) enddo if(rec_salt(irec)%pts_type.eq.1) then do isalt=1,cs_db%num_salts - recsaltb_d(irec)%salt(isalt) = rec_salt(irec)%hd_salt(1,time%yrs)%salt(isalt) + recsaltb_d(irec)%salt(isalt) = rec_salt(irec)%hd_salt(1,time%yrs)%salt(isalt) enddo else do isalt=1,cs_db%num_salts diff --git a/src/reg_read_elements.f90 b/src/reg_read_elements.f90 index d228675..d83f1e4 100644 --- a/src/reg_read_elements.f90 +++ b/src/reg_read_elements.f90 @@ -122,7 +122,7 @@ subroutine reg_read_elements end do ! i = 1, mreg end do - end if + end if !!read data for each element in all landscape cataloging units inquire (file=in_regs%ele_reg, exist=i_exist) diff --git a/src/res_control.f90 b/src/res_control.f90 index d04c488..18e78d6 100644 --- a/src/res_control.f90 +++ b/src/res_control.f90 @@ -76,8 +76,8 @@ subroutine res_control (jres) res_ob(jres)%prev_flo = ht2%flo call res_sediment - else - ictbl = res_dat(idat)%release !! Osvaldo + else + ictbl = res_dat(idat)%release !! Osvaldo call res_rel_conds (ictbl, res(jres)%flo, ht1%flo, 0.) endif diff --git a/src/res_cs.f90 b/src/res_cs.f90 index ff43035..569264d 100644 --- a/src/res_cs.f90 +++ b/src/res_cs.f90 @@ -24,7 +24,7 @@ subroutine res_cs(jres, icon, iob) !rtb cs real :: cs_conc = 0. !concentration of constituent in reservoir water (g/m3 = mg/L) integer :: icmd = 0 !none real :: k_react = 0. !1/day - first-order rate constant, affected by temperature - real :: v_settle = 0. !m/day - settling rate + real :: v_settle = 0. !m/day - settling rate real :: cs_mass_beg = 0. real :: cs_conc_beg = 0. real :: cs_mass_end = 0. @@ -87,11 +87,11 @@ subroutine res_cs(jres, icon, iob) !rtb cs !constituent mass settling to bottom of reservoir if(ics == 1) then v_settle = res_cs_data(icon)%v_seo4 - elseif(ics == 2) then + elseif(ics == 2) then v_settle = res_cs_data(icon)%v_seo3 - elseif(ics == 3) then + elseif(ics == 3) then v_settle = res_cs_data(icon)%v_born - endif + endif cs_settle = (cs_conc_beg/1000.) * v_settle * (res_wat_d(jres)%area_ha*10000.) !kg if(cs_settle > mass_avail) then cs_settle = mass_avail !take remaining diff --git a/src/res_cs_module.f90 b/src/res_cs_module.f90 index a0323bc..b6e8478 100644 --- a/src/res_cs_module.f90 +++ b/src/res_cs_module.f90 @@ -28,7 +28,7 @@ module res_cs_module !rtb cs type (res_cs_output), dimension(:), allocatable, save :: rescs_m type (res_cs_output), dimension(:), allocatable, save :: rescs_y type (res_cs_output), dimension(:), allocatable, save :: rescs_a - + !arrays for wetland mass balance output type (res_cs_output), dimension(:), allocatable, save :: wetcs_d type (res_cs_output), dimension(:), allocatable, save :: wetcs_m diff --git a/src/res_hydro.f90 b/src/res_hydro.f90 index 340204f..1aa25e0 100644 --- a/src/res_hydro.f90 +++ b/src/res_hydro.f90 @@ -43,10 +43,10 @@ subroutine res_hydro (jres, id, pvol_m3, evol_m3) nstep = 1 wsa1 = wbody_wb%area_ha * 10000. !m2 if (time%step>0) then !Jaehak 2024 - nstep = time%step - else - nstep = 1 - end if + nstep = time%step + else + nstep = 1 + end if do tstep = 1, nstep diff --git a/src/res_salt_module.f90 b/src/res_salt_module.f90 index b30142b..cfb020c 100644 --- a/src/res_salt_module.f90 +++ b/src/res_salt_module.f90 @@ -24,7 +24,7 @@ module res_salt_module !rtb salt type (res_salt_output), dimension(:), allocatable, save :: ressalt_m type (res_salt_output), dimension(:), allocatable, save :: ressalt_y type (res_salt_output), dimension(:), allocatable, save :: ressalt_a - + !arrays for wetland mass balance output type (res_salt_output), dimension(:), allocatable, save :: wetsalt_d type (res_salt_output), dimension(:), allocatable, save :: wetsalt_m diff --git a/src/res_sediment.f90 b/src/res_sediment.f90 index c8d157c..6f59e06 100644 --- a/src/res_sediment.f90 +++ b/src/res_sediment.f90 @@ -22,18 +22,18 @@ subroutine res_sediment else !! compute concentrations - if (wbody%flo > 0.) then + if (wbody%flo > 0.) then sed_ppm = 1000000. * wbody%sed / wbody%flo sed_ppm = Max(1.e-6, sed_ppm) sil_ppm = 1000000. * wbody%sil / wbody%flo sil_ppm = Max(1.e-6, sil_ppm) cla_ppm = 1000000. * wbody%cla / wbody%flo cla_ppm = Max(1.e-6, cla_ppm) - else + else sed_ppm = 1.e-6 sil_ppm = 1.e-6 cla_ppm = 1.e-6 - endif + endif !! compute change in sediment concentration due to settling if (sed_ppm > wbody_prm%sed%nsed) then diff --git a/src/ru_cs_output.f90 b/src/ru_cs_output.f90 index 0e43ba1..7792664 100644 --- a/src/ru_cs_output.f90 +++ b/src/ru_cs_output.f90 @@ -10,7 +10,7 @@ subroutine ru_cs_output(iru) !rtb cs integer, intent (in) :: iru ! | integer :: iob = 0 ! | - integer :: ics = 0 ! |constituent counter + integer :: ics = 0 ! |constituent counter integer :: ihyd = 0 ! |hydrograph counter !! ~ ~ ~ PURPOSE ~ ~ ~ @@ -64,7 +64,7 @@ subroutine ru_cs_output(iru) !rtb cs (ru_hru_csb_d(iru)%cs(ics)%sorb,ics=1,cs_db%num_cs) if (pco%csvout == "y") then write (6071,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iru, ob(iob)%gis_id, & - (rucsb_d(iru)%hd(1)%cs(ics),ics=1,cs_db%num_cs), & !total out + (rucsb_d(iru)%hd(1)%cs(ics),ics=1,cs_db%num_cs), & !total out (rucsb_d(iru)%hd(2)%cs(ics),ics=1,cs_db%num_cs), & !percolation (rucsb_d(iru)%hd(3)%cs(ics),ics=1,cs_db%num_cs), & !surface runoff (rucsb_d(iru)%hd(4)%cs(ics),ics=1,cs_db%num_cs), & !soil lateral flow diff --git a/src/ru_salt_output.f90 b/src/ru_salt_output.f90 index 5156c34..9265186 100644 --- a/src/ru_salt_output.f90 +++ b/src/ru_salt_output.f90 @@ -64,7 +64,7 @@ subroutine ru_salt_output(iru) !rtb salt ru_hru_saltb_d(iru)%salt(1)%diss if (pco%csvout == "y") then write (5071,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, iru, ob(iob)%gis_id, & - (rusaltb_d(iru)%hd(1)%salt(isalt),isalt=1,cs_db%num_salts), & + (rusaltb_d(iru)%hd(1)%salt(isalt),isalt=1,cs_db%num_salts), & (rusaltb_d(iru)%hd(2)%salt(isalt),isalt=1,cs_db%num_salts), & (rusaltb_d(iru)%hd(3)%salt(isalt),isalt=1,cs_db%num_salts), & (rusaltb_d(iru)%hd(4)%salt(isalt),isalt=1,cs_db%num_salts), & @@ -299,7 +299,7 @@ subroutine ru_salt_output(iru) !rtb salt (ru_hru_saltb_a(iru)%salt(isalt)%rain,isalt=1,cs_db%num_salts), & (ru_hru_saltb_a(iru)%salt(isalt)%dryd,isalt=1,cs_db%num_salts), & (ru_hru_saltb_a(iru)%salt(isalt)%road,isalt=1,cs_db%num_salts), & - (ru_hru_saltb_a(iru)%salt(isalt)%fert,isalt=1,cs_db%num_salts), & + (ru_hru_saltb_a(iru)%salt(isalt)%fert,isalt=1,cs_db%num_salts), & (ru_hru_saltb_a(iru)%salt(isalt)%amnd,isalt=1,cs_db%num_salts), & (ru_hru_saltb_a(iru)%salt(isalt)%uptk,isalt=1,cs_db%num_salts), & ru_hru_saltb_a(iru)%salt(1)%diss diff --git a/src/salt_balance.f90 b/src/salt_balance.f90 index 637396b..fbab842 100644 --- a/src/salt_balance.f90 +++ b/src/salt_balance.f90 @@ -499,7 +499,7 @@ subroutine salt_balance gwsol_ss(i)%solute(2+m)%rcti = 0. gwsol_ss(i)%solute(2+m)%rcto = 0. gwsol_ss(i)%solute(2+m)%minl = 0. - enddo + enddo enddo endif endif diff --git a/src/salt_chem_hru.f90 b/src/salt_chem_hru.f90 index 757a110..8e73fb0 100644 --- a/src/salt_chem_hru.f90 +++ b/src/salt_chem_hru.f90 @@ -198,29 +198,29 @@ subroutine salt_chem_hru if(K_ADJ1.gt.0.) then salt_K1 = Ksp11/K_ADJ1 - else + else salt_K1 = 0. - endif + endif if(K_ADJ2.gt.0.) then salt_K2 = Ksp21/K_ADJ2 - else + else salt_K2 = 0. - endif + endif if(K_ADJ3.gt.0.) then salt_K3 = Ksp31/K_ADJ3 - else + else salt_K3 = 0. - endif + endif if(K_ADJ4.gt.0.) then salt_K4 = Ksp41/K_ADJ4 - else + else salt_K4 = 0. - endif + endif if(K_ADJ5.gt.0.) then salt_K5 = Ksp51/K_ADJ5 - else + else salt_K5 = 0. - endif + endif errorTotal = 1 diff --git a/src/salt_chem_soil_single.f90 b/src/salt_chem_soil_single.f90 index a578c97..a52ed13 100644 --- a/src/salt_chem_soil_single.f90 +++ b/src/salt_chem_soil_single.f90 @@ -112,29 +112,29 @@ subroutine salt_chem_soil_single(hru_num,lay_num,waterC) !rtb salt if(K_ADJ1.gt.0.) then salt_K1 = Ksp11/K_ADJ1 - else + else salt_K1 = 0. - endif + endif if(K_ADJ2.gt.0.) then salt_K2 = Ksp21/K_ADJ2 - else + else salt_K2 = 0. - endif + endif if(K_ADJ3.gt.0.) then salt_K3 = Ksp31/K_ADJ3 - else + else salt_K3 = 0. - endif + endif if(K_ADJ4.gt.0.) then salt_K4 = Ksp41/K_ADJ4 - else + else salt_K4 = 0. - endif + endif if(K_ADJ5.gt.0.) then salt_K5 = Ksp51/K_ADJ5 - else + else salt_K5 = 0. - endif + endif errorTotal = 1 diff --git a/src/sd_channel_control.f90 b/src/sd_channel_control.f90 index 26b97de..ba30c3b 100644 --- a/src/sd_channel_control.f90 +++ b/src/sd_channel_control.f90 @@ -234,7 +234,7 @@ subroutine sd_channel_control if(bsn_cc%gwflow.eq.1) then flood_freq(ich) = 1 !flag to indicate the water is in the floodplain call gwflow_fpln(ich) - endif + endif sd_ch(ich)%overbank = "ob" rcharea = sd_ch_vel(ich)%area diff --git a/src/sd_channel_control3.f90 b/src/sd_channel_control3.f90 index 4465968..68faffd 100644 --- a/src/sd_channel_control3.f90 +++ b/src/sd_channel_control3.f90 @@ -40,7 +40,7 @@ subroutine sd_channel_control3 real :: erode_bank_cut = 0. !cm |widening caused by downcutting (both sides) real :: ebtm_t = 0. !tons |bottom erosion real :: ebank_t = 0. !tons |bank erosion - real :: sedout = 0. !mg |sediment out of waterway channel + real :: sedout = 0. !mg |sediment out of waterway channel real :: washld = 0. !tons |wash load real :: bedld = 0. !tons |bed load real :: dep = 0. !tons |deposition diff --git a/src/sd_channel_sediment.f90 b/src/sd_channel_sediment.f90 index f066676..233cc5b 100644 --- a/src/sd_channel_sediment.f90 +++ b/src/sd_channel_sediment.f90 @@ -187,7 +187,7 @@ subroutine sd_channel_sediment (ts_int) chsd_d(ich)%hc_m = hc !! compute sediment leaving the channel - washload only - bottom deg is bedload - sedout = ht1%sed - dep + hc_sed + erode_bank ! + ebtm_t + sedout = ht1%sed - dep + hc_sed + erode_bank ! + ebtm_t ht2%sed = sedout diff --git a/src/sd_hydsed_init.f90 b/src/sd_hydsed_init.f90 index 3edca75..5832299 100644 --- a/src/sd_hydsed_init.f90 +++ b/src/sd_hydsed_init.f90 @@ -164,8 +164,8 @@ subroutine sd_hydsed_init end do !! Compute storage time constant for reach (msk_co1 + msk_co2 = 1.) - msk1 = bsn_prm%msk_co1 / (bsn_prm%msk_co1 + bsn_prm%msk_co2) - msk2 = bsn_prm%msk_co2 / (bsn_prm%msk_co1 + bsn_prm%msk_co2) + msk1 = bsn_prm%msk_co1 / (bsn_prm%msk_co1 + bsn_prm%msk_co2) + msk2 = bsn_prm%msk_co2 / (bsn_prm%msk_co1 + bsn_prm%msk_co2) xkm = sd_ch(i)%stor_dis_bf * msk1 + sd_ch(i)%stor_dis_01bf * msk2 !! Muskingum numerical stability -Jaehak Jeong, 2011 @@ -304,7 +304,7 @@ subroutine sd_hydsed_init ch_water(ich)%cs(ics) = (cs_cha_ini(ics_ini)%conc(ics)/1000.) * tot_stor(ich)%flo !kg enddo enddo - endif + endif return end subroutine sd_hydsed_init \ No newline at end of file diff --git a/src/sep_biozone.f90 b/src/sep_biozone.f90 index 7a299f4..bcb906d 100644 --- a/src/sep_biozone.f90 +++ b/src/sep_biozone.f90 @@ -1,5 +1,5 @@ subroutine sep_biozone - + !! ~ ~ ~ PURPOSE ~ ~ ~ !! This subroutine conducts biophysical processes occuring !! in the biozone layer of a septic HRU. @@ -45,18 +45,18 @@ subroutine sep_biozone use soil_module use time_module - implicit none + implicit none integer :: bz_lyr = 0 !none |soil layer where biozone exists integer :: isp = 0 !none |type of septic system for current hru integer :: j = 0 !none |hru integer :: nly = 0 ! | - real*8 :: bz_vol = 0.d0 !m^3 |volume of biozone + real*8 :: bz_vol = 0.d0 !m^3 |volume of biozone real*8 :: rtrate = 0.d0 ! | real*8 :: qin = 0.d0 !m^3 H2O |water in reach during time step real*8 :: qout = 0.d0 ! | real*8 :: rplqm = 0.d0 !kg/ha |daily change in plaque - real*8 :: ntr_rt = 0.d0 !1/day |nitrification reaction rate + real*8 :: ntr_rt = 0.d0 !1/day |nitrification reaction rate real*8 :: dentr_rt = 0.d0 !1/day |denitrification reaction rate real*8 :: bod_rt = 0.d0 !1/day |BOD reaction rate real*8 :: fcoli_rt = 0.d0 !1/day |fecal coliform reaction rate @@ -68,30 +68,30 @@ subroutine sep_biozone ! |value needed in later equations real*8 :: bodi = 0.d0 ! | real*8 :: bode = 0.d0 ! | - real*8 :: rnit = 0.d0 !kg/ha |nitrification during the day + real*8 :: rnit = 0.d0 !kg/ha |nitrification during the day real*8 :: rdenit = 0.d0 !kg/ha |denitrification during the day real*8 :: rmort = 0.d0 !kg/ha |daily mortality of bacteria real*8 :: rrsp = 0.d0 !kg/ha |daily resparation of bacteria real*8 :: rslg = 0.d0 !kg/ha |daily slough-off bacteria real*8 :: rbod = 0.d0 !mg/l |daily change in bod concentration real*8 :: rfcoli = 0.d0 !cfu/100ml |daily change in fecal coliform - real*8 :: nh3_begin = 0.d0 ! | + real*8 :: nh3_begin = 0.d0 ! | real*8 :: nh3_end = 0.d0 ! | real*8 :: nh3_inflw_ste = 0.d0! | real*8 :: no3_begin = 0.d0 ! | real*8 :: no3_end = 0.d0 ! | - real*8 :: no3_inflow_ste = 0.d0! | + real*8 :: no3_inflow_ste = 0.d0! | real*8 :: bza = 0.d0 ! | real*8 :: qi = 0.d0 ! | real*8 :: nperc = 0.d0 ! | - real*8 :: nh3_init = 0.d0 ! | + real*8 :: nh3_init = 0.d0 ! | real*8 :: no3_init = 0.d0 ! | real*8 :: hvol = 0.d0 ! | real*8 :: solpconc = 0.d0 ! | real*8 :: solpsorb = 0.d0 ! | real*8 :: qlyr = 0.d0 ! | real*8 :: qsrf = 0.d0 ! | - real*8 :: solp_init = 0.d0 ! | + real*8 :: solp_init = 0.d0 ! | real*8 :: solp_begin = 0.d0 ! | real*8 :: solp_end = 0.d0 ! | real*8 :: svolp = 0.d0 ! | @@ -99,75 +99,75 @@ subroutine sep_biozone real*8 :: ctmp = 0.d0 ! | real*8 :: percp = 0.d0 ! | - j = ihru - nly = soil(j)%nly + j = ihru + nly = soil(j)%nly isep = iseptic(j) - isp = sep(isep)%typ !! J.Jeong 3/09/09 + isp = sep(isep)%typ !! J.Jeong 3/09/09 bz_lyr = i_sep(j) - bza = hru(j)%area_ha - bz_vol = sep(isep)%thk * bza * 10. !m^3 - qlyr = qstemm(j) - qsrf = 0 - - !temperature correction factor for bacteria growth/dieoff (Eppley, 1972) + bza = hru(j)%area_ha + bz_vol = sep(isep)%thk * bza * 10. !m^3 + qlyr = qstemm(j) + qsrf = 0 + + !temperature correction factor for bacteria growth/dieoff (Eppley, 1972) !ibac = 1 !there should be a loop for all pathogens in this hru - !ctmp = path_db(ibac)%t_adj ** (soil(j)%phys(bz_lyr)%tmp- 20.) + !ctmp = path_db(ibac)%t_adj ** (soil(j)%phys(bz_lyr)%tmp- 20.) ctmp = 1. - ! initial water volume - qi = (soil(j)%phys(bz_lyr)%st + soil(j)%ly(bz_lyr-1)%prk + qstemm(j)) * & + ! initial water volume + qi = (soil(j)%phys(bz_lyr)%st + soil(j)%ly(bz_lyr-1)%prk + qstemm(j)) * & bza * 10. !m3 ! STE volume - qin = qstemm(j) * bza * 10. ! m^3 - ! leaching to septic layer - qout = bz_perc(j) * bza * 10. !m3/d - ! final volume - hvol = soil(j)%phys(bz_lyr)%st * bza * 10. - rtof = 0.5 + qin = qstemm(j) * bza * 10. ! m^3 + ! leaching to septic layer + qout = bz_perc(j) * bza * 10. !m3/d + ! final volume + hvol = soil(j)%phys(bz_lyr)%st * bza * 10. + rtof = 0.5 - nh3_init = soil1(j)%mn(bz_lyr)%nh4 - no3_init = soil1(j)%mn(bz_lyr)%no3 - solp_init = soil1(j)%mp(bz_lyr)%lab + nh3_init = soil1(j)%mn(bz_lyr)%nh4 + no3_init = soil1(j)%mn(bz_lyr)%no3 + solp_init = soil1(j)%mp(bz_lyr)%lab - !! Failing system: STE saturates upper soil layers - if (sep(isep)%opt == 2) then - - ! increment the number of failing days - if(sep_tsincefail(j)>0) sep_tsincefail(j) = sep_tsincefail(j) + 1 + !! Failing system: STE saturates upper soil layers + if (sep(isep)%opt == 2) then + + ! increment the number of failing days + if(sep_tsincefail(j)>0) sep_tsincefail(j) = sep_tsincefail(j) + 1 ! convert the failing system into an active system if duration of failing ends - if (sep_tsincefail(j) >= sep(isep)%tfail) then - sep(isep)%opt = 1 + if (sep_tsincefail(j) >= sep(isep)%tfail) then + sep(isep)%opt = 1 soil(j)%phys(bz_lyr)%ul=sep(isep)%thk * & (soil(j)%phys(bz_lyr)%por - soil(j)%phys(bz_lyr)%wp) soil(j)%phys(bz_lyr)%fc=sep(isep)%thk*(soil(j)%phys(bz_lyr)%up- & soil(j)%phys(bz_lyr)%wp) - soil1(j)%mn(bz_lyr)%nh4 = 0 - soil1(j)%mn(bz_lyr)%no3 = 0 - soil1(j)%hsta(bz_lyr)%n = 0 - soil1(j)%hsta(bz_lyr)%p = 0 - soil1(j)%tot(bz_lyr)%p = 0 - soil1(j)%mp(bz_lyr)%lab = 0 + soil1(j)%mn(bz_lyr)%nh4 = 0 + soil1(j)%mn(bz_lyr)%no3 = 0 + soil1(j)%hsta(bz_lyr)%n = 0 + soil1(j)%hsta(bz_lyr)%p = 0 + soil1(j)%tot(bz_lyr)%p = 0 + soil1(j)%mp(bz_lyr)%lab = 0 soil1(j)%mp(bz_lyr)%act = 0 - biom(j) = 0 + biom(j) = 0 plqm(j) = 0 - bio_bod(j) = 0 - fcoli(j) = 0 - sep_tsincefail(j) = 0 - end if + bio_bod(j) = 0 + fcoli(j) = 0 + sep_tsincefail(j) = 0 + end if - return - endif + return + endif - !! Active system + !! Active system !! Water content(eqn 4-12), biozone hydraulic conductivity(eqn 4-9), - !! and percolation (eqn 4-8,10,11) are computed in percmain/percmicro + !! and percolation (eqn 4-8,10,11) are computed in percmain/percmicro - ! Add STE nutrients to appropriate soil pools in mass unit - xx = qin / bza / 1000. ! used for unit conversion: mg/l -> kg/ha + ! Add STE nutrients to appropriate soil pools in mass unit + xx = qin / bza / 1000. ! used for unit conversion: mg/l -> kg/ha soil1(j)%mn(bz_lyr)%no3 = soil1(j)%mn(bz_lyr)%no3 + xx * & (sepdb(sep(isep)%typ)%no3concs + & sepdb(sep(isep)%typ)%no2concs) @@ -188,93 +188,93 @@ subroutine sep_biozone bodi = bio_bod(j) * bza / qi * 1000. !mg/l - !! Field capacity in the biozone Eq. 4-6 ! + !! Field capacity in the biozone Eq. 4-6 ! soil(j)%phys(bz_lyr)%fc = soil(j)%phys(bz_lyr)%fc + sep(isep)%fc1 & * (soil(j)%phys(bz_lyr)%ul - soil(j)%phys(bz_lyr)%fc) ** & sep(isep)%fc2 * rbiom(j) / (sep(isep)%bd * 10) - !! Saturated water content in the biozone - Eq. 4-7 - ! mm = mm - kg/ha / (kg/m^3 * 10) + !! Saturated water content in the biozone - Eq. 4-7 + ! mm = mm - kg/ha / (kg/m^3 * 10) soil(j)%phys(bz_lyr)%ul = soil(j)%phys(bz_lyr)%por * & sep(isep)%thk-plqm(j) /(sep(isep)%bd*10.) - if(soil(j)%phys(bz_lyr)%ul.le.soil(j)%phys(bz_lyr)%fc) then - soil(j)%phys(bz_lyr)%ul = soil(j)%phys(bz_lyr)%fc - sep(isep)%opt = 2 - endif + if(soil(j)%phys(bz_lyr)%ul.le.soil(j)%phys(bz_lyr)%fc) then + soil(j)%phys(bz_lyr)%ul = soil(j)%phys(bz_lyr)%fc + sep(isep)%opt = 2 + endif - !! Respiration rate(kg/ha) Eq. 4-2 - rrsp = ctmp * sep(isep)%rsp * biom(j) + !! Respiration rate(kg/ha) Eq. 4-2 + rrsp = ctmp * sep(isep)%rsp * biom(j) - !! Mortality rate(kg/ha) Eq. 4-3 - rmort = ctmp * sep(isep)%mrt * biom(j) + !! Mortality rate(kg/ha) Eq. 4-3 + rmort = ctmp * sep(isep)%mrt * biom(j) - !! Slough-off rate(kg/ha) - rslg = sep(isep)%slg1 * bz_perc(j) ** sep(isep)%slg2 * biom(j) - - - !! Build up of plqm(kg/ha) Eq.4-5 - ! kg/ha (perday) = kg/ha + dimensionless * m^3/d * mg/l / (1000*ha) + !! Slough-off rate(kg/ha) + rslg = sep(isep)%slg1 * bz_perc(j) ** sep(isep)%slg2 * biom(j) + + + !! Build up of plqm(kg/ha) Eq.4-5 + ! kg/ha (perday) = kg/ha + dimensionless * m^3/d * mg/l / (1000*ha) rplqm = (rmort - rslg) + sep(isep)%plq * qin * & sepdb(sep(isep)%typ)%tssconcs / (1000. * bza) - rplqm = max(0.,rplqm) + rplqm = max(0.,rplqm) - !! Add build up to plqm ! kg/ha = kg/ha + kg/ha + !! Add build up to plqm ! kg/ha = kg/ha + kg/ha plqm(j) = plqm(j) + rplqm - - nh3_inflw_ste = xx * sepdb(sep(isep)%typ)%nh4concs - no3_inflow_ste = xx*(sepdb(sep(isep)%typ)%no3concs + & + + nh3_inflw_ste = xx * sepdb(sep(isep)%typ)%nh4concs + no3_inflow_ste = xx*(sepdb(sep(isep)%typ)%no3concs + & sepdb(sep(isep)%typ)%no2concs) - nh3_begin = soil1(j)%mn(bz_lyr)%nh4 - no3_begin = soil1(j)%mn(bz_lyr)%no3 - solp_begin = soil1(j)%mp(bz_lyr)%lab + nh3_begin = soil1(j)%mn(bz_lyr)%nh4 + no3_begin = soil1(j)%mn(bz_lyr)%no3 + solp_begin = soil1(j)%mp(bz_lyr)%lab - !! Add STE f.coli concentration by volumetric averaging + !! Add STE f.coli concentration by volumetric averaging xx = 10.* soil(j)%phys(bz_lyr)%st * bza / (qin & + 10.* soil(j)%phys(bz_lyr)%st * bza) - fcoli(j) = fcoli(j) * xx + sepdb(sep(isep)%typ)%fcolis * (1.- xx) ! J.Jeong 3/09/09 - - !! nutrients reaction rate (Equation 4-13) - rtrate = biom(j) * bza / (bz_vol * soil(j)%phys(bz_lyr)%por) - - !! BOD (kg/ha) 4-14 ! - bod_rt = max(0.,sep(isep)%bod_dc * rtrate) !bod + fcoli(j) = fcoli(j) * xx + sepdb(sep(isep)%typ)%fcolis * (1.- xx) ! J.Jeong 3/09/09 + + !! nutrients reaction rate (Equation 4-13) + rtrate = biom(j) * bza / (bz_vol * soil(j)%phys(bz_lyr)%por) + + !! BOD (kg/ha) 4-14 ! + bod_rt = max(0.,sep(isep)%bod_dc * rtrate) !bod if (bod_rt>4) bod_rt=4 - rbod = bodi * (1.- Exp(-bod_rt)) - bode = bodi - rbod !mg/l - bio_bod(j) = bode * (soil(j)%phys(bz_lyr)%st * 10)/1000. !kg/ha + rbod = bodi * (1.- Exp(-bod_rt)) + bode = bodi - rbod !mg/l + bio_bod(j) = bode * (soil(j)%phys(bz_lyr)%st * 10)/1000. !kg/ha - !! Fecal coliform(cfu/100ml) Eq 4-14, J.Jeong 3/09/09 - fcoli_rt = max(0.,sep(isep)%fecal * rtrate) !fecal coliform - rfcoli = fcoli(j) * (1.- exp(-fcoli_rt)) - fcoli(j) = fcoli(j) - rfcoli + !! Fecal coliform(cfu/100ml) Eq 4-14, J.Jeong 3/09/09 + fcoli_rt = max(0.,sep(isep)%fecal * rtrate) !fecal coliform + rfcoli = fcoli(j) * (1.- exp(-fcoli_rt)) + fcoli(j) = fcoli(j) - rfcoli - !! change in nh3 & no3 in soil pools due to nitrification(kg/ha) Eq.4-13, 4-14 - ntr_rt = max(0.,sep(isep)%nitr * rtrate) !nitrification - rnit = soil1(j)%mn(bz_lyr)%nh4 * (1. - Exp(-ntr_rt)) !! J.Jeong 4/03/09 - soil1(j)%mn(bz_lyr)%nh4 = soil1(j)%mn(bz_lyr)%nh4 - rnit !J.Jeong 3/09/09 - soil1(j)%mn(bz_lyr)%no3 = soil1(j)%mn(bz_lyr)%no3 + rnit !J.Jeong 3/09/09 - - !ammonium percolation - nperc = 0.2 * qout / qi * soil1(j)%mn(bz_lyr)%nh4 - nperc = min(nperc,0.5 * soil1(j)%mn(bz_lyr)%nh4) - soil1(j)%mn(bz_lyr)%nh4 = soil1(j)%mn(bz_lyr)%nh4 - nperc - soil1(j)%mn(bz_lyr+1)%nh4 = soil1(j)%mn(bz_lyr+1)%nh4 + nperc + !! change in nh3 & no3 in soil pools due to nitrification(kg/ha) Eq.4-13, 4-14 + ntr_rt = max(0.,sep(isep)%nitr * rtrate) !nitrification + rnit = soil1(j)%mn(bz_lyr)%nh4 * (1. - Exp(-ntr_rt)) !! J.Jeong 4/03/09 + soil1(j)%mn(bz_lyr)%nh4 = soil1(j)%mn(bz_lyr)%nh4 - rnit !J.Jeong 3/09/09 + soil1(j)%mn(bz_lyr)%no3 = soil1(j)%mn(bz_lyr)%no3 + rnit !J.Jeong 3/09/09 + + !ammonium percolation + nperc = 0.2 * qout / qi * soil1(j)%mn(bz_lyr)%nh4 + nperc = min(nperc,0.5 * soil1(j)%mn(bz_lyr)%nh4) + soil1(j)%mn(bz_lyr)%nh4 = soil1(j)%mn(bz_lyr)%nh4 - nperc + soil1(j)%mn(bz_lyr+1)%nh4 = soil1(j)%mn(bz_lyr+1)%nh4 + nperc - !! denitrification,(kg/ha) Eq 4-14 - dentr_rt = max(0.,sep(isep)%denitr * rtrate) !denitrification - rdenit = soil1(j)%mn(bz_lyr)%no3 * (1. - Exp(-dentr_rt)) !J.Jeong 3/09/09 - soil1(j)%mn(bz_lyr)%no3 = soil1(j)%mn(bz_lyr)%no3 - rdenit !J.Jeong 3/09/09 + !! denitrification,(kg/ha) Eq 4-14 + dentr_rt = max(0.,sep(isep)%denitr * rtrate) !denitrification + rdenit = soil1(j)%mn(bz_lyr)%no3 * (1. - Exp(-dentr_rt)) !J.Jeong 3/09/09 + soil1(j)%mn(bz_lyr)%no3 = soil1(j)%mn(bz_lyr)%no3 - rdenit !J.Jeong 3/09/09 - !soil volume for sorption: soil thickness below biozone + !soil volume for sorption: soil thickness below biozone svolp = (soil(j)%phys(nly)%d - sep(isep)%z) * bza * 10. !m3, !max adsorption amnt: linear isotherm, McCray 2005 solpconc = soil1(j)%mp(bz_lyr)%lab * bza / qi * 1000. !mg/l - solpsorb = min(sep(isep)%pdistrb * solpconc,sep(isep)%psorpmax) !mgP/kgSoil - solpsorb = 1.6 * 1.e-3 * solpsorb * svolp * & - (1-soil(j)%phys(bz_lyr)%por) !kgP sorption potential + solpsorb = min(sep(isep)%pdistrb * solpconc,sep(isep)%psorpmax) !mgP/kgSoil + solpsorb = 1.6 * 1.e-3 * solpsorb * svolp * & + (1-soil(j)%phys(bz_lyr)%por) !kgP sorption potential !check if max. P sorption is reached if(soil1(j)%mp(bz_lyr)%lab * bza .0001) then + if (surfq(j) > .0001) then !! vfs comnposed of two sections one with more concentrated flow than the other !! Calculate drainage area of vfs 1 2 3 in ha - drain_vfs1 = (1. - hru(j)%lumv%vfscon)* hru(j)%area_ha - drain_vfs2 = ((1. - hru(j)%lumv%vfsch) * hru(j)%lumv%vfscon)* hru(j)%area_ha - drain_vfs3 = hru(j)%lumv%vfscon * hru(j)%lumv%vfsch * hru(j)%area_ha + drain_vfs1 = (1. - hru(j)%lumv%vfscon)* hru(j)%area_ha + drain_vfs2 = ((1. - hru(j)%lumv%vfsch) * hru(j)%lumv%vfscon)* hru(j)%area_ha + drain_vfs3 = hru(j)%lumv%vfscon * hru(j)%lumv%vfsch * hru(j)%area_ha !! Calculate area of vfs 1 and 2 in ha - area_vfs1 = hru(j)%area_ha * 0.9 / hru(j)%lumv%vfsratio - area_vfs2 = hru(j)%area_ha * 0.1 / hru(j)%lumv%vfsratio + area_vfs1 = hru(j)%area_ha * 0.9 / hru(j)%lumv%vfsratio + area_vfs2 = hru(j)%area_ha * 0.1 / hru(j)%lumv%vfsratio - !! Calculate drainage area to vfs area ratio (unitless) - vfs_ratio1 = drain_vfs1/area_vfs1 - vfs_ratio2 = drain_vfs2/area_vfs2 + !! Calculate drainage area to vfs area ratio (unitless) + vfs_ratio1 = drain_vfs1/area_vfs1 + vfs_ratio2 = drain_vfs2/area_vfs2 !! calculate runoff depth over buffer area in mm - vfs_depth1 = vfs_ratio1 * surfq(j) - vfs_depth2 = vfs_ratio2 * surfq(j) + vfs_depth1 = vfs_ratio1 * surfq(j) + vfs_depth2 = vfs_ratio2 * surfq(j) !! calculate sediment loading over buffer area in kg/m^2 - vfs_sed1 = (sedyld(j) / hru(j)%area_ha * 1000. * drain_vfs1) / (area_vfs1 * 10000.) - vfs_sed2 = (sedyld(j) / hru(j)%area_ha * 1000. * drain_vfs2) / (area_vfs2 * 10000.) + vfs_sed1 = (sedyld(j) / hru(j)%area_ha * 1000. * drain_vfs1) / (area_vfs1 * 10000.) + vfs_sed2 = (sedyld(j) / hru(j)%area_ha * 1000. * drain_vfs2) / (area_vfs2 * 10000.) !! calculate Runoff Removal by vfs (used for nutrient removal estimation only) based on runoff depth and ksat !! Based on vfsmod simulations surq_remove1 = 75.8-10.8 * Log(vfs_depth1) + 25.9 * Log(soil(j)%phys(1)%k) - if (surq_remove1 > 100.) surq_remove1 = 100. - if (surq_remove1 < 0.) surq_remove1 = 0. + if (surq_remove1 > 100.) surq_remove1 = 100. + if (surq_remove1 < 0.) surq_remove1 = 0. surq_remove2 = 75.8-10.8 * Log(vfs_depth2) + 25.9 * Log(soil(j)%phys(1)%k) - if (surq_remove2 > 100.) surq_remove2 = 100. - if (surq_remove2 < 0.) surq_remove2 = 0. + if (surq_remove2 > 100.) surq_remove2 = 100. + if (surq_remove2 < 0.) surq_remove2 = 0. - surq_remove = (surq_remove1 * drain_vfs1 + surq_remove2 * drain_vfs2)/hru(j)%area_ha + surq_remove = (surq_remove1 * drain_vfs1 + surq_remove2 * drain_vfs2)/hru(j)%area_ha !! calculate sediment Removal - Based on measured data from literature - sed_remove1 = 79.0 - 1.04 * vfs_sed1 + 0.213 * surq_remove1 - if (sed_remove1 > 100.) sed_remove1 = 100. - if (sed_remove1 < 0.) sed_remove1 = 0. + sed_remove1 = 79.0 - 1.04 * vfs_sed1 + 0.213 * surq_remove1 + if (sed_remove1 > 100.) sed_remove1 = 100. + if (sed_remove1 < 0.) sed_remove1 = 0. - sed_remove2 = 79.0 - 1.04 * vfs_sed2 + 0.213 * surq_remove1 - if (sed_remove2 > 100.) sed_remove2 = 100. - if (sed_remove2 < 0.) sed_remove2 = 0. + sed_remove2 = 79.0 - 1.04 * vfs_sed2 + 0.213 * surq_remove1 + if (sed_remove2 > 100.) sed_remove2 = 100. + if (sed_remove2 < 0.) sed_remove2 = 0. - sed_remove = (sed_remove1 * drain_vfs1 + sed_remove2 * drain_vfs2) / hru(j)%area_ha - - sedyld(j) = sedyld(j) * (1. - sed_remove / 100.) + sed_remove = (sed_remove1 * drain_vfs1 + sed_remove2 * drain_vfs2) / hru(j)%area_ha + + sedyld(j) = sedyld(j) * (1. - sed_remove / 100.) sedyld(j) = Max(0., sedyld(j)) - sedtrap = sedyld(j) * sed_remove / 100. - xrem = 0. + sedtrap = sedyld(j) * sed_remove / 100. + xrem = 0. if (sedtrap <= lagyld(j)) then lagyld(j) = lagyld(j) - sedtrap @@ -174,59 +174,59 @@ subroutine smp_filter !! Calculate Organic Nitrogen Removal !! Based on measured data from literature - remove1 = 0.036 * sed_remove1 ** 1.69 - if (remove1 > 100.) remove1 = 100. - if (remove1 < 0.) remove1 = 0. + remove1 = 0.036 * sed_remove1 ** 1.69 + if (remove1 > 100.) remove1 = 100. + if (remove1 < 0.) remove1 = 0. - remove2 = 0.036 * sed_remove2 ** 1.69 - if (remove2 > 100.) remove2 = 100. - if (remove2 < 0.) remove2 = 0. - - orgn_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha - sedorgn(j) = sedorgn(j) * (1. - orgn_remove / 100.) + remove2 = 0.036 * sed_remove2 ** 1.69 + if (remove2 > 100.) remove2 = 100. + if (remove2 < 0.) remove2 = 0. + + orgn_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha + sedorgn(j) = sedorgn(j) * (1. - orgn_remove / 100.) !! calculate Nitrate removal from surface runoff !! Based on measured data from literature - - remove1 = 39.4 + 0.584 * surq_remove1 - if (remove1 > 100.) remove1 = 100. - if (remove1 < 0.) remove1 = 0. + + remove1 = 39.4 + 0.584 * surq_remove1 + if (remove1 > 100.) remove1 = 100. + if (remove1 < 0.) remove1 = 0. - remove2 = 39.4 + 0.584 * surq_remove2 - if (remove2 > 100.) remove2 = 100. + remove2 = 39.4 + 0.584 * surq_remove2 + if (remove2 > 100.) remove2 = 100. if (remove2 < 0.) remove2 = 0. surqno3_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha - surqno3(j) = surqno3(j) * (1. - surqno3_remove / 100.) + surqno3(j) = surqno3(j) * (1. - surqno3_remove / 100.) !! calculate Particulate P removal from surface runoff !!Based on measured data from literature - remove1 = 0.903 * sed_remove1 - if (remove1 > 100.) remove1 = 100. - if (remove1 < 0.) remove1 = 0. - - remove2 = 0.903 * sed_remove2 - if (remove2 > 100.) remove2 = 100. - if (remove2 < 0.) remove2 = 0. + remove1 = 0.903 * sed_remove1 + if (remove1 > 100.) remove1 = 100. + if (remove1 < 0.) remove1 = 0. + + remove2 = 0.903 * sed_remove2 + if (remove2 > 100.) remove2 = 100. + if (remove2 < 0.) remove2 = 0. - partP_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha - sedminpa(j) = sedminpa(j) * (1. - partP_remove / 100.) - sedminps(j) = sedminps(j) * (1. - partP_remove / 100.) - sedorgp(j) = sedorgp(j) * (1. - partP_remove / 100.) + partP_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha + sedminpa(j) = sedminpa(j) * (1. - partP_remove / 100.) + sedminps(j) = sedminps(j) * (1. - partP_remove / 100.) + sedorgp(j) = sedorgp(j) * (1. - partP_remove / 100.) !! Calculate Soluble P removal from surface runoff !! DP% = - 6.14 + 1.13 Runoff% - remove1 = 29.3 + 0.51 * surq_remove1 - if (remove1 > 100.) remove1 = 100. - if (remove1 < 0.) remove1 = 0. - - remove21 = 29.3 + 0.51 * surq_remove2 - if (remove2 > 100.) remove2 = 100. - if (remove2 < 0.) remove2 = 0. + remove1 = 29.3 + 0.51 * surq_remove1 + if (remove1 > 100.) remove1 = 100. + if (remove1 < 0.) remove1 = 0. + + remove21 = 29.3 + 0.51 * surq_remove2 + if (remove2 > 100.) remove2 = 100. + if (remove2 < 0.) remove2 = 0. - solp_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha - surqsolp(j) = surqsolp(j) * (1. - solp_remove / 100.) + solp_remove = (remove1 * drain_vfs1 + remove2 * drain_vfs2)/hru(j)%area_ha + surqsolp(j) = surqsolp(j) * (1. - solp_remove / 100.) !! Calculate pesticide removal !! based on the sediment and runoff removal only @@ -235,7 +235,7 @@ subroutine smp_filter hpestb_d(j)%pest(k)%sed = hpestb_d(j)%pest(k)%sed * (1. - sed_remove / 100.) end do - end if ! if (surfq(j) > .0001) + end if ! if (surfq(j) > .0001) return end subroutine smp_filter \ No newline at end of file diff --git a/src/smp_grass_wway.f90 b/src/smp_grass_wway.f90 index 44c011d..930ef0b 100644 --- a/src/smp_grass_wway.f90 +++ b/src/smp_grass_wway.f90 @@ -6,12 +6,12 @@ subroutine smp_grass_wway !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ihru |none |HRU number -!! surfq(:) |mm H2O |amount of water in surface runoff generated -!! grwat_l(:) |km |Length of Grass Waterway -!! grwat_w(:) |none |Width of grass waterway -!! grwat_s(:) |m/m |Slope of grass waterway -!! grwat_spcon(:) |none |sediment transport coefficant defined by user -!! tc_gwat(:) |none |Time of concentration for Grassed waterway and its drainage area +!! surfq(:) |mm H2O |amount of water in surface runoff generated +!! grwat_l(:) |km |Length of Grass Waterway +!! grwat_w(:) |none |Width of grass waterway +!! grwat_s(:) |m/m |Slope of grass waterway +!! grwat_spcon(:) |none |sediment transport coefficant defined by user +!! tc_gwat(:) |none |Time of concentration for Grassed waterway and its drainage area !! surfq(:) |mm H2O |surface runoff generated on day in HRU !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~ @@ -22,7 +22,7 @@ subroutine smp_grass_wway !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! qp_cms |m^3/s |peak runoff rate for the day -!! rcharea |m^2 |cross-sectional area of flow +!! rcharea |m^2 |cross-sectional area of flow !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ @@ -42,15 +42,15 @@ subroutine smp_grass_wway real :: sed_remove = 0. !% |percent of sediment capture in VFS real :: sf_sed = 0. !kg/m^2 |sediment loads on sides of waterway real :: vc = 0. !m/s |flow velocity in reach - real :: chflow_day = 0. !m^3/day |Runoff + real :: chflow_day = 0. !m^3/day |Runoff integer :: j = 0 !none |HRU number real :: rchdep = 0. !m |depth of flow on day real :: p = 0. ! | real :: rh = 0. !m |hydraulic radius real :: qman !m^3/s or m/s |flow rate or flow velocity - real :: sedin = 0. !mg |Sediment in waterway + real :: sedin = 0. !mg |Sediment in waterway real :: sf_depth = 0. ! | - real :: sedint = 0. !mg |Sediment into waterway channel + real :: sedint = 0. !mg |Sediment into waterway channel real :: cyin = 0. ! | real :: cych = 0. ! | real :: rcharea = 0. @@ -58,23 +58,23 @@ subroutine smp_grass_wway real :: deg = 0. !metric tons |sediment reentrained in water by channel ! |degradation real :: dep = 0. ! | - real :: sedout = 0. !mg | Sediment out of waterway channel + real :: sedout = 0. !mg | Sediment out of waterway channel real :: sed_frac = 0. ! | real :: surq_frac = 0. ! | real :: sedtrap = 0. ! | real :: xrem = 0. ! | integer :: k = 0 !m^3/s |Total number of HRUs plus this HRU number -!! set variables +!! set variables j = ihru -!! do this only if there is surface runoff this day +!! do this only if there is surface runoff this day if (surfq(j) > 0.001) then !! compute channel peak rate using SCS triangular unit hydrograph -!! Calculate average flow based on 3 hours of runoff - chflow_day = 1000. * surfq(j) * hru(ihru)%km +!! Calculate average flow based on 3 hours of runoff + chflow_day = 1000. * surfq(j) * hru(ihru)%km chflow_m3 = chflow_day/10800 qp_cms = 2. * chflow_m3 / (1.5 * tc_gwat(j)) @@ -100,40 +100,40 @@ subroutine smp_grass_wway !! Sediment yield (kg) from fraction of area drained by waterway - sedin = sedyld(ihru) * hru(ihru)%km + sedin = sedyld(ihru) * hru(ihru)%km !! Calculate sediment losses in sheetflow at waterway sides !! calculate area of sheeflow in m^2 assumne *:1 side slope 8.06 = (8^2+1^2)^.5 - sf_area = (hru(j)%lumv%grwat_d - rchdep) * 8.06 * hru(j)%lumv%grwat_l * 1000 + sf_area = (hru(j)%lumv%grwat_d - rchdep) * 8.06 * hru(j)%lumv%grwat_l * 1000 !! Adjust Area to account for flow nonuniformities White and Arnold 2009 found half of flow in VFS !!handled by 10% of VFS area. Waterways likely even more concentrated Assume only 20% of sideslope acts as filters if (sf_area > 1.e-6) then - sf_area = sf_area * 0.20 + sf_area = sf_area * 0.20 !! calculate runoff depth over sheetflow area in mm - sf_depth=surfq(j) * hru(ihru)%km * 1000000/sf_area + sf_depth=surfq(j) * hru(ihru)%km * 1000000/sf_area !! Calculate sediment load on sheetflow area kg/ha - sf_sed = sedin * 1000 / sf_area + sf_sed = sedin * 1000 / sf_area !! Calculate runoff and sediment losses taken from mostly from filter.f end if - if (sf_area > 0.) then -!! surq_remove = 75.8 - 10.8 * Log(sf_depth) + 25.9 + if (sf_area > 0.) then +!! surq_remove = 75.8 - 10.8 * Log(sf_depth) + 25.9 !! & * Log(sol_k(1,j)) - !! Simpler form derived from vfsmod simulations. r2 = 0.57 Publication pending white and arnold 2008 + !! Simpler form derived from vfsmod simulations. r2 = 0.57 Publication pending white and arnold 2008 - surq_remove = 95.6 - 10.79 * Log(sf_depth) - if (surq_remove > 100.) surq_remove = 100. - if (surq_remove < 0.) surq_remove = 0. + surq_remove = 95.6 - 10.79 * Log(sf_depth) + if (surq_remove > 100.) surq_remove = 100. + if (surq_remove < 0.) surq_remove = 0. - sed_remove = 79.0 - 1.04 * sf_sed + 0.213 * surq_remove - if (sed_remove > 100.) sed_remove = 100. - if (sed_remove < 0.) sed_remove = 0. + sed_remove = 79.0 - 1.04 * sf_sed + 0.213 * surq_remove + if (sed_remove > 100.) sed_remove = 100. + if (sed_remove < 0.) sed_remove = 0. - Else - sed_remove = 0 - surq_remove = 0 - endif - sedint = sedin * (1. - sed_remove / 100.) + Else + sed_remove = 0 + surq_remove = 0 + endif + sedint = sedin * (1. - sed_remove / 100.) !! calculate flow velocity vc = 0.001 @@ -157,59 +157,59 @@ subroutine smp_grass_wway !! Calculate deposition in mg depnet = chflow_day * (cyin - cych) if (depnet < 0.) depnet = 0 - if (depnet > sedint) depnet = sedint + if (depnet > sedint) depnet = sedint endif !! Calculate sediment out of waterway channel - sedout = sedint - depnet + sedout = sedint - depnet !! Calculate total fraction of sediment and surface runoff transported if (sedyld(j) < .0001) sedyld(j) = .0001 - sed_frac = sedout/sedyld(j) + sed_frac = sedout/sedyld(j) - surq_frac = 1 - surq_remove/100 + surq_frac = 1 - surq_remove/100 !! Subtract reductions from sediment, nutrients, bacteria, and pesticides NOT SURFACE RUNOFF to protect water balance sedtrap = sedyld(j) * (1. - sed_frac) - sedyld(j) = sedyld(j) * sed_frac - sedminpa(j) = sedminpa(j) * sed_frac - sedminps(j) = sedminps(j) * sed_frac - sedorgp(j) = sedorgp(j) * sed_frac - surqsolp(j) = surqsolp(j) * surq_frac - sedorgn(j) = sedorgn(j) * sed_frac - surqno3(j) = surqno3(j) * surq_frac + sedyld(j) = sedyld(j) * sed_frac + sedminpa(j) = sedminpa(j) * sed_frac + sedminps(j) = sedminps(j) * sed_frac + sedorgp(j) = sedorgp(j) * sed_frac + surqsolp(j) = surqsolp(j) * surq_frac + sedorgn(j) = sedorgn(j) * sed_frac + surqno3(j) = surqno3(j) * surq_frac xrem = 0. - if (sedtrap <= lagyld(j)) then - lagyld(j) = lagyld(j) - sedtrap - else - xrem = sedtrap - lagyld(j) - lagyld(j) = 0. - if (xrem <= sanyld(j)) then - sanyld(j) = sanyld(j) - xrem - else - xrem = xrem - sanyld(j) - sanyld(j) = 0. - if (xrem <= sagyld(j)) then - sagyld(j) = sagyld(j) - xrem - else - xrem = xrem - sagyld(j) - sagyld(j) = 0. - if (xrem <= silyld(j)) then - silyld(j) = silyld(j) - xrem - else - xrem = xrem - silyld(j) - silyld(j) = 0. - if (xrem <= clayld(j)) then - clayld(j) = clayld(j) - xrem - else - xrem = xrem - clayld(j) - clayld(j) = 0. - end if - end if - end if - end if - end if + if (sedtrap <= lagyld(j)) then + lagyld(j) = lagyld(j) - sedtrap + else + xrem = sedtrap - lagyld(j) + lagyld(j) = 0. + if (xrem <= sanyld(j)) then + sanyld(j) = sanyld(j) - xrem + else + xrem = xrem - sanyld(j) + sanyld(j) = 0. + if (xrem <= sagyld(j)) then + sagyld(j) = sagyld(j) - xrem + else + xrem = xrem - sagyld(j) + sagyld(j) = 0. + if (xrem <= silyld(j)) then + silyld(j) = silyld(j) - xrem + else + xrem = xrem - silyld(j) + silyld(j) = 0. + if (xrem <= clayld(j)) then + clayld(j) = clayld(j) - xrem + else + xrem = xrem - clayld(j) + clayld(j) = 0. + end if + end if + end if + end if + end if sanyld(j) = Max(0., sanyld(j)) silyld(j) = Max(0., silyld(j)) clayld(j) = Max(0., clayld(j)) diff --git a/src/soil_data_module.f90 b/src/soil_data_module.f90 index c57f907..5d6f077 100644 --- a/src/soil_data_module.f90 +++ b/src/soil_data_module.f90 @@ -12,7 +12,7 @@ module soil_data_module type soiltest_db character(len=16) :: name = "default" - real :: exp_co = .001 ! |depth coefficient to adjust concentrations for depth + real :: exp_co = .001 ! |depth coefficient to adjust concentrations for depth real :: lab_p = 5. !ppm |labile P in soil surface real :: nitrate = 7. !ppm |nitrate N in soil surface real :: fr_hum_act = .02 !0-1 |fraction of soil humus that is active @@ -29,7 +29,7 @@ module soil_data_module !!!!!! OLD type type soiltest_db_old character(len=16) :: name = "default" - real :: exp_co = .001 ! |depth coefficient to adjust concentrations for depth + real :: exp_co = .001 ! |depth coefficient to adjust concentrations for depth real :: totaln = 13. !ppm |total N in soil real :: inorgn = 6. !ppm |inorganic N in soil surface real :: orgn = 3. !ppm |organic N in soil surface diff --git a/src/soil_nutcarb_init.f90 b/src/soil_nutcarb_init.f90 index c911954..b08ee50 100644 --- a/src/soil_nutcarb_init.f90 +++ b/src/soil_nutcarb_init.f90 @@ -75,15 +75,15 @@ subroutine soil_nutcarb_init (isol) soil1(ihru)%mp(ly)%lab = soil1(ihru)%mp(ly)%lab * wt1 !! mg/kg => kg/ha !! set active mineral P pool based on dynamic PSP MJW - if (bsn_cc%sol_P_model == 1) then - !! Allow Dynamic PSP Ratio + if (bsn_cc%sol_P_model == 1) then + !! Allow Dynamic PSP Ratio !! convert to concentration solp = soil1(ihru)%mp(ly)%lab / wt1 - !! PSP = -0.045*log (% clay) + 0.001*(Solution P, mg kg-1) - 0.035*(% Organic C) + 0.43 - if (soil(ihru)%phys(ly)%clay > 0.) then + !! PSP = -0.045*log (% clay) + 0.001*(Solution P, mg kg-1) - 0.035*(% Organic C) + 0.43 + if (soil(ihru)%phys(ly)%clay > 0.) then psp = -0.045 * log(soil(ihru)%phys(ly)%clay) + (0.001 * solp) psp = psp - (0.035 * soil1(ihru)%cbn(ly)) + 0.43 - endif + endif !! Limit PSP range if (psp < .10) then psp = 0.10 @@ -96,24 +96,24 @@ subroutine soil_nutcarb_init (isol) soil1(ihru)%mp(ly)%act = soil1(ihru)%mp(ly)%lab * (1. - psp) / psp !! Set Stable pool based on dynamic coefficient - if (bsn_cc%sol_P_model == 1) then !! From White et al 2009 + if (bsn_cc%sol_P_model == 1) then !! From White et al 2009 !! convert to concentration for ssp calculation - actp = soil1(ihru)%mp(ly)%act / wt1 - solp = soil1(ihru)%mp(ly)%lab / wt1 + actp = soil1(ihru)%mp(ly)%act / wt1 + solp = soil1(ihru)%mp(ly)%lab / wt1 !! estimate Total Mineral P in this soil based on data from sharpley 2004 - ssp = 25.044 * (actp + solp)** (-0.3833) - !!limit SSP Range - if (ssp > 7.) ssp = 7. - if (ssp < 1.) ssp = 1. - soil1(ihru)%mp(ly)%sta = ssp * (soil1(ihru)%mp(ly)%act + soil1(ihru)%mp(ly)%lab) + ssp = 25.044 * (actp + solp)** (-0.3833) + !!limit SSP Range + if (ssp > 7.) ssp = 7. + if (ssp < 1.) ssp = 1. + soil1(ihru)%mp(ly)%sta = ssp * (soil1(ihru)%mp(ly)%act + soil1(ihru)%mp(ly)%lab) else - !! the original code - soil1(ihru)%mp(ly)%sta = 4. * soil1(ihru)%mp(ly)%act - end if + !! the original code + soil1(ihru)%mp(ly)%sta = 4. * soil1(ihru)%mp(ly)%act + end if end do !! set initial organic pools - originally by Zhang - do ly = 1, nly + do ly = 1, nly !initialize total soil organic pool - no litter !kg/ha = mm * t/m3 * m/1,000 mm * 1,000 kg/t * 10,000 m2/ha @@ -192,7 +192,7 @@ subroutine soil_nutcarb_init (isol) !soil1(ihru)%water(ly)%n = !soil1(ihru)%water(ly)%p = - end do + end do return end subroutine soil_nutcarb_init \ No newline at end of file diff --git a/src/soil_phys_init.f90 b/src/soil_phys_init.f90 index 8c9ab4b..d8f89cb 100644 --- a/src/soil_phys_init.f90 +++ b/src/soil_phys_init.f90 @@ -62,13 +62,13 @@ subroutine soil_phys_init (isol) if (sol(isol)%phys(j)%k <= 0.0) then if (sol(isol)%s%hydgrp == "A") then sol(isol)%phys(j)%k = a - else + else if (sol(isol)%s%hydgrp == "B") then sol(isol)%phys(j)%k = b - else + else if (sol(isol)%s%hydgrp == "C") then sol(isol)%phys(j)%k = c - else + else if (sol(isol)%s%hydgrp == "D") then sol(isol)%phys(j)%k = d !Claire 12/2/09 else @@ -131,15 +131,15 @@ subroutine soil_phys_init (isol) sol(isol)%s%det_lag = 1. - sol(isol)%s%det_san - & sol(isol)%s%det_sil - sol(isol)%s%det_cla - sol(isol)%s%det_sag !! Large Aggregate fraction -!! Error check. May happen for soils with more sand +!! Error check. May happen for soils with more sand !! Soil not typical of mid-western USA !! The fraction wont add upto 1.0 - if (sol(isol)%s%det_lag < 0.) then - sol(isol)%s%det_san = sol(isol)%s%det_san/(1 - sol(isol)%s%det_lag) - sol(isol)%s%det_sil = sol(isol)%s%det_sil/(1 - sol(isol)%s%det_lag) - sol(isol)%s%det_cla = sol(isol)%s%det_cla/(1 - sol(isol)%s%det_lag) - sol(isol)%s%det_sag = sol(isol)%s%det_sag/(1 - sol(isol)%s%det_lag) - sol(isol)%s%det_lag = 0. + if (sol(isol)%s%det_lag < 0.) then + sol(isol)%s%det_san = sol(isol)%s%det_san/(1 - sol(isol)%s%det_lag) + sol(isol)%s%det_sil = sol(isol)%s%det_sil/(1 - sol(isol)%s%det_lag) + sol(isol)%s%det_cla = sol(isol)%s%det_cla/(1 - sol(isol)%s%det_lag) + sol(isol)%s%det_sag = sol(isol)%s%det_sag/(1 - sol(isol)%s%det_lag) + sol(isol)%s%det_lag = 0. end if !! initialize water/drainage coefs for each soil layer diff --git a/src/soil_text_init.f90 b/src/soil_text_init.f90 index 87f0672..8c474d5 100644 --- a/src/soil_text_init.f90 +++ b/src/soil_text_init.f90 @@ -55,12 +55,12 @@ subroutine soil_text_init (isol) !! Error check. May happen for soils with more sand !! Soil not typical of mid-western USA The fraction wont add upto 1.0 - if (soil(isol)%det_lag < 0.) then - soil(isol)%det_san = soil(isol)%det_san/(1 - soil(isol)%det_lag) - soil(isol)%det_sil = soil(isol)%det_sil/(1 - soil(isol)%det_lag) - soil(isol)%det_cla = soil(isol)%det_cla/(1 - soil(isol)%det_lag) - soil(isol)%det_sag = soil(isol)%det_sag/(1 - soil(isol)%det_lag) - soil(isol)%det_lag = 0. + if (soil(isol)%det_lag < 0.) then + soil(isol)%det_san = soil(isol)%det_san/(1 - soil(isol)%det_lag) + soil(isol)%det_sil = soil(isol)%det_sil/(1 - soil(isol)%det_lag) + soil(isol)%det_cla = soil(isol)%det_cla/(1 - soil(isol)%det_lag) + soil(isol)%det_sag = soil(isol)%det_sag/(1 - soil(isol)%det_lag) + soil(isol)%det_lag = 0. end if return diff --git a/src/soils_init.f90 b/src/soils_init.f90 index 4240763..30894f5 100644 --- a/src/soils_init.f90 +++ b/src/soils_init.f90 @@ -134,7 +134,7 @@ subroutine soils_init if (sep(isep)%opt /= 0) then dep_new1 = 0. dep_new2 = 0. - if (sep(isep)%z + sep(isep)%thk > soil(ihru)%phys(nly)%d) then + if (sep(isep)%z + sep(isep)%thk > soil(ihru)%phys(nly)%d) then i_sep(ihru) = nly + 1 dep_new1 = sep(isep)%z - sep(isep)%thk dep_new2 = 0. diff --git a/src/sq_surfst.f90 b/src/sq_surfst.f90 index 594ff55..1478e77 100644 --- a/src/sq_surfst.f90 +++ b/src/sq_surfst.f90 @@ -42,29 +42,29 @@ subroutine sq_surfst j = ihru - if (bsn_cc%gampt == 0) then + if (bsn_cc%gampt == 0) then bsprev = surf_bs(1,j) - surf_bs(1,j) = Max(1.e-6, surf_bs(1,j) + surfq(j)) + surf_bs(1,j) = Max(1.e-6, surf_bs(1,j) + surfq(j)) qday = surf_bs(1,j) * brt(j) surf_bs(1,j) = surf_bs(1,j) - qday - else - bsprev = hhsurf_bs(1,j,time%step) ! lag from previous day J.Jeong 4/06/2009 + else + bsprev = hhsurf_bs(1,j,time%step) ! lag from previous day J.Jeong 4/06/2009 qday = 0. - do k=1,time%step - !! Left-over (previous timestep) + inflow (current timestep) + do k=1,time%step + !! Left-over (previous timestep) + inflow (current timestep) hhsurf_bs(1,j,k) = Max(0., bsprev + hhsurfq(j,k)) - - !! new estimation of runoff and sediment reaching the main channel - hhsurfq(j,k) = hhsurf_bs(1,j,k) * brt(j) - hhsurf_bs(1,j,k) = hhsurf_bs(1,j,k) - hhsurfq(j,k) - - !! lagged at the end of time step - bsprev = hhsurf_bs(1,j,k) + + !! new estimation of runoff and sediment reaching the main channel + hhsurfq(j,k) = hhsurf_bs(1,j,k) * brt(j) + hhsurf_bs(1,j,k) = hhsurf_bs(1,j,k) - hhsurfq(j,k) + + !! lagged at the end of time step + bsprev = hhsurf_bs(1,j,k) !! daily total yield from the HRU - qday = qday + hhsurfq(j,k) - end do - end if + qday = qday + hhsurfq(j,k) + end do + end if return end subroutine sq_surfst \ No newline at end of file diff --git a/src/stmp_solt.f90 b/src/stmp_solt.f90 index 9d4746c..e4f75e3 100644 --- a/src/stmp_solt.f90 +++ b/src/stmp_solt.f90 @@ -132,10 +132,10 @@ subroutine stmp_solt isep = iseptic(j) if (sep(isep)%opt /= 0 .and. time%yrc >= sep(isep)%yr .and. k >= & i_sep(j)) then - if (soil(j)%phys(k)%tmp < 10.) then - soil(j)%phys(k)%tmp = 10. - (10. - soil(j)%phys(k)%tmp) * 0.1 - end if - endif + if (soil(j)%phys(k)%tmp < 10.) then + soil(j)%phys(k)%tmp = 10. - (10. - soil(j)%phys(k)%tmp) * 0.1 + end if + endif end do diff --git a/src/stor_surfstor.f90 b/src/stor_surfstor.f90 index 8c44398..e886367 100644 --- a/src/stor_surfstor.f90 +++ b/src/stor_surfstor.f90 @@ -98,23 +98,23 @@ subroutine stor_surfstor surf_bs(2,j) = surf_bs(2,j) - sedyld(j) else !subdaily time steps, Jaehak Jeong 2011 - sedprev = hhsurf_bs(2,j,time%step) + sedprev = hhsurf_bs(2,j,time%step) - do k=1,time%step - !! Left-over (previous timestep) + inflow (current timestep) + do k=1,time%step + !! Left-over (previous timestep) + inflow (current timestep) hhsurf_bs(2,j,k) = Max(0., sedprev + hhsedy(j,k)) - - !! new estimation of sediment reaching the main channel + + !! new estimation of sediment reaching the main channel hhsedy(j,k) = hhsurf_bs(2,j,k) * brt(j)! tons hhsurf_bs(2,j,k) = hhsurf_bs(2,j,k) - hhsedy(j,k) - - !! lagged at the end of time step - sedprev = hhsurf_bs(2,j,k) + + !! lagged at the end of time step + sedprev = hhsurf_bs(2,j,k) surf_bs(2,j) = Max(1.e-9, surf_bs(2,j) + sedyld(j)) - end do + end do - !! daily total sediment yield from the HRU - sedyld(j) = sum(hhsedy(j,:)) + !! daily total sediment yield from the HRU + sedyld(j) = sum(hhsedy(j,:)) endif surf_bs(13,j) = Max(1.e-6, surf_bs(13,j) + sanyld(j)) @@ -179,7 +179,7 @@ subroutine stor_surfstor surf_bs(53,j) = surf_bs(53,j) + wetqcs(j,1) !seo4 surf_bs(54,j) = surf_bs(54,j) + wetqcs(j,2) !seo3 surf_bs(55,j) = surf_bs(55,j) + wetqcs(j,3) !born - endif + endif !! sedyld(j) = surf_bs(2,j) * brt(j) <--line of code in x 2. fixes sedyld low prob diff --git a/src/surface.f90 b/src/surface.f90 index f7a09be..a9e1536 100644 --- a/src/surface.f90 +++ b/src/surface.f90 @@ -68,8 +68,8 @@ subroutine surface if (qday > 1.e-6 .and. qp_cms > 1.e-6) then call ero_eiusle - !! calculate sediment erosion by rainfall and overland flow - call ero_ovrsed + !! calculate sediment erosion by rainfall and overland flow + call ero_ovrsed end if call ero_cfactor diff --git a/src/swr_depstor.f90 b/src/swr_depstor.f90 index e39f95d..8762628 100644 --- a/src/swr_depstor.f90 +++ b/src/swr_depstor.f90 @@ -1,4 +1,4 @@ - subroutine swr_depstor + subroutine swr_depstor !! ~ ~ ~ PURPOSE ~ ~ ~ !! this subroutine computes maximum surface depressional storage depth based on @@ -10,22 +10,22 @@ subroutine swr_depstor !! iop(:,:,:) |julian date |date of tillage operation !! mgt_op |none |operation code number !! ranrns_hru(:)|mm |random roughness for a given HRU -!! sol_ori(:) |mm |oriented roughness (ridges) at time of a given tillage operation +!! sol_ori(:) |mm |oriented roughness (ridges) at time of a given tillage operation !! usle_ei |100(ft-tn in)/(acre-hr)|USLE rainfall erosion index !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~ !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! stmaxd(:) |mm |maximum surface depressional storage for day in a given HRU +!! stmaxd(:) |mm |maximum surface depressional storage for day in a given HRU !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~ !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! cumei(:) |Mj*mm/ha*hr |cumulative USLE rainfall erosion index since last -!! |tillage operation -!! cumrt(:) |mm H2O |cumulative rainfall since last tillage operation +!! cumei(:) |Mj*mm/ha*hr |cumulative USLE rainfall erosion index since last +!! |tillage operation +!! cumrt(:) |mm H2O |cumulative rainfall since last tillage operation !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ @@ -42,28 +42,28 @@ subroutine swr_depstor implicit none integer :: j = 0 !none |HRU number - real:: df = 0. !none |oriented and random roughness decay factor - based + real:: df = 0. !none |oriented and random roughness decay factor - based ! |on cumulative EI and cumulative precip_eff - real:: hru_slpp = 0. !% |average percent slope steepness - real:: sol_orgm = 0. !% |percent organic matter content in soil material - !real:: sol_orr !cm |oriented roughness (ridges) after a rain event - real:: sol_rrr = 0. !cm |random roughness after a rain event + real:: hru_slpp = 0. !% |average percent slope steepness + real:: sol_orgm = 0. !% |percent organic matter content in soil material + !real:: sol_orr !cm |oriented roughness (ridges) after a rain event + real:: sol_rrr = 0. !cm |random roughness after a rain event real:: ei = 0. !Mj*mm/ha*hr |USLE rainfall erosion index real :: xx = 0. ! | j = ihru !! Calculate current cummulative erosivity and rainfall - ei = usle_ei*18.7633 - if (itill(j) ==1)then - cumeira(j) = cumeira(j) + ei - cumei(j) = cumeira(j) - ei - cumrai(j) = cumrai(j) + precip_eff - cumrt(j) = cumrai(j) - precip_eff + ei = usle_ei*18.7633 + if (itill(j) ==1)then + cumeira(j) = cumeira(j) + ei + cumei(j) = cumeira(j) - ei + cumrai(j) = cumrai(j) + precip_eff + cumrt(j) = cumrai(j) - precip_eff end if !! Calculate the decay factor df based on %clay and %organic matter or %organic carbon - sol_orgm = soil1(j)%tot(1)%c / 0.58 - xx = (0.943 - 0.07 * soil(j)%phys(1)%clay + 0.0011 * & + sol_orgm = soil1(j)%tot(1)%c / 0.58 + xx = (0.943 - 0.07 * soil(j)%phys(1)%clay + 0.0011 * & soil(j)%phys(1)%clay**2 - 0.67 * sol_orgm + 0.12 * sol_orgm**2) if (xx > 1.) then df = 1. @@ -75,20 +75,20 @@ subroutine swr_depstor !! Determine the current random and oriented roughness using cumei and cumrt and initial !! random and oriented roughness values - sol_rrr = 0.1 * ranrns_hru(j) & - * exp(df*(-0.0009*cumei(j)-0.0007 * cumrt(j))) - -! sol_orr = 0.1*sol_ori(j)* -! & exp(df*(-0.025*(cumei(j)**0.31)-0.0085*(cumrt(j)**0.567))) + sol_rrr = 0.1 * ranrns_hru(j) & + * exp(df*(-0.0009*cumei(j)-0.0007 * cumrt(j))) + +! sol_orr = 0.1*sol_ori(j)* +! & exp(df*(-0.025*(cumei(j)**0.31)-0.0085*(cumrt(j)**0.567))) !! Compute the current maximum depressional storage using percent slope steepness !! and current random and oriented roughness values determined above - hru_slpp = hru(j)%topo%slope*100 -! if(irk=0) then !irk=0 for random rough, and irk=1, for oriented roughness - stmaxd(j)= 0.112*sol_rrr+0.031*sol_rrr**2-0.012*sol_rrr*hru_slpp -! else -! stmaxd(j)= 0.112*sol_orr+0.031*sol_orr**2-0.012*sol_orr*hru_slpp -! endif + hru_slpp = hru(j)%topo%slope*100 +! if(irk=0) then !irk=0 for random rough, and irk=1, for oriented roughness + stmaxd(j)= 0.112*sol_rrr+0.031*sol_rrr**2-0.012*sol_rrr*hru_slpp +! else +! stmaxd(j)= 0.112*sol_orr+0.031*sol_orr**2-0.012*sol_orr*hru_slpp +! endif - return + return end subroutine swr_depstor \ No newline at end of file diff --git a/src/swr_drains.f90 b/src/swr_drains.f90 index e81fb33..636fa8d 100644 --- a/src/swr_drains.f90 +++ b/src/swr_drains.f90 @@ -1,4 +1,4 @@ - subroutine swr_drains + subroutine swr_drains !! ~ ~ ~ PURPOSE ~ ~ ~ !! this subroutine finds the effective lateral hydraulic conductivity @@ -8,7 +8,7 @@ subroutine swr_drains !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! drain_co(:) |mm/day |drainage coefficient -!! ddrain(:) |mm |depth of drain tube from the soil surface +!! ddrain(:) |mm |depth of drain tube from the soil surface !! latksatf(:) |none |multiplication factor to determine conk(j1,j) from sol_k(j1,j) for HRU !! pc(:) |mm/hr |pump capacity (default pump capacity = 1.042mm/hr or 25mm/day) !! sdrain(:) |mm |distance between two drain tubes or tiles @@ -105,11 +105,11 @@ subroutine swr_drains if(y1 > soil(j)%phys(j1)%d) then wnan(j1) = 0. else - wnan(j1) = soil(j)%phys(j1)%d - y1 - x = soil(j)%phys(j1)%d - above + wnan(j1) = soil(j)%phys(j1)%d - y1 + x = soil(j)%phys(j1)%d - above if(wnan(j1) > x) wnan(j1) = x - end if - above = soil(j)%phys(j1)%d + end if + above = soil(j)%phys(j1)%d end do sum = 0. deep = 0. @@ -122,27 +122,27 @@ subroutine swr_drains sum = 0. deep = 0.001 do j1=1,soil(j)%nly - sum = sum + soil(j)%ly(j1)%conk * soil(j)%phys(j1)%thick !Daniel 10/09/07 - deep = deep + dg !Daniel 10/09/07 + sum = sum + soil(j)%ly(j1)%conk * soil(j)%phys(j1)%thick !Daniel 10/09/07 + deep = deep + dg !Daniel 10/09/07 end do - cone=sum/deep - else - cone=sum/deep + cone=sum/deep + else + cone=sum/deep end if - !! calculate parameters hdrain and gee1 + !! calculate parameters hdrain and gee1 ad = soil(j)%zmx - hru(j)%lumv%sdr_dep ad = Max (10., ad) - ap = 3.55 - ((1.6 * ad) / hru(j)%sdr%dist) + 2 * & + ap = 3.55 - ((1.6 * ad) / hru(j)%sdr%dist) + 2 * & ((2 / hru(j)%sdr%dist)**2) - if (ad / hru(j)%sdr%dist < 0.3) then + if (ad / hru(j)%sdr%dist < 0.3) then hdrain= ad / (1 + ((ad / hru(j)%sdr%dist) * (((8 / pi) * & - Log(ad / hru(j)%sdr%radius) - ap)))) + Log(ad / hru(j)%sdr%radius) - ap)))) else hdrain = ad !hdrain = (hru(j)%sdr%dist * pi) / (8 * ((log(hru(j)%sdr%dist / & ! hru(j)%sdr%radius)/ log(e)) - 1.15)) - end if + end if !! calculate Kirkham G-Factor, gee k2 = tan((pi * ((2. * ad) - hru(j)%sdr%radius)) / (4. * soil(j)%zmx)) k3 = tan((pi * hru(j)%sdr%radius) / (4. * soil(j)%zmx)) @@ -164,11 +164,11 @@ subroutine swr_drains if (gee > 12.) gee = 12. !! calculate drainage and subirrigation flux section - ! drainage flux for ponded surface + ! drainage flux for ponded surface depth = hru(j)%lumv%sdr_dep + hdrain hdmin = depth - hru(j)%lumv%sdr_dep call swr_depstor ! dynamic stmaxd(j): compute current HRU stmaxd based - ! on cumulative rainfall and cum. intensity + ! on cumulative rainfall and cum. intensity storro = 0.2 * stmaxd(j) !surface storage that must be filled before surface !water can move to the tile drain tube !! Determine surface storage for the day in a given HRU (stor) @@ -187,7 +187,7 @@ subroutine swr_drains dflux= (12.56637 * 24.0 * cone* (depth - hdrain + stor)) / (gee * hru(j)%sdr%dist) !eq.10 if (dflux > hru(j)%sdr%drain_co) dflux = hru(j)%sdr%drain_co !eq.11 else -! subirrigation flux +! subirrigation flux em = depth - y1 - hdrain if(em < -1.0) then !! ddranp=ddrain(j)-1.0 @@ -198,15 +198,15 @@ subroutine swr_drains if (abs(dflux) > hru(j)%sdr%pumpcap) then dflux = - hru(j)%sdr%pumpcap * 24.0 end if -! drainage flux - for WT below the surface and for ponded depths < storro (S1) +! drainage flux - for WT below the surface and for ponded depths < storro (S1) else dflux = 4.0 * 24.0 * cone * em * (2.0 * hdrain + em) / hru(j)%sdr%dist**2 !eq.5 if(dflux > hru(j)%sdr%drain_co) dflux = hru(j)%sdr%drain_co !eq.11 if(dflux < 0.) dflux=0. if(em < 0.) dflux=0. end if - end if - qtile = dflux + end if + qtile = dflux return end subroutine swr_drains \ No newline at end of file diff --git a/src/swr_percmain.f90 b/src/swr_percmain.f90 index 9296186..8089384 100644 --- a/src/swr_percmain.f90 +++ b/src/swr_percmain.f90 @@ -9,15 +9,15 @@ subroutine swr_percmain !! name |units |definition !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! new water table depth equations 01/2009 -!! c |none |a factor used to convert airvol to wtd +!! c |none |a factor used to convert airvol to wtd !! dg |mm |soil layer thickness in HRU !! new water table depth equations 01/2009 !! latq(:) |mm H2O |total lateral flow in soil profile for the !! |day in HRU !! lyrtile |mm H2O |drainage tile flow in soil layer for day !! new water table depth equations 01/2009 -!! ne_p |mm/hr |effective porosity in HRU for all soil profile layers -!! ne_w |mm/hr |effective porosity in HRU for soil layers above wtd +!! ne_p |mm/hr |effective porosity in HRU for all soil profile layers +!! ne_w |mm/hr |effective porosity in HRU for soil layers above wtd !! new water table depth equations 01/2009 !! qtile |mm H2O |drainage tile flow in soil profile for the day !! sepday |mm H2O |micropore percolation from soil layer @@ -29,8 +29,8 @@ subroutine swr_percmain !! new water table depth equations 01/2009 !! wt_shall |mm H2O |shallow water table height above bottom of soil profile !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! w2 |mm | -!! y1 |mm |dummy variable for wat +!! w2 |mm | +!! y1 |mm |dummy variable for wat !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ use hru_module, only : hru, ihru, i_sep, inflpcp, isep, latlyr, latq, lyrtile, qstemm, sepbtm, sepcrktot, sepday, & @@ -77,9 +77,9 @@ subroutine swr_percmain !! calculate crack flow if (bsn_cc%crk == 1) then - call swr_percmacro - sepday = sepday - sepcrktot - endif + call swr_percmacro + sepday = sepday - sepcrktot + endif !back to 4 mm slug for soil routing- keeps moisture above fc slug = 1000. !4. !1000. !this should be an input in parameters.bsn @@ -92,11 +92,11 @@ subroutine swr_percmain !! add water moving into soil layer from overlying layer soil(j)%phys(j1)%st = soil(j)%phys(j1)%st + sepday - !! septic tank inflow to biozone layer J.Jeong - ! STE added to the biozone layer if soil temp is above zero. - if (j1 == i_sep(j) .and. soil(j)%phys(j1)%tmp > 0. .and. & + !! septic tank inflow to biozone layer J.Jeong + ! STE added to the biozone layer if soil temp is above zero. + if (j1 == i_sep(j) .and. soil(j)%phys(j1)%tmp > 0. .and. & sep(isep)%opt /= 0) then - soil(j)%phys(j1)%st = soil(j)%phys(j1)%st + qstemm(j) ! in mm + soil(j)%phys(j1)%st = soil(j)%phys(j1)%st + qstemm(j) ! in mm end if !! determine gravity drained water in layer @@ -124,7 +124,7 @@ subroutine swr_percmain qtile = qtile + lyrtile soil(j)%ly(j1)%flat = latlyr + lyrtile soil(j)%ly(j1)%prk = soil(j)%ly(j1)%prk + sepday - if (latq(j) < 1.e-6) latq(j) = 0. + if (latq(j) < 1.e-6) latq(j) = 0. if (qtile < 1.e-6) qtile = 0. if (soil(j)%ly(j1)%flat < 1.e-6) soil(j)%ly(j1)%flat = 0. end do @@ -157,8 +157,8 @@ subroutine swr_percmain xx = (soil(j)%sw - soil(j)%sumfc) / (yy - soil(j)%sumfc) if (xx > 1.) xx = 1. wt_shall = xx * soil(j)%zmx - wat = soil(j)%zmx - wt_shall - if(wat > soil(j)%zmx) wat = soil(j)%zmx + wat = soil(j)%zmx - wt_shall + if(wat > soil(j)%zmx) wat = soil(j)%zmx end if else !compute water table depth using Daniel"s modifications @@ -167,12 +167,12 @@ subroutine swr_percmain sw_del = soil(j)%swpwt - soil(j)%sw wt_del = sw_del * soil(j)%ly(j1)%vwt soil(j)%wat_tbl = soil(j)%wat_tbl + wt_del - if(soil(j)%wat_tbl > soil(j)%zmx) soil(j)%wat_tbl = soil(j)%zmx - wt_shall = soil(j)%zmx - soil(j)%wat_tbl - soil(j)%swpwt = soil(j)%sw - exit - end if - end do + if(soil(j)%wat_tbl > soil(j)%zmx) soil(j)%wat_tbl = soil(j)%zmx + wt_shall = soil(j)%zmx - soil(j)%wat_tbl + soil(j)%swpwt = soil(j)%sw + exit + end if + end do end if !! drainmod wt_shall equations 10/23/2006 diff --git a/src/swr_percmicro.f90 b/src/swr_percmicro.f90 index 11f1fd4..714b437 100644 --- a/src/swr_percmicro.f90 +++ b/src/swr_percmicro.f90 @@ -92,10 +92,10 @@ subroutine swr_percmicro(ly1) sepday = Max(0., sepday) !! limit maximum seepage from biozone layer below potential perc amount - if(ly1 == i_sep(j).and.sep(isep)%opt ==1) then - sepday = min(sepday,sol_k_sep *24.) - bz_perc(j) = sepday - end if + if(ly1 == i_sep(j).and.sep(isep)%opt ==1) then + sepday = min(sepday,sol_k_sep *24.) + bz_perc(j) = sepday + end if !! switched to linear relationship for dep_imp and seepage if (ly1 == soil(j)%nly) then diff --git a/src/tiles_data_module.f90 b/src/tiles_data_module.f90 index d298177..3ee3fc7 100644 --- a/src/tiles_data_module.f90 +++ b/src/tiles_data_module.f90 @@ -7,7 +7,7 @@ module tiles_data_module real :: depth = 0. !! |mm |depth of drain tube from the soil surface real :: time = 0. !! |hrs |time to drain soil to field capacity real :: lag = 0. !! |hours |drain tile lag time - real :: radius =0. !! |mm effective radius of drains + real :: radius =0. !! |mm effective radius of drains real :: dist = 0. !! |mm |distance between two drain tubes or tiles real :: drain_co = 0. !! |mm/day |drainage coefficient real :: pumpcap = 0. !! |mm/hr |pump capacity (default pump capacity = 1.042mm/hr or 25mm/day) diff --git a/src/time_conc_init.f90 b/src/time_conc_init.f90 index 4488a4d..09e5784 100644 --- a/src/time_conc_init.f90 +++ b/src/time_conc_init.f90 @@ -69,7 +69,7 @@ subroutine time_conc_init !! compute fraction of surface runoff that is reaching the main channel if (time%step > 1) then brt(ihru) = 1.-Exp(-bsn_prm%surlag / (tconc(ihru) / & - (time%dtm / 60.))) !! urban modeling by J.Jeong + (time%dtm / 60.))) !! urban modeling by J.Jeong else brt(ihru) = 1. - Exp(-bsn_prm%surlag / tconc(ihru)) endif diff --git a/src/topography_data_module.f90 b/src/topography_data_module.f90 index d2f0e50..771080d 100644 --- a/src/topography_data_module.f90 +++ b/src/topography_data_module.f90 @@ -4,7 +4,7 @@ module topography_data_module type topography_db character(len=16) :: name = "default" - real :: slope = .02 !! hru_slp(:) |m/m |average slope steepness in HRU + real :: slope = .02 !! hru_slp(:) |m/m |average slope steepness in HRU real :: slope_len = 50. !! slsubbsn(:) |m |average slope length for erosion real :: lat_len = 50. !! slsoil(:) |m |slope length for lateral subsurface flow real :: dis_stream = 100. !! dis_stream(:) |m |average distance to stream diff --git a/src/varinit.f90 b/src/varinit.f90 index b0b340d..46c787e 100644 --- a/src/varinit.f90 +++ b/src/varinit.f90 @@ -120,10 +120,10 @@ subroutine varinit vpd = 0. voltot = 0. - !! urban modeling by J.Jeong - sedprev = 0. - ubnrunoff = 0. - irmmdt = 0. + !! urban modeling by J.Jeong + sedprev = 0. + ubnrunoff = 0. + irmmdt = 0. hhsedy = 0. ubntss = 0. wet_seep_day(j)%no3 = 0 diff --git a/src/wallo_withdraw.f90 b/src/wallo_withdraw.f90 index 437230f..0ecc0d3 100644 --- a/src/wallo_withdraw.f90 +++ b/src/wallo_withdraw.f90 @@ -24,7 +24,7 @@ subroutine wallo_withdraw (iwallo, idmd, isrc) real :: avail = 0. !m3 |water available to withdraw from an aquifer real :: extracted = 0. !m3 |water extracted from the aquifer object (gwflow - rtb) real :: dmd_unmet = 0. !m3 |demand that is unmet (gwflow - rtb) - real :: hru_demand = 0. !m3 |demand (copy to pass into gwflow subroutine - rtb) + real :: hru_demand = 0. !m3 |demand (copy to pass into gwflow subroutine - rtb) real :: withdraw = 0. !m3 real :: unmet = 0. !m3 real :: total_dmd = 0. !m3 diff --git a/src/water_allocation_module.f90 b/src/water_allocation_module.f90 index da8ace1..e6f6285 100644 --- a/src/water_allocation_module.f90 +++ b/src/water_allocation_module.f90 @@ -103,29 +103,29 @@ module water_allocation_module type (water_allocation_output), dimension(:), allocatable :: walloa_out !dimension by demand objects type wallo_header - character(len=6) :: day = " jday" - character(len=6) :: mo = " mon" - character(len=6) :: day_mo = " day " - character(len=6) :: yrc = " yr " - character(len=8) :: idmd = " unit " - character(len=16) :: dmd_typ = "dmd_typ " - character(len=16) :: dmd_num = " dmd_num " - character(len=16) :: rcv_typ = "drcv_typ " - character(len=16) :: rcv_num = " rcv_num " + character(len=6) :: day = " jday" + character(len=6) :: mo = " mon" + character(len=6) :: day_mo = " day " + character(len=6) :: yrc = " yr " + character(len=8) :: idmd = " unit " + character(len=16) :: dmd_typ = "dmd_typ " + character(len=16) :: dmd_num = " dmd_num " + character(len=16) :: rcv_typ = "drcv_typ " + character(len=16) :: rcv_num = " rcv_num " character(len=12) :: src1_obj = " src1_obj " - character(len=12) :: src1_typ = " src1_typ " - character(len=12) :: src1_num = " src1_num " - character(len=15) :: dmd1 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src1_typ = " src1_typ " + character(len=12) :: src1_num = " src1_num " + character(len=15) :: dmd1 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s1out = "src1_withdraw " !! ha-m |withdrawal from source 1 character(len=12) :: s1un = " src1_unmet" !! ha-m |unmet from source 1 - character(len=12) :: src2_typ = " src2_typ " - character(len=12) :: src2_num = " src2_num " - character(len=15) :: dmd2 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src2_typ = " src2_typ " + character(len=12) :: src2_num = " src2_num " + character(len=15) :: dmd2 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s2out = "src2_withdraw " !! ha-m |withdrawal from source 2 character(len=12) :: s2un = " src2_unmet" !! ha-m |unmet from source 2 - character(len=12) :: src3_typ = " src3_typ " - character(len=12) :: src3_num = " src3_num " - character(len=15) :: dmd3 = " demand " !! ha-m |demand - muni or irrigation + character(len=12) :: src3_typ = " src3_typ " + character(len=12) :: src3_num = " src3_num " + character(len=15) :: dmd3 = " demand " !! ha-m |demand - muni or irrigation character(len=15) :: s3out = "src3_withdraw " !! ha-m |withdrawal from source 3 character(len=12) :: s3un = " src3_unmet" !! ha-m |unmet from source 3 @@ -133,30 +133,30 @@ module water_allocation_module type (wallo_header) :: wallo_hdr type wallo_header_units - character (len=8) :: day = " " - character (len=8) :: mo = " " - character (len=8) :: day_mo = " " - character (len=8) :: yrc = " " - character (len=8) :: idmd = " " - character (len=16) :: dmd_typ = " " - character (len=16) :: dmd_num = " " - character (len=16) :: rcv_typ = " " - character (len=16) :: rcv_num = " " + character (len=8) :: day = " " + character (len=8) :: mo = " " + character (len=8) :: day_mo = " " + character (len=8) :: yrc = " " + character (len=8) :: idmd = " " + character (len=16) :: dmd_typ = " " + character (len=16) :: dmd_num = " " + character (len=16) :: rcv_typ = " " + character (len=16) :: rcv_num = " " character (len=12) :: src1_obj = " " - character (len=12) :: src1_typ = " " - character (len=8) :: src1_num = " " + character (len=12) :: src1_typ = " " + character (len=8) :: src1_num = " " character (len=15) :: dmd1 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s1out = "m^3 " !! ha-m |withdrawal from source 1 + character (len=15) :: s1out = "m^3 " !! ha-m |withdrawal from source 1 character (len=9) :: s1un = "m^3 " !! ha-m |unmet from source 1 - character (len=15) :: src2_typ = " " - character (len=15) :: src2_num = " " + character (len=15) :: src2_typ = " " + character (len=15) :: src2_num = " " character (len=15) :: dmd2 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 + character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 character (len=10) :: s2un = "m^3 " !! ha-m |unmet from source 2 - character (len=15) :: src3_typ = " " - character (len=15) :: src3_num = " " + character (len=15) :: src3_typ = " " + character (len=15) :: src3_num = " " character (len=15) :: dmd3 = "m^3 " !! ha-m |demand - muni or irrigation - character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 + character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 character (len=10) :: s3un = "m^3 " !! ha-m |unmet from source 3 end type wallo_header_units diff --git a/src/wet_cs.f90 b/src/wet_cs.f90 index 0b5258f..b959b7c 100644 --- a/src/wet_cs.f90 +++ b/src/wet_cs.f90 @@ -87,11 +87,11 @@ subroutine wet_cs(icmd, icon, ihru) !rtb cs !constituent mass settling to bottom of wetland if(ics == 1) then v_settle = res_cs_data(icon)%v_seo4 - elseif(ics == 2) then + elseif(ics == 2) then v_settle = res_cs_data(icon)%v_seo3 - elseif(ics == 3) then + elseif(ics == 3) then v_settle = res_cs_data(icon)%v_born - endif + endif cs_settle = (cs_conc_beg/1000.) * v_settle * (wet_wat_d(ihru)%area_ha*10000.) !kg if(cs_settle > mass_avail) then cs_settle = mass_avail !take remaining diff --git a/src/wetland_control.f90 b/src/wetland_control.f90 index cf06571..0c674f7 100644 --- a/src/wetland_control.f90 +++ b/src/wetland_control.f90 @@ -128,11 +128,11 @@ subroutine wetland_control swst(j1) = swst(j1) - volex !update soil water endif end do - + !update seepage volume wet_wat_d(j)%seep = max(0., wet_wat_d(j)%seep - volex * wsa1) !m3 - endif - + endif + wet(j)%flo = wet(j)%flo - wet_wat_d(j)%seep wet_wat_d(j)%area_ha = hru(j)%area_ha hru(j)%water_seep = wet_wat_d(j)%seep / wsa1 !mm=m3/(10*ha) From b095cf8d5c2ea2a727c58cb262c3ede2e9788c2f Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 08:48:20 -0500 Subject: [PATCH 03/17] truncation fixes Increase length of various character variables Extended character variable lengths in multiple modules: - `basin_module.f90`: `year`, `area_ha`, `yield_t` in `basin_yld_header` (+1) - `gwflow_read.f90`: `year` in `hydsep_hdr` (+2) - `hydrograph_module.f90`: `hd_type` in `hru_swift_header` (+1) - `manure_allocation_module.f90`: `s2un`, `s3un` in `mallo_header_units` (+5) - `output_landscape_module.f90`: `puptake` in `output_nutbal_header` (+1) - `reservoir_module.f90`: `j` in `res_in` and `res_out` headers (+1) - `soil_nutcarb_module.f90`: `mb_c` in `organic_carbon_units` (+3) - `water_allocation_module.f90`: `rcv_typ` in `wallo_header_units` (+1) - `water_allocation_module.f90`: `s2un`, `s3un` in `wallo_header_units` (+5) --- src/basin_module.f90 | 6 +++--- src/gwflow_read.f90 | 2 +- src/hydrograph_module.f90 | 2 +- src/manure_allocation_module.f90 | 4 ++-- src/output_landscape_module.f90 | 2 +- src/reservoir_module.f90 | 4 ++-- src/soil_nutcarb_module.f90 | 2 +- src/water_allocation_module.f90 | 6 +++--- 8 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/basin_module.f90 b/src/basin_module.f90 index bfb0eb8..47a0498 100644 --- a/src/basin_module.f90 +++ b/src/basin_module.f90 @@ -379,11 +379,11 @@ module basin_module ! type(snutc_old_header) :: snutc_old_hdr type basin_yld_header - character (len=10) :: year = " year " + character (len=11) :: year = " year " character (len=16) :: plant_no = " plant_no" character (len=16) :: plant_name = "plant_name " - character (len=16) :: area_ha = " harv_area(ha) " - character (len=16) :: yield_t = " yld(t) " + character (len=17) :: area_ha = " harv_area(ha) " + character (len=17) :: yield_t = " yld(t) " character (len=16) :: yield_tha = " yld(t/ha) " end type basin_yld_header type (basin_yld_header) :: bsn_yld_hdr diff --git a/src/gwflow_read.f90 b/src/gwflow_read.f90 index 5df47f1..7810fb6 100644 --- a/src/gwflow_read.f90 +++ b/src/gwflow_read.f90 @@ -2427,7 +2427,7 @@ subroutine gwflow_read write(out_hyd_sep,*) 'chan_satexsw: channel flow contributed from saturation excess runoff' write(out_hyd_sep,*) 'chan_tile: channel flow contributed from tile drain flow' write(out_hyd_sep,*) - hydsep_hdr = [character(len=10) :: " year"," day","channel","chan_surf","chan_lat","chan_gwsw","chan_swgw", & + hydsep_hdr = [character(len=12) :: " year"," day","channel","chan_surf","chan_lat","chan_gwsw","chan_swgw", & "chan_satexgw","chan_satexsw","chan_tile"] write(out_hyd_sep,121) (hydsep_hdr(j),j=1,10) diff --git a/src/hydrograph_module.f90 b/src/hydrograph_module.f90 index c67617c..bcff631 100644 --- a/src/hydrograph_module.f90 +++ b/src/hydrograph_module.f90 @@ -1137,7 +1137,7 @@ module hydrograph_module end type hru_swift_header_baseunit2 type hru_swift_header - character(len=16) :: hd_type(5) = ["total_flow ", "percolation ", "surface_runoff ", "lateral_flow ", "tile_flow "] + character(len=17) :: hd_type(5) = ["total_flow ", "percolation ", "surface_runoff ", "lateral_flow ", "tile_flow "] type (hru_swift_header_base) :: exco type (hru_swift_header_baseunit) :: exco_unit type (hru_swift_header_base2) :: dr diff --git a/src/manure_allocation_module.f90 b/src/manure_allocation_module.f90 index e6401bf..a452e82 100644 --- a/src/manure_allocation_module.f90 +++ b/src/manure_allocation_module.f90 @@ -110,12 +110,12 @@ module manure_allocation_module character (len=15) :: src2_num = " " character (len=15) :: dmd2 = "m^3 " !! ha-m |demand - muni or irrigation character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 - character (len=10) :: s2un = "m^3 " !! ha-m |unmet from source 2 + character (len=15) :: s2un = "m^3 " !! ha-m |unmet from source 2 character (len=15) :: src3_typ = " " character (len=15) :: src3_num = " " character (len=15) :: dmd3 = "m^3 " !! ha-m |demand - muni or irrigation character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 - character (len=10) :: s3un = "m^3 " !! ha-m |unmet from source 3 + character (len=15) :: s3un = "m^3 " !! ha-m |unmet from source 3 end type mallo_header_units type (mallo_header_units) :: mallo_hdr_units diff --git a/src/output_landscape_module.f90 b/src/output_landscape_module.f90 index b09a38a..32fcb39 100644 --- a/src/output_landscape_module.f90 +++ b/src/output_landscape_module.f90 @@ -416,7 +416,7 @@ module output_landscape_module character(len=17) :: no3atmo = " no3atmo " character(len=17) :: nh4atmo = " nh4atmo " character(len=17) :: nuptake = " nuptake " - character(len=17) :: puptake = " puptake " + character(len=18) :: puptake = " puptake " character(len=17) :: gwsoiln = " gwsoiln " character(len=17) :: gwsoilp = " gwsoilp " end type output_nutbal_header diff --git a/src/reservoir_module.f90 b/src/reservoir_module.f90 index 6ebe5f4..c8d321d 100644 --- a/src/reservoir_module.f90 +++ b/src/reservoir_module.f90 @@ -74,7 +74,7 @@ module reservoir_module character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" - character (len=8) :: j = " resnum " + character (len=9) :: j = " resnum " character (len=9) :: id = " gis_id " character (len=16) :: name = " name " character (len=13) :: flo = " flo" !! ha-m |volume of water @@ -166,7 +166,7 @@ module reservoir_module character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " - character (len=8) :: j = " " + character (len=9) :: j = " " character (len=9) :: id = " " character (len=16) :: name = " " character (len=13) :: flo = " ha-m" !! ha-m |volume of water diff --git a/src/soil_nutcarb_module.f90 b/src/soil_nutcarb_module.f90 index 3b6591c..808b3e4 100644 --- a/src/soil_nutcarb_module.f90 +++ b/src/soil_nutcarb_module.f90 @@ -36,7 +36,7 @@ module soil_nutcarb_module character (len=15) :: man_c = " kg/ha" character (len=15) :: hum_c = " kg/ha" character (len=15) :: phum_c = " kg/ha" - character (len=12) :: mb_c = " kg/ha" + character (len=15) :: mb_c = " kg/ha" end type organic_carbon_units type (organic_carbon_units) :: orgc_units diff --git a/src/water_allocation_module.f90 b/src/water_allocation_module.f90 index e6f6285..0f8093f 100644 --- a/src/water_allocation_module.f90 +++ b/src/water_allocation_module.f90 @@ -110,7 +110,7 @@ module water_allocation_module character(len=8) :: idmd = " unit " character(len=16) :: dmd_typ = "dmd_typ " character(len=16) :: dmd_num = " dmd_num " - character(len=16) :: rcv_typ = "drcv_typ " + character(len=17) :: rcv_typ = "drcv_typ " character(len=16) :: rcv_num = " rcv_num " character(len=12) :: src1_obj = " src1_obj " character(len=12) :: src1_typ = " src1_typ " @@ -152,12 +152,12 @@ module water_allocation_module character (len=15) :: src2_num = " " character (len=15) :: dmd2 = "m^3 " !! ha-m |demand - muni or irrigation character (len=15) :: s2out = "m^3 " !! ha-m |withdrawal from source 2 - character (len=10) :: s2un = "m^3 " !! ha-m |unmet from source 2 + character (len=15) :: s2un = "m^3 " !! ha-m |unmet from source 2 character (len=15) :: src3_typ = " " character (len=15) :: src3_num = " " character (len=15) :: dmd3 = "m^3 " !! ha-m |demand - muni or irrigation character (len=15) :: s3out = "m^3 " !! ha-m |withdrawal from source 3 - character (len=10) :: s3un = "m^3 " !! ha-m |unmet from source 3 + character (len=15) :: s3un = "m^3 " !! ha-m |unmet from source 3 end type wallo_header_units type (wallo_header_units) :: wallo_hdr_units From dab22e11d4c6bd179a3a6e72cc3a47dabe0970cf Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 08:58:35 -0500 Subject: [PATCH 04/17] Remove unused format labels in Fortran source files Commented out unused format statements with `!*** tu Wunused-label:` prefix across multiple Fortran source files. This cleanup improves code readability and reduces potential confusion for future maintenance. Affected files include: - calsoft_control.f90 - ch_pathogen_output.f90 - command.f90 - cs_balance.f90 - gwflow_read.f90 - gwflow_simulate.f90 - hru_carbon_output.f90 - hru_output.f90 - hru_pathogen_output.f90 - lsreg_output.f90 - lsu_output.f90 - recall_nut.f90 - ru_output.f90 - salt_balance.f90 - salt_chem_hru.f90 - sep_biozone.f90 - sq_greenampt.f90 - surface.f90 - swift_output.f90 No changes to program functionality. --- src/calsoft_control.f90 | 2 +- src/ch_pathogen_output.f90 | 8 ++++---- src/command.f90 | 2 +- src/cs_balance.f90 | 4 ++-- src/gwflow_read.f90 | 6 +++--- src/gwflow_simulate.f90 | 10 +++++----- src/hru_carbon_output.f90 | 14 +++++++------- src/hru_output.f90 | 4 ++-- src/hru_pathogen_output.f90 | 6 +++--- src/lsreg_output.f90 | 2 +- src/lsu_output.f90 | 2 +- src/recall_nut.f90 | 2 +- src/ru_output.f90 | 4 ++-- src/salt_balance.f90 | 2 +- src/salt_chem_hru.f90 | 2 +- src/sep_biozone.f90 | 2 +- src/sq_greenampt.f90 | 20 ++++++++++---------- src/surface.f90 | 2 +- src/swift_output.f90 | 2 +- 19 files changed, 48 insertions(+), 48 deletions(-) diff --git a/src/calsoft_control.f90 b/src/calsoft_control.f90 index 0fddcb9..8350920 100644 --- a/src/calsoft_control.f90 +++ b/src/calsoft_control.f90 @@ -160,7 +160,7 @@ subroutine calsoft_control end do end if ! channel sediment parms - 500 format (a16,f12.3,i12,f12.3,2(1x,a16,10f12.3),10f12.3) +!*** tu Wunused-label: 500 format (a16,f12.3,i12,f12.3,2(1x,a16,10f12.3),10f12.3) 503 format (2a16,f12.5,a) return diff --git a/src/ch_pathogen_output.f90 b/src/ch_pathogen_output.f90 index e434f29..89706ba 100644 --- a/src/ch_pathogen_output.f90 +++ b/src/ch_pathogen_output.f90 @@ -98,9 +98,9 @@ subroutine ch_pathogen_output(ihru) return 100 format (4i6,2i8,2x,a,28f12.3) -101 format (4i6,2i8,2x,a,20f12.3) -102 format (4i6,2i8,2x,a,20f12.3) -103 format (2i6,i8,4x,a,5x,f12.3) -104 format (4i6,2i8,2x,a,27f18.3) +!*** tu Wunused-label: 101 format (4i6,2i8,2x,a,20f12.3) +!*** tu Wunused-label: 102 format (4i6,2i8,2x,a,20f12.3) +!*** tu Wunused-label: 103 format (2i6,i8,4x,a,5x,f12.3) +!*** tu Wunused-label: 104 format (4i6,2i8,2x,a,27f18.3) end subroutine ch_pathogen_output \ No newline at end of file diff --git a/src/command.f90 b/src/command.f90 index 4258cc5..ff8402a 100644 --- a/src/command.f90 +++ b/src/command.f90 @@ -623,7 +623,7 @@ subroutine command enddo 102 format(i6,11x,i3,8x,i5,5x,1000(f16.4)) -103 format(4i6,2i8,2x,a,35f12.3) +!*** tu Wunused-label: 103 format(4i6,2i8,2x,a,35f12.3) return diff --git a/src/cs_balance.f90 b/src/cs_balance.f90 index 6c0519b..3417cce 100644 --- a/src/cs_balance.f90 +++ b/src/cs_balance.f90 @@ -688,8 +688,8 @@ subroutine cs_balance !rtb cs 7000 format(i8,i8,i8,100e16.8) -7001 format(20e16.8) -7002 format(i8,50f16.8) +!*** tu Wunused-label: 7001 format(20e16.8) +!*** tu Wunused-label: 7002 format(i8,50f16.8) return end \ No newline at end of file diff --git a/src/gwflow_read.f90 b/src/gwflow_read.f90 index 7810fb6..a824455 100644 --- a/src/gwflow_read.f90 +++ b/src/gwflow_read.f90 @@ -2440,14 +2440,14 @@ subroutine gwflow_read return -100 format(i6,i6,10(f10.2)) +!*** tu Wunused-label: 100 format(i6,i6,10(f10.2)) !output files for all cells !101 format((f12.4)) !102 format((i4)) 101 format(f12.4) -102 format(i4) +!*** tu Wunused-label: 102 format(i4) !other formats -103 format(10000(i8)) +!*** tu Wunused-label: 103 format(10000(i8)) 111 format(1x,a, 5x,"Time",2x,i2,":",i2,":",i2) 119 format(4x,a8,a8,a10,a16,a19,50(a13)) 120 format(a8,50(a13)) diff --git a/src/gwflow_simulate.f90 b/src/gwflow_simulate.f90 index 2111c61..7b1367c 100644 --- a/src/gwflow_simulate.f90 +++ b/src/gwflow_simulate.f90 @@ -2510,12 +2510,12 @@ subroutine gwflow_simulate 100 format(10000(f12.3)) 101 format(10000(e12.3)) 102 format(i8,i8,f10.3,e16.7,e16.7,1000(e13.4)) -103 format(i8,i8,i8,i8,i8,i8,i8,50(f15.3)) -104 format(10000(f12.2)) +!*** tu Wunused-label: 103 format(i8,i8,i8,i8,i8,i8,i8,50(f15.3)) +!*** tu Wunused-label: 104 format(10000(f12.2)) 105 format(i8,50(e13.4)) -106 format(i8,i8,i8,50(f12.3)) -108 format(i8,2x,50(e12.4)) -109 format(i8,i8,1000(e12.3)) +!*** tu Wunused-label: 106 format(i8,i8,i8,50(f12.3)) +!*** tu Wunused-label: 108 format(i8,2x,50(e12.4)) +!*** tu Wunused-label: 109 format(i8,i8,1000(e12.3)) 110 format(i8,f20.1,i8,f12.3,f12.3,f12.3) 111 format(f20.1,f12.3,f12.3,i8) 112 format(f15.1,50(e13.4)) diff --git a/src/hru_carbon_output.f90 b/src/hru_carbon_output.f90 index 30a726a..bb59160 100644 --- a/src/hru_carbon_output.f90 +++ b/src/hru_carbon_output.f90 @@ -126,12 +126,12 @@ subroutine hru_carbon_output (ihru) return -100 format (4i6,2i8,2x,a,40f12.3) -101 format (4i6,2i8,2x,a,24f12.3) -102 format (4i6,2i8,2x,a,24f12.3) -103 format (4i6,i8,4x,a,5x,4f12.3) -104 format (4i6,2i8,2x,a8,4f12.3,23f17.3) -105 format (4i6,2i8,2x,a8,8f17.3) -106 format (4i6,2i8,2x,a8,29f17.3) +!*** tu Wunused-label: 100 format (4i6,2i8,2x,a,40f12.3) +!*** tu Wunused-label: 101 format (4i6,2i8,2x,a,24f12.3) +!*** tu Wunused-label: 102 format (4i6,2i8,2x,a,24f12.3) +!*** tu Wunused-label: 103 format (4i6,i8,4x,a,5x,4f12.3) +!*** tu Wunused-label: 104 format (4i6,2i8,2x,a8,4f12.3,23f17.3) +!*** tu Wunused-label: 105 format (4i6,2i8,2x,a8,8f17.3) +!*** tu Wunused-label: 106 format (4i6,2i8,2x,a8,29f17.3) end subroutine hru_carbon_output \ No newline at end of file diff --git a/src/hru_output.f90 b/src/hru_output.f90 index 0e4901b..59dd783 100644 --- a/src/hru_output.f90 +++ b/src/hru_output.f90 @@ -274,7 +274,7 @@ subroutine hru_output (ihru) 102 format (4i6,2i8,2x,a,25f12.3) !!!!!!!!!! nbs chg 103 format (4i6,i8,4x,a,5x,4f12.3) 104 format (4i6,2i8,2x,a8,4f12.3,23f17.3) -105 format (4i6,2i8,2x,a8,8f17.3) -106 format (4i6,2i8,2x,a8,29f17.3) +!*** tu Wunused-label: 105 format (4i6,2i8,2x,a8,8f17.3) +!*** tu Wunused-label: 106 format (4i6,2i8,2x,a8,29f17.3) end subroutine hru_output \ No newline at end of file diff --git a/src/hru_pathogen_output.f90 b/src/hru_pathogen_output.f90 index 4a50735..abbee3b 100644 --- a/src/hru_pathogen_output.f90 +++ b/src/hru_pathogen_output.f90 @@ -98,8 +98,8 @@ subroutine hru_pathogen_output(ihru) return 100 format (4i6,2i8,2x,a,11e12.3) -101 format (4i6,2i8,2x,a,11e12.3) -102 format (4i6,2i8,2x,a,11e12.3) -103 format (2i6,i8,4x,a,5x,11e12.3) +!*** tu Wunused-label: 101 format (4i6,2i8,2x,a,11e12.3) +!*** tu Wunused-label: 102 format (4i6,2i8,2x,a,11e12.3) +!*** tu Wunused-label: 103 format (2i6,i8,4x,a,5x,11e12.3) end subroutine hru_pathogen_output \ No newline at end of file diff --git a/src/lsreg_output.f90 b/src/lsreg_output.f90 index abdc39b..e4806f7 100644 --- a/src/lsreg_output.f90 +++ b/src/lsreg_output.f90 @@ -336,6 +336,6 @@ subroutine lsreg_output 100 format (4i6,2a16,22f12.3) 101 format (4i6,2a16,24f12.3) 102 format (4i6,2a16,24f12.3) -103 format (4i6,i8,4x,a,5x,f12.3) +!*** tu Wunused-label: 103 format (4i6,i8,4x,a,5x,f12.3) end subroutine lsreg_output \ No newline at end of file diff --git a/src/lsu_output.f90 b/src/lsu_output.f90 index 0a9bfb3..3546bd9 100644 --- a/src/lsu_output.f90 +++ b/src/lsu_output.f90 @@ -260,6 +260,6 @@ subroutine lsu_output 102 format (1x,4i6,i7,a,2x,a,40f12.3) !103 format (4i6,i8,a,2x,a,6f12.3,29f17.3) 103 format (4i6,i8,a,2x,a,4f12.3,23f17.3) -104 format (4i6,i8,a,2x,a,6f12.3,29f17.3) +!*** tu Wunused-label: 104 format (4i6,i8,a,2x,a,6f12.3,29f17.3) end subroutine lsu_output \ No newline at end of file diff --git a/src/recall_nut.f90 b/src/recall_nut.f90 index 5b290b2..6a3379f 100644 --- a/src/recall_nut.f90 +++ b/src/recall_nut.f90 @@ -84,7 +84,7 @@ subroutine recall_nut(irec) endif -100 format(i8,i8,100e16.8) +!*** tu Wunused-label: 100 format(i8,i8,100e16.8) return end subroutine recall_nut \ No newline at end of file diff --git a/src/ru_output.f90 b/src/ru_output.f90 index 3184522..48e7da1 100644 --- a/src/ru_output.f90 +++ b/src/ru_output.f90 @@ -60,7 +60,7 @@ subroutine ru_output (iru) return -100 format (4i6,2i8,25f15.3) -102 format (4i6,2i8,25f15.3) +!*** tu Wunused-label: 100 format (4i6,2i8,25f15.3) +!*** tu Wunused-label: 102 format (4i6,2i8,25f15.3) end subroutine ru_output \ No newline at end of file diff --git a/src/salt_balance.f90 b/src/salt_balance.f90 index fbab842..08f3792 100644 --- a/src/salt_balance.f90 +++ b/src/salt_balance.f90 @@ -506,7 +506,7 @@ subroutine salt_balance 7000 format(i8,i8,i8,35e16.8) -7001 format(20e16.8) +!*** tu Wunused-label: 7001 format(20e16.8) return end \ No newline at end of file diff --git a/src/salt_chem_hru.f90 b/src/salt_chem_hru.f90 index 8e73fb0..0281bce 100644 --- a/src/salt_chem_hru.f90 +++ b/src/salt_chem_hru.f90 @@ -365,7 +365,7 @@ subroutine salt_chem_hru mass_after = mass_after / hru(j)%area_ha !kg/ha hsaltb_d(j)%salt(1)%diss = mass_after - mass_before -101 format(i8,i8,i8,i8,50(e13.4)) +!*** tu Wunused-label: 101 format(i8,i8,i8,i8,50(e13.4)) return end diff --git a/src/sep_biozone.f90 b/src/sep_biozone.f90 index bcb906d..4fd91fa 100644 --- a/src/sep_biozone.f90 +++ b/src/sep_biozone.f90 @@ -305,6 +305,6 @@ subroutine sep_biozone !! total live biomass in biozone(kg/ha) biom(j) = biom(j) + rbiom(j) -1000 format(3i5,50es15.4) +!*** tu Wunused-label: 1000 format(3i5,50es15.4) return end subroutine sep_biozone \ No newline at end of file diff --git a/src/sq_greenampt.f90 b/src/sq_greenampt.f90 index 3883bf3..c93e7e8 100644 --- a/src/sq_greenampt.f90 +++ b/src/sq_greenampt.f90 @@ -179,14 +179,14 @@ subroutine sq_greenampt end if return - 5000 format(//,"Excess rainfall calculation for day ",i3," of year ", & - i4," for sub-basin",i4,".",/) - 5001 format(t2,"Time",t9,"Incremental",t22,"Cumulative",t35,"Rainfall", & - t45,"Infiltration",t59,"Cumulative",t71,"Cumulative",t82, & - "Incremental",/,t2,"Step",t10,"Rainfall",t23,"Rainfall", & - t35,"Intensity",t49,"Rate",t58,"Infiltration",t73,"Runoff", & - t84,"Runoff",/,t12,"(mm)",t25,"(mm)",t36,"(mm/h)",t48, & - "(mm/h)",t62,"(mm)",t74,"(mm)",t85,"(mm)",/) - 5002 format(i5,t12,f5.2,t24,f6.2,t36,f6.2,t47,f7.2,t61,f6.2,t73,f6.2, & - t84,f6.2) +!*** tu Wunused-label: 5000 format(//,"Excess rainfall calculation for day ",i3," of year ", & + !i4," for sub-basin",i4,".",/) +!*** tu Wunused-label: 5001 format(t2,"Time",t9,"Incremental",t22,"Cumulative",t35,"Rainfall", & + !t45,"Infiltration",t59,"Cumulative",t71,"Cumulative",t82, & + !"Incremental",/,t2,"Step",t10,"Rainfall",t23,"Rainfall", & + !t35,"Intensity",t49,"Rate",t58,"Infiltration",t73,"Runoff", & + !t84,"Runoff",/,t12,"(mm)",t25,"(mm)",t36,"(mm/h)",t48, & + !"(mm/h)",t62,"(mm)",t74,"(mm)",t85,"(mm)",/) +!*** tu Wunused-label: 5002 format(i5,t12,f5.2,t24,f6.2,t36,f6.2,t47,f7.2,t61,f6.2,t73,f6.2, & + !t84,f6.2) end subroutine sq_greenampt \ No newline at end of file diff --git a/src/surface.f90 b/src/surface.f90 index a9e1536..bc824f9 100644 --- a/src/surface.f90 +++ b/src/surface.f90 @@ -77,6 +77,6 @@ subroutine surface if (qday < 0.) qday = 0. -1010 format (2(i4,1x),a5,a4,1x,10f8.3) +!*** tu Wunused-label: 1010 format (2(i4,1x),a5,a4,1x,10f8.3) return end subroutine surface \ No newline at end of file diff --git a/src/swift_output.f90 b/src/swift_output.f90 index c42e667..38ee8e2 100644 --- a/src/swift_output.f90 +++ b/src/swift_output.f90 @@ -42,7 +42,7 @@ subroutine swift_output 205 format (7xA16, A16, 10x,*(A16)) ! format of chan_dat.swf headers 305 format (I8, 1x, A16, A16,*(F16.4)) ! format of chan_dat.swf 206 format (4xA8, 1xA8, 20x,*(A16)) ! format of chan_dr.swf headers - 306 format (I8,4xA16, 10xA16,*(F16.4)) ! format of chan_dr.swf +!*** tu Wunused-label: 306 format (I8,4xA16, 10xA16,*(F16.4)) ! format of chan_dr.swf 207 format (A16,1x*(A16)) ! format of aqu_dr.swf headers 208 format (6xA8, 1xA8, 16x,*(A8,6x)) ! format of res_dat.swf headers !209 format (6xA8, 1xA8, 16x,*(A8,6x)) ! format of res_dr.swf headers From 568154c5ea40a6d5238c87724fc01aa72f7f81bc Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 10:45:30 -0500 Subject: [PATCH 05/17] Increase length of various character variables Extended the length of character variables across multiple files: - `actions.f90`: `lu_prev` from 25 to 40. - `cal_conditions.f90`: `chg_parm` from 16 to 25. - `conditional_module.f90`: `option` in `actions_var` from 25 to 40. - `gwflow_chan_read.f90`: `col_head_con` array elements from 8 to 20. - `hydrograph_module.f90`: `flo` in `hru_swift_header_base2` from 16 to 17. - `plant_data_module.f90`: `plts_bsn` array elements from 16 to 40. - `plant_module.f90`: - `fertname` in `fertilize_future` from 35 to 40. - `name` in `plant_community` from 35 to 40. - `pl` in `plant_community` from 16 to 40. - `last_kill` in `plant_community` from 16 to 40. - `soil_module.f90`: `snam` in `soil_profile` from 16 to 20. - `time_module.f90`: `cal_sim` from 25 to 29. --- src/actions.f90 | 2 +- src/cal_conditions.f90 | 2 +- src/conditional_module.f90 | 2 +- src/gwflow_chan_read.f90 | 2 +- src/hydrograph_module.f90 | 2 +- src/plant_data_module.f90 | 2 +- src/plant_module.f90 | 8 ++++---- src/soil_module.f90 | 2 +- src/time_module.f90 | 2 +- 9 files changed, 12 insertions(+), 12 deletions(-) diff --git a/src/actions.f90 b/src/actions.f90 index 2cbfae8..cd48f9b 100644 --- a/src/actions.f90 +++ b/src/actions.f90 @@ -90,7 +90,7 @@ subroutine actions (ob_cur, ob_num, idtbl) real :: cn_prev = 0. real :: stor_m3 = 0. character(len=1) :: action = "" ! | - character(len=25) :: lu_prev = "" ! | + character(len=40) :: lu_prev = "" ! | do iac = 1, d_tbl%acts action = "n" diff --git a/src/cal_conditions.f90 b/src/cal_conditions.f90 index 926e18f..0e1a9e4 100644 --- a/src/cal_conditions.f90 +++ b/src/cal_conditions.f90 @@ -12,7 +12,7 @@ subroutine cal_conditions implicit none - character(len=16) :: chg_parm = "" ! | + character(len=25) :: chg_parm = "" ! | character(len=16) :: chg_typ = "" !variable |type of change (absval, abschg, pctchg) character(len=1) :: cond_met = "" ! | character(len=1) :: pl_find = "" ! | diff --git a/src/conditional_module.f90 b/src/conditional_module.f90 index 37ad3b7..c5241b6 100644 --- a/src/conditional_module.f90 +++ b/src/conditional_module.f90 @@ -18,7 +18,7 @@ module conditional_module character(len=25) :: ob = "" ! object variable (ie res, hru, canal, etc) integer :: ob_num = 0 ! object number character(len=25) :: name = "" ! name of action - character(len=25) :: option = "" ! action option - specific to type of action (ie for reservoir, option to + character(len=40) :: option = "" ! action option - specific to type of action (ie for reservoir, option to ! input rate, days of drawdown, weir equation pointer, etc real :: const = 0. ! constant used for rate, days, etc real :: const2 = 1 ! additional constant used for rate, days, etc diff --git a/src/gwflow_chan_read.f90 b/src/gwflow_chan_read.f90 index d401284..2c6be53 100644 --- a/src/gwflow_chan_read.f90 +++ b/src/gwflow_chan_read.f90 @@ -10,7 +10,7 @@ subroutine gwflow_chan_read implicit none - character(len=8) :: col_head_con(17) = "" + character(len=20) :: col_head_con(17) = "" integer :: i = 0 integer :: j = 0 integer :: k = 0 diff --git a/src/hydrograph_module.f90 b/src/hydrograph_module.f90 index bcff631..b9f2b9c 100644 --- a/src/hydrograph_module.f90 +++ b/src/hydrograph_module.f90 @@ -1127,7 +1127,7 @@ module hydrograph_module end type hru_swift_header_baseunit type hru_swift_header_base2 - character (len=16) :: flo = "flo " !! ha-m |volume of water + character (len=17) :: flo = "flo " !! ha-m |volume of water type(hru_swift_header_base) :: base end type hru_swift_header_base2 diff --git a/src/plant_data_module.f90 b/src/plant_data_module.f90 index 200e8eb..08b8d40 100644 --- a/src/plant_data_module.f90 +++ b/src/plant_data_module.f90 @@ -2,7 +2,7 @@ module plant_data_module implicit none - character(len=16), dimension (:), allocatable :: plts_bsn !none |plant names simulated in current run + character(len=40), dimension (:), allocatable :: plts_bsn !none |plant names simulated in current run type plant_db character(len=40) :: plantnm = "" !none |crop name diff --git a/src/plant_module.f90 b/src/plant_module.f90 index 05bbe64..5109822 100644 --- a/src/plant_module.f90 +++ b/src/plant_module.f90 @@ -92,7 +92,7 @@ module plant_module type fertilize_future !! set to the fert_fut action in the lum.dtl character(len=35) :: name = "" !! name of the fertilizer operation (from the dtbl) integer :: num = 0 !! number of the future fertilizer application (from the dtbl) - character(len=35) :: fertname = "" !! fertilizer name in fertilizer.frt + character(len=40) :: fertname = "" !! fertilizer name in fertilizer.frt integer :: fertnum = 0 !! fertilizer number in fertilizer.frt integer :: day_fert = 0 !! future julian day to apply fert (must be within a year of test) real :: fert_kg = 0. !! kg/ha - amount of fertilzer applied @@ -101,15 +101,15 @@ module plant_module end type fertilize_future type plant_community - character(len=35) :: name = "" + character(len=40) :: name = "" integer :: npl = 0 !! number of plants in community - character(len=16), dimension(:), allocatable :: pl !! N/A |plant name + character(len=40), dimension(:), allocatable :: pl !! N/A |plant name integer :: pcomdb = 0 !! current plant community database number integer :: rot_yr = 1 !! rotation year integer :: days_plant = 0 !! |days since last planting - for conditional scheduling planting integer :: days_harv = 0 !! |days since last harvest - for conditional scheduling planting integer :: days_irr = 0 !! |days since last irrigation - for conditional scheduling planting - character(len=16) :: last_kill = ""!! |name of last plant killed + character(len=40) :: last_kill = ""!! |name of last plant killed real :: cht_mx = 0. !! m |height of tallest plant in community for pet calculation real :: lai_sum = 0. !! m/m |sum of lai for each plant real :: laimx_sum = 0. !! m/m |sum of maximum lai for each plant - for canopy interception diff --git a/src/soil_module.f90 b/src/soil_module.f90 index 45895f5..845e995 100644 --- a/src/soil_module.f90 +++ b/src/soil_module.f90 @@ -50,7 +50,7 @@ module soil_module type (soil_physical_properties),dimension (:), allocatable:: phys1 type soil_profile - character(len=16) :: snam = "" !! NA soil series name + character(len=20) :: snam = "" !! NA soil series name character(len=16) :: hydgrp = "" !! NA hydrologic soil group character(len=16) :: texture = "" integer :: nly = 0 !! none number of soil layers diff --git a/src/time_module.f90 b/src/time_module.f90 index 5d14317..e8f6df8 100644 --- a/src/time_module.f90 +++ b/src/time_module.f90 @@ -3,7 +3,7 @@ module time_module implicit none !integer :: int_print = 1 !! current interval between daily prints - character (len=25) :: cal_sim = " Original Simulation" + character (len=29) :: cal_sim = " Original Simulation" real :: cal_adj = 0.0 real :: yrs_print = 0. integer, dimension (13) :: ndays = (/0,31,60,91,121,152,182,213,244,274,305,335,366/) From 6e9a0f73d58a23c754aab62bce04776e6f9084ef Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 10:56:40 -0500 Subject: [PATCH 06/17] Expand string lengths for `urb_ro` and `irr_src` variables The `landuse` type's `urb_ro` variable in `hru_module.f90` has been modified to allow for longer strings, increasing its length from 16 to 40 characters. This change accommodates more detailed urban runoff model identification. Similarly, the `irr_src` variable in `hru_module.f90` has been updated to increase its length from 5 to 40 characters, allowing for more descriptive irrigation source specifications. --- src/hru_module.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/hru_module.f90 b/src/hru_module.f90 index 21808fd..4adf6e6 100644 --- a/src/hru_module.f90 +++ b/src/hru_module.f90 @@ -100,7 +100,7 @@ module hru_module integer :: cn_lu = 0 integer :: cons_prac = 0 real :: usle_p = 0. !! none | USLE equation support practice (P) factor daily - character (len=16) :: urb_ro = ""!! none | urban runoff model + character (len=40) :: urb_ro = ""!! none | urban runoff model !! | "usgs_reg", simulate using USGS regression eqs !! | "buildup_washoff", simulate using build up/wash off alg integer :: urb_lu = 0 !! none | urban land type identification number @@ -251,7 +251,7 @@ module hru_module real :: wet_obank_in = 0. !mm |inflow from overbank into wetlands real :: precip_aa = 0. character(len=1) :: wet_fp = "n" - character(len=5) :: irr_src = "unlim" ! |irrigation source, Jaehak 2022 + character(len=40) :: irr_src = "unlim" ! |irrigation source, Jaehak 2022 real :: strsa = 0. real :: irr_hmax = 0 !mm H2O |target ponding depth during paddy irrigation Jaehak 2022 real :: irr_hmin = 0 !mm H2O |threshold ponding depth to trigger paddy irrigation From 576314b14b37ff7efab1a254c9dfe8576d8a7b34 Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Tue, 8 Oct 2024 12:35:07 -0500 Subject: [PATCH 07/17] Separate write statements for bsn%name and prog Modified output_landscape_init.f90 to split the single write statement into two separate statements. Now, bsn%name and prog are written to crop_yld_aa.txt on different lines. --- .gitignore | 3 ++- src/output_landscape_init.f90 | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 7a2f2fd..4bfcb14 100644 --- a/.gitignore +++ b/.gitignore @@ -59,4 +59,5 @@ CMakeCache.txt Resources/R* src/main.f90 ford.md -/.vs/SWAT_PLUS_DEV \ No newline at end of file +/.vs/SWAT_PLUS_DEV +/.vscode diff --git a/src/output_landscape_init.f90 b/src/output_landscape_init.f90 index 2b22c1f..9d53bae 100644 --- a/src/output_landscape_init.f90 +++ b/src/output_landscape_init.f90 @@ -1423,7 +1423,8 @@ subroutine output_landscape_init !! headers for annual crop yields if (pco%crop_yld == "a" .or. pco%crop_yld == "b") then open (4008,file="crop_yld_aa.txt", recl = 1500) - write (4008,*) bsn%name, prog + write (4008,*) bsn%name + write (4008,*) prog write (4008,1000) write (9000,*) "CROP crop_yld_aa.txt" if (pco%csvout == "y") then From ee1b472beb4e4fb0619630531d612ceec2a6e8b9 Mon Sep 17 00:00:00 2001 From: Taci Ugraskan <143652012+tugraskan@users.noreply.github.com> Date: Thu, 10 Oct 2024 14:34:23 -0500 Subject: [PATCH 08/17] Refactor and enhance residue decomposition and output Refactored residue decomposition logic and enhanced output formatting across multiple modules. Key changes include: - Modified `carbon_module.f90` to update `carbon_residue_gain_losses` type. - Added commented-out code in `cbn_zhang2.f90` for carbon loss calculations. - Updated `hru_control.f90` to call `rsd_decomp` and re-indented conditional blocks. - Enhanced `output_landscape_module.f90` for better readability and maintainability. - Removed and re-added fields in `output_landscape_module.f90` for consistent formatting. - Introduced new subroutine `rsd_decomp` in `rsd_decomp.f90` for daily N and P mineralization. - Made minor adjustments in `sd_channel_sediment3.f90` for clarity and precision. - Improved `swift_output.f90` header format for better precision. --- src/carbon_module.f90 | 2 +- src/cbn_zhang2.f90 | 8 + src/hru_control.f90 | 11 +- src/hru_output.f90 | 149 ++++++---- src/nut_nminrl.f90 | 97 +----- src/organic_mineral_mass_module.f90 | 2 +- src/output_landscape_module.f90 | 444 ++++++++++++++-------------- src/rsd_decomp.f90 | 171 +++++++++++ src/sd_channel_sediment3.f90 | 9 +- src/swift_output.f90 | 2 +- 10 files changed, 516 insertions(+), 379 deletions(-) create mode 100644 src/rsd_decomp.f90 diff --git a/src/carbon_module.f90 b/src/carbon_module.f90 index b3b0ccd..436528e 100644 --- a/src/carbon_module.f90 +++ b/src/carbon_module.f90 @@ -231,7 +231,7 @@ module carbon_module type (carbon_soil_gain_losses) :: bsc_a type carbon_residue_gain_losses - real :: plant_c = 0. !kg C/ha |carbon added to residue from leaf drop and kill + real :: plant_c = 0. !kg C/ha |carbon added to residue from leaf drop and kill real :: res_decay_c = 0. !kg C/ha |carbon lost to soil from residue decay real :: harv_stov_c = 0. !kg C/ha |carbon removed during residue harvest real :: emit_c = 0. !kg C/ha |CO2 production from burning residue carbon diff --git a/src/cbn_zhang2.f90 b/src/cbn_zhang2.f90 index 9113c91..64de2c4 100644 --- a/src/cbn_zhang2.f90 +++ b/src/cbn_zhang2.f90 @@ -279,6 +279,14 @@ subroutine cbn_zhang2 j = ihru + !! calculate carbon loss in surface residue + !soil1(j)%str(k)%n = soil1(j)%str(k)%n * (1. - decr) + !soil1(j)%lig(k)%n = soil1(j)%lig(k)%n * (1. - decr) + !soil1(j)%meta(k)%n = soil1(j)%meta(k)%n * (1. - decr) + !soil1(j)%str(k)%p = soil1(j)%str(k)%p * (1. - decr) + !soil1(j)%lig(k)%p = soil1(j)%lig(k)%p * (1. - decr) + !soil1(j)%meta(k)%p = soil1(j)%meta(k)%p * (1. - decr) + !calculate tillage factor using dssat if (tillage_switch(j) .eq. 1 .and. tillage_days(j) .le. 30) then tillage_factor(j) = 1.6 diff --git a/src/hru_control.f90 b/src/hru_control.f90 index d006e7c..fd8d856 100644 --- a/src/hru_control.f90 +++ b/src/hru_control.f90 @@ -351,18 +351,21 @@ subroutine hru_control end if end if + !! compute residue decomposition + call rsd_decomp + !! compute nitrogen and phosphorus mineralization if (bsn_cc%cswat == 0) then call nut_nminrl end if - if (bsn_cc%cswat == 2) then - call cbn_zhang2 - end if + if (bsn_cc%cswat == 2) then + call cbn_zhang2 + end if call nut_nitvol - if (bsn_cc%sol_P_model == 1) then + if (bsn_cc%sol_P_model == 1) then call nut_pminrl2 else call nut_pminrl diff --git a/src/hru_output.f90 b/src/hru_output.f90 index 59dd783..8d9f138 100644 --- a/src/hru_output.f90 +++ b/src/hru_output.f90 @@ -10,6 +10,7 @@ subroutine hru_output (ihru) use soil_module use carbon_module use hru_module, only : hru + use landuse_data_module implicit none @@ -18,6 +19,7 @@ subroutine hru_output (ihru) integer :: j = 0 integer :: iob = 0 integer :: ipl = 0 + integer :: ilu = 0 real :: const = 0. real :: sw_init = 0. real :: sno_init = 0. @@ -28,6 +30,7 @@ subroutine hru_output (ihru) j = ihru iob = sp_ob1%hru + j - 1 !!!!!! added for new output write + ilu = hru(j)%land_use_mgt hwb_m(j) = hwb_m(j) + hwb_d(j) hnb_m(j) = hnb_m(j) + hnb_d(j) @@ -42,31 +45,39 @@ subroutine hru_output (ihru) !! daily print if (pco%day_print == "y" .and. pco%int_day_cur == pco%int_day) then if (pco%wb_hru%d == "y") then - write (2000,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_d(j) !! waterbal + write (2000,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_d(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! water bal day if (pco%csvout == "y") then !! changed write unit below (2004 to write file data) - write (2004,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_d(j) !! waterbal + write (2004,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hwb_d(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if hwb_d(j)%sw_init = hwb_d(j)%sw_final hwb_d(j)%sno_init = hwb_d(j)%sno_final if (pco%nb_hru%d == "y") then - write (2020,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_d(j) !! nutrient bal + write (2020,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_d(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! nutrient bal day if (pco%csvout == "y") then - write (2024,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_d(j) !! nutrient bal + write (2024,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hnb_d(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%ls_hru%d == "y") then - write (2030,102) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_d(j) !! losses + write (2030,108) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_d(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! losses day if (pco%csvout == "y") then - write (2034,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_d(j) !! losses + write (2034,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hls_d(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%pw_hru%d == "y") then - write (2040,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_d(j) !! plant weather + write (2040,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_d(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! plant weather day if (pco%csvout == "y") then - write (2044,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_d(j) !! plant weather + write (2044,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hpw_d(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if end if @@ -87,32 +98,40 @@ subroutine hru_output (ihru) hwb_m(j)%sno_final = hwb_d(j)%sno_final if (pco%wb_hru%m == "y") then - write (2001,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_m(j) + write (2001,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_m(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! water bal mon if (pco%csvout == "y") then - write (2005,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_m(j) + write (2005,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hwb_m(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%nb_hru%m == "y") then - write (2021,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_m(j) + write (2021,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_m(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! nutrient bal mon if (pco%csvout == "y") then - write (2025,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_m(j) + write (2025,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hnb_m(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%ls_hru%m == "y") then - write (2031,102) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_m(j) + write (2031,108) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_m(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! losses mon if (pco%csvout == "y") then - write (2035,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_m(j) + write (2035,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hls_m(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%pw_hru%m == "y") then hpw_m(j)%nplnt = pl_mass(j)%tot_com%n hpw_m(j)%pplnt = pl_mass(j)%tot_com%p - write (2041,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_m(j) + write (2041,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_m(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! plant weather mon if (pco%csvout == "y") then - write (2045,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_m(j) + write (2045,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hpw_m(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if @@ -145,32 +164,40 @@ subroutine hru_output (ihru) hru(j)%irr = 1 end if if (pco%wb_hru%y == "y") then - write (2002,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_y(j) + write (2002,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_y(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! water balance yr if (pco%csvout == "y") then - write (2006,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_y(j) + write (2006,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hwb_y(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%nb_hru%y == "y") then - write (2022,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_y(j) + write (2022,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_y(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! nutrient balance yr if (pco%csvout == "y") then - write (2026,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_y(j) + write (2026,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hnb_y(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%ls_hru%y == "y") then - write (2032,102) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_y(j) + write (2032,108) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_y(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! losses yr if (pco%csvout == "y") then - write (2036,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_y(j) + write (2036,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hls_y(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if if (pco%pw_hru%y == "y") then hpw_y(j)%nplnt = pl_mass(j)%tot_com%n hpw_y(j)%pplnt = pl_mass(j)%tot_com%p - write (2042,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_y(j) + write (2042,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_y(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! plant weather yr if (pco%csvout == "y") then - write (2046,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_y(j) + write (2046,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hpw_y(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if @@ -188,9 +215,11 @@ subroutine hru_output (ihru) hwb_a(j)%sno_init = sno_init hwb_a(j)%sno_final = hwb_d(j)%sno_final if (pco%wb_hru%a == "y") then - write (2003,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_a(j) + write (2003,100) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_a(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! water balance ann if (pco%csvout == "y") then - write (2007,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hwb_a(j) + write (2007,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hwb_a(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if end if sw_init = hwb_d(j)%sw_final @@ -208,18 +237,22 @@ subroutine hru_output (ihru) if (time%end_sim == 1 .and. pco%nb_hru%a == "y") then hnb_a(j) = hnb_a(j) / time%yrs_prt - write (2023,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_a(j) + write (2023,104) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_a(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! nutrient bal ann if (pco%csvout == "y") then - write (2027,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hnb_a(j) + write (2027,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hnb_a(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if hnb_a(j) = hnbz end if if (time%end_sim == 1 .and. pco%ls_hru%a == "y") then hls_a(j) = hls_a(j) / time%yrs_prt - write (2033,101) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_a(j) + write (2033,107) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_a(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! losses ann if (pco%csvout == "y") then - write (2037,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hls_a(j) + write (2037,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hls_a(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if hls_a(j) = hlsz end if @@ -229,9 +262,11 @@ subroutine hru_output (ihru) hpw_a(j) = hpw_a(j) // time%days_prt hpw_a(j)%nplnt = pl_mass(j)%tot_com%n hpw_a(j)%pplnt = pl_mass(j)%tot_com%p - write (2043,102) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_a(j) + write (2043,102) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_a(j), & + lum(ilu)%plant_cov, lum(ilu)%mgt_ops !! plant weather ann if (pco%csvout == "y") then - write (2047,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, hpw_a(j) + write (2047,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, & + hpw_a(j), lum(ilu)%plant_cov, lum(ilu)%mgt_ops end if hru(j)%strsa = hpw_a(j)%strsa hpw_a(j) = hpwz @@ -240,41 +275,41 @@ subroutine hru_output (ihru) !! write yearly crop yields if (time%end_yr == 1) then if (pco%crop_yld == "y" .or. pco%crop_yld == "b") then - do ipl = 1, pcom(j)%npl - if (pcom(j)%plcur(ipl)%harv_num_yr > 0) then - pl_mass(j)%yield_yr(ipl) = pl_mass(j)%yield_yr(ipl) / float(pcom(j)%plcur(ipl)%harv_num_yr) - endif - write (4010,103) time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) - if (pco%csvout == "y") then - write (4011,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) - end if - end do + do ipl = 1, pcom(j)%npl + if (pcom(j)%plcur(ipl)%harv_num_yr > 0) then + pl_mass(j)%yield_yr(ipl) = pl_mass(j)%yield_yr(ipl) / float(pcom(j)%plcur(ipl)%harv_num_yr) + endif + write (4010,103) time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) + if (pco%csvout == "y") then + write (4011,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j, pcom(j)%pl(ipl), pl_mass(j)%yield_yr(ipl) + end if + end do end if end if !! write average annual crop yields if (time%end_sim == 1) then if (pco%crop_yld == "a" .or. pco%crop_yld == "b") then - do ipl = 1, pcom(j)%npl - idp = pcom(j)%plcur(ipl)%idplt - if (pcom(j)%plcur(ipl)%harv_num > 0) then - pl_mass(j)%yield_tot(ipl) = pl_mass(j)%yield_tot(ipl) / float(pcom(j)%plcur(ipl)%harv_num) - endif - write (4008,103) time%day, time%mo, time%day_mo, time%yrc, j,pldb(idp)%plantnm, pl_mass(j)%yield_tot(ipl) - if (pco%csvout == "y") then - write (4009,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j,pldb(idp)%plantnm, pl_mass(j)%yield_tot(ipl) - end if - end do + do ipl = 1, pcom(j)%npl + idp = pcom(j)%plcur(ipl)%idplt + if (pcom(j)%plcur(ipl)%harv_num > 0) then + pl_mass(j)%yield_tot(ipl) = pl_mass(j)%yield_tot(ipl) / float(pcom(j)%plcur(ipl)%harv_num) + endif + write (4008,103) time%day, time%mo, time%day_mo, time%yrc, j,pldb(idp)%plantnm, pl_mass(j)%yield_tot(ipl) + if (pco%csvout == "y") then + write (4009,'(*(G0.3,:","))') time%day, time%mo, time%day_mo, time%yrc, j,pldb(idp)%plantnm, pl_mass(j)%yield_tot(ipl) + end if + end do end if end if return -100 format (4i6,2i8,2x,a,42f12.3) -101 format (4i6,2i8,2x,a,25f12.3) !!!!!!!!!! nbs chg -102 format (4i6,2i8,2x,a,25f12.3) !!!!!!!!!! nbs chg +100 format (4i6,2i8,2x,a,42f12.3,3x,a16,a30) +101 format (4i6,2i8,2x,a,25f12.3,3x,a16,a30) +102 format (4i6,2i8,2x,a,25f12.3,3x,a16,a30) 103 format (4i6,i8,4x,a,5x,4f12.3) -104 format (4i6,2i8,2x,a8,4f12.3,23f17.3) -!*** tu Wunused-label: 105 format (4i6,2i8,2x,a8,8f17.3) -!*** tu Wunused-label: 106 format (4i6,2i8,2x,a8,29f17.3) +104 format (4i6,2i8,2x,a8,4f12.3,15f17.3,7x,a16,a30) +107 format (4i6,2i8,2x,a,12f12.3,3x,a16,a30) +108 format (4i6,2i8,2x,a,12f12.3,3x,a16,a30) end subroutine hru_output \ No newline at end of file diff --git a/src/nut_nminrl.f90 b/src/nut_nminrl.f90 index 5ffc610..90e0ad0 100644 --- a/src/nut_nminrl.f90 +++ b/src/nut_nminrl.f90 @@ -30,7 +30,6 @@ subroutine nut_nminrl !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ use septic_data_module - use plant_data_module use basin_module use organic_mineral_mass_module use hru_module, only : rsdco_plcom, i_sep, ihru, ipl, isep @@ -74,89 +73,11 @@ subroutine nut_nminrl j = ihru nactfr = .02 !zero transformations for summing layers - hnb_d(j)%rsd_nitorg_n = 0. - hnb_d(j)%rsd_laborg_p = 0. hnb_d(j)%act_nit_n = 0. hnb_d(j)%org_lab_p = 0. hnb_d(j)%act_sta_n = 0. hnb_d(j)%denit = 0. - !! mineralization can occur only if temp above 0 deg - if (soil(j)%phys(1)%tmp > 0.) then - !! compute residue decomp and mineralization of fresh organic n and p of flat residue - do ipl = 1, pcom(j)%npl !! we need to decompose each plant - rmn1 = 0. - rmp = 0. - if (rsd1(j)%tot(ipl)%n > 1.e-4) then - cnr = rsd1(j)%tot(ipl)%c / rsd1(j)%tot(ipl)%n - if (cnr > 500.) cnr = 500. - cnrf = Exp(-.693 * (cnr - 25.) / 25.) - else - cnrf = 1. - end if - - if (rsd1(j)%tot(ipl)%p > 1.e-4) then - cpr = rsd1(j)%tot(ipl)%c / rsd1(j)%tot(ipl)%p - if (cpr > 5000.) cpr = 5000. - cprf = Exp(-.693 * (cpr - 200.) / 200.) - else - cprf = 1. - end if - - !! compute soil water factor - if (soil(j)%phys(1)%st < 0.) soil(j)%phys(1)%st = .0000001 - sut = .1 + .9 * Sqrt(soil(j)%phys(1)%st / soil(j)%phys(1)%fc) - sut = Max(.05, sut) - - !!compute soil temperature factor - xx = soil(j)%phys(1)%tmp - cdg = .9 * xx / (xx + Exp(9.93 - .312 * xx)) + .1 - cdg = Max(.1, cdg) - - !! compute combined factor - xx = cdg * sut - if (xx < 0.) xx = 0. - if (xx > 1.e6) xx = 1.e6 - csf = Sqrt(xx) - ca = Min(cnrf, cprf, 1.) - !! compute residue decomp and mineralization for each plant - if (pcom(j)%npl > 0) then - idp = pcom(j)%plcur(ipl)%idplt - decr = pldb(idp)%rsdco_pl * ca * csf - else - decr = 0.05 * ca * csf - end if - decr = Max(bsn_prm%decr_min, decr) - decr = Min(decr, 1.) - - !! mineralization of mass and carbon - rsd1(j)%tot(ipl)%m = Max(1.e-6, rsd1(j)%tot(ipl)%m) - rdc = decr * rsd1(j)%tot(ipl)%m - rsd1(j)%tot(ipl)%m = rsd1(j)%tot(ipl)%m - rdc - if (rsd1(j)%tot(ipl)%m < 0.) rsd1(j)%tot(ipl)%m = 0. - rsd1(j)%tot(ipl)%c = (1. - decr) * rsd1(j)%tot(ipl)%c - if (rsd1(j)%tot(ipl)%c < 0.) rsd1(j)%tot(ipl)%c = 0. - soil1(j)%hact(1)%c = soil1(j)%hact(1)%c + decr * rsd1(j)%tot(ipl)%c - - !! mineralization of residue n and p - rmn1 = decr * rsd1(j)%tot(ipl)%n - rsd1(j)%tot(ipl)%n = Max(1.e-6, rsd1(j)%tot(ipl)%n) - rsd1(j)%tot(ipl)%n = rsd1(j)%tot(ipl)%n - rmn1 - soil1(j)%mn(1)%no3 = soil1(j)%mn(1)%no3 + .8 * rmn1 - soil1(j)%hact(1)%n = soil1(j)%hact(1)%n + .2 * rmn1 - - rsd1(j)%tot(ipl)%p = Max(1.e-6, rsd1(j)%tot(ipl)%p) - rmp = decr * rsd1(j)%tot(ipl)%p - rsd1(j)%tot(ipl)%p = rsd1(j)%tot(ipl)%p - rmp - soil1(j)%mp(1)%lab = soil1(j)%mp(1)%lab + .8 * rmp - soil1(j)%hact(1)%p = soil1(j)%hact(1)%p + .2 * rmp - - hnb_d(j)%rsd_nitorg_n = hnb_d(j)%rsd_nitorg_n + .8 * rmn1 - hnb_d(j)%rsd_laborg_p = hnb_d(j)%rsd_laborg_p + .8 * rmp - - end do ! ipl = 1, pcom(j)%npl - end if - !! compute humus mineralization of organic soil pools do k = 1, soil(j)%nly @@ -252,20 +173,10 @@ subroutine nut_nminrl rmn1 = decr * (soil1(j)%str(k)%n + soil1(j)%lig(k)%n + soil1(j)%meta(k)%n) rmp = decr * (soil1(j)%str(k)%p + soil1(j)%lig(k)%p + soil1(j)%meta(k)%p) - soil1(j)%str(k)%n = soil1(j)%str(k)%n * (1. - decr) - soil1(j)%lig(k)%n = soil1(j)%lig(k)%n * (1. - decr) - soil1(j)%meta(k)%n = soil1(j)%meta(k)%n * (1. - decr) - soil1(j)%str(k)%p = soil1(j)%str(k)%p * (1. - decr) - soil1(j)%lig(k)%p = soil1(j)%lig(k)%p * (1. - decr) - soil1(j)%meta(k)%p = soil1(j)%meta(k)%p * (1. - decr) - - ! soil1(j)%mn(k)%no3 = soil1(j)%mn(k)%no3 + .8 * rmn1 - ! soil1(j)%hact(k)%n = soil1(j)%hact(k)%n + .2 * rmn1 - ! soil1(j)%mp(k)%lab = soil1(j)%mp(k)%lab + .8 * rmp - ! soil1(j)%hsta(k)%p = soil1(j)%hsta(k)%p + .2 * rmp - - ! hnb_d(j)%rsd_nitorg_n = hnb_d(j)%rsd_nitorg_n + rmn1 - ! hnb_d(j)%rsd_laborg_p = hnb_d(j)%rsd_laborg_p + rmp + soil1(j)%mn(k)%no3 = soil1(j)%mn(k)%no3 + .8 * rmn1 + soil1(j)%hact(k)%n = soil1(j)%hact(k)%n + .2 * rmn1 + soil1(j)%mp(k)%lab = soil1(j)%mp(k)%lab + .8 * rmp + soil1(j)%hsta(k)%p = soil1(j)%hsta(k)%p + .2 * rmp !! compute denitrification wdn = 0. diff --git a/src/organic_mineral_mass_module.f90 b/src/organic_mineral_mass_module.f90 index 6afb70e..1e3e6a4 100644 --- a/src/organic_mineral_mass_module.f90 +++ b/src/organic_mineral_mass_module.f90 @@ -94,7 +94,7 @@ module organic_mineral_mass_module type (organic_mass), dimension(:), allocatable :: tot ! |total mass surface residue litter pool-dimensioned by plant type (organic_mass), dimension(:), allocatable :: meta ! |metabolic litter pool-dimensioned by plant type (organic_mass), dimension(:), allocatable :: str ! |structural litter pool-dimensioned by plant - type (organic_mass), dimension(:), allocatable :: lignin ! |lignin pool-dimensioned by plant + type (organic_mass), dimension(:), allocatable :: lignin ! |lignin pool-dimensioned by plant type (organic_mass) :: tot_com !kg/ha |total type (organic_mass) :: tot_meta ! | type (organic_mass) :: tot_str ! | diff --git a/src/output_landscape_module.f90 b/src/output_landscape_module.f90 index 32fcb39..10fc2a6 100644 --- a/src/output_landscape_module.f90 +++ b/src/output_landscape_module.f90 @@ -39,12 +39,12 @@ module output_landscape_module real :: satex = 0. !mm H2O |saturation excess flow developed from high water table !rtb gwflow real :: satex_chan = 0. !mm H2O |saturation excess flow reaching main channel !rtb gwflow real :: delsw = 0. !mm H2O |change in soil water volume !rtb gwflow - real :: lagsurf = 0. !mm H2O |surface runoff in transit to channel - real :: laglatq = 0. !mm H2O |lateral flow in transit to channel - real :: lagsatex = 0. !mm H2O |saturation excess flow in transit to channel - real :: wet_evap = 0. !mm H2O |evaporation from wetland surface - real :: wet_out = 0. !mm H2O |outflow (spill) from wetland - real :: wet_stor = 0. !mm H2O |volume stored in wetland at end of time period + real :: lagsurf = 0. !mm H2O |surface runoff in transit to channel + real :: laglatq = 0. !mm H2O |lateral flow in transit to channel + real :: lagsatex = 0. !mm H2O |saturation excess flow in transit to channel + real :: wet_evap = 0. !mm H2O |evaporation from wetland surface + real :: wet_out = 0. !mm H2O |outflow (spill) from wetland + real :: wet_stor = 0. !mm H2O |volume stored in wetland at end of time period end type output_waterbal type (output_waterbal), pointer :: h @@ -292,15 +292,15 @@ module output_landscape_module character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" character (len=8) :: isd = " unit" - character (len=8) :: id = " gis_id" - character (len=16) :: name = " name " + character (len=8) :: id = " gis_id" + character (len=16) :: name = " name " character (len=14) :: precip = " precip" character (len=12) :: snofall = " snofall" - character (len=12) :: snomlt = " snomlt" - character (len=12) :: surq_gen = " surq_gen" - character (len=12) :: latq = " latq" + character (len=12) :: snomlt = " snomlt" + character (len=12) :: surq_gen = " surq_gen" + character (len=12) :: latq = " latq" character (len=12) :: wateryld = " wateryld" - character (len=12) :: perc = " perc" + character (len=12) :: perc = " perc" character (len=12) :: et = " et" character (len=12) :: ecanopy = " ecanopy" character (len=12) :: eplant = " eplant" @@ -313,7 +313,7 @@ module output_landscape_module character (len=12) :: sw_300 = " sw_300" character (len=12) :: sno_init = " sno_init" character (len=12) :: sno_final = " sno_final" - character (len=12) :: snopack = " snopack" + character (len=12) :: snopack = " snopack" character (len=12) :: pet = " pet" character (len=12) :: qtile = " qtile" character (len=12) :: irr = " irr" @@ -336,6 +336,8 @@ module output_landscape_module character (len=12) :: wet_evap = " wet_evap" character (len=12) :: wet_oflo = " wet_oflo" character (len=12) :: wet_stor = " wet_stor" + character (len=16) :: plt_cov = " plant_cov " + character (len=30) :: mgt_ops = " mgt_ops " end type output_waterbal_header type (output_waterbal_header) :: wb_hdr @@ -345,15 +347,15 @@ module output_landscape_module character (len=6) :: day_mo = " " character (len=6) :: yrc = " " character (len=8) :: isd = " " - character (len=8) :: id = " " - character (len=16) :: name = " " + character (len=8) :: id = " " + character (len=16) :: name = " " character (len=14) :: precip = " mm" character (len=12) :: snofall = " mm" - character (len=12) :: snomlt = " mm" - character (len=12) :: surq_gen = " mm" - character (len=12) :: latq = " mm" + character (len=12) :: snomlt = " mm" + character (len=12) :: surq_gen = " mm" + character (len=12) :: latq = " mm" character (len=12) :: wateryld = " mm" - character (len=12) :: perc = " mm" + character (len=12) :: perc = " mm" character (len=12) :: et = " mm" character (len=12) :: ecanopy = " mm" character (len=12) :: eplant = " mm" @@ -366,7 +368,7 @@ module output_landscape_module character (len=12) :: sw_300 = " mm" character (len=12) :: sno_init = " mm" character (len=12) :: sno_final = " mm" - character (len=12) :: snopack = " mm" + character (len=12) :: snopack = " mm" character (len=12) :: pet = " mm" character (len=12) :: qtile = " mm" character (len=12) :: irr = " mm" @@ -397,28 +399,30 @@ module output_landscape_module character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" - character (len=9) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=9) :: isd = " unit " + character (len=8) :: id = " gis_id " + character (len=16) :: name = " name " character(len=12) :: grazn = " grzn " - character(len=12) :: grazp = " grzp " - character(len=12) :: lab_min_p = " lab_min_p " - character(len=12) :: act_sta_p = " act_sta_p " - character(len=17) :: fertn = " fertn " - character(len=17) :: fertp = " fertp " - character(len=17) :: fixn = " fixn " + character(len=12) :: grazp = " grzp " + character(len=12) :: lab_min_p = " lab_min_p " + character(len=12) :: act_sta_p = " act_sta_p " + character(len=17) :: fertn = " fertn " + character(len=17) :: fertp = " fertp " + character(len=17) :: fixn = " fixn " character(len=17) :: denit = " denit " character(len=17) :: act_nit_n = " act_nit_n " character(len=17) :: act_sta_n = " act_sta_n " character(len=17) :: org_lab_p = " org_lab_p " - character(len=17) :: rsd_nitorg_n = " rsd_nitorg_n" - character(len=17) :: rsd_laborg_p = " rsd_laborg_p" - character(len=17) :: no3atmo = " no3atmo " - character(len=17) :: nh4atmo = " nh4atmo " - character(len=17) :: nuptake = " nuptake " - character(len=18) :: puptake = " puptake " - character(len=17) :: gwsoiln = " gwsoiln " - character(len=17) :: gwsoilp = " gwsoilp " + character(len=17) :: rsd_nitorg_n = " rsd_nitorg_n" + character(len=17) :: rsd_laborg_p = " rsd_laborg_p" + character(len=17) :: no3atmo = " no3atmo " + character(len=17) :: nh4atmo = " nh4atmo " + character(len=17) :: nuptake = " nuptake " + character(len=17) :: puptake = " puptake " + character(len=17) :: gwsoiln = " gwsoiln " + character(len=17) :: gwsoilp = " gwsoilp " + character (len=16) :: plt_cov = "plant_cov " + character (len=30) :: mgt_ops = "mgt_ops " end type output_nutbal_header type (output_nutbal_header) :: nb_hdr @@ -427,26 +431,26 @@ module output_landscape_module character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " - character (len=9) :: isd = " " - character (len=8) :: id = " " - character (len=16) :: name = " " + character (len=9) :: isd = " " + character (len=8) :: id = " " + character (len=16) :: name = " " character(len=12) :: grazn = " kgha " - character(len=12) :: grazp = " kgha " - character(len=12) :: lab_min_p = " kgha " - character(len=12) :: act_sta_p = " kgha " - character(len=17) :: fertn = " kgha " - character(len=17) :: fertp = " kgha " - character(len=17) :: fixn = " kgha " - character(len=17) :: denit = " kgha " - character(len=17) :: act_nit_n = " kgha " - character(len=17) :: act_sta_n = " kgha " - character(len=17) :: org_lab_p = " kgha " - character(len=17) :: rsd_nitorg_n = " kgha " - character(len=17) :: rsd_laborg_p = " kgha " - character(len=17) :: no3atmo = " kgha " - character(len=17) :: nh4atmo = " kgha " - character(len=17) :: nuptake = " kgha " - character(len=17) :: puptake = " kgha " + character(len=12) :: grazp = " kgha " + character(len=12) :: lab_min_p = " kgha " + character(len=12) :: act_sta_p = " kgha " + character(len=17) :: fertn = " kgha " + character(len=17) :: fertp = " kgha " + character(len=17) :: fixn = " kgha " + character(len=17) :: denit = " kgha " + character(len=17) :: act_nit_n = " kgha " + character(len=17) :: act_sta_n = " kgha " + character(len=17) :: org_lab_p = " kgha " + character(len=17) :: rsd_nitorg_n = " kgha " + character(len=17) :: rsd_laborg_p = " kgha " + character(len=17) :: no3atmo = " kgha " + character(len=17) :: nh4atmo = " kgha " + character(len=17) :: nuptake = " kgha " + character(len=17) :: puptake = " kgha " character(len=17) :: gwsoiln = " kgha " character(len=17) :: gwsoilp = " kgha " end type output_nutbal_header_units @@ -458,20 +462,22 @@ module output_landscape_module character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" character (len=8) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=8) :: id = " gis_id " + character (len=16) :: name = " name " character (len=12) :: sedyld = " sedyld" character (len=12) :: sedorgn = " sedorgn" character (len=12) :: sedorgp = " sedorgp" character (len=12) :: surqno3 = " surqno3" - character (len=12) :: latno3 = " lat3no3" + character (len=12) :: latno3 = " lat3no3" character (len=12) :: surqsolp = " surqsolp" - character (len=12) :: usle = " usle" + character (len=12) :: usle = " usle" character (len=12) :: sedminp = " sedminp" character (len=12) :: tileno3 = " tileno3" character (len=12) :: lchlabp = " lchlabp" character (len=12) :: tilelabp = " tilelabp" character (len=12) :: satexn = " satexn" + character (len=16) :: plt_cov = " plant_cov " + character (len=30) :: mgt_ops = " mgt_ops " end type output_losses_header type (output_losses_header) :: ls_hdr @@ -481,15 +487,15 @@ module output_landscape_module character (len=6) :: day_mo = " " character (len=6) :: yrc = " " character (len=8) :: isd = " " - character (len=8) :: id = " " - character (len=16) :: name = " " + character (len=8) :: id = " " + character (len=16) :: name = " " character (len=12) :: sedyld = " tha" character (len=12) :: sedorgn = " kgha" character (len=12) :: sedorgp = " kgha" character (len=12) :: surqno3 = " kgha" - character (len=12) :: latno3 = " kgha" + character (len=12) :: latno3 = " kgha" character (len=12) :: surqsolp = " kgha" - character (len=12) :: usle = " tons" + character (len=12) :: usle = " tons" character (len=12) :: sedmin = " kgha" character (len=12) :: tileno3 = " kgha" character (len=12) :: lchlabp = " kgha" @@ -503,17 +509,17 @@ module output_landscape_module character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" - character (len=9) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=9) :: name = " name " - character(len=17) :: lab_min_p = " lab_min_p" + character (len=9) :: isd = " unit " + character (len=8) :: id = " gis_id " + character (len=9) :: name = " name " + character(len=17) :: lab_min_p = " lab_min_p" character(len=17) :: act_sta_p = " act_sta_p" character(len=17) :: act_nit_n = " act_nit_n" character(len=17) :: act_sta_n = " act_sta_n" character(len=17) :: org_lab_p = " org_lab_p" character(len=17) :: rsd_hs_c = " rsd_hs_c" character(len=17) :: rsd_nitorg_n = " rsd_nitrorg_n" - character(len=17) :: rsd_laborg_p = " rsd_laborg_p" + character(len=17) :: rsd_laborg_p = " rsd_laborg_p" end type output_nutcarb_cycling_header type (output_nutcarb_cycling_header) :: nb_hdr1 @@ -522,17 +528,17 @@ module output_landscape_module character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " - character (len=9) :: isd = " " - character (len=8) :: id = " " - character (len=9) :: name = " " + character (len=9) :: isd = " " + character (len=8) :: id = " " + character (len=9) :: name = " " character(len=17) :: lab_min_p = " kgha" - character(len=17) :: act_sta_p = " kgha" - character(len=17) :: act_nit_n = " kgha" - character(len=17) :: act_sta_n = " kgha" - character(len=17) :: org_lab_p = " kgha" - character(len=17) :: rsd_hs_c = " kgha" - character(len=17) :: rsd_nitorg_n = " kgha" - character(len=17) :: rsd_laborg_p = " kgha" + character(len=17) :: act_sta_p = " kgha" + character(len=17) :: act_nit_n = " kgha" + character(len=17) :: act_sta_n = " kgha" + character(len=17) :: org_lab_p = " kgha" + character(len=17) :: rsd_hs_c = " kgha" + character(len=17) :: rsd_nitorg_n = " kgha" + character(len=17) :: rsd_laborg_p = " kgha" end type output_nutbal_header_units1 type (output_nutbal_header_units1) :: nb_hdr_units1 @@ -542,10 +548,10 @@ module output_landscape_module character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" - character (len=9) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=9) :: name = " name " - character(len=17) :: sed_c = " sed_c" + character (len=9) :: isd = " unit " + character (len=8) :: id = " gis_id " + character (len=9) :: name = " name " + character(len=17) :: sed_c = " sed_c" character(len=17) :: surq_c = " surq_c" character(len=17) :: surq_doc = " surq_doc" character(len=17) :: surq_dic = " surq_dic" @@ -553,8 +559,8 @@ module output_landscape_module character(len=17) :: latq_doc = " latq_doc" character(len=17) :: latq_dic = " latq_dic" character(len=17) :: perc_c = " perc_c" - character(len=17) :: perc_doc = " perc_doc" - character(len=17) :: perc_dic = " perc_dic" + character(len=17) :: perc_doc = " perc_doc" + character(len=17) :: perc_dic = " perc_dic" character(len=17) :: npp_c = " npp_c" character(len=17) :: rsd_c = " rsd_c" character(len=17) :: grain_c = " grain_c" @@ -569,16 +575,16 @@ module output_landscape_module character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " - character (len=9) :: isd = " " - character (len=8) :: id = " " - character (len=9) :: name = " " + character (len=9) :: isd = " " + character (len=8) :: id = " " + character (len=9) :: name = " " character(len=17) :: sed_c = " kg C/ha" - character(len=17) :: surq_c = " kg C/ha" - character(len=17) :: surq_doc = " kg C/ha" - character(len=17) :: surq_dic = " kg C/ha" - character(len=17) :: latq_c = " kg C/ha" - character(len=17) :: latq_doc = " kg C/ha" - character(len=17) :: latq_dic = " kg C/ha" + character(len=17) :: surq_c = " kg C/ha" + character(len=17) :: surq_doc = " kg C/ha" + character(len=17) :: surq_dic = " kg C/ha" + character(len=17) :: latq_c = " kg C/ha" + character(len=17) :: latq_doc = " kg C/ha" + character(len=17) :: latq_dic = " kg C/ha" character(len=17) :: perc_c = " kg C/ha" character(len=17) :: perc_doc = " kg C/ha" character(len=17) :: perc_dic = " kg C/ha" @@ -597,20 +603,20 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " character (len=16) :: name = " name " character(len=15) :: sed_c = " sed_c" - character(len=15) :: surq_c = " surq_c" - character(len=15) :: surq_doc = " surq_doc" + character(len=15) :: surq_c = " surq_c" + character(len=15) :: surq_doc = " surq_doc" character(len=15) :: surq_dic = " surq_dic" - character(len=15) :: latq_c = " latq_c" + character(len=15) :: latq_c = " latq_c" character(len=15) :: latq_doc = " latq_doc" character(len=15) :: latq_dic = " latq_dic" character(len=15) :: perc_c = " perc_c" - character(len=15) :: perc_doc = " perc_doc" - character(len=15) :: perc_dic = " perc_dic" + character(len=15) :: perc_doc = " perc_doc" + character(len=15) :: perc_dic = " perc_dic" character(len=15) :: res_decay = " res_decay" character(len=15) :: man_app_c = " man_app_c" character(len=15) :: man_graze_c = " man_graze_c" @@ -623,17 +629,17 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: sed_c = " kg C/ha" - character(len=15) :: surq_c = " kg C/ha" - character(len=15) :: surq_doc = " kg C/ha" - character(len=15) :: surq_dic = " kg C/ha" - character(len=15) :: latq_c = " kg C/ha" - character(len=15) :: latq_doc = " kg C/ha" - character(len=15) :: latq_dic = " kg C/ha" + character(len=15) :: surq_c = " kg C/ha" + character(len=15) :: surq_doc = " kg C/ha" + character(len=15) :: surq_dic = " kg C/ha" + character(len=15) :: latq_c = " kg C/ha" + character(len=15) :: latq_doc = " kg C/ha" + character(len=15) :: latq_dic = " kg C/ha" character(len=15) :: perc_c = " kg C/ha" character(len=15) :: perc_doc = " kg C/ha" character(len=15) :: perc_dic = " kg C/ha" @@ -653,13 +659,13 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " character (len=16) :: name = " name " character(len=15) :: plant_c = " plant_c" - character(len=15) :: res_decay_c = " res_decay_c" - character(len=15) :: harv_stov_c = " harv_stov_c" + character(len=15) :: res_decay_c = " res_decay_c" + character(len=15) :: harv_stov_c = " harv_stov_c" character(len=15) :: emit_c = " emit_c" end type output_rescarb_header type (output_rescarb_header) :: rescarb_hdr @@ -668,13 +674,13 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: plant_c = " kg C/ha" - character(len=15) :: res_decay_c = " kg C/ha" - character(len=15) :: harv_stov_c = " kg C/ha" + character(len=15) :: res_decay_c = " kg C/ha" + character(len=15) :: harv_stov_c = " kg C/ha" character(len=15) :: emit_c = " kg C/ha" end type output_rescarb_header_units type (output_rescarb_header_units) :: rescarb_hdr_units @@ -687,13 +693,13 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " + character (len=16) :: name = " name " character(len=15) :: npp_c = " npp_c" - character(len=15) :: harv_c = " harv_c" - character(len=15) :: drop_c = " drop_c" + character(len=15) :: harv_c = " harv_c" + character(len=15) :: drop_c = " drop_c" character(len=15) :: grazeat_c = " grazeat_c" character(len=15) :: emit_c = " emit_c" end type output_plcarb_header @@ -703,14 +709,14 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: npp_c = " kg C/ha" - character(len=15) :: harv_c = " kg C/ha" - character(len=15) :: drop_c = " kg C/ha" - character(len=15) :: grazeat_c = " kg C/ha" + character(len=15) :: harv_c = " kg C/ha" + character(len=15) :: drop_c = " kg C/ha" + character(len=15) :: grazeat_c = " kg C/ha" character(len=15) :: emit_c = " kg C/ha" end type output_plcarb_header_units type (output_plcarb_header_units) :: plcarb_hdr_units @@ -723,18 +729,18 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " + character (len=16) :: name = " name " character(len=15) :: meta_micr = " meta_micr" - character(len=15) :: str_micr = " str_micr" - character(len=15) :: str_hs = " str_hs" + character(len=15) :: str_micr = " str_micr" + character(len=15) :: str_hs = " str_hs" character(len=15) :: co2_meta = " co2_meta" character(len=15) :: co2_str = " co2_str" character(len=15) :: micr_hs = " micr_hs" character(len=15) :: micr_hp = " micr_hp" - character(len=15) :: hs_micr = " hs_micr" + character(len=15) :: hs_micr = " hs_micr" character(len=15) :: hs_hp = " hs_hp" character(len=15) :: hp_micr = " hp_micr" character(len=15) :: co2_micr = " co2_micr" @@ -747,13 +753,13 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: meta_micr = " kg C/ha" - character(len=15) :: str_micr = " kg C/ha" - character(len=15) :: str_hs = " kg C/ha" + character(len=15) :: str_micr = " kg C/ha" + character(len=15) :: str_hs = " kg C/ha" character(len=15) :: co2_meta = " kg C/ha" character(len=15) :: co2_str = " kg C/ha" character(len=15) :: micr_hs = " kg C/ha" @@ -763,7 +769,7 @@ module output_landscape_module character(len=15) :: hp_micr = " kg C/ha" character(len=15) :: co2_micr = " kg C/ha" character(len=15) :: co2_hs = " kg C/ha" - character(len=15) :: co2_hp = " kg C/ha" + character(len=15) :: co2_hp = " kg C/ha" end type output_hscf_header_units type (output_hscf_header_units) :: hscf_hdr_units @@ -775,13 +781,13 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " + character (len=16) :: name = " name " character(len=15) :: tot_c = " meta_micr" - character(len=15) :: ab_gr_c = " ab_gr_c" - character(len=15) :: leaf_c = " leaf_c" + character(len=15) :: ab_gr_c = " ab_gr_c" + character(len=15) :: leaf_c = " leaf_c" character(len=15) :: stem_c = " stem_c" character(len=15) :: seed_c = " seed_c" character(len=15) :: root_c = " root_c" @@ -792,13 +798,13 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: tot_c = " kg/ha" - character(len=15) :: ab_gr_c = " kg/ha" - character(len=15) :: leaf_c = " kg/ha" + character(len=15) :: ab_gr_c = " kg/ha" + character(len=15) :: leaf_c = " kg/ha" character(len=15) :: stem_c = " kg/ha" character(len=15) :: seed_c = " kg/ha" character(len=15) :: root_c = " kg/ha" @@ -813,13 +819,13 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " + character (len=16) :: name = " name " character(len=15) :: tot_c = " tot_c" - character(len=15) :: meta_c = " meta_c" - character(len=15) :: str_c = " str_c" + character(len=15) :: meta_c = " meta_c" + character(len=15) :: str_c = " str_c" character(len=15) :: lig_c = " lig_c" end type output_resc_header @@ -829,13 +835,13 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: tot_c = " kg/ha" - character(len=15) :: meta_c = " kg/ha" - character(len=15) :: str_c = " kg/ha" + character(len=15) :: meta_c = " kg/ha" + character(len=15) :: str_c = " kg/ha" character(len=15) :: lig_c = " kg/ha" end type output_resc_header_units type (output_resc_header_units) :: resc_hdr_units @@ -848,17 +854,17 @@ module output_landscape_module character (len=11) :: day = " jday" character (len=11) :: mo = " mon" character (len=11) :: day_mo = " day" - character (len=11) :: yrc = " yr" - character (len=16) :: isd = " unit" - character (len=21) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=11) :: yrc = " yr" + character (len=16) :: isd = " unit" + character (len=21) :: id = " gis_id " + character (len=16) :: name = " name " character(len=15) :: tot_org_c = " tot_org_c" - character(len=15) :: str_c = " str_c" - character(len=15) :: lig_c = " lib_c" + character(len=15) :: str_c = " str_c" + character(len=15) :: lig_c = " lib_c" character(len=15) :: meta_c = " meta_c" character(len=15) :: man_c = " man_c" - character(len=15) :: humus_low_c = " humus_low_c" - character(len=15) :: humus_pass_c = " humus_pass_c" + character(len=15) :: humus_low_c = " humus_low_c" + character(len=15) :: humus_pass_c = " humus_pass_c" character(len=15) :: microb_c = " microb_c" end type output_soilc_header type (output_soilc_header) :: soilc_hdr @@ -867,17 +873,17 @@ module output_landscape_module character (len=11) :: day = " " character (len=11) :: mo = " " character (len=11) :: day_mo = " " - character (len=11) :: yrc = " " - character (len=16) :: isd = " " - character (len=21) :: id = " " - character (len=16) :: name = " " + character (len=11) :: yrc = " " + character (len=16) :: isd = " " + character (len=21) :: id = " " + character (len=16) :: name = " " character(len=15) :: tot_org_c = " kg/ha" - character(len=15) :: str_c = " kg/ha" - character(len=15) :: lig_c = " kg/ha" + character(len=15) :: str_c = " kg/ha" + character(len=15) :: lig_c = " kg/ha" character(len=15) :: meta_c = " kg/ha" character(len=15) :: man_c = " kg/ha" - character(len=15) :: humus_low_c = " kg/ha" - character(len=15) :: humus_pass_c = " kg/ha" + character(len=15) :: humus_low_c = " kg/ha" + character(len=15) :: humus_pass_c = " kg/ha" character(len=15) :: microb_c = " kg/ha" end type output_soilc_header_units type (output_soilc_header_units) :: soilc_hdr_units @@ -888,21 +894,21 @@ module output_landscape_module type output_bsn_carb_header character (len=11) :: day = " jday" - character (len=11) :: yrc = " yr" + character (len=11) :: yrc = " yr" character (len=6) :: blnk = " " character (len=15) :: org_soilc = " org_soilc" - character (len=15) :: org_plc = " org_plc" - character (len=15) :: org_resc = " org_resc" + character (len=15) :: org_plc = " org_plc" + character (len=15) :: org_resc = " org_resc" end type output_bsn_carb_header type (output_bsn_carb_header) :: bsn_carb_hdr type output_bsn_carb_header_units character (len=11) :: day = " " - character (len=11) :: yrc = " " + character (len=11) :: yrc = " " character (len=6) :: blnk = " " character(len=15) :: org_soilc = " kg/ha" - character(len=15) :: org_plc = " kg/ha" - character(len=15) :: org_resc = " kg/ha" + character(len=15) :: org_plc = " kg/ha" + character(len=15) :: org_resc = " kg/ha" end type output_bsn_carb_header_units type (output_bsn_carb_header_units) :: bsn_carb_hdr_units @@ -910,21 +916,21 @@ module output_landscape_module type output_losses_header1 - character (len=6) :: day = " jday" + character (len=5) :: day = " jday" character (len=6) :: mo = " mon" character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" character (len=9) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=9) :: name = " name " + character (len=8) :: id = " gis_id " + character (len=9) :: name = " name " character (len=17) :: sedyld = " sedyld" - character (len=17) :: usle = " usle" - character (len=17) :: sedorgc = " sedorgc" + character (len=17) :: usle = " usle" + character (len=17) :: sedorgc = " sedorgc" character (len=17) :: sedorgn = " sedorgn" character (len=17) :: sedorgp = " sedorgp" character (len=17) :: surqno3 = " surqno3" - character (len=17) :: latno3 = " lat3no3" - character (len=17) :: surqsolp = " surqsolp" + character (len=17) :: latno3 = " lat3no3" + character (len=17) :: surqsolp = " surqsolp" character (len=17) :: sedminp = " sedminp" character (len=17) :: tileno3 = " tileno3" character (len=17) :: no3atmo = " no3atmo" @@ -950,20 +956,20 @@ module output_landscape_module type (output_losses_header1) :: ls_hdr1 type output_losses_header_units1 - character (len=6) :: day = " " + character (len=5) :: day = " " character (len=6) :: mo = " " character (len=6) :: day_mo = " " character (len=6) :: yrc = " " character (len=9) :: isd = " " - character (len=8) :: id = " " - character (len=9) :: name = " " + character (len=8) :: id = " " + character (len=9) :: name = " " character (len=17) :: sedyld = " tons" character (len=17) :: usle = " tha" character (len=17) :: sedorgc = " kgha" character (len=17) :: sedorgn = " kgha" character (len=17) :: sedorgp = " kgha" character (len=17) :: surqno3 = " kgha" - character (len=17) :: latno3 = " kgha" + character (len=17) :: latno3 = " kgha" character (len=17) :: surqsolp = " kgha" character (len=17) :: sedmin = " ----" character (len=17) :: tileno3 = " kgha" @@ -995,8 +1001,8 @@ module output_landscape_module character (len=6) :: day_mo = " day" character (len=6) :: yrc = " yr" character (len=8) :: isd = " unit " - character (len=8) :: id = " gis_id " - character (len=16) :: name = " name " + character (len=8) :: id = " gis_id " + character (len=16) :: name = " name " character (len=13) :: lai = " lai" character (len=12) :: bioms = " bioms" character (len=12) :: yield = " yield" @@ -1021,7 +1027,9 @@ module output_landscape_module character (len=12) :: lai_max = " lai_max" character (len=12) :: bm_max = " bm_max" character (len=12) :: bm_grow = " bm_grow" - character (len=12) :: c_gro = " c_gro" + character (len=12) :: c_gro = " c_gro" + character (len=16) :: plt_cov = " plant_cov " + character (len=30) :: mgt_ops = " mgt_ops " end type output_plantweather_header type (output_plantweather_header) :: pw_hdr @@ -1031,19 +1039,19 @@ module output_landscape_module character (len=6) :: day_mo = " " character (len=6) :: yrc = " " character (len=8) :: isd = " " - character (len=8) :: id = " " - character (len=16) :: name = " " + character (len=8) :: id = " " + character (len=16) :: name = " " character (len=13) :: lai = " m**2/m**2" character (len=12) :: bioms = " kgha" character (len=12) :: yield = " kgha" character (len=12) :: residue = " kgha" character (len=12) :: sol_tmp = " degc" - character (len=12) :: strsw = " ----" - character (len=12) :: strsa = " ----" - character (len=12) :: strstmp = " ----" - character (len=12) :: strsn = " ----" - character (len=12) :: strsp = " ----" - character (len=12) :: strss = " ----" + character (len=12) :: strsw = " ----" + character (len=12) :: strsa = " ----" + character (len=12) :: strstmp = " ----" + character (len=12) :: strsn = " ----" + character (len=12) :: strsp = " ----" + character (len=12) :: strss = " ----" character (len=12) :: nplnt = " kgha" character (len=12) :: percn = " kgha" character (len=12) :: pplnt = " kgha" diff --git a/src/rsd_decomp.f90 b/src/rsd_decomp.f90 new file mode 100644 index 0000000..329aa81 --- /dev/null +++ b/src/rsd_decomp.f90 @@ -0,0 +1,171 @@ + subroutine rsd_decomp + +!! ~ ~ ~ PURPOSE ~ ~ ~ +!! this subroutine estimates daily nitrogen and phosphorus +!! mineralization and immobilization considering fresh organic +!! material (plant residue) and active and stable humus material + +!! ~ ~ ~ INCOMING VARIABLES ~ ~ ~ +!! name |units |definition +!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ +!! ihru |none |HRU number +!! rsdco_pl(:) |none |plant residue decomposition coefficient. The +!! |fraction of residue which will decompose in +!! |a day assuming optimal moisture, +!! |temperature, C:N ratio, and C:P ratio +!!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + +!! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~ +!! name |units |definition +!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + +!! ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~ +!! name |units |definition +!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ +!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ + +!! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ +!! Intrinsic: Max, Exp, Sqrt, Min, Abs + +!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ + + use plant_data_module + use basin_module + use organic_mineral_mass_module + use hru_module, only : rsdco_plcom, i_sep, ihru, ipl, isep + use soil_module + use plant_module + use output_landscape_module, only : hnb_d + use carbon_module, only : hrc_d + + implicit none + + integer :: j = 0 !none |HRU number + integer :: k = 0 !none |counter (soil layer) + integer :: kk = 0 !none |soil layer used to compute soil water and + ! |soil temperature factors + integer :: idp = 0 + real :: rmn1 = 0. !kg N/ha |amount of nitrogen moving from fresh organic + ! |to nitrate(80%) and active organic(20%) + ! |pools in layer + real :: rmp = 0. ! |to labile(80%) and organic(20%) pools in layer + real :: xx = 0. !varies |variable to hold intermediate calculation result + real :: csf = 0. !none |combined temperature/soil water factor + real :: cnr = 0. ! |carbon nitrogen ratio + real :: cnrf = 0. ! |carbon nitrogen ratio factor + real :: cpr = 0. ! |carbon phosphorus ratio + real :: cprf = 0. ! |carbon phosphorus ratio factor + real :: ca = 0. ! | + real :: decr = 0. ! | + real :: rdc = 0. ! | + real :: cdg = 0. !none |soil temperature factor + real :: sut = 0. !none |soil water factor + + j = ihru + + !zero transformations for summing layers + hnb_d(j)%rsd_nitorg_n = 0. + hnb_d(j)%rsd_laborg_p = 0. + + !! mineralization can occur only if temp above 0 deg + if (soil(j)%phys(1)%tmp > 0.) then + rsd1(j)%tot_com = orgz + if (bsn_cc%cswat == 2) then + rsd1(j)%tot_meta = orgz + rsd1(j)%tot_str = orgz + rsd1(j)%tot_lignin = orgz + end if + + !! compute residue decomp and mineralization of fresh organic n and p of flat residue + do ipl = 1, pcom(j)%npl !! we need to decompose each plant + rmn1 = 0. + rmp = 0. + if (rsd1(j)%tot(ipl)%n > 1.e-4) then + cnr = rsd1(j)%tot(ipl)%c / rsd1(j)%tot(ipl)%n + if (cnr > 500.) cnr = 500. + cnrf = Exp(-.693 * (cnr - 25.) / 25.) + else + cnrf = 1. + end if + + if (rsd1(j)%tot(ipl)%p > 1.e-4) then + cpr = rsd1(j)%tot(ipl)%c / rsd1(j)%tot(ipl)%p + if (cpr > 5000.) cpr = 5000. + cprf = Exp(-.693 * (cpr - 200.) / 200.) + else + cprf = 1. + end if + + !! compute soil water factor + if (soil(j)%phys(1)%st < 0.) soil(j)%phys(1)%st = .0000001 + sut = .1 + .9 * Sqrt(soil(j)%phys(1)%st / soil(j)%phys(1)%fc) + sut = Max(.05, sut) + + !!compute soil temperature factor + xx = soil(j)%phys(1)%tmp + cdg = .9 * xx / (xx + Exp(9.93 - .312 * xx)) + .1 + cdg = Max(.1, cdg) + + !! compute combined factor + xx = cdg * sut + if (xx < 0.) xx = 0. + if (xx > 1.e6) xx = 1.e6 + csf = Sqrt(xx) + ca = Min(cnrf, cprf, 1.) + !! compute residue decomp and mineralization for each plant + if (pcom(j)%npl > 0) then + idp = pcom(j)%plcur(ipl)%idplt + decr = pldb(idp)%rsdco_pl * ca * csf + else + decr = 0.05 * ca * csf + end if + decr = Max(bsn_prm%decr_min, decr) + decr = Min(decr, 1.) + + !! mineralization of mass and carbon + rsd1(j)%tot(ipl)%m = Max(1.e-6, rsd1(j)%tot(ipl)%m) + rdc = decr * rsd1(j)%tot(ipl)%m + rsd1(j)%tot(ipl)%m = rsd1(j)%tot(ipl)%m - rdc + if (rsd1(j)%tot(ipl)%m < 0.) rsd1(j)%tot(ipl)%m = 0. + + !! apply decay to total carbon pool + rsd1(j)%tot(ipl)%c = (1. - decr) * rsd1(j)%tot(ipl)%c + if (rsd1(j)%tot(ipl)%c < 0.) rsd1(j)%tot(ipl)%c = 0. + soil1(j)%hact(1)%c = soil1(j)%hact(1)%c + decr * rsd1(j)%tot(ipl)%c + + !! apply decay to all carbon pools + if (bsn_cc%cswat == 2) then + rsd1(j)%meta(ipl) = (1. - decr) * rsd1(j)%meta(ipl) + rsd1(j)%str(ipl) = (1. - decr) * rsd1(j)%str(ipl) + rsd1(j)%lignin(ipl) = (1. - decr) * rsd1(j)%lignin(ipl) + end if + + !! mineralization of residue n and p + rmn1 = decr * rsd1(j)%tot(ipl)%n + rsd1(j)%tot(ipl)%n = Max(1.e-6, rsd1(j)%tot(ipl)%n) + rsd1(j)%tot(ipl)%n = rsd1(j)%tot(ipl)%n - rmn1 + soil1(j)%mn(1)%no3 = soil1(j)%mn(1)%no3 + .8 * rmn1 + soil1(j)%hact(1)%n = soil1(j)%hact(1)%n + .2 * rmn1 + + rsd1(j)%tot(ipl)%p = Max(1.e-6, rsd1(j)%tot(ipl)%p) + rmp = decr * rsd1(j)%tot(ipl)%p + rsd1(j)%tot(ipl)%p = rsd1(j)%tot(ipl)%p - rmp + soil1(j)%mp(1)%lab = soil1(j)%mp(1)%lab + .8 * rmp + soil1(j)%hact(1)%p = soil1(j)%hact(1)%p + .2 * rmp + + hnb_d(j)%rsd_nitorg_n = hnb_d(j)%rsd_nitorg_n + .8 * rmn1 + hnb_d(j)%rsd_laborg_p = hnb_d(j)%rsd_laborg_p + .8 * rmp + + !! sum total residue pools + rsd1(j)%tot_com = rsd1(j)%tot_com + rsd1(j)%tot(ipl) + if (bsn_cc%cswat == 2) then + rsd1(j)%tot_meta = rsd1(j)%tot_meta + rsd1(j)%meta(ipl) + rsd1(j)%tot_str = rsd1(j)%tot_str + rsd1(j)%str(ipl) + rsd1(j)%tot_lignin = rsd1(j)%tot_lignin + rsd1(j)%lignin(ipl) + end if + + end do ! ipl = 1, pcom(j)%npl + end if ! soil temperature > 0. + + return + end subroutine rsd_decomp \ No newline at end of file diff --git a/src/sd_channel_sediment3.f90 b/src/sd_channel_sediment3.f90 index 55b9423..e94d4ad 100644 --- a/src/sd_channel_sediment3.f90 +++ b/src/sd_channel_sediment3.f90 @@ -52,7 +52,7 @@ subroutine sd_channel_sediment3 real :: precip = 0. real :: flovol_ob = 0. real :: wet_fill = 0. - + ich = isdch iob = sp_ob1%chandeg + jrch - 1 @@ -91,6 +91,7 @@ subroutine sd_channel_sediment3 ht1%flo = ht1%flo + precip !! compute flood plain deposition + !sd_ch(ich)%bankfull_flo = 2. bf_flow = sd_ch(ich)%bankfull_flo * ch_rcurv(ich)%elev(2)%flo_rate florate_ob = peakrate - bf_flow if (florate_ob > 0.) then @@ -150,9 +151,7 @@ subroutine sd_channel_sediment3 !! add sediment deposition to calculate mm of deposition over the flood plain later ch_morph(ich)%fp_mm = ch_morph(ich)%fp_mm + fp_dep%sed - - !! calc bank erosion cohesion = (-87.1 + (42.82 * sd_ch(ich)%ch_clay) - (0.261 * sd_ch(ich)%ch_clay ** 2.) & + (0.029 * sd_ch(ich)%ch_clay ** 3.)) @@ -161,6 +160,7 @@ subroutine sd_channel_sediment3 bd_fac = Max (0.001, 0.03924 * sd_ch(ich)%ch_bd * 1000. - 1000.) cohes_fac = 0.021 * cohesion + veg vel_cr = log10 (2200. * sd_ch(ich)%chd) * (0.0004 * (bd_fac + cohes_fac)) ** 0.5 + !sd_ch(ich)%vcr_coef = 1. vel_cr = sd_ch(ich)%vcr_coef * vel_cr !! calculate radius of curvature @@ -170,6 +170,7 @@ subroutine sd_channel_sediment3 vel_rch = 0.33 * vel_bend + 0.66 * vel b_exp = 12.3 / sqrt (sd_ch(ich)%ch_clay + 1.) b_exp = min (3.5, b_exp) + !sd_ch(ich)%bank_exp = 2. if (vel_rch > vel_cr) then !! bank erosion m/yr ebank_m = 0.0024 * (vel_rch / vel_cr) ** sd_ch(ich)%bank_exp @@ -180,7 +181,7 @@ subroutine sd_channel_sediment3 !! calc mass of sediment eroded -> t = bankcut (m) * depth (m) * lengthcut (m) * bd (t/m3) !! arc length = 0.33 * meander wavelength * sinuosity - arc_len = 0.33 * (12. * sd_ch(ich)%chw) * sd_ch(ich)%sinu + arc_len = 0.66 * (12. * sd_ch(ich)%chw) * sd_ch(ich)%sinu prot_len = arc_len * sd_ch(ich)%arc_len_fr ebank_t = ebank_m * sd_ch(ich)%chd * sd_ch(ich)%arc_len_fr * prot_len * sd_ch(ich)%ch_bd bank_ero%sed = ebank_t diff --git a/src/swift_output.f90 b/src/swift_output.f90 index 38ee8e2..8740586 100644 --- a/src/swift_output.f90 +++ b/src/swift_output.f90 @@ -32,7 +32,7 @@ subroutine swift_output logical :: i_exist ! SWIFT file formats - 201 format (A8,12xA8,46X,*(A16,F2.0,A4,1xA16,F2.0,A4)) ! format of precip.swf headers + 201 format (A8,12xA8,46X,*(A16,F5.1,A4,1xA16,F5.1,A4)) ! format of precip.swf headers 301 format (I8,1xA64,F16.4,8xF16.4) ! format of precip.swf 202 format (A8,30xA8,18X,A8,36xA8,4xA8,218x1A8,6x1A8) ! format of hru_dat.swf headers 302 format (1I8,1x2A48, G16.4 ,1x*(G16.4)) ! format of hru_dat.swf From 0863b549067680d7fbd8f515aa720d6e5fb98f91 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 09:10:19 -0600 Subject: [PATCH 09/17] branch build possible now, added compiler tag to exe --- .github/workflows/build.yml | 10 ++++++++-- CMakeLists.txt | 25 ++++++++++++------------- 2 files changed, 20 insertions(+), 15 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 002b5bd..c824844 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -9,6 +9,11 @@ on: - '*.*.*' workflow_dispatch: + inputs: + branch: + description: 'tag, branch, or SHA to check out` + required: true + default: 'main' permissions: contents: write @@ -18,7 +23,7 @@ permissions: jobs: build: runs-on: ${{ matrix.os }} - if: endsWith(github.event.base_ref, 'main') == true + # if: endsWith(github.event.base_ref, 'main') == true strategy: fail-fast: false @@ -38,7 +43,8 @@ jobs: steps: - name: Checkout uses: actions/checkout@v4 - # with: + with: + ref: '${{ github.event.inputs.branch }}' # fetch-tags: true # fetch-depth: 0 diff --git a/CMakeLists.txt b/CMakeLists.txt index d3468e8..61e4692 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,19 +33,19 @@ if (UNIX) set(fdialect "-free -fpe0 -traceback -diag-disable=10448") set(fdebug "-warn all") set(frelease "-O") - set(FFC "ifo") + set(FFC "ifo") link_libraries("-static") elseif(CMAKE_Fortran_COMPILER_ID STREQUAL IntelLLVM) set(fdialect "-free -fpe0 -traceback") set(fdebug "-warn all -O0") set(frelease "-O") - set(FFC "ifx") + set(FFC "ifx") link_libraries("-static") elseif(CMAKE_Fortran_COMPILER_ID MATCHES GNU) - set(fdialect "-fcheck=all -ffpe-trap=invalid,zero,overflow,underflow -fimplicit-none -ffree-line-length-none -fbacktrace -finit-local-zero -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") - set(fdebug "-Wall") - set(frelease "-O") - set(FFC "gcc") + set(fdialect "-fcheck=all -ffpe-trap=invalid,zero,overflow,underflow -fimplicit-none -ffree-line-length-none -fbacktrace -finit-local-zero -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") + set(fdebug "-Wall") + set(frelease "-O") + set(FFC "gnu") if(NOT APPLE) link_libraries("-static") endif() @@ -66,18 +66,18 @@ elseif(WIN32) elseif(CMAKE_Fortran_COMPILER_ID MATCHES GNU) set(fdialect "-fcheck=all -ffpe-trap=invalid,zero,overflow,underflow -fimplicit-none -ffree-line-length-none -fbacktrace -finit-local-zero -fno-unsafe-math-optimizations -frounding-math -fsignaling-nans") set(fdebug "-Wall ") - set(FFC "gcc") + set(FFC "gnu") set(frelease "-O") endif() endif() string(TOLOWER ${CMAKE_HOST_SYSTEM_PROCESSOR} ARCH) if(CMAKE_SYSTEM_NAME STREQUAL "Linux") - set(AR "${FFC}-lin_${ARCH}") + set(AR "lin_${ARCH}") elseif(CMAKE_SYSTEM_NAME STREQUAL "Windows") - set(AR "${FFC}-win_${ARCH}") + set(AR "win_${ARCH}") elseif(CMAKE_SYSTEM_NAME STREQUAL "Darwin") - set(AR "${FFC}-mac_${ARCH}") + set(AR "mac_${ARCH}") else() set(AR "unknown") endif() @@ -92,9 +92,9 @@ endif() # SWAT Version number set(SWAT_VERSION ${TAG}) -set(SWATPLUS_EXE "swatplus-${SWAT_VERSION}-${AR}${TY}") +set(SWATPLUS_EXE "swatplus-${SWAT_VERSION}-${FFC}-${AR}${TY}") -# Enable this to 'TRUE' to see the fortran command on compile +# Set this to 'TRUE' to see the fortran command on compile set(CMAKE_VERBOSE_MAKEFILE FALSE) set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} ${fdialect}") @@ -111,7 +111,6 @@ set(CMAKE_Fortran_FLAGS_RELEASE "${frelease}") if(EXISTS "${PROJECT_SOURCE_DIR}/src/main.f90.in") string(TIMESTAMP ISO "%Y-%m-%d %H:%M:%S") - # string(TIMESTAMP TODAY "%b %d %Y") # e.g. produces Dec 7 2023 string(TIMESTAMP TODAY "%Y-%m-%d") # e.g. produces 2023-12-07 string(TIMESTAMP YEAR "%Y") From 0be40b09e8d0fdcbd61c785e6556f917edd1d044 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 09:17:18 -0600 Subject: [PATCH 10/17] fix typo --- .github/workflows/build.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index c824844..dc57e74 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -10,10 +10,10 @@ on: workflow_dispatch: inputs: - branch: - description: 'tag, branch, or SHA to check out` - required: true - default: 'main' + rev: + description: 'tag, branch, or SHA to check out' + required: true + default: 'main' permissions: contents: write @@ -44,7 +44,7 @@ jobs: - name: Checkout uses: actions/checkout@v4 with: - ref: '${{ github.event.inputs.branch }}' + ref: '${{ github.event.inputs.rev }}' # fetch-tags: true # fetch-depth: 0 From d84d35d66754aeaecd5d050b29504391d723d148 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 09:26:38 -0600 Subject: [PATCH 11/17] upgrade to v4 up/download actions API --- .github/workflows/build.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index dc57e74..17396a6 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -120,7 +120,7 @@ jobs: dest: ${{ steps.build_exe.outputs.exez }} - name: upload - uses: actions/upload-artifact@v2 + uses: actions/upload-artifact@v4 with: name: sp-${{ steps.build_exe.outputs.os }} path: ${{ steps.build_exe.outputs.exez }} @@ -134,17 +134,17 @@ jobs: steps: - name: Download Linux - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: name: sp-Linux - name: Download Windows - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: name: sp-Windows - name: Download macOS - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v4 with: name: sp-macOS From f656b9e48d2234f31a18389a3326e2fc78be2b72 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 12:16:15 -0600 Subject: [PATCH 12/17] test versioning --- .github/workflows/build.yml | 296 ++++++++++++++++++++---------------- 1 file changed, 162 insertions(+), 134 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 17396a6..d05631d 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -21,147 +21,175 @@ permissions: pull-requests: write jobs: - build: - runs-on: ${{ matrix.os }} - # if: endsWith(github.event.base_ref, 'main') == true - - strategy: - fail-fast: false - matrix: - os: [ubuntu-latest, windows-latest, macos-latest] - toolchain: - - {compiler: intel, version: '2024.1'} - - {compiler: intel-classic, version: '2021.9'} - exclude: - - os: macos-latest - toolchain: {compiler: intel, version: '2024.1'} - - os: windows-latest - toolchain: {compiler: intel-classic, version: '2021.9'} - - os: ubuntu-latest - toolchain: {compiler: intel-classic, version: '2021.9'} + version: + name: Version + runs-on: ubuntu-latest steps: - - name: Checkout + - name: Checkout uses: actions/checkout@v4 with: ref: '${{ github.event.inputs.rev }}' # fetch-tags: true # fetch-depth: 0 - - - name: Install Compiler - uses: fortran-lang/setup-fortran@v1 - id: setup-fortran - with: - compiler: ${{ matrix.toolchain.compiler }} - version: ${{ matrix.toolchain.version }} - - - name: Build SWAT+ - id: build_exe + - name: Get SWAT+ version + id: get_version run: | - echo ${{ env.FC }} - cmake --version - - RELEASE_VERSION=${GITHUB_REF#refs/*/} - os="$RUNNER_OS" - - if [ "$RUNNER_OS" == "Linux" ]; then - cmake -B build \ - -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ - -D TAG=$RELEASE_VERSION \ - -D CMAKE_BUILD_TYPE=Release - e="build/swatplus-*" - elif [ "$RUNNER_OS" == "Windows" ]; then - cmake -B build -G "MinGW Makefiles" \ - -D CMAKE_Fortran_COMPILER="C:\Program Files (x86)\Intel\oneAPI\compiler\2024.1\bin\${{ env.FC }}.exe" \ - -D TAG=$RELEASE_VERSION \ - -D CMAKE_BUILD_TYPE=Release - e="build/swatplus-*.exe" - elif [ "$RUNNER_OS" == "macOS" ]; then - cmake -B build \ - -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ - -D TAG=$RELEASE_VERSION \ - -D CMAKE_APPLE_SILICON_PROCESSOR="x86_64" \ - -D CMAKE_BUILD_TYPE=Release - e="build/swatplus-*" - else - echo "$RUNNER_OS not supported." - exit 1 - fi - - # compile - cmake --build build - - exebase=`basename -s .exe build/swatplus-*` - exez="${exebase}.zip" - exe=`ls $e` - - echo $exe - echo $exez - echo $os - - echo "exe=$exe" >> $GITHUB_OUTPUT - echo "exez=$exez" >> $GITHUB_OUTPUT - echo "os=$os" >> $GITHUB_OUTPUT - - ls -hl build/swatplus-* - file build/swatplus-* - - if [ "$RUNNER_OS" != "Windows" ]; then - (cd build && zip ../$exez swatplus-*) - fi - - shell: bash - - - name: zip - if: matrix.os == 'windows-latest' - uses: vimtor/action-zip@v1.2 - with: - files: ${{ steps.build_exe.outputs.exe }} - dest: ${{ steps.build_exe.outputs.exez }} - - - name: upload - uses: actions/upload-artifact@v4 - with: - name: sp-${{ steps.build_exe.outputs.os }} - path: ${{ steps.build_exe.outputs.exez }} - - - release: - name: Release - runs-on: ubuntu-latest - needs: - - build - - steps: - - name: Download Linux - uses: actions/download-artifact@v4 - with: - name: sp-Linux - - - name: Download Windows - uses: actions/download-artifact@v4 - with: - name: sp-Windows - - - name: Download macOS - uses: actions/download-artifact@v4 - with: - name: sp-macOS - - - name: Release - uses: softprops/action-gh-release@v2 - with: - token: ${{ github.token }} - tag_name: ${{ github.event.release.tag_name }} - prerelease: false - draft: false - name: ${{ github.event.release.tag_name }} - files: swatplus-* - generate_release_notes: true - body: | -
- Autogenerated Changelog - ... changelog ... -
+ V=`git describe --tags` + echo $V + echo $V >v.txt + cat v.txt + echo ${{ github.event.release.tag_name }} + echo ${GITHUB_REF#refs/*/} + + # - name: upload + # uses: actions/upload-artifact@v4 + # with: + # name: v.txt + # path: v.txt + # + # + # build: + # runs-on: ${{ matrix.os }} + # # if: endsWith(github.event.base_ref, 'main') == true + # + # strategy: + # fail-fast: false + # matrix: + # os: [ubuntu-latest, windows-latest, macos-latest] + # toolchain: + # - {compiler: intel, version: '2024.1'} + # - {compiler: intel-classic, version: '2021.9'} + # exclude: + # - os: macos-latest + # toolchain: {compiler: intel, version: '2024.1'} + # - os: windows-latest + # toolchain: {compiler: intel-classic, version: '2021.9'} + # - os: ubuntu-latest + # toolchain: {compiler: intel-classic, version: '2021.9'} + # + # steps: + # - name: Checkout + # uses: actions/checkout@v4 + # with: + # ref: '${{ github.event.inputs.rev }}' + # # fetch-tags: true + # # fetch-depth: 0 + # + # - name: Install Compiler + # uses: fortran-lang/setup-fortran@v1 + # id: setup-fortran + # with: + # compiler: ${{ matrix.toolchain.compiler }} + # version: ${{ matrix.toolchain.version }} + # + # - name: Build SWAT+ + # id: build_exe + # run: | + # echo ${{ env.FC }} + # cmake --version + # + # RELEASE_VERSION=${GITHUB_REF#refs/*/} + # os="$RUNNER_OS" + # + # if [ "$RUNNER_OS" == "Linux" ]; then + # cmake -B build \ + # -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ + # -D TAG=$RELEASE_VERSION \ + # -D CMAKE_BUILD_TYPE=Release + # e="build/swatplus-*" + # elif [ "$RUNNER_OS" == "Windows" ]; then + # cmake -B build -G "MinGW Makefiles" \ + # -D CMAKE_Fortran_COMPILER="C:\Program Files (x86)\Intel\oneAPI\compiler\2024.1\bin\${{ env.FC }}.exe" \ + # -D TAG=$RELEASE_VERSION \ + # -D CMAKE_BUILD_TYPE=Release + # e="build/swatplus-*.exe" + # elif [ "$RUNNER_OS" == "macOS" ]; then + # cmake -B build \ + # -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ + # -D TAG=$RELEASE_VERSION \ + # -D CMAKE_APPLE_SILICON_PROCESSOR="x86_64" \ + # -D CMAKE_BUILD_TYPE=Release + # e="build/swatplus-*" + # else + # echo "$RUNNER_OS not supported." + # exit 1 + # fi + # + # # compile + # cmake --build build -j 4 + # + # exebase=`basename -s .exe build/swatplus-*` + # exez="${exebase}.zip" + # exe=`ls $e` + # + # echo $exe + # echo $exez + # echo $os + # + # echo "exe=$exe" >> $GITHUB_OUTPUT + # echo "exez=$exez" >> $GITHUB_OUTPUT + # echo "os=$os" >> $GITHUB_OUTPUT + # + # ls -hl build/swatplus-* + # file build/swatplus-* + # + # if [ "$RUNNER_OS" != "Windows" ]; then + # (cd build && zip ../$exez swatplus-*) + # fi + # + # shell: bash + # + # - name: zip + # if: matrix.os == 'windows-latest' + # uses: vimtor/action-zip@v1.2 + # with: + # files: ${{ steps.build_exe.outputs.exe }} + # dest: ${{ steps.build_exe.outputs.exez }} + # + # - name: upload + # uses: actions/upload-artifact@v4 + # with: + # name: sp-${{ steps.build_exe.outputs.os }} + # path: ${{ steps.build_exe.outputs.exez }} + # + # + # release: + # name: Release + # runs-on: ubuntu-latest + # needs: + # - build + # + # steps: + # - name: Download Linux + # uses: actions/download-artifact@v4 + # with: + # name: sp-Linux + # + # - name: Download Windows + # uses: actions/download-artifact@v4 + # with: + # name: sp-Windows + # + # - name: Download macOS + # uses: actions/download-artifact@v4 + # with: + # name: sp-macOS + # + # - name: Release + # uses: softprops/action-gh-release@v2 + # with: + # token: ${{ github.token }} + # tag_name: ${{ github.event.release.tag_name }} + # prerelease: false + # draft: false + # name: ${{ github.event.release.tag_name }} + # files: swatplus-* + # generate_release_notes: true + # body: | + #
+ # Autogenerated Changelog + # ... changelog ... + #
From c1bcf7948f0d268058067e55e80e4fa2d0529c17 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 12:19:21 -0600 Subject: [PATCH 13/17] fix yaml --- .github/workflows/build.yml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index d05631d..eaa104b 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -27,14 +27,14 @@ jobs: runs-on: ubuntu-latest steps: - name: Checkout - uses: actions/checkout@v4 - with: - ref: '${{ github.event.inputs.rev }}' + uses: actions/checkout@v4 + with: + ref: '${{ github.event.inputs.rev }}' # fetch-tags: true # fetch-depth: 0 - name: Get SWAT+ version - id: get_version - run: | + id: get_version + run: | V=`git describe --tags` echo $V echo $V >v.txt From 9cb055f85ebcd608deba6ec2c99bbeb75a2a9bac Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 12:32:36 -0600 Subject: [PATCH 14/17] added tags --- .github/workflows/build.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index eaa104b..33a9a43 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -30,8 +30,8 @@ jobs: uses: actions/checkout@v4 with: ref: '${{ github.event.inputs.rev }}' - # fetch-tags: true - # fetch-depth: 0 + fetch-tags: true + fetch-depth: 0 - name: Get SWAT+ version id: get_version run: | From 4b37af922da068cc950ebd047a78ecf81a905f61 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 19:30:05 -0600 Subject: [PATCH 15/17] first ver integration --- .github/workflows/build.yml | 317 +++++++++++++++++++----------------- 1 file changed, 168 insertions(+), 149 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 33a9a43..89be2d7 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -41,155 +41,174 @@ jobs: cat v.txt echo ${{ github.event.release.tag_name }} echo ${GITHUB_REF#refs/*/} + - name: upload + uses: actions/upload-artifact@v4 + with: + name: release_tag + path: v.txt + + + build: + runs-on: ${{ matrix.os }} + needs: + - version + # if: endsWith(github.event.base_ref, 'main') == true + + strategy: + fail-fast: false + matrix: + os: [ubuntu-latest, windows-latest, macos-latest] + toolchain: + - {compiler: intel, version: '2024.1'} + - {compiler: intel-classic, version: '2021.9'} + exclude: + - os: macos-latest + toolchain: {compiler: intel, version: '2024.1'} + - os: windows-latest + toolchain: {compiler: intel-classic, version: '2021.9'} + - os: ubuntu-latest + toolchain: {compiler: intel-classic, version: '2021.9'} + + steps: + - name: Checkout + uses: actions/checkout@v4 + with: + ref: '${{ github.event.inputs.rev }}' + # fetch-tags: true + # fetch-depth: 0 + + - name: Install Compiler + uses: fortran-lang/setup-fortran@v1 + id: setup-fortran + with: + compiler: ${{ matrix.toolchain.compiler }} + version: ${{ matrix.toolchain.version }} + + - name: Download version + uses: actions/download-artifact@v4 + with: + name: release_tag + + - name: Build SWAT+ + id: build_exe + run: | + echo ${{ env.FC }} + cmake --version + + # RELEASE_VERSION=${GITHUB_REF#refs/*/} + RELEASE_VERSION=`cat v.txt` + os="$RUNNER_OS" + + if [ "$RUNNER_OS" == "Linux" ]; then + cmake -B build \ + -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ + -D TAG=$RELEASE_VERSION \ + -D CMAKE_BUILD_TYPE=Release + e="build/swatplus-*" + elif [ "$RUNNER_OS" == "Windows" ]; then + cmake -B build -G "MinGW Makefiles" \ + -D CMAKE_Fortran_COMPILER="C:\Program Files (x86)\Intel\oneAPI\compiler\2024.1\bin\${{ env.FC }}.exe" \ + -D TAG=$RELEASE_VERSION \ + -D CMAKE_BUILD_TYPE=Release + e="build/swatplus-*.exe" + elif [ "$RUNNER_OS" == "macOS" ]; then + cmake -B build \ + -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ + -D TAG=$RELEASE_VERSION \ + -D CMAKE_APPLE_SILICON_PROCESSOR="x86_64" \ + -D CMAKE_BUILD_TYPE=Release + e="build/swatplus-*" + else + echo "$RUNNER_OS not supported." + exit 1 + fi + + # compile + cmake --build build -j 4 + + exebase=`basename -s .exe build/swatplus-*` + exez="${exebase}.zip" + exe=`ls $e` + + echo $exe + echo $exez + echo $os + + echo "exe=$exe" >> $GITHUB_OUTPUT + echo "exez=$exez" >> $GITHUB_OUTPUT + echo "os=$os" >> $GITHUB_OUTPUT + + ls -hl build/swatplus-* + file build/swatplus-* + + if [ "$RUNNER_OS" != "Windows" ]; then + (cd build && zip ../$exez swatplus-*) + fi + + shell: bash + + - name: zip + if: matrix.os == 'windows-latest' + uses: vimtor/action-zip@v1.2 + with: + files: ${{ steps.build_exe.outputs.exe }} + dest: ${{ steps.build_exe.outputs.exez }} + + - name: upload + uses: actions/upload-artifact@v4 + with: + name: sp-${{ steps.build_exe.outputs.os }} + path: ${{ steps.build_exe.outputs.exez }} + + + release: + name: Release + runs-on: ubuntu-latest + needs: + - build + + steps: + - name: Download Linux + uses: actions/download-artifact@v4 + with: + name: sp-Linux + + - name: Download Windows + uses: actions/download-artifact@v4 + with: + name: sp-Windows + + - name: Download macOS + uses: actions/download-artifact@v4 + with: + name: sp-macOS + + - name: Download version + uses: actions/download-artifact@v4 + with: + name: release_tag + + - name: Read version + id: read_ver + run: | + RELEASE_VERSION=`cat v.txt` + echo "rv=$RELEASE_VERSION" >> $GITHUB_OUTPUT - # - name: upload - # uses: actions/upload-artifact@v4 - # with: - # name: v.txt - # path: v.txt - # - # - # build: - # runs-on: ${{ matrix.os }} - # # if: endsWith(github.event.base_ref, 'main') == true - # - # strategy: - # fail-fast: false - # matrix: - # os: [ubuntu-latest, windows-latest, macos-latest] - # toolchain: - # - {compiler: intel, version: '2024.1'} - # - {compiler: intel-classic, version: '2021.9'} - # exclude: - # - os: macos-latest - # toolchain: {compiler: intel, version: '2024.1'} - # - os: windows-latest - # toolchain: {compiler: intel-classic, version: '2021.9'} - # - os: ubuntu-latest - # toolchain: {compiler: intel-classic, version: '2021.9'} - # - # steps: - # - name: Checkout - # uses: actions/checkout@v4 - # with: - # ref: '${{ github.event.inputs.rev }}' - # # fetch-tags: true - # # fetch-depth: 0 - # - # - name: Install Compiler - # uses: fortran-lang/setup-fortran@v1 - # id: setup-fortran - # with: - # compiler: ${{ matrix.toolchain.compiler }} - # version: ${{ matrix.toolchain.version }} - # - # - name: Build SWAT+ - # id: build_exe - # run: | - # echo ${{ env.FC }} - # cmake --version - # - # RELEASE_VERSION=${GITHUB_REF#refs/*/} - # os="$RUNNER_OS" - # - # if [ "$RUNNER_OS" == "Linux" ]; then - # cmake -B build \ - # -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ - # -D TAG=$RELEASE_VERSION \ - # -D CMAKE_BUILD_TYPE=Release - # e="build/swatplus-*" - # elif [ "$RUNNER_OS" == "Windows" ]; then - # cmake -B build -G "MinGW Makefiles" \ - # -D CMAKE_Fortran_COMPILER="C:\Program Files (x86)\Intel\oneAPI\compiler\2024.1\bin\${{ env.FC }}.exe" \ - # -D TAG=$RELEASE_VERSION \ - # -D CMAKE_BUILD_TYPE=Release - # e="build/swatplus-*.exe" - # elif [ "$RUNNER_OS" == "macOS" ]; then - # cmake -B build \ - # -D CMAKE_Fortran_COMPILER=${{ env.FC }} \ - # -D TAG=$RELEASE_VERSION \ - # -D CMAKE_APPLE_SILICON_PROCESSOR="x86_64" \ - # -D CMAKE_BUILD_TYPE=Release - # e="build/swatplus-*" - # else - # echo "$RUNNER_OS not supported." - # exit 1 - # fi - # - # # compile - # cmake --build build -j 4 - # - # exebase=`basename -s .exe build/swatplus-*` - # exez="${exebase}.zip" - # exe=`ls $e` - # - # echo $exe - # echo $exez - # echo $os - # - # echo "exe=$exe" >> $GITHUB_OUTPUT - # echo "exez=$exez" >> $GITHUB_OUTPUT - # echo "os=$os" >> $GITHUB_OUTPUT - # - # ls -hl build/swatplus-* - # file build/swatplus-* - # - # if [ "$RUNNER_OS" != "Windows" ]; then - # (cd build && zip ../$exez swatplus-*) - # fi - # - # shell: bash - # - # - name: zip - # if: matrix.os == 'windows-latest' - # uses: vimtor/action-zip@v1.2 - # with: - # files: ${{ steps.build_exe.outputs.exe }} - # dest: ${{ steps.build_exe.outputs.exez }} - # - # - name: upload - # uses: actions/upload-artifact@v4 - # with: - # name: sp-${{ steps.build_exe.outputs.os }} - # path: ${{ steps.build_exe.outputs.exez }} - # - # - # release: - # name: Release - # runs-on: ubuntu-latest - # needs: - # - build - # - # steps: - # - name: Download Linux - # uses: actions/download-artifact@v4 - # with: - # name: sp-Linux - # - # - name: Download Windows - # uses: actions/download-artifact@v4 - # with: - # name: sp-Windows - # - # - name: Download macOS - # uses: actions/download-artifact@v4 - # with: - # name: sp-macOS - # - # - name: Release - # uses: softprops/action-gh-release@v2 - # with: - # token: ${{ github.token }} - # tag_name: ${{ github.event.release.tag_name }} - # prerelease: false - # draft: false - # name: ${{ github.event.release.tag_name }} - # files: swatplus-* - # generate_release_notes: true - # body: | - #
- # Autogenerated Changelog - # ... changelog ... - #
+ - name: Release + uses: softprops/action-gh-release@v2 + with: + token: ${{ github.token }} + # tag_name: ${{ github.event.release.tag_name }} + prerelease: false + draft: false + # name: ${{ github.event.release.tag_name }} + name: ${{ steps.read_ver.outputs.rv }} + files: swatplus-* + generate_release_notes: true + body: | +
+ Autogenerated Changelog + ... changelog ... +
From 66188c79c16892163d5b05ae6308a9909bd11879 Mon Sep 17 00:00:00 2001 From: od Date: Tue, 22 Oct 2024 19:57:08 -0600 Subject: [PATCH 16/17] added gate --- .github/workflows/build.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 89be2d7..c83e611 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -13,7 +13,7 @@ on: rev: description: 'tag, branch, or SHA to check out' required: true - default: 'main' + default: 'develop' permissions: contents: write @@ -196,6 +196,7 @@ jobs: - name: Release uses: softprops/action-gh-release@v2 + if: startsWith(github.ref, 'refs/tags/') with: token: ${{ github.token }} # tag_name: ${{ github.event.release.tag_name }} From ebfbbc4b5c91b0cca5a713db11adad8e9c739afa Mon Sep 17 00:00:00 2001 From: od Date: Wed, 6 Nov 2024 10:35:25 -0700 Subject: [PATCH 17/17] Set variables to zero that are used to sum up the total soil carbon for each carbon components before summing the soil carbon components in the soil layers and changed what soil carbon constituents would be added to get a tot_org&c value. --- src/soil_nutcarb_write.f90 | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/src/soil_nutcarb_write.f90 b/src/soil_nutcarb_write.f90 index ce214c5..3c746de 100644 --- a/src/soil_nutcarb_write.f90 +++ b/src/soil_nutcarb_write.f90 @@ -50,6 +50,15 @@ subroutine soil_nutcarb_write soil1(j)%tot_org = soil_org_z soil_prof_hact = soil_org_z soil_prof_hsta = soil_org_z + soil_prof_hsta = soil_org_z + soil_prof_str = soil_org_z + soil_prof_lig = soil_org_z + soil_prof_meta = soil_org_z + soil_prof_man = soil_org_z + soil_prof_hs = soil_org_z + soil_prof_hp = soil_org_z + soil_prof_microb = soil_org_z + soil_prof_water = soil_org_z do ly = 1, soil(j)%nly soil_prof_hact = soil_prof_hact + soil1(j)%hact(ly) soil_prof_hsta = soil_prof_hsta + soil1(j)%hsta(ly) @@ -62,7 +71,9 @@ subroutine soil_nutcarb_write soil_prof_microb = soil_prof_microb + soil1(j)%microb(ly) soil_prof_water = soil_prof_water + soil1(j)%water(ly) end do - soil1(j)%tot_org = soil_prof_hact + soil_prof_hsta + soil_prof_microb + ! soil1(j)%tot_org = soil_prof_hact + soil_prof_hsta + soil_prof_microb + soil1(j)%tot_org = soil_prof_hs + soil_prof_hp + soil_prof_microb + soil_prof_meta + & + soil_prof_str + soil_prof_lig !write all organic carbon for the plant community write (4560,*) time%day, time%mo, time%day_mo, time%yrc, j, ob(iob)%gis_id, ob(iob)%name, &