Skip to content

Commit 1807dbb

Browse files
Jeff.ArnoldJeff.Arnold
Jeff.Arnold
authored and
Jeff.Arnold
committed
na
1 parent 8ae040c commit 1807dbb

21 files changed

+377
-806
lines changed

‎src/actions.f90‎

Lines changed: 60 additions & 117 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ subroutine actions (ob_cur, ob_num, idtbl)
44
use time_module
55
use aquifer_module
66
use hru_module, only : hru, cn2, fertno3, fertnh3, fertorgn, fertorgp, fertsolp, &
7-
ihru, ipl, isol, phubase, sol_sumno3, sol_sumsolp
7+
ihru, ipl, isol, phubase, sol_sumno3, sol_sumsolp, qtile
88
use soil_module
99
use plant_module
1010
use plant_data_module
@@ -73,10 +73,11 @@ subroutine actions (ob_cur, ob_num, idtbl)
7373
integer :: irec = 0
7474
integer :: iplt = 0
7575
integer :: num_plts_cur = 0
76+
integer :: hru_rcv
7677
real :: hiad1 = 0. ! |
7778
real :: biomass = 0. ! |
7879
real :: frt_kg = 0.
79-
real :: harveff = 0. !
80+
real :: harveff = 0.
8081
real :: wur = 0. ! |
8182
real :: frac = 0. ! |
8283
real :: rto = 0. ! |
@@ -92,9 +93,6 @@ subroutine actions (ob_cur, ob_num, idtbl)
9293
character(len=1) :: action = "" ! |
9394
character(len=40) :: lu_prev = "" ! |
9495

95-
yield = 0.
96-
sumpst = 0.
97-
9896
do iac = 1, d_tbl%acts
9997
action = "n"
10098
do ial = 1, d_tbl%alts
@@ -131,7 +129,7 @@ subroutine actions (ob_cur, ob_num, idtbl)
131129
hru(j)%irr_hmax = d_tbl%act(iac)%const !mm target ponding depth
132130
hru(j)%irr_hmin = d_tbl%act(iac)%const2 !mm threshold ponding depth for irrigation
133131

134-
wet_ob(j)%depth = wet_ob(j)%depth + irrig(j)%applied / 1000. !m irrigation by wro already happened for today Jaehak 2023
132+
wet_ob(j)%depth = wet_ob(j)%depth + irrig(j)%applied / 1000. !mm irrigation by wro already happend for today Jaehak 2023
135133

136134
if (wet_ob(j)%depth*1000.<hru(j)%irr_hmin) then
137135
irrig(j)%demand = max(0.,d_tbl%act(iac)%const-wet_ob(j)%depth*1000.) * hru(j)%area_ha * 10. ! m3 = mm * ha * 10.
@@ -246,7 +244,6 @@ subroutine actions (ob_cur, ob_num, idtbl)
246244
end select
247245

248246
if (pco%mgtout == "y") then
249-
! write (2612, *) j, time%yrc, time%mo, time%day_mo, " ", "IRRIGATE", phubase(j), &
250247
write (2612, *) j, time%yrc, time%mo, time%day_mo, d_tbl%act(iac)%name, "IRRIGATE", phubase(j), &
251248
pcom(j)%plcur(ipl)%phuacc, soil(j)%sw, pl_mass(j)%tot(ipl)%m, soil1(j)%rsd(1)%m, &
252249
sol_sumno3(j), sol_sumsolp(j), irrig(j)%demand
@@ -321,6 +318,9 @@ subroutine actions (ob_cur, ob_num, idtbl)
321318
case ("plant")
322319
j = d_tbl%act(iac)%ob_num
323320
if (j == 0) j = ob_cur
321+
322+
if (pcom(j)%dtbl(idtbl)%num_actions(iac) <= Int(d_tbl%act(iac)%const2)) then
323+
324324
icom = pcom(j)%pcomdb
325325
pcom(j)%days_plant = 1 !reset days since last planting
326326
!! check for generic plant-harv and set crops
@@ -333,8 +333,6 @@ subroutine actions (ob_cur, ob_num, idtbl)
333333
d_tbl%act(iac)%option = sched(isched)%auto_crop(pcom(j)%rot_yr)
334334
end if
335335

336-
if (pcom(j)%dtbl(idtbl)%num_actions(iac) <= Int(d_tbl%act(iac)%const2)) then
337-
338336
do ipl = 1, pcom(j)%npl
339337

340338
idp = pcomdb(icom)%pl(ipl)%db_num
@@ -461,6 +459,7 @@ subroutine actions (ob_cur, ob_num, idtbl)
461459

462460
if (pcom(j)%dtbl(idtbl)%num_actions(iac) <= Int(d_tbl%act(iac)%const2)) then
463461
icom = pcom(j)%pcomdb
462+
pcom(j)%days_kill = 1 !reset days since last kill
464463
do ipl = 1, pcom(j)%npl
465464
biomass = pl_mass(j)%tot(ipl)%m
466465
if (d_tbl%act(iac)%option == pcomdb(icom)%pl(ipl)%cpnm .or. d_tbl%act(iac)%option == "all") then
@@ -577,6 +576,34 @@ subroutine actions (ob_cur, ob_num, idtbl)
577576
if (d_tbl%act(iac)%const < 1) d_tbl%act(iac)%const = 1
578577
pcom(j)%rot_yr = d_tbl%act(iac)%const
579578

