Skip to content

Commit 5e892f4

Browse files
crazyzljcrazyzlj
committed
Update to 2012Rev670
1 parent 6225b66 commit 5e892f4

File tree

262 files changed

+2399
-1970
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

262 files changed

+2399
-1970
lines changed

‎VERSIONS

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,3 @@
11
VERSION_MAJOR 2012
2-
VERSION_MINOR 664
2+
VERSION_MINOR 670
33
VERSION_PATCH

‎src/HQDAV.f90

Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
SUBROUTINE HQDAV(A,CBW,QQ,SSS,ZCH,ZX,CHW,FPW,jrch)
2+
! adopted from APEX1501 by Jaehak Jeong 2017
3+
! THIS SUBPROGRAM COMPUTES FLOW AREA AND DEPTH GIVEN RATE in a reach
4+
5+
USE PARM
6+
7+
real*8, intent (in out) :: A, ZX, CHW, FPW
8+
real*8, intent (in) :: CBW, QQ, SSS, ZCH
9+
integer, intent (in) :: jrch
10+
11+
real*8:: RFPW, RFPX
12+
ZX=.5*ZCH
13+
RFPW = ch_w(2,jrch) * 4. !width of floodplain
14+
RFPX = SQRT(ch_s(2,jrch)) * RFPW / ch_n(1,jrch)
15+
16+
DO IT=1,10
17+
IF(QQ>QCAP(jrch))THEN
18+
ZX=MAX(ZX,ZCH)
19+
ZZ=ZX-ZCH
20+
!COMPUTE CH FLOW ABOVE QCAP
21+
ACH=CHXA(jrch)+ZZ*ch_w(2,jrch)
22+
R=ACH/CHXP(jrch)
23+
QCH=ACH*R**.66667*RCHX(jrch)
24+
CHW=ch_w(2,jrch)
25+
!COMPUTE FP FLOW
26+
AFP=ZZ*(RFPW-ch_w(2,jrch))
27+
QFP=AFP*ZZ**.66667*RFPX/RFPW
28+
Q=QCH+QFP
29+
A=ACH+AFP
30+
FPW=RFPW
31+
NBCF=1
32+
ELSE
33+
X1=ZX*RCSS(jrch)
34+
A=ZX*(CBW+X1)
35+
P=CBW+2.*SSS*ZX
36+
Q=A**1.66667*RCHX(jrch)/P**.66667
37+
CHW=CBW+2.*X1
38+
FPW=0.
39+
NBCX=1
40+
END IF
41+
FU=Q-QQ
42+
X6=MAX(1.,QQ)
43+
IF(ABS(FU/X6)<.001)EXIT
44+
IF(IT==1)THEN
45+
DFQ=-.1*ZX
46+
ELSE
47+
DFDZ=(FU-FU1)/(ZX-ZX1)
48+
DFQ=FU/DFDZ
49+
END IF
50+
FU1=FU
51+
ZX1=ZX
52+
ZX=ZX-DFQ
53+
END DO
54+
RETURN
55+
END

‎src/NCsed_leach.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -54,9 +54,9 @@ subroutine orgncswat2(iwave)
5454

5555
integer, intent (in) :: iwave
5656
integer :: j
57-
real :: xx, wt1, er, conc
58-
real :: sol_mass, QBC, VBC, YBC, YOC, YW, TOT, YEW, X1, PRMT_21, PRMT_44
59-
real :: DK, V, X3, CO, CS, perc_clyr, latc_clyr
57+
real*8 :: xx, wt1, er, conc
58+
real*8 :: sol_mass, QBC, VBC, YBC, YOC, YW, TOT, YEW, X1, PRMT_21, PRMT_44
59+
real*8 :: DK, V, X3, CO, CS, perc_clyr, latc_clyr
6060
integer :: k
6161
latc_clyr = 0.
6262

‎src/addh.f

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,6 @@ subroutine addh
6969

