ana_srflux.h

Go to the documentation of this file.

!!
      SUBROUTINE ana_srflux (ng, tile, model)
!
!! git $Id$
!!======================================================================
!! Copyright (c) 2002-2025 The ROMS Group                              !
!!   Licensed under a MIT/X style license                              !
!!   See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This subroutine sets kinematic surface solar shortwave radiation    !
!  flux "srflx" (degC m/s) using an analytical expression.             !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_forces
      USE mod_grid
      USE mod_ncparam
!
! Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
!
!  Local variable declarations.
!
      character (len=*), parameter :: MyFile =                          &
     &  __FILE__
!
#include "tile.h"
!
      CALL ana_srflux_tile (ng, tile, model,                            &
     &                      lbi, ubi, lbj, ubj,                         &
     &                      imins, imaxs, jmins, jmaxs,                 &
     &                      grid(ng) % lonr,                            &
     &                      grid(ng) % latr,                            &
#ifdef ALBEDO
     &                      forces(ng) % cloud,                         &
     &                      forces(ng) % Hair,                          &
     &                      forces(ng) % Tair,                          &
     &                      forces(ng) % Pair,                          &
#endif
     &                      forces(ng) % srflx)
!
! Set analytical header file name used.
!
#ifdef DISTRIBUTE
      IF (lanafile) THEN
#else
      IF (lanafile.and.(tile.eq.0)) THEN
#endif
        ananame(27)=myfile
      END IF
!
      RETURN
      END SUBROUTINE ana_srflux
!
!***********************************************************************
      SUBROUTINE ana_srflux_tile (ng, tile, model,                      &
     &                            LBi, UBi, LBj, UBj,                   &
     &                            IminS, ImaxS, JminS, JmaxS,           &
     &                            lonr, latr,                           &
#ifdef ALBEDO
     &                            cloud, Hair, Tair, Pair,              &
#endif
     &                            srflx)
!***********************************************************************
!
      USE mod_param
      USE mod_scalars
!
      USE dateclock_mod,   ONLY : caldate
      USE exchange_2d_mod, ONLY : exchange_r2d_tile
#ifdef DISTRIBUTE
      USE mp_exchange_mod, ONLY : mp_exchange2d
#endif
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, tile, model
      integer, intent(in) :: LBi, UBi, LBj, UBj
      integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
!
#ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: lonr(LBi:,LBj:)
      real(r8), intent(in) :: latr(LBi:,LBj:)
# ifdef ALBEDO
      real(r8), intent(in) :: cloud(LBi:,LBj:)
      real(r8), intent(in) :: Hair(LBi:,LBj:)
      real(r8), intent(in) :: Tair(LBi:,LBj:)
      real(r8), intent(in) :: Pair(LBi:,LBj:)
# endif
      real(r8), intent(out) :: srflx(LBi:,LBj:)
#else
      real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
