SCALE-RM
Functions/Subroutines
scale_cpl_phy_sfc_fixed_temp Module Reference

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_finalize
 Finalize. 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 51 of file scale_cpl_phy_sfc_fixed_temp.F90.

51  implicit none
52  !---------------------------------------------------------------------------
53 
54  if ( initialized ) return
55 
56  log_newline
57  log_info("CPL_PHY_SFC_FIXED_TEMP_setup",*) 'Setup'
58 
59  initialized = .true.
60 
61  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_finalize()

subroutine, public scale_cpl_phy_sfc_fixed_temp::cpl_phy_sfc_fixed_temp_finalize

Finalize.

Definition at line 67 of file scale_cpl_phy_sfc_fixed_temp.F90.

67 
68  initialized = .false.
69 
70  return

Referenced by mod_cpl_driver::cpl_driver_finalize().

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 94 of file scale_cpl_phy_sfc_fixed_temp.F90.

94  use scale_const, only: &
95  eps => const_eps, &
96  undef => const_undef, &
97  epsvap => const_epsvap, &
98  pre00 => const_pre00, &
99  rdry => const_rdry, &
100  cpdry => const_cpdry, &
101  rvap => const_rvap, &
102  stb => const_stb
103  use scale_atmos_saturation, only: &
104 ! qsat => ATMOS_SATURATION_pres2qsat_all
105  qsat => atmos_saturation_dens2qsat_all
106  use scale_bulkflux, only: &
107  bulkflux, &
108  bulkflux_diagnose_surface
109  implicit none
110 
111  integer, intent(in) :: IA, IS, IE
112  integer, intent(in) :: JA, JS, JE
113  real(RP), intent(in) :: TMPA (IA,JA) ! temperature at the lowest atmospheric layer [K]
114  real(RP), intent(in) :: PRSA (IA,JA) ! pressure at the lowest atmospheric layer [Pa]
115  real(RP), intent(in) :: WA (IA,JA) ! velocity w at the lowest atmospheric layer [m/s]
116  real(RP), intent(in) :: UA (IA,JA) ! velocity u at the lowest atmospheric layer [m/s]
117  real(RP), intent(in) :: VA (IA,JA) ! velocity v at the lowest atmospheric layer [m/s]
118  real(RP), intent(in) :: RHOA (IA,JA) ! density at the lowest atmospheric layer [kg/m3]
119  real(RP), intent(in) :: QVA (IA,JA) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
120  real(RP), intent(in) :: LH (IA,JA) ! latent heat at the lowest atmospheric layer [J/kg]
121  real(RP), intent(in) :: Z1 (IA,JA) ! cell center height at the lowest atmospheric layer [m]
122  real(RP), intent(in) :: PBL (IA,JA) ! the top of atmospheric mixing layer [m]
123  real(RP), intent(in) :: RHOS (IA,JA) ! density at the surface [kg/m3]
124  real(RP), intent(in) :: PRSS (IA,JA) ! pressure at the surface [Pa]
125  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]
126  real(RP), intent(in) :: TMPS (IA,JA) ! surface temperature [K]
127  real(RP), intent(in) :: WSTR (IA,JA) ! amount of the water storage [kg/m2]
128  real(RP), intent(in) :: QVEF (IA,JA) ! efficiency of evaporation (0-1)
129  real(RP), intent(in) :: ALBEDO (IA,JA,N_RAD_DIR,N_RAD_RGN) ! surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
130  real(RP), intent(in) :: Rb (IA,JA) ! stomata resistance [1/s]
131  real(RP), intent(in) :: Z0M (IA,JA) ! roughness length for momemtum [m]
132  real(RP), intent(in) :: Z0H (IA,JA) ! roughness length for heat [m]
133  real(RP), intent(in) :: Z0E (IA,JA) ! roughness length for vapor [m]
134  logical, intent(in) :: calc_flag(IA,JA) ! to decide calculate or not
135  real(DP), intent(in) :: dt ! delta time
136 
137  real(RP), intent(out) :: ZMFLX (IA,JA) ! z-momentum flux at the surface [kg/m/s2]
138  real(RP), intent(out) :: XMFLX (IA,JA) ! x-momentum flux at the surface [kg/m/s2]
139  real(RP), intent(out) :: YMFLX (IA,JA) ! y-momentum flux at the surface [kg/m/s2]
140  real(RP), intent(out) :: SHFLX (IA,JA) ! sensible heat flux at the surface [J/m2/s]
141  real(RP), intent(out) :: LHFLX (IA,JA) ! latent heat flux at the surface [J/m2/s]
142  real(RP), intent(out) :: QVFLX (IA,JA) ! water vapor flux at the surface [kg/m2/s]
143  real(RP), intent(out) :: GFLX (IA,JA) ! subsurface heat flux at the surface [J/m2/s]
144  real(RP), intent(out) :: Ustar (IA,JA) ! friction velocity [m/s]
145  real(RP), intent(out) :: Tstar (IA,JA) ! temperature scale [K]
146  real(RP), intent(out) :: Qstar (IA,JA) ! moisture scale [kg/kg]
147  real(RP), intent(out) :: Wstar (IA,JA) ! convective velocity scale [m/s]
148  real(RP), intent(out) :: RLmo (IA,JA) ! inversed Obukhov length [1/m]
149  real(RP), intent(out) :: U10 (IA,JA) ! velocity u at 10m [m/s]
150  real(RP), intent(out) :: V10 (IA,JA) ! velocity v at 10m [m/s]
151  real(RP), intent(out) :: T2 (IA,JA) ! temperature at 2m [K]
152  real(RP), intent(out) :: Q2 (IA,JA) ! water vapor at 2m [kg/kg]
153 
154  real(RP) :: emis ! surface longwave emission [J/m2/s]
155  real(RP) :: LWD ! surface downward longwave radiation flux [J/m2/s]
156  real(RP) :: LWU ! surface upward longwave radiation flux [J/m2/s]
157  real(RP) :: SWD ! surface downward shortwave radiation flux [J/m2/s]
158  real(RP) :: SWU ! surface upward shortwave radiation flux [J/m2/s]
159  real(RP) :: res ! residual
160 
161  real(RP) :: Uabs ! absolute velocity [m/s]
162  real(RP) :: Ra ! Aerodynamic resistance (=1/Ce) [1/s]
163 
164  real(RP) :: QVsat ! saturation water vapor mixing ratio at surface [kg/kg]
165  real(RP) :: QVS(IA,JA) ! water vapor mixing ratio at surface [kg/kg]
166  real(RP) :: Rtot ! total gas constant
167  real(RP) :: qdry ! dry air mass ratio [kg/kg]
168 
169  real(RP) :: FracU10(IA,JA) ! calculation parameter for U10 [1]
170  real(RP) :: FracT2 (IA,JA) ! calculation parameter for T2 [1]
171  real(RP) :: FracQ2 (IA,JA) ! calculation parameter for Q2 [1]
172 
173  real(RP) :: MFLUX
174 
175  integer :: i, j
176  !---------------------------------------------------------------------------
177 
178  log_progress(*) 'coupler / physics / surface / FIXED-TEMP'
179 
180  !$acc data copyin(TMPA,PRSA,WA,UA,VA,RHOA,QVA,LH,Z1,PBL,RHOS,PRSS,RFLXD,TMPS,WSTR,QVEF,ALBEDO,Rb,Z0M,Z0H,Z0E,calc_flag) &
181  !$acc copyout(ZMFLX,XMFLX,YMFLX,SHFLX,LHFLX,QVFLX,GFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
182  !$acc create(QVS,FracU10,FracT2,FracQ2)
183 
184  ! calculate surface flux
185  !$omp parallel do schedule(dynamic) collapse(2) &
186 #ifndef __GFORTRAN__
187  !$omp default(none) &
188  !$omp shared(IS,IE,JS,JE,EPS,UNDEF,Rdry,CPdry,bulkflux,dt, &
189  !$omp calc_flag,TMPA,QVA,QVS,LH,WA,UA,VA,Z1,PBL,PRSA,TMPS,WSTR,PRSS,RHOS,QVEF,Z0M,Z0H,Z0E,ALBEDO,RFLXD,Rb, &
190  !$omp FracU10,FracT2,FracQ2, &
191  !$omp SHFLX,LHFLX,QVFLX,GFLX,ZMFLX,XMFLX,YMFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
192 #else
193  !$omp default(shared) &
194 #endif
195  !$omp private(qdry,Rtot,QVsat,Uabs,Ra,res,emis,LWD,LWU,SWD,SWU,MFLUX)
196  !$acc kernels
197  do j = js, je
198  !$acc loop private(qvsat,ra,Uabs)
199  do i = is, ie
200  if ( calc_flag(i,j) ) then
201 
202 ! qdry = 1.0_RP - QVA(i,j)
203 ! Rtot = qdry * Rdry + QVA(i,j) * Rvap
204 ! call qsat( TMPS(i,j), PRSS(i,j), qdry, QVsat )
205  call qsat( tmps(i,j), rhos(i,j), qvsat )
206 
207  qvs(i,j) = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
208  + ( qvef(i,j) ) * qvsat
209 
210  uabs = sqrt( wa(i,j)**2 + ua(i,j)**2 + va(i,j)**2 )
211 
212  call bulkflux( tmpa(i,j), tmps(i,j), & ! [IN]
213  prsa(i,j), prss(i,j), & ! [IN]
214  qva(i,j), qvs(i,j), & ! [IN]
215  uabs, z1(i,j), pbl(i,j), & ! [IN]
216  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
217  ustar(i,j), tstar(i,j), qstar(i,j), & ! [OUT]
218  wstar(i,j), rlmo(i,j), ra, & ! [OUT]
219  fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
220 
221  if ( uabs < eps ) then
222  zmflx(i,j) = 0.0_rp
223  xmflx(i,j) = 0.0_rp
224  ymflx(i,j) = 0.0_rp
225  else
226  mflux = - rhos(i,j) * ustar(i,j)**2
227  zmflx(i,j) = mflux * wa(i,j) / uabs
228  xmflx(i,j) = mflux * ua(i,j) / uabs
229  ymflx(i,j) = mflux * va(i,j) / uabs
230  end if
231  shflx(i,j) = -rhos(i,j) * ustar(i,j) * tstar(i,j) * cpdry
232  qvflx(i,j) = -rhos(i,j) * ustar(i,j) * qstar(i,j) * ra / ( ra+rb(i,j) )
233  qvflx(i,j) = min( qvflx(i,j), wstr(i,j) / real(dt,rp) )
234  lhflx(i,j) = qvflx(i,j) * lh(i,j)
235 
236  emis = ( 1.0_rp-albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps(i,j)**4
237 
238  lwd = rflxd(i,j,i_r_diffuse,i_r_ir)
239  lwu = rflxd(i,j,i_r_diffuse,i_r_ir) * albedo(i,j,i_r_diffuse,i_r_ir) + emis
240  swd = rflxd(i,j,i_r_direct ,i_r_nir) &
241  + rflxd(i,j,i_r_diffuse,i_r_nir) &
242  + rflxd(i,j,i_r_direct ,i_r_vis) &
243  + rflxd(i,j,i_r_diffuse,i_r_vis)
244  swu = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
245  + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
246  + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
247  + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
248 
249  ! calculation for residual
250  res = swd - swu + lwd - lwu - shflx(i,j) - qvflx(i,j) * lh(i,j)
251 
252  ! put residual in ground heat flux (positive for downward)
253  gflx(i,j) = res
254 
255  else ! not calculate surface flux
256  zmflx(i,j) = undef
257  xmflx(i,j) = undef
258  ymflx(i,j) = undef
259  shflx(i,j) = undef
260  lhflx(i,j) = undef
261  qvflx(i,j) = undef
262  gflx(i,j) = undef
263  ustar(i,j) = undef
264  tstar(i,j) = undef
265  qstar(i,j) = undef
266  wstar(i,j) = undef
267  rlmo(i,j) = undef
268  u10(i,j) = undef
269  v10(i,j) = undef
270  t2(i,j) = undef
271  q2(i,j) = undef
272  endif
273  enddo
274  enddo
275  !$acc end kernels
276 
277  call bulkflux_diagnose_surface( ia, is, ie, ja, js, je, &
278  ua(:,:), va(:,:), & ! (in)
279  tmpa(:,:), qva(:,:), & ! (in)
280  tmps(:,:), qvs(:,:), & ! (in)
281  z1(:,:), z0m(:,:), z0h(:,:), z0e(:,:), & ! (in)
282  u10(:,:), v10(:,:), t2(:,:), q2(:,:), & ! (out)
283  mask = calc_flag(:,:), & ! (in)
284  fracu10 = fracu10(:,:), & ! (in)
285  fract2 = fract2(:,:), & ! (in)
286  fracq2 = fracq2(:,:) ) ! (in)
287 
288  !$acc end data
289 
290  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:
scale_const::const_epsvap
real(rp), public const_epsvap
Rdry / Rvap.
Definition: scale_const.F90:75
scale_const::const_rvap
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
Definition: scale_const.F90:68
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_bulkflux
module Surface bulk flux
Definition: scale_bulkflux.F90:12
scale_index::va
integer, public va
Definition: scale_index.F90:35
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_atmos_grid_cartesc_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:54
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:60
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_const::const_stb
real(rp), parameter, public const_stb
Stefan-Boltzman constant [W/m2/K4].
Definition: scale_const.F90:53
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:97
scale_atmos_grid_cartesc_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:56
scale_bulkflux::bulkflux
procedure(bc), pointer, public bulkflux
Definition: scale_bulkflux.F90:84