579+
!reset days since last harvest
580+
case ("harv_reset")
581+
j = d_tbl%act(iac)%ob_num
582+
if (j == 0) j = ob_cur
583+
if (d_tbl%act(iac)%const < 1) d_tbl%act(iac)%const = 1
584+
pcom(j)%days_harv = d_tbl%act(iac)%const
585+
586+
!reset days since last harvest
587+
case ("kill_reset")
588+
j = d_tbl%act(iac)%ob_num
589+
if (j == 0) j = ob_cur
590+
if (d_tbl%act(iac)%const < 1) d_tbl%act(iac)%const = 1
591+
pcom(j)%days_kill = d_tbl%act(iac)%const
592+
593+
!reset days since last planting
594+
case ("plant_reset")
595+
j = d_tbl%act(iac)%ob_num
596+
if (j == 0) j = ob_cur
597+
if (d_tbl%act(iac)%const < 1) d_tbl%act(iac)%const = 1
598+
pcom(j)%days_plant = d_tbl%act(iac)%const
599+
600+
!reset days since last irrigation
601+
case ("irr_reset")
602+
j = d_tbl%act(iac)%ob_num
603+
if (j == 0) j = ob_cur
604+
if (d_tbl%act(iac)%const < 1) d_tbl%act(iac)%const = 1
605+
pcom(j)%days_irr = d_tbl%act(iac)%const
606+
580607
!apply pesticide
581608
case ("pest_apply")
582609
j = d_tbl%act(iac)%ob_num
@@ -656,22 +683,14 @@ subroutine actions (ob_cur, ob_num, idtbl)
656683
hlt(j)%aet = 0.
657684
hlt(j)%pet = 0.
658685

659-
!drainage water management
660-
case ("drain_control") !! set drain depth for drainage water management
686+
!! drainage water management
687+
case ("tiledep_control") !! set drain depth for drainage water management
661688
j = d_tbl%act(iac)%ob_num
662689
if (j == 0) j = ob_cur
663690

664691
if (pcom(j)%dtbl(idtbl)%num_actions(iac) <= Int(d_tbl%act(iac)%const2)) then
665-
istr = hru(j)%tiledrain
692+
istr = hru(j)%tiledrain
666693
hru(j)%lumv%sdr_dep = d_tbl%act(iac)%const
667-
!if (hru(j)%lumv%sdr_dep > 0) then
668-
! do jj = 1, soil(j)%nly
669-
! if (hru(j)%lumv%sdr_dep < soil(j)%phys(jj)%d) hru(j)%lumv%ldrain = jj
670-
! if (hru(j)%lumv%sdr_dep < soil(j)%phys(jj)%d) exit
671-
! end do
672-
!else
673-
! hru(j)%lumv%ldrain = 0
674-
!end if
675694
pcom(j)%dtbl(idtbl)%num_actions(iac) = pcom(j)%dtbl(idtbl)%num_actions(iac) + 1
676695

677696
if (pco%mgtout == "y") then
@@ -682,38 +701,33 @@ subroutine actions (ob_cur, ob_num, idtbl)
682701
end if
683702

684703
! set the amount of water to be diverted
685-
case ("divert")
686-
! ob_num is set in wallo_demand
704+
case ("tileflo_contol")
705+
j = d_tbl%act(iac)%ob_num
706+
if (j == 0) j = ob_cur
707+
708+
!! set amount of tile flow to send to buffer hru
709+
hru_rcv = hru(j)%sb%sb_db%hru_rcv
710+
711+
! option to set tile flow directed toward the saturated buffer hru
687712
select case (d_tbl%act(iac)%option)
688713

689-
case ("flo_cms") !! flow diversion demand to m3
690-
trans_m3 = d_tbl%act(iac)%const * 86400.
714+
case ("flo_mm") !! set tile flow diverted - can't be more than actual flow
715+
hru(hru_rcv)%sb%inflo = Min (qtile, d_tbl%act(iac)%const)
691716

692-
case ("min_cms") !! minimum flow rate (m3/s)
693-
if (ob(ob_num)%hd(1)%flo / 86400. < d_tbl%act(iac)%const + .0001) then
694-
!! below min - all flow to downstream channel (first outflow hydrograph in connect file)
695-
trans_m3 = 0.
696-
else
697-
!! above min flow
698-
trans_m3 = ob(ob_num)%hd(1)%flo - d_tbl%act(iac)%const * 86400.
699-
end if
717+
case ("min_mm") !! divert at least the minimum flow rate
718+
hru(hru_rcv)%sb%inflo = Max (qtile, d_tbl%act(iac)%const)
719+
720+
case ("max_mm") !! divert the maximum flow rate - can't be more than actual flow
721+
hru(hru_rcv)%sb%inflo = Min (qtile, d_tbl%act(iac)%const)
700722