# ifdef ALBEDO
      real(r8), intent(in) :: cloud(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: Hair(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: Tair(LBi:UBi,LBj:UBj)
      real(r8), intent(in) :: Pair(LBi:UBi,LBj:UBj)
# endif
      real(r8), intent(out) :: srflx(LBi:UBi,LBj:UBj)
#endif
!
!  Local variable declarations.
!
      integer :: i, j
!
#if defined ALBEDO || defined DIURNAL_SRFLUX
      real(dp) :: hour, yday
      real(r8) :: Dangle, Hangle, LatRad
      real(r8) :: cff1, cff2
# ifdef ALBEDO
      real(r8) :: Rsolar, e_sat, vap_p, zenith
# endif
#endif
      real(r8) :: cff
!
      real(r8), parameter :: alb_w=0.06_r8
 
#include "set_bounds.h"
 
#if defined ALBEDO || defined DIURNAL_SRFLUX
!
!-----------------------------------------------------------------------
!  Compute shortwave radiation (degC m/s):
!
!  ALBEDO option: Compute shortwave radiation flux using the Laevastu
!                 cloud correction to the Zillman equation for cloudless
!  radiation (Parkinson and Washington 1979, JGR, 84, 311-337).  Notice
!  that flux is scaled from W/m2 to degC m/s by dividing by (rho0*Cp).
!
!  DIURNAL_SRFLUX option: Modulate shortwave radiation SRFLX (which
!                         read and interpolated elsewhere) by the local
!  diurnal cycle (a function of longitude, latitude and day-of-year).
!  This option is provided for cases where SRFLX computed by SET_DATA is
!  an average over >= 24 hours. For "diurnal_srflux" to work ana_srflux
!  must be undefined. If you want a strictly analytical diurnal cycle
!  enter it explicitly at the end of this subroutine or use the "albedo"
!  option.
!
!  For a review of shortwave radiation formulations check:
!
!    Niemela, S., P. Raisanen, and H. Savijarvi, 2001: Comparison of
!      surface radiative flux parameterizations, Part II, Shortwave
!      radiation, Atmos. Res., 58, 141-154.
!
!-----------------------------------------------------------------------
!
!  Get time clock day-of-year and hour.
!
      CALL caldate (tdays(ng), yd_dp=yday, h_dp=hour)
!
!  Estimate solar declination angle (radians).
!
      dangle=23.44_dp*cos((172.0_dp-yday)*2.0_dp*pi/365.2425_dp)
      dangle=dangle*deg2rad
!
!  Compute hour angle (radians).
!
      hangle=(12.0_r8-hour)*pi/12.0_r8
!
# ifdef ALBEDO
      rsolar=csolar/(rho0*cp)
# endif
      DO j=jstrt,jendt
        DO i=istrt,iendt
!
!  Local daylight, GMT time zone, is a function of the declination
!  (Dangle) and hour angle adjusted for the local meridian
!  (Hangle-lonr(i,j)*deg2rad).
!
          latrad=latr(i,j)*deg2rad
          cff1=sin(latrad)*sin(dangle)
          cff2=cos(latrad)*cos(dangle)
# if defined ALBEDO
!
!  Estimate variation in optical thickness of the atmosphere over
!  the course of a day under cloudless skies (Zillman, 1972). To
!  obtain incoming shortwave radiation multiply by (1.0-0.6*c**3),
!  where c is the fractional cloud cover.
!
!  The equation for saturation vapor pressure is from Gill (Atmosphere-
!  Ocean Dynamics, pp 606).
!!
!! If specific humidity in kg/kg.
!!
!!        vap_p=Pair(i,j)*Hair(i,j)/(0.62197_r8+0.378_r8*Hair(i,j))
!!
!
          srflx(i,j)=0.0_r8
          zenith=cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)
          IF (zenith.gt.0.0_r8) THEN
            cff=(0.7859_r8+0.03477_r8*tair(i,j))/                       &
     &          (1.0_r8+0.00412_r8*tair(i,j))
            e_sat=10.0_r8**cff    ! saturation vapor pressure (hPa=mbar)
            vap_p=e_sat*hair(i,j) ! water vapor pressure (hPa=mbar)
            srflx(i,j)=rsolar*zenith*zenith*                            &
     &                 (1.0_r8-0.6_r8*cloud(i,j)**3)/                   &
     &                 ((zenith+2.7_r8)*vap_p*1.0e-3_r8+                &
     &                  1.085_r8*zenith+0.1_r8)
          END IF
!
!  Add correction for ocean albedo. Notice that the correction is not
!  needed below because it is assumed that the input (>=24h-average)
!  and 'srflx' is NET downward shortwave radiation.
!
          srflx(i,j)=(1.0_r8-alb_w)*srflx(i,j)
 
# elif defined DIURNAL_SRFLUX
!
!  SRFLX is reset on each time step in subroutine SET_DATA which
!  interpolates values in the forcing file to the current date.
!  This DIURNAL_SRFLUX option is provided so that SRFLX values
!  corresponding to a greater or equal daily average can be modulated
!  by the local length of day to produce a diurnal cycle with the
!  same daily average as the original data.  This approach assumes
!  the net effect of clouds is incorporated into the SRFLX data.
!
!  Normalization = (1/2*pi)*INTEGRAL{ABS(a+b*COS(t)) dt}  from 0 to 2*pi
!                = (a*ARCCOS(-a/b)+SQRT(b**2-a**2))/pi    for |a| < |b|
!
          IF (abs(cff1).gt.abs(cff2)) THEN
            IF (cff1*cff2.gt.0.0_r8) THEN
              cff=cff1                                 ! All day case
              srflx(i,j)=max(0.0_r8,                                    &
     &                       srflx(i,j)/cff*                            &
     &                       (cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)))
            ELSE
              srflx(i,j)=0.0_r8                        ! All night case
            END IF
          ELSE
            cff=(cff1*acos(-cff1/cff2)+sqrt(cff2*cff2-cff1*cff1))/pi
            srflx(i,j)=max(0.0_r8,                                      &
     &                     srflx(i,j)/cff*                              &
     &                     (cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)))
          END IF
# endif
        END DO
      END DO
#else
!
!-----------------------------------------------------------------------
!  Set incoming solar shortwave radiation (degC m/s).  Usually, the
!  shortwave radiation from input files is Watts/m2 and then converted
!  to degC m/s by multiplying by conversion factor 1/(rho0*Cp) during
!  reading (Fscale). However, we are already inside ROMS kernel here
!  and all the fluxes are kinematic so shortwave radiation units need
!  to be degC m/s.
!-----------------------------------------------------------------------
!
      cff=1.0_r8/(rho0*cp)
# if defined UPWELLING
      DO j=jstrt,jendt
        DO i=istrt,iendt
          srflx(i,j)=cff*150.0_r8
        END DO
      END DO
# else
      DO j=jstrt,jendt
        DO i=istrt,iendt
          srflx(i,j)=0.0_r8
        END DO
      END DO
# endif
#endif
!
!  Exchange boundary data.
!
      IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
        CALL exchange_r2d_tile (ng, tile,                               &
     &                          lbi, ubi, lbj, ubj,                     &
     &                          srflx)
      END IF
 
#ifdef DISTRIBUTE
      CALL mp_exchange2d (ng, tile, model, 1,                           &
     &                    lbi, ubi, lbj, ubj,                           &
     &                    nghostpoints,                                 &
     &                    ewperiodic(ng), nsperiodic(ng),               &
     &                    srflx)
#endif
!
      RETURN
      END SUBROUTINE ana_srflux_tile