writeaa.f

水文模型的原始代码

!!    basorgpf    |kg P/ha       |final average amount of phosphorus in
!!                               |the organic P pool in watershed soil
!!    bio_aahv(:,:,:)|kg/ha         |harvested biomass of plant
!!    resdata(1)  |mm H2O        |average annual evaporation from reservoirs
!!                               |in watershed
!!    resdata(2)  |mm H2O        |average annual seepage from reservoirs in
!!                               |watershed
!!    resdata(3)  |mm H2O        |average annual precipitation on reservoirs
!!                               |in watershed
!!    resdata(4)  |mm H2O        |average annual amount of water transported
!!                               |into reservoirs in watershed
!!    resdata(5)  |metric tons/ha|average annual amount of sediment transported
!!                               |into reservoirs in watershed
!!    resdata(6)  |mm H2O        |average annual amount of water transported
!!                               |out of reservoirs in watershed
!!    resdata(7)  |metric tons/ha|average annual amount of sediment transported
!!                               |out of reservoirs in watershed
!!    wshd_pstap(:)|kg pst/ha     |average annual amount of pesticide type
!!                               |applied in watershed during simulation
!!    wshd_pstdg(:)|kg pst/ha     |average annual amount of pesticide lost
!!                               |through degradation in watershed
!!    yldn(:,:,:) |kg/ha         |average value for yield of crop
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    ic          |none          |hydrograph storage location number
!!    idum        |none          |line # in .fig file
!!    ii          |none          |counter
!!    j           |none          |counter
!!    k           |none          |counter
!!    ly          |none          |counter
!!    nicr        |none          |crop number in sequence within year
!!    nnro        |none          |year number in rotation sequence
!!    summinp     |kg P/ha       |total mineral P in HRU soil profile
!!    sumno3      |kg N/ha       |total nitrate in HRU soil profile
!!    sumorgn     |kg N/ha       |total organic N in HRU soil profile
!!    sumorgp     |kg P/ha       |total organic P in HRU soil profile
!!    yrs         |years         |length of simulation
!!    xmm         |months        |number of months simulated
!!    xx          |none          |days in year
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
!!    Intrinsic: Real
!!    SWAT: hruaa, impndaa, rchaa, subaa, stdaa

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

      use parm

      real :: yrs, xx, xmm, sumno3, sumorgn, summinp, sumorgp
      integer :: j, nnro, nicr, k, ly, idum, ic, ii

!! calculate number of years simulated
      yrs = 0.
      do j = 1, nbyr
        xx = 0.
        xx = 366. - Real(leapyr)
        if (j > nyskip) then
          if (j == 1 .and. idaf > 0) then
            yrs = yrs + (xx - (Real(idaf) - 1. - Real(fcstcnt))) / xx
          elseif (j == nbyr .and. idal > 0) then
            yrs = yrs + ((Real(idal) - Real(fcstcnt)) / xx)
          else
            yrs = yrs + 1.
          end if
        end if
      end do
      if (yrs <= 0) return

!! calculate average annual values for HRU data
      hruaao = hruaao / yrs
      wtraa = wtraa / yrs
      bio_aams = bio_aams / yrs
      lai_aamx = lai_aamx / yrs
      yldaa = yldaa / yrs
      irn = irn / yrs
      aairr = aairr / yrs
      do j = 1, nhru
        do nnro = 1, nrot(j)
          do nicr = 1, mcr
            yldn(nnro,nicr,j) = yldkg(nnro,nicr,j) /                    &
     &                               (Real(ncrops(nnro,nicr,j)) + 1.e-6)
            bio_aahv(nnro,nicr,j) = bio_hv(nnro,nicr,j) /               &
     &                               (Real(ncrops(nnro,nicr,j)) + 1.e-6)
          end do
        end do
      end do
      hrupsta = hrupsta / yrs
      sumix = sumix / yrs

!! calculate average annual values for reach data
      rchaao = rchaao / yrs

!! calculate average annual values for subbasin data
      subaao = subaao / yrs

!! calculate average annual values for reservoir data
      resouta = resouta / yrs
      do j = 1, nres
        resdata(1) = resdata(1) + resouta(17,j)
        resdata(2) = resdata(2) + resouta(18,j)
        resdata(3) = resdata(3) + resouta(19,j)
        resdata(4) = resdata(4) + resouta(20,j)
        resdata(5) = resdata(5) + resouta(3,j)
        resdata(6) = resdata(6) + resouta(21,j)
        resdata(7) = resdata(7) + resouta(4,j)
      end do
      resdata(1) = resdata(1) / (da_ha * 10.)
      resdata(2) = resdata(2) / (da_ha * 10.)
      resdata(3) = resdata(3) / (da_ha * 10.)
      resdata(4) = resdata(4) / (da_ha * 10.)
      resdata(5) = resdata(5) / da_ha
      resdata(6) = resdata(6) / (da_ha * 10.)
      resdata(7) = resdata(7) / da_ha

