SCALE-RM
scale_land_dyn_bucket.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
9 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module scale_land_dyn_bucket
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
19  use scale_debug
20  !-----------------------------------------------------------------------------
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  !
25  !++ Public procedure
26  !
27  public :: land_dyn_bucket_setup
28  public :: land_dyn_bucket
29 
30  !-----------------------------------------------------------------------------
31  !
32  !++ Public parameters & variables
33  !
34  !-----------------------------------------------------------------------------
35  !
36  !++ Private procedure
37  !
38  !-----------------------------------------------------------------------------
39  !
40  !++ Private parameters & variables
41  !
42  real(RP), private :: LAND_DYN_BUCKET_T_frz
43 
44  logical, private :: LAND_DYN_BUCKET_update_bottom_temp = .false. ! Is LAND_TEMP updated in the lowest level?
45  logical, private :: LAND_DYN_BUCKET_update_bottom_water = .false. ! Is LAND_WATER updated in the lowest level?
46 
47  logical, private :: LAND_DYN_BUCKET_nudging = .false. ! Is nudging for land physics used?
48  real(DP), private :: LAND_DYN_BUCKET_nudging_tau = 0.0_dp ! time constant for nudging [sec]
49  character(len=H_SHORT), private :: LAND_DYN_BUCKET_nudging_tau_unit = "SEC"
50  character(len=H_LONG), private :: LAND_DYN_BUCKET_nudging_basename = ''
51  logical, private :: LAND_DYN_BUCKET_nudging_basename_add_num = .false.
52  integer, private :: LAND_DYN_BUCKET_nudging_number_of_files = 1
53  logical, private :: LAND_DYN_BUCKET_nudging_enable_periodic_year = .false.
54  logical, private :: LAND_DYN_BUCKET_nudging_enable_periodic_month = .false.
55  logical, private :: LAND_DYN_BUCKET_nudging_enable_periodic_day = .false.
56  integer, private :: LAND_DYN_BUCKET_nudging_step_fixed = 0
57  real(RP), private :: LAND_DYN_BUCKET_nudging_defval ! = UNDEF
58  logical, private :: LAND_DYN_BUCKET_nudging_check_coordinates = .true.
59  integer, private :: LAND_DYN_BUCKET_nudging_step_limit = 0
60 
61  real(RP), private :: WATER_DENSCS
62  real(RP), private :: ICE_DENSCS
63  real(DP), private :: LAND_DYN_BUCKET_nudging_tausec
64 
65  logical, private :: replace = .false.
66  !-----------------------------------------------------------------------------
67 contains
68  !-----------------------------------------------------------------------------
70  subroutine land_dyn_bucket_setup
71  use scale_prc, only: &
72  prc_abort
73  use scale_const, only: &
74  undef => const_undef, &
75  tem00 => const_tem00, &
76  dwatr => const_dwatr, &
77  dice => const_dice, &
78  cl => const_cl
79  use scale_calendar, only: &
80  calendar_unit2sec
81  use scale_file_external_input, only: &
82  file_external_input_regist
83  use scale_atmos_hydrometeor, only: &
84  cv_water, &
85  cv_ice
86  implicit none
87 
88  namelist / param_land_dyn_bucket / &
89  land_dyn_bucket_t_frz, &
90  land_dyn_bucket_nudging, &
91  land_dyn_bucket_nudging_tau, &
92  land_dyn_bucket_nudging_tau_unit, &
93  land_dyn_bucket_nudging_basename, &
94  land_dyn_bucket_nudging_basename_add_num, &
95  land_dyn_bucket_nudging_number_of_files, &
96  land_dyn_bucket_nudging_enable_periodic_year, &
97  land_dyn_bucket_nudging_enable_periodic_month, &
98  land_dyn_bucket_nudging_enable_periodic_day, &
99  land_dyn_bucket_nudging_step_fixed, &
100  land_dyn_bucket_nudging_defval, &
101  land_dyn_bucket_nudging_check_coordinates, &
102  land_dyn_bucket_nudging_step_limit, &
103  land_dyn_bucket_update_bottom_temp, &
104  land_dyn_bucket_update_bottom_water
105 
106  integer :: ierr
107  !---------------------------------------------------------------------------
108 
109  log_newline
110  log_info("LAND_DYN_BUCKET_setup",*) 'Setup'
111 
112  land_dyn_bucket_nudging_defval = undef
113  land_dyn_bucket_t_frz = tem00
114 
115  !--- read namelist
116  rewind(io_fid_conf)
117  read(io_fid_conf,nml=param_land_dyn_bucket,iostat=ierr)
118  if( ierr < 0 ) then !--- missing
119  log_info("LAND_DYN_BUCKET_setup",*) 'Not found namelist. Default used.'
120  elseif( ierr > 0 ) then !--- fatal error
121  log_error("LAND_DYN_BUCKET_setup",*) 'Not appropriate names in namelist PARAM_LAND_DYN_BUCKET. Check!'
122  call prc_abort
123  endif
124  log_nml(param_land_dyn_bucket)
125 
126  if ( land_dyn_bucket_nudging ) then
127  call calendar_unit2sec( land_dyn_bucket_nudging_tausec, land_dyn_bucket_nudging_tau, land_dyn_bucket_nudging_tau_unit )
128 
129  log_info("LAND_DYN_BUCKET_setup",*) 'Use nudging for LAND physics : ON'
130  log_info("LAND_DYN_BUCKET_setup",*) 'Relaxation time Tau [sec] : ', land_dyn_bucket_nudging_tausec
131 
132  if ( land_dyn_bucket_nudging_tausec <= 0.0_rp ) then
133  log_info("LAND_DYN_BUCKET_setup",*) 'Tau<=0 means that LST is completely replaced by the external data.'
134  replace = .true.
135  endif
136 
137  if ( land_dyn_bucket_nudging_basename == '' ) then
138  log_error("LAND_DYN_BUCKET_setup",*) 'LAND_DYN_BUCKET_nudging_basename is necessary !!'
139  call prc_abort
140  end if
141 
142  call file_external_input_regist( land_dyn_bucket_nudging_basename, & ! [IN]
143  land_dyn_bucket_nudging_basename_add_num, & ! [IN]
144  land_dyn_bucket_nudging_number_of_files, & ! [IN]
145  'LAND_TEMP', & ! [IN]
146  'LXY', & ! [IN]
147  land_dyn_bucket_nudging_enable_periodic_year, & ! [IN]
148  land_dyn_bucket_nudging_enable_periodic_month, & ! [IN]
149  land_dyn_bucket_nudging_enable_periodic_day, & ! [IN]
150  land_dyn_bucket_nudging_step_fixed, & ! [IN]
151  land_dyn_bucket_nudging_defval, & ! [IN]
152  check_coordinates = land_dyn_bucket_nudging_check_coordinates, & ! [IN]
153  step_limit = land_dyn_bucket_nudging_step_limit, & ! [IN]
154  allow_missing = (.not. replace) ) ! [IN]
155 
156  call file_external_input_regist( land_dyn_bucket_nudging_basename, & ! [IN]
157  land_dyn_bucket_nudging_basename_add_num, & ! [IN]
158  land_dyn_bucket_nudging_number_of_files, & ! [IN]
159  'LAND_WATER', & ! [IN]
160  'LXY', & ! [IN]
161  land_dyn_bucket_nudging_enable_periodic_year, & ! [IN]
162  land_dyn_bucket_nudging_enable_periodic_month, & ! [IN]
163  land_dyn_bucket_nudging_enable_periodic_day, & ! [IN]
164  land_dyn_bucket_nudging_step_fixed, & ! [IN]
165  land_dyn_bucket_nudging_defval, & ! [IN]
166  check_coordinates = land_dyn_bucket_nudging_check_coordinates, & ! [IN]
167  step_limit = land_dyn_bucket_nudging_step_limit, & ! [IN]
168  allow_missing = (.not. replace) ) ! [IN]
169 
170  log_info("LAND_DYN_BUCKET_setup",*) 'Use nudging for Land physics: ON'
171  else
172  log_info("LAND_DYN_BUCKET_setup",*) 'Use nudging for Land physics: OFF'
173  end if
174 
175  water_denscs = dwatr * cv_water
176  ice_denscs = dice * cv_ice
177 
178  log_newline
179  log_info("LAND_DYN_BUCKET_setup",*) 'Update soil temperature of bottom layer? : ', land_dyn_bucket_update_bottom_temp
180  log_info("LAND_DYN_BUCKET_setup",*) 'Update soil moisture of bottom layer? : ', land_dyn_bucket_update_bottom_water
181 
182  return
183  end subroutine land_dyn_bucket_setup
184 
185  !-----------------------------------------------------------------------------
187  subroutine land_dyn_bucket( &
188  LKMAX, LKS, LKE, LIA, LIS, LIE, LJA, LJS, LJE, &
189  TEMP_t, WATER_t, ICE_t, &
190  WaterLimit, &
191  ThermalCond, &
192  HeatCapacity, &
193  WaterDiff, &
194  SFLX_GH, SFLX_water, &
195  SFLX_RHOE, &
196  exists_land, CDZ, &
197  dt, NOWDAYSEC, &
198  TEMP, WATER, ICE, &
199  RUNOFF, RUNOFF_ENGI )
200  use scale_const, only: &
201  undef => const_undef, &
202  dwatr => const_dwatr, &
203  dice => const_dice, &
204  emelt => const_emelt
205  use scale_prc, only: &
206  prc_abort
207  use scale_file_external_input, only: &
208  file_external_input_update
209  use scale_matrix, only: &
210  matrix_solver_tridiagonal, &
211  matrix_solver_tridiagonal_1d_cr
212  use scale_atmos_hydrometeor, only: &
213  cv_water, &
214  cv_ice, &
215  lhf
216  implicit none
217  integer, intent(in) :: lkmax, lks, lke
218  integer, intent(in) :: lia, lis, lie
219  integer, intent(in) :: lja, ljs, lje
220 
221  real(rp), intent(in) :: temp_t (lkmax,lia,lja)
222  real(rp), intent(in) :: water_t (lkmax,lia,lja)
223  real(rp), intent(in) :: ice_t (lkmax,lia,lja)
224  real(rp), intent(in) :: waterlimit (lia,lja)
225  real(rp), intent(in) :: thermalcond (lia,lja)
226  real(rp), intent(in) :: heatcapacity(lia,lja)
227  real(rp), intent(in) :: waterdiff (lia,lja)
228  real(rp), intent(in) :: sflx_gh (lia,lja) ! positive for downward
229  real(rp), intent(in) :: sflx_water (lia,lja) ! positive for downward
230  real(rp), intent(in) :: sflx_rhoe (lia,lja) ! positive for downward
231  logical, intent(in) :: exists_land (lia,lja)
232  real(rp), intent(in) :: cdz (lkmax)
233  real(dp), intent(in) :: dt
234  real(dp), intent(in) :: nowdaysec
235 
236  real(rp), intent(inout) :: temp (lkmax,lia,lja)
237  real(rp), intent(inout) :: water(lkmax,lia,lja)
238  real(rp), intent(inout) :: ice (lkmax,lia,lja)
239 
240  real(rp), intent(out) :: runoff (lia,lja)
241  real(rp), intent(out) :: runoff_engi(lia,lja) ! internal energy of the runoff water
242 
243  logical :: error
244 
245  real(rp) :: temp1 (lkmax,lia,lja)
246  real(rp) :: water1(lkmax,lia,lja)
247 
248  real(rp) :: kappa (lkmax,lsize)
249 
250  real(rp) :: f1(lkmax,lsize)
251  real(rp) :: f2(lkmax,lsize)
252  real(rp) :: f3(lkmax,lsize)
253  real(rp) :: v(lkmax,lsize)
254  real(rp) :: temp2(lkmax,lsize)
255  real(rp) :: water2(lkmax,lsize)
256  real(rp) :: ice2 (lkmax,lsize)
257 
258 #ifdef _OPENACC
259  real(rp) :: work(lkmax,4) ! for CR
260 #endif
261 
262  real(rp) :: ndg_temp (lkmax,lia,lja)
263  real(rp) :: ndg_water(lkmax,lia,lja)
264 
265  real(rp) :: mass_total(lkmax)
266  real(rp) :: mass_water(lkmax)
267  real(rp) :: mass_ice(lkmax)
268 
269  real(rp) :: engi(lkmax,lsize)
270  real(rp) :: cs
271  real(rp) :: cl
272 
273  real(rp) :: flux(lks-1:lke,lsize)
274 
275  real(rp) :: ro, rw, ri
276  real(rp) :: ro_sum, roe_sum
277 
278  real(rp) :: sw
279 
280  integer :: k, i, j
281 #if LSIZE == 1
282  integer, parameter :: l = 1
283 #else
284  integer :: ii
285  integer :: l
286  integer :: len
287  integer :: land_iindx_list(lie-lis+1,ljs:lje)
288  integer :: land_iindx_list_epos(ljs:lje)
289 #endif
290  !---------------------------------------------------------------------------
291 
292  log_progress(*) 'land / dynamics / bucket'
293 
294  !$acc data copy(TEMP, WATER, ICE) &
295  !$acc copyin(TEMP_t, WATER_t, ICE_t, WaterLimit, ThermalCond, HeatCapacity, &
296  !$acc WaterDiff, SFLX_GH, SFLX_water, SFLX_RHOE, exists_land, CDZ) &
297  !$acc copyout(RUNOFF, RUNOFF_ENGI) &
298  !$acc create(NDG_TEMP, NDG_WATER, TEMP1, WATER1)
299 
300  if ( land_dyn_bucket_nudging ) then
301 
302  call file_external_input_update( &
303  'LAND_TEMP', & ! (in)
304  nowdaysec, & ! (in)
305  temp1, & ! (out)
306  error ) ! (out)
307  if ( error ) then
308  log_error("LAND_DYN_BUCKET",*) 'Requested data is not found!'
309  call prc_abort
310  end if
311 
312  call file_external_input_update( &
313  'LAND_WATER', & ! (in)
314  nowdaysec, & ! (in)
315  water1, & ! (out)
316  error ) ! (out)
317  if ( error ) then
318  log_error("LAND_DYN_BUCKET",*) 'Requested data is not found!'
319  call prc_abort
320  end if
321  end if
322 
323  if ( land_dyn_bucket_nudging ) then
324  if ( .not. replace ) then
325  ! nudging is used
326 
327  !$omp parallel do
328  !$acc kernels
329  do j = ljs,lje
330  do i = lis,lie
331  do k = lks,lke
332  if ( temp1(k,i,j) == undef ) then
333  ndg_temp(k,i,j) = 0.0_rp
334  else
335  ndg_temp(k,i,j) = ( temp1(k,i,j) - temp(k,i,j) ) / land_dyn_bucket_nudging_tausec * dt
336  end if
337  end do
338  end do
339  end do
340  !$acc end kernels
341 
342  !$omp parallel do
343  !$acc kernels
344  do j = ljs,lje
345  do i = lis,lie
346  do k = lks,lke
347  if ( water1(k,i,j) == undef ) then
348  ndg_water(k,i,j) = 0.0_rp
349  else
350  ndg_water(k,i,j) = ( water1(k,i,j) - ( water(k,i,j) + ice(k,i,j) ) ) / land_dyn_bucket_nudging_tausec * dt
351  end if
352  end do
353  end do
354  end do
355  !$acc end kernels
356 
357  end if
358 
359  if ( .not. land_dyn_bucket_update_bottom_water ) then
360  !$omp parallel do
361  !$acc kernels
362  do j = ljs, lje
363  do i = lis, lie
364  ndg_water(lke,i,j) = 0.0_rp
365  end do
366  end do
367  !$acc end kernels
368  end if
369 
370  if ( .not. land_dyn_bucket_update_bottom_temp ) then
371  !$omp parallel do
372  !$acc kernels
373  do j = ljs, lje
374  do i = lis, lie
375  ndg_temp(lke,i,j) = 0.0_rp
376  end do
377  end do
378  !$acc end kernels
379  end if
380 
381  else
382  ! nudging is NOT used
383 
384  !$omp parallel do
385  !$acc kernels
386  do j = ljs,lje
387  do i = lis,lie
388  do k = lks,lke
389  ndg_temp(k,i,j) = 0.0_rp
390  ndg_water(k,i,j) = 0.0_rp
391  end do
392  end do
393  end do
394  !$acc end kernels
395 
396  end if
397 
398  if ( .not. replace ) then
399 
400 #if LSIZE == 1
401 #else
402  !$omp parallel do private(l,i)
403  do j = ljs, lje
404  l = 0
405  do i = lis, lie
406  if ( exists_land(i,j) ) then
407  l = l + 1
408  land_iindx_list(l,j) = i
409  end if
410  end do
411  land_iindx_list_epos(j) = l
412  end do
413 #endif
414 
415  !$omp parallel do &
416  !$omp private( i, j, k, l, ii, len, &
417  !$omp MASS_total, MASS_water, MASS_ice, &
418  !$omp TEMP2, WATER2, ICE2, ENGI, &
419  !$omp F1, F2, F3, V, flux, kappa, &
420  !$omp ro_sum, roe_sum, &
421  !$omp CS, CL, ro, rw, ri, sw )
422  !$acc kernels
423  do j = ljs, lje
424 #if LSIZE == 1
425  !$acc loop private( MASS_total, MASS_water, MASS_ice, &
426  !$acc TEMP2, WATER2, ICE2, ENGI, &
427  !$acc F1, F2, F3, V, work, flux, kappa )
428  do i = lis, lie
429  if ( exists_land(i,j) ) then
430 #else
431  do ii = 1, land_iindx_list_epos(j), lsize
432  len = min(ii+lsize,land_iindx_list_epos(j)+1) - ii
433 #ifdef QUICKDEBUG
434  f1(:,:) = 0.0_rp
435  f2(:,:) = 1.0_rp
436  f3(:,:) = 0.0_rp
437 #endif
438  do l = 1, len
439  i = land_iindx_list(ii+l-1,j)
440 #endif
441  do k = lks, lke
442  mass_total(k) = dwatr * water(k,i,j) + dice * ice(k,i,j)
443  end do
444  mass_total(lks) = mass_total(lks) + dt * sflx_water(i,j) / cdz(lks)
445 
446  cs = ( 1.0_rp - waterlimit(i,j) ) * heatcapacity(i,j)
447  do k = lks, lke
448  engi(k,l) = ( cs + water_denscs * water(k,i,j) + ice_denscs * ice(k,i,j) ) * temp(k,i,j) - lhf * dice * ice(k,i,j)
449  end do
450  engi(lks,l) = engi(lks,l) + dt * ( sflx_gh(i,j) + sflx_rhoe(i,j) ) / cdz(lks)
451 
452  ! phase change
453  do k = lks, lke
454  mass_ice(k) = min( mass_total(k), max( 0.0_rp, &
455  ( engi(k,l) - ( cs + cv_water * mass_total(k) ) * land_dyn_bucket_t_frz ) &
456  / ( ( cv_ice - cv_water ) * land_dyn_bucket_t_frz - lhf ) &
457  ) )
458  mass_water(k) = mass_total(k) - mass_ice(k)
459  v(k,l) = mass_water(k) / dwatr
460  ice2(k,l) = mass_ice(k) / dice
461  temp2(k,l) = ( engi(k,l) + lhf * mass_ice(k) ) &
462  / ( cs + cv_water * mass_water(k) + cv_ice * mass_ice(k) )
463  end do
464 
465  !--
466 
467  f3(lks,l) = 0.0_rp
468  f1(lks,l) = -2.0_rp * waterdiff(i,j) / ( cdz(lks) * ( cdz(lks) + cdz(lks+1) ) ) * dt
469  f2(lks,l) = 1.0_rp - f3(lks,l) - f1(lks,l)
470 
471  if ( land_dyn_bucket_update_bottom_water ) then
472  f3(lke,l) = -2.0_rp * waterdiff(i,j) / ( cdz(lke) * ( cdz(lke) + cdz(lke-1) ) ) * dt
473  else
474  f3(lke,l) = 0.0_rp
475  end if
476 
477  f1(lke,l) = 0.0_rp
478  f2(lke,l) = 1.0_rp - f3(lke,l) - f1(lke,l)
479 
480  do k = lks+1, lke-1
481  f3(k,l) = -2.0_rp * waterdiff(i,j) / ( cdz(k) * ( cdz(k) + cdz(k-1) ) ) * dt
482  f1(k,l) = -2.0_rp * waterdiff(i,j) / ( cdz(k) * ( cdz(k) + cdz(k+1) ) ) * dt
483  f2(k,l) = 1.0_rp - f3(k,l) - f1(k,l)
484  end do
485 
486 #if LSIZE == 1
487  call matrix_solver_tridiagonal_1d_cr( lkmax, 1, lkmax, &
488 #ifdef _OPENACC
489  work(:,:), &
490 #endif
491  f1(:,1), f2(:,1), f3(:,1), v(:,1), & ! [IN]
492  water2(:,1) ) ! [OUT]
493 #else
494  end do
495 #ifdef QUICKDEBUG
496  do l = len+1, lsize
497  f1(:,l) = 0.0_rp
498  f2(:,l) = 1.0_rp
499  f3(:,l) = 0.0_rp
500  v(:,l) = 0.0_rp
501  end do
502 #endif
503 
504  call matrix_solver_tridiagonal( lkmax, 1, lkmax, &
505  f1(:,:), f2(:,:), f3(:,:), v(:,:), & ! [IN]
506  water2(:,:) ) ! [OUT]
507 
508  do l = 1, len
509  i = land_iindx_list(ii+l-1,j)
510 #endif
511 
512  ! temperature
513 
514  flux(lks-1,l) = 0.0_rp
515  flux(lke,l) = 0.0_rp
516 
517  cs = ( 1.0_rp - waterlimit(i,j) ) * heatcapacity(i,j)
518  do k = lks, lke
519  kappa(k,l) = thermalcond(i,j) + 0.5_rp * water2(k,l)**(1.0_rp/3.0_rp)
520  end do
521 
522  do k = lks, lke-1
523  flux(k,l) = - 2.0_rp * dwatr * waterdiff(i,j) * ( water2(k+1,l) - water2(k,l) ) / ( cdz(k+1) + cdz(k) )
524  sw = 0.5_rp - sign( 0.5_rp, flux(k,l) )
525  flux(k,l) = flux(k,l) * cv_water * ( temp2(k+1,l) * sw + temp2(k,l) * ( 1.0_rp - sw ) )
526  end do
527  if ( .not. land_dyn_bucket_update_bottom_temp ) then
528  flux(lke,l) = flux(lke-1,l)
529  end if
530 
531  do k = lks, lke
532  v(k,l) = engi(k,l) + lhf * dice * ice2(k,l) &
533  - dt * ( flux(k,l) - flux(k-1,l) ) / cdz(k)
534  end do
535 
536  cl = cs + water_denscs * water2(lks,l) + ice_denscs * ice2(lks,l)
537  f3(lks,l) = 0.0_rp
538  f1(lks,l) = - ( kappa(lks,l) + kappa(lks+1,l) ) / ( cdz(lks) * ( cdz(lks) + cdz(lks+1) ) ) * dt
539  f2(lks,l) = cl - f3(lks,l) - f1(lks,l)
540 
541  cl = cs + water_denscs * water2(lke,l) + ice_denscs * ice2(lke,l)
542  if ( land_dyn_bucket_update_bottom_water ) then
543  f3(lke,l) = - ( kappa(lke,l) + kappa(lke-1,l) ) / ( cdz(lke) * ( cdz(lke) + cdz(lke-1) ) ) * dt
544  else
545  f3(lke,l) = 0.0_rp
546  end if
547  f1(lke,l) = 0.0_rp
548  f2(lke,l) = cl - f3(lke,l) - f1(lke,l)
549 
550  do k = lks+1, lke-1
551  cl = cs + water_denscs * water2(k,l) + ice_denscs * ice2(k,l)
552  f3(k,l) = - ( kappa(k,l) + kappa(k-1,l) ) / ( cdz(k) * ( cdz(k) + cdz(k-1) ) ) * dt
553  f1(k,l) = - ( kappa(k,l) + kappa(k+1,l) ) / ( cdz(k) * ( cdz(k) + cdz(k+1) ) ) * dt
554  f2(k,l) = cl - f3(k,l) - f1(k,l)
555  end do
556 
557 
558 #if LSIZE == 1
559  call matrix_solver_tridiagonal_1d_cr( lkmax, 1, lkmax, &
560 #ifdef _OPENACC
561  work(:,:), &
562 #endif
563  f1(:,1), f2(:,1), f3(:,1), v(:,1), & ! [IN]
564  temp2(:,1) ) ! [OUT]
565 #else
566  end do
567 
568  call matrix_solver_tridiagonal( lkmax, 1, lkmax, &
569  f1(:,:), f2(:,:), f3(:,:), v(:,:), & ! [IN]
570  temp2(:,:) ) ! [OUT]
571 
572  do l = 1, len
573  i = land_iindx_list(ii+l-1,j)
574 #endif
575 
576  do k = lks, lke
577  temp2(k,l) = temp2(k,l) + ndg_temp(k,i,j)
578 
579  if ( temp2(k,l) >= land_dyn_bucket_t_frz ) then
580  water2(k,l) = water2(k,l) + ndg_water(k,i,j)
581  else
582  ice2(k,l) = ice2(k,l) + ndg_water(k,i,j)
583  end if
584  end do
585 
586  ! runoff of soil moisture (vertical sum)
587  ro_sum = 0.0_rp
588  roe_sum = 0.0_rp
589  !$acc loop private(ro,rw,ri) reduction(+:ro_sum,roe_sum)
590  do k = lks, lke
591  ro = max( water2(k,l) + ice2(k,l) - waterlimit(i,j), 0.0_rp )
592  rw = min( ro, water2(k,l) )
593  ri = ro - rw
594  water2(k,l) = water2(k,l) - rw
595  ice2(k,l) = ice2(k,l) - ri
596  rw = rw * dwatr / dt
597  ri = ri * dice / dt
598  ro_sum = ro_sum + ( rw + ri ) * cdz(k)
599  roe_sum = roe_sum &
600  + ( ( rw * cv_water + ri * cv_ice ) * temp2(k,l) - ri * lhf ) * cdz(k)
601  end do
602  runoff(i,j) = ro_sum
603  runoff_engi(i,j) = roe_sum
604 
605 
606  if ( .not. land_dyn_bucket_update_bottom_water ) then
607  water2(lke,l) = water(lke,i,j)
608  ice2(lke,l) = ice(lke,i,j)
609  end if
610  if ( .not. land_dyn_bucket_update_bottom_temp ) then
611  temp2(lke,l) = temp(lke,i,j)
612  end if
613 
614  do k = lks, lke
615  temp(k,i,j) = temp2(k,l)
616  water(k,i,j) = water2(k,l)
617  ice(k,i,j) = ice2(k,l)
618  end do
619 
620 #if LSIZE == 1
621  end if ! end if exists_land(i,j)
622 #else
623  end do ! end for l
624 #endif
625  end do ! end for i or ii
626  end do ! end for j
627  !$acc end kernels
628 
629  else
630  ! if replace
631 
632  !$acc kernels
633  do j = ljs, lje
634  do i = lis, lie
635  do k = lks, lke
636  temp(k,i,j) = temp1(k,i,j)
637  water(k,i,j) = water1(k,i,j)
638  ice(k,i,j) = 0.0_rp
639  end do
640  end do
641  end do
642  !$acc end kernels
643  end if
644 
645  !$acc end data
646 
647  return
648  end subroutine land_dyn_bucket
649 
650 end module scale_land_dyn_bucket
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_matrix::matrix_solver_tridiagonal_1d_cr
subroutine, public matrix_solver_tridiagonal_1d_cr( KA, KS, KE, ifdef _OPENACC
solve tridiagonal matrix with Cyclic Reduction method
Definition: scale_matrix.F90:186
scale_const::const_emelt
real(rp), parameter, public const_emelt
Definition: scale_const.F90:79
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:13
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_io
module STDIO
Definition: scale_io.F90:10
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_land_dyn_bucket::land_dyn_bucket
subroutine, public land_dyn_bucket(LKMAX, LKS, LKE, LIA, LIS, LIE, LJA, LJS, LJE, TEMP_t, WATER_t, ICE_t, WaterLimit, ThermalCond, HeatCapacity, WaterDiff, SFLX_GH, SFLX_water, SFLX_RHOE, exists_land, CDZ, dt, NOWDAYSEC, TEMP, WATER, ICE, RUNOFF, RUNOFF_ENGI)
Physical processes for land submodel.
Definition: scale_land_dyn_bucket.F90:200
scale_const::const_dwatr
real(rp), parameter, public const_dwatr
density of water [kg/m3]
Definition: scale_const.F90:89
scale_debug
module DEBUG
Definition: scale_debug.F90:11
scale_const::const_tem00
real(rp), parameter, public const_tem00
temperature reference (0C) [K]
Definition: scale_const.F90:99
scale_const::const_cl
real(rp), parameter, public const_cl
specific heat (liquid water) [J/kg/K]
Definition: scale_const.F90:71
scale_matrix
module MATRIX
Definition: scale_matrix.F90:17
scale_land_dyn_bucket
module land / dynamics / bucket
Definition: scale_land_dyn_bucket.F90:11
scale_atmos_hydrometeor::lhf
real(rp), public lhf
latent heat of fusion for use [J/kg]
Definition: scale_atmos_hydrometeor.F90:146
scale_land_dyn_bucket::land_dyn_bucket_setup
subroutine, public land_dyn_bucket_setup
Setup.
Definition: scale_land_dyn_bucket.F90:71
scale_file_external_input
module file / external_input
Definition: scale_file_external_input.F90:12
scale_const::const_dice
real(rp), parameter, public const_dice
density of ice [kg/m3]
Definition: scale_const.F90:90
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_atmos_hydrometeor::cv_water
real(rp), public cv_water
CV for water [J/kg/K].
Definition: scale_atmos_hydrometeor.F90:151
scale_atmos_hydrometeor::cv_ice
real(rp), public cv_ice
CV for ice [J/kg/K].
Definition: scale_atmos_hydrometeor.F90:153
scale_calendar::calendar_unit2sec
subroutine, public calendar_unit2sec(second, value, unit)
Convert several units to second.
Definition: scale_calendar.F90:486
Generated by   doxygen 1.8.17