SCALE-RM
mod_realinput.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module mod_realinput
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use mpi
17  use scale_precision
18  use scale_io
19  use scale_prof
20  use scale_atmos_grid_cartesc_index
21  use scale_ocean_grid_cartesc_index
22  use scale_land_grid_cartesc_index
23  use scale_urban_grid_cartesc_index
24  use scale_index
25  use scale_tracer
26  use scale_cpl_sfc_index
27 
28  use scale_prc, only: &
29  prc_ismaster, &
30  prc_abort
31  use scale_comm_cartesc, only: &
32  comm_bcast
33  use scale_atmos_grid_cartesc_real, only: &
34  lon => atmos_grid_cartesc_real_lon, &
35  lat => atmos_grid_cartesc_real_lat, &
36  cz => atmos_grid_cartesc_real_cz, &
37  fz => atmos_grid_cartesc_real_fz
38  use scale_comm_cartesc_nest, only: &
39  comm_cartesc_nest_interp_level
40  !-----------------------------------------------------------------------------
41  implicit none
42  private
43  !-----------------------------------------------------------------------------
44  !
45  !++ Public procedure
46  !
47  public :: realinput_atmos
48  public :: realinput_surface
49 
50  !-----------------------------------------------------------------------------
51  !
52  !++ Public parameters & variables
53  !
54  !-----------------------------------------------------------------------------
55  !
56  !++ Private procedure
57  !
58  private :: parentatmossetup
59  private :: parentatmosfinalize
60  private :: parentatmosopen
61  private :: parentatmosinput
62  private :: boundaryatmossetup
63  private :: boundaryatmosoutput
64 
65  private :: parentsurfacesetup
66  private :: parentsurfacefinalize
67  private :: parentsurfaceopen
68  private :: parentsurfaceinput
69  private :: boundarysurfacesetup
70  private :: boundarysurfaceoutput
71  private :: interp_oceanland_data
72 
73  !-----------------------------------------------------------------------------
74  !
75  !++ Private parameters & variables
76  !
77  integer, public, parameter :: inetcdf = 1
78  integer, public, parameter :: igrads = 2
79 
80  integer, private :: ka_org, ks_org, ke_org
81  integer, private :: ia_org, is_org, ie_org
82  integer, private :: ja_org, js_org, je_org
83  integer, private :: lka_org, lks_org, lke_org
84  integer, private :: lia_org, lis_org, lie_org
85  integer, private :: lja_org, ljs_org, lje_org
86  integer, private :: oia_org, ois_org, oie_org
87  integer, private :: oja_org, ojs_org, oje_org
88 
89  real(rp), private, allocatable :: lon_org (:,:)
90  real(rp), private, allocatable :: lat_org (:,:)
91  real(rp), private, allocatable :: cz_org (:,:,:)
92 
93  real(rp), private, allocatable :: w_org (:,:,:) ! scalar point
94  real(rp), private, allocatable :: u_org (:,:,:) ! scalar point
95  real(rp), private, allocatable :: v_org (:,:,:) ! scalar point
96  real(rp), private, allocatable :: dens_org(:,:,:)
97  real(rp), private, allocatable :: pt_org (:,:,:)
98  real(rp), private, allocatable :: temp_org(:,:,:)
99  real(rp), private, allocatable :: pres_org(:,:,:)
100  real(rp), private, allocatable :: qtrc_org (:,:,:,:)
101  real(rp), private, allocatable :: qv_org (:,:,:)
102  real(rp), private, allocatable :: rh_org (:,:,:)
103  real(rp), private, allocatable :: qhyd_org (:,:,:,:)
104  real(rp), private, allocatable :: qnum_org (:,:,:,:)
105 
106  real(rp), private, allocatable :: llon_org (:,:)
107  real(rp), private, allocatable :: llat_org (:,:)
108 
109  real(rp), private, allocatable :: olon_org (:,:)
110  real(rp), private, allocatable :: olat_org (:,:)
111 
112  real(rp), private, allocatable :: rotc_org(:,:,:)
113 
114  integer, private :: itp_nh_a = 4 ! for atmos
115  integer, private :: itp_nh_l = 4 ! for land
116  integer, private :: itp_nh_o = 4 ! for ocean
117  integer, private :: itp_nh_ol = 5 ! for ocean-land
118 
119  integer, private, parameter :: i_intrp_linear = 0
120  integer, private, parameter :: i_intrp_dstwgt = 1
121  integer, private :: itp_type_a
122  integer, private :: itp_type_l
123  integer, private :: itp_type_o
124 
125  integer, private, allocatable :: igrd ( :,:,:)
126  integer, private, allocatable :: jgrd ( :,:,:)
127  real(rp), private, allocatable :: hfact( :,:,:)
128  integer, private, allocatable :: kgrd (:,:,:,:,:)
129  real(rp), private, allocatable :: vfact(:, :,:,:)
130 
131  integer, private, allocatable :: oigrd (:,:,:)
132  integer, private, allocatable :: ojgrd (:,:,:)
133  real(rp), private, allocatable :: ohfact(:,:,:)
134 
135  logical, private :: ol_interp
136  real(rp), private, allocatable :: hfact_ol(:,:,:)
137  integer, private, allocatable :: igrd_ol (:,:,:)
138  integer, private, allocatable :: jgrd_ol (:,:,:)
139 
140  logical, private :: serial_atmos
141  logical, private :: serial_land
142  logical, private :: serial_ocean
143  logical, private :: do_read_atmos
144  logical, private :: do_read_land
145  logical, private :: do_read_ocean
146 
147  logical, private :: mixing_ratio
148  logical, private :: temp2pt
149  logical, private :: update_coord
150  logical, private :: use_waterratio
151 
152  integer, private, parameter :: i_intrp_off = 0
153  integer, private, parameter :: i_intrp_mask = 1
154  integer, private, parameter :: i_intrp_fill = 2
155 
156  integer, private :: i_intrp_land_temp
157  integer, private :: i_intrp_land_water
158  integer, private :: i_intrp_land_sfc_temp
159  integer, private :: i_intrp_ocean_temp
160  integer, private :: i_intrp_ocean_sfc_temp
161 
162  ! replace missing value
163  real(rp), private, parameter :: maskval_tg = 298.0_rp ! mask value 298K
164  real(rp), private, parameter :: maskval_strg = 0.02_rp ! mask value 0.02
165  ! default value 0.02: set as value of forest at 40% of evapolation rate.
166  ! forest is considered as a typical landuse over Japan area.
167 
168  ! for namelist
169  integer, private :: number_of_files = 1
170  integer, private :: number_of_tsteps = -1 ! num of time steps in one file
171  integer, private :: number_of_skip_tsteps = 0 ! num of skipped first several data
172 
173  logical, private :: serial_proc_read = .true. ! read by one MPI process and broadcast
174 
175  character(len=H_LONG), private :: filetype_org = ''
176  character(len=H_LONG), private :: basename_org = ''
177  logical, private :: basename_add_num = .false.
178 
179  character(len=H_LONG), private :: basename_boundary = ''
180  logical, private :: boundary_postfix_timelabel = .false.
181  character(len=H_LONG), private :: boundary_title = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
182  character(len=H_SHORT), private :: boundary_dtype = 'DEFAULT'
183  real(dp), private :: boundary_update_dt = 0.0_dp ! inteval time of boudary data update [s]
184 
185  integer, private :: filter_order = 8 ! order of the hyper-diffusion (must be even)
186  integer, private :: filter_niter = 0 ! times for hyper-diffusion iteration
187 
188  logical, private :: use_file_density = .false. ! use density data from files
189  logical, private :: pt_dry = .true. ! potential temperature is defined associated with dry air
190  logical, private :: same_mp_type = .false. ! microphysics type of the parent model is same as it in this model
191  character(len=4), private :: upper_qv_type = "ZERO"
194 
195  character(len=H_SHORT), private :: intrp_type = "LINEAR" ! "LINEAR" or "DIST-WEIGHT"
196  ! LINEAR : bi-linear interpolation
197  ! DIST-WEIGHT: distance-weighted mean of the nearest N-neighbors
198 
199  logical, private :: first_atmos = .true.
200  logical, private :: first_surface = .true.
201  !-----------------------------------------------------------------------------
202 contains
203  !-----------------------------------------------------------------------------
204  subroutine realinput_atmos
205  use scale_const, only: &
206  p00 => const_pre00
207  use scale_time, only: &
208  time_gettimelabel
209  use mod_atmos_vars, only: &
210  dens, &
211  momz, &
212  momx, &
213  momy, &
214  rhot, &
215  qtrc
216  use mod_atmos_admin, only: &
217  atmos_phy_mp_type
218  use scale_atmos_thermodyn, only: &
219  atmos_thermodyn_specific_heat
220  implicit none
221 
222  logical :: use_sfc_diagnoses = .false.
223  logical :: use_data_under_sfc = .true.
224  logical :: use_nonhydro_dens_boundary = .false.
225  logical :: skip_vertical_range_check = .false.
226 
227 
228  namelist / param_mkinit_real_atmos / &
229  number_of_files, &
230  number_of_tsteps, &
231  number_of_skip_tsteps, &
232  serial_proc_read, &
233  filetype_org, &
234  basename_org, &
235  basename_add_num, &
236  basename_boundary, &
237  boundary_postfix_timelabel, &
238  boundary_title, &
239  boundary_dtype, &
240  boundary_update_dt, &
241  filter_order, &
242  filter_niter, &
243  use_file_density, &
244  pt_dry, &
245  use_nonhydro_dens_boundary, &
246  use_sfc_diagnoses, &
247  use_data_under_sfc, &
248  same_mp_type, &
249  upper_qv_type, &
250  intrp_type, &
251  skip_vertical_range_check
252 
253  character(len=6) :: basename_num
254  character(len=H_LONG) :: basename_out_mod
255  character(len=19) :: timelabel
256 
257  integer :: dims(6) ! dims 1-3: normal, 4-6: staggerd
258  integer :: timelen
259 
260  integer :: fid_atmos
261  integer :: vid_atmos(5+qa)
262  logical :: qtrc_flag(qa)
263 
264  real(rp) :: dens_in(ka,ia,ja)
265  real(rp) :: momz_in(ka,ia,ja) ! staggered point
266  real(rp) :: momx_in(ka,ia,ja) ! staggered point
267  real(rp) :: momy_in(ka,ia,ja) ! staggered point
268  real(rp) :: rhot_in(ka,ia,ja)
269  real(rp) :: qtrc_in(ka,ia,ja,qa)
270 
271  real(rp) :: velz_in(ka,ia,ja) ! staggered point
272  real(rp) :: velx_in(ka,ia,ja) ! staggered point
273  real(rp) :: vely_in(ka,ia,ja) ! staggered point
274  real(rp) :: pt_in (ka,ia,ja)
275  real(rp) :: pres_in(ka,ia,ja)
276 
277  real(rp) :: qdry (ka,ia,ja)
278  real(rp) :: rtot (ka,ia,ja)
279  real(rp) :: cptot(ka,ia,ja)
280  real(rp) :: cvtot(ka,ia,ja)
281 
282  integer :: ifile, istep, t, tall
283  integer :: k, i, j, iq
284  integer :: ierr
285  !---------------------------------------------------------------------------
286 
287  log_newline
288  log_info('REALINPUT_atmos',*) 'Setup'
289 
290  !--- read namelist
291  rewind(io_fid_conf)
292  read(io_fid_conf,nml=param_mkinit_real_atmos,iostat=ierr)
293  if( ierr < 0 ) then !--- missing
294  log_info("REALINPUT_atmos",*) 'Not found namelist. Default used.'
295  elseif( ierr > 0 ) then !--- fatal error
296  log_error("REALINPUT_atmos",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_ATMOS. Check!'
297  call prc_abort
298  endif
299  log_nml(param_mkinit_real_atmos)
300 
301  if ( boundary_update_dt <= 0.0_dp ) then
302  log_error("REALINPUT_atmos",*) 'BOUNDARY_UPDATE_DT is necessary in real case preprocess'
303  call prc_abort
304  endif
305 
306  if ( number_of_files > 1 .OR. basename_add_num ) then
307  basename_num = '_00000'
308  else
309  basename_num = ''
310  endif
311 
312  select case( intrp_type )
313  case ( "LINEAR" )
314  itp_nh_a = 4
315  itp_type_a = i_intrp_linear
316  case ( "DIST-WEIGHT" )
317  itp_nh_a = comm_cartesc_nest_interp_level
318  itp_type_a = i_intrp_dstwgt
319  case default
320  log_error("REALINPUT_atmos",*) 'Unsupported type of INTRP_TYPE : ', trim(intrp_type)
321  log_error_cont(*) ' It must be "LINEAR" or "DIST-WEIGHT"'
322  call prc_abort
323  end select
324 
325  call parentatmossetup( filetype_org, & ! [IN]
326  basename_org, & ! [IN]
327  basename_num, & ! [IN]
328  serial_proc_read, & ! [IN]
329  same_mp_type, & ! [IN]
330  use_file_density, & ! [IN]
331  dims(:), & ! [OUT]
332  timelen, & ! [OUT]
333  qtrc_flag(:) ) ! [OUT]
334 
335  if ( timelen < number_of_tsteps ) then
336  log_error("REALINPUT_atmos",*) 'time dimension in file is shorter than NUMBER_OF_TSTEPS', timelen, number_of_tsteps
337  call prc_abort
338  end if
339  if ( number_of_tsteps < 1 ) then
340  number_of_tsteps = timelen
341  end if
342 
343  log_newline
344  log_info("REALINPUT_atmos",*) 'Number of temporal data in each file : ', number_of_tsteps
345 
346  do ifile = 1, number_of_files
347 
348  if ( number_of_files > 1 .OR. basename_add_num ) then
349  write(basename_num,'(A,I5.5)') '_', ifile-1
350  else
351  basename_num = ''
352  endif
353 
354  log_newline
355  if ( basename_num == "" ) then
356  log_info("REALINPUT_atmos",*) 'read external data from : ', trim(basename_org)
357  else
358  log_info("REALINPUT_atmos",*) 'read external data from : ', trim(basename_org), ' (', trim(basename_num), ')'
359  end if
360 
361  call parentatmosopen( filetype_org, basename_org, basename_num ) ![IN]
362 
363  do istep = 1, number_of_tsteps
364 
365  tall = number_of_tsteps * (ifile-1) + istep ! consecutive time step (input)
366  t = tall - number_of_skip_tsteps ! time step (output)
367 
368  if ( t <= 0 ) then
369  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
370  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, '] ...skip.'
371  cycle
372  endif
373 
374  if ( t == 1 .OR. basename_boundary /= '' ) then
375 
376  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
377  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, ']'
378 
379  ! read prepared data
380  call parentatmosinput( filetype_org, & ! [IN]
381  basename_num, & ! [IN]
382  dims(:), & ! [IN]
383  istep, & ! [IN]
384  use_sfc_diagnoses, & ! [IN]
385  use_data_under_sfc, & ! [IN]
386  same_mp_type, & ! [IN]
387  skip_vertical_range_check, & ! [IN]
388  qtrc_flag(:), & ! [IN]
389  dens_in(:,:,:), & ! [OUT]
390  momz_in(:,:,:), & ! [OUT]
391  momx_in(:,:,:), & ! [OUT]
392  momy_in(:,:,:), & ! [OUT]
393  rhot_in(:,:,:), & ! [OUT]
394  qtrc_in(:,:,:,:), & ! [OUT]
395  velz_in(:,:,:), & ! [OUT]
396  velx_in(:,:,:), & ! [OUT]
397  vely_in(:,:,:), & ! [OUT]
398  pt_in(:,:,:), & ! [OUT]
399  pres_in(:,:,:) ) ! [OUT]
400  else
401  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
402  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, '] ...skip.'
403  endif
404 
405  !--- store prognostic variables as initial
406  if ( t == 1 ) then
407  log_newline
408  log_info("REALINPUT_atmos",*) 'store initial state.'
409 
410  !$omp parallel do collapse(2)
411  !$acc kernels
412  !$acc loop collapse(3) independent
413  do j = 1, ja
414  do i = 1, ia
415  do k = 1, ka
416  dens(k,i,j) = dens_in(k,i,j)
417  momz(k,i,j) = momz_in(k,i,j)
418  momx(k,i,j) = momx_in(k,i,j)
419  momy(k,i,j) = momy_in(k,i,j)
420  rhot(k,i,j) = rhot_in(k,i,j)
421  enddo
422  enddo
423  enddo
424  !$acc end kernels
425 
426  !$omp parallel do collapse(3)
427  !$acc kernels
428  do iq = 1, qa
429  do j = 1, ja
430  do i = 1, ia
431  do k = 1, ka
432  qtrc(k,i,j,iq) = qtrc_in(k,i,j,iq)
433  enddo
434  enddo
435  enddo
436  enddo
437  !$acc end kernels
438 
439  endif
440 
441  !--- output boundary data
442  if ( basename_boundary /= '' ) then
443 
444  if ( t == 1 ) then
445  if ( boundary_postfix_timelabel ) then
446  call time_gettimelabel( timelabel )
447  basename_out_mod = trim(basename_boundary)//'_'//trim(timelabel)
448  else
449  basename_out_mod = trim(basename_boundary)
450  endif
451 
452  call boundaryatmossetup( basename_out_mod, & ! [IN]
453  boundary_title, & ! [IN]
454  boundary_dtype, & ! [IN]
455  boundary_update_dt, & ! [IN]
456  qtrc_flag(:), & ! [IN]
457  fid_atmos, & ! [OUT]
458  vid_atmos(:) ) ! [OUT]
459  endif
460 
461  if ( use_nonhydro_dens_boundary ) then
462  call atmos_thermodyn_specific_heat( ka, ks, ke, ia, 1, ia, ja, 1, ja, qa, &
463  qtrc_in(:,:,:,:), & ! [IN]
464  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), & ! [IN]
465  qdry(:,:,:), rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:) ) ! [OUT]
466  !$omp parallel do collapse(2)
467  do j = 1, ja
468  do i = 1, ia
469  do k = ks, ke
470  dens_in(k,i,j) = ( pres_in(k,i,j) / p00 )**( cvtot(k,i,j) / cptot(k,i,j) ) * p00 / ( rtot(k,i,j) * pt_in(k,i,j) )
471  end do
472  end do
473  end do
474  end if
475 
476  call boundaryatmosoutput( dens_in(:,:,:), & ! [IN]
477  velz_in(:,:,:), & ! [IN]
478  velx_in(:,:,:), & ! [IN]
479  vely_in(:,:,:), & ! [IN]
480  pt_in(:,:,:), & ! [IN]
481  qtrc_in(:,:,:,:), & ! [IN]
482  qtrc_flag(:), & ! [IN]
483  fid_atmos, & ! [IN]
484  vid_atmos(:), & ! [IN]
485  boundary_update_dt, & ! [IN]
486  t ) ! [IN]
487  endif
488 
489  enddo ! istep loop
490  enddo ! ifile loop
491 
492  call parentatmosfinalize( filetype_org ) ![IN]
493 
494  return
495  end subroutine realinput_atmos
496 
497  !-----------------------------------------------------------------------------
498  subroutine realinput_surface
499  use scale_const, only: &
500  tem00 => const_tem00
501  use scale_time, only: &
502  time_gettimelabel
503  use scale_landuse, only: &
504  fact_ocean => landuse_fact_ocean, &
505  fact_land => landuse_fact_land, &
506  fact_urban => landuse_fact_urban, &
507  landuse_pft_nmax
508  use mod_atmos_vars, only: &
509  dens, &
510  momx, &
511  momy, &
512  rhot, &
513  qtrc
514  use mod_atmos_phy_sf_vars, only: &
515  atmos_phy_sf_sfc_temp, &
516  atmos_phy_sf_sfc_albedo, &
517  atmos_phy_sf_sfc_z0m, &
518  atmos_phy_sf_sfc_z0h, &
519  atmos_phy_sf_sfc_z0e
520  use mod_ocean_admin, only: &
521  ocean_do
522  use scale_ocean_phy_ice_simple, only: &
523  ocean_phy_ice_freezetemp
524  use mod_ocean_vars, only: &
525  ice_flag, &
526  ocean_temp, &
527  ocean_salt, &
528  ocean_uvel, &
529  ocean_vvel, &
530  ocean_ocn_z0m, &
531  ocean_ice_temp, &
532  ocean_ice_mass, &
533  ocean_sfc_temp, &
534  ocean_sfc_albedo, &
535  ocean_sfc_z0m, &
536  ocean_sfc_z0h, &
537  ocean_sfc_z0e
538  use mod_land_admin, only: &
539  land_do
540  use mod_land_vars, only: &
541  land_temp, &
542  land_water, &
543  land_ice, &
544  land_sfc_temp, &
545  land_sfc_albedo
546  use mod_urban_admin, only: &
547  urban_do
548  use mod_urban_vars, only: &
549  urban_tc, &
550  urban_qc, &
551  urban_uc, &
552  urban_tr, &
553  urban_tb, &
554  urban_tg, &
555  urban_trl, &
556  urban_tbl, &
557  urban_tgl, &
558  urban_rainr, &
559  urban_rainb, &
560  urban_raing, &
561  urban_roff, &
562  urban_sfc_temp, &
563  urban_sfc_albedo
564  implicit none
565 
566  logical :: use_file_landwater = .true. ! use land water data from files
567  real(rp) :: init_landwater_ratio = 0.5_rp ! Ratio of land water to storage is constant, if USE_FILE_LANDWATER is ".false." (all PFT)
568 ! real(RP) :: INIT_LANDWATER_RATIO_EACH(LANDUSE_PFT_nmax) ! Ratio of land water to storage is constant, if USE_FILE_LANDWATER is ".false." (each PFT)
569  real(rp) :: init_ocean_alb_lw = 0.04_rp ! initial LW albedo on the ocean
570  real(rp) :: init_ocean_alb_sw = 0.10_rp ! initial SW albedo on the ocean
571  real(rp) :: init_ocean_z0w = 1.0e-3_rp ! initial surface roughness on the ocean
572  character(len=H_SHORT) :: intrp_land_temp = 'off'
573  character(len=H_SHORT) :: intrp_land_water = 'off'
574  character(len=H_SHORT) :: intrp_land_sfc_temp = 'off'
575  character(len=H_SHORT) :: intrp_ocean_temp = 'off'
576  character(len=H_SHORT) :: intrp_ocean_sfc_temp = 'off'
577  integer :: intrp_iter_max = 5
578  character(len=H_SHORT) :: soilwater_ds2vc = 'limit'
579  logical :: soilwater_ds2vc_flag ! true: 'critical', false: 'limit'
580  logical :: elevation_correction = .true.
581  logical :: elevation_correction_land
582  logical :: elevation_correction_ocean
583 
584  namelist / param_mkinit_real_land / &
585  number_of_files, &
586  number_of_tsteps, &
587  number_of_skip_tsteps, &
588  filetype_org, &
589  basename_org, &
590  basename_add_num, &
591  basename_boundary, &
592  boundary_postfix_timelabel, &
593  boundary_title, &
594  boundary_update_dt, &
595  use_file_landwater, &
596  init_landwater_ratio, &
597 ! INIT_LANDWATER_RATIO_EACH, &
598  intrp_type, &
599  intrp_land_temp, &
600  intrp_land_water, &
601  intrp_land_sfc_temp, &
602  intrp_iter_max, &
603  filter_order, &
604  filter_niter, &
605  soilwater_ds2vc, &
606  elevation_correction, &
607  serial_proc_read
608 
609  namelist / param_mkinit_real_ocean / &
610  number_of_files, &
611  number_of_tsteps, &
612  number_of_skip_tsteps, &
613  filetype_org, &
614  basename_org, &
615  basename_add_num, &
616  basename_boundary, &
617  boundary_postfix_timelabel, &
618  boundary_title, &
619  boundary_update_dt, &
620  init_ocean_alb_lw, &
621  init_ocean_alb_sw, &
622  init_ocean_z0w, &
623  intrp_type, &
624  intrp_ocean_temp, &
625  intrp_ocean_sfc_temp, &
626  intrp_iter_max, &
627  filter_order, &
628  filter_niter, &
629  serial_proc_read
630 
631  character(len=6) :: filetype_land
632  character(len=6) :: filetype_ocean
633  character(len=6) :: basename_land
634  character(len=6) :: basename_ocean
635 
636  ! land
637  real(rp) :: land_temp_in (lkmax,ia,ja)
638  real(rp) :: land_water_in (lkmax,ia,ja)
639  real(rp) :: land_sfc_temp_in ( ia,ja)
640  real(rp) :: land_sfc_albedo_in( ia,ja,n_rad_dir,n_rad_rgn)
641 
642  ! urban
643  real(rp) :: urban_tc_in(ia,ja)
644  real(rp) :: urban_qc_in(ia,ja)
645  real(rp) :: urban_uc_in(ia,ja)
646  real(rp) :: urban_sfc_temp_in(ia,ja)
647  real(rp) :: urban_sfc_albedo_in(ia,ja,n_rad_dir,n_rad_rgn)
648 
649  ! ocean
650  real(rp) :: ocean_temp_in (okmax,ia,ja)
651  real(rp) :: ocean_sfc_temp_in ( ia,ja)
652  real(rp) :: ocean_sfc_albedo_in( ia,ja,n_rad_dir,n_rad_rgn)
653  real(rp) :: ocean_sfc_z0_in ( ia,ja)
654 
655  integer :: number_of_files_land = 1
656  integer :: number_of_files_ocean = 1
657  integer :: number_of_tsteps_land = 1 ! num of time steps in one file
658  integer :: number_of_tsteps_ocean = 1 ! num of time steps in one file
659  integer :: number_of_skip_tsteps_land = 0 ! num of skipped first several data
660  integer :: number_of_skip_tsteps_ocean = 0 ! num of skipped first several data
661 
662  character(len=H_LONG) :: basename_org_land = ''
663  character(len=H_LONG) :: basename_org_ocean = ''
664  character(len=H_LONG) :: basename_boundary_land = ''
665  character(len=H_LONG) :: basename_boundary_ocean = ''
666  logical :: boundary_postfix_timelabel_land = .false.
667  logical :: boundary_postfix_timelabel_ocean = .false.
668  character(len=H_LONG) :: boundary_title_land = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
669  character(len=H_LONG) :: boundary_title_ocean = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
670  real(dp) :: boundary_update_dt_land = 0.0_dp ! inteval time of boudary data update [s]
671  real(dp) :: boundary_update_dt_ocean = 0.0_dp ! inteval time of boudary data update [s]
672  logical :: basename_add_num_land
673  logical :: basename_add_num_ocean
674 
675  real(rp), allocatable :: lst_ocean(:,:)
676  real(rp), allocatable :: lz_org(:)
677  real(rp), allocatable :: topo_org(:,:)
678  real(rp), allocatable :: lmask_org(:,:)
679  real(rp), allocatable :: omask_org(:,:)
680 
681  integer :: mdlid_land, mdlid_ocean
682  integer :: ldims(3), odims(2)
683 
684  integer :: totaltimesteps = 1
685  integer :: timelen_land, timelen_ocean
686  integer :: ierr
687 
688  character(len=H_LONG) :: basename_out_mod
689  character(len=19) :: timelabel
690 
691  integer :: fid_sfc
692  integer :: vid_sfc(10)
693 
694  logical :: land_flag
695  logical :: multi_land
696  logical :: multi_ocean
697 
698  integer :: oistep, listep
699  integer :: tall, t
700  integer :: idir, irgn
701 
702  integer :: k, i, j, n
703  !---------------------------------------------------------------------------
704 
705  if ( land_do .or. urban_do ) then
706  land_flag = .true.
707  else
708  land_flag = .false.
709  end if
710 
711  if ( .not. land_flag .or. .not. ocean_do ) then
712  log_error("REALINPUT_surface",*) 'OCEAN_ and LAND_DYN_TYPE must be set'
713  end if
714 
715 
716  log_newline
717  log_info('REALINPUT_surface',*) 'Setup LAND'
718 
719  ! LAND/URBAN
720 ! INIT_LANDWATER_RATIO_EACH(:) = -1.0_RP
721 
722  !--- read namelist
723  rewind(io_fid_conf)
724  read(io_fid_conf,nml=param_mkinit_real_land,iostat=ierr)
725  if( ierr < 0 ) then !--- missing
726  log_info("REALINPUT_surface",*) 'Not found namelist. Default used.'
727  elseif( ierr > 0 ) then !--- fatal error
728  log_error("REALINPUT_surface",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_LAND. Check!'
729  call prc_abort
730  endif
731  log_nml(param_mkinit_real_land)
732 
733  number_of_files_land = number_of_files
734  number_of_tsteps_land = number_of_tsteps
735  number_of_skip_tsteps_land = number_of_skip_tsteps
736  filetype_land = filetype_org
737  basename_org_land = basename_org
738  basename_add_num_land = basename_add_num
739  basename_boundary_land = basename_boundary
740  boundary_postfix_timelabel_land = boundary_postfix_timelabel
741  boundary_title_land = boundary_title
742  boundary_update_dt_land = boundary_update_dt
743  elevation_correction_land = elevation_correction
744 
745  if ( number_of_files > 1 .OR. basename_add_num_land ) then
746  basename_land = "_00000"
747  else
748  basename_land = ""
749  endif
750 
751 !!$ if( .NOT. USE_FILE_LANDWATER ) then
752 !!$ if( all( INIT_LANDWATER_RATIO_EACH(:) < 0.0_RP ) ) then
753 !!$ LOG_INFO("REALINPUT_surface",*) 'Applied INIT_LANDWATER_RATIO, instead of INIT_LANDWATER_RATIO_EACH.'
754 !!$ INIT_LANDWATER_RATIO_EACH(:) = INIT_LANDWATER_RATIO
755 !!$ else
756 !!$ if( any( INIT_LANDWATER_RATIO_EACH(:) < 0.0_RP ) ) then
757 !!$ LOG_ERROR("REALINPUT_surface",*) 'Insufficient elemtents of array (INIT_LANDWATER_RATIO_EACH):', INIT_LANDWATER_RATIO_EACH(:)
758 !!$ call PRC_abort
759 !!$ endif
760 !!$ endif
761 !!$ endif
762 
763  select case( soilwater_ds2vc )
764  case( 'critical' )
765  soilwater_ds2vc_flag = .true.
766  case('limit' )
767  soilwater_ds2vc_flag = .false.
768  case default
769  log_error("REALINPUT_surface",*) 'Unsupported SOILWATER_DS2CV TYPE:', trim(soilwater_ds2vc)
770  call prc_abort
771  end select
772 
773  !serial_land = SERIAL_PROC_READ
774  ! if serial_land = .false., interp_OceanLand_data may result in different value
775  serial_land = .true.
776 
777  select case( intrp_type )
778  case ( "LINEAR" )
779  itp_nh_l = 4
780  itp_type_l = i_intrp_linear
781  case ( "DIST-WEIGHT" )
782  itp_nh_l = comm_cartesc_nest_interp_level
783  itp_type_l = i_intrp_dstwgt
784  case default
785  log_error("REALINPUT_surface",*) 'Unsupported type of INTRP_TYPE : ', trim(intrp_type)
786  log_error_cont(*) ' It must be "LINEAR" or "DIST-WEIGHT"'
787  call prc_abort
788  end select
789 
790 
791 
792  log_newline
793  log_info('REALINPUT_surface',*) 'Setup OCEAN'
794 
795  !--- read namelist
796  rewind(io_fid_conf)
797  read(io_fid_conf,nml=param_mkinit_real_ocean,iostat=ierr)
798  if( ierr < 0 ) then !--- missing
799  log_info("REALINPUT_surface",*) 'Not found namelist. Default used.'
800  elseif( ierr > 0 ) then !--- fatal error
801  log_error("REALINPUT_surface",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_OCEAN. Check!'
802  call prc_abort
803  endif
804  log_nml(param_mkinit_real_ocean)
805 
806  number_of_files_ocean = number_of_files
807  number_of_tsteps_ocean = number_of_tsteps
808  number_of_skip_tsteps_ocean = number_of_skip_tsteps
809  filetype_ocean = filetype_org
810  basename_org_ocean = basename_org
811  basename_add_num_ocean = basename_add_num
812  basename_boundary_ocean = basename_boundary
813  boundary_postfix_timelabel_ocean = boundary_postfix_timelabel
814  boundary_title_ocean = boundary_title
815  boundary_update_dt_ocean = boundary_update_dt
816  elevation_correction_ocean = elevation_correction
817 
818  if ( number_of_files > 1 .OR. basename_add_num_ocean ) then
819  basename_ocean = "_00000"
820  else
821  basename_ocean = ""
822  endif
823 
824  ! if serial_ocean = .false., interp_OceanLand_data may result in different value
825  !serial_ocean = SERIAL_PROC_READ
826  serial_ocean = .true.
827 
828  select case( intrp_type )
829  case ( "LINEAR" )
830  itp_nh_o = 4
831  itp_type_o = i_intrp_linear
832  case ( "DIST-WEIGHT" )
833  itp_nh_o = comm_cartesc_nest_interp_level
834  itp_type_o = i_intrp_dstwgt
835  case default
836  log_error("REALINPUT_surface",*) 'Unsupported type of INTRP_TYPE : ', trim(intrp_type)
837  log_error_cont(*) ' It must be "LINEAR" or "DIST-WEIGHT"'
838  call prc_abort
839  end select
840 
841  itp_nh_ol = comm_cartesc_nest_interp_level
842 
843  multi_land = ( number_of_files_land * number_of_tsteps_land - number_of_skip_tsteps_land ) > 1
844  multi_ocean = basename_boundary_ocean .ne. ''
845 
846  if ( ( multi_land .and. multi_ocean ) .AND. &
847  ( ( number_of_files_land .NE. number_of_files_ocean ) .OR. &
848  ( number_of_tsteps_land .NE. number_of_tsteps_ocean ) .OR. &
849  ( number_of_skip_tsteps_land .NE. number_of_skip_tsteps_ocean ) .OR. &
850  ( basename_boundary_land .NE. basename_boundary_ocean ) .OR. &
851  ( boundary_postfix_timelabel_land .NEQV. boundary_postfix_timelabel_ocean ) .OR. &
852  ( boundary_title_land .NE. boundary_title_ocean ) .OR. &
853  ( boundary_update_dt_land .NE. boundary_update_dt_ocean ) ) ) then
854  log_error("REALINPUT_surface",*) 'The following LAND/OCEAN parameters must be consistent due to technical problem:'
855  log_error_cont(*) ' NUMBER_OF_FILES, NUMBER_OF_TSTEPS, NUMBER_OF_SKIP_TSTEPS,'
856  log_error_cont(*) ' BASENAME_BOUNDARY, BOUNDARY_POSTFIX_TIMELABEL, BOUNDARY_TITLE, BOUNDARY_UPDATE_DT.'
857  call prc_abort
858  end if
859 
860  if ( multi_land .and. .not. multi_ocean ) then
861  log_error("REALINPUT_surface",*) 'To output boundary data for land data, it is necessary to output ocean data'
862  call prc_abort
863  end if
864 
865  call parentsurfacesetup( ldims, odims, & ![OUT]
866  mdlid_land, & ![OUT]
867  mdlid_ocean, & ![OUT]
868  timelen_land, & ![OUT]
869  timelen_ocean, & ![OUT]
870  basename_org_land, & ![IN]
871  basename_org_ocean, & ![IN]
872  basename_land, & ![IN]
873  basename_ocean, & ![IN]
874  filetype_land, & ![IN]
875  filetype_ocean, & ![IN]
876  use_file_landwater, & ![IN]
877  intrp_iter_max, & ![IN]
878  intrp_land_temp, & ![IN]
879  intrp_land_water, & ![IN]
880  intrp_land_sfc_temp, & ![IN]
881  intrp_ocean_temp, & ![IN]
882  intrp_ocean_sfc_temp ) ![IN]
883 
884  if ( timelen_land < number_of_tsteps_land ) then
885  log_error("REALINPUT_surface",*) 'time dimension in file is shorter than NUMBER_OF_TSTEPS_LAND', timelen_land, number_of_tsteps_land
886  call prc_abort
887  end if
888 
889  if ( timelen_ocean < number_of_tsteps_ocean ) then
890  log_error("REALINPUT_surface",*) 'time dimension in file is shorter than NUMBER_OF_TSTEPS_OCEAN', timelen_ocean, number_of_tsteps_ocean
891  call prc_abort
892  end if
893 
894  if ( number_of_tsteps_land < 1 ) then
895  number_of_tsteps_land = timelen_land
896  end if
897  if ( number_of_tsteps_ocean < 1 ) then
898  number_of_tsteps_ocean = timelen_ocean
899  end if
900 
901  totaltimesteps = number_of_files_ocean * number_of_tsteps_ocean
902 
903  if ( totaltimesteps <= number_of_skip_tsteps_ocean ) then
904  log_error("REALSINPUT_surface",*) "NUMBER_OF_FILES_OCEAN * NUMBER_OF_TSTEPS_OCEAN <= NUMBER_OF_SKIP_TSTEPS_OCEAN"
905  call prc_abort
906  end if
907  if ( multi_ocean ) then
908  if ( boundary_update_dt_ocean <= 0.0_dp ) then
909  log_error("REALINPUT_surface",*) 'BOUNDARY_UPDATE_DT is necessary in real case preprocess'
910  call prc_abort
911  endif
912  end if
913 
914  allocate( lz_org(lka_org) )
915  allocate( topo_org(lia_org, lja_org) )
916  allocate( lmask_org(lia_org, lja_org) )
917  allocate( omask_org(oia_org, oja_org) )
918  allocate( lst_ocean(oia_org, oja_org) )
919 
920  !--- read external file
921  do n = 1, number_of_files_ocean
922 
923  if ( number_of_files_land > 1 .OR. basename_add_num_land ) then
924  if ( multi_land ) then
925  write(basename_land,'(A,I5.5)') '_', n-1
926  else
927  write(basename_land,'(A,I5.5)') '_', number_of_skip_tsteps_land / number_of_tsteps_land
928  end if
929  else
930  basename_land = ''
931  endif
932  if ( number_of_files_ocean > 1 .OR. basename_add_num_ocean ) then
933  write(basename_ocean,'(A,I5.5)') '_', n-1
934  else
935  basename_ocean = ''
936  endif
937 
938  log_newline
939  log_info("REALINPUT_surface",*) 'Target Postfix Name (Land) : ', trim(basename_land)
940  log_info("REALINPUT_surface",*) 'Target Postfix Name (Ocean): ', trim(basename_ocean)
941  log_info("REALINPUT_surface",*) 'Time Steps in One File : ', number_of_tsteps
942 
943  call parentsurfaceopen( filetype_land, filetype_ocean, & ! [IN]
944  basename_org_land, basename_org_ocean, & ! [IN]
945  basename_land, basename_ocean ) ! [IN]
946 
947  do oistep = 1, number_of_tsteps_ocean
948 
949  tall = number_of_tsteps_ocean * (n-1) + oistep
950  t = tall - number_of_skip_tsteps_ocean
951  if ( t <= 0 ) then
952  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
953  '[file,step,cons.] = [', n, ',', oistep, ',', tall, '] ...skip.'
954  cycle
955  end if
956  if ( t > 1 .and. .not. multi_ocean .and. .not. multi_land ) exit
957 
958  if ( multi_land ) then
959  listep = oistep
960  else
961  listep = mod(number_of_skip_tsteps_land, number_of_tsteps_land) + 1
962  end if
963 
964  ! read all prepared data
965  !$acc update host(DENS,MOMX,MOMY,RHOT,QTRC)
966  call parentsurfaceinput( land_temp_in(:,:,:), &
967  land_water_in(:,:,:), &
968  land_sfc_temp_in(:,:), &
969  land_sfc_albedo_in(:,:,:,:), &
970  urban_tc_in(:,:), &
971  urban_qc_in(:,:), &
972  urban_uc_in(:,:), &
973  urban_sfc_temp_in(:,:), &
974  urban_sfc_albedo_in(:,:,:,:), &
975  lst_ocean(:,:), &
976  lz_org(:), topo_org(:,:), &
977  lmask_org(:,:), omask_org(:,:), &
978  ocean_temp_in(oks,:,:), &
979  ocean_sfc_temp_in( :,:), &
980  ocean_sfc_albedo_in( :,:,:,:), &
981  ocean_sfc_z0_in( :,:), &
982  basename_land, basename_ocean, &
983  mdlid_land, mdlid_ocean, &
984  ldims, odims, &
985  use_file_landwater, &
986  init_landwater_ratio, &
987 ! INIT_LANDWATER_RATIO_EACH(:), &
988  init_ocean_alb_lw, init_ocean_alb_sw, &
989  init_ocean_z0w, &
990  intrp_iter_max, &
991  soilwater_ds2vc_flag, &
992  elevation_correction_land, &
993  elevation_correction_ocean, &
994  oistep, listep, &
995  multi_land, &
996  urban_do, &
997  dens, momx, momy, rhot, qtrc )
998 
999  !--- input initial data
1000  if ( t == 1 ) then
1001 
1002  !$omp parallel do
1003  !$acc kernels
1004  do j = 1, ja
1005  do i = 1, ia
1006  ocean_sfc_temp(i,j) = ocean_sfc_temp_in(i,j)
1007  ocean_sfc_z0m(i,j) = ocean_sfc_z0_in(i,j)
1008  ocean_sfc_z0h(i,j) = ocean_sfc_z0_in(i,j)
1009  ocean_sfc_z0e(i,j) = ocean_sfc_z0_in(i,j)
1010  do irgn = i_r_ir, i_r_vis
1011  do idir = i_r_direct, i_r_diffuse
1012  ocean_sfc_albedo(i,j,idir,irgn) = ocean_sfc_albedo_in(i,j,idir,irgn)
1013  enddo
1014  enddo
1015  do k = 1, okmax
1016  ocean_temp(k,i,j) = ocean_temp_in(oks,i,j)
1017  ocean_salt(k,i,j) = 0.0_rp
1018  ocean_uvel(k,i,j) = 0.0_rp
1019  ocean_vvel(k,i,j) = 0.0_rp
1020  enddo
1021  ocean_ocn_z0m(i,j) = ocean_sfc_z0_in(i,j)
1022  if ( ice_flag ) then
1023  ocean_ice_temp(i,j) = min( ocean_sfc_temp_in(i,j), ocean_phy_ice_freezetemp )
1024  ocean_ice_mass(i,j) = 0.0_rp
1025  end if
1026 
1027  land_sfc_temp(i,j) = land_sfc_temp_in(i,j)
1028  do irgn = i_r_ir, i_r_vis
1029  do idir = i_r_direct, i_r_diffuse
1030  land_sfc_albedo(i,j,idir,irgn) = land_sfc_albedo_in(i,j,idir,irgn)
1031  enddo
1032  enddo
1033  do k = 1, lkmax
1034  land_temp(k,i,j) = land_temp_in(k,i,j)
1035  if ( land_temp(k,i,j) >= tem00 ) then
1036  land_water(k,i,j) = land_water_in(k,i,j)
1037  land_ice(k,i,j) = 0.0_rp
1038  else
1039  land_water(k,i,j) = 0.0_rp
1040  land_ice(k,i,j) = land_water_in(k,i,j)
1041  end if
1042  enddo
1043 
1044  if ( urban_do ) then
1045  urban_sfc_temp(i,j) = urban_sfc_temp_in(i,j)
1046  do irgn = i_r_ir, i_r_vis
1047  do idir = i_r_direct, i_r_diffuse
1048  urban_sfc_albedo(i,j,idir,irgn) = urban_sfc_albedo_in(i,j,idir,irgn)
1049  enddo
1050  enddo
1051  do k = 1, ukmax
1052  urban_trl(k,i,j) = urban_sfc_temp_in(i,j)
1053  urban_tbl(k,i,j) = urban_sfc_temp_in(i,j)
1054  urban_tgl(k,i,j) = urban_sfc_temp_in(i,j)
1055  enddo
1056  urban_tc(i,j) = urban_tc_in(i,j)
1057  urban_qc(i,j) = urban_qc_in(i,j)
1058  urban_uc(i,j) = urban_uc_in(i,j)
1059  urban_tr(i,j) = urban_sfc_temp_in(i,j)
1060  urban_tb(i,j) = urban_sfc_temp_in(i,j)
1061  urban_tg(i,j) = urban_sfc_temp_in(i,j)
1062  urban_rainr(i,j) = 0.0_rp
1063  urban_rainb(i,j) = 0.0_rp
1064  urban_raing(i,j) = 0.0_rp
1065  urban_roff(i,j) = 0.0_rp
1066  end if
1067 
1068  atmos_phy_sf_sfc_z0m(i,j) = ocean_sfc_z0m(i,j)
1069  atmos_phy_sf_sfc_z0h(i,j) = ocean_sfc_z0h(i,j)
1070  atmos_phy_sf_sfc_z0e(i,j) = ocean_sfc_z0e(i,j)
1071 
1072  if ( urban_do ) then
1073  atmos_phy_sf_sfc_temp(i,j) = fact_ocean(i,j) * ocean_sfc_temp(i,j) &
1074  + fact_land(i,j) * land_sfc_temp(i,j) &
1075  + fact_urban(i,j) * urban_sfc_temp(i,j)
1076  do irgn = i_r_ir, i_r_vis
1077  do idir = i_r_direct, i_r_diffuse
1078  atmos_phy_sf_sfc_albedo(i,j,idir,irgn) = fact_ocean(i,j) * ocean_sfc_albedo(i,j,idir,irgn) &
1079  + fact_land(i,j) * land_sfc_albedo(i,j,idir,irgn) &
1080  + fact_urban(i,j) * urban_sfc_albedo(i,j,idir,irgn)
1081  enddo
1082  enddo
1083  else
1084  atmos_phy_sf_sfc_temp(i,j) = fact_ocean(i,j) * ocean_sfc_temp(i,j) &
1085  + fact_land(i,j) * land_sfc_temp(i,j)
1086  do irgn = i_r_ir, i_r_vis
1087  do idir = i_r_direct, i_r_diffuse
1088  atmos_phy_sf_sfc_albedo(i,j,idir,irgn) = fact_ocean(i,j) * ocean_sfc_albedo(i,j,idir,irgn) &
1089  + fact_land(i,j) * land_sfc_albedo(i,j,idir,irgn)
1090  enddo
1091  enddo
1092  endif
1093  enddo
1094  enddo
1095  !$acc end kernels
1096 
1097 
1098  end if ! t==1
1099 
1100 
1101  !--- output boundary data
1102  if ( multi_ocean ) then
1103 
1104  if ( t==1 ) then
1105  if ( boundary_postfix_timelabel_ocean ) then
1106  call time_gettimelabel( timelabel )
1107  basename_out_mod = trim(basename_boundary_ocean)//'_'//trim(timelabel)
1108  else
1109  basename_out_mod = trim(basename_boundary_ocean)
1110  endif
1111 
1112  call boundarysurfacesetup( basename_out_mod, & ! [IN]
1113  boundary_title_ocean, & ! [IN]
1114  boundary_update_dt_ocean, & ! [IN]
1115  multi_ocean, multi_land, & ! [IN]
1116  fid_sfc, & ! [OUT]
1117  vid_sfc(:) ) ! [OUT]
1118  end if ! t==1
1119 
1120  call boundarysurfaceoutput( land_temp_in(:,:,:), & ! [IN]
1121  land_water_in(:,:,:), & ! [IN]
1122  land_sfc_temp_in(:,:), & ! [IN]
1123  ocean_temp_in(:,:,:), & ! [IN]
1124  ocean_sfc_temp_in(:,:), & ! [IN]
1125  ocean_sfc_z0_in(:,:), & ! [IN]
1126  multi_ocean, multi_land, & ! [IN]
1127  fid_sfc, & ! [IN]
1128  vid_sfc(:), & ! [IN]
1129  boundary_update_dt_ocean, & ! [IN]
1130  t ) ! [IN]
1131  end if
1132 
1133  end do ! oistep
1134 
1135  ! required one-step data only
1136  if( t > 0 .and. .not. ( multi_land .or. multi_ocean ) ) exit
1137 
1138  enddo
1139 
1140  deallocate( lst_ocean )
1141  deallocate( lz_org )
1142  deallocate( topo_org )
1143  deallocate( lmask_org )
1144  deallocate( omask_org )
1145 
1146  call parentsurfacefinalize( filetype_land, & ![IN]
1147  filetype_ocean ) ![IN]
1148 
1149  return
1150  end subroutine realinput_surface
1151 
1152 
1153  !-----------------------------------------------------------------------------
1155  subroutine parentatmossetup( &
1156  inputtype, &
1157  basename, &
1158  basename_num, &
1159  serial_in, &
1160  same_mptype, &
1161  use_file_density_in, &
1162  dims, &
1163  timelen, &
1164  qtrc_flag )
1165  use scale_comm_cartesc, only: &
1166  comm_world, &
1167  comm_datatype
1168  use scale_atmos_hydrometeor, only: &
1169  n_hyd
1170  use scale_mapprojection, only: &
1171  mappingparam, &
1172  mappinginfo, &
1173  mapprojection_rotcoef, &
1174  mapprojection_get_param
1175  use scale_atmos_grid_cartesc_real, only: &
1176  atmos_grid_cartesc_real_lon, &
1177  atmos_grid_cartesc_real_lat
1178  use mod_realinput_netcdf, only: &
1179  parentatmossetupnetcdf
1180  use mod_realinput_grads, only: &
1181  parentatmossetupgrads
1182  implicit none
1183 
1184  character(len=*), intent(in) :: inputtype
1185  character(len=*), intent(in) :: basename
1186  character(len=*), intent(in) :: basename_num
1187  logical, intent(in) :: serial_in ! read by a serial process
1188  logical, intent(in) :: same_mptype
1189  logical, intent(in) :: use_file_density_in ! use density data from files
1190 
1191  integer, intent(out) :: dims(6)
1192  integer, intent(out) :: timelen
1193  logical, intent(out) :: qtrc_flag(qa)
1194 
1195  real(rp), allocatable :: lon_all(:,:)
1196  real(rp), allocatable :: lat_all(:,:)
1197 
1198  real(rp) :: lon_min, lon_max
1199  real(rp) :: lat_min, lat_max
1200 
1201  type(mappingparam) :: mapping_param
1202  type(mappinginfo) :: mapping_info
1203 
1204  integer :: ierr
1205  integer :: i, j
1206  !---------------------------------------------------------------------------
1207 
1208  serial_atmos = serial_in
1209  if ( serial_atmos .and. (.not. prc_ismaster) ) then
1210  do_read_atmos = .false.
1211  else
1212  do_read_atmos = .true.
1213  endif
1214 
1215  select case(inputtype)
1216  case('NetCDF')
1217 
1218  call parentatmossetupnetcdf( dims(:), & ! [OUT]
1219  timelen, & ! [OUT]
1220  mixing_ratio, & ! [OUT]
1221  update_coord, & ! [OUT]
1222  mapping_info, & ! [OUT]
1223  qtrc_flag(:), & ! [OUT]
1224  lon_all, & ! [OUT]
1225  lat_all, & ! [OUT]
1226  basename, & ! [IN]
1227  basename_num, & ! [IN]
1228  same_mptype, & ! [IN]
1229  pt_dry, & ! [INOUT]
1230  serial_atmos, & ! [INOUT]
1231  do_read_atmos ) ! [INOUT]
1232 
1233  case('GrADS')
1234 
1235  if ( do_read_atmos ) then
1236  call parentatmossetupgrads( dims(:), & ! [OUT]
1237  timelen, & ! [OUT]
1238  qtrc_flag(:), & ! [OUT]
1239  lon_all, & ! [OUT]
1240  lat_all, & ! [OUT]
1241  basename, & ! [IN]
1242  basename_num ) ! [IN]
1243  endif
1244  mapping_info%mapping_name = ""
1245  mixing_ratio = .false.
1246  update_coord = .true.
1247 
1248  case default
1249 
1250  log_error("ParentAtmosSetup",*) 'Unsupported type of input data : ', trim(inputtype)
1251  call prc_abort
1252 
1253  end select
1254 
1255  lon_min = minval( atmos_grid_cartesc_real_lon(:,:) )
1256  lon_max = maxval( atmos_grid_cartesc_real_lon(:,:) )
1257  lat_min = minval( atmos_grid_cartesc_real_lat(:,:) )
1258  lat_max = maxval( atmos_grid_cartesc_real_lat(:,:) )
1259 
1260  if ( serial_atmos ) then
1261  call comm_bcast( 6, dims(:) )
1262  call comm_bcast( timelen )
1263 
1264  call comm_bcast( qa, qtrc_flag(:) )
1265 
1266  call comm_bcast( mixing_ratio )
1267  call comm_bcast( update_coord )
1268 
1269  call comm_bcast( mapping_info%mapping_name )
1270  call comm_bcast( mapping_info%longitude_of_central_meridian )
1271  call comm_bcast( mapping_info%longitude_of_projection_origin )
1272  call comm_bcast( mapping_info%latitude_of_projection_origin )
1273  call comm_bcast( 2, mapping_info%standard_parallel )
1274  call comm_bcast( mapping_info%rotation )
1275 
1276  if ( .not. do_read_atmos ) then
1277  allocate( lon_all(dims(2), dims(3)) )
1278  allocate( lat_all(dims(2), dims(3)) )
1279  end if
1280  call comm_bcast( dims(2), dims(3), lon_all )
1281  call comm_bcast( dims(2), dims(3), lat_all )
1282 
1283  call mpi_allreduce( mpi_in_place, lon_min, 1, comm_datatype, mpi_min, comm_world, ierr )
1284  call mpi_allreduce( mpi_in_place, lon_max, 1, comm_datatype, mpi_max, comm_world, ierr )
1285  call mpi_allreduce( mpi_in_place, lat_min, 1, comm_datatype, mpi_min, comm_world, ierr )
1286  call mpi_allreduce( mpi_in_place, lat_max, 1, comm_datatype, mpi_max, comm_world, ierr )
1287  endif
1288 
1289  call get_ijrange( is_org, ie_org, js_org, je_org, & ! [OUT]
1290  dims(2), dims(3), & ! [IN]
1291  lon_min, lon_max, lat_min, lat_max, & ! [IN]
1292  lon_all, lat_all ) ! [IN]
1293  ka_org = dims(1) + 2
1294  ks_org = 1
1295  ke_org = ka_org
1296  ia_org = ie_org - is_org + 1
1297  ja_org = je_org - js_org + 1
1298 
1299  allocate( lon_org( ia_org, ja_org) )
1300  allocate( lat_org( ia_org, ja_org) )
1301  allocate( cz_org(ka_org, ia_org, ja_org) )
1302 
1303  allocate( w_org(ka_org, ia_org, ja_org ) )
1304  allocate( u_org(ka_org, ia_org, ja_org ) )
1305  allocate( v_org(ka_org, ia_org, ja_org ) )
1306  allocate( pt_org(ka_org, ia_org, ja_org ) )
1307  allocate( temp_org(ka_org, ia_org, ja_org ) )
1308  allocate( pres_org(ka_org, ia_org, ja_org ) )
1309  allocate( dens_org(ka_org, ia_org, ja_org ) )
1310  allocate( qtrc_org(ka_org, ia_org, ja_org, qa) )
1311 
1312  allocate( qv_org(ka_org, ia_org, ja_org ) )
1313  allocate( rh_org(ka_org, ia_org, ja_org ) )
1314  allocate( qhyd_org(ka_org, ia_org, ja_org, n_hyd) )
1315  allocate( qnum_org(ka_org, ia_org, ja_org, n_hyd) )
1316 
1317  allocate( rotc_org(ia_org, ja_org, 2) )
1318 
1319  allocate( igrd( ia, ja, itp_nh_a) )
1320  allocate( jgrd( ia, ja, itp_nh_a) )
1321  allocate( hfact( ia, ja, itp_nh_a) )
1322  allocate( kgrd(ka, 2, ia, ja, itp_nh_a) )
1323  allocate( vfact(ka, ia, ja, itp_nh_a) )
1324 
1325  !$omp parallel do
1326  do j = 1, ja_org
1327  do i = 1, ia_org
1328  lon_org(i,j) = lon_all(i-1+is_org,j-1+js_org)
1329  lat_org(i,j) = lat_all(i-1+is_org,j-1+js_org)
1330  end do
1331  end do
1332 
1333  deallocate( lon_all )
1334  deallocate( lat_all )
1335 
1336  if ( mapping_info%mapping_name /= "" ) then
1337  call mapprojection_get_param( mapping_info, mapping_param )
1338  call mapprojection_rotcoef( &
1339  ia_org, 1, ia_org, ja_org, 1, ja_org, &
1340  lon_org(:,:), lat_org(:,:), &
1341  mapping_info%mapping_name, &
1342  mapping_param, &
1343  rotc_org(:,:,1), rotc_org(:,:,2) )
1344  else
1345  rotc_org(:,:,1) = 1.0_rp
1346  rotc_org(:,:,2) = 0.0_rp
1347  end if
1348 
1349  first_atmos = .true.
1350 
1351  return
1352  end subroutine parentatmossetup
1353 
1354  !-----------------------------------------------------------------------------
1356  subroutine parentatmosfinalize( &
1357  inputtype )
1358  use mod_realinput_netcdf, only: &
1359  parentatmosfinalizenetcdf
1360  implicit none
1361 
1362  character(len=*), intent(in) :: inputtype
1363  !---------------------------------------------------------------------------
1364 
1365  select case(inputtype)
1366  case('NetCDF')
1367 
1368  if ( do_read_atmos ) then
1369  call parentatmosfinalizenetcdf
1370  end if
1371 
1372  case('GrADS')
1373  ! do nothing
1374  end select
1375 
1376  deallocate( igrd )
1377  deallocate( jgrd )
1378  deallocate( hfact )
1379  deallocate( kgrd )
1380  deallocate( vfact )
1381 
1382  deallocate( rotc_org )
1383 
1384  deallocate( lon_org )
1385  deallocate( lat_org )
1386  deallocate( cz_org )
1387 
1388  deallocate( w_org )
1389  deallocate( u_org )
1390  deallocate( v_org )
1391  deallocate( pt_org )
1392  deallocate( temp_org )
1393  deallocate( pres_org )
1394  deallocate( dens_org )
1395  deallocate( qtrc_org )
1396 
1397  deallocate( qv_org )
1398  deallocate( rh_org )
1399  deallocate( qhyd_org )
1400  deallocate( qnum_org )
1401 
1402  return
1403  end subroutine parentatmosfinalize
1404 
1405 
1406  !-----------------------------------------------------------------------------
1408  subroutine parentatmosopen( &
1409  inputtype, &
1410  basename_org, &
1411  basename_num )
1412  use mod_realinput_netcdf, only: &
1413  parentatmosopennetcdf
1414  implicit none
1415 
1416  character(len=*), intent(in) :: inputtype
1417  character(len=*), intent(in) :: basename_org
1418  character(len=*), intent(in) :: basename_num
1419 
1420  !---------------------------------------------------------------------------
1421 
1422  select case(inputtype)
1423  case('NetCDF')
1424 
1425  if ( do_read_atmos ) then
1426  call parentatmosopennetcdf( basename_org, basename_num )
1427  endif
1428 
1429  case('GrADS')
1430 
1431  ! do nothing
1432  end select
1433 
1434  return
1435  end subroutine parentatmosopen
1436 
1437  !-----------------------------------------------------------------------------
1439  subroutine parentatmosinput( &
1440  inputtype, &
1441  basename_num, &
1442  dims, &
1443  istep, &
1444  sfc_diagnoses, &
1445  under_sfc, &
1446  same_mptype, &
1447  skip_vcheck, &
1448  qtrc_flag, &
1449  DENS, &
1450  MOMZ, &
1451  MOMX, &
1452  MOMY, &
1453  RHOT, &
1454  QTRC, &
1455  VELZ, &
1456  VELX, &
1457  VELY, &
1458  POTT, &
1459  PRES )
1460  use scale_const, only: &
1461  undef => const_undef, &
1462  pi => const_pi, &
1463  grav => const_grav, &
1464  epsvap => const_epsvap, &
1465  epstvap => const_epstvap, &
1466  pre00 => const_pre00, &
1467  rdry => const_rdry, &
1468  cpdry => const_cpdry, &
1469  cpvap => const_cpvap, &
1470  laps => const_laps
1471  use scale_comm_cartesc, only: &
1472  comm_vars8, &
1473  comm_wait
1474  use scale_atmos_grid_cartesc_metric, only: &
1475  rotc => atmos_grid_cartesc_metric_rotc
1476  use scale_atmos_hydrometeor, only: &
1477  atmos_hydrometeor_dry, &
1478  n_hyd, &
1479  i_qv, &
1480  qls, &
1481  qle
1482  use scale_atmos_thermodyn, only: &
1483  thermodyn_qdry => atmos_thermodyn_qdry, &
1484  thermodyn_r => atmos_thermodyn_r, &
1485  thermodyn_cp => atmos_thermodyn_cp, &
1486  thermodyn_rhot2pres => atmos_thermodyn_rhot2pres, &
1487  thermodyn_temp_pres2pott => atmos_thermodyn_temp_pres2pott, &
1488  thermodyn_specific_heat => atmos_thermodyn_specific_heat
1489  use scale_atmos_saturation, only: &
1490  psat => atmos_saturation_psat_liq
1491  use scale_atmos_hydrostatic, only: &
1492  hydrostatic_buildrho_real => atmos_hydrostatic_buildrho_real
1493  use scale_interp, only: &
1494  interp_domain_compatibility, &
1495  interp_factor3d, &
1496  interp_interp3d
1497  use scale_filter, only: &
1498  filter_hyperdiff
1499  use mod_realinput_netcdf, only: &
1500  parentatmosinputnetcdf
1501  use mod_realinput_grads, only: &
1502  parentatmosinputgrads
1503  use mod_atmos_phy_mp_vars, only: &
1504  qs_mp, &
1505  qe_mp
1506  use mod_atmos_phy_mp_driver, only: &
1507  atmos_phy_mp_driver_qhyd2qtrc
1508  use mod_atmos_phy_sf_vars, only: &
1509  z0m => atmos_phy_sf_sfc_z0m
1510  use scale_atmos_grid_cartesc, only: &
1511  cx => atmos_grid_cartesc_cx, &
1512  cy => atmos_grid_cartesc_cy
1513  use scale_atmos_grid_cartesc_real, only: &
1514  cz => atmos_grid_cartesc_real_cz
1515  use scale_mapprojection, only: &
1516  mapprojection_lonlat2xy
1517  use scale_topography, only: &
1518  topo => topography_zsfc
1519  implicit none
1520 
1521  character(len=*), intent(in) :: inputtype
1522  character(len=*), intent(in) :: basename_num
1523  integer, intent(in) :: dims(6)
1524  integer, intent(in) :: istep
1525  logical, intent(in) :: sfc_diagnoses
1526  logical, intent(in) :: under_sfc
1527  logical, intent(in) :: same_mptype ! Is microphysics type same between outer and inner model
1528  logical, intent(in) :: skip_vcheck
1529  logical, intent(in) :: qtrc_flag(qa)
1530 
1531  real(rp), intent(out) :: dens(ka,ia,ja)
1532  real(rp), intent(out) :: momz(ka,ia,ja)
1533  real(rp), intent(out) :: momx(ka,ia,ja)
1534  real(rp), intent(out) :: momy(ka,ia,ja)
1535  real(rp), intent(out) :: rhot(ka,ia,ja)
1536  real(rp), intent(out) :: qtrc(ka,ia,ja,qa)
1537  real(rp), intent(out) :: velz(ka,ia,ja)
1538  real(rp), intent(out) :: velx(ka,ia,ja)
1539  real(rp), intent(out) :: vely(ka,ia,ja)
1540  real(rp), intent(out) :: pott(ka,ia,ja)
1541  real(rp), intent(out) :: pres(ka,ia,ja)
1542 
1543  real(rp) :: pres2(ka,ia,ja)
1544  real(rp) :: temp (ka,ia,ja)
1545  real(rp) :: w (ka,ia,ja)
1546  real(rp) :: u (ka,ia,ja)
1547  real(rp) :: v (ka,ia,ja)
1548  real(rp) :: qv (ka,ia,ja)
1549  real(rp) :: qc (ka,ia,ja)
1550  real(rp) :: dens2(ka,ia,ja)
1551  real(rp) :: u_on_map, v_on_map
1552 
1553  real(rp) :: qdry(ka_org,ia_org,ja_org)
1554  real(rp) :: rtot(ka_org,ia_org,ja_org)
1555  real(rp) :: cptot(ka_org,ia_org,ja_org)
1556  real(rp) :: cvtot(ka_org,ia_org,ja_org)
1557  real(rp) :: qtot, p_sat, qm
1558  real(rp) :: rhot_tmp
1559 
1560  integer :: lm_layer(ia_org,ja_org)
1561 
1562  real(rp) :: x_org(ia_org,ja_org)
1563  real(rp) :: y_org(ia_org,ja_org)
1564  logical :: zonal, pole
1565 
1566  real(rp) :: wsum(ka,ia,ja)
1567  real(rp) :: work(ka,ia,ja)
1568 
1569  logical :: same_mptype_
1570  logical :: uvmet
1571  logical :: nopres
1572  logical :: nodens
1573  logical :: rh2qv
1574  logical :: qnum_flag
1575 
1576  real(rp) :: one(ka,ia,ja)
1577 
1578  real(rp) :: dz
1579 
1580  integer :: kref, k0
1581  integer :: k, i, j, iq
1582  !---------------------------------------------------------------------------
1583 
1584  call prof_rapstart('___AtmosInput',3)
1585 
1586  if ( do_read_atmos ) then
1587  select case(inputtype)
1588  case('NetCDF')
1589  call parentatmosinputnetcdf( ka_org, ks_org, ke_org, &
1590  ia_org, is_org, ie_org, &
1591  ja_org, js_org, je_org, &
1592  qa, &
1593  cz_org(:,:,:), & ! [INOUT]
1594  w_org(:,:,:), & ! [OUT]
1595  u_org(:,:,:), & ! [OUT]
1596  v_org(:,:,:), & ! [OUT]
1597  pres_org(:,:,:), & ! [OUT]
1598  dens_org(:,:,:), & ! [OUT]
1599  temp_org(:,:,:), & ! [OUT]
1600  pt_org(:,:,:), & ! [OUT]
1601  qtrc_org(:,:,:,:), & ! [OUT]
1602  qv_org(:,:,:), & ! [OUT]
1603  rh_org(:,:,:), & ! [OUT]
1604  qhyd_org(:,:,:,:), & ! [OUT]
1605  qnum_org(:,:,:,:), & ! [OUT]
1606  nopres, nodens, & ! [OUT]
1607  uvmet, & ! [OUT]
1608  temp2pt, rh2qv, & ! [OUT]
1609  qnum_flag, & ! [OUT]
1610  same_mptype, & ! [IN]
1611  sfc_diagnoses, & ! [IN]
1612  update_coord, & ! [IN]
1613  dims(:), & ! [IN]
1614  istep ) ! [IN]
1615  same_mptype_ = same_mptype
1616  case('GrADS')
1617  call parentatmosinputgrads ( ka_org, ks_org, ke_org, &
1618  ia_org, is_org, ie_org, &
1619  ja_org, js_org, je_org, &
1620  qa, &
1621  w_org(:,:,:), & ! [OUT]
1622  u_org(:,:,:), & ! [OUT]
1623  v_org(:,:,:), & ! [OUT]
1624  pres_org(:,:,:), & ! [OUT]
1625  dens_org(:,:,:), & ! [OUT]
1626  pt_org(:,:,:), & ! [OUT]
1627  temp_org(:,:,:), & ! [OUT]
1628  qv_org(:,:,:), & ! [OUT]
1629  rh_org(:,:,:), & ! [OUT]
1630  qhyd_org(:,:,:,:), & ! [OUT]
1631  qtrc_org(:,:,:,:), & ! [OUT]
1632  cz_org(:,:,:), & ! [OUT]
1633  nopres, nodens, & ! [OUT]
1634  temp2pt, rh2qv, & ! [OUT]
1635  basename_num, & ! [IN]
1636  sfc_diagnoses, & ! [IN]
1637  istep ) ! [IN]
1638  same_mptype_ = .false.
1639  qnum_flag = .false.
1640  uvmet = .true.
1641  end select
1642 
1643  if ( sfc_diagnoses ) then
1644  k0 = 2
1645  else
1646  k0 = 3
1647  end if
1648 
1649  if ( rh2qv ) then
1650  if ( .not. temp2pt ) then
1651  log_error("ParentAtmosInput",*) 'When RH is read, TEMP is necessary'
1652  call prc_abort()
1653  end if
1654 
1655  !$omp parallel do collapse(2) &
1656  !$omp private(p_sat,qm)
1657  do j = 1, ja_org
1658  do i = 1, ia_org
1659  do k = k0, ka_org
1660  if ( temp_org(k,i,j) > undef .and. rh_org(k,i,j) > undef .and. pres_org(k,i,j) > undef ) then
1661  call psat( temp_org(k,i,j), p_sat )
1662  qm = epsvap * rh_org(k,i,j) * 0.01_rp * p_sat &
1663  / ( pres_org(k,i,j) - rh_org(k,i,j) * 0.01_rp * p_sat )
1664  qv_org(k,i,j) = qm / ( 1.0_rp + qm ) ! specific humidity
1665  else
1666  qv_org(k,i,j) = undef
1667  end if
1668  end do
1669  end do
1670  end do
1671 #ifdef QUICKDEBUG
1672  !$omp parallel do collapse(2)
1673  do j = 1, ja_org
1674  do i = 1, ia_org
1675  do k = 1, k0-1
1676  qv_org(k,i,j) = undef
1677  end do
1678  end do
1679  end do
1680 #endif
1681  end if
1682 
1683 
1684  select case( upper_qv_type )
1685  case("COPY")
1686  !$omp parallel do collapse(2)
1687  do j = 1, ja_org
1688  do i = 1, ia_org
1689  do k = 4, ka_org
1690  if ( qv_org(k,i,j) == undef ) qv_org(k,i,j) = qv_org(k-1,i,j)
1691  enddo
1692  enddo
1693  enddo
1694  case("ZERO")
1695  !$omp parallel do collapse(2)
1696  do j = 1, ja_org
1697  do i = 1, ia_org
1698  do k = 4, ka_org
1699  if ( qv_org(k,i,j) == undef ) qv_org(k,i,j) = 0.0_rp
1700  enddo
1701  enddo
1702  enddo
1703  case default
1704  log_error("ParentAtmosInput",*) 'upper_qv_type in PARAM_MKINIT_REAL is invalid! ', trim(upper_qv_type)
1705  call prc_abort
1706  end select
1707 
1708  if ( mixing_ratio ) then
1709  !$omp parallel do collapse(2) &
1710  !$omp private(qtot)
1711  do j = 1, ja_org
1712  do i = 1, ia_org
1713  do k = k0, ka_org
1714  qtot = 0.0_rp
1715  if ( qv_org(k,i,j) > undef ) then
1716  qtot = qtot + qv_org(k,i,j)
1717  end if
1718  do iq = 1, n_hyd
1719  if ( qhyd_org(k,i,j,iq) > undef ) then
1720  qtot = qtot + qhyd_org(k,i,j,iq)
1721  end if
1722  end do
1723  if( qv_org(k,i,j) > undef .and. qtot > 0.0_rp ) then
1724  qv_org(k,i,j) = qv_org(k,i,j) / ( 1.0_rp + qtot )
1725  else
1726  qv_org(k,i,j) = undef
1727  end if
1728  do iq = 1, n_hyd
1729  if ( qhyd_org(k,i,j,iq) > undef .and. qtot > 0.0_rp ) then
1730  qhyd_org(k,i,j,iq) = qhyd_org(k,i,j,iq) / ( 1.0_rp + qtot )
1731  else
1732  qhyd_org(k,i,j,iq) = 0.0_rp
1733  end if
1734  end do
1735  end do
1736  end do
1737  end do
1738  end if
1739 
1740 
1741  if ( .not. same_mptype_ ) then
1742  if ( qnum_flag ) then
1743  call atmos_phy_mp_driver_qhyd2qtrc( ka_org, k0, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, &
1744  qv_org(:,:,:), qhyd_org(:,:,:,:), & ! [IN]
1745  qtrc_org(:,:,:,qs_mp:qe_mp), & ! [OUT]
1746  qnum=qnum_org(:,:,:,:) ) ! [IN]
1747  else
1748  call atmos_phy_mp_driver_qhyd2qtrc( ka_org, k0, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, &
1749  qv_org(:,:,:), qhyd_org(:,:,:,:), & ! [IN]
1750  qtrc_org(:,:,:,qs_mp:qe_mp) ) ! [OUT]
1751  end if
1752  !$omp parallel do collapse(3)
1753  do iq = qs_mp, qe_mp
1754  do j = 1, ja_org
1755  do i = 1, ia_org
1756  do k = 1, k0-1
1757  qtrc_org(k,i,j,iq) = undef
1758  end do
1759  do k = k0, ka_org
1760  if ( qv_org(k,i,j) == undef ) qtrc_org(k,i,j,iq) = undef
1761  end do
1762  end do
1763  end do
1764  end do
1765  end if
1766 
1767  if ( pt_dry .and. .not. temp2pt ) then
1768  if ( nopres ) then
1769  log_error('ParentAtmosInput',*) 'PRES is required'
1770  call prc_abort
1771  end if
1772  !$omp parallel do collapse(2)
1773  do j = 1, ja_org
1774  do i = 1, ia_org
1775  do k = 3, ka_org
1776  temp_org(k,i,j) = pt_org(k,i,j) * ( pres_org(k,i,j) / pre00 )**(rdry/cpdry)
1777  end do
1778  end do
1779  end do
1780  temp2pt = .true.
1781  end if
1782 
1783  if ( temp2pt .or. nopres .or. nodens ) then
1784  call thermodyn_specific_heat( &
1785  ka_org, 3, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, qa, &
1786  qtrc_org(:,:,:,:), &
1787  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), &
1788  qdry(:,:,:), rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:) )
1789  end if
1790 
1791  if ( temp2pt ) then
1792  if ( nopres ) then
1793  log_error('ParentAtmosInput',*) 'If TEMP is read, PRES is required'
1794  call prc_abort
1795  end if
1796  !$omp parallel do collapse(2)
1797  do j = 1, ja_org
1798  do i = 1, ia_org
1799  do k = 3, ka_org
1800  if ( temp_org(k,i,j) == undef ) then
1801  pt_org(k,i,j) = undef
1802  else
1803  call thermodyn_temp_pres2pott( &
1804  temp_org(k,i,j), pres_org(k,i,j), & ! [IN]
1805  cptot(k,i,j), rtot(k,i,j), & ! [IN]
1806  pt_org(k,i,j) ) ! [OUT]
1807  end if
1808  enddo
1809  enddo
1810  enddo
1811  endif
1812 
1813  if ( nopres ) then
1814  if ( nodens ) then
1815  log_error('ParentAtmosInput',*) 'If PRES does not exist, DENS is required'
1816  call prc_abort
1817  end if
1818  !$omp parallel do collapse(2) &
1819  !$omp private(rhot_tmp)
1820  do j = 1, ja_org
1821  do i = 1, ia_org
1822  do k = 3, ka_org
1823  if ( pt_org(k,i,j) == undef ) then
1824  pres_org(k,i,j) = undef
1825  else
1826  rhot_tmp = pt_org(k,i,j) * dens_org(k,i,j)
1827  call thermodyn_rhot2pres( &
1828  rhot_tmp, cvtot(k,i,j), cptot(k,i,j), rtot(k,i,j), & ! [IN]
1829  pres_org(k,i,j) ) ! [OUT]
1830  end if
1831  enddo
1832  enddo
1833  enddo
1834  end if
1835 
1836  if ( nodens .and. use_file_density ) then
1837  log_error('ParentAtmosInput',*) 'DENS is required when USE_FILE_DENSITY is true'
1838  call prc_abort
1839  end if
1840 
1841 
1842  lm_layer(:,:) = 3
1843  !$omp parallel do collapse(2)
1844  do j = 1, ja_org
1845  do i = 1, ia_org
1846  do k = 3, ka_org
1847  ! search the lowermost layer excluding UNDEF
1848  if( pres_org(k,i,j) == undef ) then
1849  lm_layer(i,j) = k + 1
1850  else
1851  exit
1852  end if
1853  end do
1854  end do
1855  end do
1856  if ( sfc_diagnoses ) then
1857 
1858  if ( .not. under_sfc ) then
1859  !$omp parallel do collapse(2)
1860  do j = 1, ja_org
1861  do i = 1, ia_org
1862  do k = 3, ka_org
1863  if ( .not. ( &
1864  .not. (cz_org(2,i,j) > undef .and. cz_org(k,i,j) > cz_org(2,i,j) ) .or. &
1865  .not. (pres_org(2,i,j) > undef .and. pres_org(k,i,j) > pres_org(2,i,j) ) &
1866  ) ) then
1867  lm_layer(i,j) = k
1868  exit
1869  end if
1870  end do
1871  end do
1872  end do
1873  end if
1874 
1875  ! groud surface
1876 
1877  !$omp parallel do &
1878  !$omp private(k,dz)
1879  do j = 1, ja_org
1880  do i = 1, ia_org
1881  k = lm_layer(i,j)
1882 
1883  if ( cz_org(2,i,j) > undef .and. & ! topo exists
1884  ( .not. under_sfc .or. cz_org(2,i,j) < cz_org(k,i,j) ) ) then ! surface is lower than the lowest data
1885  dz = cz_org(k,i,j) - cz_org(2,i,j)
1886  if ( qv_org(2,i,j) > undef ) qv_org(2,i,j) = qtrc_org(k,i,j,qs_mp)
1887  if ( temp_org(2,i,j) > undef .and. pres_org(2,i,j) > undef ) then
1888  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1889  dens_org(2,i,j) = pres_org(2,i,j) / ( rtot(2,i,j) * temp_org(2,i,j) )
1890  else if ( pres_org(2,i,j) > undef ) then
1891  dens_org(2,i,j) = - ( pres_org(k,i,j) - pres_org(2,i,j) ) * 2.0_rp / ( grav * dz ) &
1892  - dens_org(k,i,j)
1893  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1894  temp_org(2,i,j) = pres_org(2,i,j) / ( rtot(2,i,j) * dens_org(2,i,j) )
1895  else if ( temp_org(2,i,j) > undef ) then
1896  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1897  dens_org(2,i,j) = ( pres_org(k,i,j) + grav * dens_org(k,i,j) * dz * 0.5_rp ) &
1898  / ( rtot(2,i,j) * temp_org(2,i,j) - grav * dz * 0.5_rp )
1899  pres_org(2,i,j) = dens_org(2,i,j) * rtot(2,i,j) * temp_org(2,i,j)
1900  else
1901  temp_org(2,i,j) = temp_org(k,i,j) + laps * dz
1902  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1903  dens_org(2,i,j) = ( pres_org(k,i,j) + grav * dens_org(k,i,j) * dz * 0.5_rp ) &
1904  / ( rtot(2,i,j) * temp_org(2,i,j) - grav * dz * 0.5_rp )
1905  pres_org(2,i,j) = dens_org(2,i,j) * rtot(2,i,j) * temp_org(2,i,j)
1906  end if
1907  cptot(2,i,j) = cpdry + ( cpvap - cpdry ) * qv_org(2,i,j)
1908  pt_org(2,i,j) = temp_org(2,i,j) * ( pre00 / pres_org(2,i,j) )**(rtot(2,i,j)/cptot(2,i,j))
1909 
1910  else ! no topo
1911 
1912  ! ignore surface variables
1913  cz_org(2,i,j) = cz_org(k,i,j)
1914  w_org(2,i,j) = w_org(k,i,j)
1915  u_org(2,i,j) = u_org(k,i,j)
1916  v_org(2,i,j) = v_org(k,i,j)
1917  pres_org(2,i,j) = pres_org(k,i,j)
1918  pt_org(2,i,j) = pt_org(k,i,j)
1919  dens_org(2,i,j) = dens_org(k,i,j)
1920  qtrc_org(2,i,j,:) = qtrc_org(k,i,j,:)
1921 
1922  end if
1923 
1924  end do
1925  end do
1926 
1927 
1928  ! sea level
1929 
1930  !$omp parallel do
1931  do j = 1, ja_org
1932  do i = 1, ia_org
1933  if ( pres_org(1,i,j) > undef ) then
1934  temp_org(1,i,j) = temp_org(2,i,j) + laps * cz_org(2,i,j)
1935  rtot(1,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1936  cptot(1,i,j) = cpdry + ( cpvap - cpdry ) * qv_org(2,i,j)
1937  dens_org(1,i,j) = pres_org(1,i,j) / ( rtot(1,i,j) * temp_org(1,i,j) )
1938  pt_org(1,i,j) = temp_org(1,i,j) * ( pre00 / pres_org(1,i,j) )**(rtot(1,i,j)/cptot(1,i,j))
1939  cz_org(1,i,j) = 0.0_rp
1940  w_org(1,i,j) = w_org(2,i,j)
1941  u_org(1,i,j) = u_org(2,i,j)
1942  v_org(1,i,j) = v_org(2,i,j)
1943  qtrc_org(1,i,j,:) = qtrc_org(2,i,j,:)
1944  else
1945  cz_org(1,i,j) = undef
1946  w_org(1,i,j) = undef
1947  u_org(1,i,j) = undef
1948  v_org(1,i,j) = undef
1949  pres_org(1,i,j) = undef
1950  pt_org(1,i,j) = undef
1951  dens_org(1,i,j) = undef
1952  qtrc_org(1,i,j,:) = undef
1953  end if
1954  end do
1955  end do
1956 
1957  else
1958 
1959  !$omp parallel do
1960  do j = 1, ja_org
1961  do i = 1, ia_org
1962  cz_org(1:2,i,j) = undef
1963  w_org(1:2,i,j) = undef
1964  u_org(1:2,i,j) = undef
1965  v_org(1:2,i,j) = undef
1966  pres_org(1:2,i,j) = undef
1967  temp_org(1:2,i,j) = undef
1968  dens_org(1:2,i,j) = undef
1969  qtrc_org(1:2,i,j,:) = undef
1970  end do
1971  end do
1972 
1973  end if ! sfc_diagnoses
1974 
1975  endif ! read by this process?
1976 
1977  call prof_rapend ('___AtmosInput',3)
1978 
1979  call prof_rapstart('___AtmosBcast',3)
1980 
1981  if ( serial_atmos ) then
1982  if ( first_atmos .or. update_coord ) then
1983  call comm_bcast( ka_org, ia_org, ja_org, cz_org )
1984  end if
1985  call comm_bcast( ka_org, ia_org, ja_org, pres_org )
1986  call comm_bcast( ka_org, ia_org, ja_org, w_org )
1987  call comm_bcast( ka_org, ia_org, ja_org, u_org )
1988  call comm_bcast( ka_org, ia_org, ja_org, v_org )
1989  call comm_bcast( ka_org, ia_org, ja_org, pt_org )
1990  call comm_bcast( ka_org, ia_org, ja_org, dens_org )
1991  call comm_bcast( ka_org, ia_org, ja_org, qa, qtrc_org )
1992  call comm_bcast( uvmet )
1993  endif
1994 
1995  call prof_rapend ('___AtmosBcast',3)
1996 
1997  !$omp parallel do collapse(3)
1998  do iq = 1, qa
1999  do j = 1, ja_org
2000  do i = 1, ia_org
2001  do k = 1, ka_org
2002  if ( qtrc_org(k,i,j,iq) .ne. undef ) then
2003  qtrc_org(k,i,j,iq) = max( qtrc_org(k,i,j,iq), 0.0_rp )
2004  end if
2005  enddo
2006  enddo
2007  enddo
2008  enddo
2009 
2010  ! interpolation
2011  call prof_rapstart('___AtmosInterp',3)
2012 
2013  if ( first_atmos .or. update_coord ) then
2014 
2015  k = ka_org
2016  call interp_domain_compatibility( lon_org(:,:), & ! [IN]
2017  lat_org(:,:), & ! [IN]
2018  cz_org(k,:,:), & ! [IN]
2019  lon(:,:), & ! [IN]
2020  lat(:,:), & ! [IN]
2021  cz(ke,:,:), & ! [IN]
2022  fz(ke,:,:), & ! [IN]
2023  skip_z = skip_vcheck ) ! [IN]
2024 
2025  select case( itp_type_a )
2026  case ( i_intrp_linear )
2027 
2028  if ( ia_org == 1 .or. ja_org == 1 ) then
2029  log_error("ParentAtmosInput",*) 'LINER interpolation requires nx, ny > 1'
2030  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_ATMOS'
2031  call prc_abort
2032  end if
2033 
2034  !$omp parallel do
2035  do j = 1, ja_org
2036  do i = 1, ia_org
2037  lat_org(i,j) = sign( min( abs(lat_org(i,j)), pi * 0.499999_rp ), lat_org(i,j) )
2038  end do
2039  end do
2040 
2041  call mapprojection_lonlat2xy( ia_org, 1, ia_org, & ! [IN]
2042  ja_org, 1, ja_org, & ! [IN]
2043  lon_org(:,:), & ! [IN]
2044  lat_org(:,:), & ! [IN]
2045  x_org(:,:), & ! [OUT]
2046  y_org(:,:) ) ! [OUT]
2047 
2048  zonal = ( maxval(lon_org) - minval(lon_org) ) > 2.0_rp * pi * 0.9_rp
2049  pole = ( maxval(lat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(lat_org) < - pi * 0.5_rp * 0.9_rp )
2050  call interp_factor3d( ka_org, 1, ka_org, & ! [IN]
2051  ia_org, ja_org, & ! [IN]
2052  ka, ks, ke, & ! [IN]
2053  ia, ja, & ! [IN]
2054  x_org(:,:), y_org(:,:), & ! [IN]
2055  cz_org(:,:,:), & ! [IN]
2056  cx(:), cy(:), & ! [IN]
2057  cz(:,:,:), & ! [IN]
2058  igrd( :,:,:), & ! [OUT]
2059  jgrd( :,:,:), & ! [OUT]
2060  hfact( :,:,:), & ! [OUT]
2061  kgrd(:,:,:,:,:), & ! [OUT]
2062  vfact(:, :,:,:), & ! [OUT]
2063  flag_extrap = .false., & ! [IN]
2064  zonal = zonal, & ! [IN]
2065  pole = pole ) ! [IN]
2066 
2067  case ( i_intrp_dstwgt )
2068 
2069  call interp_factor3d( itp_nh_a, & ! [IN]
2070  ka_org, 1, ka_org, & ! [IN]
2071  ia_org, ja_org, & ! [IN]
2072  ka, ks, ke, & ! [IN]
2073  ia, ja, & ! [IN]
2074  lon_org(:,:), & ! [IN]
2075  lat_org(:,:), & ! [IN]
2076  cz_org(:,:,:), & ! [IN]
2077  lon(:,:), & ! [IN]
2078  lat(:,:), & ! [IN]
2079  cz(:,:,:), & ! [IN]
2080  igrd( :,:,:), & ! [OUT]
2081  jgrd( :,:,:), & ! [OUT]
2082  hfact( :,:,:), & ! [OUT]
2083  kgrd(:,:,:,:,:), & ! [OUT]
2084  vfact(:, :,:,:), & ! [OUT]
2085  flag_extrap = .false. ) ! [IN]
2086 
2087  end select
2088 
2089  endif
2090 
2091  call interp_interp3d( itp_nh_a, &
2092  ka_org, 1, ka_org, &
2093  ia_org, ja_org, &
2094  ka, ks, ke, &
2095  ia, ja, &
2096  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2097  hfact(:,:,:), & ! [IN]
2098  kgrd(:,:,:,:,:), & ! [IN]
2099  vfact(:,:,:,:), & ! [IN]
2100  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2101  w_org(:,:,:), & ! [IN]
2102  w(:,:,:), & ! [OUT]
2103  spline = .false., & ! [IN]
2104  threshold_undef = 1.0_rp, & ! [IN]
2105  wsum = wsum(:,:,:), & ! [OUT]
2106  val2 = work(:,:,:) ) ! [OUT]
2107  !$omp parallel do collapse(2) &
2108  !$omp private(kref)
2109  do j = 1, ja
2110  do i = 1, ia
2111 !CDIR NOVECTOR
2112  do k = ks, ka
2113  if ( w(k,i,j) .ne. undef ) then
2114  kref = k
2115  exit
2116  end if
2117  end do
2118  do k = kref-1, ks, -1
2119  w(k,i,j) = w(k+1,i,j) * log( ( cz(k,i,j) - topo(i,j) ) / z0m(i,j) ) / log( ( cz(k+1,i,j) - topo(i,j) ) / z0m(i,j) ) * ( 1.0_rp - wsum(k,i,j) ) &
2120  + work(k,i,j) * wsum(k,i,j)
2121  end do
2122  do k = kref+1, ke
2123  if ( w(k,i,j) == undef ) w(k,i,j) = w(k-1,i,j)
2124  end do
2125  end do
2126  end do
2127  if ( filter_niter > 0 ) then
2128  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2129  w(:,:,:), filter_order, filter_niter )
2130  call comm_vars8( w(:,:,:), 1 )
2131  call comm_wait ( w(:,:,:), 1, .false. )
2132  end if
2133 
2134  if ( .not. uvmet ) then
2135  ! rotation from map-projected field to latlon field
2136  !$omp parallel do collapse(2) &
2137  !$omp private(u_on_map,v_on_map)
2138  do j = 1, ja_org
2139  do i = 1, ia_org
2140  do k = 1, ka_org
2141  if ( u_org(k,i,j) > undef .and. v_org(k,i,j) > undef ) then
2142  u_on_map = u_org(k,i,j) * rotc_org(i,j,1) - v_org(k,i,j) * rotc_org(i,j,2)
2143  v_on_map = u_org(k,i,j) * rotc_org(i,j,2) + v_org(k,i,j) * rotc_org(i,j,1)
2144 
2145  u_org(k,i,j) = u_on_map
2146  v_org(k,i,j) = v_on_map
2147  end if
2148  enddo
2149  enddo
2150  enddo
2151  end if
2152 
2153 
2154  call interp_interp3d( itp_nh_a, &
2155  ka_org, 1, ka_org, &
2156  ia_org, ja_org, &
2157  ka, ks, ke, &
2158  ia, ja, &
2159  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2160  hfact(:,:,:), & ! [IN]
2161  kgrd(:,:,:,:,:), & ! [IN]
2162  vfact(:,:,:,:), & ! [IN]
2163  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2164  u_org(:,:,:), & ! [IN]
2165  u(:,:,:), & ! [OUT]
2166  spline = .false., & ! [IN]
2167  threshold_undef = 1.0_rp, & ! [IN]
2168  wsum = wsum(:,:,:), & ! [OUT]
2169  val2 = work(:,:,:) ) ! [OUT]
2170  !$omp parallel do collapse(2) &
2171  !$omp private(kref)
2172  do j = 1, ja
2173  do i = 1, ia
2174  do k = ks, ka
2175  if ( u(k,i,j) .ne. undef ) then
2176  kref = k
2177  exit
2178  end if
2179  end do
2180  do k = kref-1, ks, -1
2181  u(k,i,j) = u(k+1,i,j) * log( ( cz(k,i,j) - topo(i,j) ) / z0m(i,j) ) / log( ( cz(k+1,i,j) - topo(i,j) ) / z0m(i,j) ) * ( 1.0_rp - wsum(k,i,j) ) &
2182  + work(k,i,j) * wsum(k,i,j)
2183  end do
2184  do k = kref+1, ke
2185  if ( u(k,i,j) == undef ) u(k,i,j) = u(k-1,i,j)
2186  end do
2187  end do
2188  end do
2189  if ( filter_niter > 0 ) then
2190  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2191  u(:,:,:), filter_order, filter_niter )
2192  call comm_vars8( u(:,:,:), 1 )
2193  call comm_wait ( u(:,:,:), 1, .false. )
2194  end if
2195 
2196  call interp_interp3d( itp_nh_a, &
2197  ka_org, 1, ka_org, &
2198  ia_org, ja_org, &
2199  ka, ks, ke, &
2200  ia, ja, &
2201  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2202  hfact(:,:,:), & ! [IN]
2203  kgrd(:,:,:,:,:), & ! [IN]
2204  vfact(:,:,:,:), & ! [IN]
2205  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2206  v_org(:,:,:), & ! [IN]
2207  v(:,:,:), & ! [OUT]
2208  spline = .false., & ! [IN]
2209  threshold_undef = 1.0_rp, & ! [IN]
2210  wsum = wsum(:,:,:), & ! [OUT]
2211  val2 = work(:,:,:) ) ! [OUT]
2212  !$omp parallel do collapse(2) &
2213  !$omp private(kref)
2214  do j = 1, ja
2215  do i = 1, ia
2216  do k = ks, ka
2217  if ( v(k,i,j) .ne. undef ) then
2218  kref = k
2219  exit
2220  end if
2221  end do
2222  do k = kref-1, ks, -1
2223  v(k,i,j) = v(k+1,i,j) * log( ( cz(k,i,j) - topo(i,j) ) / z0m(i,j) ) / log( ( cz(k+1,i,j) - topo(i,j) ) / z0m(i,j) ) * ( 1.0_rp - wsum(k,i,j) ) &
2224  + work(k,i,j) * wsum(k,i,j)
2225  end do
2226  do k = kref+1, ke
2227  if ( v(k,i,j) == undef ) v(k,i,j) = v(k-1,i,j)
2228  end do
2229  end do
2230  end do
2231  if ( filter_niter > 0 ) then
2232  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2233  v(:,:,:), filter_order, filter_niter )
2234  call comm_vars8( v(:,:,:), 1 )
2235  call comm_wait ( v(:,:,:), 1, .false. )
2236  end if
2237 
2238  ! rotation from latlon field to map-projected field
2239  !$omp parallel do collapse(2) &
2240  !$omp private(u_on_map,v_on_map)
2241  do j = 1, ja
2242  do i = 1, ia
2243  do k = ks, ke
2244  u_on_map = u(k,i,j) * rotc(i,j,1) + v(k,i,j) * rotc(i,j,2)
2245  v_on_map = -u(k,i,j) * rotc(i,j,2) + v(k,i,j) * rotc(i,j,1)
2246 
2247  u(k,i,j) = u_on_map
2248  v(k,i,j) = v_on_map
2249  enddo
2250  enddo
2251  enddo
2252 
2253  ! from scalar point to staggered point
2254  !$omp parallel do collapse(2)
2255  do j = 1, ja
2256  do i = 1, ia
2257  do k = ks, ke-1
2258  velz(k,i,j) = 0.5_rp * ( w(k+1,i,j) + w(k,i,j) )
2259  enddo
2260  enddo
2261  enddo
2262 
2263  !$omp parallel do
2264  do j = 1, ja
2265  do i = 1, ia-1
2266  do k = ks, ke
2267  velx(k,i,j) = 0.5_rp * ( u(k,i+1,j) + u(k,i,j) )
2268  enddo
2269  enddo
2270  enddo
2271 
2272  i = ia
2273  !$omp parallel do
2274  do j = 1, ja
2275  do k = ks, ke
2276  velx(k,i,j) = u(k,i,j)
2277  enddo
2278  enddo
2279 
2280  !$omp parallel do
2281  do j = 1, ja-1
2282  do i = 1, ia
2283  do k = ks, ke
2284  vely(k,i,j) = 0.5_rp * ( v(k,i,j+1) + v(k,i,j) )
2285  enddo
2286  enddo
2287  enddo
2288 
2289  j = ja
2290  !$omp parallel do
2291  do i = 1, ia
2292  do k = ks, ke
2293  vely(k,i,j) = v(k,i,j)
2294  enddo
2295  enddo
2296 
2297  !$omp parallel do
2298  do j = 1, ja
2299  do i = 1, ia
2300  velz( 1:ks-1,i,j) = 0.0_rp
2301  velz(ke :ka ,i,j) = 0.0_rp
2302  velx( 1:ks-1,i,j) = 0.0_rp
2303  velx(ke+1:ka ,i,j) = 0.0_rp
2304  vely( 1:ks-1,i,j) = 0.0_rp
2305  vely(ke+1:ka ,i,j) = 0.0_rp
2306  enddo
2307  enddo
2308 
2309  call comm_vars8( velz(:,:,:), 1 )
2310  call comm_vars8( velx(:,:,:), 2 )
2311  call comm_vars8( vely(:,:,:), 3 )
2312  call comm_wait ( velz(:,:,:), 1, .false. )
2313  call comm_wait ( velx(:,:,:), 2, .false. )
2314  call comm_wait ( vely(:,:,:), 3, .false. )
2315 
2316  call interp_interp3d( itp_nh_a, &
2317  ka_org, 1, ka_org, &
2318  ia_org, ja_org, &
2319  ka, ks, ke, &
2320  ia, ja, &
2321  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2322  hfact(:,:,:), & ! [IN]
2323  kgrd(:,:,:,:,:), & ! [IN]
2324  vfact(:,:,:,:), & ! [IN]
2325  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2326  pt_org(:,:,:), & ! [IN]
2327  pott(:,:,:), & ! [OUT]
2328  spline = .false., & ! [IN]
2329  threshold_undef = 1.0_rp, & ! [IN]
2330  wsum = wsum(:,:,:), & ! [OUT]
2331  val2 = work(:,:,:) ) ! [OUT]
2332  !$omp parallel do collapse(2)
2333  do j = 1, ja
2334  do i = 1, ia
2335  do k = ks+1, ke
2336  if ( pott(k,i,j) == undef .and. pott(k-1,i,j) .ne. undef ) pott(k,i,j) = pott(k-1,i,j)
2337  end do
2338  do k = ke-1, ks, -1
2339  if ( pott(k,i,j) == undef ) then
2340  pott(k,i,j) = pott(k+1,i,j) * ( 1.0_rp - wsum(k,i,j) ) &
2341  + work(k,i,j) * wsum(k,i,j)
2342  end if
2343  end do
2344  pott( 1:ks-1,i,j) = undef
2345  pott(ke+1:ka ,i,j) = undef
2346  enddo
2347  enddo
2348  if ( filter_niter > 0 ) then
2349  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2350  pott(:,:,:), filter_order, filter_niter )
2351  call comm_vars8( pott(:,:,:), 1 )
2352  call comm_wait ( pott(:,:,:), 1, .false. )
2353  end if
2354 
2355  do iq = 1, qa
2356 
2357  if ( ( iq < qs_mp .or. iq > qe_mp ) .and. ( .not. qtrc_flag(iq) ) ) then
2358  !$omp parallel do collapse(2)
2359  do j = 1, ja
2360  do i = 1, ia
2361  do k = 1, ka
2362  qtrc(k,i,j,iq) = undef
2363  end do
2364  end do
2365  end do
2366  cycle
2367  end if
2368 
2369  call interp_interp3d( itp_nh_a, &
2370  ka_org, 1, ka_org, &
2371  ia_org, ja_org, &
2372  ka, ks, ke, &
2373  ia, ja, &
2374  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2375  hfact(:,:,:), & ! [IN]
2376  kgrd(:,:,:,:,:), & ! [IN]
2377  vfact(:,:,:,:), & ! [IN]
2378  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2379  qtrc_org(:,:,:,iq), & ! [IN]
2380  qtrc(:,:,:,iq), & ! [OUT]
2381  spline = .false., & ! [IN]
2382  threshold_undef = 1.0_rp, & ! [IN]
2383  wsum = wsum(:,:,:), & ! [OUT]
2384  val2 = work(:,:,:) ) ! [OUT]
2385  !$omp parallel do collapse(2)
2386  do j = 1, ja
2387  do i = 1, ia
2388  do k = ks+1, ke
2389  if ( qtrc(k,i,j,iq) == undef .and. qtrc(k-1,i,j,iq) > undef ) qtrc(k,i,j,iq) = qtrc(k-1,i,j,iq)
2390  end do
2391  do k = ke-1, ks, -1
2392  if ( qtrc(k,i,j,iq) == undef .and. qtrc(k+1,i,j,iq) > undef ) then
2393  qtrc(k,i,j,iq) = qtrc(k+1,i,j,iq) * ( 1.0_rp - wsum(k,i,j) ) &
2394  + work(k,i,j) * wsum(k,i,j)
2395  end if
2396  end do
2397  do k = ks, ke
2398  qtrc(k,i,j,iq) = max( qtrc(k,i,j,iq), 0.0_rp )
2399  end do
2400  qtrc( 1:ks-1,i,j,iq) = 0.0_rp
2401  qtrc(ke+1:ka ,i,j,iq) = 0.0_rp
2402  enddo
2403  enddo
2404  if ( filter_niter > 0 ) then
2405  !$omp parallel do collapse(2)
2406  do j = 1, ja
2407  do i = 1, ia
2408  do k = 1, ka
2409  one(k,i,j) = 1.0_rp
2410  end do
2411  end do
2412  end do
2413  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2414  qtrc(:,:,:,iq), filter_order, filter_niter, &
2415  limiter_sign = one(:,:,:) )
2416  call comm_vars8( qtrc(:,:,:,iq), 1 )
2417  call comm_wait ( qtrc(:,:,:,iq), 1, .false. )
2418  end if
2419  enddo
2420 
2421  call interp_interp3d( itp_nh_a, &
2422  ka_org, 1, ka_org, &
2423  ia_org, ja_org, &
2424  ka, ks, ke, &
2425  ia, ja, &
2426  igrd( :,:,:), & ! [IN]
2427  jgrd( :,:,:), & ! [IN]
2428  hfact( :,:,:), & ! [IN]
2429  kgrd(:,:,:,:,:), & ! [IN]
2430  vfact(:, :,:,:), & ! [IN]
2431  cz_org(:,:,:), & ! [IN]
2432  cz(:,:,:), & ! [IN]
2433  pres_org(:,:,:), & ! [IN]
2434  pres(:,:,:), & ! [OUT]
2435  logwgt = .true. ) ! [IN, optional]
2436 
2437  !$omp parallel do collapse(2)
2438  do j = 1, ja
2439  do i = 1, ia
2440  do k = 1, ka
2441  qc(k,i,j) = 0.0_rp
2442  end do
2443  end do
2444  end do
2445  if ( atmos_hydrometeor_dry ) then
2446  !$omp parallel do collapse(2)
2447  do j = 1, ja
2448  do i = 1, ia
2449  do k = 1, ka
2450  qv(k,i,j) = 0.0_rp
2451  end do
2452  end do
2453  end do
2454  else
2455  !$omp parallel do collapse(2)
2456  do j = 1, ja
2457  do i = 1, ia
2458  do k = 1, ka
2459  qv(k,i,j) = qtrc(k,i,j,i_qv)
2460  do iq = qls, qle
2461  qc(k,i,j) = qc(k,i,j) + qtrc(k,i,j,iq)
2462  enddo
2463  end do
2464  end do
2465  end do
2466  end if
2467 
2468 
2469  !$omp parallel do collapse(2)
2470  do j = 1, ja
2471  do i = 1, ia
2472  do k = ks, ke
2473  pres2(k,i,j) = pres(k,i,j)
2474  end do
2475  end do
2476  end do
2477 
2478  if ( use_file_density ) then
2479  call interp_interp3d( itp_nh_a, &
2480  ka_org, 1, ka_org, &
2481  ia_org, ja_org, &
2482  ka, ks, ke, &
2483  ia, ja, &
2484  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2485  hfact(:,:,:), & ! [IN]
2486  kgrd(:,:,:,:,:), & ! [IN]
2487  vfact(:,:,:,:), & ! [IN]
2488  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2489  dens_org(:,:,:), & ! [IN]
2490  dens(:,:,:), & ! [OUT]
2491  threshold_undef = 1.0_rp, & ! [IN]
2492  wsum = wsum(:,:,:), & ! [OUT]
2493  val2 = work(:,:,:) ) ! [OUT]
2494  call hydrostatic_buildrho_real( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2495  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2496  cz(:,:,:), & ! [IN]
2497  pres2(:,:,:), & ! [INOUT]
2498  dens2(:,:,:), temp(:,:,:) ) ! [OUT]
2499  !$omp parallel do collapse(2)
2500  do j = 1, ja
2501  do i = 1, ia
2502  do k = ks, ke
2503  if ( dens(k,i,j) == undef ) then
2504  dens(k,i,j) = dens2(k,i,j) * ( 1.0_rp - wsum(k,i,j) ) &
2505  + work(k,i,j) * wsum(k,i,j)
2506  end if
2507  end do
2508  end do
2509  end do
2510  else
2511  ! make density & pressure profile in moist condition
2512  call hydrostatic_buildrho_real( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2513  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2514  cz(:,:,:), & ! [IN]
2515  pres2(:,:,:), & ! [INOUT]
2516  dens(:,:,:), temp(:,:,:) ) ! [OUT]
2517  endif
2518 
2519  if ( filter_niter > 0 ) then
2520  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2521  dens(:,:,:), filter_order, filter_niter, &
2522  limiter_sign = one(:,:,:) )
2523  call comm_vars8( dens(:,:,:), 1 )
2524  call comm_wait ( dens(:,:,:), 1, .false. )
2525  end if
2526 
2527  !$omp parallel do collapse(2)
2528  do j = 1, ja
2529  do i = 1, ia
2530  do k = ks, ke
2531  if ( pres(k,i,j) == undef ) pres(k,i,j) = pres2(k,i,j)
2532  end do
2533  end do
2534  end do
2535 
2536 
2537  !$omp parallel do
2538  do j = 1, ja
2539  do i = 1, ia
2540  dens( 1:ks-1,i,j) = 0.0_rp
2541  dens(ke+1:ka ,i,j) = 0.0_rp
2542  enddo
2543  enddo
2544 
2545  !$omp parallel do collapse(2)
2546  do j = 1, ja
2547  do i = 1, ia
2548  do k = ks, ke-1
2549  momz(k,i,j) = velz(k,i,j) * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
2550  enddo
2551  enddo
2552  enddo
2553 
2554  !$omp parallel do
2555  do j = 1, ja
2556  do i = 1, ia-1
2557  do k = ks, ke
2558  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
2559  enddo
2560  enddo
2561  enddo
2562 
2563  i = ia
2564  !$omp parallel do
2565  do j = 1, ja
2566  do k = ks, ke
2567  momx(k,i,j) = velx(k,i,j) * dens(k,i,j)
2568  enddo
2569  enddo
2570 
2571  !$omp parallel do
2572  do j = 1, ja-1
2573  do i = 1, ia
2574  do k = ks, ke
2575  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
2576  enddo
2577  enddo
2578  enddo
2579 
2580  j = ja
2581  !$omp parallel do
2582  do i = 1, ia
2583  do k = ks, ke
2584  momy(k,i,j) = vely(k,i,j) * dens(k,i,j)
2585  enddo
2586  enddo
2587 
2588  !$omp parallel do collapse(2)
2589  do j = 1, ja
2590  do i = 1, ia
2591  do k = 1, ka
2592  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
2593  enddo
2594  enddo
2595  enddo
2596 
2597  !$omp parallel do
2598  do j = 1, ja
2599  do i = 1, ia
2600  momz( 1:ks-1,i,j) = 0.0_rp
2601  momz(ke :ka ,i,j) = 0.0_rp
2602  momx( 1:ks-1,i,j) = 0.0_rp
2603  momx(ke+1:ka ,i,j) = 0.0_rp
2604  momy( 1:ks-1,i,j) = 0.0_rp
2605  momy(ke+1:ka ,i,j) = 0.0_rp
2606  enddo
2607  enddo
2608 
2609  call comm_vars8( momz(:,:,:), 1 )
2610  call comm_vars8( momx(:,:,:), 2 )
2611  call comm_vars8( momy(:,:,:), 3 )
2612  call comm_wait ( momz(:,:,:), 1, .false. )
2613  call comm_wait ( momx(:,:,:), 2, .false. )
2614  call comm_wait ( momy(:,:,:), 3, .false. )
2615 
2616  first_atmos = .false.
2617 
2618  call prof_rapend ('___AtmosInterp',3)
2619 
2620  return
2621  end subroutine parentatmosinput
2622 
2623  !-----------------------------------------------------------------------------
2625  subroutine boundaryatmossetup( &
2626  basename, &
2627  title, &
2628  datatype, &
2629  timeintv, &
2630  qtrc_flag, &
2631  fid, &
2632  vid )
2633  use scale_file_cartesc, only: &
2634  file_cartesc_create, &
2635  file_cartesc_def_var, &
2636  file_cartesc_enddef
2637  use scale_time, only: &
2638  nowdate => time_nowdate
2639  use mod_atmos_phy_mp_vars, only: &
2640  qs_mp, &
2641  qe_mp
2642  implicit none
2643 
2644  character(len=*), intent(in) :: basename
2645  character(len=*), intent(in) :: title
2646  character(len=*), intent(in) :: datatype
2647  real(dp), intent(in) :: timeintv
2648  logical, intent(in) :: qtrc_flag(qa)
2649  integer, intent(out) :: fid
2650  integer, intent(out) :: vid(5+qa)
2651 
2652  integer :: iq
2653  !---------------------------------------------------------------------------
2654 
2655  call file_cartesc_create( basename, title, datatype, fid, date=nowdate )
2656 
2657  call file_cartesc_def_var( fid, &
2658  'DENS', 'Reference Density', 'kg/m3', 'ZXYT', datatype, & ! [IN]
2659  vid(1), & ! [OUT]
2660  timeintv=timeintv ) ! [IN]
2661  call file_cartesc_def_var( fid, &
2662  'VELZ', 'Reference VELZ', 'm/s', 'ZHXYT', datatype, & ! [IN]
2663  vid(2), & ! [OUT]
2664  timeintv=timeintv ) ! [IN]
2665  call file_cartesc_def_var( fid, &
2666  'VELX', 'Reference VELX', 'm/s', 'ZXHYT', datatype, & ! [IN]
2667  vid(3), & ! [OUT]
2668  timeintv=timeintv ) ! [IN]
2669  call file_cartesc_def_var( fid, &
2670  'VELY', 'Reference VELY', 'm/s', 'ZXYHT', datatype, & ! [IN]
2671  vid(4), & ! [OUT]
2672  timeintv=timeintv ) ! [IN]
2673  call file_cartesc_def_var( fid, &
2674  'PT', 'Reference PT', 'K', 'ZXYT', datatype, & ! [IN]
2675  vid(5), & ! [OUT]
2676  timeintv=timeintv ) ! [IN]
2677 
2678  do iq = qs_mp, qe_mp
2679  call file_cartesc_def_var( fid, & ! [IN]
2680  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
2681  'ZXYT', datatype, & ! [IN]
2682  vid(5+iq), & ! [OUT]
2683  timeintv = timeintv ) ! [IN]
2684  enddo
2685 
2686  do iq = 1, qa
2687  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
2688  if ( .not. qtrc_flag(iq) ) cycle
2689  call file_cartesc_def_var( fid, & ! [IN]
2690  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
2691  'ZXYT', datatype, & ! [IN]
2692  vid(5+iq), & ! [OUT]
2693  timeintv = timeintv ) ! [IN]
2694  enddo
2695 
2696  call file_cartesc_enddef( fid )
2697 
2698  return
2699  end subroutine boundaryatmossetup
2700 
2701  !-----------------------------------------------------------------------------
2703  subroutine boundaryatmosoutput( &
2704  DENS, &
2705  VELZ, &
2706  VELX, &
2707  VELY, &
2708  POTT, &
2709  QTRC, &
2710  qtrc_flag, &
2711  fid, vid, &
2712  timeintv, &
2713  istep )
2714  use scale_file_cartesc, only: &
2715  file_cartesc_write_var
2716  use mod_atmos_phy_mp_vars, only: &
2717  qs_mp, &
2718  qe_mp
2719  implicit none
2720 
2721  real(rp), intent(in) :: dens(ka,ia,ja)
2722  real(rp), intent(in) :: velz(ka,ia,ja)
2723  real(rp), intent(in) :: velx(ka,ia,ja)
2724  real(rp), intent(in) :: vely(ka,ia,ja)
2725  real(rp), intent(in) :: pott(ka,ia,ja)
2726  real(rp), intent(in) :: qtrc(ka,ia,ja,qa)
2727  logical, intent(in) :: qtrc_flag(qa)
2728  integer, intent(in) :: fid
2729  integer, intent(in) :: vid(5+qa)
2730  real(dp), intent(in) :: timeintv
2731  integer, intent(in) :: istep
2732 
2733  real(rp) :: work(ka,ia,ja,1)
2734 
2735  real(dp) :: timeofs
2736  integer :: iq
2737  !---------------------------------------------------------------------------
2738 
2739  call prof_rapstart('___AtmosOutput',3)
2740 
2741  timeofs = real(istep-1,kind=dp) * timeintv
2742 
2743 !OCL XFILL
2744  work(:,:,:,1) = dens(:,:,:)
2745  call file_cartesc_write_var( fid, vid(1), work(:,:,:,:), 'DENS', 'ZXYT', timeintv, timeofs=timeofs )
2746 !OCL XFILL
2747  work(:,:,:,1) = velz(:,:,:)
2748  call file_cartesc_write_var( fid, vid(2), work(:,:,:,:), 'VELZ', 'ZHXYT', timeintv, timeofs=timeofs )
2749 !OCL XFILL
2750  work(:,:,:,1) = velx(:,:,:)
2751  call file_cartesc_write_var( fid, vid(3), work(:,:,:,:), 'VELX', 'ZXHYT', timeintv, timeofs=timeofs )
2752 !OCL XFILL
2753  work(:,:,:,1) = vely(:,:,:)
2754  call file_cartesc_write_var( fid, vid(4), work(:,:,:,:), 'VELY', 'ZXYHT', timeintv, timeofs=timeofs )
2755 !OCL XFILL
2756  work(:,:,:,1) = pott(:,:,:)
2757  call file_cartesc_write_var( fid, vid(5), work(:,:,:,:), 'PT', 'ZXYT', timeintv, timeofs=timeofs )
2758 
2759  do iq = qs_mp, qe_mp
2760  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
2761  'ZXYT', timeintv, timeofs=timeofs )
2762  enddo
2763 
2764  do iq = 1, qa
2765  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
2766  if ( .not. qtrc_flag(iq) ) cycle
2767  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
2768  'ZXYT', timeintv, timeofs=timeofs )
2769  enddo
2770 
2771  call prof_rapend ('___AtmosOutput',3)
2772 
2773  return
2774  end subroutine boundaryatmosoutput
2775 
2776  !-----------------------------------------------------------------------------
2778  subroutine parentsurfacesetup( &
2779  ldims, odims, &
2780  lmdlid, omdlid, &
2781  timelen_land, &
2782  timelen_ocean, &
2783  basename_org_land, &
2784  basename_org_ocean, &
2785  basename_land, &
2786  basename_ocean, &
2787  filetype_land, &
2788  filetype_ocean, &
2789  use_file_landwater, &
2790  intrp_iter_max, &
2791  intrp_land_temp, &
2792  intrp_land_water, &
2793  intrp_land_sfc_temp, &
2794  intrp_ocean_temp, &
2795  intrp_ocean_sfc_temp )
2796  use scale_comm_cartesc, only: &
2797  comm_world, &
2798  comm_datatype
2799  use scale_atmos_grid_cartesc_real, only: &
2800  atmos_grid_cartesc_real_lon, &
2801  atmos_grid_cartesc_real_lat
2802  use mod_realinput_netcdf, only: &
2803  parentlandsetupnetcdf, &
2804  parentoceansetupnetcdf
2805  use mod_realinput_grads, only: &
2806  parentlandsetupgrads, &
2807  parentoceansetupgrads
2808  implicit none
2809 
2810  integer, intent(out) :: ldims(3) ! dims for land
2811  integer, intent(out) :: odims(2) ! dims for ocean
2812  integer, intent(out) :: lmdlid ! model id for land
2813  integer, intent(out) :: omdlid ! model id for ocean
2814  integer, intent(out) :: timelen_land ! number of time steps in land file
2815  integer, intent(out) :: timelen_ocean ! number of time steps in ocean file
2816 
2817  character(len=*), intent(in) :: basename_org_land
2818  character(len=*), intent(in) :: basename_org_ocean
2819  character(len=*), intent(in) :: basename_land
2820  character(len=*), intent(in) :: basename_ocean
2821  character(len=*), intent(in) :: filetype_land
2822  character(len=*), intent(in) :: filetype_ocean
2823  logical, intent(in) :: use_file_landwater ! use land water data from files
2824  integer, intent(in) :: intrp_iter_max
2825  character(len=*), intent(in) :: intrp_land_temp
2826  character(len=*), intent(in) :: intrp_land_water
2827  character(len=*), intent(in) :: intrp_land_sfc_temp
2828  character(len=*), intent(in) :: intrp_ocean_temp
2829  character(len=*), intent(in) :: intrp_ocean_sfc_temp
2830 
2831  real(rp), allocatable :: lon_all(:,:)
2832  real(rp), allocatable :: lat_all(:,:)
2833 
2834  real(rp) :: lon_min, lon_max
2835  real(rp) :: lat_min, lat_max
2836 
2837  integer :: ierr
2838  integer :: i, j
2839  !---------------------------------------------------------------------------
2840 
2841  log_newline
2842  log_info("ParentSurfaceSetup",*) 'Setup'
2843 
2844  ! Land
2845 
2846  if( lkmax < 4 )then
2847  log_error("ParentSurfaceSetup",*) 'LKMAX less than 4: ', lkmax
2848  log_error_cont(*) 'in Real Case, LKMAX should be set more than 4'
2849  call prc_abort
2850  endif
2851 
2852  log_info("ParentSurfaceSetup",*) 'Horizontal Interpolation Level: ', comm_cartesc_nest_interp_level
2853 
2854 
2855  if( serial_land .and. .not. prc_ismaster ) then
2856  do_read_land = .false.
2857  else
2858  do_read_land = .true.
2859  endif
2860 
2861  select case(filetype_land)
2862  case('NetCDF')
2863 
2864  lmdlid = inetcdf
2865  call parentlandsetupnetcdf( ldims, & ! (out)
2866  timelen_land, & ! (out)
2867  lon_all, lat_all, & ! (out)
2868  basename_org_land, & ! (in)
2869  basename_land, & ! (in)
2870  use_file_landwater, & ! (in)
2871  serial_land, & ! (inout)
2872  do_read_land ) ! (inout)
2873 
2874  case('GrADS')
2875 
2876  lmdlid = igrads
2877  if ( do_read_land ) call parentlandsetupgrads( ldims, & ! (out)
2878  timelen_land, & ! (out)
2879  lon_all, lat_all, & ! (out)
2880  basename_org_land, & ! (in)
2881  basename_land ) ! (in)
2882 
2883  case default
2884 
2885  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_land)
2886  call prc_abort
2887 
2888  endselect
2889 
2890  lon_min = minval( atmos_grid_cartesc_real_lon(:,:) )
2891  lon_max = maxval( atmos_grid_cartesc_real_lon(:,:) )
2892  lat_min = minval( atmos_grid_cartesc_real_lat(:,:) )
2893  lat_max = maxval( atmos_grid_cartesc_real_lat(:,:) )
2894 
2895  if ( serial_land ) then
2896  call comm_bcast( 3, ldims(:) )
2897  call comm_bcast( timelen_land )
2898 
2899  if ( .not. do_read_land ) then
2900  allocate( lon_all(ldims(2), ldims(3)) )
2901  allocate( lat_all(ldims(2), ldims(3)) )
2902  end if
2903  call comm_bcast( ldims(2), ldims(3), lon_all )
2904  call comm_bcast( ldims(2), ldims(3), lat_all )
2905 
2906  call mpi_allreduce( mpi_in_place, lon_min, 1, comm_datatype, mpi_min, comm_world, ierr )
2907  call mpi_allreduce( mpi_in_place, lon_max, 1, comm_datatype, mpi_max, comm_world, ierr )
2908  call mpi_allreduce( mpi_in_place, lat_min, 1, comm_datatype, mpi_min, comm_world, ierr )
2909  call mpi_allreduce( mpi_in_place, lat_max, 1, comm_datatype, mpi_max, comm_world, ierr )
2910  endif
2911 
2912  call get_ijrange( lis_org, lie_org, ljs_org, lje_org, & ! [OUT]
2913  ldims(2), ldims(3), & ! [IN]
2914  lon_min, lon_max, lat_min, lat_max, & ! [IN]
2915  lon_all, lat_all ) ! [IN]
2916  lis_org = max( lis_org - intrp_iter_max, 1 )
2917  lie_org = min( lie_org + intrp_iter_max, ldims(2) )
2918  ljs_org = max( ljs_org - intrp_iter_max, 1 )
2919  lje_org = min( lje_org + intrp_iter_max, ldims(3) )
2920 
2921  lks_org = 1
2922  lke_org = ldims(1)
2923  lka_org = lke_org - lks_org + 1
2924  lia_org = lie_org - lis_org + 1
2925  lja_org = lje_org - ljs_org + 1
2926 
2927  allocate( llon_org(lia_org, lja_org) )
2928  allocate( llat_org(lia_org, lja_org) )
2929 
2930  !$omp parallel do
2931  do j = 1, lja_org
2932  do i = 1, lia_org
2933  llon_org(i,j) = lon_all(i-1+lis_org,j-1+ljs_org)
2934  llat_org(i,j) = lat_all(i-1+lis_org,j-1+ljs_org)
2935  end do
2936  end do
2937 
2938  deallocate( lon_all )
2939  deallocate( lat_all )
2940 
2941 
2942  select case( intrp_land_temp )
2943  case( 'off' )
2944  i_intrp_land_temp = i_intrp_off
2945  case( 'mask' )
2946  i_intrp_land_temp = i_intrp_mask
2947  case( 'fill' )
2948  i_intrp_land_temp = i_intrp_fill
2949  case default
2950  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_TEMP is invalid. ', intrp_land_temp
2951  call prc_abort
2952  end select
2953  select case( intrp_land_sfc_temp )
2954  case( 'off' )
2955  i_intrp_land_sfc_temp = i_intrp_off
2956  case( 'mask' )
2957  i_intrp_land_sfc_temp = i_intrp_mask
2958  case( 'fill' )
2959  i_intrp_land_sfc_temp = i_intrp_fill
2960  case default
2961  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_SFC_TEMP is invalid. ', intrp_land_sfc_temp
2962  call prc_abort
2963  end select
2964  select case( intrp_land_water )
2965  case( 'off' )
2966  i_intrp_land_water = i_intrp_off
2967  case( 'mask' )
2968  i_intrp_land_water = i_intrp_mask
2969  case( 'fill' )
2970  i_intrp_land_water = i_intrp_fill
2971  case default
2972  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_WATER is invalid. ', intrp_land_water
2973  call prc_abort
2974  end select
2975 
2976  select case( lmdlid )
2977  case( inetcdf )
2978  i_intrp_land_temp = i_intrp_mask
2979  i_intrp_land_sfc_temp = i_intrp_mask
2980  i_intrp_land_water = i_intrp_mask
2981  end select
2982 
2983 
2984  ! Ocean
2985 
2986  if( serial_ocean .and. .not. prc_ismaster ) then
2987  do_read_ocean = .false.
2988  else
2989  do_read_ocean = .true.
2990  endif
2991 
2992  select case(filetype_ocean)
2993  case('NetCDF')
2994 
2995  omdlid = inetcdf
2996  call parentoceansetupnetcdf( odims, timelen_ocean, & ! (out)
2997  lon_all, lat_all, & ! (out)
2998  basename_org_ocean, & ! (in)
2999  basename_ocean, & ! (in)
3000  serial_ocean, & ! (inout)
3001  do_read_ocean ) ! (inout)
3002 
3003  case('GrADS')
3004 
3005  omdlid = igrads
3006  if ( do_read_ocean ) call parentoceansetupgrads( odims, timelen_ocean, & ! (out)
3007  lon_all, lat_all, & ! (out)
3008  basename_org_ocean, & ! (in)
3009  basename_ocean ) ! (in)
3010  case default
3011 
3012  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_ocean)
3013  call prc_abort
3014 
3015  endselect
3016 
3017  lon_min = minval( atmos_grid_cartesc_real_lon(:,:) )
3018  lon_max = maxval( atmos_grid_cartesc_real_lon(:,:) )
3019  lat_min = minval( atmos_grid_cartesc_real_lat(:,:) )
3020  lat_max = maxval( atmos_grid_cartesc_real_lat(:,:) )
3021 
3022  if ( serial_ocean ) then
3023  call comm_bcast( 2, odims(:) )
3024  call comm_bcast( timelen_ocean )
3025 
3026  if ( .not. do_read_ocean ) then
3027  allocate( lon_all(odims(1), odims(2)) )
3028  allocate( lat_all(odims(1), odims(2)) )
3029  end if
3030  call comm_bcast( odims(1), odims(2), lon_all )
3031  call comm_bcast( odims(1), odims(2), lat_all )
3032 
3033  call mpi_allreduce( mpi_in_place, lon_min, 1, comm_datatype, mpi_min, comm_world, ierr )
3034  call mpi_allreduce( mpi_in_place, lon_max, 1, comm_datatype, mpi_max, comm_world, ierr )
3035  call mpi_allreduce( mpi_in_place, lat_min, 1, comm_datatype, mpi_min, comm_world, ierr )
3036  call mpi_allreduce( mpi_in_place, lat_max, 1, comm_datatype, mpi_max, comm_world, ierr )
3037  endif
3038 
3039  call get_ijrange( ois_org, oie_org, ojs_org, oje_org, & ! [OUT]
3040  odims(1), odims(2), & ! [IN]
3041  lon_min, lon_max, lat_min, lat_max, & ! [IN]
3042  lon_all, lat_all ) ! [IN]
3043  ois_org = max( ois_org - intrp_iter_max, 1 )
3044  oie_org = min( oie_org + intrp_iter_max, odims(1) )
3045  ojs_org = max( ojs_org - intrp_iter_max, 1 )
3046  oje_org = min( oje_org + intrp_iter_max, odims(2) )
3047 
3048  oia_org = oie_org - ois_org + 1
3049  oja_org = oje_org - ojs_org + 1
3050 
3051  allocate( olon_org(oia_org, oja_org) )
3052  allocate( olat_org(oia_org, oja_org) )
3053 
3054  !$omp parallel do
3055  do j = 1, oja_org
3056  do i = 1, oia_org
3057  olon_org(i,j) = lon_all(i-1+ois_org,j-1+ojs_org)
3058  olat_org(i,j) = lat_all(i-1+ois_org,j-1+ojs_org)
3059  end do
3060  end do
3061 
3062  deallocate( lon_all )
3063  deallocate( lat_all )
3064 
3065  select case( intrp_ocean_temp )
3066  case( 'off' )
3067  i_intrp_ocean_temp = i_intrp_off
3068  case( 'mask' )
3069  i_intrp_ocean_temp = i_intrp_mask
3070  case( 'fill' )
3071  i_intrp_ocean_temp = i_intrp_fill
3072  case default
3073  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_TEMP is invalid. ', intrp_ocean_temp
3074  call prc_abort
3075  end select
3076  select case( intrp_ocean_sfc_temp )
3077  case( 'off' )
3078  i_intrp_ocean_sfc_temp = i_intrp_off
3079  case( 'mask' )
3080  i_intrp_ocean_sfc_temp = i_intrp_mask
3081  case( 'fill' )
3082  i_intrp_ocean_sfc_temp = i_intrp_fill
3083  case default
3084  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_SFC_TEMP is invalid. ', intrp_ocean_sfc_temp
3085  call prc_abort
3086  end select
3087 
3088  select case( omdlid )
3089  case( inetcdf )
3090  i_intrp_ocean_temp = i_intrp_mask
3091  i_intrp_ocean_sfc_temp = i_intrp_mask
3092  end select
3093 
3094 
3095  allocate( oigrd( ia, ja, itp_nh_a) )
3096  allocate( ojgrd( ia, ja, itp_nh_a) )
3097  allocate( ohfact( ia, ja, itp_nh_a) )
3098 
3099  allocate( hfact_ol(oia_org, oja_org, itp_nh_ol) )
3100  allocate( igrd_ol(oia_org, oja_org, itp_nh_ol) )
3101  allocate( jgrd_ol(oia_org, oja_org, itp_nh_ol) )
3102 
3103  return
3104  end subroutine parentsurfacesetup
3105 
3106  !-----------------------------------------------------------------------------
3108  subroutine parentsurfaceopen( &
3109  filetype_land, filetype_ocean, &
3110  basename_org_land, basename_org_ocean, &
3111  basename_land, basename_ocean )
3112  use mod_realinput_netcdf, only: &
3113  parentlandopennetcdf, &
3114  parentoceanopennetcdf
3115  implicit none
3116  character(len=*), intent(in) :: filetype_land
3117  character(len=*), intent(in) :: filetype_ocean
3118  character(len=*), intent(in) :: basename_org_land
3119  character(len=*), intent(in) :: basename_org_ocean
3120  character(len=*), intent(in) :: basename_land
3121  character(len=*), intent(in) :: basename_ocean
3122 
3123  select case ( filetype_land )
3124  case ( "NetCDF" )
3125  call parentlandopennetcdf( basename_org_land, basename_land )
3126  case ( "GrADS" )
3127  ! do nothing
3128  end select
3129 
3130  select case ( filetype_ocean )
3131  case ( "NetCDF" )
3132  call parentoceanopennetcdf( basename_org_ocean, basename_land )
3133  case ( "GrADS" )
3134  ! do nothing
3135  end select
3136 
3137  return
3138  end subroutine parentsurfaceopen
3139  !-----------------------------------------------------------------------------
3141  subroutine parentsurfacefinalize( &
3142  filetype_land, &
3143  filetype_ocean )
3144  use mod_realinput_netcdf, only: &
3145  parentlandfinalizenetcdf, &
3146  parentoceanfinalizenetcdf
3147  implicit none
3148 
3149  character(len=*), intent(in) :: filetype_land
3150  character(len=*), intent(in) :: filetype_ocean
3151  !---------------------------------------------------------------------------
3152 
3153  log_newline
3154  log_info("ParentSurfaceFinalize",*) 'Finalize'
3155 
3156  ! Land
3157 
3158  if( serial_land ) then
3159  if( prc_ismaster ) then
3160  do_read_land = .true.
3161  else
3162  do_read_land = .false.
3163  endif
3164  else
3165  do_read_land = .true.
3166  endif
3167 
3168  select case(trim(filetype_land))
3169  case('NetCDF')
3170 
3171  if ( do_read_ocean ) then
3172  call parentlandfinalizenetcdf
3173  end if
3174 
3175  case('GrADS')
3176 
3177  ! do nothing
3178 
3179  case default
3180 
3181  log_error("ParentSurfaceFinalize",*) 'Unsupported FILE TYPE:', trim(filetype_land)
3182  call prc_abort
3183 
3184  endselect
3185 
3186 
3187  ! Ocean
3188 
3189  if( serial_ocean ) then
3190  if( prc_ismaster ) then
3191  do_read_ocean = .true.
3192  else
3193  do_read_ocean = .false.
3194  endif
3195  else
3196  do_read_ocean = .true.
3197  endif
3198 
3199  select case(trim(filetype_ocean))
3200  case('NetCDF')
3201 
3202  if ( do_read_ocean ) then
3203  call parentoceanfinalizenetcdf
3204  end if
3205 
3206  case('GrADS')
3207 
3208  ! do nothing
3209 
3210  case default
3211 
3212  log_error("ParentSurfaceFinalize",*) 'Unsupported FILE TYPE:', trim(filetype_ocean)
3213  call prc_abort
3214 
3215  endselect
3216 
3217 
3218  deallocate( llon_org )
3219  deallocate( llat_org )
3220 
3221  deallocate( olon_org )
3222  deallocate( olat_org )
3223 
3224  deallocate( oigrd )
3225  deallocate( ojgrd )
3226  deallocate( ohfact )
3227 
3228  deallocate( hfact_ol )
3229  deallocate( igrd_ol )
3230  deallocate( jgrd_ol )
3231 
3232  first_surface = .true.
3233 
3234  return
3235  end subroutine parentsurfacefinalize
3236 
3237  !-----------------------------------------------------------------------------
3239  subroutine boundarysurfacesetup( &
3240  basename, &
3241  title, &
3242  timeintv, &
3243  multi_ocean, &
3244  multi_land, &
3245  fid, &
3246  vid )
3247  use scale_file_cartesc, only: &
3248  file_cartesc_create, &
3249  file_cartesc_def_var, &
3250  file_cartesc_enddef
3251  use scale_time, only: &
3252  nowdate => time_nowdate
3253  implicit none
3254  character(len=*), intent(in) :: basename
3255  character(len=*), intent(in) :: title
3256  real(dp), intent(in) :: timeintv
3257  logical, intent(in) :: multi_ocean
3258  logical, intent(in) :: multi_land
3259  integer, intent(out) :: fid
3260  integer, intent(out) :: vid(10)
3261 
3262  character(len=H_SHORT) :: boundary_out_dtype = 'DEFAULT'
3263  !---------------------------------------------------------------------------
3264 
3265  call file_cartesc_create( basename, title, boundary_out_dtype, fid, date=nowdate )
3266 
3267  if ( multi_land ) then
3268  call file_cartesc_def_var( fid, & ! [IN]
3269  'LAND_TEMP', 'Reference Land Temperature', 'K', & ! [IN]
3270  'LXYT', boundary_out_dtype, & ! [IN]
3271  vid(1), & ! [OUT]
3272  timeintv=timeintv ) ! [IN]
3273  call file_cartesc_def_var( fid, & ! [IN]
3274  'LAND_WATER', 'Reference Land Moisture', 'm3/m3', & ! [IN]
3275  'LXYT', boundary_out_dtype, & ! [IN]
3276  vid(2), & ! [OUT]
3277  timeintv=timeintv ) ! [IN]
3278  call file_cartesc_def_var( fid, & ! [IN]
3279  'LAND_SFC_TEMP', 'Reference Land Surface Temperature', 'K', & ! [IN]
3280  'XYT', boundary_out_dtype, & ! [IN]
3281  vid(3), & ! [OUT]
3282  timeintv=timeintv ) ! [IN]
3283  end if
3284 
3285  if ( multi_ocean ) then
3286  call file_cartesc_def_var( fid, & ! [IN]
3287  'OCEAN_TEMP', 'Reference Ocean Temperature', 'K', & ! [IN]
3288  'OXYT', boundary_out_dtype, & ! [IN]
3289  vid(6), & ! [OUT]
3290  timeintv=timeintv ) ! [IN]
3291  call file_cartesc_def_var( fid, & ! [IN]
3292  'OCEAN_SFC_TEMP', 'Reference Ocean Surface Temperature', 'K', & ! [IN]
3293  'XYT', boundary_out_dtype, & ! [IN]
3294  vid(7), & ! [OUT]
3295  timeintv=timeintv ) ! [IN]
3296  call file_cartesc_def_var( fid, & ! [IN]
3297  'OCEAN_SFC_Z0', 'Reference Ocean Surface Z0', 'm', & ! [IN]
3298  'XYT', boundary_out_dtype, & ! [IN]
3299  vid(10), & ! [OUT]
3300  timeintv=timeintv ) ! [IN]
3301  end if
3302 
3303  call file_cartesc_enddef( fid )
3304 
3305  return
3306  end subroutine boundarysurfacesetup
3307 
3308  !-----------------------------------------------------------------------------
3310  subroutine parentsurfaceinput( &
3311  tg, strg, lst, albg, &
3312  tc_urb, qc_urb, uc_urb, ust, albu, &
3313  lst_ocean, &
3314  lz_org, topo_org, &
3315  lmask_org, omask_org, &
3316  tw, sst, albw, z0w, &
3317  basename_land, basename_ocean, &
3318  mdlid_land, mdlid_ocean, &
3319  ldims, odims, &
3320  use_file_landwater, &
3321  init_landwater_ratio, &
3322 ! init_landwater_ratio_each, &
3323  init_ocean_alb_lw, &
3324  init_ocean_alb_sw, &
3325  init_ocean_z0w, &
3326  intrp_iter_max, &
3327  soilwater_ds2vc_flag, &
3328  elevation_correction_land, &
3329  elevation_correction_ocean, &
3330  oistep, listep, &
3331  multi_land, &
3332  URBAN_do, &
3333  DENS, MOMX, MOMY, RHOT, QTRC )
3334  use scale_comm_cartesc, only: &
3335  comm_bcast, &
3336  comm_vars8, &
3337  comm_wait
3338  use scale_const, only: &
3339  undef => const_undef, &
3340  eps => const_eps, &
3341  laps => const_laps
3342  use scale_topography, only: &
3343  topography_zsfc
3344  use scale_interp, only: &
3345  interp_factor2d, &
3346  interp_interp2d
3347  use scale_atmos_grid_cartesc, only: &
3348  cx => atmos_grid_cartesc_cx, &
3349  cy => atmos_grid_cartesc_cy
3350  use scale_land_grid_cartesc, only: &
3351  lcz => land_grid_cartesc_cz
3352  use scale_landuse, only: &
3353  lsmask_nest => landuse_frac_land, &
3354  landuse_pft_nmax
3355  use mod_realinput_netcdf, only: &
3356  parentoceaninputnetcdf, &
3357  parentlandinputnetcdf
3358  use mod_realinput_grads, only: &
3359  parentoceaninputgrads, &
3360  parentlandinputgrads
3361  implicit none
3362 
3363  real(rp), intent(inout) :: tg (lka,ia,ja)
3364  real(rp), intent(inout) :: strg(lka,ia,ja)
3365  real(rp), intent(inout) :: lst (ia,ja)
3366  real(rp), intent(inout) :: albg(ia,ja,n_rad_dir,n_rad_rgn)
3367  real(rp), intent(inout) :: tc_urb(ia,ja)
3368  real(rp), intent(inout) :: qc_urb(ia,ja)
3369  real(rp), intent(inout) :: uc_urb(ia,ja)
3370  real(rp), intent(inout) :: ust (ia,ja)
3371  real(rp), intent(inout) :: albu (ia,ja,n_rad_dir,n_rad_rgn)
3372  real(rp), intent(inout) :: lst_ocean(oia_org,oja_org)
3373  real(rp), intent(inout) :: tw (ia,ja)
3374  real(rp), intent(inout) :: lz_org(lka_org)
3375  real(rp), intent(inout) :: topo_org(lia_org,lja_org)
3376  real(rp), intent(inout) :: lmask_org(lia_org,lja_org)
3377  real(rp), intent(inout) :: omask_org(oia_org,oja_org)
3378  real(rp), intent(out) :: sst (ia,ja)
3379  real(rp), intent(out) :: albw(ia,ja,n_rad_dir,n_rad_rgn)
3380  real(rp), intent(out) :: z0w (ia,ja)
3381  character(len=*), intent(in) :: basename_land
3382  character(len=*), intent(in) :: basename_ocean
3383  integer, intent(in) :: mdlid_land
3384  integer, intent(in) :: mdlid_ocean
3385  integer, intent(in) :: ldims(3)
3386  integer, intent(in) :: odims(2)
3387  logical, intent(in) :: use_file_landwater ! use land water data from files
3388  real(rp), intent(in) :: init_landwater_ratio ! Ratio of land water to storage is constant,
3389 ! real(RP), intent(in) :: init_landwater_ratio_each(LANDUSE_PFT_nmax) ! Ratio of land water to storage is constant,
3390  ! if use_file_landwater is ".false." (each PFT)
3391  real(rp), intent(in) :: init_ocean_alb_lw
3392  real(rp), intent(in) :: init_ocean_alb_sw
3393  real(rp), intent(in) :: init_ocean_z0w
3394  integer, intent(in) :: intrp_iter_max
3395  logical, intent(in) :: soilwater_ds2vc_flag
3396  logical, intent(in) :: elevation_correction_land
3397  logical, intent(in) :: elevation_correction_ocean
3398  integer, intent(in) :: oistep
3399  integer, intent(in) :: listep
3400  logical, intent(in) :: multi_land
3401  logical, intent(in) :: urban_do
3402 
3403  real(rp), intent(in) :: dens(ka,ia,ja)
3404  real(rp), intent(in) :: momx(ka,ia,ja)
3405  real(rp), intent(in) :: momy(ka,ia,ja)
3406  real(rp), intent(in) :: rhot(ka,ia,ja)
3407  real(rp), intent(in) :: qtrc(ka,ia,ja,qa)
3408 
3409  ! land
3410  real(rp) :: tg_org (lka_org,lia_org,lja_org)
3411  real(rp) :: strg_org (lka_org,lia_org,lja_org)
3412  real(rp) :: smds_org (lka_org,lia_org,lja_org)
3413  real(rp) :: lst_org ( lia_org,lja_org)
3414  real(rp) :: ust_org ( lia_org,lja_org)
3415  real(rp) :: albg_org ( lia_org,lja_org,n_rad_dir,n_rad_rgn)
3416 
3417  ! ocean
3418  real(rp) :: tw_org (oia_org,oja_org)
3419  real(rp) :: sst_org (oia_org,oja_org)
3420  real(rp) :: z0w_org (oia_org,oja_org)
3421  real(rp) :: albw_org (oia_org,oja_org,n_rad_dir,n_rad_rgn)
3422  real(rp) :: omask (oia_org,oja_org)
3423 
3424  ! elevation correction
3425  real(rp) :: work(lia_org,lja_org)
3426 
3427  integer :: i, j
3428  !---------------------------------------------------------------------------
3429 
3430  call prof_rapstart('___SurfaceInput',3)
3431 
3432  if ( do_read_land .and. ( first_surface .or. multi_land ) ) then
3433 
3434  select case( mdlid_land )
3435  case( inetcdf ) ! TYPE: NetCDF
3436 
3437  call parentlandinputnetcdf( &
3438  lka_org, lks_org, lke_org, &
3439  lia_org, lis_org, lie_org, &
3440  lja_org, ljs_org, lje_org, &
3441  tg_org, strg_org, & ! (out)
3442  lst_org, ust_org, albg_org, & ! (out)
3443  topo_org, lmask_org, & ! (inout)
3444  lz_org, & ! (inout)
3445  use_file_landwater, & ! (in)
3446  ldims, & ! (in)
3447  listep ) ! (in)
3448 
3449  case( igrads ) ! TYPE: GrADS format
3450 
3451  call parentlandinputgrads( &
3452  lka_org, lks_org, lke_org, &
3453  lia_org, lis_org, lie_org, &
3454  lja_org, ljs_org, lje_org, &
3455  tg_org, strg_org, smds_org, & ! (out)
3456  lst_org, & ! (out)
3457  lz_org, & ! (out)
3458  topo_org, lmask_org, & ! (out)
3459  use_waterratio, & ! (out)
3460  ldims, & ! (in)
3461  basename_land, & ! (in)
3462  use_file_landwater, & ! (in)
3463  listep ) ! (in)
3464  ust_org = undef
3465  albg_org = undef
3466 
3467  end select
3468 
3469  end if
3470 
3471  call prof_rapend ('___SurfaceInput',3)
3472 
3473  call prof_rapstart('___SurfaceBcast',3)
3474 
3475  if ( serial_land .and. ( first_surface .or. multi_land ) ) then
3476  call comm_bcast( lka_org, lia_org, lja_org, tg_org )
3477  if ( use_waterratio ) then
3478  call comm_bcast( lka_org, lia_org, lja_org, smds_org )
3479  else
3480  call comm_bcast( lka_org, lia_org, lja_org, strg_org )
3481  end if
3482  call comm_bcast( lia_org, lja_org, lst_org )
3483  if ( urban_do ) call comm_bcast( lia_org, lja_org, ust_org )
3484  call comm_bcast( lia_org, lja_org, n_rad_dir, n_rad_rgn, albg_org(:,:,:,:) )
3485  call comm_bcast( lia_org, lja_org, topo_org )
3486  call comm_bcast( lia_org, lja_org, lmask_org )
3487  call comm_bcast( lka_org, lz_org )
3488  end if
3489 
3490  call prof_rapend ('___SurfaceBcast',3)
3491 
3492  call prof_rapstart('___SurfaceInput',3)
3493 
3494  if ( do_read_ocean ) then
3495 
3496  select case( mdlid_ocean )
3497  case( inetcdf ) ! TYPE: NetCDF
3498 
3499  call parentoceaninputnetcdf( &
3500  oia_org, ois_org, oie_org, &
3501  oja_org, ojs_org, oje_org, &
3502  tw_org, sst_org, & ! (out)
3503  albw_org, z0w_org, & ! (out)
3504  omask_org, & ! (inout)
3505  odims, & ! (in)
3506  oistep ) ! (in)
3507 
3508  case( igrads ) ! TYPE: GrADS format
3509 
3510  call parentoceaninputgrads( &
3511  oia_org, ois_org, oie_org, &
3512  oja_org, ojs_org, oje_org, &
3513  tw_org, sst_org, & ! (out)
3514  omask_org, & ! (out)
3515  basename_ocean, odims, & ! (in)
3516  oistep ) ! (in)
3517  albw_org = undef
3518  z0w_org = undef
3519 
3520  end select
3521 
3522  end if
3523 
3524  call prof_rapend ('___SurfaceInput',3)
3525 
3526  call prof_rapstart('___SurfaceBcast',3)
3527 
3528  if ( serial_ocean ) then
3529  call comm_bcast( oia_org, oja_org, tw_org )
3530  call comm_bcast( oia_org, oja_org, sst_org )
3531  call comm_bcast( oia_org, oja_org, n_rad_dir, n_rad_rgn, albw_org(:,:,:,:) )
3532 
3533  call comm_bcast( oia_org, oja_org, z0w_org )
3534  call comm_bcast( oia_org, oja_org, omask_org )
3535  end if
3536 
3537  call prof_rapend ('___SurfaceBcast',3)
3538 
3539  call prof_rapstart('___SurfaceInterp',3)
3540 
3541  if ( first_surface ) then
3542 
3543  if ( lia_org .ne. oia_org &
3544  .or. lja_org .ne. oja_org ) then
3545  ol_interp = .true.
3546  else
3547  ol_interp = .false.
3548  outer: do j = 1, lja_org
3549  do i = 1, lia_org
3550  if ( llon_org(i,j) .ne. olon_org(i,j) &
3551  .or. llat_org(i,j) .ne. olat_org(i,j) ) then
3552  ol_interp = .true.
3553  exit outer
3554  end if
3555  end do
3556  end do outer
3557  end if
3558 
3559  if ( ol_interp ) then
3560  ! interpolation factor between outer ocean grid and land grid
3561  call interp_factor2d( itp_nh_ol, & ! [IN]
3562  lia_org, lja_org, & ! [IN]
3563  oia_org, oja_org, & ! [IN]
3564  llon_org(:,:), & ! [IN]
3565  llat_org(:,:), & ! [IN]
3566  olon_org(:,:), & ! [IN]
3567  olat_org(:,:), & ! [IN]
3568  igrd_ol(:,:,:), & ! [OUT]
3569  jgrd_ol(:,:,:), & ! [OUT]
3570  hfact_ol(:,:,:) ) ! [OUT]
3571  end if
3572  end if
3573 
3574 
3575  ! Ocean temp: interpolate over the land
3576  if ( i_intrp_ocean_temp .ne. i_intrp_off ) then
3577  select case( i_intrp_ocean_temp )
3578  case( i_intrp_mask )
3579  call make_mask( omask, tw_org, oia_org, oja_org, landdata=.false.)
3580  !$omp parallel do
3581  do j = 1, oja_org
3582  do i = 1, oia_org
3583  if ( omask_org(i,j) .ne. undef ) omask(i,j) = omask_org(i,j)
3584  end do
3585  end do
3586  case( i_intrp_fill )
3587  call make_mask( omask, tw_org, oia_org, oja_org, landdata=.false.)
3588  end select
3589  call interp_oceanland_data(tw_org, omask, oia_org, oja_org, .false., intrp_iter_max)
3590  end if
3591 
3592  ! SST: interpolate over the land
3593  if ( i_intrp_ocean_sfc_temp .ne. i_intrp_off ) then
3594  select case( i_intrp_ocean_sfc_temp )
3595  case( i_intrp_mask )
3596  call make_mask( omask, sst_org, oia_org, oja_org, landdata=.false.)
3597  !$omp parallel do
3598  do j = 1, oja_org
3599  do i = 1, oia_org
3600  if ( omask_org(i,j) .ne. undef ) omask(i,j) = omask_org(i,j)
3601  end do
3602  end do
3603  case( i_intrp_fill )
3604  call make_mask( omask, sst_org, oia_org, oja_org, landdata=.false.)
3605  end select
3606  call interp_oceanland_data(sst_org, omask, oia_org, oja_org, .false., intrp_iter_max)
3607  end if
3608 
3609  if ( first_surface .or. multi_land ) then
3610 
3611  call land_interporation( &
3612  lka_org, lia_org, lja_org, &
3613  oia_org, oja_org, &
3614  tg(:,:,:), strg(:,:,:), & ! (out)
3615  lst(:,:), albg(:,:,:,:), & ! (out)
3616  tg_org, strg_org, smds_org, & ! (inout)
3617  lst_org, albg_org, & ! (inout)
3618  sst_org, & ! (in)
3619  lmask_org, & ! (in)
3620  lsmask_nest, & ! (in)
3621  topo_org, & ! (in)
3622  lz_org, llon_org, llat_org, & ! (in)
3623  lcz, cx, cy, lon, lat, & ! (in)
3624  maskval_tg, maskval_strg, & ! (in)
3625  init_landwater_ratio, & ! (in)
3626  ! init_landwater_ratio_each(:), & ! (in)
3627  use_file_landwater, & ! (in)
3628  use_waterratio, & ! (in)
3629  soilwater_ds2vc_flag, & ! (in)
3630  elevation_correction_land, & ! (in)
3631  intrp_iter_max, & ! (in)
3632  ol_interp ) ! (in)
3633 
3634  !$omp parallel do
3635  do j = 1, lja_org
3636  do i = 1, lia_org
3637  if ( topo_org(i,j) > undef ) then ! ignore UNDEF value
3638  work(i,j) = lst_org(i,j) + topo_org(i,j) * laps
3639  else
3640  work(i,j) = lst_org(i,j)
3641  end if
3642  end do
3643  end do
3644 
3645  if ( ol_interp ) then
3646  ! land surface temperature at ocean grid
3647  call interp_interp2d( itp_nh_ol, & ! [IN]
3648  lia_org, lja_org, & ! [IN]
3649  oia_org, oja_org, & ! [IN]
3650  igrd_ol(:,:,:), & ! [IN]
3651  jgrd_ol(:,:,:), & ! [IN]
3652  hfact_ol(:,:,:), & ! [IN]
3653  work(:,:), & ! [IN]
3654  lst_ocean(:,:) ) ! [OUT]
3655  else
3656  !$omp parallel do
3657  do j = 1, oja_org
3658  do i = 1, oia_org
3659  lst_ocean(i,j) = work(i,j)
3660  end do
3661  end do
3662  end if
3663 
3664  end if
3665 
3666  call replace_misval_map( sst_org, lst_ocean, oia_org, oja_org, "SST" )
3667  call replace_misval_map( tw_org, lst_ocean, oia_org, oja_org, "OCEAN_TEMP" )
3668 
3669  call ocean_interporation( oia_org, oja_org, & ! (in)
3670  sst_org(:,:), tw_org(:,:), & ! (in)
3671  albw_org(:,:,:,:), z0w_org(:,:), & ! (inout)
3672  cx(:), cy(:), & ! (in)
3673  elevation_correction_ocean, & ! (in)
3674  init_ocean_alb_lw, init_ocean_alb_sw, & ! (in)
3675  init_ocean_z0w, & ! (in)
3676  first_surface, & ! (in)
3677  sst(:,:), tw(:,:), & ! (out)
3678  albw(:,:,:,:), z0w(:,:) ) ! (out)
3679 
3680 
3681  if ( first_surface .or. multi_land ) then
3682  ! replace values over the ocean ####
3683  !$omp parallel do
3684  do j = 1, ja
3685  do i = 1, ia
3686  if( abs(lsmask_nest(i,j)-0.0_rp) < eps ) then ! ocean grid
3687  lst(i,j) = sst(i,j)
3688  endif
3689  enddo
3690  enddo
3691  end if
3692 
3693 
3694  if ( urban_do .and. first_surface ) then
3695  call urban_input( lst(:,:), albg(:,:,:,:), & ! [IN]
3696  dens, momx, momy, rhot, qtrc, & ! [IN]
3697  tc_urb(:,:), qc_urb(:,:), uc_urb(:,:), & ! [OUT]
3698  ust(:,:), albu(:,:,:,:) ) ! [OUT]
3699  end if
3700 
3701 
3702  first_surface = .false.
3703 
3704  call prof_rapend ('___SurfaceInterp',3)
3705 
3706 
3707  return
3708  end subroutine parentsurfaceinput
3709 
3710  !-----------------------------------------------------------------------------
3712  subroutine boundarysurfaceoutput( &
3713  tg, &
3714  strg, &
3715  lst, &
3716  tw, &
3717  sst, &
3718  z0, &
3719  multi_ocean, &
3720  multi_land, &
3721  fid, &
3722  vid, &
3723  timeintv, &
3724  istep )
3725  use scale_const, only: &
3726  i_sw => const_i_sw, &
3727  i_lw => const_i_lw
3728  use scale_file_cartesc, only: &
3729  file_cartesc_create, &
3730  file_cartesc_def_var, &
3731  file_cartesc_enddef, &
3732  file_cartesc_write_var
3733  use scale_time, only: &
3734  time_nowdate
3735  implicit none
3736 
3737  real(rp), intent(in) :: tg(lka,ia,ja,1)
3738  real(rp), intent(in) :: strg(lka,ia,ja,1)
3739  real(rp), intent(in) :: lst(ia,ja,1)
3740  real(rp), intent(in) :: tw(1,ia,ja,1)
3741  real(rp), intent(in) :: sst(ia,ja,1)
3742  real(rp), intent(in) :: z0(ia,ja,1)
3743  logical, intent(in) :: multi_ocean
3744  logical, intent(in) :: multi_land
3745  integer, intent(in) :: fid
3746  integer, intent(in) :: vid(10)
3747  real(dp), intent(in) :: timeintv
3748  integer, intent(in) :: istep
3749 
3750  real(dp) :: timeofs
3751  !---------------------------------------------------------------------------
3752 
3753  call prof_rapstart('___SurfaceOutput',3)
3754 
3755  timeofs = (istep - 1) * timeintv
3756 
3757  if ( multi_land ) then
3758  call file_cartesc_write_var( fid, vid(1), tg(:,:,:,:), 'LAND_TEMP', 'LXYT', timeintv, timeofs=timeofs )
3759  call file_cartesc_write_var( fid, vid(2), strg(:,:,:,:), 'LAND_WATER', 'LXYT', timeintv, timeofs=timeofs )
3760  call file_cartesc_write_var( fid, vid(3), lst(:,:,:), 'LAND_SFC_TEMP', 'XYT', timeintv, timeofs=timeofs )
3761  end if
3762 
3763  if ( multi_ocean ) then
3764  call file_cartesc_write_var( fid, vid(6), tw(:,:,:,:), 'OCEAN_TEMP', 'OXYT', timeintv, timeofs=timeofs )
3765  call file_cartesc_write_var( fid, vid(7), sst(:,:,:), 'OCEAN_SFC_TEMP', 'XYT', timeintv, timeofs=timeofs )
3766  call file_cartesc_write_var( fid, vid(10), z0(:,:,:), ' OCEAN_SFC_Z0', 'XYT', timeintv, timeofs=timeofs )
3767  end if
3768 
3769  call prof_rapend ('___SurfaceOutput',3)
3770 
3771  return
3772  end subroutine boundarysurfaceoutput
3773 
3774 
3775  !-------------------------------
3776  subroutine land_interporation( &
3777  kmax, imax, jmax, oimax,ojmax, &
3778  tg, strg, lst, albg, &
3779  tg_org, strg_org, smds_org, &
3780  lst_org, albg_org, &
3781  sst_org, &
3782  lmask_org, lsmask_nest, &
3783  topo_org, &
3784  lz_org, llon_org, llat_org, &
3785  LCZ, CX, CY, &
3786  LON, LAT, &
3787  maskval_tg, maskval_strg, &
3788  init_landwater_ratio, &
3789 ! init_landwater_ratio_each, &
3790  use_file_landwater, &
3791  use_waterratio, &
3792  soilwater_ds2vc_flag, &
3793  elevation_correction, &
3794  intrp_iter_max, &
3795  ol_interp )
3796  use scale_prc, only: &
3797  prc_abort
3798  use scale_const, only: &
3799  undef => const_undef, &
3800  eps => const_eps, &
3801  i_sw => const_i_sw, &
3802  i_lw => const_i_lw, &
3803  pi => const_pi, &
3804  laps => const_laps
3805  use scale_interp, only: &
3806  interp_factor2d, &
3807  interp_factor3d, &
3808  interp_interp2d, &
3809  interp_interp3d
3810  use scale_mapprojection, only: &
3811  mapprojection_lonlat2xy
3812  use scale_comm_cartesc, only: &
3813  comm_vars8, &
3814  comm_wait
3815  use scale_filter, only: &
3816  filter_hyperdiff
3817  use scale_topography, only: &
3818  topography_zsfc
3819  use scale_landuse, only: &
3820  landuse_pft_nmax, &
3821  landuse_index_pft
3822  use mod_land_vars, only: &
3823  convert_ws2vwc
3824  implicit none
3825  integer, intent(in) :: kmax, imax, jmax
3826  integer, intent(in) :: oimax, ojmax
3827  real(RP), intent(out) :: tg(LKMAX,IA,JA)
3828  real(RP), intent(out) :: strg(LKMAX,IA,JA)
3829  real(RP), intent(out) :: lst(IA,JA)
3830  real(RP), intent(out) :: albg(IA,JA,N_RAD_DIR,N_RAD_RGN)
3831  real(RP), intent(inout) :: tg_org(kmax,imax,jmax)
3832  real(RP), intent(inout) :: strg_org(kmax,imax,jmax)
3833  real(RP), intent(inout) :: smds_org(kmax,imax,jmax)
3834  real(RP), intent(inout) :: lst_org(imax,jmax)
3835  real(RP), intent(inout) :: albg_org(imax,jmax,N_RAD_DIR,N_RAD_RGN)
3836  real(RP), intent(inout) :: sst_org(oimax,ojmax)
3837  real(RP), intent(in) :: lmask_org(imax,jmax)
3838  real(RP), intent(in) :: lsmask_nest(IA,JA)
3839  real(RP), intent(in) :: topo_org(imax,jmax)
3840  real(RP), intent(in) :: lz_org(kmax)
3841  real(RP), intent(in) :: llon_org(imax,jmax)
3842  real(RP), intent(in) :: llat_org(imax,jmax)
3843  real(RP), intent(in) :: LCZ(LKMAX)
3844  real(RP), intent(in) :: CX(IA)
3845  real(RP), intent(in) :: CY(JA)
3846  real(RP), intent(in) :: LON(IA,JA)
3847  real(RP), intent(in) :: LAT(IA,JA)
3848  real(RP), intent(in) :: maskval_tg
3849  real(RP), intent(in) :: maskval_strg
3850  real(RP), intent(in) :: init_landwater_ratio
3851 ! real(RP), intent(in) :: init_landwater_ratio_each(LANDUSE_PFT_nmax)
3852  logical, intent(in) :: use_file_landwater
3853  logical, intent(in) :: use_waterratio
3854  logical, intent(in) :: soilwater_ds2vc_flag
3855  logical, intent(in) :: elevation_correction
3856  integer, intent(in) :: intrp_iter_max
3857  logical, intent(in) :: ol_interp
3858 
3859  real(RP) :: lmask(imax,jmax)
3860  real(RP) :: smds(LKMAX,IA,JA)
3861 
3862  ! data for interporation
3863  real(RP) :: hfact_l(imax,jmax,itp_nh_ol)
3864  integer :: igrd_l (imax,jmax,itp_nh_ol)
3865  integer :: jgrd_l (imax,jmax,itp_nh_ol)
3866  real(RP) :: lX_org (imax,jmax)
3867  real(RP) :: lY_org (imax,jmax)
3868  logical :: zonal, pole
3869  integer :: igrd ( IA,JA,itp_nh_l)
3870  integer :: jgrd ( IA,JA,itp_nh_l)
3871  real(RP) :: hfact( IA,JA,itp_nh_l)
3872  integer :: kgrdl (LKMAX,2,IA,JA,itp_nh_l)
3873  real(RP) :: vfactl(LKMAX, IA,JA,itp_nh_l)
3874 
3875 
3876  real(RP) :: sst_land(imax,jmax)
3877  real(RP) :: work (imax,jmax)
3878  real(RP) :: work2(imax,jmax)
3879 
3880  real(RP) :: lz3d_org(kmax,imax,jmax)
3881  real(RP) :: lcz_3D(LKMAX,IA,JA)
3882 
3883  ! elevation correction
3884  real(RP) :: topo(IA,JA)
3885  real(RP) :: tdiff
3886 
3887  real(RP) :: one2d(IA,JA)
3888  real(RP) :: one3d(LKMAX,IA,JA)
3889 
3890  integer :: k, i, j, m, n
3891 
3892 
3893  ! Surface skin temp: interpolate over the ocean
3894  if ( i_intrp_land_sfc_temp .ne. i_intrp_off ) then
3895  select case( i_intrp_land_sfc_temp )
3896  case( i_intrp_mask )
3897  call make_mask( lmask, lst_org, imax, jmax, landdata=.true.)
3898  !$omp parallel do
3899  do j = 1, jmax
3900  do i = 1, imax
3901  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
3902  end do
3903  end do
3904  case( i_intrp_fill )
3905  call make_mask( lmask, lst_org, imax, jmax, landdata=.true.)
3906  case default
3907  log_error("land_interporation",*) 'INTRP_LAND_SFC_TEMP is invalid.'
3908  call prc_abort
3909  end select
3910  call interp_oceanland_data(lst_org, lmask, imax, jmax, .true., intrp_iter_max)
3911  end if
3912 
3913  if ( ol_interp ) then
3914  ! interpolation facter between outer land grid and ocean grid
3915  call interp_factor2d( itp_nh_ol, & ! [IN]
3916  oimax, ojmax, & ! [IN]
3917  imax, jmax, & ! [IN]
3918  olon_org(:,:), & ! [IN]
3919  olat_org(:,:), & ! [IN]
3920  llon_org(:,:), & ! [IN]
3921  llat_org(:,:), & ! [IN]
3922  igrd_l(:,:,:), & ! [OUT]
3923  jgrd_l(:,:,:), & ! [OUT]
3924  hfact_l(:,:,:) ) ! [OUT]
3925 
3926  ! sst on land grid
3927  call interp_interp2d( itp_nh_ol, & ! [IN]
3928  oimax, ojmax, & ! [IN]
3929  imax, jmax, & ! [IN]
3930  igrd_l(:,:,:), & ! [IN]
3931  jgrd_l(:,:,:), & ! [IN]
3932  hfact_l(:,:,:), & ! [IN]
3933  sst_org(:,:), & ! [IN]
3934  sst_land(:,:) ) ! [OUT]
3935  else
3936  !$omp parallel do
3937  do j = 1, jmax
3938  do i = 1, imax
3939  sst_land(i,j) = sst_org(i,j)
3940  end do
3941  end do
3942  end if
3943 
3944  !$omp parallel do
3945  do j = 1, jmax
3946  do i = 1, imax
3947  if ( topo_org(i,j) > undef + eps ) then ! ignore UNDEF value
3948  sst_land(i,j) = sst_land(i,j) - topo_org(i,j) * laps
3949  end if
3950  end do
3951  end do
3952 
3953  call replace_misval_map( lst_org, sst_land, imax, jmax, "SKINT" )
3954 
3955  ! replace missing value
3956  !$omp parallel do
3957  do j = 1, jmax
3958  do i = 1, imax
3959 ! if ( skinw_org(i,j) == UNDEF ) skinw_org(i,j) = 0.0_RP
3960 ! if ( snowq_org(i,j) == UNDEF ) snowq_org(i,j) = 0.0_RP
3961 ! if ( snowt_org(i,j) == UNDEF ) snowt_org(i,j) = TEM00
3962  do m = 1, n_rad_dir
3963  if( albg_org(i,j,m,i_r_ir ) == undef ) albg_org(i,j,m,i_r_ir ) = 0.03_rp ! emissivity of general ground surface : 0.95-0.98
3964  if( albg_org(i,j,m,i_r_nir) == undef ) albg_org(i,j,m,i_r_nir) = 0.22_rp
3965  if( albg_org(i,j,m,i_r_vis) == undef ) albg_org(i,j,m,i_r_vis) = 0.22_rp
3966  end do
3967  end do
3968  end do
3969 
3970  ! Land temp: interpolate over the ocean
3971  if ( i_intrp_land_temp .ne. i_intrp_off ) then
3972  do k = 1, kmax
3973  !$omp parallel do
3974  do j = 1, jmax
3975  do i = 1, imax
3976  work(i,j) = tg_org(k,i,j)
3977  end do
3978  end do
3979  select case( i_intrp_land_temp )
3980  case( i_intrp_mask )
3981  call make_mask( lmask, work, imax, jmax, landdata=.true.)
3982  !$omp parallel do
3983  do j = 1, jmax
3984  do i = 1, imax
3985  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
3986  end do
3987  end do
3988  case( i_intrp_fill )
3989  call make_mask( lmask, work, imax, jmax, landdata=.true.)
3990  end select
3991  call interp_oceanland_data( work, lmask, imax, jmax, .true., intrp_iter_max )
3992  !replace land temp using skin temp
3993  call replace_misval_map( work, lst_org, imax, jmax, "STEMP")
3994  !$omp parallel do
3995  do j = 1, jmax
3996  do i = 1, imax
3997  tg_org(k,i,j) = work(i,j)
3998  end do
3999  end do
4000  end do
4001  end if
4002 
4003 
4004  ! fill grid data
4005  !$omp parallel do collapse(2)
4006  do j = 1, jmax
4007  do i = 1, imax
4008  lz3d_org(:,i,j) = lz_org(:)
4009  end do
4010  end do
4011 
4012  !$omp parallel do collapse(2)
4013  do j = 1, ja
4014  do i = 1, ia
4015  lcz_3d(:,i,j) = lcz(:)
4016  enddo
4017  enddo
4018 
4019  select case( itp_type_l )
4020  case ( i_intrp_linear )
4021 
4022  if ( imax == 1 .or. jmax == 1 ) then
4023  log_error("land_interporation",*) 'LINER interpolation requires nx, ny > 1'
4024  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_LAND'
4025  call prc_abort
4026  end if
4027 
4028  !$omp parallel do
4029  do j = 1, jmax
4030  do i = 1, imax
4031  work(i,j) = sign( min( abs(llat_org(i,j)), pi * 0.499999_rp ), llat_org(i,j) )
4032  end do
4033  end do
4034 
4035  call mapprojection_lonlat2xy( imax, 1, imax, jmax, 1, jmax, &
4036  llon_org(:,:), work(:,:), & ! [IN]
4037  lx_org(:,:), ly_org(:,:) ) ! [OUT]
4038 
4039  zonal = ( maxval(llon_org) - minval(llon_org) ) > 2.0_rp * pi * 0.9_rp
4040  pole = ( maxval(llat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(llat_org) < - pi * 0.5_rp * 0.9_rp )
4041  call interp_factor3d( kmax, 1, kmax, & ! [IN]
4042  imax, jmax, & ! [IN]
4043  lkmax, lks, lke, & ! [IN]
4044  ia, ja, & ! [IN]
4045  lx_org(:,:), & ! [IN]
4046  ly_org(:,:), & ! [IN]
4047  lz3d_org(:,:,:), & ! [IN]
4048  cx(:), cy(:), & ! [IN]
4049  lcz_3d(:,:,:), & ! [IN]
4050  igrd( :,:,:), & ! [OUT]
4051  jgrd( :,:,:), & ! [OUT]
4052  hfact( :,:,:), & ! [OUT]
4053  kgrdl(:,:,:,:,:), & ! [OUT]
4054  vfactl(:, :,:,:), & ! [OUT]
4055  flag_extrap = .true., & ! [IN, optional]
4056  zonal = zonal, & ! [IN, optional]
4057  pole = pole ) ! [IN, optional]
4058 
4059  case ( i_intrp_dstwgt )
4060 
4061  call interp_factor3d( itp_nh_l, & ! [IN]
4062  kmax, 1, kmax, & ! [IN]
4063  imax, jmax, & ! [IN]
4064  lkmax, lks, lke, & ! [IN]
4065  ia, ja, & ! [IN]
4066  llon_org(:,:), & ! [IN]
4067  llat_org(:,:), & ! [IN]
4068  lz3d_org(:,:,:), & ! [IN]
4069  lon(:,:), lat(:,:), & ! [IN]
4070  lcz_3d(:,:,:), & ! [IN]
4071  igrd( :,:,:), & ! [OUT]
4072  jgrd( :,:,:), & ! [OUT]
4073  hfact( :,:,:), & ! [OUT]
4074  kgrdl(:,:,:,:,:), & ! [OUT]
4075  vfactl(:, :,:,:), & ! [OUT]
4076  flag_extrap = .true. ) ! [IN, optional]
4077 
4078  end select
4079 
4080  call interp_interp2d( itp_nh_l, & ! [IN]
4081  imax, jmax, & ! [IN]
4082  ia, ja, & ! [IN]
4083  igrd(:,:,:), & ! [IN]
4084  jgrd(:,:,:), & ! [IN]
4085  hfact(:,:,:), & ! [IN]
4086  lst_org(:,:), & ! [IN]
4087  lst(:,:) ) ! [OUT]
4088  if ( filter_niter > 0 ) then
4089  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4090  lst(:,:), filter_order, filter_niter )
4091  call comm_vars8( lst(:,:), 1 )
4092  call comm_wait ( lst(:,:), 1, .false. )
4093  end if
4094 
4095 
4096  if ( filter_niter > 0 ) then
4097  !$omp parallel do
4098  do j = 1, ja
4099  do i = 1, ia
4100  one2d(i,j) = 1.0_rp
4101  end do
4102  end do
4103  end if
4104 
4105  do n = 1, n_rad_rgn
4106  do m = 1, n_rad_dir
4107 
4108  call interp_interp2d( itp_nh_l, & ! [IN]
4109  imax, jmax, & ! [IN]
4110  ia, ja, & ! [IN]
4111  igrd(:,:,:), & ! [IN]
4112  jgrd(:,:,:), & ! [IN]
4113  hfact(:,:,:), & ! [IN]
4114  albg_org(:,:,m,n), & ! [IN]
4115  albg(:,:,m,n) ) ! [OUT]
4116  if ( filter_niter > 0 ) then
4117  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4118  albg(:,:,m,n), filter_order, filter_niter, &
4119  limiter_sign = one2d(:,:) )
4120  call comm_vars8( albg(:,:,m,n), 1 )
4121  call comm_wait ( albg(:,:,m,n), 1, .false. )
4122  end if
4123  end do
4124  end do
4125 
4126  call interp_interp3d( itp_nh_l, &
4127  kmax, 1, kmax, &
4128  imax, jmax, &
4129  lkmax, lks, lke, &
4130  ia, ja, &
4131  igrd( :,:,:), & ! [IN]
4132  jgrd( :,:,:), & ! [IN]
4133  hfact( :,:,:), & ! [IN]
4134  kgrdl(:,:,:,:,:), & ! [IN]
4135  vfactl(:, :,:,:), & ! [IN]
4136  lz3d_org(:,:,:), & ! [IN]
4137  lcz_3d(:,:,:), & ! [IN]
4138  tg_org(:,:,:), & ! [IN]
4139  tg(:,:,:) ) ! [OUT]
4140 
4141  !$omp parallel do
4142  do j = 1, ja
4143  do i = 1, ia
4144  tg(lkmax,i,j) = tg(lkmax-1,i,j)
4145  enddo
4146  enddo
4147 
4148  ! replace values over the ocean
4149  do k = 1, lkmax
4150  call replace_misval_const( tg(k,:,:), maskval_tg, lsmask_nest )
4151  enddo
4152  if ( filter_niter > 0 ) then
4153  call filter_hyperdiff( lkmax, 1, lkmax, ia, isb, ieb, ja, jsb, jeb, &
4154  tg(:,:,:), filter_order, filter_niter )
4155  call comm_vars8( tg(:,:,:), 1 )
4156  call comm_wait ( tg(:,:,:), 1, .false. )
4157  end if
4158 
4159 
4160  ! elevation correction
4161  if ( elevation_correction ) then
4162  call interp_interp2d( itp_nh_l, & ! [IN]
4163  imax, jmax, & ! [IN]
4164  ia, ja, & ! [IN]
4165  igrd(:,:,:), & ! [IN]
4166  jgrd(:,:,:), & ! [IN]
4167  hfact(:,:,:), & ! [IN]
4168  topo_org(:,:), & ! [IN]
4169  topo(:,:) ) ! [OUT]
4170  if ( filter_niter > 0 ) then
4171  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4172  topo(:,:), filter_order, filter_niter )
4173  call comm_vars8( topo(:,:), 1 )
4174  call comm_wait ( topo(:,:), 1, .false. )
4175  end if
4176 
4177  !$omp parallel do &
4178  !$omp private(tdiff)
4179  do j = 1, ja
4180  do i = 1, ia
4181  if ( topo(i,j) > undef + eps ) then ! ignore UNDEF value
4182  tdiff = ( topography_zsfc(i,j) - topo(i,j) ) * laps
4183  lst(i,j) = lst(i,j) - tdiff
4184  do k = 1, lkmax
4185  tg(k,i,j) = tg(k,i,j) - tdiff
4186  end do
4187  end if
4188  end do
4189  end do
4190 
4191  end if
4192 
4193 
4194 
4195  ! Land water: interpolate over the ocean
4196  if( use_file_landwater )then
4197 
4198  if ( use_waterratio ) then
4199 
4200  if ( i_intrp_land_water .ne. i_intrp_off ) then
4201  do k = 1, kmax
4202  !$omp parallel do
4203  do j = 1, jmax
4204  do i = 1, imax
4205  work(i,j) = smds_org(k,i,j)
4206  end do
4207  end do
4208  select case( i_intrp_land_water )
4209  case( i_intrp_mask )
4210  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4211  !$omp parallel do
4212  do j = 1, jmax
4213  do i = 1, imax
4214  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
4215  end do
4216  end do
4217  case( i_intrp_fill )
4218  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4219  end select
4220  call interp_oceanland_data(work, lmask, imax, jmax, .true., intrp_iter_max)
4221  !$omp parallel do
4222  do j = 1, jmax
4223  do i = 1, imax
4224 ! work2(i,j) = init_landwater_ratio_each( LANDUSE_index_PFT(i,j,1) )
4225  work2(i,j) = init_landwater_ratio
4226  end do
4227  end do
4228  !replace missing value to init_landwater_ratio_each
4229  call replace_misval_map( work, work2, imax, jmax, "SMOISDS")
4230  !$omp parallel do
4231  do j = 1, jmax
4232  do i = 1, imax
4233  smds_org(k,i,j) = work(i,j)
4234  end do
4235  end do
4236  enddo
4237  end if
4238 
4239  call interp_interp3d( itp_nh_l, &
4240  kmax, 1, kmax, &
4241  imax, jmax, &
4242  lkmax, lks, lke, &
4243  ia, ja, &
4244  igrd( :,:,:), & ! [IN]
4245  jgrd( :,:,:), & ! [IN]
4246  hfact( :,:,:), & ! [IN]
4247  kgrdl(:,:,:,:,:), & ! [IN]
4248  vfactl(:, :,:,:), & ! [IN]
4249  lz3d_org(:,:,:), & ! [IN]
4250  lcz_3d(:,:,:), & ! [IN]
4251  smds_org(:,:,:), & ! [IN]
4252  smds(:,:,:) ) ! [OUT]
4253 
4254  do k = 1, lkmax-1
4255  strg(k,:,:) = convert_ws2vwc( smds(k,:,:), critical=soilwater_ds2vc_flag )
4256  end do
4257 
4258  else
4259 
4260  if ( i_intrp_land_water .ne. i_intrp_off ) then
4261  do k = 1, kmax
4262  !$omp parallel do
4263  do j = 1, jmax
4264  do i = 1, imax
4265  work(i,j) = strg_org(k,i,j)
4266  end do
4267  end do
4268  select case( i_intrp_land_water )
4269  case( i_intrp_mask )
4270  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4271  !$omp parallel do
4272  do j = 1, jmax
4273  do i = 1, imax
4274  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
4275  end do
4276  end do
4277  case( i_intrp_fill )
4278  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4279  end select
4280  call interp_oceanland_data(work, lmask, imax, jmax, .true., intrp_iter_max)
4281  !$omp parallel do
4282  do j = 1, jmax
4283  do i = 1, imax
4284  lmask(i,j) = maskval_strg
4285  end do
4286  end do
4287  !replace missing value to init_landwater_ratio
4288  call replace_misval_map( work, lmask, imax, jmax, "SMOIS")
4289  !$omp parallel do
4290  do j = 1, jmax
4291  do i = 1, imax
4292  strg_org(k,i,j) = work(i,j)
4293  end do
4294  end do
4295  enddo
4296  end if
4297 
4298  call interp_interp3d( itp_nh_l, &
4299  kmax, 1, kmax, &
4300  imax, jmax, &
4301  lkmax, lks, lke, &
4302  ia, ja, &
4303  igrd( :,:,:), & ! [IN]
4304  jgrd( :,:,:), & ! [IN]
4305  hfact( :,:,:), & ! [IN]
4306  kgrdl(:,:,:,:,:), & ! [IN]
4307  vfactl(:, :,:,:), & ! [IN]
4308  lz3d_org(:,:,:), & ! [IN]
4309  lcz_3d(:,:,:), & ! [IN]
4310  strg_org(:,:,:), & ! [IN]
4311  strg(:,:,:) ) ! [OUT]
4312  end if
4313 
4314  ! replace values over the ocean
4315  do k = 1, lkmax-1
4316  call replace_misval_const( strg(k,:,:), maskval_strg, lsmask_nest )
4317  enddo
4318 
4319  !$omp parallel do collapse(2)
4320  do j = 1, ja
4321  do i = 1, ia
4322  do k = 1, lkmax
4323  strg(k,i,j) = max( min( strg(k,i,j), 1.0_rp ), 0.0_rp )
4324  end do
4325  end do
4326  end do
4327 
4328  if ( filter_niter > 0 ) then
4329  !$omp parallel do collapse(2)
4330  do j = 1, ja
4331  do i = 1, ia
4332  do k = 1, lkmax-1
4333  one3d(k,i,j) = 1.0_rp
4334  end do
4335  end do
4336  end do
4337  call filter_hyperdiff( lkmax, 1, lkmax-1, ia, isb, ieb, ja, jsb, jeb, &
4338  strg(:,:,:), filter_order, filter_niter, &
4339  limiter_sign = one3d(:,:,:) )
4340  call comm_vars8( strg(:,:,:), 1 )
4341  call comm_wait ( strg(:,:,:), 1, .false. )
4342  end if
4343 
4344  !$omp parallel do
4345  do j = 1, ja
4346  do i = 1, ia
4347  strg(lkmax,i,j) = strg(lkmax-1,i,j)
4348  enddo
4349  enddo
4350 
4351  else ! not read from boundary file
4352 
4353  do k = 1, lkmax
4354  !$omp parallel do
4355  do j = 1, ja
4356  do i = 1, ia
4357 ! work(i,j) = init_landwater_ratio_each( LANDUSE_index_PFT(i,j,1) )
4358  work(i,j) = init_landwater_ratio
4359  end do
4360  end do
4361  ! conversion from water saturation [fraction] to volumetric water content [m3/m3]
4362  strg(k,:,:) = convert_ws2vwc( work(:,:), critical=soilwater_ds2vc_flag )
4363  end do
4364 
4365  endif ! use_file_waterratio
4366 
4367 
4368  return
4369  end subroutine land_interporation
4370 
4371  subroutine ocean_interporation( &
4372  imax, jmax, &
4373  sst_org, tw_org, albw_org, z0w_org, &
4374  CX, CY, &
4375  elevation_correction_ocean, &
4376  init_ocean_alb_lw, init_ocean_alb_sw, &
4377  init_ocean_z0w, &
4378  first_surface, &
4379  sst, tw, albw, z0w )
4380  use scale_const, only: &
4381  undef => const_undef, &
4382  pi => const_pi, &
4383  laps => const_laps
4384  use scale_topography, only: &
4385  topography_zsfc
4386  use scale_interp, only: &
4387  interp_factor2d, &
4388  interp_interp2d
4389  use scale_filter, only: &
4390  filter_hyperdiff
4391  use scale_mapprojection, only: &
4392  mapprojection_lonlat2xy
4393  use scale_comm_cartesc, only: &
4394  comm_vars8, &
4395  comm_wait
4396  implicit none
4397  integer, intent(in) :: imax, jmax
4398  real(RP), intent(in) :: sst_org (imax,jmax)
4399  real(RP), intent(in) :: tw_org (imax,jmax)
4400  real(RP), intent(inout) :: albw_org(imax,jmax,N_RAD_DIR,N_RAD_RGN)
4401  real(RP), intent(inout) :: z0w_org (imax,jmax)
4402  real(RP), intent(in) :: CX(IA)
4403  real(RP), intent(in) :: CY(JA)
4404  logical, intent(in) :: elevation_correction_ocean
4405  real(RP), intent(in) :: init_ocean_alb_lw
4406  real(RP), intent(in) :: init_ocean_alb_sw
4407  real(RP), intent(in) :: init_ocean_z0w
4408  logical, intent(in) :: first_surface
4409 
4410  real(RP), intent(out) :: sst (IA,JA)
4411  real(RP), intent(out) :: tw (IA,JA)
4412  real(RP), intent(out) :: albw(IA,JA,N_RAD_DIR,N_RAD_RGN)
4413  real(RP), intent(out) :: z0w (IA,JA)
4414 
4415  ! for interpolation
4416  real(RP) :: oX_org(imax,jmax)
4417  real(RP) :: oY_org(imax,jmax)
4418  logical :: zonal, pole
4419 
4420  real(RP) :: one(IA,JA)
4421  real(RP) :: tdiff
4422 
4423  integer :: i, j, m, n
4424 
4425  !$omp parallel do
4426  do j = 1, jmax
4427  do i = 1, imax
4428  do m = 1, n_rad_dir
4429  if ( albw_org(i,j,m,i_r_ir ) == undef ) albw_org(i,j,m,i_r_ir ) = init_ocean_alb_lw
4430  if ( albw_org(i,j,m,i_r_nir) == undef ) albw_org(i,j,m,i_r_nir) = init_ocean_alb_sw
4431  if ( albw_org(i,j,m,i_r_vis) == undef ) albw_org(i,j,m,i_r_vis) = init_ocean_alb_sw
4432  if ( albw_org(i,j,m,i_r_vis) == undef ) albw_org(i,j,m,i_r_vis) = init_ocean_alb_sw
4433  end do
4434  if ( z0w_org(i,j) == undef ) z0w_org(i,j) = init_ocean_z0w
4435  end do
4436  end do
4437 
4438  if ( first_surface ) then
4439 
4440  ! interporation for ocean variables
4441 
4442  select case( itp_type_a )
4443  case ( i_intrp_linear )
4444 
4445  if ( imax == 1 .or. jmax == 1 ) then
4446  log_error("ocean_interporation",*) 'LINER interpolation requires nx, ny > 1'
4447  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_OCEAN'
4448  call prc_abort
4449  end if
4450 
4451  !$omp parallel do
4452  do j = 1, jmax
4453  do i = 1, imax
4454  olat_org(i,j) = sign( min( abs(olat_org(i,j)), pi * 0.499999_rp ), olat_org(i,j) )
4455  end do
4456  end do
4457 
4458  call mapprojection_lonlat2xy( imax, 1, imax, jmax, 1, jmax, &
4459  olon_org(:,:), olat_org(:,:), & ! [IN]
4460  ox_org(:,:), oy_org(:,:) ) ! [OUT]
4461 
4462  zonal = ( maxval(olon_org) - minval(olon_org) ) > 2.0_rp * pi * 0.9_rp
4463  pole = ( maxval(olat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(olat_org) < - pi * 0.5_rp * 0.9_rp )
4464  call interp_factor2d( imax, jmax, & ! [IN]
4465  ia, ja, & ! [IN]
4466  ox_org(:,:), & ! [IN]
4467  oy_org(:,:), & ! [IN]
4468  cx(:), cy(:), & ! [IN]
4469  oigrd(:,:,:), & ! [OUT]
4470  ojgrd(:,:,:), & ! [OUT]
4471  ohfact(:,:,:), & ! [OUT]
4472  zonal = zonal, & ! [IN]
4473  pole = pole ) ! [IN]
4474 
4475  case ( i_intrp_dstwgt )
4476 
4477  call interp_factor2d( itp_nh_o, & ! [IN]
4478  imax, jmax, & ! [IN]
4479  ia, ja, & ! [IN]
4480  olon_org(:,:), & ! [IN]
4481  olat_org(:,:), & ! [IN]
4482  lon(:,:), lat(:,:), & ! [IN]
4483  oigrd(:,:,:), & ! [OUT]
4484  ojgrd(:,:,:), & ! [OUT]
4485  ohfact(:,:,:) ) ! [OUT]
4486 
4487  end select
4488 
4489  end if
4490 
4491 
4492  call interp_interp2d( itp_nh_o, & ! [IN]
4493  imax, jmax, & ! [IN]
4494  ia, ja, & ! [IN]
4495  oigrd(:,:,:), & ! [IN]
4496  ojgrd(:,:,:), & ! [IN]
4497  ohfact(:,:,:), & ! [IN]
4498  tw_org(:,:), & ! [IN]
4499  tw(:,:) ) ! [OUT]
4500  if ( filter_niter > 0 ) then
4501  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4502  tw(:,:), filter_order, filter_niter )
4503  call comm_vars8( tw(:,:), 1 )
4504  call comm_wait ( tw(:,:), 1, .false. )
4505  end if
4506 
4507  call interp_interp2d( itp_nh_o, & ! [IN]
4508  imax, jmax, & ! [IN]
4509  ia, ja, & ! [IN]
4510  oigrd(:,:,:), & ! [IN]
4511  ojgrd(:,:,:), & ! [IN]
4512  ohfact(:,:,:), & ! [IN]
4513  sst_org(:,:), & ! [IN]
4514  sst(:,:) ) ! [OUT]
4515  if ( filter_niter > 0 ) then
4516  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4517  sst(:,:), filter_order, filter_niter )
4518  call comm_vars8( sst(:,:), 1 )
4519  call comm_wait ( sst(:,:), 1, .false. )
4520  end if
4521 
4522  ! elevation correction
4523  if ( elevation_correction_ocean ) then
4524 
4525  !$omp parallel do &
4526  !$omp private(tdiff)
4527  do j = 1, ja
4528  do i = 1, ia
4529  tdiff = topography_zsfc(i,j) * laps
4530  sst(i,j) = sst(i,j) - tdiff
4531  tw(i,j) = tw(i,j) - tdiff
4532  end do
4533  end do
4534 
4535  end if
4536 
4537 
4538  if ( filter_niter > 0 ) then
4539  !$omp parallel do
4540  do j = 1, ja
4541  do i = 1, ia
4542  one(i,j) = 1.0_rp
4543  end do
4544  end do
4545  end if
4546 
4547  do n = 1, n_rad_rgn
4548  do m = 1, n_rad_dir
4549 
4550  call interp_interp2d( itp_nh_o, & ! [IN]
4551  imax, jmax, & ! [IN]
4552  ia, ja, & ! [IN]
4553  oigrd(:,:,:), & ! [IN]
4554  ojgrd(:,:,:), & ! [IN]
4555  ohfact(:,:,:), & ! [IN]
4556  albw_org(:,:,m,n), & ! [IN]
4557  albw(:,:,m,n) ) ! [OUT]
4558  if ( filter_niter > 0 ) then
4559  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4560  albw(:,:,m,n), filter_order, filter_niter, &
4561  limiter_sign = one(:,:) )
4562  call comm_vars8( albw(:,:,m,n), 1 )
4563  call comm_wait ( albw(:,:,m,n), 1, .false. )
4564  end if
4565 
4566  end do
4567  end do
4568 
4569  call interp_interp2d( itp_nh_o, & ! [IN]
4570  imax, jmax, & ! [IN]
4571  ia, ja, & ! [IN]
4572  oigrd(:,:,:), & ! [IN]
4573  ojgrd(:,:,:), & ! [IN]
4574  ohfact(:,:,:), & ! [IN]
4575  z0w_org(:,:), & ! [IN]
4576  z0w(:,:) ) ! [OUT]
4577  if ( filter_niter > 0 ) then
4578  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4579  z0w(:,:), filter_order, filter_niter, &
4580  limiter_sign = one(:,:) )
4581  call comm_vars8( z0w(:,:), 1 )
4582  call comm_wait ( z0w(:,:), 1, .false. )
4583  end if
4584 
4585 
4586  return
4587  end subroutine ocean_interporation
4588 
4589  !-------------------------------
4590  subroutine urban_input( &
4591  lst, albg, &
4592  DENS, MOMX, MOMY, RHOT, &
4593  QTRC , &
4594  tc_urb, qc_urb, uc_urb, &
4595  ust, albu )
4596  use scale_atmos_hydrometeor, only: &
4597  i_qv
4598  use scale_atmos_thermodyn, only: &
4599  thermodyn_specific_heat => atmos_thermodyn_specific_heat, &
4600  thermodyn_rhot2temp_pres => atmos_thermodyn_rhot2temp_pres
4601  use scale_comm_cartesc, only: &
4602  comm_vars8, &
4603  comm_wait
4604  implicit none
4605  real(RP), intent(in) :: lst (IA,JA)
4606  real(RP), intent(in) :: albg (IA,JA,N_RAD_DIR,N_RAD_RGN)
4607  real(RP), intent(in) :: DENS(KA,IA,JA)
4608  real(RP), intent(in) :: MOMX(KA,IA,JA)
4609  real(RP), intent(in) :: MOMY(KA,IA,JA)
4610  real(RP), intent(in) :: RHOT(KA,IA,JA)
4611  real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
4612  real(RP), intent(out) :: tc_urb(IA,JA)
4613  real(RP), intent(out) :: qc_urb(IA,JA)
4614  real(RP), intent(out) :: uc_urb(IA,JA)
4615  real(RP), intent(out) :: ust (IA,JA)
4616  real(RP), intent(out) :: albu (IA,JA,N_RAD_DIR,N_RAD_RGN)
4617 
4618  real(RP) :: temp, pres
4619  real(RP) :: Qdry
4620  real(RP) :: Rtot
4621  real(RP) :: CVtot
4622  real(RP) :: CPtot
4623 
4624  integer :: i, j
4625 
4626  ! urban data
4627 
4628  !$omp parallel do collapse(2) &
4629  !$omp private(Qdry,Rtot,CVtot,CPtot,temp,pres)
4630  do j = 1, ja
4631  do i = 1, ia
4632  call thermodyn_specific_heat( qa, &
4633  qtrc(ks,i,j,:), &
4634  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), & ! [IN]
4635  qdry, rtot, cvtot, cptot ) ! [OUT]
4636  call thermodyn_rhot2temp_pres( dens(ks,i,j), rhot(ks,i,j), rtot, cvtot, cptot, & ! [IN]
4637  temp, pres ) ! [OUT]
4638 
4639  tc_urb(i,j) = temp
4640  if ( i_qv > 0 ) then
4641  qc_urb(i,j) = qtrc(ks,i,j,i_qv)
4642  else
4643  qc_urb(i,j) = 0.0_rp
4644  end if
4645  enddo
4646  enddo
4647 
4648  !$omp parallel do
4649  do j = 1, ja-1
4650  do i = 1, ia-1
4651  uc_urb(i,j) = max(sqrt( ( momx(ks,i,j) / (dens(ks,i+1, j)+dens(ks,i,j)) * 2.0_rp )**2.0_rp &
4652  + ( momy(ks,i,j) / (dens(ks, i,j+1)+dens(ks,i,j)) * 2.0_rp )**2.0_rp ), &
4653  0.01_rp)
4654  enddo
4655  enddo
4656  !$omp parallel do
4657  do j = 1, ja-1
4658  uc_urb(ia,j) = max(sqrt( ( momx(ks,ia,j) / dens(ks,ia,j ) )**2.0_rp &
4659  + ( momy(ks,ia,j) / (dens(ks,ia,j+1)+dens(ks,ia,j)) * 2.0_rp )**2.0_rp ), &
4660  0.01_rp)
4661  enddo
4662  !$omp parallel do
4663  do i = 1, ia-1
4664  uc_urb(i,ja) = max(sqrt( ( momx(ks,i,ja) / (dens(ks,i+1,ja)+dens(ks,i,ja)) * 2.0_rp )**2.0_rp &
4665  + ( momy(ks,i,ja) / dens(ks,i ,ja) )**2.0_rp ), 0.01_rp)
4666  enddo
4667  uc_urb(ia,ja) = max(sqrt( ( momx(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp &
4668  + ( momy(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp ), 0.01_rp)
4669 
4670  call comm_vars8( uc_urb, 1 )
4671  call comm_wait ( uc_urb, 1, .false. )
4672 
4673 
4674 !!$ ! Urban surface temp: interpolate over the ocean
4675 !!$ if ( i_INTRP_URB_SFC_TEMP .ne. i_intrp_off ) then
4676 !!$ select case( i_INTRP_URB_SFC_TEMP )
4677 !!$ case( i_intrp_mask )
4678 !!$ call make_mask( lmask, ust_org, imax, jmax, landdata=.true.)
4679 !!$ !$omp parallel do
4680 !!$ do j = 1, jmax
4681 !!$ do i = 1, imax
4682 !!$ if ( lmask_org(i,j) .ne. UNDEF ) lmask(i,j) = lmask_org(i,j)
4683 !!$ end do
4684 !!$ end do
4685 !!$ case( i_intrp_fill )
4686 !!$ call make_mask( lmask, ust_org, imax, jmax, landdata=.true.)
4687 !!$ case default
4688 !!$ LOG_ERROR("urban_input",*) 'INTRP_URB_SFC_TEMP is invalid.'
4689 !!$ call PRC_abort
4690 !!$ end select
4691 !!$ call interp_OceanLand_data(ust_org, lmask, imax, jmax, .true., intrp_iter_max)
4692 !!$ end if
4693 !!$
4694 !!$ !$omp parallel do
4695 !!$ do j = 1, jmax
4696 !!$ do i = 1, imax
4697 !!$ if ( ust_org(i,j) == UNDEF ) ust_org(i,j) = lst_org(i,j)
4698 !!$ end do
4699 !!$ end do
4700 !!$
4701 !!$ call INTERP_interp2d( itp_nh_l, & ! [IN]
4702 !!$ imax, jmax, & ! [IN]
4703 !!$ IA, JA, & ! [IN]
4704 !!$ igrd (:,:,:), & ! [IN]
4705 !!$ jgrd (:,:,:), & ! [IN]
4706 !!$ hfact (:,:,:), & ! [IN]
4707 !!$ ust_org (:,:), & ! [IN]
4708 !!$ ust (:,:) ) ! [OUT]
4709 !!$ if ( FILTER_NITER > 0 ) then
4710 !!$ call FILTER_hyperdiff( IA, ISB, IEB, JA, JSB, JEB, &
4711 !!$ ust(:,:), FILTER_ORDER, FILTER_NITER )
4712 !!$ call COMM_vars8( ust(:,:), 1 )
4713 !!$ call COMM_wait ( ust(:,:), 1, .false. )
4714 !!$ end if
4715 !!$
4716 !!$ !$omp parallel do
4717 !!$ do j = 1, JA
4718 !!$ do i = 1, IA
4719 !!$ if( abs(lsmask_nest(i,j)-0.0_RP) < EPS ) then ! ocean grid
4720 !!$ ust(i,j) = sst(i,j,nn)
4721 !!$ endif
4722 !!$ enddo
4723 !!$ enddo
4724 !!$
4725 !!$ !$omp parallel do &
4726 !!$ !$omp private(tdiff)
4727 !!$ do j = 1, JA
4728 !!$ do i = 1, IA
4729 !!$ if ( topo(i,j) > 0.0_RP ) then ! ignore UNDEF value
4730 !!$ tdiff = ( TOPOGRAPHY_Zsfc(i,j) - topo(i,j) ) * LAPS
4731 !!$ ust(i,j) = ust(i,j) - tdiff
4732 !!$ end if
4733 !!$ end do
4734 !!$ end do
4735 
4736 
4737  !$omp parallel do
4738  do j = 1, ja
4739  do i = 1, ia
4740  ust(i,j) = lst(i,j)
4741  end do
4742  end do
4743 
4744 
4745  ! copy albedo of land to urban
4746  !$omp parallel do
4747  do j = 1, ja
4748  do i = 1, ia
4749  albu(i,j,:,:) = albg(i,j,:,:)
4750  enddo
4751  enddo
4752 
4753  return
4754  end subroutine urban_input
4755 
4756  !-------------------------------
4757  subroutine make_mask( &
4758  gmask, & ! (out)
4759  data, & ! (in)
4760  nx, & ! (in)
4761  ny, & ! (in)
4762  landdata ) ! (in)
4763  use scale_const, only: &
4764  eps => const_eps, &
4765  undef => const_undef
4766  implicit none
4767  real(RP), intent(out) :: gmask(:,:)
4768  real(RP), intent(in) :: data(:,:)
4769  integer, intent(in) :: nx
4770  integer, intent(in) :: ny
4771  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
4772 
4773  real(RP) :: dd
4774  integer :: i,j
4775 
4776  if( landdata )then
4777  !$omp parallel do
4778  do j = 1, ny
4779  do i = 1, nx
4780  gmask(i,j) = 1.0_rp ! gmask=1 will be skip in "interp_OceanLand_data"
4781  end do
4782  end do
4783  dd = 0.0_rp
4784  else
4785  !$omp parallel do
4786  do j = 1, ny
4787  do i = 1, nx
4788  gmask(i,j) = 0.0_rp ! gmask=0 will be skip in "interp_OceanLand_data"
4789  end do
4790  end do
4791  dd = 1.0_rp
4792  endif
4793 
4794  !$omp parallel do
4795  do j = 1, ny
4796  do i = 1, nx
4797  if( abs(data(i,j) - undef) < sqrt(eps) )then
4798  gmask(i,j) = dd
4799  endif
4800  enddo
4801  enddo
4802 
4803  return
4804  end subroutine make_mask
4805  !-----------------------------------------------------------------------------
4806  subroutine interp_oceanland_data( &
4807  data, &
4808  lsmask, &
4809  nx, &
4810  ny, &
4811  landdata, &
4812  iter_max )
4813  use scale_const, only: &
4814  undef => const_undef, &
4815  eps => const_eps
4816  implicit none
4817 
4818  integer, intent(in) :: nx
4819  integer, intent(in) :: ny
4820  real(RP), intent(inout) :: data (nx,ny)
4821  real(RP), intent(in) :: lsmask(nx,ny)
4822  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
4823  integer, intent(in) :: iter_max
4824 
4825  integer :: mask (nx,ny)
4826  integer :: mask_prev(nx,ny)
4827  real(RP) :: data_prev(nx,ny)
4828  real(RP) :: tmp, cnt, sw
4829  integer :: mask_target
4830 
4831  integer :: num_land, num_ocean, num_replaced
4832  integer :: istr, iend, jstr, jend
4833  integer :: i, j, ii, jj, ite
4834  !---------------------------------------------------------------------------
4835 
4836  log_newline
4837  log_info("interp_OceanLand_data",*) 'Interpolation'
4838 
4839  if ( landdata ) then
4840  log_info("interp_OceanLand_data",*) 'target mask : LAND'
4841  mask_target = 1 ! interpolation for land data
4842  else
4843  log_info("interp_OceanLand_data",*) 'target mask : OCEAN'
4844  mask_target = 0 ! interpolation for ocean data
4845  endif
4846 
4847  ! search target cell for interpolation
4848  num_land = 0
4849  num_ocean = 0
4850  !$omp parallel do &
4851  !$omp reduction(+:num_land,num_ocean)
4852  do j = 1, ny
4853  do i = 1, nx
4854  mask(i,j) = int( 0.5_rp - sign(0.5_rp,abs(lsmask(i,j)-1.0_rp)-eps) ) ! 1 for land, 0 for ocean
4855  num_land = num_land + ( mask(i,j) )
4856  num_ocean = num_ocean + ( 1-mask(i,j) )
4857  enddo
4858  enddo
4859 
4860  log_progress('(1x,A,I3.3,A,2I8)') 'ite=', 0, ', (land,ocean) = ', num_land, num_ocean
4861 
4862  ! start interpolation
4863  do ite = 1, iter_max
4864  ! save previous state
4865  !$omp parallel do
4866  do j = 1, ny
4867  do i = 1, nx
4868  mask_prev(i,j) = mask(i,j)
4869  data_prev(i,j) = data(i,j)
4870  end do
4871  end do
4872  num_replaced = 0
4873 
4874  !$omp parallel do collapse(2) &
4875  !$omp private(istr,iend,jstr,jend,tmp,cnt,sw) &
4876  !$omp reduction(+:num_replaced)
4877  do j = 1, ny
4878  do i = 1, nx
4879 
4880  if( mask(i,j) == mask_target ) cycle ! already filled
4881 
4882  ! collect neighbor grid
4883  istr = max(i-1,1 )
4884  iend = min(i+1,nx)
4885  jstr = max(j-1,1 )
4886  jend = min(j+1,ny)
4887 
4888  tmp = 0.0_rp
4889  cnt = 0.0_rp
4890  do jj = jstr, jend
4891  do ii = istr, iend
4892  sw = 0.5_rp - sign(0.5_rp,real(abs(mask_prev(ii,jj)-mask_target),kind=rp)-eps)
4893 
4894  tmp = tmp + sw * data_prev(ii,jj)
4895  cnt = cnt + sw
4896  enddo
4897  enddo
4898 
4899  if ( cnt >= 3.0_rp ) then ! replace by average of neighbor grid value
4900  data(i,j) = tmp / cnt
4901  mask(i,j) = mask_target
4902 
4903  num_replaced = num_replaced + 1
4904  endif
4905 
4906  enddo
4907  enddo
4908 
4909  if ( landdata ) then
4910  num_land = num_land + num_replaced
4911  num_ocean = num_ocean - num_replaced
4912  else
4913  num_land = num_land - num_replaced
4914  num_ocean = num_ocean + num_replaced
4915  endif
4916 ! LOG_PROGRESS('(1x,A,I3.3,A,3I8,A,I8)') 'ite=', ite, &
4917 ! ', (land,ocean,replaced) = ', num_land, num_ocean, num_replaced, ' / ', nx*ny
4918 
4919  if( num_replaced == 0 ) exit
4920 
4921  enddo ! itelation
4922 
4923  log_progress('(1x,A,I3.3,A,2I8)') 'ite=', ite, ', (land,ocean) = ', num_land, num_ocean
4924 
4925  !$omp parallel do
4926  do j = 1, ny
4927  do i = 1, nx
4928  if ( abs(mask(i,j)-mask_target) > eps ) data(i,j) = undef
4929  end do
4930  end do
4931 
4932 
4933  return
4934  end subroutine interp_oceanland_data
4935 
4936  !-----------------------------------------------------------------------------
4937  subroutine replace_misval_const( data, maskval, frac_land )
4938  use scale_const, only: &
4939  eps => const_eps
4940  implicit none
4941  real(RP), intent(inout) :: data(:,:)
4942  real(RP), intent(in) :: maskval
4943  real(RP), intent(in) :: frac_land(:,:)
4944  integer :: i, j
4945 
4946  !$omp parallel do
4947  do j = 1, ja
4948  do i = 1, ia
4949  if( abs(frac_land(i,j)-0.0_rp) < eps )then ! ocean grid
4950  data(i,j) = maskval
4951  endif
4952  enddo
4953  enddo
4954 
4955  end subroutine replace_misval_const
4956 
4957  !-----------------------------------------------------------------------------
4958  subroutine replace_misval_map( data, maskval, nx, ny, elem)
4959  use scale_const, only: &
4960  eps => const_eps, &
4961  undef => const_undef
4962  implicit none
4963 
4964  real(RP), intent(inout) :: data(:,:)
4965  real(RP), intent(in) :: maskval(:,:)
4966  integer, intent(in) :: nx, ny
4967  character(len=*), intent(in) :: elem
4968 
4969  integer :: i, j
4970  logical :: error
4971 
4972  error = .false.
4973  !$omp parallel do
4974  do j = 1, ny
4975  if ( error ) cycle
4976  do i = 1, nx
4977  if( abs(data(i,j) - undef) < sqrt(eps) )then
4978  if( abs(maskval(i,j) - undef) < sqrt(eps) )then
4979  log_error("replace_misval_map",*) "data for mask of "//trim(elem)//"(",i,",",j,") includes missing value."
4980  error = .true.
4981  exit
4982  else
4983  data(i,j) = maskval(i,j)
4984  endif
4985  endif
4986  enddo
4987  enddo
4988 
4989  if ( error ) then
4990  log_error_cont(*) "Please check input data of SKINTEMP or SST. "
4991  call prc_abort
4992  end if
4993 
4994  return
4995  end subroutine replace_misval_map
4996 
4997  subroutine get_ijrange( &
4998  IS_org, IE_org, JS_org, JE_org, &
4999  IA_org, JA_org, &
5000  LON_min, LON_max, LAT_min, LAT_max, &
5001  LON_all, LAT_all )
5002  use scale_const, only: &
5003  eps => const_eps
5004  use scale_atmos_grid_cartesc_real, only: &
5005  atmos_grid_cartesc_real_lon, &
5006  atmos_grid_cartesc_real_lat
5007  integer, intent(out) :: IS_org
5008  integer, intent(out) :: IE_org
5009  integer, intent(out) :: JS_org
5010  integer, intent(out) :: JE_org
5011 
5012  integer, intent(in) :: IA_org
5013  integer, intent(in) :: JA_org
5014  real(RP), intent(in) :: LON_min, LON_max
5015  real(RP), intent(in) :: LAT_min, LAT_max
5016  real(RP), intent(in) :: LON_all(IA_org,JA_org)
5017  real(RP), intent(in) :: LAT_all(IA_org,JA_org)
5018 
5019  real(RP) :: min, max
5020 
5021  logical :: LON_mask(IA_org)
5022  logical :: LAT_mask(JA_org)
5023 
5024  integer :: i, j
5025 
5026  if ( lon_min < minval( lon_all ) .or. lon_max > maxval( lon_all ) ) then
5027  ! probably global (cyclic) data
5028  is_org = 1
5029  ie_org = ia_org
5030  else
5031  min = maxval( minval( lon_all(:,:), dim=2 ), mask=all( lon_all(:,:) < lon_min, dim=2 ) )
5032  max = minval( maxval( lon_all(:,:), dim=2 ), mask=all( lon_all(:,:) > lon_max, dim=2 ) )
5033  lon_mask(:) = any( lon_all(:,:) - min > -eps, dim=2 ) .AND. any( lon_all(:,:) - max < eps, dim=2 )
5034  do i = 1, ia_org
5035  if( lon_mask(i) ) then
5036  is_org = i
5037  exit
5038  endif
5039  end do
5040  do i = ia_org, 1, -1
5041  if( lon_mask(i) ) then
5042  ie_org = i
5043  exit
5044  endif
5045  end do
5046  end if
5047 
5048  if ( lat_min < minval( lat_all ) .or. lat_max > maxval( lat_all ) ) then
5049  ! unexpected
5050  ! INTERP_domain_compatibility should been called
5051  log_error("get_IJrange",*) "unexpected error", lat_min, lat_max, minval( lat_all ), maxval( lat_all )
5052  call prc_abort
5053  end if
5054  min = maxval( minval( lat_all(:,:), dim=1 ), mask=all( lat_all(:,:) < lat_min, dim=1 ) )
5055  max = minval( maxval( lat_all(:,:), dim=1 ), mask=all( lat_all(:,:) > lat_max, dim=1 ) )
5056  lat_mask(:) = any( lat_all(:,:) - min > -eps, dim=1 ) .AND. any( lat_all(:,:) - max < eps, dim=1 )
5057  do j = 1, ja_org
5058  if( lat_mask(j) ) then
5059  js_org = j
5060  exit
5061  endif
5062  end do
5063  do j = ja_org, 1, -1
5064  if( lat_mask(j) ) then
5065  je_org = j
5066  exit
5067  endif
5068  end do
5069 
5070  return
5071  end subroutine get_ijrange
5072 
5073 end module mod_realinput
mod_atmos_phy_sf_vars::atmos_phy_sf_sfc_z0m
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0m
Definition: mod_atmos_phy_sf_vars.F90:67
scale_interp::interp_interp2d
subroutine, public interp_interp2d(npoints, IA_ref, JA_ref, IA, JA, idx_i, idx_j, hfact, val_ref, val, threshold_undef, wsum, val2)
Definition: scale_interp.F90:1376
scale_const::const_grav
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:49
scale_comm_cartesc_nest::comm_cartesc_nest_interp_level
integer, public comm_cartesc_nest_interp_level
horizontal interpolation level
Definition: scale_comm_cartesC_nest.F90:76
mod_realinput_netcdf::parentoceanopennetcdf
subroutine, public parentoceanopennetcdf(basename_org, basename_num)
Ocean Open.
Definition: mod_realinput_netcdf.F90:2177
scale_atmos_grid_cartesc_index::isb
integer, public isb
Definition: scale_atmos_grid_cartesC_index.F90:64
scale_cpl_sfc_index::n_rad_dir
integer, parameter, public n_rad_dir
Definition: scale_cpl_sfc_index.F90:36
mod_atmos_phy_mp_vars
module Atmosphere / Physics Cloud Microphysics
Definition: mod_atmos_phy_mp_vars.F90:12
mod_ocean_vars::ocean_ocn_z0m
real(rp), dimension(:,:), allocatable, public ocean_ocn_z0m
surface roughness length for momentum, open ocean [m]
Definition: mod_ocean_vars.F90:66
mod_realinput_netcdf::parentlandopennetcdf
subroutine, public parentlandopennetcdf(basename_org, basename_num)
Land Open.
Definition: mod_realinput_netcdf.F90:1662
scale_landuse::landuse_fact_ocean
real(rp), dimension(:,:), allocatable, public landuse_fact_ocean
ocean factor
Definition: scale_landuse.F90:45
mod_land_vars::land_temp
real(rp), dimension(:,:,:), allocatable, public land_temp
temperature of each soil layer [K]
Definition: mod_land_vars.F90:62
scale_comm_cartesc::comm_datatype
integer, public comm_datatype
datatype of variable
Definition: scale_comm_cartesC.F90:105
mod_urban_admin::urban_do
logical, public urban_do
Definition: mod_urban_admin.F90:32
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
mod_realinput::inetcdf
integer, parameter, public inetcdf
Definition: mod_realinput.F90:77
mod_urban_vars::urban_sfc_temp
real(rp), dimension(:,:), allocatable, public urban_sfc_temp
Definition: mod_urban_vars.F90:75
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_cpl_sfc_index::i_r_direct
integer, parameter, public i_r_direct
Definition: scale_cpl_sfc_index.F90:37
mod_ocean_vars::ocean_ice_temp
real(rp), dimension(:,:), allocatable, public ocean_ice_temp
sea ice temperature [K]
Definition: mod_ocean_vars.F90:74
mod_realinput::urban_input
subroutine urban_input(lst, albg, DENS, MOMX, MOMY, RHOT, QTRC, tc_urb, qc_urb, uc_urb, ust, albu)
Definition: mod_realinput.F90:4596
scale_const::const_epstvap
real(rp), public const_epstvap
1 / epsilon - 1
Definition: scale_const.F90:76
mod_realinput_netcdf::parentoceanfinalizenetcdf
subroutine, public parentoceanfinalizenetcdf
Ocean Finalize.
Definition: mod_realinput_netcdf.F90:2218
mod_realinput_netcdf::parentlandfinalizenetcdf
subroutine, public parentlandfinalizenetcdf
Land Finalize.
Definition: mod_realinput_netcdf.F90:1703
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:35
mod_urban_vars::urban_tb
real(rp), dimension(:,:), allocatable, public urban_tb
Definition: mod_urban_vars.F90:65
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_cz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
Definition: scale_atmos_grid_cartesC_real.F90:39
scale_index
module Index
Definition: scale_index.F90:11
mod_ocean_vars::ocean_sfc_z0e
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0e
ocean surface roughness length for vapor [m]
Definition: mod_ocean_vars.F90:72
scale_ocean_phy_ice_simple
module ocean / physics / ice / simple
Definition: scale_ocean_phy_ice_simple.F90:12
scale_tracer::tracer_mass
real(rp), dimension(qa_max), public tracer_mass
Definition: scale_tracer.F90:47
scale_file_cartesc::file_cartesc_enddef
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
Definition: scale_file_cartesC.F90:964
mod_atmos_phy_sf_vars::atmos_phy_sf_sfc_z0e
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0e
Definition: mod_atmos_phy_sf_vars.F90:69
scale_file_cartesc::file_cartesc_def_var
subroutine, public file_cartesc_def_var(fid, varname, desc, unit, dim_type, datatype, vid, standard_name, timeintv, nsteps, cell_measures)
Define a variable to file.
Definition: scale_file_cartesC.F90:3360
scale_const::const_epsvap
real(rp), public const_epsvap
Rdry / Rvap.
Definition: scale_const.F90:75
mod_land_vars::land_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public land_sfc_albedo
land surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
Definition: mod_land_vars.F90:66
scale_cpl_sfc_index::i_r_diffuse
integer, parameter, public i_r_diffuse
Definition: scale_cpl_sfc_index.F90:38
mod_realinput_netcdf::parentlandinputnetcdf
subroutine, public parentlandinputnetcdf(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tg_org, strg_org, lst_org, ust_org, albg_org, topo_org, lmask_org, lz_org, use_file_landwater, ldims, it)
Definition: mod_realinput_netcdf.F90:1737
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
mod_ocean_vars::ice_flag
logical, public ice_flag
Definition: mod_ocean_vars.F90:142
mod_atmos_admin
module ATMOS admin
Definition: mod_atmos_admin.F90:11
mod_urban_vars::urban_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public urban_sfc_albedo
Definition: mod_urban_vars.F90:76
mod_realinput_grads::parentoceansetupgrads
subroutine, public parentoceansetupgrads(odims, timelen, lon_all, lat_all, basename, basename_num)
Ocean Setup.
Definition: mod_realinput_grads.F90:965
mod_atmos_phy_mp_vars::qs_mp
integer, public qs_mp
Definition: mod_atmos_phy_mp_vars.F90:79
scale_comm_cartesc_nest
module Communication CartesianC nesting
Definition: scale_comm_cartesC_nest.F90:12
scale_interp
module INTERPOLATION
Definition: scale_interp.F90:12
scale_land_grid_cartesc_index::lkmax
integer, public lkmax
Definition: scale_land_grid_cartesC_index.F90:32
mod_land_vars::land_water
real(rp), dimension(:,:,:), allocatable, public land_water
moisture of each soil layer [m3/m3]
Definition: mod_land_vars.F90:63
scale_cpl_sfc_index::i_r_ir
integer, parameter, public i_r_ir
Definition: scale_cpl_sfc_index.F90:29
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_prof::prof_rapstart
subroutine, public prof_rapstart(rapname_base, level, disable_barrier)
Start raptime.
Definition: scale_prof.F90:174
scale_atmos_grid_cartesc_metric
module Atmosphere Grid CartesianC metirc
Definition: scale_atmos_grid_cartesC_metric.F90:12
mod_realinput_grads::parentlandinputgrads
subroutine, public parentlandinputgrads(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tg_org, strg_org, smds_org, lst_org, lz_org, topo_org, lmask_org, use_waterratio, ldims, basename_num, use_file_landwater, nt)
Definition: mod_realinput_grads.F90:790
mod_urban_vars::urban_trl
real(rp), dimension(:,:,:), allocatable, public urban_trl
Definition: mod_urban_vars.F90:61
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
mod_realinput_netcdf::parentatmosinputnetcdf
subroutine, public parentatmosinputnetcdf(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, QA, cz_org, w_org, u_org, v_org, pres_org, dens_org, temp_org, pt_org, qtrc_org, qv_org, rh_org, qhyd_org, qnum_org, nopres, nodens, uvmet, temp2pt, rh2qv, qnum_flag, same_mp_type, sfc_diagnoses, update_coord, dims, it)
Definition: mod_realinput_netcdf.F90:727
mod_atmos_phy_sf_vars
module ATMOSPHERIC Surface Variables
Definition: mod_atmos_phy_sf_vars.F90:12
scale_ocean_grid_cartesc_index::okmax
integer, public okmax
Definition: scale_ocean_grid_cartesC_index.F90:32
mod_urban_vars::urban_raing
real(rp), dimension(:,:), allocatable, public urban_raing
Definition: mod_urban_vars.F90:72
scale_topography
module TOPOGRAPHY
Definition: scale_topography.F90:11
mod_urban_vars::urban_qc
real(rp), dimension(:,:), allocatable, public urban_qc
Definition: mod_urban_vars.F90:68
mod_ocean_vars::ocean_sfc_z0m
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0m
ocean surface roughness length for momentum [m]
Definition: mod_ocean_vars.F90:70
scale_atmos_hydrometeor::atmos_hydrometeor_dry
logical, public atmos_hydrometeor_dry
Definition: scale_atmos_hydrometeor.F90:114
scale_urban_grid_cartesc_index
module urban / grid / icosahedralA / index
Definition: scale_urban_grid_cartesC_index.F90:11
mod_atmos_vars::rhot
real(rp), dimension(:,:,:), allocatable, target, public rhot
Definition: mod_atmos_vars.F90:80
mod_atmos_phy_sf_vars::atmos_phy_sf_sfc_z0h
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0h
Definition: mod_atmos_phy_sf_vars.F90:68
scale_atmos_grid_cartesc_real
module Atmosphere GRID CartesC Real(real space)
Definition: scale_atmos_grid_cartesC_real.F90:11
mod_atmos_phy_sf_vars::atmos_phy_sf_sfc_temp
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_temp
Definition: mod_atmos_phy_sf_vars.F90:65
mod_atmos_vars::qtrc
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
Definition: mod_atmos_vars.F90:81
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lon
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lon
longitude [rad,0-2pi]
Definition: scale_atmos_grid_cartesC_real.F90:49
scale_land_grid_cartesc_index
module land / grid / cartesianC / index
Definition: scale_land_grid_cartesC_index.F90:11
scale_atmos_grid_cartesc_index::jeb
integer, public jeb
Definition: scale_atmos_grid_cartesC_index.F90:67
scale_const::const_i_sw
integer, public const_i_sw
short-wave radiation index
Definition: scale_const.F90:108
mod_atmos_phy_mp_driver
module atmosphere / physics / cloud microphysics
Definition: mod_atmos_phy_mp_driver.F90:12
scale_const::const_cpvap
real(rp), parameter, public const_cpvap
specific heat (water vapor, constant pressure) [J/kg/K]
Definition: scale_const.F90:69
scale_urban_grid_cartesc_index::ukmax
integer, public ukmax
Definition: scale_urban_grid_cartesC_index.F90:32
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_atmos_hydrometeor::qle
integer, public qle
Definition: scale_atmos_hydrometeor.F90:137
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_mapprojection
module Map projection
Definition: scale_mapprojection.F90:12
scale_io
module STDIO
Definition: scale_io.F90:10
mod_realinput::realinput_surface
subroutine, public realinput_surface
Definition: mod_realinput.F90:499
mod_atmos_vars::dens
real(rp), dimension(:,:,:), allocatable, target, public dens
Definition: mod_atmos_vars.F90:76
scale_interp::interp_domain_compatibility
subroutine, public interp_domain_compatibility(lon_org, lat_org, topc_org, lon_loc, lat_loc, topc_loc, topf_loc, skip_x, skip_y, skip_z)
Definition: scale_interp.F90:150
scale_cpl_sfc_index::i_r_nir
integer, parameter, public i_r_nir
Definition: scale_cpl_sfc_index.F90:30
mod_ocean_vars::ocean_sfc_z0h
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0h
ocean surface roughness length for heat [m]
Definition: mod_ocean_vars.F90:71
mod_ocean_admin
module Ocean admin
Definition: mod_ocean_admin.F90:11
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:45
scale_atmos_grid_cartesc_index
module atmosphere / grid / cartesC index
Definition: scale_atmos_grid_cartesC_index.F90:12
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
mod_ocean_vars::ocean_uvel
real(rp), dimension(:,:,:), allocatable, public ocean_uvel
ocean zonal velocity [m/s]
Definition: mod_ocean_vars.F90:63
mod_land_admin
module Land admin
Definition: mod_land_admin.F90:11
mod_atmos_phy_sf_vars::atmos_phy_sf_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_sf_sfc_albedo
Definition: mod_atmos_phy_sf_vars.F90:66
scale_landuse::landuse_frac_land
real(rp), dimension(:,:), allocatable, public landuse_frac_land
land fraction
Definition: scale_landuse.F90:55
mod_atmos_vars::momz
real(rp), dimension(:,:,:), allocatable, target, public momz
Definition: mod_atmos_vars.F90:77
mod_realinput::replace_misval_const
subroutine replace_misval_const(data, maskval, frac_land)
Definition: mod_realinput.F90:4938
mod_urban_vars::urban_tgl
real(rp), dimension(:,:,:), allocatable, public urban_tgl
Definition: mod_urban_vars.F90:63
scale_landuse::landuse_index_pft
integer, dimension(:,:,:), allocatable, public landuse_index_pft
index of PFT for each mosaic
Definition: scale_landuse.F90:68
mod_realinput::igrads
integer, parameter, public igrads
Definition: mod_realinput.F90:78
scale_tracer::tracer_cv
real(rp), dimension(qa_max), public tracer_cv
Definition: scale_tracer.F90:42
mod_realinput::ocean_interporation
subroutine ocean_interporation(imax, jmax, sst_org, tw_org, albw_org, z0w_org, CX, CY, elevation_correction_ocean, init_ocean_alb_lw, init_ocean_alb_sw, init_ocean_z0w, first_surface, sst, tw, albw, z0w)
Definition: mod_realinput.F90:4380
mod_land_vars
module LAND Variables
Definition: mod_land_vars.F90:11
mod_realinput_netcdf::parentatmossetupnetcdf
subroutine, public parentatmossetupnetcdf(dims, timelen, mixing_ratio, update_coord, mapping_info, qtrc_flag, lon_all, lat_all, basename_org, basename_num, same_mp_type, pt_dry, serial, do_read)
Atmos Setup.
Definition: mod_realinput_netcdf.F90:150
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:60
scale_landuse::landuse_pft_nmax
integer, public landuse_pft_nmax
number of plant functional type(PFT)
Definition: scale_landuse.F90:64
scale_ocean_phy_ice_simple::ocean_phy_ice_freezetemp
real(rp), public ocean_phy_ice_freezetemp
Definition: scale_ocean_phy_ice_simple.F90:44
mod_realinput::replace_misval_map
subroutine replace_misval_map(data, maskval, nx, ny, elem)
Definition: mod_realinput.F90:4959
scale_tracer::tracer_name
character(len=h_short), dimension(qa_max), public tracer_name
Definition: scale_tracer.F90:39
scale_prof
module profiler
Definition: scale_prof.F90:11
mod_realinput::make_mask
subroutine make_mask(gmask, data, nx, ny, landdata)
Definition: mod_realinput.F90:4763
mod_atmos_vars::momx
real(rp), dimension(:,:,:), allocatable, target, public momx
Definition: mod_atmos_vars.F90:78
mod_ocean_vars
module OCEAN Variables
Definition: mod_ocean_vars.F90:12
mod_realinput_grads::parentatmossetupgrads
subroutine, public parentatmossetupgrads(dims, timelen, qtrc_flag, LON_all, LAT_all, basename_org, basename_num)
Atmos Setup.
Definition: mod_realinput_grads.F90:62
scale_ocean_grid_cartesc_index
module ocean / grid / cartesianC / index
Definition: scale_ocean_grid_cartesC_index.F90:11
scale_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
mod_atmos_vars::momy
real(rp), dimension(:,:,:), allocatable, target, public momy
Definition: mod_atmos_vars.F90:79
scale_time
module TIME
Definition: scale_time.F90:11
scale_interp::interp_interp3d
subroutine, public interp_interp3d(npoints, KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, idx_i, idx_j, hfact, idx_k, vfact, hgt_ref, hgt, val_ref, val, spline, logwgt, threshold_undef, wsum, val2)
Definition: scale_interp.F90:1469
scale_const::const_pi
real(rp), parameter, public const_pi
pi
Definition: scale_const.F90:32
scale_const::const_i_lw
integer, public const_i_lw
long-wave radiation index
Definition: scale_const.F90:107
scale_land_grid_cartesc::land_grid_cartesc_cz
real(rp), dimension(:), allocatable, public land_grid_cartesc_cz
center coordinate [m]: z, local=global
Definition: scale_land_grid_cartesC.F90:35
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
scale_comm_cartesc::comm_world
integer, public comm_world
communication world ID
Definition: scale_comm_cartesC.F90:106
mod_urban_vars::urban_tc
real(rp), dimension(:,:), allocatable, public urban_tc
Definition: mod_urban_vars.F90:67
mod_urban_vars::urban_tg
real(rp), dimension(:,:), allocatable, public urban_tg
Definition: mod_urban_vars.F90:66
scale_atmos_hydrometeor::i_qv
integer, public i_qv
Definition: scale_atmos_hydrometeor.F90:93
mod_land_vars::convert_ws2vwc
real(rp) function, dimension(lia, lja), public convert_ws2vwc(WS, critical)
conversion from water saturation [fraction] to volumetric water content [m3/m3]
Definition: mod_land_vars.F90:1422
mod_urban_vars::urban_uc
real(rp), dimension(:,:), allocatable, public urban_uc
Definition: mod_urban_vars.F90:69
mod_realinput_netcdf::parentoceansetupnetcdf
subroutine, public parentoceansetupnetcdf(odims, timelen, lon_all, lat_all, basename_org, basename_num, serial, do_read)
Ocean Setup.
Definition: mod_realinput_netcdf.F90:1906
mod_realinput::realinput_atmos
subroutine, public realinput_atmos
Definition: mod_realinput.F90:205
scale_landuse::landuse_fact_land
real(rp), dimension(:,:), allocatable, public landuse_fact_land
land factor
Definition: scale_landuse.F90:46
mod_realinput
module REAL input
Definition: mod_realinput.F90:11
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
mod_realinput_grads
module REAL input GrADS
Definition: mod_realinput_grads.F90:11
scale_topography::topography_zsfc
real(rp), dimension(:,:), allocatable, public topography_zsfc
absolute ground height [m]
Definition: scale_topography.F90:39
mod_land_vars::land_sfc_temp
real(rp), dimension(:,:), allocatable, public land_sfc_temp
land surface skin temperature [K]
Definition: mod_land_vars.F90:65
mod_realinput_grads::parentlandsetupgrads
subroutine, public parentlandsetupgrads(ldims, timelen, lon_all, lat_all, basename, basename_num)
Land Setup.
Definition: mod_realinput_grads.F90:645
scale_tracer::tracer_cp
real(rp), dimension(qa_max), public tracer_cp
Definition: scale_tracer.F90:43
mod_ocean_admin::ocean_do
logical, public ocean_do
Definition: mod_ocean_admin.F90:32
mod_ocean_vars::ocean_ice_mass
real(rp), dimension(:,:), allocatable, public ocean_ice_mass
sea ice mass [kg]
Definition: mod_ocean_vars.F90:75
scale_const::const_tem00
real(rp), parameter, public const_tem00
temperature reference (0C) [K]
Definition: scale_const.F90:99
scale_atmos_hydrostatic
module atmosphere / hydrostatic barance
Definition: scale_atmos_hydrostatic.F90:12
scale_file_cartesc::file_cartesc_create
subroutine, public file_cartesc_create(basename, title, datatype, fid, date, subsec, haszcoord, append, aggregate, single)
Create/open a netCDF file.
Definition: scale_file_cartesC.F90:796
mod_ocean_vars::ocean_vvel
real(rp), dimension(:,:,:), allocatable, public ocean_vvel
ocean meridional velocity [m/s]
Definition: mod_ocean_vars.F90:64
scale_time::time_gettimelabel
subroutine, public time_gettimelabel(timelabel)
generate time label
Definition: scale_time.F90:93
scale_comm_cartesc
module COMMUNICATION
Definition: scale_comm_cartesC.F90:11
mod_atmos_vars
module ATMOSPHERIC Variables
Definition: mod_atmos_vars.F90:12
scale_cpl_sfc_index
module coupler / surface-atmospehre
Definition: scale_cpl_sfc_index.F90:11
mod_realinput::land_interporation
subroutine land_interporation(kmax, imax, jmax, oimax, ojmax, tg, strg, lst, albg, tg_org, strg_org, smds_org, lst_org, albg_org, sst_org, lmask_org, lsmask_nest, topo_org, lz_org, llon_org, llat_org, LCZ, CX, CY, LON, LAT, maskval_tg, maskval_strg, init_landwater_ratio, use_file_landwater, use_waterratio, soilwater_ds2vc_flag, elevation_correction, intrp_iter_max, ol_interp)
Definition: mod_realinput.F90:3796
scale_tracer::tracer_r
real(rp), dimension(qa_max), public tracer_r
Definition: scale_tracer.F90:44
scale_mapprojection::mapprojection_get_param
subroutine, public mapprojection_get_param(info, param)
Definition: scale_mapprojection.F90:337
mod_land_admin::land_do
logical, public land_do
Definition: mod_land_admin.F90:41
scale_time::time_nowdate
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:68
mod_urban_vars::urban_rainb
real(rp), dimension(:,:), allocatable, public urban_rainb
Definition: mod_urban_vars.F90:71
scale_cpl_sfc_index::i_r_vis
integer, parameter, public i_r_vis
Definition: scale_cpl_sfc_index.F90:31
scale_atmos_grid_cartesc::atmos_grid_cartesc_cy
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cy
center coordinate [m]: y, local
Definition: scale_atmos_grid_cartesC.F90:57
mod_ocean_vars::ocean_sfc_albedo
real(rp), dimension(:,:,:,:), allocatable, public ocean_sfc_albedo
ocean surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
Definition: mod_ocean_vars.F90:69
mod_realinput_grads::parentoceaninputgrads
subroutine, public parentoceaninputgrads(IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tw_org, sst_org, omask_org, basename_num, odims, nt)
Definition: mod_realinput_grads.F90:1154
mod_realinput_netcdf
module REAL input netCDF
Definition: mod_realinput_netcdf.F90:11
mod_urban_vars::urban_tr
real(rp), dimension(:,:), allocatable, public urban_tr
Definition: mod_urban_vars.F90:64
mod_ocean_vars::ocean_sfc_temp
real(rp), dimension(:,:), allocatable, public ocean_sfc_temp
ocean surface skin temperature [K]
Definition: mod_ocean_vars.F90:68
scale_atmos_grid_cartesc_index::ieb
integer, public ieb
Definition: scale_atmos_grid_cartesC_index.F90:65
mod_realinput_netcdf::parentatmosfinalizenetcdf
subroutine, public parentatmosfinalizenetcdf
Atmos Finalize.
Definition: mod_realinput_netcdf.F90:684
scale_filter
module FILTER
Definition: scale_filter.F90:11
mod_realinput::get_ijrange
subroutine get_ijrange(IS_org, IE_org, JS_org, JE_org, IA_org, JA_org, LON_min, LON_max, LAT_min, LAT_max, LON_all, LAT_all)
Definition: mod_realinput.F90:5002
mod_atmos_admin::atmos_phy_mp_type
character(len=h_short), public atmos_phy_mp_type
Definition: mod_atmos_admin.F90:36
scale_atmos_thermodyn
module atmosphere / thermodyn
Definition: scale_atmos_thermodyn.F90:11
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
mod_urban_vars::urban_roff
real(rp), dimension(:,:), allocatable, public urban_roff
Definition: mod_urban_vars.F90:92
scale_prof::prof_rapend
subroutine, public prof_rapend(rapname_base, level, disable_barrier)
Save raptime.
Definition: scale_prof.F90:246
mod_realinput_netcdf::parentlandsetupnetcdf
subroutine, public parentlandsetupnetcdf(ldims, timelen, lon_all, lat_all, basename_org, basename_num, use_file_landwater, serial, do_read)
Land Setup.
Definition: mod_realinput_netcdf.F90:1375
mod_atmos_phy_mp_vars::qe_mp
integer, public qe_mp
Definition: mod_atmos_phy_mp_vars.F90:80
mod_realinput_grads::parentatmosinputgrads
subroutine, public parentatmosinputgrads(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, QA, w_org, u_org, v_org, pres_org, dens_org, pt_org, temp_org, qv_org, rh_org, qhyd_org, qtrc_org, cz_org, nopres, nodens, temp2pt, rh2qv, basename_num, sfc_diagnoses, nt)
Definition: mod_realinput_grads.F90:170
scale_const::const_laps
real(rp), public const_laps
lapse rate of ISA [K/m]
Definition: scale_const.F90:62
scale_landuse::landuse_fact_urban
real(rp), dimension(:,:), allocatable, public landuse_fact_urban
urban factor
Definition: scale_landuse.F90:47
scale_land_grid_cartesc
module land / grid / cartesianC
Definition: scale_land_grid_cartesC.F90:11
scale_land_grid_cartesc_index::lke
integer, public lke
Definition: scale_land_grid_cartesC_index.F90:39
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_lat
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lat
latitude [rad,-pi,pi]
Definition: scale_atmos_grid_cartesC_real.F90:53
scale_atmos_grid_cartesc_real::atmos_grid_cartesc_real_fz
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
Definition: scale_atmos_grid_cartesC_real.F90:43
mod_ocean_vars::ocean_salt
real(rp), dimension(:,:,:), allocatable, public ocean_salt
ocean salinity [PSU]
Definition: mod_ocean_vars.F90:62
mod_urban_vars::urban_tbl
real(rp), dimension(:,:,:), allocatable, public urban_tbl
Definition: mod_urban_vars.F90:62
scale_atmos_grid_cartesc
module atmosphere / grid / cartesC
Definition: scale_atmos_grid_cartesC.F90:12
scale_landuse
module LANDUSE
Definition: scale_landuse.F90:19
mod_urban_admin
module Urban admin
Definition: mod_urban_admin.F90:11
scale_cpl_sfc_index::n_rad_rgn
integer, parameter, public n_rad_rgn
Definition: scale_cpl_sfc_index.F90:28
mod_land_vars::land_ice
real(rp), dimension(:,:,:), allocatable, public land_ice
ice of each soil layer [m3/m3]
Definition: mod_land_vars.F90:64
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_atmos_hydrometeor::qls
integer, public qls
Definition: scale_atmos_hydrometeor.F90:136
scale_atmos_grid_cartesc_index::jsb
integer, public jsb
Definition: scale_atmos_grid_cartesC_index.F90:66
scale_atmos_saturation
module atmosphere / saturation
Definition: scale_atmos_saturation.F90:12
mod_atmos_phy_mp_driver::atmos_phy_mp_driver_qhyd2qtrc
subroutine, public atmos_phy_mp_driver_qhyd2qtrc(KA, KS, KE, IA, IS, IE, JA, JS, JE, QV, QHYD, QTRC, QNUM)
Definition: mod_atmos_phy_mp_driver.F90:1553
mod_urban_vars::urban_rainr
real(rp), dimension(:,:), allocatable, public urban_rainr
Definition: mod_urban_vars.F90:70
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:97
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_mapprojection::mappingparam
Definition: scale_mapprojection.F90:106
scale_land_grid_cartesc_index::lks
integer, public lks
Definition: scale_land_grid_cartesC_index.F90:38
scale_file_cartesc
module file / cartesianC
Definition: scale_file_cartesC.F90:11
scale_atmos_hydrometeor::n_hyd
integer, parameter, public n_hyd
Definition: scale_atmos_hydrometeor.F90:95
mod_urban_vars
module URBAN Variables
Definition: mod_urban_vars.F90:12
mod_realinput_netcdf::parentoceaninputnetcdf
subroutine, public parentoceaninputnetcdf(IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tw_org, sst_org, albw_org, z0w_org, omask_org, odims, it)
Definition: mod_realinput_netcdf.F90:2246
scale_atmos_grid_cartesc::atmos_grid_cartesc_cx
real(rp), dimension(:), allocatable, public atmos_grid_cartesc_cx
center coordinate [m]: x, local
Definition: scale_atmos_grid_cartesC.F90:56
scale_mapprojection::mappinginfo
Definition: scale_mapprojection.F90:93
scale_prc::prc_ismaster
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:92
mod_realinput_netcdf::parentatmosopennetcdf
subroutine, public parentatmosopennetcdf(basename_org, basename_num)
Atmos Open.
Definition: mod_realinput_netcdf.F90:642
mod_ocean_vars::ocean_temp
real(rp), dimension(:,:,:), allocatable, public ocean_temp
ocean temperature [K]
Definition: mod_ocean_vars.F90:61
scale_land_grid_cartesc_index::lka
integer, public lka
Definition: scale_land_grid_cartesC_index.F90:37
scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_rotc
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_metric_rotc
rotation coefficient
Definition: scale_atmos_grid_cartesC_metric.F90:36
scale_ocean_grid_cartesc_index::oks
integer, public oks
Definition: scale_ocean_grid_cartesC_index.F90:38
Generated by   doxygen 1.8.17