readmgt.f

水文模型的原始代码

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    day         |none          |day operation occurs
!!    husc        |none          |heat unit scheduling for operation expressed
!!                               |as fraction of total heat units of crop
!!                               |at maturity
!!    icf         |none          |number of continuous fertilizer operation
!!                               |in year
!!    ifn         |none          |number of fertilizer application in year
!!    igr         |none          |number of grazing operation in year
!!    inop        |none          |number of tillage operation in year
!!    iro         |none          |counter for years of rotation
!!    j           |none          |counter
!!    lcr         |none          |crop id number
!!    mgt_op      |none          |operation code number
!!                               |0 end of rotation year
!!                               |1 plant/beginning of growing season
!!                               |2 irrigation operation
!!                               |3 fertilizer application
!!                               |4 pesticide application
!!                               |5 harvest and kill operation
!!                               |6 tillage operation
!!                               |7 harvest only operation
!!                               |8 kill/end of growing season
!!                               |9 grazing operation
!!                               |10 auto irrigation initialization
!!                               |11 auto fertilizer initialization
!!                               |12 street sweeping operation
!!                               |13 release/impound operation
!!                               |14 continuous fertilization operation
!!    mgt1i       |none          |first management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt2i       |none          |second management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt3i       |none          |third management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt4        |none          |fourth management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt5        |none          |fifth management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt6        |none          |sixth management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt7        |none          |seventh management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt8        |none          |eighth management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mgt9        |none          |ninth management parameter out of .mgt
!!                               |file (definition changes depending on
!!                               |mgt_op)
!!    mon         |none          |month operation occurs
!!    nafer       |none          |number of auto fertilization operation in
!!                               |year
!!    nairr       |none          |number of auto irrigation operation in year
!!    ncrp        |none          |land cover identification number 
!!                               |(from crop.dat). Need only if IGRO=1.
!!    newpest     |none          |pesticide flag
!!    nhv         |none          |number of harvest and kill operation in
!!                               |year
!!    nhvo        |none          |number of harvest operation in year
!!    nir         |none          |number of irrigation operation in year
!!    nkill       |none          |number of kill operation in year
!!    npl         |none          |number of planting operation in year
!!    npst        |none          |number of pesticide application in year
!!    nrel        |none          |number of release/impound operations in year
!!    nsw         |none          |number of street sweeping operation in year
!!    titldum     |NA            |title line from input dataset
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

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

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

      use parm

      character (len=80) :: titldum
      integer :: ncrp, iro, npl, mon, day, mgt_op, mgt2i, mgt1i, lcr
      integer :: nir, ifn, npst, j, nhv, inop, nhvo, nkill, newpest
      integer :: igr, nairr, nafer, nsw, nrel, icf, mgt3i
      real :: husc, mgt6, mgt9, mgt4, mgt5, mgt7, mgt8
      real :: disc

      lcr = 0
      ncrp = 0
      npl = 1 
      nir = 0
      ifn = 0
      npst = 0
      nhv = 1
      inop = 0
      nhvo = 0
      nkill = 1
      icf = 0
      icp = 0
      igr = 0
      nairr = 1
      nafer = 0
      nsw = 0
      nrel = 0
      igrow = 0

!!    read general management parameters
      read (109,5000) titldum
      read (109,*) nmgt(ihru)
      read (109,5000) titldum
      read (109,*) igro(ihru)
      read (109,*) ncrp
      read (109,*) laiday(ihru)
      read (109,*) bio_ms(ihru)
      read (109,*) phu_plt(1,1,ihru)
      read (109,5000) titldum
!     read (109,*) curyr_mat(ihru)
      read (109,*) biomix(ihru)
      read (109,*) cn2(ihru)
      read (109,*) usle_p(ihru)
      read (109,*) bio_min(ihru)
      read (109,*) filterw(ihru)
      read (109,5000) titldum
      read (109,*) iurban(ihru)
      read (109,*) urblu(ihru)
      read (109,5000) titldum
      read (109,*) irrsc(ihru)
      read (109,*) irrno(ihru)
      read (109,*) flowmin(ihru)
      read (109,*) divmax(ihru)
      read (109,*) flowfr(ihru)
      read (109,5000) titldum
      read (109,*) ddrain(ihru)
      read (109,*) tdrain(ihru)
      read (109,*) gdrain(ihru)
      read (109,5000) titldum
      read (109,*) nrot(ihru)
      read (109,5000) titldum

!!    set pothole trigger
      if (ipot(ihru) == ihru) then
        do irot = 1, nrot(ihru)
          imp_trig(irot,1,ihru) = 0
        end do
      end if