!! calculate average annual values for watershed data
      wshdaao = wshdaao / yrs
      wpstaao = wpstaao / yrs
      !!convert metric tons to metric tons/ha
      wshdaao(11) = wshdaao(11) / da_ha
      !! wshdaao(12) converted in writem.f
      do j = 13, 18
        wshdaao(j) = wshdaao(j) / da_ha
      end do
      !! convert m^3 H2O to mm H2O
      do j = 19, 34
        wshdaao(j) = wshdaao(j) / (da_ha * 10.)
      end do
      wshd_pstap = wshd_pstap / yrs
      wshd_pstdg = wshd_pstdg / yrs
      !! calculate monthly averages
      do j = 1, 12
        xmm = Real(ndmo(j)) / Real(ndays(j+1) - ndays(j))
        if (xmm > 0.) then
          do k = 1, 8
            wshd_aamon(j,k) = wshd_aamon(j,k) / xmm
          end do
        end if
      end do
      !! calculate average stresses for watershed
      wshd_wstrs = wshd_wstrs / yrs
      wshd_tstrs = wshd_tstrs / yrs
      wshd_nstrs = wshd_nstrs / yrs
      wshd_pstrs = wshd_pstrs / yrs
      !! calculate watershed pothole averages
      spadyo = spadyo / yrs
      spadyev = spadyev / yrs
      spadysp = spadysp / yrs
      spadyrfv = spadyrfv / yrs
      !! calculate watershed nutrient averages
      wshd_pup = wshd_pup / yrs
      wshd_plch = wshd_plch / yrs
      wshd_pal = wshd_pal / yrs
      wshd_pas = wshd_pas / yrs
      wshd_ftotn = wshd_ftotn / yrs
      wshd_ftotp = wshd_ftotp / yrs
      wshd_dnit = wshd_dnit / yrs
      wshd_fixn = wshd_fixn / yrs
      wshd_hmn = wshd_hmn / yrs
      wshd_rwn = wshd_rwn / yrs
      wshd_hmp = wshd_hmp / yrs
      wshd_rmn = wshd_rmn / yrs
      wshd_rmp = wshd_rmp / yrs
      wshd_raino3 = wshd_raino3 / yrs
      wshd_fno3 = wshd_fno3 / yrs
      wshd_fnh3 = wshd_fnh3 / yrs
      wshd_forgn = wshd_forgn / yrs
      wshd_fminp = wshd_fminp / yrs
      wshd_forgp = wshd_forgp / yrs
      wshd_yldn = wshd_yldn / yrs
      wshd_yldp = wshd_yldp / yrs
      wshd_voln = wshd_voln / yrs
      wshd_nitn = wshd_nitn / yrs
      sno3up = sno3up / yrs
      !! calculate final nutrient levels in watershed soils
      do j = 1, nhru
        sumno3 = 0.
        sumorgn = 0.
        summinp = 0.
        sumorgp = 0.
        do ly = 1, sol_nly(j)
          sumno3 = sumno3 + sol_no3(ly,j)
          sumorgn = sumorgn + sol_aorgn(ly,j) + sol_orgn(ly,j) +        &
     *        sol_fon(ly,j)
          summinp = summinp + sol_solp(ly,j) + sol_actp(ly,j) +         &
     &              sol_stap(ly,j)
          sumorgp = sumorgp + sol_fop(ly,j) + sol_orgp(ly,j)
        end do
        basno3f = basno3f + sumno3 * hru_dafr(j)
        basorgnf = basorgnf + sumorgn * hru_dafr(j)
        basminpf = basminpf + summinp * hru_dafr(j)
        basorgpf = basorgpf + sumorgp * hru_dafr(j)
      end do
      !! calculate watershed bacteria averages
      sdiegropq = sdiegropq / yrs
      sdiegrolpq = sdiegrolpq / yrs
      sdiegrops = sdiegrops / yrs
      sdiegrolps = sdiegrolps / yrs
      sbactrop = sbactrop / yrs
      sbactrolp = sbactrolp / yrs
      sbactsedp = sbactsedp / yrs
      sbactsedlp = sbactsedlp / yrs
      sbactlchp = sbactlchp / yrs
      sbactlchlp = sbactlchlp / yrs
      

!! write average annual data
      if (iprint /= 1) then
        !! write average annual output--HRU (output.hru)
        call hruaa(yrs)
        call impndaa(yrs)

        !! write average annual output--reach (.rch)
        call rchaa(yrs)

        !! write average annual output--subbasin (output.sub)
        call subaa(yrs)
      end if

!! write average annual pesticide data (output.pst)
      if (iprp == 1) then
        write (5,5500)
        do j = 1, nhru
          if (hrupest(j) == 1) then
                write (5,5600) j, yrs,                                  &
     &                     (hrupsta(k,1,j), hrupsta(k,2,j), k = 1, npmx)
          end if
        end do
      end if

!! write to hydrograph output file
      idum = 1
      do while (icodes(idum) > 0)
        ic = 0
        ic = ihouts(idum)
        write(11123,9400) icodes(idum), ic, inum1s(idum), inum2s(idum), &
     &               inum3s(idum),subed(ic),recmonps(ic),reccnstps(ic), &
     &               (shyd(ii,ic), ii = 1, 7)
        idum = idum + 1
      end do

!! write average annual summary tables in standard output file (.std)
      call stdaa

!! write average annual forecast table
      if (ffcst == 1 .and. fcstcnt > 0) then
        write (18,*) iscen, (fcstaao(j), j = 1, 16)
      end if

      return
 5500 format ("Average Annual Loadings")
 5600 format (1x,i4,1x,f4.0,4x,1x,250(e16.4,1x))
 9400 format (6i8,2(5x,a),7e12.4)
      end