7070
!! add hydrograph points (hourly time step)
7171
if (ievent > 0) then
72-
! do kk = 1, 24
7372
do kk = 1, nstep ! modified for urban modeling by J.Jeong 4/15/2008
7473
if (hhvaroute(2,inum1,kk) + hhvaroute(2,inum2,kk) > 0.1) then
7574
hhvaroute(1,ihout,kk) = (hhvaroute(1,inum1,kk) *
@@ -79,12 +78,16 @@ subroutine addh
7978
end if
8079
end do
8180
do ii = 2, mvaro
82-
! do kk = 1, 24
8381
do kk = 1, nstep ! modified for urban modeling by J.Jeong 4/15/2008
8482
hhvaroute(ii,ihout,kk) = hhvaroute(ii,inum1,kk) +
8583
* hhvaroute(ii,inum2,kk)
8684
end do
8785
end do
86+
87+
DO K = 1, nstep
88+
QHY(K,ihout,IHX(1))=QHY(K,inum1,IHX(1))+QHY(K,inum2,IHX(1)) !flood routing jaehak 2017
89+
END DO
90+
8891
endif
8992

9093
do ii = 29, mvaro

‎src/albedo.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ subroutine albedo
3636
use parm
3737

3838
integer :: j
39-
real :: cej, eaj
39+
real*8 :: cej, eaj
4040

4141
j = 0
4242
j = ihru

‎src/allocate_parms.f

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1173,6 +1173,9 @@ subroutine allocate_parms
11731173
allocate (pnd_cla(mhru))
11741174
allocate (pnd_sag(mhru))
11751175
allocate (pnd_lag(mhru))
1176+
1177+
allocate (twlpnd(mhru)) !!srini pond/wet infiltration to shallow gw storage
1178+
allocate (twlwet(mhru)) !!srini pond/wet infiltration to shallow gw storage
11761179

11771180
allocate (pnd_solp(mhru))
11781181
allocate (pnd_solpg(mhru))
@@ -1740,8 +1743,8 @@ subroutine allocate_parms
17401743
!! LID simulations
17411744
!! Common variable
17421745
!! van Genuchten equation's coefficients
1743-
allocate(lid_vgcl,lid_vgcm,lid_qsurf_total,
1744-
& lid_farea_sum)
1746+
! allocate(lid_vgcl,lid_vgcm,lid_qsurf_total,
1747+
! & lid_farea_sum)
17451748
allocate(lid_cuminf_last(mhru,4),lid_sw_last(mhru,4),
17461749
& interval_last(mhru,4),lid_f_last(mhru,4),lid_cumr_last(mhru,4),
17471750
& lid_str_last(mhru,4),lid_farea(mhru,4),lid_qsurf(mhru,4),
@@ -1881,6 +1884,10 @@ subroutine allocate_parms
18811884
tillage_factor = 0.
18821885
!! By Zhang for C/N cycling
18831886
!! ============================
1887+
1888+
!FLOOD ROUTING
1889+
allocate(QHY(nstep+1,mhyd,4), NHY(4*msub))
1890+
allocate(RCHX(msub),RCSS(msub),QCAP(msub),CHXA(msub),CHXP(msub))
18841891
18851892
call zero0
18861893
call zero1

‎src/alph.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -70,7 +70,7 @@ subroutine alph(iwave)
7070

7171
integer, intent (in) :: iwave
7272
integer :: j, k, kk, jj
73-
real :: ab, ajp, preceff, rainsum
73+
real*8 :: ab, ajp, preceff, rainsum
7474

7575
j = 0
7676
j = ihru

‎src/anfert.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -167,9 +167,9 @@ subroutine anfert
167167

168168
use parm
169169

170-
real, parameter :: rtoaf = 0.50
170+
real*8, parameter :: rtoaf = 0.50
171171
integer :: j, ly, ifrt
172-
real :: tsno3, tpno3, dwfert, xx, targn, tfp
172+
real*8 :: tsno3, tpno3, dwfert, xx, targn, tfp
173173

174174
j = 0
175175
j = ihru

‎src/apex_day.f

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -178,12 +178,12 @@ subroutine apex_day
178178

179179
if (ievent > 0) then
180180
do ii = 1, nstep
181-
hhvaroute(2,ihout,ii) = flodaya(inum1) / real(nstep)
182-
hhvaroute(3,ihout,ii) = seddaya(inum1) / real(nstep)
183-
hhvaroute(4,ihout,ii) = orgndaya(inum1) / real(nstep)
184-
hhvaroute(5,ihout,ii) = orgpdaya(inum1) / real(nstep)
185-
hhvaroute(6,ihout,ii) = no3daya(inum1) / real(nstep)
186-
hhvaroute(7,ihout,ii) = minpdaya(inum1) / real(nstep)
181+
hhvaroute(2,ihout,ii) = flodaya(inum1) / dfloat(nstep)
182+
hhvaroute(3,ihout,ii) = seddaya(inum1) / dfloat(nstep)
183+
hhvaroute(4,ihout,ii) = orgndaya(inum1) / dfloat(nstep)
184+
hhvaroute(5,ihout,ii) = orgpdaya(inum1) / dfloat(nstep)
185+
hhvaroute(6,ihout,ii) = no3daya(inum1) / dfloat(nstep)
186+
hhvaroute(7,ihout,ii) = minpdaya(inum1) / dfloat(nstep)
187187

188188
end do
189189
end if

‎src/apply.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ subroutine apply
6464
use parm
6565

6666
integer :: j, kk, k, jj
67-
real :: xx, gc
67+
real*8 :: xx, gc
6868

6969
j = 0
7070
j = ihru

‎src/ascrv.f

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -44,10 +44,10 @@ subroutine ascrv(x1,x2,x3,x4,x5,x6)
4444
!! Intrinsic: Log
4545

4646
!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
47-
real :: xx
47+
real*8 :: xx
4848

49-
real, intent (in) :: x1, x2, x3, x4
50-
real, intent (out) :: x5, x6
49+
real*8, intent (in) :: x1, x2, x3, x4
50+
real*8, intent (out) :: x5, x6
5151

5252
xx = 0.0
5353
x5 = 0.0

‎src/atri.f

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
function atri(at1,at2,at3,at4i)
1+
function atri(at1,at2,at3,at4i) result (r_atri)
22

33
!! ~ ~ ~ PURPOSE ~ ~ ~
44
!! this function generates a random number from a triangular distribution
@@ -39,10 +39,12 @@ function atri(at1,at2,at3,at4i)
3939

4040
!! ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~
4141

42-
real, intent (in) :: at1, at2, at3
42+
use parm
43+
44+
real*8, intent (in) :: at1, at2, at3
4345
integer, intent (in out) :: at4i
44-
real :: u3, rn, y, b1, b2, x1, xx, yy, amn
45-
real :: atri
46+
real*8 :: u3, rn, y, b1, b2, x1, xx, yy, amn
47+
real*8 :: r_atri
4648

4749
u3 = 0.
4850
rn = 0.
@@ -68,22 +70,22 @@ function atri(at1,at2,at3,at4i)
6870
else
6971
yy = Sqrt(xx)
7072
end if
71-
atri = yy + at1
73+
r_atri = yy + at1
7274
else
7375
xx = b2 * b2 - 2.0 * b2 * (b1 - 0.5 * u3)
7476
if (xx <= 0.) then
7577
yy = 0.
7678
else
7779
yy = Sqrt(xx)
7880
end if
79-
atri = at3 - yy
81+
r_atri = at3 - yy
8082
end if
8183

8284
amn = (at3 + at2 + at1) / 3.0
83-
atri = atri * at2 / amn
85+
r_atri = r_atri * at2 / amn
8486

85-
if (atri >= 1.0) atri = 0.99
86-
if (atri <= 0.0) atri = 0.001
87+
if (r_atri >= 1.0) r_atri = 0.99
88+
if (r_atri <= 0.0) r_atri = 0.001
8789

8890
return
8991
end

‎src/aunif.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
real function aunif (x1) result (unif)
1+
real*8 function aunif (x1) result (unif)
22

33
!! ~ ~ ~ PURPOSE ~ ~ ~
44
!! This function generates random numbers ranging from 0.0 to 1.0.

‎src/autoirr.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,7 @@ subroutine autoirr
7878
use parm
7979

8080
integer :: j, k
81-
real :: vmma, vmm, cnv, vol, vmms, vmmd
81+
real*8 :: vmma, vmm, cnv, vol, vmms, vmmd
8282

8383
j = 0
8484
j = ihru
@@ -152,7 +152,7 @@ subroutine autoirr
152152
vmma = vol * (shallst(k) * cnv / vmms)
153153
end if
154154
vmma = vmma / cnv
155-
vmma = vmma / irr_eff(k)
155+
vmma = vmma / irr_eff(j)
156156
shallst(k) = shallst(k) - vmma
157157
if (shallst(k) < 0.) then
158158
vmma = vmma + shallst(k)

‎src/bacteria.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ subroutine bacteria
150150
use parm
151151

152152
integer :: j
153-
real :: bpq, blpq, bps, blps, wt1, cbact, xx
153+
real*8 :: bpq, blpq, bps, blps, wt1, cbact, xx
154154

155155
j = 0
156156
j = ihru

‎src/biofilm.f

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -129,16 +129,16 @@ subroutine biofilm
129129
use parm
130130

131131
integer :: jrch
132-
real :: wtrin, chlin, algin, orgnin, ammoin, nitratin, nitritin
133-
real :: orgpin, dispin, cbodin, disoxin, tday, wtmp, fll, gra
134-
real :: lambda, fnn, fpp, algi, fl_1, xx, yy, zz, ww, cinn
135-
real :: uu, vv, cordo, f1, algcon, orgncon, nh3con, no2con, no3con
136-
real :: orgpcon, solpcon, cbodcon, o2con, wtrtot, bc1mod, bc2mod
137-
real :: thgra = 1.047, thrho = 1.047, thrs1 = 1.024
138-
real :: thrs2 = 1.074, thrs3 = 1.074, thrs4 = 1.024, thrs5 = 1.024
139-
real :: thbc1 = 1.083, thbc2 = 1.047, thbc3 = 1.047, thbc4 = 1.047
140-
real :: thrk1 = 1.047, thrk2 = 1.024, thrk3 = 1.024, thrk4 = 1.060
141-
! real :: thrk5 = 1.047, thrk6 = 1.0, thrs6 = 1.024, thrs7 = 1.0
132+
real*8 :: wtrin, chlin, algin, orgnin, ammoin, nitratin, nitritin
133+
real*8 :: orgpin, dispin, cbodin, disoxin, tday, wtmp, fll, gra
134+
real*8 :: lambda, fnn, fpp, algi, fl_1, xx, yy, zz, ww, cinn
135+
real*8 :: uu, vv, cordo, f1, algcon, orgncon, nh3con, no2con, no3con
136+
real*8 :: orgpcon, solpcon, cbodcon, o2con, wtrtot, bc1mod, bc2mod
137+
real*8 :: thgra = 1.047, thrho = 1.047, thrs1 = 1.024
138+
real*8 :: thrs2 = 1.074, thrs3 = 1.074, thrs4 = 1.024, thrs5 = 1.024
139+
real*8 :: thbc1 = 1.083, thbc2 = 1.047, thbc3 = 1.047, thbc4 = 1.047
140+
real*8 :: thrk1 = 1.047, thrk2 = 1.024, thrk3 = 1.024, thrk4 = 1.060
141+
! real*8 :: thrk5 = 1.047, thrk6 = 1.0, thrs6 = 1.024, thrs7 = 1.0
142142

143143
jrch = 0
144144
jrch = inum1
@@ -185,7 +185,7 @@ subroutine biofilm
185185
solpcon = 0.
186186
cbodcon = 0.
187187
o2con = 0.
188-
rch_cbod(jrch) = amax1(1.e-6,rch_cbod(jrch))
188+
rch_cbod(jrch) = dmax1(1.e-6,rch_cbod(jrch))
189189
wtrtot = wtrin + rchwtr
190190
algcon = (algin * wtrin + algae(jrch) * rchwtr) / wtrtot
191191
orgncon = (orgnin * wtrin + organicn(jrch) * rchwtr) / wtrtot
@@ -357,7 +357,7 @@ subroutine biofilm
357357
rch_dox(jrch) = 0.
358358
rch_dox(jrch) = o2con + (uu + vv - ww - xx - yy - zz) * tday
359359
if (rch_dox(jrch) < 1.e-6) rch_dox(jrch) = 0.
360-
if (rch_dox(jrch) > dcoef * o2con) rch_dox(jrch) = dcoef * o2con
360+
if (rch_dox(jrch) > dcoef * o2con) rch_dox(jrch) = dcoef * o2con
361361
!! end oxygen calculations
362362

363363
!! nitrogen calculations

‎src/biozone.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,7 @@ subroutine biozone()
125125
use parm
126126
implicit none
127127

128-
! real ntr_rt
128+
! real*8 ntr_rt
129129
integer bz_lyr, isp, ii,j,nly
130130
real*8 bz_vol, rtrate,bodconc, qin, qout,qmm,qvol,pormm,rplqm
131131
real*8 ntr_rt,dentr_rt, bod_rt, fcoli_rt,rtof,xx,bodi,bode

‎src/bmp_det_pond.f

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
subroutine det_pond
1+
subroutine bmp_det_pond
22

33
!! ~ ~ ~ PURPOSE ~ ~ ~
44
!! the purpose of this program is to read in data from the detention pond
@@ -51,7 +51,7 @@ subroutine det_pond
5151

5252
character (len=80) :: titldum
5353
integer :: ii, k, sb
54-
real :: qin,qout,qpnd,qpnd_last,sedin,sedout,sedpnd,spndconc,
54+
real*8 :: qin,qout,qpnd,qpnd_last,sedin,sedout,sedpnd,spndconc,
5555
& qdepth,sedpnd_last,
5656
& watdepact,qstage,backup_length,seep_sa,evap_sa,pcp_vol,
5757
& evap_vol,seep_vol,warea,pi,qovmax,qaddon,depaddon
@@ -224,4 +224,4 @@ subroutine det_pond
224224
dtp_ivol(sb) = qpnd !m^3
225225
dtp_ised(sb) = sedpnd !tons
226226

227-
end subroutine
227+
end subroutine bmp_det_pond

‎src/bmp_ri_pond.f

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
subroutine ri_pond(kk,riflw,rised)
1+
subroutine bmp_ri_pond(kk,riflw,rised)
22

33
!! ~ ~ ~ PURPOSE ~ ~ ~
44
!! this subroutine routes water through a retention irrigation pond in the subbasin
@@ -36,12 +36,12 @@ subroutine ri_pond(kk,riflw,rised)
3636
implicit none
3737

3838
integer :: sb, kk, ii
39-
real :: tsa,mxvol,pdia,ksat,dp,sub_ha,mxh,hweir,phead,pipeflow
40-
real :: qin,qout,qpnd,sweir,hpnd,qet
41-
real :: qweir, qseep,qpipe,qpndi,decayexp,splw,qpump
42-
real :: sedconc,sedpndi, sedpnde,ksed,td,sedpump
43-
real, dimension(4,0:nstep), intent(in out) :: riflw,rised
44-
real, dimension(0:nstep) :: inflw,insed,outflw,outsed
39+
real*8 :: tsa,mxvol,pdia,ksat,dp,sub_ha,mxh,hweir,phead,pipeflow
40+
real*8 :: qin,qout,qpnd,sweir,hpnd,qet
41+
real*8 :: qweir, qseep,qpipe,qpndi,decayexp,splw,qpump
42+
real*8 :: sedconc,sedpndi, sedpnde,ksed,td,sedpump
43+
real*8, dimension(4,0:nstep), intent(in out) :: riflw,rised
44+
real*8, dimension(0:nstep) :: inflw,insed,outflw,outsed
4545

4646
sb = inum1
4747
sub_ha = da_ha * sub_fr(sb)
@@ -135,4 +135,4 @@ subroutine ri_pond(kk,riflw,rised)
135135
ri_sedi(sb,kk) = sedpnde
136136

137137
return
138-
end subroutine
138+
end subroutine bmp_ri_pond

0 commit comments

Comments
 (0)