module coupler / surface fixed temp model More...

Functions/Subroutines
subroutine, public	cpl_phy_sfc_fixed_temp_setup
	Setup. More...

subroutine, public	cpl_phy_sfc_fixed_temp (IA, IS, IE, JA, JS, JE, TMPA, PRSA, WA, UA, VA, RHOA, QVA, LH, Z1, PBL, RHOS, PRSS, RFLXD, TMPS, WSTR, QVEF, ALBEDO, Rb, Z0M, Z0H, Z0E, calc_flag, dt, ZMFLX, XMFLX, YMFLX, SHFLX, LHFLX, QVFLX, GFLX, Ustar, Tstar, Qstar, Wstar, RLmo, U10, V10, T2, Q2)

Detailed Description

module coupler / surface fixed temp model

Description: Surface fixed temperature model

Author: Team SCALE

Function/Subroutine Documentation

◆ cpl_phy_sfc_fixed_temp_setup()

subroutine, public scale_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp_setup

Setup.

Definition at line 50 of file scale_cpl_phy_sfc_fixed_temp.F90.

     implicit none
     !---------------------------------------------------------------------------
  
     if ( initialized ) return
  
     log_newline
     log_info("CPL_PHY_SFC_FIXED_TEMP_setup",*) 'Setup'
  
     initialized = .true.
  
     return

Referenced by mod_land_driver::land_driver_setup(), and mod_ocean_driver::ocean_driver_setup().

Here is the caller graph for this function:

◆ cpl_phy_sfc_fixed_temp()

subroutine, public scale_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp	(	integer, intent(in)	IA,
		integer, intent(in)	IS,
		integer, intent(in)	IE,
		integer, intent(in)	JA,
		integer, intent(in)	JS,
		integer, intent(in)	JE,
		real(rp), dimension (ia,ja), intent(in)	TMPA,
		real(rp), dimension (ia,ja), intent(in)	PRSA,
		real(rp), dimension (ia,ja), intent(in)	WA,
		real(rp), dimension (ia,ja), intent(in)	UA,
		real(rp), dimension (ia,ja), intent(in)	VA,
		real(rp), dimension (ia,ja), intent(in)	RHOA,
		real(rp), dimension (ia,ja), intent(in)	QVA,
		real(rp), dimension (ia,ja), intent(in)	LH,
		real(rp), dimension (ia,ja), intent(in)	Z1,
		real(rp), dimension (ia,ja), intent(in)	PBL,
		real(rp), dimension (ia,ja), intent(in)	RHOS,
		real(rp), dimension (ia,ja), intent(in)	PRSS,
		real(rp), dimension (ia,ja,n_rad_dir,n_rad_rgn), intent(in)	RFLXD,
		real(rp), dimension (ia,ja), intent(in)	TMPS,
		real(rp), dimension (ia,ja), intent(in)	WSTR,
		real(rp), dimension (ia,ja), intent(in)	QVEF,
		real(rp), dimension (ia,ja,n_rad_dir,n_rad_rgn), intent(in)	ALBEDO,
		real(rp), dimension (ia,ja), intent(in)	Rb,
		real(rp), dimension (ia,ja), intent(in)	Z0M,
		real(rp), dimension (ia,ja), intent(in)	Z0H,
		real(rp), dimension (ia,ja), intent(in)	Z0E,
		logical, dimension(ia,ja), intent(in)	calc_flag,
		real(dp), intent(in)	dt,
		real(rp), dimension (ia,ja), intent(out)	ZMFLX,
		real(rp), dimension (ia,ja), intent(out)	XMFLX,
		real(rp), dimension (ia,ja), intent(out)	YMFLX,
		real(rp), dimension (ia,ja), intent(out)	SHFLX,
		real(rp), dimension (ia,ja), intent(out)	LHFLX,
		real(rp), dimension (ia,ja), intent(out)	QVFLX,
		real(rp), dimension (ia,ja), intent(out)	GFLX,
		real(rp), dimension (ia,ja), intent(out)	Ustar,
		real(rp), dimension (ia,ja), intent(out)	Tstar,
		real(rp), dimension (ia,ja), intent(out)	Qstar,
		real(rp), dimension (ia,ja), intent(out)	Wstar,
		real(rp), dimension (ia,ja), intent(out)	RLmo,
		real(rp), dimension (ia,ja), intent(out)	U10,
		real(rp), dimension (ia,ja), intent(out)	V10,
		real(rp), dimension (ia,ja), intent(out)	T2,
		real(rp), dimension (ia,ja), intent(out)	Q2
	)