701723
case ("all_flo") !! all flow diverted
702-
trans_m3 = ob(ob_num)%hd(1)%flo
724+
hru(hru_rcv)%sb%inflo = qtile
703725

704-
case ("min_frac") !! minimum - constant fraction
705-
trans_m3 = d_tbl%act(iac)%const * ob(ob_num)%hd(1)%flo
706-
707-
case ("recall")
708-
irec = d_tbl%act_typ(iac)
709-
select case (recall(irec)%typ)
710-
case (1) !daily
711-
trans_m3 = recall(irec)%hd(time%day,time%yrs)%flo
712-
case (2) !monthly
713-
trans_m3 = recall(irec)%hd(time%mo,time%yrs)%flo
714-
case (3) !annual
715-
trans_m3 = recall(irec)%hd(1,time%yrs)%flo
716-
end select
726+
case ("zero_flo") !! all flow diverted
727+
hru(hru_rcv)%sb%inflo = 0.
728+
729+
case ("frac") !! minimum - constant fraction
730+
hru(hru_rcv)%sb%inflo = d_tbl%act(iac)%const * qtile
717731

718732
end select
719733

@@ -734,77 +748,6 @@ subroutine actions (ob_cur, ob_num, idtbl)
734748
dmd_m3 = Max (0., dmd_m3)
735749
end if
736750
end select
737-
738-
!flow control for water allocation - needs to be modified***
739-
case ("flow_control") !! set flow fractions in con file
740-
! ob_num is the object number of the current channel
741-
select case (d_tbl%act(iac)%option)
742-
743-
case ("min_cms") !! minimum flow rate (m3/s) left in first outflow channel in connect file
744-
if (ob(ob_num)%hd(1)%flo / 86400. < d_tbl%act(iac)%const + .0001) then
745-
!! below min - all flow to downstream channel (first outflow hydrograph in connect file)
746-
frac = 1.
747-
else
748-
!! above min flow - set first channel fraction to min and divert the rest to the second channel
749-
frac = d_tbl%act(iac)%const / (ob(ob_num)%hd(1)%flo / 86400.)
750-
end if
751-
752-
case ("all_flo") !! all flow to first outflow channel in connect file
753-
frac = 1.
754-
755-
case ("min_frac") !! minimum or constant fraction
756-
frac = d_tbl%act(iac)%const
757-
758-
case ("demand")
759-
760-
end select
761-
762-
! set inflow hydrograph fraction of receiving objects - used for dtbl flow fractions
763-
! set first object hyd fractin as defined in decision table
764-
inhyd = dtbl_flo(idtbl)%act(iac)%ob_num
765-
ihyd_in = ob(ob_num)%rcvob_inhyd(inhyd)
766-
iob_out = ob(ob_num)%obj_out(inhyd)
767-
ob(iob_out)%frac_in(ihyd_in) = frac
768-
769-
! set second hydrograph fraction
770-
if (inhyd < ob(ob_num)%src_tot .and. dtbl_flo(idtbl)%act(iac)%typ /= "irrigate_direct") then
771-
inhyd = inhyd + 1
772-
ihyd_in = ob(ob_num)%rcvob_inhyd(inhyd)
773-
iob_out = ob(ob_num)%obj_out(inhyd)
774-
ob(iob_out)%frac_in(ihyd_in) = 1. - frac
775-
end if
776-
777-
!tile flow control for saturated buffers
778-
case ("tile_control") !! set flow fractions to buffer tile and direct to channel
779-
icon = d_tbl%act(iac)%ob_num
780-
if (j == 0) j = ob_cur
781-
select case (d_tbl%act(iac)%option)
782-
case ("min_flo")
783-
if (hwb_d(j)%qtile < d_tbl%act(iac)%const) then
784-
frac = 1.
785-
else
786-
frac = d_tbl%act(iac)%const / hwb_d(j)%qtile
787-
end if
788-
! set inflow hydrograph fraction of receiving objects - used for dtbl flow fractions
789-
! set first object hyd fractin as defined in decision table
790-
inhyd = dtbl_flo(idtbl)%act(iac)%ob_num
791-
ihyd_in = ob(ob_num)%rcvob_inhyd(inhyd)
792-
iob_out = ob(ob_num)%obj_out(inhyd)
793-
ob(iob_out)%frac_in(ihyd_in) = frac
794-
795-
! set second hydrograph fraction
796-
if (inhyd < ob(ob_num)%src_tot .and. dtbl_flo(idtbl)%act(iac)%typ /= "irrigate_direct") then
797-
inhyd = inhyd + 1
798-
ihyd_in = ob(ob_num)%rcvob_inhyd(inhyd)
799-
iob_out = ob(ob_num)%obj_out(inhyd)
800-
ob(iob_out)%frac_in(ihyd_in) = 1. - frac
801-
end if
802-
803-
case ("linear")
804-
805-
case ("power")
806-
807-
end select
808751

809752
!turn off hru impounded water - rice paddy or wetland
810753
case ("impound_off")

0 commit comments

Comments
 (0)