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 (IA, IS, IE, JA, JS, JE, TMPA, PRSA, WA, UA, VA, RHOA, QVA, LH, Z1, PBL, RHOS, PRSS, RFLXD, TMPS, QVEF, ALBEDO, Rb, Z0M, Z0H, Z0E, calc_flag, dt, ZMFLX, XMFLX, YMFLX, SHFLX, QVFLX, GFLX, 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.

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

50  implicit none
51  !---------------------------------------------------------------------------
52 
53  if ( initialized ) return
54 
55  log_newline
56  log_info("CPL_PHY_SFC_FIXED_TEMP_setup",*) 'Setup'
57 
58  initialized = .true.
59 
60  return
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)  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)  QVFLX,
real(rp), dimension (ia,ja), intent(out)  GFLX,
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 80 of file scale_cpl_phy_sfc_fixed_temp.F90.

References scale_bulkflux::bulkflux, scale_const::const_cpdry, scale_const::const_pre00, scale_const::const_rdry, scale_const::const_rvap, scale_const::const_stb, 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, and scale_cpl_sfc_index::i_r_vis.

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

80  use scale_const, only: &
81  pre00 => const_pre00, &
82  rdry => const_rdry, &
83  cpdry => const_cpdry, &
84  rvap => const_rvap, &
85  stb => const_stb
86  use scale_atmos_saturation, only: &
87  qsat => atmos_saturation_pres2qsat_all
88  use scale_bulkflux, only: &
89  bulkflux
90  implicit none
91 
92  integer, intent(in) :: ia, is, ie
93  integer, intent(in) :: ja, js, je
94  real(RP), intent(in) :: tmpa (ia,ja) ! temperature at the lowest atmospheric layer [K]
95  real(RP), intent(in) :: prsa (ia,ja) ! pressure at the lowest atmospheric layer [Pa]
96  real(RP), intent(in) :: wa (ia,ja) ! velocity w at the lowest atmospheric layer [m/s]
97  real(RP), intent(in) :: ua (ia,ja) ! velocity u at the lowest atmospheric layer [m/s]
98  real(RP), intent(in) :: va (ia,ja) ! velocity v at the lowest atmospheric layer [m/s]
99  real(RP), intent(in) :: rhoa (ia,ja) ! density at the lowest atmospheric layer [kg/m3]
100  real(RP), intent(in) :: qva (ia,ja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
101  real(RP), intent(in) :: lh (ia,ja) ! latent heat at the lowest atmospheric layer [J/kg]
102  real(RP), intent(in) :: z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
103  real(RP), intent(in) :: pbl (ia,ja) ! the top of atmospheric mixing layer [m]
104  real(RP), intent(in) :: rhos (ia,ja) ! density at the surface [kg/m3]
105  real(RP), intent(in) :: prss (ia,ja) ! pressure at the surface [Pa]
106  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]
107  real(RP), intent(in) :: tmps (ia,ja) ! surface temperature [K]
108  real(RP), intent(in) :: qvef (ia,ja) ! efficiency of evaporation (0-1)
109  real(RP), intent(in) :: albedo (ia,ja,n_rad_dir,n_rad_rgn) ! surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
110  real(RP), intent(in) :: rb (ia,ja) ! stomata resistance [1/s]
111  real(RP), intent(in) :: z0m (ia,ja) ! roughness length for momemtum [m]
112  real(RP), intent(in) :: z0h (ia,ja) ! roughness length for heat [m]
113  real(RP), intent(in) :: z0e (ia,ja) ! roughness length for vapor [m]
114  logical, intent(in) :: calc_flag(ia,ja) ! to decide calculate or not
115  real(DP), intent(in) :: dt ! delta time
116  real(RP), intent(out) :: zmflx (ia,ja) ! z-momentum flux at the surface [kg/m/s2]
117  real(RP), intent(out) :: xmflx (ia,ja) ! x-momentum flux at the surface [kg/m/s2]
118  real(RP), intent(out) :: ymflx (ia,ja) ! y-momentum flux at the surface [kg/m/s2]
119  real(RP), intent(out) :: shflx (ia,ja) ! sensible heat flux at the surface [J/m2/s]
120  real(RP), intent(out) :: qvflx (ia,ja) ! water vapor flux at the surface [kg/m2/s]
121  real(RP), intent(out) :: gflx (ia,ja) ! subsurface heat flux at the surface [J/m2/s]
122  real(RP), intent(out) :: u10 (ia,ja) ! velocity u at 10m [m/s]
123  real(RP), intent(out) :: v10 (ia,ja) ! velocity v at 10m [m/s]
124  real(RP), intent(out) :: t2 (ia,ja) ! temperature at 2m [K]
125  real(RP), intent(out) :: q2 (ia,ja) ! water vapor at 2m [kg/kg]
126 
127  real(RP) :: emis ! surface longwave emission [J/m2/s]
128  real(RP) :: lwd ! surface downward longwave radiation flux [J/m2/s]
129  real(RP) :: lwu ! surface upward longwave radiation flux [J/m2/s]
130  real(RP) :: swd ! surface downward shortwave radiation flux [J/m2/s]
131  real(RP) :: swu ! surface upward shortwave radiation flux [J/m2/s]
132  real(RP) :: res ! residual
133 
134  real(RP) :: ustar ! friction velocity [m]
135  real(RP) :: tstar ! friction potential temperature [K]
136  real(RP) :: qstar ! friction water vapor mass ratio [kg/kg]
137  real(RP) :: uabs ! modified absolute velocity [m/s]
138  real(RP) :: ra ! Aerodynamic resistance (=1/Ce) [1/s]
139 
140  real(RP) :: qvsat ! saturation water vapor mixing ratio at surface [kg/kg]
141  real(RP) :: qvs ! water vapor mixing ratio at surface [kg/kg]
142  real(RP) :: rtot ! total gas constant
143  real(RP) :: qdry ! dry air mass ratio [kg/kg]
144 
145  real(RP) :: fracu10 ! calculation parameter for U10 [1]
146  real(RP) :: fract2 ! calculation parameter for T2 [1]
147  real(RP) :: fracq2 ! calculation parameter for Q2 [1]
148 
149  integer :: i, j
150  !---------------------------------------------------------------------------
151 
152  log_progress(*) 'coupler / physics / surface / FIXED-TEMP'
153 
154  ! calculate surface flux
155 #ifndef __GFORTRAN__
156  !$omp parallel do default(none) &
157  !$omp private(qdry,Rtot,QVsat,QVS,Ustar,Tstar,Qstar,Uabs,Ra,FracU10,FracT2,FracQ2,res,emis,LWD,LWU,SWD,SWU) &
158  !$omp shared(IS,IE,JS,JE,Rdry,CPdry,bulkflux, &
159  !$omp calc_flag,TMPA,QVA,LH,UA,VA,WA,Z1,PBL,PRSA,TMPS,PRSS,RHOS,QVEF,Z0M,Z0H,Z0E,ALBEDO,RFLXD,Rb, &
160  !$omp SHFLX,QVFLX,GFLX,ZMFLX,XMFLX,YMFLX,U10,V10,T2,Q2)
161 #else
162  !$omp parallel do default(shared) &
163  !$omp private(qdry,Rtot,QVsat,QVS,Ustar,Tstar,Qstar,Uabs,Ra,FracU10,FracT2,FracQ2,res,emis,LWD,LWU,SWD,SWU)
164 #endif
165  do j = js, je
166  do i = is, ie
167  if ( calc_flag(i,j) ) then
168 
169  qdry = 1.0_rp - qva(i,j)
170  rtot = qdry * rdry + qva(i,j) * rvap
171 
172  call qsat( tmps(i,j), prss(i,j), qdry, qvsat )
173 
174  qvs = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
175  + ( qvef(i,j) ) * qvsat
176 
177  call bulkflux( ustar, & ! [OUT]
178  tstar, & ! [OUT]
179  qstar, & ! [OUT]
180  uabs, & ! [OUT]
181  ra, & ! [OUT]
182  fracu10, & ! [OUT]
183  fract2, & ! [OUT]
184  fracq2, & ! [OUT]
185  tmpa(i,j), & ! [IN]
186  tmps(i,j), & ! [IN]
187  prsa(i,j), & ! [IN]
188  prss(i,j), & ! [IN]
189  qva(i,j), & ! [IN]
190  qvs, & ! [IN]
191  ua(i,j), & ! [IN]
192  va(i,j), & ! [IN]
193  z1(i,j), & ! [IN]
194  pbl(i,j), & ! [IN]
195  z0m(i,j), & ! [IN]
196  z0h(i,j), & ! [IN]
197  z0e(i,j) ) ! [IN]
198 
199  zmflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * wa(i,j)
200  xmflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * ua(i,j)
201  ymflx(i,j) = -rhos(i,j) * ustar * ustar / uabs * va(i,j)
202  shflx(i,j) = -rhos(i,j) * ustar * tstar * cpdry
203  qvflx(i,j) = -rhos(i,j) * ustar * qstar * ra / ( ra+rb(i,j) )
204 
205  emis = ( 1.0_rp-albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps(i,j)**4
206 
207  lwd = rflxd(i,j,i_r_diffuse,i_r_ir)
208  lwu = rflxd(i,j,i_r_diffuse,i_r_ir) * albedo(i,j,i_r_diffuse,i_r_ir) + emis
209  swd = rflxd(i,j,i_r_direct ,i_r_nir) &
210  + rflxd(i,j,i_r_diffuse,i_r_nir) &
211  + rflxd(i,j,i_r_direct ,i_r_vis) &
212  + rflxd(i,j,i_r_diffuse,i_r_vis)
213  swu = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
214  + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
215  + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
216  + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
217 
218  ! calculation for residual
219  res = swd - swu + lwd - lwu - shflx(i,j) - qvflx(i,j) * lh(i,j)
220 
221  ! put residual in ground heat flux (positive for upward)
222  gflx(i,j) = -res
223 
224  ! diagnostic variables considering unstable/stable state
225  !U10(i,j) = FracU10 * UA(i,j)
226  !V10(i,j) = FracU10 * VA(i,j)
227  !T2 (i,j) = ( 1.0_RP - FracT2 ) * TMPS(i,j) + FracT2 * TMPA(i,j)
228  !Q2 (i,j) = ( 1.0_RP - FracQ2 ) * QVS + FracQ2 * QVA (i,j)
229 
230  ! diagnostic variables for neutral state
231  u10(i,j) = ua(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
232  v10(i,j) = va(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
233  t2(i,j) = tmps(i,j) + ( tmpa(i,j) - tmps(i,j) ) * log( 2.0_rp / z0h(i,j) ) / log( z1(i,j) / z0h(i,j) )
234  q2(i,j) = qvs + ( qva(i,j) - qvs ) * log( 2.0_rp / z0e(i,j) ) / log( z1(i,j) / z0e(i,j) )
235 
236  else ! not calculate surface flux
237  zmflx(i,j) = 0.0_rp
238  xmflx(i,j) = 0.0_rp
239  ymflx(i,j) = 0.0_rp
240  shflx(i,j) = 0.0_rp
241  qvflx(i,j) = 0.0_rp
242  gflx(i,j) = 0.0_rp
243  u10(i,j) = 0.0_rp
244  v10(i,j) = 0.0_rp
245  t2(i,j) = 0.0_rp
246  q2(i,j) = 0.0_rp
247  endif
248  enddo
249  enddo
250 
251  return
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:56
module atmosphere / saturation
integer, public va
Definition: scale_index.F90:35
real(rp), parameter, public const_stb
Stefan-Boltzman constant [W/m2/K4].
Definition: scale_const.F90:49
integer, public ia
of whole cells: x, local, with HALO
integer, public ja
of whole cells: y, local, with HALO
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:55
integer, public is
start point of inner domain: x, local
integer, public ie
end point of inner domain: x, local
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:88
integer, public je
end point of inner domain: y, local
procedure(bc), pointer, public bulkflux
real(rp), parameter, public const_rvap
specific gas constant (water vapor) [J/kg/K]
Definition: scale_const.F90:63
module CONSTANT
Definition: scale_const.F90:11
integer, public js
start point of inner domain: y, local
module Surface bulk flux
Here is the caller graph for this function: