diff --git a/VERSIONS b/VERSIONS index 8222130..432e132 100644 --- a/VERSIONS +++ b/VERSIONS @@ -1,3 +1,3 @@ VERSION_MAJOR 2012 -VERSION_MINOR 689 +VERSION_MINOR 692 VERSION_PATCH \ No newline at end of file diff --git a/src/allocate_parms.f b/src/allocate_parms.f index 276db01..cb114de 100644 --- a/src/allocate_parms.f +++ b/src/allocate_parms.f @@ -65,6 +65,8 @@ subroutine allocate_parms do ihru = 1, mhru allocate (ppet(ihru)%precip(ppet(ihru)%ndays)) allocate (ppet(ihru)%pet(ppet(ihru)%ndays)) + ppet(ihru)%precip = 0. + ppet(ihru)%pet = 0. end do !! Srini 11_1_22 diff --git a/src/alph.f b/src/alph.f index 7f0e943..d80578a 100644 --- a/src/alph.f +++ b/src/alph.f @@ -62,7 +62,7 @@ subroutine alph(iwave) !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ -!! SWAT: Expo, Atri +!! SWAT: Exp, Atri !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ @@ -101,7 +101,8 @@ subroutine alph(iwave) endif ajp = 0. - ajp = 1. - Expo(-125. / (preceff + 5.)) + xx = (-125. / (preceff + 5.)) + ajp = 1. - Exp(xx) if (ised_det == 0) then al5 = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp, rndseed(idg(6),j)) else @@ -153,7 +154,8 @@ subroutine alph(iwave) endif ajp = 0. - ajp = 1. - Expo(-125. / (preceff + 5.)) + xx = (-125. / (preceff + 5.)) + ajp = 1. - Exp(xx) if (ised_det == 0) then al5 = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp, & rndseed(idg(6),j)) diff --git a/src/command.f b/src/command.f index 846234c..5531ffa 100644 --- a/src/command.f +++ b/src/command.f @@ -129,8 +129,10 @@ subroutine command case (0) return case (1) - call subbasin - call print_hyd + if (isub_sav == 0) then + call subbasin + call print_hyd + end if case (2) call route if (dtp_onoff(inum1)==1) call bmp_det_pond !route detention pond J.Jeong feb 2010 diff --git a/src/eiusle.f b/src/eiusle.f index 43ecbe3..e6d02de 100644 --- a/src/eiusle.f +++ b/src/eiusle.f @@ -42,7 +42,7 @@ subroutine eiusle !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ !! Intrinsic: Log, Log10 -!! SWAT: Expo, Atri +!! SWAT: Exp, Atri !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ @@ -63,7 +63,8 @@ subroutine eiusle preceff = precipday !- snomlt - ovrlnd(j) if (preceff > 1.e-4) then - ajp = 1. - Expo(-125. / preceff) + xx = (-125. / preceff) + ajp = 1. - Exp(xx) xa = Atri(ab, amp_r(i_mo,hru_sub(j)), ajp, rndseed(idg(4),j)) xb = -2. * Log(1. - xa) pkrf30 = 2. * preceff * xa diff --git a/src/etact.f b/src/etact.f index 0f4f7a4..c533e3d 100644 --- a/src/etact.f +++ b/src/etact.f @@ -102,7 +102,7 @@ subroutine etact !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ !! Intrinsic: Exp, Min, Max -!! SWAT: Expo +!! SWAT: Exp !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ @@ -263,7 +263,7 @@ subroutine etact evzp = evz if (sol_st(ly,j) < sol_fc(ly,j)) then xx = 2.5 * (sol_st(ly,j) - sol_fc(ly,j)) / sol_fc(ly,j) - sev = sev * Expo(xx) + sev = sev * Exp(xx) end if sev = Min(sev, sol_st(ly,j) * etco) diff --git a/src/expo.f b/src/expo.f deleted file mode 100644 index 3737545..0000000 --- a/src/expo.f +++ /dev/null @@ -1,35 +0,0 @@ - real function expo (xx) result(r_expo) - -!! ~ ~ ~ PURPOSE ~ ~ ~ -!! This function checks the argument against upper and lower -!! boundary values prior to taking the Exponential - -!! ~ ~ ~ INCOMING VARIABLES ~ ~ ~ -!! name |units |definition -!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! xx |none |Exponential argument -!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -!! ~ ~ ~ OUTGOING VARIABLES ~ ~ ~ -!! name |units |definition -!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ -!! expo |none |Exp(xx) -!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ - -!! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ -!! Intrinsic: Exp - -!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ - - real*8 :: xx, yy - - yy = xx - - if (yy < -20.) yy = -20. - if (yy > 20.) yy = 20. - - r_expo = 0. - r_expo = Exp(yy) - - return - end \ No newline at end of file diff --git a/src/hruallo.f b/src/hruallo.f index e17c5b1..8aabb83 100644 --- a/src/hruallo.f +++ b/src/hruallo.f @@ -113,7 +113,8 @@ subroutine hruallo read (10,6000) titldum end do - do kk = 1, 1000 +!! do kk = 1, 1000 + do kk = 1, 2000 !!!!!!! nbs 8/25/23 read (10,6300,iostat=eof) mgt_op, mgt1i if (eof < 0) exit if (mgt_op == 1) then diff --git a/src/main.f b/src/main.f index 4927861..c308126 100644 --- a/src/main.f +++ b/src/main.f @@ -47,11 +47,10 @@ program main use parm implicit none - !prog = "SWAT Dec 1 VER 2022/Merge Rev 663/Rev 687" - prog = "SWAT May 10 VER 2023/Rev 689" + prog = "SWAT Nov 14 VER 2023/Rev 692" write (*,1000) 1000 format(1x," SWAT2022 ",/, - & " Rev. 688 ",/, + & " Rev. 692 ",/, & " Soil & Water Assessment Tool ",/, & " PC Version ",/, & " Program reading from file.cio . . . executing",/) diff --git a/src/modparm.f b/src/modparm.f index afdfadd..33a77f3 100644 --- a/src/modparm.f +++ b/src/modparm.f @@ -11,8 +11,8 @@ module parm integer :: curday_mon = 0 !! |current day into the monsoon period integer :: ndays = 30 !! |number of days for precip/pet moving average real :: trig = 0.5 !!mm/mm |precip/pet ratio to trigger plant/restart - real :: precip_sum !!mm |sum of precip during moving average period - real :: pet_sum !!mm |sum of pet during moving average period + real :: precip_sum = 0. !!mm |sum of precip during moving average period + real :: pet_sum = 0. !!mm |sum of pet during moving average period real, dimension (:), allocatable :: precip !!mm |precip dimensioned by ndays real, dimension (:), allocatable :: pet !!mm |pet dimensioned by ndays real :: rto = 0 !! |sum of precip/sum of pet @@ -26,6 +26,7 @@ module parm real*8, dimension (:), allocatable :: tmp_win1, tmp_win2, & tmp_sum1, tmp_sum2, tmp_spr1, & tmp_spr2, tmp_fal1, tmp_fal2 + integer :: isub_sav real*8 :: wtmp real*8, dimension (12) :: pcpmm @@ -1037,11 +1038,6 @@ real*8 function ee(tk) result (r_ee) real*8, intent (in) :: tk end - function expo (xx) result (r_expo) - real*8 :: xx - real*8 :: r_expo - end function - real*8 Function fcgd(xx) real*8, intent (in) :: xx End function diff --git a/src/pgenhr.f b/src/pgenhr.f index 1ea298f..81021a6 100644 --- a/src/pgenhr.f +++ b/src/pgenhr.f @@ -65,7 +65,7 @@ subroutine pgenhr(jj) !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ !! Intrinsic: Log -!! SWAT: Atri, Expo +!! SWAT: Atri, Exp !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ @@ -81,14 +81,16 @@ subroutine pgenhr(jj) ab = 0.02083 ajp = 0. al5 = 0. - ajp = 1. - Expo(-125. / (subp(jj) + 5.)) + xx = (-125. / (subp(jj) + 5.)) + ajp = 1. - Exp(xx) al5 = Atri(ab, amp_r(i_mo,hru_sub(jj)), ajp, rndseed(10,jj)) !! need peak rainfall rate !! calculate peak rate using same method as that for peak runoff altc = 0. pkrr = 0. - altc = 1. - Expo(2. * tconc(jj) * Log(1. - al5)) + xx = (2. * tconc(jj) * Log(1. - al5)) + altc = 1. - Exp(xx) pkrr = altc * subp(jj) / tconc(jj) !! mm/h diff --git a/src/pkq.f b/src/pkq.f index f134cbb..6da8f86 100644 --- a/src/pkq.f +++ b/src/pkq.f @@ -39,7 +39,7 @@ subroutine pkq(iwave) !! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ !! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~ -!! Intrinsic: Log, Expo +!! Intrinsic: Log, Exp !! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~ @@ -56,12 +56,14 @@ subroutine pkq(iwave) if (iwave > 0) then !! subbasin sediment calculations - altc = 1. - Expo(2. * sub_tc(iwave) * Log(1. - al5)) + xx = (2. * sub_tc(iwave) * Log(1. - al5)) + altc = 1. - Exp(xx) peakr = altc * (sub_qd(iwave) + sub_tran(iwave)) / sub_tc(iwave) !! mm/h peakr = peakr * sub_km(iwave) / 3.6 !! m^3/s else !! HRU sediment calculations - altc = 1. - Expo(2. * tconc(j) * Log(1. - al5)) + xx = (2. * tconc(j) * Log(1. - al5)) + altc = 1. - Exp(xx) peakr = altc * qday / tconc(j) !! mm/h peakr = peakr * hru_km(j) / 3.6 !! m^3/s end if diff --git a/src/plantop.f b/src/plantop.f index 478333e..e428ac4 100644 --- a/src/plantop.f +++ b/src/plantop.f @@ -90,10 +90,10 @@ subroutine plantop endif !! compare maximum rooting depth in soil to maximum rooting depth of plant - nly = sol_nly(j) - sol_zmx(ihru) = sol_z(nly,j) - plt_zmx = 1000. * rdmx(idplt(j)) - sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx) + !nly = sol_nly(j) + !sol_zmx(ihru) = sol_z(nly,j) + !plt_zmx = 1000. * rdmx(idplt(j)) + !sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx) !! reset curve number if given in .mgt file if (cnop > 0.) call curno(cnop,j) diff --git a/src/readbsn.f b/src/readbsn.f index 11efb8c..9a10e6d 100644 --- a/src/readbsn.f +++ b/src/readbsn.f @@ -381,6 +381,7 @@ subroutine readbsn eof = 0 escobsn = 0. epcobsn = 0. + isub_sav = 0 r2adj_bsn = 0. !D. Moriasi 4/8/2014 wwqfile = "" numlu=1 @@ -606,8 +607,11 @@ subroutine readbsn read (103,*,iostat=eof) sfsedmean if (eof < 0) exit read (103,*,iostat=eof) sfsedstdev + if (eof < 0) exit read (103,*,iostat=eof) salt_num if (eof < 0) exit + read (103,*,iostat=eof) isub_sav + if (eof < 0) exit exit !! Drainmod input variables - 01/2006 end do diff --git a/src/readfig.f b/src/readfig.f index 9d724fd..e2b4eea 100644 --- a/src/readfig.f +++ b/src/readfig.f @@ -282,19 +282,19 @@ subroutine readfig day_in = "" read (102,5100) day_in call caps(day_in) - if (inum1s(idum) <= 10 .and. inum1s(idum) > 0) then - open (40+inum1s(idum),file=day_in,recl=350) + !if (inum1s(idum) <= 10 .and. inum1s(idum) > 0) then + open (30000+inum1s(idum),file=day_in,recl=350) if (inum3s(idum) == 0) then - write (40+inum1s(idum),5400) title - write (40+inum1s(idum),5500) + write (30000+inum1s(idum),5400) title + write (30000+inum1s(idum),5500) else iida = 0 iida = idaf call xmon - write (40+inum1s(idum),5501) iyr, i_mo, + write (30000+inum1s(idum),5501) iyr, i_mo, & (iida - ndays(i_mo)) end if - end if + !end if case (10) !! icode = 10 RECDAY command: read in daily values !! with water in cms and rest in tons diff --git a/src/readfile.f b/src/readfile.f index 771b074..19ac39c 100644 --- a/src/readfile.f +++ b/src/readfile.f @@ -693,6 +693,15 @@ subroutine readfile write (142,4998) 4998 format(t17,'AVE WATER',/,t3,'Day',t7,'Year',t18,'DEPTH(m)') end if + +!!!!!open Srin/Arun new output file from subbasin.f (monsoon_plt.out) + open (144, file="monsoon_plt.out", recl=600) + write (144, 1999) +1999 format(2x,'Sub',2x,'Hru',2x,'Year',3x,'Mon',3x,'Day', + *' AREAkm2', 13x,'CPNM', 4x, " PLANT", + *' PRECIPD ', ' PET_DAY ', ' RTO', ' PRECIPSUM', ' PET_SUM ', + *' SOL_SW',/,70x,' (mm) ',' (mm) ',10x,' (mm) ', ' (mm) ',' (mm) ') + !!!!!open Srin/Arun new output file from subbasin.f !! Code for output.mgt file ! 0=no print 1=print diff --git a/src/readpnd.f b/src/readpnd.f index 5d47dbb..9220aa2 100644 --- a/src/readpnd.f +++ b/src/readpnd.f @@ -599,9 +599,9 @@ subroutine readpnd read (104,*,iostat=eof) (lid_lus(k),k=1,mudb) if (eof < 0) exit nlid(i)=1 - do while (is_numeric(lid_lus(nlid(i))) .eqv. .TRUE.) + !do while (is_numeric(lid_lus(nlid(i)))== .TRUE.) nlid(i)=nlid(i) + 1 - END DO + !END DO nlid(i) = nlid(i) - 1 backspace(104) backspace(104) diff --git a/src/readsol.f b/src/readsol.f index 087ec99..340a04f 100644 --- a/src/readsol.f +++ b/src/readsol.f @@ -188,19 +188,19 @@ subroutine readsol !! compare maximum rooting depth in soil to maximum rooting depth of !! plant - if (sol_zmx(ihru) <= 0.001) sol_zmx(ihru) = sol_z(nly,ihru) - plt_zmx = 0. - if (idplt(ihru) > 0) then - if (idc(idplt(ihru)) > 0) then - plt_zmx = 1000. * rdmx(idplt(ihru)) - end if - end if - if (sol_zmx(ihru) > 1. .and. plt_zmx > 1.) then - sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx) - else + !if (sol_zmx(ihru) <= 0.001) sol_zmx(ihru) = sol_z(nly,ihru) + !plt_zmx = 0. + !if (idplt(ihru) > 0) then + ! if (idc(idplt(ihru)) > 0) then + ! plt_zmx = 1000. * rdmx(idplt(ihru)) + ! end if + !end if + !if (sol_zmx(ihru) > 1. .and. plt_zmx > 1.) then + ! sol_zmx(ihru) = Min(sol_zmx(ihru),plt_zmx) + !else !! if one value is missing it will set to the one available - sol_zmx(ihru) = Max(sol_zmx(ihru),plt_zmx) - end if + ! sol_zmx(ihru) = Max(sol_zmx(ihru),plt_zmx) + !end if !! create a layer boundary at maximum rooting depth (sol_zmx) !if (sol_zmx(i) > 0.001.and.sol_zmx(ihru)/=sol_z(nly,ihru)) then diff --git a/src/routres.f b/src/routres.f index a50dc2e..d1158ad 100644 --- a/src/routres.f +++ b/src/routres.f @@ -48,7 +48,7 @@ subroutine routres !! res_seci(:) |m |secchi-disk depth !! res_sub(:) |none |number of subbasin reservoir is in !! res_vol(:) |m^3 H2O |reservoir volume -!! reschlao |kg chl-a |amount of chlorophyll-a leaving reaservoir +!! reschlao |kg chl-a |amount of chlorophyll-a leaving reservoir !! |on day !! resev |m^3 H2O |evaporation from reservoir on day !! resflwi |m^3 H2O |water entering reservoir on day diff --git a/src/save.f b/src/save.f index 69ac62f..07ef62c 100644 --- a/src/save.f +++ b/src/save.f @@ -42,12 +42,12 @@ subroutine save integer :: ii - if (inum1 <= 10 .and. inum1 > 0) then + !if (inum1 <= 10 .and. inum1 > 0) then if (ievent == 1 .and. inum2 == 1) then !! Write subdaily values do ii = 1, nstep if (inum3 == 0) then - write (40+inum1,5000) iida, iyr, ii-1, + write (30000+inum1,5000) iida, iyr, ii-1, & hhvaroute(2,ihout,ii), & hhvaroute(3,ihout,ii), & hhvaroute(4,ihout,ii), @@ -68,7 +68,7 @@ subroutine save & hhvaroute(22,ihout,ii), & hhvaroute(1,ihout,ii) else - write (40+inum1,5000) + write (30000+inum1,5000) & hhvaroute(2,ihout,ii), & hhvaroute(3,ihout,ii), & hhvaroute(4,ihout,ii), @@ -92,7 +92,7 @@ subroutine save end do else if (inum3 == 0) then - write (40+inum1,5002) iida, iyr, + write (30000+inum1,5002) iida, iyr, & varoute(2,ihout), & varoute(3,ihout), & varoute(4,ihout), @@ -113,7 +113,7 @@ subroutine save & varoute(22,ihout), & varoute(1,ihout) else - write (40+inum1,5003) + write (30000+inum1,5003) & varoute(2,ihout), & varoute(3,ihout), & varoute(4,ihout), @@ -135,11 +135,10 @@ subroutine save & varoute(1,ihout) end if end if - end if + !end if return 5000 format (1x,i3,1x,i4,1x,i2,1x,18(e11.5,1x),f11.1) - 5001 format (18(e11.5,","),f11.1) 5002 format (1x,i3,1x,i4,4x,18(e11.5,1x),f11.1) 5003 format (18(e11.5,","),f11.1) end \ No newline at end of file diff --git a/src/simulate.f b/src/simulate.f index 78e7602..8c5243a 100644 --- a/src/simulate.f +++ b/src/simulate.f @@ -163,9 +163,9 @@ subroutine simulate do i = id1, idlst !! begin daily loop !screen print days of the year for subdaily runs - !if (ievent>0) then - !write(*,'(3x,I5,a6,i4)') iyr,' day:', iida - !endif + if (ievent > 0) then + write(*,'(3x,I5,a6,i4)') iyr,' day:', iida + endif !!if last day of month if (i_mo /= mo_chk) then diff --git a/src/stdaa.f b/src/stdaa.f index c67fb3b..16eb7d5 100644 --- a/src/stdaa.f +++ b/src/stdaa.f @@ -533,6 +533,7 @@ subroutine stdaa & 'AUTOPkh ',t84,'MIXEF',t90,'PRECmm',t97,'SURQGENmm',t109, & 'GWQmm',t118,'ETmm',t125,'SEDth ',t132,'NO3kgh ',t140, & 'ORGNkgh ',t148,'BIOMth',t157,'YLDth',t164,'SURQmm') + !1900 format (i7,i4,3x,a16,3x,e8.3,17f10.2) 1900 format (i7,i4,3x,a8,3x,e8.3,17f8.2) 2000 format (///,t17,'AVE MONTHLY BASIN VALUES',/t20,'SNOW',t46, & 'WATER',t66,'SED',/t3,'MON',t11,'RAIN',t20,'FALL',t27,'SURF Q', diff --git a/src/subbasin.f b/src/subbasin.f index 94a0626..866e425 100644 --- a/src/subbasin.f +++ b/src/subbasin.f @@ -134,6 +134,7 @@ subroutine subbasin integer :: j,sb,kk real*8 :: tmpk, d, gma, ho, pet_alpha, aphu, phuop,lid_sto + integer :: ppet_mce ihru = 0 ihru = hru1(inum1) @@ -210,7 +211,7 @@ subroutine subbasin !! subtract the 30 day previous and add the current day precip/pet ppet(j)%precip_sum = ppet(j)%precip_sum + precipday - ppet(j)%precip(ppet_mce) ppet(j)%pet_sum = ppet(j)%pet_sum + pet_day - ppet(j)%pet(ppet_mce) - ppet(j)%rto = ppet(j)%precip_sum / ppet(j)%pet_sum + ppet(j)%rto = ppet(j)%precip_sum / (ppet(j)%pet_sum + 0.5) ppet(j)%precip(ppet_mce) = precipday ppet(j)%pet(ppet_mce) = pet_day if (ppet(j)%trop > 0) then @@ -222,23 +223,18 @@ subroutine subbasin if (ppet(j)%peren == 0) then !! annual planting call plantop - if (imgt == 1) then - write (143, 1000) subnum(j), hruno(j), iyr, i_mo, iida, - & hru_km(j),cpnm(idplt(j))," PLANT", phubase(j), phuacc(j), - & sol_sw(j),bio_ms(j), sol_rsd(1,j),sol_sumno3(j), - & sol_sumsolp(j) - end if + write (144, 1001) subnum(j), hruno(j), iyr, i_mo, iida, + & hru_km(j), cpnm(idplt(j))," PLANT", precipday, pet_day, + & ppet(j)%rto, ppet(j)%precip_sum, ppet(j)%pet_sum, sol_sw(j) else !! perennial phenology reset igro(j) = 1 idorm(j) = 0 phuacc(j) = 0. - if (imgt == 1) then - write (143, 1000) subnum(j), hruno(j), iyr, i_mo, iida, - & hru_km(j),cpnm(idplt(j))," PHENO-RESET", phubase(j), phuacc(j), - & sol_sw(j),bio_ms(j), sol_rsd(1,j),sol_sumno3(j), - & sol_sumsolp(j) - end if + write (144, 1001) subnum(j), hruno(j), iyr, i_mo, iida, + & hru_km(j), cpnm(idplt(j))," PHENO-RESET", precipday, pet_day, + & ppet(j)%rto, ppet(j)%precip_sum, ppet(j)%pet_sum, sol_sw(j) + 1001 format (a5,1x,a4,3i6,1x,e10.5,1x,2a15,6f10.2) end if end if !else @@ -247,24 +243,18 @@ subroutine subbasin ppet(j)%mon_seas = 0 if (ppet(j)%peren == 0) then !! annual planting - call plantop - if (imgt == 1) then - write (143, 1000) subnum(j), hruno(j), iyr, i_mo, iida, - & hru_km(j),cpnm(idplt(j))," PLANT", phubase(j), phuacc(j), - & sol_sw(j),bio_ms(j), sol_rsd(1,j),sol_sumno3(j), - & sol_sumsolp(j) - end if + call plantop + write (144, 1001) subnum(j), hruno(j), iyr, i_mo, iida, + & hru_km(j), cpnm(idplt(j))," PLANT", precipday, pet_day, + & ppet(j)%rto, ppet(j)%precip_sum, ppet(j)%pet_sum, sol_sw(j) else !! perennial phenology reset igro(j) = 1 idorm(j) = 0 - phuacc(j) = 0. - if (imgt == 1) then - write (143, 1000) subnum(j), hruno(j), iyr, i_mo, iida, - & hru_km(j),cpnm(idplt(j))," PHENO-RESET", phubase(j), phuacc(j), - & sol_sw(j),bio_ms(j), sol_rsd(1,j),sol_sumno3(j), - & sol_sumsolp(j) - end if + phuacc(j) = 0. + write (144, 1001) subnum(j), hruno(j), iyr, i_mo, iida, + & hru_km(j), cpnm(idplt(j))," PHENO-RESET", precipday, pet_day, + & ppet(j)%rto, ppet(j)%precip_sum, ppet(j)%pet_sum, sol_sw(j) end if end if end if @@ -280,11 +270,6 @@ subroutine subbasin !! perform management operations if (yr_skip(j) == 0) call operatn -!!!! Srin's irrigation source by each application changes - irrsc(j) = irr_sca(j) - irrno(j) = irr_noa(j) -!!!! Srin's irrigation source by each application changes - if (irrsc(j) > 2) call autoirr !! perform soil water routing @@ -599,6 +584,5 @@ subroutine subbasin varoute(isub,:) = varoute(ihout,:) end if - 1000 format(4i10,a10) return end \ No newline at end of file diff --git a/src/surface.f b/src/surface.f index 078dd13..f16ab74 100644 --- a/src/surface.f +++ b/src/surface.f @@ -119,7 +119,7 @@ subroutine surface if (ievent>0 .and. urblu(j)>0) then do kk = 1, nlid(sb) if (lid_lunam(sb,kk)==urbname(urblu(j)).and.cs_onoff(sb,kk)==1) then !cistern - if (hrnopcp(sb,k) > 96) then ! four days + if (hrnopcp(sb,kk) > 96) then ! four days lid_irr = 0.3 * cs_vol(sb,kk) ! assumming 30% of water storage of a cistern in a day, m3 else lid_irr = 0. diff --git a/src/swu.f b/src/swu.f index e88344c..a52f509 100644 --- a/src/swu.f +++ b/src/swu.f @@ -96,19 +96,25 @@ subroutine swu use parm integer :: j, k, ir + real :: rdmax real*8, dimension(mlyr) :: wuse real*8 :: sum, xx, gx, reduc, sump j = 0 j = ihru - + + if (idplt(j) > 0) then + rdmax = min (sol_zmx(j), 1000. * rdmx(idplt(j))) + else + rdmax = sol_zmx(j) + end if select case (idc(idplt(j))) case (1, 2, 4, 5) - sol_rd = 2.5 * phuacc(j) * sol_zmx(j) - if (sol_rd > sol_zmx(j)) sol_rd = sol_zmx(j) + sol_rd = 2.5 * phuacc(j) * rdmax + if (sol_rd > rdmax) sol_rd = rdmax if (sol_rd < 10.) sol_rd = 10. case default - sol_rd = sol_zmx(j) + sol_rd = rdmax end select stsol_rd(j) = sol_rd ! cole armen 26 Feb diff --git a/src/virtual.f b/src/virtual.f index e8dba1a..0e3f088 100644 --- a/src/virtual.f +++ b/src/virtual.f @@ -325,15 +325,15 @@ subroutine virtual sub_dsag(sb) = sub_dsag(sb) + sagyld(j) sub_dlag(sb) = sub_dlag(sb) + lagyld(j) - surqno3(j) = amax1(1.e-12,surqno3(j)) - latno3(j) = amax1(1.e-12,latno3(j)) - no3gw(j) = amax1(1.e-12,no3gw(j)) - surqsolp(j) = amax1(1.e-12,surqsolp(j)) - minpgw(j) = amax1(1.e-12,minpgw(j)) - sedorgn(j) = amax1(1.e-12,sedorgn(j)) - sedorgp(j) = amax1(1.e-12,sedorgp(j)) - sedminpa(j) = amax1(1.e-12,sedminpa(j)) - sedminps(j) = amax1(1.e-12,sedminps(j)) + surqno3(j) = max(1.d-12,surqno3(j)) + latno3(j) = max(1.d-12,latno3(j)) + no3gw(j) = max(1.d-12,no3gw(j)) + surqsolp(j) = max(1.d-12,surqsolp(j)) + minpgw(j) = max(1.d-12,minpgw(j)) + sedorgn(j) = max(1.d-12,sedorgn(j)) + sedorgp(j) = max(1.d-12,sedorgp(j)) + sedminpa(j) = max(1.d-12,sedminpa(j)) + sedminps(j) = max(1.d-12,sedminps(j)) !! subbasin average: salt Srini do ii = 1, 10