SCALE-RM
scale_land_sfc_slab.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 module scale_land_sfc_slab
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_stdio
18  use scale_grid_index
19  !-----------------------------------------------------------------------------
20  implicit none
21  private
22  !-----------------------------------------------------------------------------
23  !
24  !++ Public procedure
25  !
26  public :: land_sfc_slab_setup
27  public :: land_sfc_slab
28 
29  !-----------------------------------------------------------------------------
30  !
31  !++ Public parameters & variables
32  !
33  !-----------------------------------------------------------------------------
34  !
35  !++ Private procedure
36  !
37  !-----------------------------------------------------------------------------
38  !
39  !++ Private parameters & variables
40  !
41  !-----------------------------------------------------------------------------
42  logical, private :: lst_update
43 
44  integer, private :: land_sfc_slab_itr_max = 100 ! maximum iteration number
45 
46  real(RP), private :: land_sfc_slab_dts_max = 5.0e-2_rp ! maximum delta surface temperature [K/s]
47  real(RP), private :: land_sfc_slab_res_min = 1.0e+0_rp ! minimum value of residual
48  real(RP), private :: land_sfc_slab_err_min = 1.0e-2_rp ! minimum value of error
49  real(RP), private :: land_sfc_slab_dreslim = 1.0e+2_rp ! limiter of d(residual)
50 
51  logical, allocatable, private :: is_lnd(:,:)
52 
53 contains
54  !-----------------------------------------------------------------------------
56  subroutine land_sfc_slab_setup( LAND_TYPE )
57  use scale_process, only: &
58  prc_mpistop
59  use scale_landuse, only: &
60  landuse_fact_land
61  implicit none
62 
63  character(len=*), intent(in) :: LAND_TYPE
64 
65  namelist / param_land_sfc_slab / &
66  land_sfc_slab_itr_max, &
67  land_sfc_slab_dts_max, &
68  land_sfc_slab_res_min, &
69  land_sfc_slab_err_min, &
70  land_sfc_slab_dreslim
71 
72  integer :: i, j
73  integer :: ierr
74  !---------------------------------------------------------------------------
75 
76  if( io_l ) write(io_fid_log,*)
77  if( io_l ) write(io_fid_log,*) '++++++ Module[SLAB] / Categ[LAND SFC] / Origin[SCALElib]'
78 
79  !--- read namelist
80  rewind(io_fid_conf)
81  read(io_fid_conf,nml=param_land_sfc_slab,iostat=ierr)
82  if( ierr < 0 ) then !--- missing
83  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
84  elseif( ierr > 0 ) then !--- fatal error
85  write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_SFC_SLAB. Check!'
86  call prc_mpistop
87  endif
88  if( io_lnml ) write(io_fid_log,nml=param_land_sfc_slab)
89 
90  if( land_type == 'CONST' ) then
91  lst_update = .false.
92  else if( land_type == 'SLAB' ) then
93  lst_update = .true.
94  else
95  write(*,*) 'xxx wrong LAND_TYPE. Check!'
96  call prc_mpistop
97  end if
98 
99  ! judge to run slab land model
100  allocate( is_lnd(ia,ja) )
101 
102  do j = js, je
103  do i = is, ie
104  if( landuse_fact_land(i,j) > 0.0_rp ) then
105  is_lnd(i,j) = .true.
106  else
107  is_lnd(i,j) = .false.
108  end if
109  end do
110  end do
111 
112  return
113  end subroutine land_sfc_slab_setup
114 
115  !-----------------------------------------------------------------------------
116  subroutine land_sfc_slab( &
117  LST_t, &
118  ZMFLX, &
119  XMFLX, &
120  YMFLX, &
121  SHFLX, &
122  LHFLX, &
123  GHFLX, &
124  U10, &
125  V10, &
126  T2, &
127  Q2, &
128  TMPA, &
129  PRSA, &
130  WA, &
131  UA, &
132  VA, &
133  RHOA, &
134  QVA, &
135  Z1, &
136  PBL, &
137  PRSS, &
138  LWD, &
139  SWD, &
140  TG, &
141  LST, &
142  QVEF, &
143  ALB_LW, &
144  ALB_SW, &
145  DZG, &
146  TCS, &
147  Z0M, &
148  Z0H, &
149  Z0E, &
150  dt )
151  use scale_process, only: &
152  prc_myrank, &
153  prc_mpistop
154  use scale_const, only: &
155  eps => const_eps, &
156  rdry => const_rdry, &
157  cpdry => const_cpdry, &
158  stb => const_stb
159  use scale_grid_index
160  use scale_atmos_saturation, only: &
161  qsat => atmos_saturation_pres2qsat_all
162  use scale_atmos_thermodyn, only: &
163  atmos_thermodyn_templhv
164  use scale_bulkflux, only: &
165  bulkflux
166  implicit none
167 
168  ! parameters
169  real(RP), parameter :: dTS0 = 1.0e-4_rp ! delta surface temp.
170 
171  real(RP), parameter :: redf_min = 1.0e-2_rp ! minimum reduced factor
172  real(RP), parameter :: redf_max = 1.0e+0_rp ! maximum reduced factor
173  real(RP), parameter :: TFa = 0.5e+0_rp ! factor a in Tomita (2009)
174  real(RP), parameter :: TFb = 1.1e+0_rp ! factor b in Tomita (2009)
175 
176  ! arguments
177  real(RP), intent(out) :: LST_t(ia,ja) ! tendency of LST
178  real(RP), intent(out) :: ZMFLX(ia,ja) ! z-momentum flux at the surface [kg/m2/s]
179  real(RP), intent(out) :: XMFLX(ia,ja) ! x-momentum flux at the surface [kg/m2/s]
180  real(RP), intent(out) :: YMFLX(ia,ja) ! y-momentum flux at the surface [kg/m2/s]
181  real(RP), intent(out) :: SHFLX(ia,ja) ! sensible heat flux at the surface [J/m2/s]
182  real(RP), intent(out) :: LHFLX(ia,ja) ! latent heat flux at the surface [J/m2/s]
183  real(RP), intent(out) :: GHFLX(ia,ja) ! ground heat flux at the surface [J/m2/s]
184  real(RP), intent(out) :: U10 (ia,ja) ! velocity u at 10m [m/s]
185  real(RP), intent(out) :: V10 (ia,ja) ! velocity v at 10m [m/s]
186  real(RP), intent(out) :: T2 (ia,ja) ! temperature at 2m [K]
187  real(RP), intent(out) :: Q2 (ia,ja) ! water vapor at 2m [kg/kg]
188 
189  real(RP), intent(in) :: TMPA(ia,ja) ! temperature at the lowest atmospheric layer [K]
190  real(RP), intent(in) :: PRSA(ia,ja) ! pressure at the lowest atmospheric layer [Pa]
191  real(RP), intent(in) :: WA (ia,ja) ! velocity w at the lowest atmospheric layer [m/s]
192  real(RP), intent(in) :: UA (ia,ja) ! velocity u at the lowest atmospheric layer [m/s]
193  real(RP), intent(in) :: VA (ia,ja) ! velocity v at the lowest atmospheric layer [m/s]
194  real(RP), intent(in) :: RHOA(ia,ja) ! density at the lowest atmospheric layer [kg/m3]
195  real(RP), intent(in) :: QVA (ia,ja) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
196  real(RP), intent(in) :: Z1 (ia,ja) ! cell center height at the lowest atmospheric layer [m]
197  real(RP), intent(in) :: PBL (ia,ja) ! the top of atmospheric mixing layer [m]
198  real(RP), intent(in) :: PRSS(ia,ja) ! pressure at the surface [Pa]
199  real(RP), intent(in) :: LWD (ia,ja) ! downward long-wave radiation flux at the surface [J/m2/s]
200  real(RP), intent(in) :: SWD (ia,ja) ! downward short-wave radiation flux at the surface [J/m2/s]
201 
202  real(RP), intent(in) :: TG (ia,ja) ! soil temperature [K]
203  real(RP), intent(in) :: LST (ia,ja) ! land surface temperature [K]
204  real(RP), intent(in) :: QVEF (ia,ja) ! efficiency of evaporation [0-1]
205  real(RP), intent(in) :: ALB_LW(ia,ja) ! surface albedo for LW [0-1]
206  real(RP), intent(in) :: ALB_SW(ia,ja) ! surface albedo for SW [0-1]
207  real(RP), intent(in) :: DZG (ia,ja) ! soil depth [m]
208  real(RP), intent(in) :: TCS (ia,ja) ! thermal conductivity for soil [J/m/K/s]
209  real(RP), intent(in) :: Z0M (ia,ja) ! roughness length for momemtum [m]
210  real(RP), intent(in) :: Z0H (ia,ja) ! roughness length for heat [m]
211  real(RP), intent(in) :: Z0E (ia,ja) ! roughness length for vapor [m]
212  real(DP), intent(in) :: dt ! delta time
213 
214  ! works
215  real(RP) :: LST1(ia,ja)
216 
217  real(RP) :: res ! residual
218  real(RP) :: dres ! d(residual)/dLST
219  real(RP) :: oldres ! residual in previous step
220  real(RP) :: redf ! reduced factor
221 
222  real(RP) :: Ustar, dUstar ! friction velocity [m]
223  real(RP) :: Tstar, dTstar ! friction potential temperature [K]
224  real(RP) :: Qstar, dQstar ! friction water vapor mass ratio [kg/kg]
225  real(RP) :: Uabs, dUabs ! modified absolute velocity [m/s]
226  real(RP) :: SQV, dSQV ! saturation water vapor mixing ratio at surface [kg/kg]
227 
228  real(RP) :: LHV(ia,ja) ! latent heat for vaporization depending on temperature [J/kg]
229 
230  integer :: i, j, n
231  !---------------------------------------------------------------------------
232 
233  ! copy land surfce temperature for iteration
234  do j = js, je
235  do i = is, ie
236  lst1(i,j) = lst(i,j)
237  end do
238  end do
239 
240  call atmos_thermodyn_templhv( lhv, tmpa )
241 
242  ! update surface temperature
243  if( lst_update ) then
244 
245  do j = js, je
246  do i = is, ie
247 
248  if( is_lnd(i,j) ) then
249 
250  redf = 1.0_rp
251  oldres = huge(0.0_rp)
252 
253  ! modified Newton-Raphson method (Tomita 2009)
254  do n = 1, land_sfc_slab_itr_max
255 
256  call qsat( sqv, & ! [OUT]
257  lst1(i,j), & ! [IN]
258  prss(i,j) ) ! [IN]
259  call qsat( dsqv, & ! [OUT]
260  lst1(i,j)+dts0, & ! [IN]
261  prss(i,j) ) ! [IN]
262 
263  call bulkflux( &
264  ustar, & ! [OUT]
265  tstar, & ! [OUT]
266  qstar, & ! [OUT]
267  uabs, & ! [OUT]
268  tmpa(i,j), & ! [IN]
269  lst1(i,j), & ! [IN]
270  prsa(i,j), & ! [IN]
271  prss(i,j), & ! [IN]
272  qva(i,j), & ! [IN]
273  sqv, & ! [IN]
274  ua(i,j), & ! [IN]
275  va(i,j), & ! [IN]
276  z1(i,j), & ! [IN]
277  pbl(i,j), & ! [IN]
278  z0m(i,j), & ! [IN]
279  z0h(i,j), & ! [IN]
280  z0e(i,j) ) ! [IN]
281 
282  call bulkflux( &
283  dustar, & ! [OUT]
284  dtstar, & ! [OUT]
285  dqstar, & ! [OUT]
286  duabs, & ! [OUT]
287  tmpa(i,j), & ! [IN]
288  lst1(i,j)+dts0, & ! [IN]
289  prsa(i,j), & ! [IN]
290  prss(i,j), & ! [IN]
291  qva(i,j), & ! [IN]
292  dsqv, & ! [IN]
293  ua(i,j), & ! [IN]
294  va(i,j), & ! [IN]
295  z1(i,j), & ! [IN]
296  pbl(i,j), & ! [IN]
297  z0m(i,j), & ! [IN]
298  z0h(i,j), & ! [IN]
299  z0e(i,j) ) ! [IN]
300 
301  ! calculation for residual
302  res = ( 1.0_rp - alb_sw(i,j) ) * swd(i,j) &
303  + ( 1.0_rp - alb_lw(i,j) ) * ( lwd(i,j) - stb * lst1(i,j)**4 ) &
304  + cpdry * rhoa(i,j) * ustar * tstar &
305  + lhv(i,j) * rhoa(i,j) * ustar * qstar * qvef(i,j) &
306  - 2.0_rp * tcs(i,j) * ( lst1(i,j) - tg(i,j) ) / dzg(i,j)
307 
308  ! calculation for d(residual)/dLST
309  dres = -4.0_rp * ( 1.0_rp - alb_lw(i,j) ) * stb * lst1(i,j)**3 &
310  + cpdry * rhoa(i,j) * ( (dustar-ustar)/dts0 * tstar + ustar * (dtstar-tstar)/dts0 ) &
311  + lhv(i,j) * rhoa(i,j) * ( (dustar-ustar)/dts0 * qstar + ustar * (dqstar-qstar)/dts0 ) * qvef(i,j) &
312  - 2.0_rp * tcs(i,j) / dzg(i,j)
313 
314  ! convergence test with residual and error levels
315  if( abs( res ) < land_sfc_slab_res_min .OR. &
316  abs( res/dres ) < land_sfc_slab_err_min ) then
317  exit
318  end if
319 
320  ! stop iteration to prevent numerical error
321  if( abs(dres) * land_sfc_slab_dreslim < abs(res) ) then
322  exit
323  end if
324 
325  ! calculate reduced factor
326  if( dres < 0.0_rp ) then
327  if( abs(res) > abs(oldres) ) then
328  redf = max( tfa*abs(redf), redf_min )
329  else
330  redf = min( tfb*abs(redf), redf_max )
331  end if
332  else
333  redf = -1.0_rp
334  end if
335 
336  ! estimate next surface temperature
337  lst1(i,j) = lst1(i,j) - redf * res / dres
338 
339  ! save residual in this step
340  oldres = res
341 
342  end do
343 
344  ! update land surface temperature with limitation
345  lst1(i,j) = min( max( lst1(i,j), &
346  lst(i,j) - land_sfc_slab_dts_max * dt ), &
347  lst(i,j) + land_sfc_slab_dts_max * dt )
348 
349  if( n > land_sfc_slab_itr_max ) then
350  ! land surface temperature was not converged
351  if( io_l ) write(io_fid_log,'(A)' ) 'Warning: land surface tempearture was not converged.'
352  if( io_l ) write(io_fid_log,'(A)' ) ''
353  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- PRC_myrank [no unit] :', prc_myrank
354  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- number of i [no unit] :', i
355  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- number of j [no unit] :', j
356  if( io_l ) write(io_fid_log,'(A)' ) ''
357  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- loop number [no unit] :', n
358  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- Residual [J/m2/s] :', res
359  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- delta Residual [J/m2/s] :', dres
360  if( io_l ) write(io_fid_log,'(A,F32.16)') ''
361  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- temperature [K] :', tmpa(i,j)
362  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- pressure [Pa] :', prsa(i,j)
363  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity w [m/s] :', wa(i,j)
364  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity u [m/s] :', ua(i,j)
365  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity v [m/s] :', va(i,j)
366  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- density [kg/m3] :', rhoa(i,j)
367  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- water vapor mass ratio [kg/kg] :', qva(i,j)
368  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- cell center height [m] :', z1(i,j)
369  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- atmospheric mixing layer height [m] :', pbl(i,j)
370  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- pressure at the surface [Pa] :', prss(i,j)
371  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- downward long-wave radiation [J/m2/s] :', lwd(i,j)
372  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- downward short-wave radiation [J/m2/s] :', swd(i,j)
373  if( io_l ) write(io_fid_log,'(A)' ) ''
374  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- soil temperature [K] :', tg(i,j)
375  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- land surface temperature [K] :', lst(i,j)
376  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- efficiency of evaporation [0-1] :', qvef(i,j)
377  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- surface albedo for LW [0-1] :', alb_lw(i,j)
378  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- surface albedo for SW [0-1] :', alb_sw(i,j)
379  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- soil depth [m] :', dzg(i,j)
380  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- thermal conductivity for soil [J/m/K/s] :', tcs(i,j)
381  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for momemtum [m] :', z0m(i,j)
382  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for heat [m] :', z0h(i,j)
383  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for vapor [m] :', z0e(i,j)
384  if( io_l ) write(io_fid_log,'(A)' ) ''
385  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- latent heat [J/kg] :', lhv(i,j)
386  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction velocity [m] :', ustar
387  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction potential temperature [K] :', tstar
388  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction water vapor mass ratio [kg/kg] :', qstar
389  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction velocity) [m] :', dustar
390  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction potential temperature) [K] :', dtstar
391  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction water vapor mass ratio) [kg/kg] :', dqstar
392  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- modified absolute velocity [m/s] :', uabs
393  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- next land surface temperature [K] :', lst1(i,j)
394 
395  ! check NaN
396  if ( .NOT. ( res > -1.0_rp .OR. res < 1.0_rp ) ) then ! must be NaN
397  write(*,*) 'xxx NaN is detected for land surface temperature.'
398  write(*,*) ''
399  write(*,*) 'DEBUG --- PRC_myrank :', prc_myrank
400  write(*,*) 'DEBUG --- number of i :', i
401  write(*,*) 'DEBUG --- number of j :', j
402  write(*,*) ''
403  write(*,*) 'DEBUG --- Residual [J/m2/s] :', res
404  write(*,*) 'DEBUG --- delta Residual [J/m2/s] :', dres
405  write(*,*) ''
406  write(*,*) 'DEBUG --- temperature [K] :', tmpa(i,j)
407  write(*,*) 'DEBUG --- pressure [Pa] :', prsa(i,j)
408  write(*,*) 'DEBUG --- velocity w [m/s] :', wa(i,j)
409  write(*,*) 'DEBUG --- velocity u [m/s] :', ua(i,j)
410  write(*,*) 'DEBUG --- velocity v [m/s] :', va(i,j)
411  write(*,*) 'DEBUG --- density [kg/m3] :', rhoa(i,j)
412  write(*,*) 'DEBUG --- water vapor mass ratio [kg/kg] :', qva(i,j)
413  write(*,*) 'DEBUG --- cell center height [m] :', z1(i,j)
414  write(*,*) 'DEBUG --- atmospheric mixing layer height [m] :', pbl(i,j)
415  write(*,*) 'DEBUG --- pressure at the surface [Pa] :', prss(i,j)
416  write(*,*) 'DEBUG --- downward long-wave radiation [J/m2/s] :', lwd(i,j)
417  write(*,*) 'DEBUG --- downward short-wave radiation [J/m2/s] :', swd(i,j)
418  write(*,*) ''
419  write(*,*) 'DEBUG --- soil temperature [K] :', tg(i,j)
420  write(*,*) 'DEBUG --- land surface temperature [K] :', lst(i,j)
421  write(*,*) 'DEBUG --- efficiency of evaporation [0-1] :', qvef(i,j)
422  write(*,*) 'DEBUG --- surface albedo for LW [0-1] :', alb_lw(i,j)
423  write(*,*) 'DEBUG --- surface albedo for SW [0-1] :', alb_sw(i,j)
424  write(*,*) 'DEBUG --- soil depth [m] :', dzg(i,j)
425  write(*,*) 'DEBUG --- thermal conductivity for soil [J/m/K/s] :', tcs(i,j)
426  write(*,*) 'DEBUG --- roughness length for momemtum [m] :', z0m(i,j)
427  write(*,*) 'DEBUG --- roughness length for heat [m] :', z0h(i,j)
428  write(*,*) 'DEBUG --- roughness length for vapor [m] :', z0e(i,j)
429  write(*,*) ''
430  write(*,*) 'DEBUG --- latent heat [J/kg] :', lhv(i,j)
431  write(*,*) 'DEBUG --- friction velocity [m] :', ustar
432  write(*,*) 'DEBUG --- friction potential temperature [K] :', tstar
433  write(*,*) 'DEBUG --- friction water vapor mass ratio [kg/kg] :', qstar
434  write(*,*) 'DEBUG --- d(friction velocity) [m] :', dustar
435  write(*,*) 'DEBUG --- d(friction potential temperature) [K] :', dtstar
436  write(*,*) 'DEBUG --- d(friction water vapor mass ratio) [kg/kg] :', dqstar
437  write(*,*) 'DEBUG --- modified absolute velocity [m/s] :', uabs
438  write(*,*) 'DEBUG --- next land surface temperature [K] :', lst1(i,j)
439 
440  call prc_mpistop
441  endif
442 
443  end if
444 
445  end if
446 
447  ! calculate tendency
448  lst_t(i,j) = ( lst1(i,j) - lst(i,j) ) / dt
449 
450  end do
451  end do
452 
453  ! not update temperature
454  else
455 
456  do j = js, je
457  do i = is, ie
458  lst_t(i,j) = 0.0_rp
459  end do
460  end do
461 
462  end if
463 
464 
465  ! calculate surface flux
466  do j = js, je
467  do i = is, ie
468 
469  if( is_lnd(i,j) ) then
470 
471  call qsat( sqv, & ! [OUT]
472  lst1(i,j), & ! [IN]
473  prss(i,j) ) ! [IN]
474 
475  call bulkflux( &
476  ustar, & ! [OUT]
477  tstar, & ! [OUT]
478  qstar, & ! [OUT]
479  uabs, & ! [OUT]
480  tmpa(i,j), & ! [IN]
481  lst1(i,j), & ! [IN]
482  prsa(i,j), & ! [IN]
483  prss(i,j), & ! [IN]
484  qva(i,j), & ! [IN]
485  sqv, & ! [IN]
486  ua(i,j), & ! [IN]
487  va(i,j), & ! [IN]
488  z1(i,j), & ! [IN]
489  pbl(i,j), & ! [IN]
490  z0m(i,j), & ! [IN]
491  z0h(i,j), & ! [IN]
492  z0e(i,j) ) ! [IN]
493 
494  zmflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * wa(i,j)
495  xmflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * ua(i,j)
496  ymflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * va(i,j)
497  shflx(i,j) = -cpdry * rhoa(i,j) * ustar * tstar
498  lhflx(i,j) = -lhv(i,j) * rhoa(i,j) * ustar * qstar * qvef(i,j)
499  ghflx(i,j) = -2.0_rp * tcs(i,j) * ( lst1(i,j) - tg(i,j) ) / dzg(i,j)
500 
501  ! calculation for residual
502  res = ( 1.0_rp - alb_sw(i,j) ) * swd(i,j) &
503  + ( 1.0_rp - alb_lw(i,j) ) * ( lwd(i,j) - stb * lst1(i,j)**4 ) &
504  - shflx(i,j) - lhflx(i,j) + ghflx(i,j)
505 
506  ! put residual in ground heat flux
507  ghflx(i,j) = ghflx(i,j) - res
508 
509  ! diagnostic variables
510  u10(i,j) = ua(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
511  v10(i,j) = va(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
512  t2(i,j) = lst1(i,j) + ( tmpa(i,j) - lst1(i,j) ) * ( log( 2.0_rp / z0m(i,j) ) * log( 2.0_rp / z0h(i,j) ) ) &
513  / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0h(i,j) ) )
514  q2(i,j) = sqv + ( qva(i,j) - sqv ) * ( log( 2.0_rp / z0m(i,j) ) * log( 2.0_rp / z0e(i,j) ) ) &
515  / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0e(i,j) ) )
516  else
517 
518  ! not calculate surface flux
519  zmflx(i,j) = 0.0_rp
520  xmflx(i,j) = 0.0_rp
521  ymflx(i,j) = 0.0_rp
522  shflx(i,j) = 0.0_rp
523  lhflx(i,j) = 0.0_rp
524  ghflx(i,j) = 0.0_rp
525  u10(i,j) = 0.0_rp
526  v10(i,j) = 0.0_rp
527  t2(i,j) = 0.0_rp
528  q2(i,j) = 0.0_rp
529 
530  end if
531 
532  end do
533  end do
534 
535  return
536  end subroutine land_sfc_slab
537 
538 end module scale_land_sfc_slab
scale_grid_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_grid_index.F90:60
scale_grid_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_grid_index.F90:63
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:58
scale_atmos_saturation
module ATMOSPHERE / Saturation adjustment
Definition: scale_atmos_sub_saturation.F90:16
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_const::const_stb
real(rp), parameter, public const_stb
Stefan-Boltzman constant [W/m2/K4].
Definition: scale_const.F90:51
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:59
scale_land_sfc_slab::land_sfc_slab
subroutine, public land_sfc_slab(LST_t, ZMFLX, XMFLX, YMFLX, SHFLX, LHFLX, GHFLX, U10, V10, T2, Q2, TMPA, PRSA, WA, UA, VA, RHOA, QVA, Z1, PBL, PRSS, LWD, SWD, TG, LST, QVEF, ALB_LW, ALB_SW, DZG, TCS, Z0M, Z0H, Z0E, dt)
Definition: scale_land_sfc_slab.F90:151
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:57
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_grid_index::ia
integer, public ia
of x whole cells (local, with HALO)
Definition: scale_grid_index.F90:55
scale_landuse
module LANDUSE
Definition: scale_landuse.F90:11
scale_bulkflux::bulkflux
procedure(bc), pointer, public bulkflux
Definition: scale_bulkflux.F90:71
scale_grid_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_grid_index.F90:62
scale_process
module PROCESS
Definition: scale_process.F90:14
dc_log::log
subroutine, public log(type, message)
Definition: dc_log.f90:133
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_process::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_process.F90:78
scale_land_sfc_slab::land_sfc_slab_setup
subroutine, public land_sfc_slab_setup(LAND_TYPE)
Setup.
Definition: scale_land_sfc_slab.F90:57
scale_grid_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_grid_index.F90:61
scale_bulkflux
module Surface bulk flux
Definition: scale_bulkflux.F90:12
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:36
scale_atmos_thermodyn
module ATMOSPHERE / Thermodynamics
Definition: scale_atmos_sub_thermodyn.F90:19
scale_stdio::io_lnml
logical, public io_lnml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:60
scale_land_sfc_slab
module LAND / Surface fluxes with slab land model
Definition: scale_land_sfc_slab.F90:11
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_landuse::landuse_fact_land
real(rp), dimension(:,:), allocatable, public landuse_fact_land
land factor
Definition: scale_landuse.F90:36
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_grid_index::ja
integer, public ja
of y whole cells (local, with HALO)
Definition: scale_grid_index.F90:56
Generated by   doxygen 1.8.13