readbsn.f

水文模型的原始代码

!!                               |foliage.
!!    wdpq        |1/day         |Die-off factor for persistent bacteria in 
!!                               |soil solution.
!!    wdprch      |1/day         |Die-off factor for persistent bacteria in
!!                               |streams
!!    wdpres      |1/day         |Die-off factor for persistent bacteria in
!!                               |reservoirs
!!    wdps        |1/day         |Die-off factor for persistent bacteria
!!                               |adsorbed to soil particles.
!!    wglpf       |1/day         |Growth factor for less persistent bacteria on
!!                               |foliage
!!    wglpq       |1/day         |Growth factor for less persistent bacteria in
!!                               |soil solution.
!!    wglps       |1/day         |Growth factor for less persistent bacteria
!!                               |adsorbed to soil particles.
!!    wgpf        |1/day         |Growth factor for persistent bacteria on
!!                               |foliage.
!!    wgpq        |1/day         |Growth factor for persistent bacteria in soil
!!                               |solution.
!!    wgps        |1/day         |Growth factor for persistent bacteria
!!                               |adsorbed to soil particles.
!!    wof_lp      |none          |Wash off fraction for less persistent
!!                               |bacteria on foliage during a rainfall event
!!    wof_p       |none          |Wash off fraction for persistent bacteria on
!!                               |foliage during a rainfall event
!!    wlpq20      |1/day         |Overall rate change for less persistent
!!                               |bacteria in soil solution.
!!    wlps20      |1/day         |Overall rate change for less persistent
!!                               |bacteria adsorbed to soil particles.
!!    wp20lp_plt  |1/day         |Overall rate change for less persistent bacteria
!!                               |on foliage
!!    wp20p_plt   |1/day         |Overall rate change for persistent bacteria on
!!                               |foliage
!!    wpq20       |1/day         |Overall rate change for persistent bacteria in
!!                               |soil solution.
!!    wps20       |1/day         |Overall rate change for persistent bacteria
!!                               |adsorbed to soil particles.
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    eof         |none          |end of file flag (=-1 if eof, else =0)
!!    epcobsn     |none          |plant water uptake compensation factor (0-1)
!!    escobsn     |none          |soil evaporation compensation factor (0-1)
!!    titldum     |NA            |title line for .bsn file, not used
!!    wwqfile     |NA            |name of watershed water quality file (.wwq)
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
!!    SWAT: ascrv

!!    ~ ~ ~ ~ ~ ~ END SPECIFICATIONS ~ ~ ~ ~ ~ ~


      use parm

      character (len=80) :: titldum
      character (len=13) :: wwqfile
      integer :: eof
      real :: escobsn, epcobsn

!!    initialize variables
      eof = 0
      escobsn = 0.
      epcobsn = 0.
      wwqfile = ""

!! read basin parameters
      do
      read (103,1000) titldum
      read (103,1000) titldum
      read (103,1000) titldum
      read (103,*) sftmp
      read (103,*) smtmp
      read (103,*) smfmx
      read (103,*) smfmn
      read (103,*) timp
      read (103,*) snocovmx
      read (103,*) sno50cov
      read (103,*) ipet
      read (103,1000) petfile
      read (103,*) escobsn
      read (103,*) epcobsn
      read (103,*) evlai
      read (103,*) ffcb
      read (103,1000) titldum
      read (103,*) ievent
      read (103,*) icrk
      read (103,*) surlag
      read (103,*) adj_pkr
      read (103,*) prf
      read (103,*) spcon
      read (103,*) spexp
      read (103,1000) titldum
      read (103,*) rcn
      read (103,*) cmn
      read (103,*) n_updis
      read (103,*) p_updis
      read (103,*) nperco
      read (103,*) pperco
      read (103,*) phoskd
      read (103,*) psp
      read (103,*) rsdco
      read (103,1000) titldum
      read (103,*) percop
      read (103,1000) titldum
      read (103,*) isubwq
      read (103,1000) titldum
      read (103,*) wdpq
      read (103,*) wgpq
      read (103,*) wdlpq
      read (103,*) wglpq
      read (103,*) wdps
      read (103,*) wgps
      read (103,*) wdlps
      read (103,*) wglps
      read (103,*) bactkdq
      read (103,*) thbact
      read (103,*) wof_p
      read (103,*) wof_lp
      read (103,*) wdpf
      read (103,*) wgpf
      read (103,*) wdlpf
      read (103,*) wglpf
      read (103,1001) ised_det
      read (103,1000) titldum
      read (103,*) irte
      read (103,*) msk_co1
      read (103,*) msk_co2
      read (103,*) msk_x
      read (103,*) ideg
      read (103,*) iwq
      read (103,1000) wwqfile
      read (103,*) trnsrch
      read (103,*) evrch
      read (103,*) irtpest
      read (103,*) icn
      read (103,*) cncoef
      read (103,*) cdn
      read (103,*) sdnco
      read (103,*) bact_swf
      read (103,*,iostat=eof) bactmx
      if (eof < 0) exit
      read (103,*,iostat=eof) bactminlp
      if (eof < 0) exit
      read (103,*,iostat=eof) bactminp
      if (eof < 0) exit
      read (103,*,iostat=eof) wdlprch
      if (eof < 0) exit
      read (103,*,iostat=eof) wdprch
      if (eof < 0) exit
      read (103,*,iostat=eof) wdlpres
      if (eof < 0) exit
      read (103,*,iostat=eof) wdpres
      if (eof < 0) exit
      read (103,*,iostat=eof) tb_adj
      if (eof < 0) exit
      read (103,*,iostat=eof) depimp_bsn
      if (eof < 0) exit
      read (103,*,iostat=eof) ddrain_bsn
      if (eof < 0) exit
      read (103,*,iostat=eof) tdrain_bsn
      if (eof < 0) exit
      read (103,*,iostat=eof) gdrain_bsn
      if (eof < 0) exit
      read (103,*,iostat=eof) cn_froz
      if (eof < 0) exit
      read (103,*,iostat=eof) dorm_hr
      if (eof < 0) exit
      exit
      end do

