📄 writem.f
字号:
!! k |none |counter
!! sum |mg |total pesticide loading
!! ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!! ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
!! Intrinsic: Real
!! SWAT: hrumon, impndmon, submon, rchmon, writea
!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
use parm
integer :: j, k
real :: sum
!! if last day of month or last day in last year
if (i_mo /= mo_chk .or. (curyr == nbyr .and. i == idal)) then
!! calculate current month (cumulative) of simulation
immo = immo + 1
!! calculate number of days in month
idlast = 0
if (immo == 1 .and. idaf > 0) then
idlast = ndays(mo_chk+1) - (idaf - 1)
if (leapyr == 1 .and. mo_chk == 2) idlast = idlast - 1
elseif (curyr == nbyr .and. i == idal) then
idlast = i - ndays(mo_chk)
else
idlast = ndays(mo_chk+1) - ndays(mo_chk)
if (leapyr == 1 .and. mo_chk == 2) idlast = idlast - 1
end if
!! calculate average temperature for month in watershed
if (idlast > 0.) then
wshdmono(8) = wshdmono(8) / Real(idlast)
wshdmono(9) = wshdmono(9) / Real(idlast)
else
wshdmono(8) = 0.
wshdmono(9) = 0.
end if
if (iprint /= 2 .and. curyr > nyskip) then
!! monthly write--output.std
if (iscen == 1) then
write (2,6200) mo_chk, wshdmono(1), wshdmono(3), wshdmono(4), &
& wshdmono(104), wshdmono(5), wshdmono(109), &
& wshddayo(35), wshdmono(7), wshdmono(108), wshdmono(6),&
& wshdmono(12), wshdmono(42), wshdmono(45), &
& wshdmono(46), wshdmono(44), wshdmono(40), &
& wshdmono(43), wshdmono(41)
else if (isproj == 1) then
write (19,6200) mo_chk, wshdmono(1), wshdmono(3), wshdmono(4),&
& wshdmono(104), wshdmono(5), wshdmono(109), &
& wshddayo(35), wshdmono(7), wshdmono(108), wshdmono(6),&
& wshdmono(12), wshdmono(42), wshdmono(45), &
& wshdmono(46), wshdmono(44), wshdmono(40), &
& wshdmono(43), wshdmono(41)
endif
if (iprint == 0) then
!! monthly write--pesticide output (output.pst) for HRUs
do j = 1, nhru
if (hrupest(j) == 1) then
sum = 0.
do k = 1, npmx
sum = sum + hrupstm(k,1,j) + hrupstm(k,2,j)
end do
if (sum > 0. .and. iprp == 1) then
write (5,5100) j, iyr, mo_chk, &
& (hrupstm(k,1,j), hrupstm(k,2,j), k = 1, npmx)
end if
end if
end do
!! monthly write--reservoir output (.rsv)
do j = 1, nres
!! monthly write-reservoir file
if (iyr > iyres(j) .or. &
& (mo_chk >= mores(j) .and. iyr == iyres(j))) then
if (iscen == 1) then
write (8,5800) j, mo_chk, res_vol(j), &
& resoutm(1,j) / Real(idlast), &
& resoutm(2,j) / Real(idlast), &
& resoutm(19,j), resoutm(17,j), resoutm(18,j),&
& resoutm(3,j), resoutm(4,j), &
& resoutm(5,j) / Real(idlast), &
& (resoutm(k,j), k = 22, 23), &
& resoutm(38,j) / Real(idlast), &
& (resoutm(k,j), k = 24, 25), &
& resoutm(36,j) / Real(idlast), &
& (resoutm(k,j), k = 26, 27), &
& resoutm(39,j) / Real(idlast), &
& (resoutm(k,j), k = 28, 29), &
& resoutm(40,j) / Real(idlast), &
& (resoutm(k,j), k = 30, 31), &
& resoutm(41,j) / Real(idlast), &
& (resoutm(k,j), k = 32, 33), &
& resoutm(37,j) / Real(idlast), &
& (resoutm(k,j), k = 34, 35), res_seci(j), &
& (resoutm(k,j), k = 6, 14), &
& resoutm(15,j) / Real(idlast), &
& resoutm(16,j) / Real(idlast)
else if (isproj == 1) then
write (22,5800) j, mo_chk, res_vol(j), &
& resoutm(1,j) / Real(idlast), &
& resoutm(2,j) / Real(idlast), &
& resoutm(19,j), resoutm(17,j), resoutm(18,j),&
& resoutm(3,j), resoutm(4,j), &
& resoutm(5,j) / Real(idlast), &
& (resoutm(k,j), k = 22, 23), &
& resoutm(38,j) / Real(idlast), &
& (resoutm(k,j), k = 24, 25), &
& resoutm(36,j) / Real(idlast), &
& (resoutm(k,j), k = 26, 27), &
& resoutm(39,j) / Real(idlast), &
& (resoutm(k,j), k = 28, 29), &
& resoutm(40,j) / Real(idlast), &
& (resoutm(k,j), k = 30, 31), &
& resoutm(41,j) / Real(idlast), &
& (resoutm(k,j), k = 32, 33), &
& resoutm(37,j) / Real(idlast), &
& (resoutm(k,j), k = 34, 35), res_seci(j), &
& (resoutm(k,j), k = 6, 14), &
& resoutm(15,j) / Real(idlast), &
& resoutm(16,j) / Real(idlast)
endif
end if
end do
!! monthly write--HRU output (output.hru)
call hrumon
call impndmon
!! monthly write--subbasin output (output.sub)
call submon
!! monthly write--reach output (.rch)
if (idlast > 0) call rchmon(idlast)
end if
end if
if (curyr > nyskip) then
!! calculating monthly averages
wshd_aamon(mo_chk,1) = wshd_aamon(mo_chk,1) + wshdmono(1)
wshd_aamon(mo_chk,2) = wshd_aamon(mo_chk,2) + wshdmono(39)
wshd_aamon(mo_chk,3) = wshd_aamon(mo_chk,3) + wshdmono(3)
wshd_aamon(mo_chk,4) = wshd_aamon(mo_chk,4) + wshdmono(4)
wshd_aamon(mo_chk,5) = wshd_aamon(mo_chk,5) + wshdmono(6)
wshd_aamon(mo_chk,6) = wshd_aamon(mo_chk,6) + wshdmono(7)
wshd_aamon(mo_chk,7) = wshd_aamon(mo_chk,7) + wshdmono(12)
wshd_aamon(mo_chk,8) = wshd_aamon(mo_chk,8) + wshdmono(108)
!! sum annual values
wshdyro = wshdyro + wshdmono
wpstyro = wpstyro + wpstmono
hruyro = hruyro + hrumono
wtryr = wtryr + wtrmon
subyro = subyro + submono
rchyro = rchyro + rchmono
resouty = resouty + resoutm
hrupsty = hrupsty + hrupstm
end if
wshdmono = 0.
wpstmono = 0.
hrumono = 0.
wtrmon = 0.
submono = 0.
rchmono = 0.
resoutm = 0.
hrupstm = 0.
call writea
endif
return
5100 format (1x,i4,1x,i4,1x,i3,1x,250(e16.4,1x))
5200 format (/,1x,i4,a4,1x,10f12.2)
5300 format (1x,i4,a4,1x,10f12.2,/)
5800 format ('RES ',i8,1x,i4,41e12.4)
6200 format (i5,15f7.2,1x,4f8.2)
end
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -