SCALE-RM
Functions/Subroutines
scale_cpl_phy_sfc_skin Module Reference

module coupler / physics / surface skin More...

Functions/Subroutines

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

Detailed Description

module coupler / physics / surface skin

Description
Skin surface model
Author
Team SCALE
NAMELIST
  • PARAM_CPL_PHY_SFC_SKIN
    nametypedefault valuecomment
    CPL_PHY_SFC_SKIN_ITR_MAX integer 100 maximum iteration number
    CPL_PHY_SFC_SKIN_DTS_MAX real(RP) 5.0E-2_RP maximum delta surface temperature [K/s]
    CPL_PHY_SFC_SKIN_RES_MIN real(RP) 1.0E+0_RP minimum value of residual
    CPL_PHY_SFC_SKIN_ERR_MIN real(RP) 1.0E-2_RP minimum value of error

History Output
No history output

Function/Subroutine Documentation

◆ cpl_phy_sfc_skin_setup()

subroutine, public scale_cpl_phy_sfc_skin::cpl_phy_sfc_skin_setup

Setup.

Definition at line 56 of file scale_cpl_phy_sfc_skin.F90.

56  use scale_prc, only: &
57  prc_abort
58  implicit none
59 
60  namelist / param_cpl_phy_sfc_skin / &
61  cpl_phy_sfc_skin_itr_max, &
62  cpl_phy_sfc_skin_dts_max, &
63  cpl_phy_sfc_skin_res_min, &
64  cpl_phy_sfc_skin_err_min
65 
66  integer :: ierr
67  !---------------------------------------------------------------------------
68 
69  if ( initialized ) return
70 
71  log_newline
72  log_info("CPL_PHY_SFC_SKIN_setup",*) 'Setup'
73 
74  !--- read namelist
75  rewind(io_fid_conf)
76  read(io_fid_conf,nml=param_cpl_phy_sfc_skin,iostat=ierr)
77  if( ierr < 0 ) then !--- missing
78  log_info("CPL_PHY_SFC_SKIN_setup",*) 'Not found namelist. Default used.'
79  elseif( ierr > 0 ) then !--- fatal error
80  log_error("CPL_PHY_SFC_SKIN_setup",*) 'Not appropriate names in namelist PARAM_CPL_PHY_SFC_SKIN. Check!'
81  call prc_abort
82  endif
83  log_nml(param_cpl_phy_sfc_skin)
84 
85  initialized = .true.
86 
87  return

References scale_io::io_fid_conf, and scale_prc::prc_abort().

Referenced by mod_land_driver::land_driver_setup().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ cpl_phy_sfc_skin()

subroutine, public scale_cpl_phy_sfc_skin::cpl_phy_sfc_skin ( 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)  TG,
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)  TC_dZ,
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,
character(len=*), intent(in)  model_name,
real(rp), dimension (ia,ja), intent(inout)  TMPS,
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 114 of file scale_cpl_phy_sfc_skin.F90.

114  use scale_prc, only: &
115  prc_myrank, &
116  prc_abort
117  use scale_const, only: &
118  eps => const_eps, &
119  undef => const_undef, &
120  pre00 => const_pre00, &
121  tem00 => const_tem00, &
122  rdry => const_rdry, &
123  cpdry => const_cpdry, &
124  rvap => const_rvap, &
125  stb => const_stb
126  use scale_atmos_saturation, only: &
127  qsat => atmos_saturation_dens2qsat_all
128 ! qsat => ATMOS_SATURATION_pres2qsat_all
129  use scale_atmos_hydrometeor, only: &
130  atmos_hydrometeor_lhv, &
131  atmos_hydrometeor_lhs, &
132  cv_water, &
133  cv_ice, &
134  lhf
135  use scale_bulkflux, only: &
136  bulkflux, &
137  bulkflux_diagnose_surface
138  implicit none
139 
140  integer, intent(in) :: IA, IS, IE
141  integer, intent(in) :: JA, JS, JE
142  real(RP), intent(in) :: TMPA (IA,JA) ! temperature at the lowest atmospheric layer [K]
143  real(RP), intent(in) :: PRSA (IA,JA) ! pressure at the lowest atmospheric layer [Pa]
144  real(RP), intent(in) :: WA (IA,JA) ! velocity w at the lowest atmospheric layer [m/s]
145  real(RP), intent(in) :: UA (IA,JA) ! velocity u at the lowest atmospheric layer [m/s]
146  real(RP), intent(in) :: VA (IA,JA) ! velocity v at the lowest atmospheric layer [m/s]
147  real(RP), intent(in) :: RHOA (IA,JA) ! density at the lowest atmospheric layer [kg/m3]
148  real(RP), intent(in) :: QVA (IA,JA) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
149  real(RP), intent(in) :: LH (IA,JA) ! latent heat [J/kg]
150  real(RP), intent(in) :: Z1 (IA,JA) ! cell center height at the lowest atmospheric layer [m]
151  real(RP), intent(in) :: PBL (IA,JA) ! the top of atmospheric mixing layer [m]
152  real(RP), intent(in) :: RHOS (IA,JA) ! density at the surface [kg/m3]
153  real(RP), intent(in) :: PRSS (IA,JA) ! pressure at the surface [Pa]
154  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]
155  real(RP), intent(in) :: TG (IA,JA) ! subsurface temperature [K]
156  real(RP), intent(in) :: WSTR (IA,JA) ! amount of water storage [kg/m2]
157  real(RP), intent(in) :: QVEF (IA,JA) ! efficiency of evaporation (0-1)
158  real(RP), intent(in) :: ALBEDO (IA,JA,N_RAD_DIR,N_RAD_RGN) ! surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
159  real(RP), intent(in) :: Rb (IA,JA) ! stomata resistance [1/s]
160  real(RP), intent(in) :: TC_dZ (IA,JA) ! thermal conductivity / depth between surface and subsurface [J/m2/s/K]
161  real(RP), intent(in) :: Z0M (IA,JA) ! roughness length for momemtum [m]
162  real(RP), intent(in) :: Z0H (IA,JA) ! roughness length for heat [m]
163  real(RP), intent(in) :: Z0E (IA,JA) ! roughness length for vapor [m]
164  logical, intent(in) :: calc_flag(IA,JA) ! to decide calculate or not
165  real(DP), intent(in) :: dt ! delta time
166  character(len=*), intent(in) :: model_name
167 
168  real(RP), intent(inout) :: TMPS (IA,JA) ! surface temperature [K]
169 
170  real(RP), intent(out) :: ZMFLX (IA,JA) ! z-momentum flux at the surface [kg/m/s2]
171  real(RP), intent(out) :: XMFLX (IA,JA) ! x-momentum flux at the surface [kg/m/s2]
172  real(RP), intent(out) :: YMFLX (IA,JA) ! y-momentum flux at the surface [kg/m/s2]
173  real(RP), intent(out) :: SHFLX (IA,JA) ! sensible heat flux at the surface [J/m2/s]
174  real(RP), intent(out) :: LHFLX (IA,JA) ! latent heat flux at the surface [J/m2/s]
175  real(RP), intent(out) :: QVFLX (IA,JA) ! water vapor flux at the surface [kg/m2/s]
176  real(RP), intent(out) :: GFLX (IA,JA) ! subsurface heat flux at the surface [J/m2/s]
177  real(RP), intent(out) :: Ustar (IA,JA) ! friction velocity [m/s]
178  real(RP), intent(out) :: Tstar (IA,JA) ! temperature scale [K]
179  real(RP), intent(out) :: Qstar (IA,JA) ! moisture scale [kg/kg]
180  real(RP), intent(out) :: Wstar (IA,JA) ! convective velocity scale [m/s]
181  real(RP), intent(out) :: RLmo (IA,JA) ! inversed Obukhov length [1/m]
182  real(RP), intent(out) :: U10 (IA,JA) ! velocity u at 10m [m/s]
183  real(RP), intent(out) :: V10 (IA,JA) ! velocity v at 10m [m/s]
184  real(RP), intent(out) :: T2 (IA,JA) ! temperature at 2m [K]
185  real(RP), intent(out) :: Q2 (IA,JA) ! water vapor at 2m [kg/kg]
186 
187  real(RP), parameter :: dTS0 = 1.0e-4_rp ! delta surface temp.
188  real(RP), parameter :: redf_min = 1.0e-2_rp ! minimum reduced factor
189  real(RP), parameter :: redf_max = 1.0e+0_rp ! maximum reduced factor
190  real(RP), parameter :: TFa = 0.5e+0_rp ! factor a in Tomita (2009)
191  real(RP), parameter :: TFb = 1.1e+0_rp ! factor b in Tomita (2009)
192 
193  real(RP) :: TMPS1(IA,JA)
194 
195  real(RP) :: emis ! surface longwave emission [J/m2/s]
196  real(RP) :: LWD ! surface downward longwave radiation flux [J/m2/s]
197  real(RP) :: LWU ! surface upward longwave radiation flux [J/m2/s]
198  real(RP) :: SWD ! surface downward shortwave radiation flux [J/m2/s]
199  real(RP) :: SWU ! surface upward shortwave radiation flux [J/m2/s]
200  real(RP) :: flx_qv ! surface upward qv flux [kg/m2/s]
201  real(RP) :: res ! residual
202 
203  real(RP) :: dres ! d(residual)/dTMPS
204  real(RP) :: oldres ! residual in previous step
205  real(RP) :: redf ! reduced factor
206  real(RP) :: dts ! temperature change
207  real(RP) :: olddts ! temperature change in previous step
208 
209  real(RP) :: dUstar ! friction velocity difference [m/s]
210  real(RP) :: dTstar ! friction potential temperature difference [K]
211  real(RP) :: dQstar ! friction water vapor mass ratio difference [kg/kg]
212  real(RP) :: dWstar ! free convection velocity scale difference [m/s]
213  real(RP) :: dRLmo ! inversed Obukhov length [1/m]
214  real(RP) :: Uabs, dUabs ! modified absolute velocity [m/s]
215  real(RP) :: Ra, dRa ! Aerodynamic resistance (=1/Ce) [1/s]
216 
217  real(RP) :: QVsat, dQVsat ! saturation water vapor mixing ratio at surface [kg/kg]
218  real(RP) :: QVS(IA,JA), dQVS ! water vapor mixing ratio at surface [kg/kg]
219  real(RP) :: Rtot ! total gas constant
220  real(RP) :: qdry ! dry air mass ratio [kg/kg]
221 
222  real(RP) :: FracU10(IA,JA), dFracU10 ! calculation parameter for U10 [1]
223  real(RP) :: FracT2 (IA,JA), dFracT2 ! calculation parameter for T2 [1]
224  real(RP) :: FracQ2 (IA,JA), dFracQ2 ! calculation parameter for Q2 [1]
225 
226  real(RP) :: MFLUX
227 
228  integer :: i, j, n
229  !---------------------------------------------------------------------------
230 
231  log_progress(*) 'coupler / physics / surface / SKIN'
232 
233  ! copy surfce temperature for iteration
234  !$omp parallel do
235  do j = js, je
236  do i = is, ie
237  tmps1(i,j) = tmps(i,j)
238  enddo
239  enddo
240 
241  ! update surface temperature
242  !$omp parallel do &
243 #ifndef __GFORTRAN__
244  !$omp default(none) &
245  !$omp shared(IO_UNIVERSALRANK,IO_LOCALRANK,IO_JOBID,IO_DOMAINID) &
246  !$omp shared(IS,IE,JS,JE,EPS,UNDEF,Rdry,CPdry,PRC_myrank,IO_FID_LOG,IO_L,model_name,bulkflux, &
247  !$omp CPL_PHY_SFC_SKIN_itr_max,CPL_PHY_SFC_SKIN_dTS_max,CPL_PHY_SFC_SKIN_err_min,CPL_PHY_SFC_SKIN_res_min, &
248  !$omp calc_flag,dt,QVA,QVS,TMPA,TMPS,PRSA,RHOA,WA,UA,VA,LH,Z1,PBL, &
249  !$omp TG,PRSS,RHOS,TMPS1,WSTR,QVEF,Z0M,Z0H,Z0E,Rb,TC_dZ,ALBEDO,RFLXD, &
250  !$omp FracU10,FracT2,FracQ2, &
251  !$omp ZMFLX,XMFLX,YMFLX,SHFLX,LHFLX,QVFLX,GFLX,Ustar,Tstar,Qstar,Wstar,RLmo,U10,V10,T2,Q2) &
252 #else
253  !$omp default(shared) &
254 #endif
255  !$omp private(qdry,Rtot,flx_qv,redf,res,dts,olddts,emis,LWD,LWU,SWD,SWU,dres,oldres,dQVS, &
256  !$omp QVsat,dQVsat,dUstar,dTstar,dQstar,dWstar,dFracU10,dFracT2,dFracQ2, &
257  !$omp Uabs,dUabs,dRLmo,Ra,dRa,MFLUX)
258  do j = js, je
259  do i = is, ie
260  if ( calc_flag(i,j) ) then
261 
262 ! qdry = 1.0_RP - QVA(i,j)
263 ! Rtot = qdry * Rdry + QVA(i,j) * Rvap
264 
265  redf = 1.0_rp
266  oldres = huge(0.0_rp)
267  olddts = cpl_phy_sfc_skin_dts_max * dt
268 
269  ! modified Newton-Raphson method (Tomita 2009)
270  do n = 1, cpl_phy_sfc_skin_itr_max
271 
272  call qsat( tmps1(i,j), rhos(i,j), qvsat )
273  call qsat( tmps1(i,j)+dts0, rhos(i,j), dqvsat )
274 ! call qsat( TMPS1(i,j), PRSS(i,j), qdry, QVsat )
275 ! call qsat( TMPS1(i,j)+dTS0, PRSS(i,j), qdry, dQVsat )
276 
277  qvs(i,j) = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
278  + ( qvef(i,j) ) * qvsat
279  dqvs = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
280  + ( qvef(i,j) ) * dqvsat
281 
282  uabs = sqrt( wa(i,j)**2 + ua(i,j)**2 + va(i,j)**2 )
283 
284  call bulkflux( tmpa(i,j), tmps1(i,j), & ! [IN]
285  prsa(i,j), prss(i,j), & ! [IN]
286  qva(i,j), qvs(i,j), & ! [IN]
287  uabs, z1(i,j), pbl(i,j), & ! [IN]
288  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
289  ustar(i,j), tstar(i,j), qstar(i,j), & ! [OUT]
290  wstar(i,j), rlmo(i,j), ra, & ! [OUT]
291  fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
292 
293  call bulkflux( tmpa(i,j), tmps1(i,j)+dts0, & ! [IN]
294  prsa(i,j), prss(i,j), & ! [IN]
295  qva(i,j), dqvs, & ! [IN]
296  uabs, z1(i,j), pbl(i,j), & ! [IN]
297  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
298  dustar, dtstar, dqstar, & ! [OUT]
299  dwstar, drlmo, dra, & ! [OUT] ! not used
300  dfracu10, dfract2, dfracq2 ) ! [OUT] ! not used
301 
302  emis = ( 1.0_rp - albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps1(i,j)**4
303 
304  lwd = rflxd(i,j,i_r_diffuse,i_r_ir)
305  lwu = rflxd(i,j,i_r_diffuse,i_r_ir) * albedo(i,j,i_r_diffuse,i_r_ir) + emis
306  swd = rflxd(i,j,i_r_direct ,i_r_nir) &
307  + rflxd(i,j,i_r_diffuse,i_r_nir) &
308  + rflxd(i,j,i_r_direct ,i_r_vis) &
309  + rflxd(i,j,i_r_diffuse,i_r_vis)
310  swu = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
311  + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
312  + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
313  + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
314 
315  ! calculation for residual
316  flx_qv = min( - rhos(i,j) * ustar(i,j) * qstar(i,j) * ra / ( ra+rb(i,j) ), wstr(i,j)/real(dt,rp) )
317  res = swd - swu + lwd - lwu &
318  + cpdry * rhos(i,j) * ustar(i,j) * tstar(i,j) &
319  - lh(i,j) * flx_qv &
320  - tc_dz(i,j) * ( tmps1(i,j) - tg(i,j) )
321 
322  ! calculation for d(residual)/dTMPS
323  dres = -4.0_rp * emis / tmps1(i,j) &
324  + cpdry * rhos(i,j) * ( ustar(i,j)*(dtstar-tstar(i,j))/dts0 + tstar(i,j)*(dustar-ustar(i,j))/dts0 ) &
325  + lh(i,j) * rhos(i,j) * ( ustar(i,j)*(dqstar-qstar(i,j))/dts0 + qstar(i,j)*(dustar-ustar(i,j))/dts0 ) * ra / ( ra+rb(i,j) ) &
326  - tc_dz(i,j)
327 
328  ! convergence test with residual and error levels
329  if ( abs(res ) < cpl_phy_sfc_skin_res_min &
330  .OR. abs(res/dres) < cpl_phy_sfc_skin_err_min ) then
331  exit
332  endif
333 
334  ! calculate reduced factor
335  if ( dres < 0.0_rp ) then
336  if ( abs(res) > abs(oldres) ) then
337  redf = max( tfa*abs(redf), redf_min )
338  else
339  redf = min( tfb*abs(redf), redf_max )
340  endif
341  else
342  redf = -1.0_rp
343  endif
344 
345  ! estimate next surface temperature
346  dts = - redf * res / dres
347  dts = sign( min( abs(dts), abs(olddts) ), dts )
348  tmps1(i,j) = tmps1(i,j) + dts
349 
350  ! save residual in this step
351  oldres = res
352  olddts = dts
353  enddo
354 
355  ! update surface temperature with limitation
356  tmps1(i,j) = min( max( tmps1(i,j), &
357  tmps(i,j) - cpl_phy_sfc_skin_dts_max * real(dt,kind=rp) ), &
358  tmps(i,j) + cpl_phy_sfc_skin_dts_max * real(dt,kind=rp) )
359 
360  if ( n > cpl_phy_sfc_skin_itr_max ) then
361  ! surface temperature was not converged
362  log_warn("CPL_PHY_SFC_skin",*) 'surface tempearture was not converged. ', trim(model_name)
363  log_newline
364  log_info_cont('(A,I32)' ) 'number of i [no unit] :', i
365  log_info_cont('(A,I32)' ) 'number of j [no unit] :', j
366  log_newline
367  log_info_cont('(A,I32)' ) 'loop number [no unit] :', n
368  log_info_cont('(A,F32.16)') 'Residual [J/m2/s] :', res
369  log_info_cont('(A,F32.16)') 'delta Residual [J/m2/s] :', dres
370  log_newline
371  log_info_cont('(A,F32.16)') 'temperature [K] :', tmpa(i,j)
372  log_info_cont('(A,F32.16)') 'pressure [Pa] :', prsa(i,j)
373  log_info_cont('(A,F32.16)') 'velocity w [m/s] :', wa(i,j)
374  log_info_cont('(A,F32.16)') 'velocity u [m/s] :', ua(i,j)
375  log_info_cont('(A,F32.16)') 'velocity v [m/s] :', va(i,j)
376  log_info_cont('(A,F32.16)') 'absolute velocity [m/s] :', uabs
377  log_info_cont('(A,F32.16)') 'density [kg/m3] :', rhoa(i,j)
378  log_info_cont('(A,F32.16)') 'water vapor mass ratio [kg/kg] :', qva(i,j)
379  log_info_cont('(A,F32.16)') 'cell center height [m] :', z1(i,j)
380  log_info_cont('(A,F32.16)') 'atmospheric mixing layer height [m] :', pbl(i,j)
381  log_info_cont('(A,F32.16)') 'pressure at the surface [Pa] :', prss(i,j)
382  log_info_cont('(A,F32.16)') 'downward radiation (IR, direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_ir )
383  log_info_cont('(A,F32.16)') 'downward radiation (IR, diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_ir )
384  log_info_cont('(A,F32.16)') 'downward radiation (NIR,direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_nir)
385  log_info_cont('(A,F32.16)') 'downward radiation (NIR,diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_nir)
386  log_info_cont('(A,F32.16)') 'downward radiation (VIS,direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_vis)
387  log_info_cont('(A,F32.16)') 'downward radiation (VIS,diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_vis)
388  log_newline
389  log_info_cont('(A,F32.16)') 'soil temperature [K] :', tg(i,j)
390  log_info_cont('(A,F32.16)') 'soil water [kg/m2] :', wstr(i,j)
391  log_info_cont('(A,F32.16)') 'surface temperature [K] :', tmps(i,j)
392  log_info_cont('(A,F32.16)') 'surface density [kg/m3] :', rhos(i,j)
393  log_info_cont('(A,F32.16)') 'efficiency of evaporation [1] :', qvef(i,j)
394  log_info_cont('(A,F32.16)') 'surface albedo (IR, direct ) [1] :', albedo(i,j,i_r_direct ,i_r_ir )
395  log_info_cont('(A,F32.16)') 'surface albedo (IR, diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_ir )
396  log_info_cont('(A,F32.16)') 'surface albedo (NIR,direct ) [1] :', albedo(i,j,i_r_direct ,i_r_nir)
397  log_info_cont('(A,F32.16)') 'surface albedo (NIR,diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_nir)
398  log_info_cont('(A,F32.16)') 'surface albedo (VIS,direct ) [1] :', albedo(i,j,i_r_direct ,i_r_vis)
399  log_info_cont('(A,F32.16)') 'surface albedo (VIS,diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_vis)
400  log_info_cont('(A,F32.16)') 'latent heat [J/kg] :', lh(i,j)
401  log_info_cont('(A,F32.16)') 'stomata registance [1/s] :', rb(i,j)
402  log_info_cont('(A,F32.16)') 'thermal conductivity / depth [J/m2/s/K] :', tc_dz(i,j)
403  log_info_cont('(A,F32.16)') 'roughness length for momemtum [m] :', z0m(i,j)
404  log_info_cont('(A,F32.16)') 'roughness length for heat [m] :', z0h(i,j)
405  log_info_cont('(A,F32.16)') 'roughness length for vapor [m] :', z0e(i,j)
406  log_info_cont('(A,F32.16)') 'time step [s] :', dt
407  log_newline
408  log_info_cont('(A,F32.16)') 'friction velocity [m/s] :', ustar(i,j)
409  log_info_cont('(A,F32.16)') 'friction potential temperature [K] :', tstar(i,j)
410  log_info_cont('(A,F32.16)') 'friction water vapor mass ratio [kg/kg] :', qstar(i,j)
411  log_info_cont('(A,F32.16)') 'free convection velocity scale [m/s] :', wstar(i,j)
412  log_info_cont('(A,F32.16)') 'd(friction velocity) [m/s] :', dustar
413  log_info_cont('(A,F32.16)') 'd(friction potential temperature) [K] :', dtstar
414  log_info_cont('(A,F32.16)') 'd(friction water vapor mass ratio) [kg/kg] :', dqstar
415  log_info_cont('(A,F32.16)') 'd(free convection velocity scale) [m/s] :', dwstar
416  log_info_cont('(A,F32.16)') 'next surface temperature [K] :', tmps1(i,j)
417 
418  ! check NaN
419  if ( .NOT. ( res > -1.0_rp .OR. res < 1.0_rp ) ) then ! must be NaN
420  log_error("CPL_PHY_SFC_skin",*) 'NaN is detected for surface temperature. ', trim(model_name)
421  log_error_cont('(A,I32)' ) 'number of i [no unit] :', i
422  log_error_cont('(A,I32)' ) 'number of j [no unit] :', j
423  log_error_cont('(A,I32)' ) 'loop number [no unit] :', n
424  log_error_cont('(A,F32.16)') 'temperature [K] :', tmpa(i,j)
425  log_error_cont('(A,F32.16)') 'pressure [Pa] :', prsa(i,j)
426  log_error_cont('(A,F32.16)') 'velocity w [m/s] :', wa(i,j)
427  log_error_cont('(A,F32.16)') 'velocity u [m/s] :', ua(i,j)
428  log_error_cont('(A,F32.16)') 'velocity v [m/s] :', va(i,j)
429  log_error_cont('(A,F32.16)') 'absolute velocity [m/s] :', uabs
430  log_error_cont('(A,F32.16)') 'density [kg/m3] :', rhoa(i,j)
431  log_error_cont('(A,F32.16)') 'water vapor mass ratio [kg/kg] :', qva(i,j)
432  log_error_cont('(A,F32.16)') 'cell center height [m] :', z1(i,j)
433  log_error_cont('(A,F32.16)') 'atmospheric mixing layer height [m] :', pbl(i,j)
434  log_error_cont('(A,F32.16)') 'pressure at the surface [Pa] :', prss(i,j)
435  log_error_cont('(A,F32.16)') 'downward radiation (IR, direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_ir )
436  log_error_cont('(A,F32.16)') 'downward radiation (IR, diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_ir )
437  log_error_cont('(A,F32.16)') 'downward radiation (NIR,direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_nir)
438  log_error_cont('(A,F32.16)') 'downward radiation (NIR,diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_nir)
439  log_error_cont('(A,F32.16)') 'downward radiation (VIS,direct ) [J/m2/s] :', rflxd(i,j,i_r_direct ,i_r_vis)
440  log_error_cont('(A,F32.16)') 'downward radiation (VIS,diffuse) [J/m2/s] :', rflxd(i,j,i_r_diffuse,i_r_vis)
441  log_error_cont('(A,F32.16)') 'soil temperature [K] :', tg(i,j)
442  log_error_cont('(A,F32.16)') 'soil water [kg/m2] :', wstr(i,j)
443  log_error_cont('(A,F32.16)') 'surface temperature [K] :', tmps(i,j)
444  log_error_cont('(A,F32.16)') 'surface density [kg/m3] :', rhos(i,j)
445  log_error_cont('(A,F32.16)') 'efficiency of evaporation [1] :', qvef(i,j)
446  log_error_cont('(A,F32.16)') 'surface albedo (IR, direct ) [1] :', albedo(i,j,i_r_direct ,i_r_ir )
447  log_error_cont('(A,F32.16)') 'surface albedo (IR, diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_ir )
448  log_error_cont('(A,F32.16)') 'surface albedo (NIR,direct ) [1] :', albedo(i,j,i_r_direct ,i_r_nir)
449  log_error_cont('(A,F32.16)') 'surface albedo (NIR,diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_nir)
450  log_error_cont('(A,F32.16)') 'surface albedo (VIS,direct ) [1] :', albedo(i,j,i_r_direct ,i_r_vis)
451  log_error_cont('(A,F32.16)') 'surface albedo (VIS,diffuse) [1] :', albedo(i,j,i_r_diffuse,i_r_vis)
452  log_error_cont('(A,F32.16)') 'latent heat [J/kg] :', lh(i,j)
453  log_error_cont('(A,F32.16)') 'stomata registance [1/s] :', rb(i,j)
454  log_error_cont('(A,F32.16)') 'thermal conductivity / depth [J/m2/s/K] :', tc_dz(i,j)
455  log_error_cont('(A,F32.16)') 'roughness length for momemtum [m] :', z0m(i,j)
456  log_error_cont('(A,F32.16)') 'roughness length for heat [m] :', z0h(i,j)
457  log_error_cont('(A,F32.16)') 'roughness length for vapor [m] :', z0e(i,j)
458  log_error_cont('(A,F32.16)') 'time step [s] :', dt
459  log_error_cont('(A,F32.16)') 'friction velocity [m/s] :', ustar(i,j)
460  log_error_cont('(A,F32.16)') 'friction potential temperature [K] :', tstar(i,j)
461  log_error_cont('(A,F32.16)') 'friction water vapor mass ratio [kg/kg] :', qstar(i,j)
462  log_error_cont('(A,F32.16)') 'free convection velocity scale [m/s] :', wstar(i,j)
463  log_error_cont('(A,F32.16)') 'd(friction velocity) [m/s] :', dustar
464  log_error_cont('(A,F32.16)') 'd(friction potential temperature) [K] :', dtstar
465  log_error_cont('(A,F32.16)') 'd(friction water vapor mass ratio) [kg/kg] :', dqstar
466  log_error_cont('(A,F32.16)') 'd(free convection velocity scale) [m/s] :', dwstar
467  log_error_cont('(A,F32.16)') 'next surface temperature [K] :', tmps1(i,j)
468  call prc_abort
469  endif
470  endif
471 
472  ! calculate surface flux
473  tmps(i,j) = tmps1(i,j)
474 
475 ! qdry = 1.0_RP - QVA(i,j)
476  ! Rtot = qdry * Rdry + QVA(i,j) * Rvap
477 
478  call qsat( tmps(i,j), rhos(i,j), qvsat )
479 ! call qsat( TMPS(i,j), PRSS(i,j), qdry, QVsat )
480 
481  qvs(i,j) = ( 1.0_rp-qvef(i,j) ) * qva(i,j) &
482  + ( qvef(i,j) ) * qvsat
483 
484  call bulkflux( tmpa(i,j), tmps(i,j), & ! [IN]
485  prsa(i,j), prss(i,j), & ! [IN]
486  qva(i,j), qvs(i,j), & ! [IN]
487  uabs, z1(i,j), pbl(i,j), & ! [IN]
488  z0m(i,j), z0h(i,j), z0e(i,j), & ! [IN]
489  ustar(i,j), tstar(i,j), qstar(i,j), & ! [OUT]
490  wstar(i,j), rlmo(i,j), ra, & ! [OUT]
491  fracu10(i,j), fract2(i,j), fracq2(i,j) ) ! [OUT]
492 
493  if ( uabs < eps ) then
494  zmflx(i,j) = 0.0_rp
495  xmflx(i,j) = 0.0_rp
496  ymflx(i,j) = 0.0_rp
497  else
498  mflux = - rhos(i,j) * ustar(i,j)**2
499  zmflx(i,j) = mflux * wa(i,j) / uabs
500  xmflx(i,j) = mflux * ua(i,j) / uabs
501  ymflx(i,j) = mflux * va(i,j) / uabs
502  end if
503  shflx(i,j) = -rhos(i,j) * ustar(i,j) * tstar(i,j) * cpdry
504  qvflx(i,j) = min( - rhos(i,j) * ustar(i,j) * qstar(i,j) * ra / ( ra+rb(i,j) ), wstr(i,j)/real(dt,rp) )
505 
506  emis = ( 1.0_rp-albedo(i,j,i_r_diffuse,i_r_ir) ) * stb * tmps(i,j)**4
507 
508  lwd = rflxd(i,j,i_r_diffuse,i_r_ir)
509  lwu = rflxd(i,j,i_r_diffuse,i_r_ir) * albedo(i,j,i_r_diffuse,i_r_ir) + emis
510  swd = rflxd(i,j,i_r_direct ,i_r_nir) &
511  + rflxd(i,j,i_r_diffuse,i_r_nir) &
512  + rflxd(i,j,i_r_direct ,i_r_vis) &
513  + rflxd(i,j,i_r_diffuse,i_r_vis)
514  swu = rflxd(i,j,i_r_direct ,i_r_nir) * albedo(i,j,i_r_direct ,i_r_nir) &
515  + rflxd(i,j,i_r_diffuse,i_r_nir) * albedo(i,j,i_r_diffuse,i_r_nir) &
516  + rflxd(i,j,i_r_direct ,i_r_vis) * albedo(i,j,i_r_direct ,i_r_vis) &
517  + rflxd(i,j,i_r_diffuse,i_r_vis) * albedo(i,j,i_r_diffuse,i_r_vis)
518 
519  gflx(i,j) = tc_dz(i,j) * ( tmps(i,j) - tg(i,j) )
520 
521  lhflx(i,j) = qvflx(i,j) * lh(i,j)
522 
523 
524  ! calculation for residual
525  res = swd - swu + lwd - lwu - shflx(i,j) - lhflx(i,j) - gflx(i,j)
526 
527  ! put residual in ground heat flux
528  gflx(i,j) = gflx(i,j) + res
529 
530  else ! not calculate surface flux
531  zmflx(i,j) = undef
532  xmflx(i,j) = undef
533  ymflx(i,j) = undef
534  shflx(i,j) = undef
535  lhflx(i,j) = undef
536  qvflx(i,j) = undef
537  gflx(i,j) = undef
538  ustar(i,j) = undef
539  tstar(i,j) = undef
540  qstar(i,j) = undef
541  wstar(i,j) = undef
542  rlmo(i,j) = undef
543  u10(i,j) = undef
544  v10(i,j) = undef
545  t2(i,j) = undef
546  q2(i,j) = undef
547  endif
548  enddo
549  enddo
550 
551  call bulkflux_diagnose_surface( ia, is, ie, ja, js, je, &
552  ua(:,:), va(:,:), & ! (in)
553  tmpa(:,:), qva(:,:), & ! (in)
554  tmps(:,:), qvs(:,:), & ! (in)
555  z1(:,:), z0m(:,:), z0h(:,:), z0e(:,:), & ! (in)
556  u10(:,:), v10(:,:), t2(:,:), q2(:,:), & ! (out)
557  mask = calc_flag(:,:), & ! (in)
558  fracu10 = fracu10(:,:), & ! (in)
559  fract2 = fract2(:,:), & ! (in)
560  fracq2 = fracq2(:,:) ) ! (in)
561 
562  return

References scale_bulkflux::bulkflux, scale_const::const_cpdry, scale_const::const_eps, scale_const::const_pre00, scale_const::const_rdry, scale_const::const_rvap, scale_const::const_stb, scale_const::const_tem00, scale_const::const_undef, scale_atmos_hydrometeor::cv_ice, scale_atmos_hydrometeor::cv_water, 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, scale_atmos_hydrometeor::lhf, scale_prc::prc_abort(), and scale_prc::prc_myrank.

Referenced by mod_land_driver::land_driver_calc_tendency().

Here is the call graph for this function:
Here is the caller graph for this function:
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
scale_bulkflux
module Surface bulk flux
Definition: scale_bulkflux.F90:12
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:90
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_hydrometeor::lhf
real(rp), public lhf
latent heat of fusion for use [J/kg]
Definition: scale_atmos_hydrometeor.F90:128
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
scale_atmos_hydrometeor::cv_water
real(rp), public cv_water
CV for water [J/kg/K].
Definition: scale_atmos_hydrometeor.F90:132
scale_atmos_hydrometeor::cv_ice
real(rp), public cv_ice
CV for ice [J/kg/K].
Definition: scale_atmos_hydrometeor.F90:134
Generated by   doxygen 1.8.17