writea.f

水文模型的原始代码

!!    wshdyro(:)  |varies        |watershed annual output array
!!    wtraa(:,:)  |varies        |HRU impoundment average annual output array
!!    wtryr(:,:)  |varies        |HRU impoundment annual output array
!!    yldaa(:)    |metric tons/ha|average annual yield (dry weight) in HRU
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ LOCAL DEFINITIONS ~ ~ ~
!!    name        |units         |definition
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~
!!    idlast      |none          |number of days simulated in year
!!    j           |none          |counter
!!    k           |none          |counter
!!    sum         |mg pst        |total pesticide loading for year
!!    ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~

!!    ~ ~ ~ SUBROUTINES/FUNCTIONS CALLED ~ ~ ~
!!    Intrinsic: Real
!!    SWAT: hruyr, impndyr, subyr, rchyr

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

      use parm

      integer :: j, k
      real :: sum

      if (i_mo <= mo_chk .or. (curyr == nbyr .and. i == idal)) then
        !! calculate average annual max and min temperature
        wshdyro(8) = wshdyro(8) / 12.
        wshdyro(9) = wshdyro(9) / 12.

          !! annual write-output.std
          if (iscen == 1) then
          write (2,6300) iyr, wshdyro(1), wshdyro(3), wshdyro(4),       &
     &            wshdyro(104), wshdyro(5), wshdyro(109), wshddayo(35), &
     &            wshdyro(7), wshdyro(108), wshdyro(6), wshdyro(12),    &
     &            wshdyro(42), wshdyro(45), wshdyro(46), wshdyro(44),   &
     &            wshdyro(40), wshdyro(43), wshdyro(41)
          else if (isproj == 1) then
          write (19,6300) iyr, wshdyro(1), wshdyro(3), wshdyro(4),      &
     &            wshdyro(104), wshdyro(5), wshdyro(109), wshddayo(35), &
     &            wshdyro(7), wshdyro(108), wshdyro(6), wshdyro(12),    &
     &            wshdyro(42), wshdyro(45), wshdyro(46), wshdyro(44),   &
     &            wshdyro(40), wshdyro(43), wshdyro(41)
          endif

          !!write channel degradation data (chan.deg)
          if (ideg == 1) then 
            write (16,780) iyr
            do j = 1, nrch
              write (16,779) j, ch_d(j), ch_w(2,j), ch_s(2,j)
            end do
          end if

        if (iprint /= 1) then
          !! annual write--pesticide output (output.pst) for HRUs
          do j = 1, nhru
            if (hrupest(j) == 1) then
            sum = 0.
            do k = 1, npmx
              sum = sum + hrupsty(k,1,j) + hrupsty(k,2,j)
            end do
            if (sum > 0. .and. iprp == 1) then
                write (5,5100) j, iyr,                                  &
     &                     (hrupsty(k,1,j), hrupsty(k,2,j), k = 1, npmx)
            end if
            end if
          end do

          !! annual write--HRU output (output.hru)
          call hruyr
          call impndyr

          !! annual write--subbasin output (output.sub)
          call subyr

          !! annual write--reach output (.rch)
          call rchyr

          idlast = 0
          idlast = i - (id1 - 1)
          do j = 1, nres
            resouty(1,j) = resouty(1,j) / Real(idlast)
            resouty(2,j) = resouty(2,j) / Real(idlast)
            resouty(5,j) = resouty(5,j) / Real(idlast)
            resouty(15,j) = resouty(15,j) / Real(idlast)
            resouty(16,j) = resouty(16,j) / Real(idlast)
            resouty(36,j) = resouty(36,j) / Real(idlast)
            resouty(37,j) = resouty(37,j) / Real(idlast)
            resouty(38,j) = resouty(38,j) / Real(idlast)
            resouty(39,j) = resouty(39,j) / Real(idlast)
            resouty(40,j) = resouty(40,j) / Real(idlast)
            resouty(41,j) = resouty(41,j) / Real(idlast)
            if (iyr >= iyres(j)) then
              if (iscen == 1) then
              write (8,5800) j, iyr, res_vol(j), resouty(1,j),          &
     &                       resouty(2,j), resouty(19,j), resouty(17,j),&
     &                       resouty(18,j), resouty(3,j), resouty(4,j), &
     &                       resouty(5,j),                              &
     &                       (resouty(k,j), k = 22, 23), resouty(38,j), &
     &                       (resouty(k,j), k = 24, 25), resouty(36,j), &
     &                       (resouty(k,j), k = 26, 27), resouty(39,j), &
     &                       (resouty(k,j), k = 28, 29), resouty(40,j), &
     &                       (resouty(k,j), k = 30, 31), resouty(41,j), &
     &                       (resouty(k,j), k = 32, 33), resouty(37,j), &
     &                       (resouty(k,j), k = 34, 35), res_seci(j),   &
     &                       (resouty(k,j), k = 6, 16)
              else if (isproj == 1) then
              write (22,5800) j, iyr, res_vol(j), resouty(1,j),         &
     &                       resouty(2,j), resouty(19,j), resouty(17,j),&
     &                       resouty(18,j), resouty(3,j), resouty(4,j), &
     &                       resouty(5,j),                              &
     &                       (resouty(k,j), k = 22, 23), resouty(38,j), &
     &                       (resouty(k,j), k = 24, 25), resouty(36,j), &
     &                       (resouty(k,j), k = 26, 27), resouty(39,j), &
     &                       (resouty(k,j), k = 28, 29), resouty(40,j), &
     &                       (resouty(k,j), k = 30, 31), resouty(41,j), &
     &                       (resouty(k,j), k = 32, 33), resouty(37,j), &
     &                       (resouty(k,j), k = 34, 35), res_seci(j),   &
     &                       (resouty(k,j), k = 6, 16)
              endif
            end if
          end do
        end if

        if (curyr > nyskip) then
          do j = 1, nhru
            bio_aams(j) = bio_aams(j) + bio_yrms(j)
            lai_aamx(j) = lai_aamx(j) + lai_yrmx(j)
            yldaa(j) = yldaa(j) + yldanu(j)
          end do

          wshdaao = wshdaao + wshdyro
          wpstaao = wpstaao + wpstyro
          hruaao = hruaao + hruyro
          wtraa = wtraa + wtryr
          subaao = subaao + subyro
          rchaao = rchaao + rchyro
          resouta = resouta + resouty
          hrupsta = hrupsta + hrupsty
        end if

        wshdyro = 0.
        wpstyro = 0.
        hruyro = 0.
        wtryr = 0.
        subyro = 0.
        rchyro = 0.
        resouty = 0.
        hrupsty = 0.

      end if

      return
 777  format (i4,500e12.4)
 779  format (i4,3f12.4)
 780  format (/,' Year End',i5,' Channel Dimensions ',/,' Reach',       &
     &         '    Depth (m)','  Width (m)','  Slope (m/m)')
 5100 format (1x,i4,1x,i4,4x,1x,250(e16.4,1x))
 5200 format (/,1x,i4,a4,1x,10f12.2)
 5300 format (1x,i4,a4,1x,10f12.2,/)
 5800 format ('RES   ',i8,1x,i4,41e12.4)
 6300 format (/i5,15f7.2,1x,4f8.2//)
      end