SCALE-RM
Functions/Subroutines
scale_land_sfc_thin_slab Module Reference

module LAND / Surface fluxes with thin-slab land model More...

Functions/Subroutines

subroutine, public land_sfc_thin_slab_setup (LAND_TYPE)
 Setup. More...
 
subroutine, public land_sfc_thin_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)
 

Detailed Description

module LAND / Surface fluxes with thin-slab land model

Description
Surface flux with thin-slab land model
Author
Team SCALE
NAMELIST
  • PARAM_LAND_SFC_THIN_SLAB
    nametypedefault valuecomment
    LAND_SFC_THIN_SLAB_ITR_MAX integer 100 maximum iteration number
    LAND_SFC_THIN_SLAB_DTS_MAX real(RP) 5.0E-2_RP maximum delta surface temperature [K/s]
    LAND_SFC_THIN_SLAB_RES_MIN real(RP) 1.0E+0_RP minimum value of residual
    LAND_SFC_THIN_SLAB_ERR_MIN real(RP) 1.0E-2_RP minimum value of error
    LAND_SFC_THIN_SLAB_DRESLIM real(RP) 1.0E+2_RP limiter of d(residual)

History Output
No history output

Function/Subroutine Documentation

◆ land_sfc_thin_slab_setup()

subroutine, public scale_land_sfc_thin_slab::land_sfc_thin_slab_setup ( character(len=*), intent(in)  LAND_TYPE)

Setup.

Definition at line 53 of file scale_land_sfc_thin-slab.F90.

References scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, and scale_process::prc_mpistop().

Referenced by scale_land_sfc::land_sfc_setup().

53  use scale_process, only: &
54  prc_mpistop
55  implicit none
56 
57  character(len=*), intent(in) :: LAND_TYPE
58 
59  namelist / param_land_sfc_thin_slab / &
60  land_sfc_thin_slab_itr_max, &
61  land_sfc_thin_slab_dts_max, &
62  land_sfc_thin_slab_res_min, &
63  land_sfc_thin_slab_err_min, &
64  land_sfc_thin_slab_dreslim
65 
66  integer :: ierr
67  !---------------------------------------------------------------------------
68 
69  if( io_l ) write(io_fid_log,*)
70  if( io_l ) write(io_fid_log,*) '++++++ Module[THIN-SLAB] / Categ[LAND SFC] / Origin[SCALElib]'
71 
72  !--- read namelist
73  rewind(io_fid_conf)
74  read(io_fid_conf,nml=param_land_sfc_thin_slab,iostat=ierr)
75  if( ierr < 0 ) then !--- missing
76  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
77  elseif( ierr > 0 ) then !--- fatal error
78  write(*,*) 'xxx Not appropriate names in namelist PARAM_LAND_SFC_THIN_SLAB. Check!'
79  call prc_mpistop
80  endif
81  if( io_nml ) write(io_fid_nml,nml=param_land_sfc_thin_slab)
82 
83  return
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
Here is the call graph for this function:
Here is the caller graph for this function:

◆ land_sfc_thin_slab()

subroutine, public scale_land_sfc_thin_slab::land_sfc_thin_slab ( real(rp), dimension(ia,ja), intent(out)  LST_t,
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)  GHFLX,
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,
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)  Z1,
real(rp), dimension (ia,ja), intent(in)  PBL,
real(rp), dimension(ia,ja), intent(in)  PRSS,
real(rp), dimension (ia,ja), intent(in)  LWD,
real(rp), dimension (ia,ja), intent(in)  SWD,
real(rp), dimension (ia,ja), intent(in)  TG,
real(rp), dimension (ia,ja), intent(in)  LST,
real(rp), dimension (ia,ja), intent(in)  QVEF,
real(rp), dimension(ia,ja), intent(in)  ALB_LW,
real(rp), dimension(ia,ja), intent(in)  ALB_SW,
real(rp), dimension (ia,ja), intent(in)  DZG,
real(rp), dimension (ia,ja), intent(in)  TCS,
real(rp), dimension (ia,ja), intent(in)  Z0M,
real(rp), dimension (ia,ja), intent(in)  Z0H,
real(rp), dimension (ia,ja), intent(in)  Z0E,
real(dp), intent(in)  dt 
)

Definition at line 122 of file scale_land_sfc_thin-slab.F90.

References scale_bulkflux::bulkflux, scale_const::const_cpdry, scale_const::const_pre00, scale_const::const_rdry, scale_const::const_stb, scale_grid_index::ie, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_landuse::landuse_fact_land, scale_process::prc_mpistop(), and scale_process::prc_myrank.

Referenced by scale_land_sfc::land_sfc_setup().

122  use scale_process, only: &
123  prc_myrank, &
124  prc_mpistop
125  use scale_const, only: &
126  pre00 => const_pre00, &
127  rdry => const_rdry, &
128  cpdry => const_cpdry, &
129  stb => const_stb
130  use scale_landuse, only: &
131  landuse_fact_land
132  use scale_atmos_hydrometeor, only: &
133  hydrometeor_lhv => atmos_hydrometeor_lhv
134  use scale_atmos_saturation, only: &
135  qsat => atmos_saturation_pres2qsat_all
136  use scale_bulkflux, only: &
137  bulkflux
138  implicit none
139 
140  ! parameters
141  real(RP), parameter :: dTS0 = 1.0e-4_rp ! delta surface temp.
142 
143  real(RP), parameter :: redf_min = 1.0e-2_rp ! minimum reduced factor
144  real(RP), parameter :: redf_max = 1.0e+0_rp ! maximum reduced factor
145  real(RP), parameter :: TFa = 0.5e+0_rp ! factor a in Tomita (2009)
146  real(RP), parameter :: TFb = 1.1e+0_rp ! factor b in Tomita (2009)
147 
148  ! arguments
149  real(RP), intent(out) :: LST_t(IA,JA) ! tendency of LST
150  real(RP), intent(out) :: ZMFLX(IA,JA) ! z-momentum flux at the surface [kg/m/s2]
151  real(RP), intent(out) :: XMFLX(IA,JA) ! x-momentum flux at the surface [kg/m/s2]
152  real(RP), intent(out) :: YMFLX(IA,JA) ! y-momentum flux at the surface [kg/m/s2]
153  real(RP), intent(out) :: SHFLX(IA,JA) ! sensible heat flux at the surface [J/m2/s]
154  real(RP), intent(out) :: LHFLX(IA,JA) ! latent heat flux at the surface [J/m2/s]
155  real(RP), intent(out) :: GHFLX(IA,JA) ! ground heat flux at the surface [J/m2/s]
156  real(RP), intent(out) :: U10 (IA,JA) ! velocity u at 10m [m/s]
157  real(RP), intent(out) :: V10 (IA,JA) ! velocity v at 10m [m/s]
158  real(RP), intent(out) :: T2 (IA,JA) ! temperature at 2m [K]
159  real(RP), intent(out) :: Q2 (IA,JA) ! water vapor at 2m [kg/kg]
160 
161  real(RP), intent(in) :: TMPA(IA,JA) ! temperature at the lowest atmospheric layer [K]
162  real(RP), intent(in) :: PRSA(IA,JA) ! pressure at the lowest atmospheric layer [Pa]
163  real(RP), intent(in) :: WA (IA,JA) ! velocity w at the lowest atmospheric layer [m/s]
164  real(RP), intent(in) :: UA (IA,JA) ! velocity u at the lowest atmospheric layer [m/s]
165  real(RP), intent(in) :: VA (IA,JA) ! velocity v at the lowest atmospheric layer [m/s]
166  real(RP), intent(in) :: RHOA(IA,JA) ! density at the lowest atmospheric layer [kg/m3]
167  real(RP), intent(in) :: QVA (IA,JA) ! ratio of water vapor mass to total mass at the lowest atmospheric layer [kg/kg]
168  real(RP), intent(in) :: Z1 (IA,JA) ! cell center height at the lowest atmospheric layer [m]
169  real(RP), intent(in) :: PBL (IA,JA) ! the top of atmospheric mixing layer [m]
170  real(RP), intent(in) :: PRSS(IA,JA) ! pressure at the surface [Pa]
171  real(RP), intent(in) :: LWD (IA,JA) ! downward long-wave radiation flux at the surface [J/m2/s]
172  real(RP), intent(in) :: SWD (IA,JA) ! downward short-wave radiation flux at the surface [J/m2/s]
173 
174  real(RP), intent(in) :: TG (IA,JA) ! soil temperature [K]
175  real(RP), intent(in) :: LST (IA,JA) ! land surface temperature [K]
176  real(RP), intent(in) :: QVEF (IA,JA) ! efficiency of evaporation (0-1)
177  real(RP), intent(in) :: ALB_LW(IA,JA) ! surface albedo for LW (0-1)
178  real(RP), intent(in) :: ALB_SW(IA,JA) ! surface albedo for SW (0-1)
179  real(RP), intent(in) :: DZG (IA,JA) ! soil depth [m]
180  real(RP), intent(in) :: TCS (IA,JA) ! thermal conductivity for soil [J/m/K/s]
181  real(RP), intent(in) :: Z0M (IA,JA) ! roughness length for momemtum [m]
182  real(RP), intent(in) :: Z0H (IA,JA) ! roughness length for heat [m]
183  real(RP), intent(in) :: Z0E (IA,JA) ! roughness length for vapor [m]
184  real(DP), intent(in) :: dt ! delta time
185 
186  ! works
187  real(RP) :: LST1(IA,JA)
188 
189  real(RP) :: res ! residual
190  real(RP) :: dres ! d(residual)/dLST
191  real(RP) :: oldres ! residual in previous step
192  real(RP) :: redf ! reduced factor
193 
194  real(RP) :: Ustar, dUstar ! friction velocity [m]
195  real(RP) :: Tstar, dTstar ! friction potential temperature [K]
196  real(RP) :: Qstar, dQstar ! friction water vapor mass ratio [kg/kg]
197  real(RP) :: Uabs, dUabs ! modified absolute velocity [m/s]
198  real(RP) :: QVsat, dQVsat ! saturation water vapor mixing ratio at surface [kg/kg]
199  real(RP) :: QVS, dQVS ! water vapor mixing ratio at surface [kg/kg]
200 
201  real(RP) :: FracU10 ! calculation parameter for U10 [-]
202  real(RP) :: FracT2 ! calculation parameter for T2 [-]
203  real(RP) :: FracQ2 ! calculation parameter for Q2 [-]
204 
205  real(RP) :: LHV(IA,JA) ! latent heat of vaporization [J/kg]
206 
207  integer :: i, j, n
208  !---------------------------------------------------------------------------
209 
210  if( io_l ) write(io_fid_log,*) '*** Land surface step: Thin-Slab'
211 
212  call hydrometeor_lhv( lhv(:,:), tmpa(:,:) )
213 
214  ! copy land surfce temperature for iteration
215  do j = js, je
216  do i = is, ie
217  lst1(i,j) = lst(i,j)
218  end do
219  end do
220 
221  ! update surface temperature
222  do j = js, je
223  do i = is, ie
224 
225  if( landuse_fact_land(i,j) > 0.0_rp ) then
226 
227  redf = 1.0_rp
228  oldres = huge(0.0_rp)
229 
230  ! modified Newton-Raphson method (Tomita 2009)
231  do n = 1, land_sfc_thin_slab_itr_max
232 
233  call qsat( qvsat, & ! [OUT]
234  lst1(i,j), & ! [IN]
235  prss(i,j) ) ! [IN]
236  call qsat( dqvsat, & ! [OUT]
237  lst1(i,j)+dts0, & ! [IN]
238  prss(i,j) ) ! [IN]
239 
240  qvs = ( 1.0_rp - qvef(i,j) ) * qva(i,j) + qvef(i,j) * qvsat
241  dqvs = ( 1.0_rp - qvef(i,j) ) * qva(i,j) + qvef(i,j) * dqvsat
242 
243  call bulkflux( &
244  ustar, & ! [OUT]
245  tstar, & ! [OUT]
246  qstar, & ! [OUT]
247  uabs, & ! [OUT]
248  fracu10, & ! [OUT] ! not used
249  fract2, & ! [OUT] ! not used
250  fracq2, & ! [OUT] ! not used
251  tmpa(i,j), & ! [IN]
252  lst1(i,j), & ! [IN]
253  prsa(i,j), & ! [IN]
254  prss(i,j), & ! [IN]
255  qva(i,j), & ! [IN]
256  qvs, & ! [IN]
257  ua(i,j), & ! [IN]
258  va(i,j), & ! [IN]
259  z1(i,j), & ! [IN]
260  pbl(i,j), & ! [IN]
261  z0m(i,j), & ! [IN]
262  z0h(i,j), & ! [IN]
263  z0e(i,j) ) ! [IN]
264 
265  call bulkflux( &
266  dustar, & ! [OUT]
267  dtstar, & ! [OUT]
268  dqstar, & ! [OUT]
269  duabs, & ! [OUT]
270  fracu10, & ! [OUT] ! not used
271  fract2, & ! [OUT] ! not used
272  fracq2, & ! [OUT] ! not used
273  tmpa(i,j), & ! [IN]
274  lst1(i,j)+dts0, & ! [IN]
275  prsa(i,j), & ! [IN]
276  prss(i,j), & ! [IN]
277  qva(i,j), & ! [IN]
278  dqvs, & ! [IN]
279  ua(i,j), & ! [IN]
280  va(i,j), & ! [IN]
281  z1(i,j), & ! [IN]
282  pbl(i,j), & ! [IN]
283  z0m(i,j), & ! [IN]
284  z0h(i,j), & ! [IN]
285  z0e(i,j) ) ! [IN]
286 
287  ! calculation for residual
288  res = ( 1.0_rp - alb_sw(i,j) ) * swd(i,j) &
289  + ( 1.0_rp - alb_lw(i,j) ) * ( lwd(i,j) - stb * lst1(i,j)**4 ) &
290  + cpdry * rhoa(i,j) * ustar * tstar &
291  + lhv(i,j) * rhoa(i,j) * ustar * qstar &
292  - 2.0_rp * tcs(i,j) * ( lst1(i,j) - tg(i,j) ) / dzg(i,j)
293 
294  ! calculation for d(residual)/dLST
295  dres = -4.0_rp * ( 1.0_rp - alb_lw(i,j) ) * stb * lst1(i,j)**3 &
296  + cpdry * rhoa(i,j) * ( (dustar-ustar)/dts0 * tstar + ustar * (dtstar-tstar)/dts0 ) &
297  + lhv(i,j) * rhoa(i,j) * ( (dustar-ustar)/dts0 * qstar + ustar * (dqstar-qstar)/dts0 ) &
298  - 2.0_rp * tcs(i,j) / dzg(i,j)
299 
300  ! convergence test with residual and error levels
301  if( abs( res ) < land_sfc_thin_slab_res_min .or. &
302  abs( res/dres ) < land_sfc_thin_slab_err_min ) then
303  exit
304  end if
305 
306  ! stop iteration to prevent numerical error
307  if( abs(dres) * land_sfc_thin_slab_dreslim < abs(res) ) then
308  exit
309  end if
310 
311  ! calculate reduced factor
312  if( dres < 0.0_rp ) then
313  if( abs(res) > abs(oldres) ) then
314  redf = max( tfa*abs(redf), redf_min )
315  else
316  redf = min( tfb*abs(redf), redf_max )
317  end if
318  else
319  redf = -1.0_rp
320  end if
321 
322  ! estimate next surface temperature
323  lst1(i,j) = lst1(i,j) - redf * res / dres
324 
325  ! save residual in this step
326  oldres = res
327 
328  end do
329 
330  ! update land surface temperature with limitation
331  lst1(i,j) = min( max( lst1(i,j), &
332  lst(i,j) - land_sfc_thin_slab_dts_max * real( dt, kind=RP ) ), &
333  LST (i,j) + LAND_SFC_THIN_SLAB_dTS_max * real( dt, kind=RP ) )
334 
335  if( n > land_sfc_thin_slab_itr_max ) then
336  ! land surface temperature was not converged
337  if( io_l ) write(io_fid_log,'(A)' ) 'Warning: land surface tempearture was not converged.'
338  if( io_l ) write(io_fid_log,'(A)' ) ''
339  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- PRC_myrank [no unit] :', prc_myrank
340  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- number of i [no unit] :', i
341  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- number of j [no unit] :', j
342  if( io_l ) write(io_fid_log,'(A)' ) ''
343  if( io_l ) write(io_fid_log,'(A,I32)' ) 'DEBUG --- loop number [no unit] :', n
344  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- Residual [J/m2/s] :', res
345  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- delta Residual [J/m2/s] :', dres
346  if( io_l ) write(io_fid_log,'(A,F32.16)') ''
347  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- temperature [K] :', tmpa(i,j)
348  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- pressure [Pa] :', prsa(i,j)
349  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity w [m/s] :', wa(i,j)
350  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity u [m/s] :', ua(i,j)
351  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- velocity v [m/s] :', va(i,j)
352  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- density [kg/m3] :', rhoa(i,j)
353  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- water vapor mass ratio [kg/kg] :', qva(i,j)
354  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- cell center height [m] :', z1(i,j)
355  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- atmospheric mixing layer height [m] :', pbl(i,j)
356  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- pressure at the surface [Pa] :', prss(i,j)
357  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- downward long-wave radiation [J/m2/s] :', lwd(i,j)
358  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- downward short-wave radiation [J/m2/s] :', swd(i,j)
359  if( io_l ) write(io_fid_log,'(A)' ) ''
360  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- soil temperature [K] :', tg(i,j)
361  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- land surface temperature [K] :', lst(i,j)
362  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- efficiency of evaporation [1] :', qvef(i,j)
363  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- surface albedo for LW [1] :', alb_lw(i,j)
364  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- surface albedo for SW [1] :', alb_sw(i,j)
365  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- soil depth [m] :', dzg(i,j)
366  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- thermal conductivity for soil [J/m/K/s] :', tcs(i,j)
367  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for momemtum [m] :', z0m(i,j)
368  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for heat [m] :', z0h(i,j)
369  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- roughness length for vapor [m] :', z0e(i,j)
370  if( io_l ) write(io_fid_log,'(A)' ) ''
371  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- latent heat [J/kg] :', lhv(i,j)
372  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction velocity [m] :', ustar
373  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction potential temperature [K] :', tstar
374  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- friction water vapor mass ratio [kg/kg] :', qstar
375  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction velocity) [m] :', dustar
376  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction potential temperature) [K] :', dtstar
377  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- d(friction water vapor mass ratio) [kg/kg] :', dqstar
378  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- modified absolute velocity [m/s] :', uabs
379  if( io_l ) write(io_fid_log,'(A,F32.16)') 'DEBUG --- next land surface temperature [K] :', lst1(i,j)
380 
381  ! check NaN
382  if ( .NOT. ( res > -1.0_rp .OR. res < 1.0_rp ) ) then ! must be NaN
383  write(*,*) 'xxx NaN is detected for land surface temperature.'
384  write(*,*) ''
385  write(*,*) 'DEBUG --- PRC_myrank :', prc_myrank
386  write(*,*) 'DEBUG --- number of i :', i
387  write(*,*) 'DEBUG --- number of j :', j
388  write(*,*) ''
389  write(*,*) 'DEBUG --- Residual [J/m2/s] :', res
390  write(*,*) 'DEBUG --- delta Residual [J/m2/s] :', dres
391  write(*,*) ''
392  write(*,*) 'DEBUG --- temperature [K] :', tmpa(i,j)
393  write(*,*) 'DEBUG --- pressure [Pa] :', prsa(i,j)
394  write(*,*) 'DEBUG --- velocity w [m/s] :', wa(i,j)
395  write(*,*) 'DEBUG --- velocity u [m/s] :', ua(i,j)
396  write(*,*) 'DEBUG --- velocity v [m/s] :', va(i,j)
397  write(*,*) 'DEBUG --- density [kg/m3] :', rhoa(i,j)
398  write(*,*) 'DEBUG --- water vapor mass ratio [kg/kg] :', qva(i,j)
399  write(*,*) 'DEBUG --- cell center height [m] :', z1(i,j)
400  write(*,*) 'DEBUG --- atmospheric mixing layer height [m] :', pbl(i,j)
401  write(*,*) 'DEBUG --- pressure at the surface [Pa] :', prss(i,j)
402  write(*,*) 'DEBUG --- downward long-wave radiation [J/m2/s] :', lwd(i,j)
403  write(*,*) 'DEBUG --- downward short-wave radiation [J/m2/s] :', swd(i,j)
404  write(*,*) ''
405  write(*,*) 'DEBUG --- soil temperature [K] :', tg(i,j)
406  write(*,*) 'DEBUG --- land surface temperature [K] :', lst(i,j)
407  write(*,*) 'DEBUG --- efficiency of evaporation [1] :', qvef(i,j)
408  write(*,*) 'DEBUG --- surface albedo for LW [1] :', alb_lw(i,j)
409  write(*,*) 'DEBUG --- surface albedo for SW [1] :', alb_sw(i,j)
410  write(*,*) 'DEBUG --- soil depth [m] :', dzg(i,j)
411  write(*,*) 'DEBUG --- thermal conductivity for soil [J/m/K/s] :', tcs(i,j)
412  write(*,*) 'DEBUG --- roughness length for momemtum [m] :', z0m(i,j)
413  write(*,*) 'DEBUG --- roughness length for heat [m] :', z0h(i,j)
414  write(*,*) 'DEBUG --- roughness length for vapor [m] :', z0e(i,j)
415  write(*,*) ''
416  write(*,*) 'DEBUG --- latent heat [J/kg] :', lhv(i,j)
417  write(*,*) 'DEBUG --- friction velocity [m] :', ustar
418  write(*,*) 'DEBUG --- friction potential temperature [K] :', tstar
419  write(*,*) 'DEBUG --- friction water vapor mass ratio [kg/kg] :', qstar
420  write(*,*) 'DEBUG --- d(friction velocity) [m] :', dustar
421  write(*,*) 'DEBUG --- d(friction potential temperature) [K] :', dtstar
422  write(*,*) 'DEBUG --- d(friction water vapor mass ratio) [kg/kg] :', dqstar
423  write(*,*) 'DEBUG --- modified absolute velocity [m/s] :', uabs
424  write(*,*) 'DEBUG --- next land surface temperature [K] :', lst1(i,j)
425 
426  call prc_mpistop
427  endif
428 
429  end if
430 
431  end if
432 
433  ! calculate tendency
434  lst_t(i,j) = ( lst1(i,j) - lst(i,j) ) / dt
435 
436  end do
437  end do
438 
439  ! calculate surface flux
440  do j = js, je
441  do i = is, ie
442 
443  if( landuse_fact_land(i,j) > 0.0_rp ) then
444 
445  call qsat( qvsat, & ! [OUT]
446  lst1(i,j), & ! [IN]
447  prss(i,j) ) ! [IN]
448 
449  qvs = ( 1.0_rp - qvef(i,j) ) * qva(i,j) + qvef(i,j) * qvsat
450 
451  call bulkflux( &
452  ustar, & ! [OUT]
453  tstar, & ! [OUT]
454  qstar, & ! [OUT]
455  uabs, & ! [OUT]
456  fracu10, & ! [OUT]
457  fract2, & ! [OUT]
458  fracq2, & ! [OUT]
459  tmpa(i,j), & ! [IN]
460  lst1(i,j), & ! [IN]
461  prsa(i,j), & ! [IN]
462  prss(i,j), & ! [IN]
463  qva(i,j), & ! [IN]
464  qvs, & ! [IN]
465  ua(i,j), & ! [IN]
466  va(i,j), & ! [IN]
467  z1(i,j), & ! [IN]
468  pbl(i,j), & ! [IN]
469  z0m(i,j), & ! [IN]
470  z0h(i,j), & ! [IN]
471  z0e(i,j) ) ! [IN]
472 
473  zmflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * wa(i,j)
474  xmflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * ua(i,j)
475  ymflx(i,j) = -rhoa(i,j) * ustar**2 / uabs * va(i,j)
476 
477  shflx(i,j) = - rhoa(i,j) * ustar * tstar &
478  * cpdry * ( prss(i,j) / pre00 )**( rdry/cpdry )
479  lhflx(i,j) = - rhoa(i,j) * ustar * qstar * lhv(i,j)
480 
481  ghflx(i,j) = -2.0_rp * tcs(i,j) * ( lst1(i,j) - tg(i,j) ) / dzg(i,j)
482 
483  ! calculation for residual
484  res = ( 1.0_rp - alb_sw(i,j) ) * swd(i,j) &
485  + ( 1.0_rp - alb_lw(i,j) ) * ( lwd(i,j) - stb * lst1(i,j)**4 ) &
486  - shflx(i,j) - lhflx(i,j) + ghflx(i,j)
487 
488  ! put residual in ground heat flux
489  ghflx(i,j) = ghflx(i,j) - res
490 
491  ! diagnostic variables considering unstable/stable state
492  !U10(i,j) = FracU10 * UA(i,j)
493  !V10(i,j) = FracU10 * VA(i,j)
494  !T2 (i,j) = ( 1.0_RP - FracT2 ) * LST1(i,j) + FracT2 * TMPA(i,j)
495  !Q2 (i,j) = ( 1.0_RP - FracQ2 ) * QVS + FracQ2 * QVA (i,j)
496 
497  ! diagnostic variables for neutral state
498  u10(i,j) = ua(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
499  v10(i,j) = va(i,j) * log( 10.0_rp / z0m(i,j) ) / log( z1(i,j) / z0m(i,j) )
500  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) ) ) &
501  / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0h(i,j) ) )
502  q2(i,j) = qvs + ( qva(i,j) - qvs ) * ( log( 2.0_rp / z0m(i,j) ) * log( 2.0_rp / z0e(i,j) ) ) &
503  / ( log( z1(i,j) / z0m(i,j) ) * log( z1(i,j) / z0e(i,j) ) )
504 
505  else
506 
507  ! not calculate surface flux
508  zmflx(i,j) = 0.0_rp
509  xmflx(i,j) = 0.0_rp
510  ymflx(i,j) = 0.0_rp
511  shflx(i,j) = 0.0_rp
512  lhflx(i,j) = 0.0_rp
513  ghflx(i,j) = 0.0_rp
514  u10(i,j) = 0.0_rp
515  v10(i,j) = 0.0_rp
516  t2(i,j) = 0.0_rp
517  q2(i,j) = 0.0_rp
518 
519  end if
520 
521  end do
522  end do
523 
524  return
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:267
scale_atmos_hydrometeor
module Hydrometeor
Definition: scale_atmos_sub_hydrometeor.F90:14
scale_landuse
module LANDUSE
Definition: scale_landuse.F90:11
scale_process
module PROCESS
Definition: scale_process.F90:14
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:79
scale_bulkflux
module Surface bulk flux
Definition: scale_bulkflux.F90:12
scale_landuse::landuse_fact_land
real(rp), dimension(:,:), allocatable, public landuse_fact_land
land factor
Definition: scale_landuse.F90:36
Here is the call graph for this function:
Here is the caller graph for this function:
Generated by   doxygen 1.8.14