!!    set default values
      if (cn2(ihru) <= 35.0) cn2(ihru) = 35.0
      if (cn2(ihru) >= 98.0) cn2(ihru) = 98.0
      if (usle_p(ihru) <= 0.0) usle_p(ihru) = 0.0
      if (usle_p(ihru) >= 1.0) usle_p(ihru) = 1.0
      if (biomix(ihru) <= 0.) biomix(ihru) = .2
      if (iurban(ihru) == 2 .and. urblu(ihru) <= 0) urblu(ihru) = 1
      if (irrsc(ihru) <= 0) irrsc(ihru) = 5
      if (irrno(ihru) <= 0) irrno(ihru) = ihru
      if (flowfr(ihru) <= 0.) flowfr(ihru) = 1.0
      if (ddrain(ihru) > .001) then 
        if (tdrain(ihru) <= .001) tdrain(ihru) = 24.
        if (gdrain(ihru) <= .001) gdrain(ihru) = 96.
      end if 

!!    set values for cover/crop already growing
      if (igro(ihru) == 1) then
        igrow = 1
        idplt(1,1,ihru) = ncrp
        idplt(1,2,ihru) = ncrp
        lcr = ncrp
        phuacc(ihru) = .1
        npl = 1
        nhv = 0
        !! calculate tnylda for autofertilization 
        if (hvsti(ncrp) < 1.) then
          tnylda(1,1,ihru) = 350. * cnyld(ncrp) * bio_e(ncrp)
        else
          tnylda(1,1,ihru) = 1000. * cnyld(ncrp) * bio_e(ncrp)
        endif
      end if

!!    Set curve number for urban disconnected impervious areas and pervious
!!    areas. This assumes CN2 given in mgt file is for pervious area only
      if (iurban(ihru) > 0) then
        disc = 0.
        disc = fimp(urblu(ihru)) - fcimp(urblu(ihru))
        if (fimp(urblu(ihru)) < 0.30) then
          cn2(ihru) = cn2(ihru) + fimp(urblu(ihru)) *                   &
     &                      (urbcn2(urblu(ihru)) - cn2(ihru)) *         &
     &                               (1. - disc/(2.* fimp(urblu(ihru))))
        else
          cn2(ihru) = cn2(ihru) + fimp(urblu(ihru)) *                   &
     &                                 (urbcn2(urblu(ihru)) - cn2(ihru))
        endif
      endif

!!    Filter strip calculations
      if (filterw(ihru) > 0.) then
        fsred(ihru) = 1. - ((12. + 4.5 * filterw(ihru)) / 100.)
        trapeff(ihru) = 0.367 * filterw(ihru)**0.2967
      else
        fsred(ihru) = 1.
        trapeff(ihru) = 0.
      endif
      fsred(ihru) = Min(fsred(ihru), 1.)
      fsred(ihru) = Max(fsred(ihru), 0.)
      trapeff(ihru) = Min(trapeff(ihru), 1.)
      trapeff(ihru) = Max(trapeff(ihru), 0.)

!!    If years of rotation are set to zero, assume continuous fallow. For
!!    continuous fallow, no management practices allowed.
      if (nrot(ihru) > 0) then

!!      read scheduled management practices
        do iro = 1, nrot(ihru)

          do
          mon = 0
          day = 0
          husc = 0.
          mgt_op = 0
          mgt1i = 0
          mgt2i = 0
          mgt3i = 0.
          mgt4 = 0.
          mgt5 = 0.
          mgt6 = 0
          mgt7 = 0.
          mgt8 = 0.
          mgt9 = 0.

          read (109,5200) mon, day, husc, mgt_op, mgt1i, mgt2i, mgt3i,  &
     &                   mgt4, mgt5, mgt6, mgt7, mgt8, mgt9
 

          select case (mgt_op)

          case (0)  !! end of rotation year

            !! this defines a crop for the model to recognize between harvest
            !! and the end of the year. The model does not simulate growth
            !! of the crop--it is needed to set parameters in erosion processes
            idplt(iro+1,1,ihru) = lcr

            !! the following equations set values for fallow years
            if (idplt(iro,1,ihru) == 0) idplt(iro,1,ihru) = lcr
            if (phu_plt(iro,1,ihru) == 0.)                              &
     &                         phu_plt(iro,1,ihru) = phu_plt(iro,2,ihru)

            !! re-initialize annual counters
            npl = 1
            if (igrow == 1) then
              nhv = 0