Definition at line 84 of file scale_cpl_phy_sfc_fixed_temp.F90.

     use scale_const, only: &
        eps   => const_eps, &
        undef => const_undef, &
        epsvap => const_epsvap, &
        pre00 => const_pre00, &
        rdry  => const_rdry,  &
        cpdry => const_cpdry, &
        rvap  => const_rvap,  &
        stb   => const_stb
     use scale_atmos_saturation, only: &
 !       qsat => ATMOS_SATURATION_pres2qsat_all
        qsat => atmos_saturation_dens2qsat_all
     use scale_bulkflux, only: &
        bulkflux, &
        bulkflux_diagnose_surface
     implicit none
  
     integer,  intent(in)  :: IA, IS, IE
     integer,  intent(in)  :: JA, JS, JE
     real(RP), intent(in)  :: TMPA     (IA,JA)                     ! temperature at the lowest atmospheric layer [K]
     real(RP), intent(in)  :: PRSA     (IA,JA)                     ! pressure    at the lowest atmospheric layer [Pa]
     real(RP), intent(in)  :: WA       (IA,JA)                     ! velocity w  at the lowest atmospheric layer [m/s]
     real(RP), intent(in)  :: UA       (IA,JA)                     ! velocity u  at the lowest atmospheric layer [m/s]
     real(RP), intent(in)  :: VA       (IA,JA)                     ! velocity v  at the lowest atmospheric layer [m/s]
     real(RP), intent(in)  :: RHOA     (IA,JA)                     ! density     at the lowest atmospheric layer [kg/m3]
     real(RP), intent(in)  :: QVA      (IA,JA)                     ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
     real(RP), intent(in)  :: LH       (IA,JA)                     ! latent heat at the lowest atmospheric layer [J/kg]
     real(RP), intent(in)  :: Z1       (IA,JA)                     ! cell center height at the lowest atmospheric layer [m]
     real(RP), intent(in)  :: PBL      (IA,JA)                     ! the top of atmospheric mixing layer [m]
     real(RP), intent(in)  :: RHOS     (IA,JA)                     ! density  at the surface [kg/m3]
     real(RP), intent(in)  :: PRSS     (IA,JA)                     ! pressure at the surface [Pa]
     real(RP), intent(in)  :: RFLXD    (IA,JA,N_RAD_DIR,N_RAD_RGN) ! downward radiation flux at the surface (direct/diffuse,IR/near-IR/VIS) [J/m2/s]
     real(RP), intent(in)  :: TMPS     (IA,JA)                     ! surface temperature [K]
     real(RP), intent(in)  :: WSTR     (IA,JA)                     ! amount of the water storage [kg/m2]
     real(RP), intent(in)  :: QVEF     (IA,JA)                     ! efficiency of evaporation (0-1)
     real(RP), intent(in)  :: ALBEDO   (IA,JA,N_RAD_DIR,N_RAD_RGN) ! surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
     real(RP), intent(in)  :: Rb       (IA,JA)                     ! stomata resistance [1/s]
     real(RP), intent(in)  :: Z0M      (IA,JA)                     ! roughness length for momemtum [m]
     real(RP), intent(in)  :: Z0H      (IA,JA)                     ! roughness length for heat     [m]
     real(RP), intent(in)  :: Z0E      (IA,JA)                     ! roughness length for vapor    [m]
     logical,  intent(in)  :: calc_flag(IA,JA)                     ! to decide calculate or not
     real(DP), intent(in)  :: dt                                   ! delta time
  
     real(RP), intent(out) :: ZMFLX    (IA,JA)                     ! z-momentum      flux at the surface [kg/m/s2]
     real(RP), intent(out) :: XMFLX    (IA,JA)                     ! x-momentum      flux at the surface [kg/m/s2]
     real(RP), intent(out) :: YMFLX    (IA,JA)                     ! y-momentum      flux at the surface [kg/m/s2]
     real(RP), intent(out) :: SHFLX    (IA,JA)                     ! sensible heat   flux at the surface [J/m2/s]
     real(RP), intent(out) :: LHFLX    (IA,JA)                     ! latent heat     flux at the surface [J/m2/s]
     real(RP), intent(out) :: QVFLX    (IA,JA)                     ! water vapor     flux at the surface [kg/m2/s]
     real(RP), intent(out) :: GFLX     (IA,JA)                     ! subsurface heat flux at the surface [J/m2/s]
     real(RP), intent(out) :: Ustar    (IA,JA)                     ! friction velocity         [m/s]
     real(RP), intent(out) :: Tstar    (IA,JA)                     ! temperature scale         [K]
     real(RP), intent(out) :: Qstar    (IA,JA)                     ! moisture scale            [kg/kg]
     real(RP), intent(out) :: Wstar    (IA,JA)                     ! convective velocity scale [m/s]
     real(RP), intent(out) :: RLmo     (IA,JA)                     ! inversed Obukhov length   [1/m]
     real(RP), intent(out) :: U10      (IA,JA)                     ! velocity u  at 10m [m/s]
     real(RP), intent(out) :: V10      (IA,JA)                     ! velocity v  at 10m [m/s]
     real(RP), intent(out) :: T2       (IA,JA)                     ! temperature at 2m  [K]
     real(RP), intent(out) :: Q2       (IA,JA)                     ! water vapor at 2m  [kg/kg]
  
     real(RP) :: emis ! surface longwave emission                 [J/m2/s]
     real(RP) :: LWD  ! surface downward longwave  radiation flux [J/m2/s]
     real(RP) :: LWU  ! surface upward   longwave  radiation flux [J/m2/s]
     real(RP) :: SWD  ! surface downward shortwave radiation flux [J/m2/s]
     real(RP) :: SWU  ! surface upward   shortwave radiation flux [J/m2/s]
     real(RP) :: res  ! residual
  
     real(RP) :: Uabs ! absolute velocity               [m/s]
     real(RP) :: Ra   ! Aerodynamic resistance (=1/Ce)  [1/s]
  
     real(RP) :: QVsat      ! saturation water vapor mixing ratio at surface [kg/kg]
     real(RP) :: QVS(IA,JA) ! water vapor mixing ratio at surface            [kg/kg]
     real(RP) :: Rtot       ! total gas constant
     real(RP) :: qdry       ! dry air mass ratio [kg/kg]
  
     real(RP) :: FracU10(IA,JA) ! calculation parameter for U10 [1]
     real(RP) :: FracT2 (IA,JA) ! calculation parameter for T2  [1]
     real(RP) :: FracQ2 (IA,JA) ! calculation parameter for Q2  [1]
  
     real(RP) :: MFLUX
  
     integer  :: i, j
     !---------------------------------------------------------------------------
  
     log_progress(*) 'coupler / physics / surface / FIXED-TEMP'
  
     ! calculate surface flux
     !$omp parallel do &
 #ifndef __GFORTRAN__
     !$omp default(none) &
     !$omp shared(IS,IE,JS,JE,EPS,UNDEF,Rdry,CPdry,bulkflux,dt, &
     !$omp        calc_flag,TMPA,QVA,QVS,LH,WA,UA,VA,Z1,PBL,PRSA,TMPS,WSTR,PRSS,RHOS,QVEF,Z0M,Z0H,Z0E,ALBEDO,RFLXD,Rb, &
     !$omp        FracU10,FracT2,FracQ2, &
     !$omp        SHFLX,LHFLX,QVFLX,GFLX,ZMFLX,XMFLX,YMFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
 #else
     !$omp default(shared) &
 #endif
     !$omp private(qdry,Rtot,QVsat,Uabs,Ra,res,emis,LWD,LWU,SWD,SWU,MFLUX)
     do j = js, je
     do i = is, ie
        if ( calc_flag(i,j) ) then
  
 !          qdry = 1.0_RP - QVA(i,j)
 !          Rtot = qdry * Rdry + QVA(i,j) * Rvap
 !          call qsat( TMPS(i,j), PRSS(i,j), qdry, QVsat )
           call qsat( tmps(i,j), rhos(i,j), qvsat )
  
           qvs(i,j) = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
                    + (        qvef(i,j) ) * qvsat
  
           uabs = sqrt( wa(i,j)**2 + ua(i,j)**2 + va(i,j)**2 )
  
           call bulkflux( tmpa(i,j), tmps(i,j),                  & ! [IN]
                          prsa(i,j), prss(i,j),                  & ! [IN]
                          qva(i,j), qvs(i,j),                  & ! [IN]
                          uabs, z1(i,j), pbl(i,j),               & ! [IN]
                          z0m(i,j), z0h(i,j), z0e(i,j),          & ! [IN]
                          ustar(i,j), tstar(i,j), qstar(i,j),    & ! [OUT]
                          wstar(i,j), rlmo(i,j), ra,             & ! [OUT]
                          fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
  
           if ( uabs < eps ) then
              zmflx(i,j) = 0.0_rp
              xmflx(i,j) = 0.0_rp
              ymflx(i,j) = 0.0_rp
           else
              mflux = - rhos(i,j) * ustar(i,j)**2
              zmflx(i,j) = mflux * wa(i,j) / uabs
              xmflx(i,j) = mflux * ua(i,j) / uabs
              ymflx(i,j) = mflux * va(i,j) / uabs
           end if
           shflx(i,j) = -rhos(i,j) * ustar(i,j) * tstar(i,j) * cpdry
           qvflx(i,j) = -rhos(i,j) * ustar(i,j) * qstar(i,j) * ra / ( ra+rb(i,j) )
           qvflx(i,j) = min( qvflx(i,j), wstr(i,j) / real(dt,rp) )
           lhflx(i,j) = qvflx(i,j) * lh(i,j)
  
           emis = ( 1.0_rp-albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps(i,j)**4
  
           lwd  = rflxd(i,j,i_r_diffuse,i_r_ir)
           lwu  = rflxd(i,j,i_r_diffuse,i_r_ir)  * albedo(i,j,i_r_diffuse,i_r_ir) + emis
           swd  = rflxd(i,j,i_r_direct ,i_r_nir) &
                + rflxd(i,j,i_r_diffuse,i_r_nir) &
                + rflxd(i,j,i_r_direct ,i_r_vis) &
                + rflxd(i,j,i_r_diffuse,i_r_vis)
           swu  = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
                + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
                + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
                + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
  
           ! calculation for residual
           res = swd - swu + lwd - lwu - shflx(i,j) - qvflx(i,j) * lh(i,j)
  
           ! put residual in ground heat flux (positive for downward)
           gflx(i,j) = res
  
        else ! not calculate surface flux
           zmflx(i,j) = undef
           xmflx(i,j) = undef
           ymflx(i,j) = undef
           shflx(i,j) = undef
           lhflx(i,j) = undef
           qvflx(i,j) = undef
           gflx(i,j) = undef
           ustar(i,j) = undef
           tstar(i,j) = undef
           qstar(i,j) = undef
           wstar(i,j) = undef
           rlmo(i,j) = undef
           u10(i,j) = undef
           v10(i,j) = undef
           t2(i,j) = undef
           q2(i,j) = undef
        endif
     enddo
     enddo
  
     call bulkflux_diagnose_surface( ia, is, ie, ja, js, je, &
                                     ua(:,:), va(:,:),                      & ! (in)
                                     tmpa(:,:), qva(:,:),                   & ! (in)
                                     tmps(:,:), qvs(:,:),                   & ! (in)
                                     z1(:,:), z0m(:,:), z0h(:,:), z0e(:,:), & ! (in)
                                     u10(:,:), v10(:,:), t2(:,:), q2(:,:),  & ! (out)
                                     mask = calc_flag(:,:),                 & ! (in)
                                     fracu10 = fracu10(:,:),                & ! (in)
                                     fract2 = fract2(:,:),                  & ! (in)
                                     fracq2 = fracq2(:,:)                   ) ! (in)
  
     return

References scale_bulkflux::bulkflux, scale_const::const_cpdry, scale_const::const_eps, scale_const::const_epsvap, scale_const::const_pre00, scale_const::const_rdry, scale_const::const_rvap, scale_const::const_stb, scale_const::const_undef, scale_cpl_sfc_index::i_r_diffuse, scale_cpl_sfc_index::i_r_direct, scale_cpl_sfc_index::i_r_ir, scale_cpl_sfc_index::i_r_nir, scale_cpl_sfc_index::i_r_vis, and scale_precision::rp.

Referenced by mod_land_driver::land_driver_calc_tendency(), and mod_ocean_driver::ocean_driver_calc_tendency().

Here is the caller graph for this function:

Functions/Subroutines

Detailed Description

Function/Subroutine Documentation

◆ cpl_phy_sfc_fixed_temp_setup()

◆ cpl_phy_sfc_fixed_temp()