hruday.f

水文模型的原始代码

!!    surqno3(:)    |kg N/ha       |amount of NO3-N in surface runoff in HRU for
!!                                 |the day
!!    surqsolp(:)   |kg P/ha       |amount of soluble phosphorus in surface
!!                                 |runoff in HRU for the day
!!    tloss         |mm H2O        |amount of water removed from surface runoff
!!                                 |via transmission losses on day in HRU
!!    tmn(:)        |deg C         |minimum temperature for the day in HRU
!!    tmpav(:)      |deg C         |average temperature for the day in HRU
!!    tmx(:)        |deg C         |maximum temperature for the day in HRU
!!    usle          |metric tons   |daily soil loss predicted with USLE equation
!!    wdntl         |kg N/ha       |amount of nitrogen lost from nitrate pool
!!                                 |by denitrification in soil profile on
!!                                 |current day in HRU
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    ii          |none          |counter
!!    j           |none          |HRU number
!!    pdvas(:)    |varies        |array to hold HRU output values
!!    pdvs(:)     |varies        |array to hold selected HRU output values
!!                               |when user doesn't want to print all
!!    sb          |none          |subbasin number
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

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

      use parm

      integer :: j, sb, ii, iflag
      real, dimension (mhruo) :: pdvas, pdvs
      character (len=4) :: cropname

      j = 0
      sb = 0
      j = ihru
      sb = inum1
      
      iflag = 0
      do ii = 1, itoth
        if (ipdhru(ii) == j) iflag = 1
      end do
      if (iflag == 0) return

      pdvas = 0.
      pdvs = 0.

      pdvas(1) = subp(j)
      pdvas(2) = snofall
      pdvas(3) = snomlt
      pdvas(4) = aird(j)
      pdvas(5) = pet_day
      pdvas(6) = etday
      pdvas(7) = sol_cnsw(j)
      pdvas(8) = sol_sw(j)
      pdvas(9) = sepbtm(j)
      pdvas(10) = rchrg(j)
      pdvas(11) = gwseep
      pdvas(12) = revapday
      pdvas(13) = shallirr(j)
      pdvas(14) = deepirr(j)
      pdvas(15) = shallst(j)
      pdvas(16) = deepst(j)
      pdvas(17) = surfq(j)
      pdvas(18) = qday + tloss
      pdvas(19) = tloss
      pdvas(20) = latq(j)
      pdvas(21) = gw_q(j)
      pdvas(22) = qdr(j)
      pdvas(23) = cnday(j)
      pdvas(24) = tmpav(j)
      pdvas(25) = tmx(j)
      pdvas(26) = tmn(j)
      pdvas(27) = sol_tmp(2,j)
      pdvas(28) = hru_ra(j)
      pdvas(29) = sedyld(j) / hru_ha(j)
      pdvas(30) = usle
      pdvas(31) = fertn
      pdvas(32) = fertp
      pdvas(33) = auton
      pdvas(34) = autop
      pdvas(35) = grazn
      pdvas(36) = grazp
      pdvas(37) = cfertn
      pdvas(38) = cfertp
      pdvas(39) = no3pcp
      pdvas(40) = fixn
      pdvas(41) = rmn2tl
      pdvas(42) = hmntl
      pdvas(43) = rwntl
      pdvas(44) = rmptl
      pdvas(45) = hmptl
      pdvas(46) = rmp1tl
      pdvas(47) = roctl
      pdvas(48) = wdntl
      pdvas(49) = nplnt(j)
      pdvas(50) = pplnt(j)
      pdvas(51) = sedorgn(j)
      pdvas(52) = sedorgp(j)
      pdvas(53) = sedminpa(j) + sedminps(j)
      pdvas(54) = surqno3(j)
      pdvas(55) = latno3(j)
      pdvas(56) = percn(j)
      pdvas(57) = no3gw(j)
      pdvas(58) = surqsolp(j)
      pdvas(59) = minpgw(j)
      pdvas(60) = (1.-strsw(j))
      pdvas(61) = (1.-strstmp(j))
      pdvas(62) = (1.-strsn(j))
      pdvas(63) = (1.-strsp(j))
      pdvas(64) = bio_ms(j)
      pdvas(65) = laiday(j)
      pdvas(66) = 0.0       !!yield only defined at annual and average annual
      pdvas(67) = bactrop + bactsedp
      pdvas(68) = bactrolp + bactsedlp

      if (ipdvas(1) > 0) then
        do ii = 1, itots
          pdvs(ii) = pdvas(ipdvas(ii))
        end do

      idum = idplt(nro(j),icr(j),j)
      if (idum > 0) then
        cropname = cpnm(idum)
      else
        cropname = "NOCR"
      endif

        if (iscen == 1) then
!       write (3,1000) cpnm(idplt(nro(j),icr(j),j)), j, hrugis(j), sb,  &
        write (3,1000) cropname, j, hrugis(j), sb,                      &
     &               nmgt(j), iida, hru_km(j), (pdvs(ii), ii = 1, itots)
        else if (isproj == 1) then
!       write (21,1000) cpnm(idplt(nro(j),icr(j),j)), j, hrugis(j), sb, &
        write (21,1000) cropname, j, hrugis(j), sb,                     &
     &               nmgt(j), iida, hru_km(j), (pdvs(ii), ii = 1, itots)
        end if
      else
        if (iscen == 1) then
!       write (3,1000) cpnm(idplt(nro(j),icr(j),j)), j, hrugis(j), sb,  &
        write (3,1000) cropname, j, hrugis(j), sb,                      &
     &              nmgt(j), iida, hru_km(j), (pdvas(ii), ii = 1, mhruo)
        else if (isproj == 1) then
!       write (21,1000) cpnm(idplt(nro(j),icr(j),j)), j, hrugis(j), sb, &
        write (21,1000) cropname, j, hrugis(j), sb,                     &
     &              nmgt(j), iida, hru_km(j), (pdvas(ii), ii = 1, mhruo)
        end if
      end if

      return
 1000 format (a4,i4,1x,i8,1x,i4,1x,i4,1x,i4,e10.5,69f10.3)
      end