!!    copy global values to local HRUs
      esco = escobsn
      epco = epcobsn

!!    set default values for undefined parameters
      if (depimp_bsn <= 1.e-6) depimp_bsn = 6000.
      if (bact_swf <= 1.e-6) bact_swf = 0.15
      if (adj_pkr <= 0.) adj_pkr = 1.
      if (spcon <= 0.) spcon = .0001
      if (spexp <= 0.) spexp = 1.0
      if (prf <= 0.) prf = 1.0
      if (percop <= 0.) percop = .5
      if (n_updis <= 0.) n_updis = 20.
      if (p_updis <= 0.) p_updis = 20.
      if (nperco <= 0.) nperco = .20
      if (pperco <= 0.) pperco = 10.
      if (rsdco <= 0.) rsdco = .05
      if (phoskd <= 0.) phoskd = 175.
      if (psp <= 0.) psp = 0.4
      if (cmn <= 0.) cmn = .0003
      if (smfmx <= 0.) smfmx = 4.5
      if (smfmn <= 0.) smfmn = 4.5
      if (timp <= 0.) timp = 1.0
      if (snocovmx <= 0.) snocovmx = 1.0
      if (sno50cov <= 0.) sno50cov = .5
      if (rcn <= 0.) rcn = 1.
      if (surlag <= 0.) surlag = 4.
      if (evrch <= 0.) evrch = 0.6
      if (bactkdq <= 0.) bactkdq = 75.
      if (thbact <= 0.) thbact = 1.07
      if (msk_x <= 0.) msk_x = 0.2
      if (evlai <= 0.) evlai = 3.0
      if (cncoef <= 0.) cncoef = 1.0
      if (cdn <= 0.) cdn = 1.4
      if (sdnco <= 0.) sdnco = 1.10
      if (bactmx <= 0.) bactmx = 10.
      if (bactminlp <= 0.) bactminlp = .0
      if (bactminp <= 0.) bactminp = 0.
      if (cn_froz <= 0.) cn_froz = .000862

      call caps(petfile)
      call caps(wwqfile)
      open (101,file=wwqfile)

!!    calculate normalization parameters for water, nitrogen, and
!!    phosphorus uptake
      uobn = 0.0
      uobp = 0.0
      uobw = 0.0
      ubw = 10.0       !! the uptake distribution for water is hardwired
                       !! users are not allowed to modify the water
                       !! water uptake distribution
      uobw = 1. - exp(-ubw)
      uobn = 1. - exp(-n_updis)
      uobp = 1. - exp(-p_updis)

!!    determine the shape parameters for the equation which describes area of
!!    snow cover as a function of amount of snow
      call ascrv(.5,.95,sno50cov,.95,snocov1,snocov2)

!!    calculate additional bacteria parameters
      wp20p_plt = wdpf - wgpf
      wp20lp_plt = wdlpf - wglpf
      wpq20 = wdpq - wgpq
      wlpq20 = wdlpq - wglpq
      wps20 = wdps - wgps
      wlps20 = wdlps - wglps

!!    initialize variables (may make these .bsn inputs for user adjustment
!!    at some future time)
      nactfr = 0.02

      
      close (103)
      return
 1000 format (a)
 1001 format (i4)
      end