surrad.f90

来自「CLM集合卡曼滤波数据同化算法」· F90 代码 · 共 87 行

  SUBROUTINE surrad(kpt  ,sigf ,albg  ,albv  ,alb  ,ssun, ssha ,&
                    sols ,soll ,solsd ,solld ,parsun, parsha, sabvsun, sabvsha, sabg ,sabvg, &
                    solisb, solisd )

!=======================================================================
!      Source file: surrad.f90
! Original version: Yongjiu Dai, September 15, 1999
!
! Net solar absorbed by surface
!
!=======================================================================

  IMPLICIT NONE

! Dummy argument
  integer, INTENT(in) :: &
        kpt      ! number of land points, including submesh

  real, dimension(1:2,1:2,1:kpt), INTENT(in) :: &
        albg,   &! albedo, ground [-]
        albv,   &! albedo, vegetation [-]
        alb,    &! averaged albedo [-]
        ssun,   &!
        ssha     !

  real, dimension(kpt), INTENT(in) :: &
        sigf,   &! fraction of veg cover, excluding snow-buried veg [-]
        sols,   &! atm vis direct beam solar rad onto srf [W/m2]
        soll,   &! atm nir direct beam solar rad onto srf [W/m2]
        solsd,  &! atm vis diffuse solar rad onto srf [W/m2]
        solld    ! atm nir diffuse solar rad onto srf [W/m2]

  real, dimension(kpt), INTENT(out) :: &
        parsun, &! PAR absorbed by sunlit vegetation [W/m2]
        parsha, &! PAR absorbed by shaded vegetation [W/m2]
        sabvsun,&! solar absorbed by sunlit vegetation [W/m2]
        sabvsha,&! solar absorbed by shaded vegetation [W/m2]
        sabg,   &! solar absorbed by ground  [W/m2]
        sabvg,  &! solar absorbed by ground + vegetation [W/m2]
        solisb, &!
        solisd   !

  ! local
  integer k      

!=======================================================================

      do k = 1, kpt
         sabvsun(k) = 0.
         sabvsha(k) = 0.
         parsun(k) = 0.
         parsha(k) = 0.

         sabg(k) = 0.
         sabvg(k) = 0.

         solisb(k) = 0.
         solisd(k) = 0. 

         if(sols(k)+soll(k)+solsd(k)+solld(k) > 0.)then
! Radiative fluxes onto surface

            parsun(k) = ssun(1,1,k)*sols(k) + ssun(1,2,k)*solsd(k)
            parsha(k) = ssha(1,1,k)*sols(k) + ssha(1,2,k)*solsd(k)
 
            sabvsun(k) = sols(k)*ssun(1,1,k) + soll(k)*ssun(2,1,k) &
                    + solsd(k)*ssun(1,2,k) + solld(k)*ssun(2,2,k)

            sabvsha(k) = sols(k)*ssha(1,1,k) + soll(k)*ssha(2,1,k) &
                    + solsd(k)*ssha(1,2,k) + solld(k)*ssha(2,2,k)

            sabvsun(k) = sigf(k)*sabvsun(k)
            sabvsha(k) = sigf(k)*sabvsha(k)

            sabvg(k) = sols(k) *(1.-alb(1,1,k)) + soll(k) *(1.-alb(2,1,k)) &
                     + solsd(k)*(1.-alb(1,2,k)) + solld(k)*(1.-alb(2,2,k))

            sabg(k) = sabvg(k) - sabvsun(k) - sabvsha(k)

            solisb(k) = sols(k) *(1.-albv(1,1,k))
            solisd(k) = solsd(k)*(1.-albv(1,2,k))

         endif
      enddo

     END SUBROUTINE surrad