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 ( rh2qv ) then
1644  if ( .not. temp2pt ) then
1645  log_error("ParentAtmosInput",*) 'When RH is read, TEMP is necessary'
1646  call prc_abort()
1647  end if
1648 
1649  if ( sfc_diagnoses ) then
1650  k0 = 2
1651  else
1652  k0 = 3
1653  end if
1654  !$omp parallel do collapse(2) &
1655  !$omp private(p_sat,qm)
1656  do j = 1, ja_org
1657  do i = 1, ia_org
1658  do k = k0, ka_org
1659  if ( temp_org(k,i,j) > undef .and. rh_org(k,i,j) > undef .and. pres_org(k,i,j) > undef ) then
1660  call psat( temp_org(k,i,j), p_sat )
1661  qm = epsvap * rh_org(k,i,j) * 0.01_rp * p_sat &
1662  / ( pres_org(k,i,j) - rh_org(k,i,j) * 0.01_rp * p_sat )
1663  qv_org(k,i,j) = qm / ( 1.0_rp + qm ) ! specific humidity
1664  else
1665  qv_org(k,i,j) = undef
1666  end if
1667  end do
1668  end do
1669  end do
1670 #ifdef QUICKDEBUG
1671  !$omp parallel do collapse(2)
1672  do j = 1, ja_org
1673  do i = 1, ia_org
1674  do k = 1, k0-1
1675  qv_org(k,i,j) = undef
1676  end do
1677  end do
1678  end do
1679 #endif
1680  end if
1681 
1682 
1683  select case( upper_qv_type )
1684  case("COPY")
1685  !$omp parallel do collapse(2)
1686  do j = 1, ja_org
1687  do i = 1, ia_org
1688  do k = 4, ka_org
1689  if ( qv_org(k,i,j) == undef ) qv_org(k,i,j) = qv_org(k-1,i,j)
1690  enddo
1691  enddo
1692  enddo
1693  case("ZERO")
1694  !$omp parallel do collapse(2)
1695  do j = 1, ja_org
1696  do i = 1, ia_org
1697  do k = 4, ka_org
1698  if ( qv_org(k,i,j) == undef ) qv_org(k,i,j) = 0.0_rp
1699  enddo
1700  enddo
1701  enddo
1702  case default
1703  log_error("ParentAtmosInput",*) 'upper_qv_type in PARAM_MKINIT_REAL is invalid! ', trim(upper_qv_type)
1704  call prc_abort
1705  end select
1706 
1707  if ( mixing_ratio ) then
1708  !$omp parallel do collapse(2) &
1709  !$omp private(qtot)
1710  do j = 1, ja_org
1711  do i = 1, ia_org
1712  do k = 1, ka_org
1713  qtot = 0.0_rp
1714  if ( qv_org(k,i,j) > undef ) then
1715  qtot = qtot + qv_org(k,i,j)
1716  end if
1717  do iq = 1, n_hyd
1718  if ( qhyd_org(k,i,j,iq) > undef ) then
1719  qtot = qtot + qhyd_org(k,i,j,iq)
1720  end if
1721  end do
1722  if( qv_org(k,i,j) > undef ) then
1723  qv_org(k,i,j) = qv_org(k,i,j) / ( 1.0_rp + qtot )
1724  else
1725  qv_org(k,i,j) = 0.0_rp
1726  end if
1727  do iq = 1, n_hyd
1728  if ( qhyd_org(k,i,j,iq) > undef ) then
1729  qhyd_org(k,i,j,iq) = qhyd_org(k,i,j,iq) / ( 1.0_rp + qtot )
1730  else
1731  qhyd_org(k,i,j,iq) = 0.0_rp
1732  end if
1733  end do
1734  end do
1735  end do
1736  end do
1737  end if
1738 
1739 
1740  if ( .not. same_mptype_ ) then
1741  if ( qnum_flag ) then
1742  call atmos_phy_mp_driver_qhyd2qtrc( ka_org, 2, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, &
1743  qv_org(:,:,:), qhyd_org(:,:,:,:), & ! [IN]
1744  qtrc_org(:,:,:,qs_mp:qe_mp), & ! [OUT]
1745  qnum=qnum_org(:,:,:,:) ) ! [IN]
1746  else
1747  call atmos_phy_mp_driver_qhyd2qtrc( ka_org, 2, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, &
1748  qv_org(:,:,:), qhyd_org(:,:,:,:), & ! [IN]
1749  qtrc_org(:,:,:,qs_mp:qe_mp) ) ! [OUT]
1750  end if
1751  !$omp parallel do
1752  do j = 1, ja_org
1753  do i = 1, ia_org
1754  qtrc_org(1,i,j,qs_mp:qe_mp) = undef
1755  do k = 2, ka_org
1756  if ( qv_org(k,i,j) == undef ) qtrc_org(k,i,j,qs_mp:qe_mp) = undef
1757  end do
1758  end do
1759  end do
1760  end if
1761 
1762  if ( pt_dry .and. .not. temp2pt ) then
1763  if ( nopres ) then
1764  log_error('ParentAtmosInput',*) 'PRES is required'
1765  call prc_abort
1766  end if
1767  !$omp parallel do collapse(2)
1768  do j = 1, ja_org
1769  do i = 1, ia_org
1770  do k = 3, ka_org
1771  temp_org(k,i,j) = pt_org(k,i,j) * ( pres_org(k,i,j) / pre00 )**(rdry/cpdry)
1772  end do
1773  end do
1774  end do
1775  temp2pt = .true.
1776  end if
1777 
1778  if ( temp2pt .or. nopres .or. nodens ) then
1779  call thermodyn_specific_heat( &
1780  ka_org, 3, ka_org, ia_org, 1, ia_org, ja_org, 1, ja_org, qa, &
1781  qtrc_org(:,:,:,:), &
1782  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), &
1783  qdry(:,:,:), rtot(:,:,:), cvtot(:,:,:), cptot(:,:,:) )
1784  end if
1785 
1786  if ( temp2pt ) then
1787  if ( nopres ) then
1788  log_error('ParentAtmosInput',*) 'If TEMP is read, PRES is required'
1789  call prc_abort
1790  end if
1791  !$omp parallel do collapse(2)
1792  do j = 1, ja_org
1793  do i = 1, ia_org
1794  do k = 3, ka_org
1795  if ( temp_org(k,i,j) == undef ) then
1796  pt_org(k,i,j) = undef
1797  else
1798  call thermodyn_temp_pres2pott( &
1799  temp_org(k,i,j), pres_org(k,i,j), & ! [IN]
1800  cptot(k,i,j), rtot(k,i,j), & ! [IN]
1801  pt_org(k,i,j) ) ! [OUT]
1802  end if
1803  enddo
1804  enddo
1805  enddo
1806  endif
1807 
1808  if ( nopres ) then
1809  if ( nodens ) then
1810  log_error('ParentAtmosInput',*) 'If PRES does not exist, DENS is required'
1811  call prc_abort
1812  end if
1813  !$omp parallel do collapse(2) &
1814  !$omp private(rhot_tmp)
1815  do j = 1, ja_org
1816  do i = 1, ia_org
1817  do k = 3, ka_org
1818  if ( pt_org(k,i,j) == undef ) then
1819  pres_org(k,i,j) = undef
1820  else
1821  rhot_tmp = pt_org(k,i,j) * dens_org(k,i,j)
1822  call thermodyn_rhot2pres( &
1823  rhot_tmp, cvtot(k,i,j), cptot(k,i,j), rtot(k,i,j), & ! [IN]
1824  pres_org(k,i,j) ) ! [OUT]
1825  end if
1826  enddo
1827  enddo
1828  enddo
1829  end if
1830 
1831  if ( nodens .and. use_file_density ) then
1832  log_error('ParentAtmosInput',*) 'DENS is required when USE_FILE_DENSITY is true'
1833  call prc_abort
1834  end if
1835 
1836 
1837  lm_layer(:,:) = 3
1838  !$omp parallel do collapse(2)
1839  do j = 1, ja_org
1840  do i = 1, ia_org
1841  do k = 3, ka_org
1842  ! search the lowermost layer excluding UNDEF
1843  if( pres_org(k,i,j) == undef ) then
1844  lm_layer(i,j) = k + 1
1845  else
1846  exit
1847  end if
1848  end do
1849  end do
1850  end do
1851  if ( sfc_diagnoses ) then
1852 
1853  if ( .not. under_sfc ) then
1854  !$omp parallel do collapse(2)
1855  do j = 1, ja_org
1856  do i = 1, ia_org
1857  do k = 3, ka_org
1858  if ( .not. ( &
1859  .not. (cz_org(2,i,j) > undef .and. cz_org(k,i,j) > cz_org(2,i,j) ) .or. &
1860  .not. (pres_org(2,i,j) > undef .and. pres_org(k,i,j) > pres_org(2,i,j) ) &
1861  ) ) then
1862  lm_layer(i,j) = k
1863  exit
1864  end if
1865  end do
1866  end do
1867  end do
1868  end if
1869 
1870  ! groud surface
1871 
1872  !$omp parallel do &
1873  !$omp private(k,dz)
1874  do j = 1, ja_org
1875  do i = 1, ia_org
1876  k = lm_layer(i,j)
1877 
1878  if ( cz_org(2,i,j) > undef .and. & ! topo exists
1879  ( .not. under_sfc .or. cz_org(2,i,j) < cz_org(k,i,j) ) ) then ! surface is lower than the lowest data
1880  dz = cz_org(k,i,j) - cz_org(2,i,j)
1881  if ( qv_org(2,i,j) > undef ) qv_org(2,i,j) = qtrc_org(k,i,j,qs_mp)
1882  if ( temp_org(2,i,j) > undef .and. pres_org(2,i,j) > undef ) then
1883  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1884  dens_org(2,i,j) = pres_org(2,i,j) / ( rtot(2,i,j) * temp_org(2,i,j) )
1885  else if ( pres_org(2,i,j) > undef ) then
1886  dens_org(2,i,j) = - ( pres_org(k,i,j) - pres_org(2,i,j) ) * 2.0_rp / ( grav * dz ) &
1887  - dens_org(k,i,j)
1888  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1889  temp_org(2,i,j) = pres_org(2,i,j) / ( rtot(2,i,j) * dens_org(2,i,j) )
1890  else if ( temp_org(2,i,j) > undef ) then
1891  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1892  dens_org(2,i,j) = ( pres_org(k,i,j) + grav * dens_org(k,i,j) * dz * 0.5_rp ) &
1893  / ( rtot(2,i,j) * temp_org(2,i,j) - grav * dz * 0.5_rp )
1894  pres_org(2,i,j) = dens_org(2,i,j) * rtot(2,i,j) * temp_org(2,i,j)
1895  else
1896  temp_org(2,i,j) = temp_org(k,i,j) + laps * dz
1897  rtot(2,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1898  dens_org(2,i,j) = ( pres_org(k,i,j) + grav * dens_org(k,i,j) * dz * 0.5_rp ) &
1899  / ( rtot(2,i,j) * temp_org(2,i,j) - grav * dz * 0.5_rp )
1900  pres_org(2,i,j) = dens_org(2,i,j) * rtot(2,i,j) * temp_org(2,i,j)
1901  end if
1902  cptot(2,i,j) = cpdry + ( cpvap - cpdry ) * qv_org(2,i,j)
1903  pt_org(2,i,j) = temp_org(2,i,j) * ( pre00 / pres_org(2,i,j) )**(rtot(2,i,j)/cptot(2,i,j))
1904 
1905  else ! no topo
1906 
1907  ! ignore surface variables
1908  cz_org(2,i,j) = cz_org(k,i,j)
1909  w_org(2,i,j) = w_org(k,i,j)
1910  u_org(2,i,j) = u_org(k,i,j)
1911  v_org(2,i,j) = v_org(k,i,j)
1912  pres_org(2,i,j) = pres_org(k,i,j)
1913  pt_org(2,i,j) = pt_org(k,i,j)
1914  dens_org(2,i,j) = dens_org(k,i,j)
1915  qtrc_org(2,i,j,:) = qtrc_org(k,i,j,:)
1916 
1917  end if
1918 
1919  end do
1920  end do
1921 
1922 
1923  ! sea level
1924 
1925  !$omp parallel do
1926  do j = 1, ja_org
1927  do i = 1, ia_org
1928  if ( pres_org(1,i,j) > undef ) then
1929  temp_org(1,i,j) = temp_org(2,i,j) + laps * cz_org(2,i,j)
1930  rtot(1,i,j) = rdry * ( 1.0_rp + epstvap * qv_org(2,i,j) )
1931  cptot(1,i,j) = cpdry + ( cpvap - cpdry ) * qv_org(2,i,j)
1932  dens_org(1,i,j) = pres_org(1,i,j) / ( rtot(1,i,j) * temp_org(1,i,j) )
1933  pt_org(1,i,j) = temp_org(1,i,j) * ( pre00 / pres_org(1,i,j) )**(rtot(1,i,j)/cptot(1,i,j))
1934  cz_org(1,i,j) = 0.0_rp
1935  w_org(1,i,j) = w_org(2,i,j)
1936  u_org(1,i,j) = u_org(2,i,j)
1937  v_org(1,i,j) = v_org(2,i,j)
1938  qtrc_org(1,i,j,:) = qtrc_org(2,i,j,:)
1939  else
1940  cz_org(1,i,j) = undef
1941  w_org(1,i,j) = undef
1942  u_org(1,i,j) = undef
1943  v_org(1,i,j) = undef
1944  pres_org(1,i,j) = undef
1945  pt_org(1,i,j) = undef
1946  dens_org(1,i,j) = undef
1947  qtrc_org(1,i,j,:) = undef
1948  end if
1949  end do
1950  end do
1951 
1952  else
1953 
1954  !$omp parallel do
1955  do j = 1, ja_org
1956  do i = 1, ia_org
1957  cz_org(1:2,i,j) = undef
1958  w_org(1:2,i,j) = undef
1959  u_org(1:2,i,j) = undef
1960  v_org(1:2,i,j) = undef
1961  pres_org(1:2,i,j) = undef
1962  temp_org(1:2,i,j) = undef
1963  dens_org(1:2,i,j) = undef
1964  qtrc_org(1:2,i,j,:) = undef
1965  end do
1966  end do
1967 
1968  end if ! sfc_diagnoses
1969 
1970  endif ! read by this process?
1971 
1972  call prof_rapend ('___AtmosInput',3)
1973 
1974  call prof_rapstart('___AtmosBcast',3)
1975 
1976  if ( serial_atmos ) then
1977  if ( first_atmos .or. update_coord ) then
1978  call comm_bcast( ka_org, ia_org, ja_org, cz_org )
1979  end if
1980  call comm_bcast( ka_org, ia_org, ja_org, pres_org )
1981  call comm_bcast( ka_org, ia_org, ja_org, w_org )
1982  call comm_bcast( ka_org, ia_org, ja_org, u_org )
1983  call comm_bcast( ka_org, ia_org, ja_org, v_org )
1984  call comm_bcast( ka_org, ia_org, ja_org, pt_org )
1985  call comm_bcast( ka_org, ia_org, ja_org, dens_org )
1986  call comm_bcast( ka_org, ia_org, ja_org, qa, qtrc_org )
1987  call comm_bcast( uvmet )
1988  endif
1989 
1990  call prof_rapend ('___AtmosBcast',3)
1991 
1992  !$omp parallel do collapse(3)
1993  do iq = 1, qa
1994  do j = 1, ja_org
1995  do i = 1, ia_org
1996  do k = 1, ka_org
1997  if ( qtrc_org(k,i,j,iq) .ne. undef ) then
1998  qtrc_org(k,i,j,iq) = max( qtrc_org(k,i,j,iq), 0.0_rp )
1999  end if
2000  enddo
2001  enddo
2002  enddo
2003  enddo
2004 
2005  ! interpolation
2006  call prof_rapstart('___AtmosInterp',3)
2007 
2008  if ( first_atmos .or. update_coord ) then
2009 
2010  k = ka_org
2011  call interp_domain_compatibility( lon_org(:,:), & ! [IN]
2012  lat_org(:,:), & ! [IN]
2013  cz_org(k,:,:), & ! [IN]
2014  lon(:,:), & ! [IN]
2015  lat(:,:), & ! [IN]
2016  cz(ke,:,:), & ! [IN]
2017  fz(ke,:,:), & ! [IN]
2018  skip_z = skip_vcheck ) ! [IN]
2019 
2020  select case( itp_type_a )
2021  case ( i_intrp_linear )
2022 
2023  if ( ia_org == 1 .or. ja_org == 1 ) then
2024  log_error("ParentAtmosInput",*) 'LINER interpolation requires nx, ny > 1'
2025  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_ATMOS'
2026  call prc_abort
2027  end if
2028 
2029  !$omp parallel do
2030  do j = 1, ja_org
2031  do i = 1, ia_org
2032  lat_org(i,j) = sign( min( abs(lat_org(i,j)), pi * 0.499999_rp ), lat_org(i,j) )
2033  end do
2034  end do
2035 
2036  call mapprojection_lonlat2xy( ia_org, 1, ia_org, & ! [IN]
2037  ja_org, 1, ja_org, & ! [IN]
2038  lon_org(:,:), & ! [IN]
2039  lat_org(:,:), & ! [IN]
2040  x_org(:,:), & ! [OUT]
2041  y_org(:,:) ) ! [OUT]
2042 
2043  zonal = ( maxval(lon_org) - minval(lon_org) ) > 2.0_rp * pi * 0.9_rp
2044  pole = ( maxval(lat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(lat_org) < - pi * 0.5_rp * 0.9_rp )
2045  call interp_factor3d( ka_org, 1, ka_org, & ! [IN]
2046  ia_org, ja_org, & ! [IN]
2047  ka, ks, ke, & ! [IN]
2048  ia, ja, & ! [IN]
2049  x_org(:,:), y_org(:,:), & ! [IN]
2050  cz_org(:,:,:), & ! [IN]
2051  cx(:), cy(:), & ! [IN]
2052  cz(:,:,:), & ! [IN]
2053  igrd( :,:,:), & ! [OUT]
2054  jgrd( :,:,:), & ! [OUT]
2055  hfact( :,:,:), & ! [OUT]
2056  kgrd(:,:,:,:,:), & ! [OUT]
2057  vfact(:, :,:,:), & ! [OUT]
2058  flag_extrap = .false., & ! [IN]
2059  zonal = zonal, & ! [IN]
2060  pole = pole ) ! [IN]
2061 
2062  case ( i_intrp_dstwgt )
2063 
2064  call interp_factor3d( itp_nh_a, & ! [IN]
2065  ka_org, 1, ka_org, & ! [IN]
2066  ia_org, ja_org, & ! [IN]
2067  ka, ks, ke, & ! [IN]
2068  ia, ja, & ! [IN]
2069  lon_org(:,:), & ! [IN]
2070  lat_org(:,:), & ! [IN]
2071  cz_org(:,:,:), & ! [IN]
2072  lon(:,:), & ! [IN]
2073  lat(:,:), & ! [IN]
2074  cz(:,:,:), & ! [IN]
2075  igrd( :,:,:), & ! [OUT]
2076  jgrd( :,:,:), & ! [OUT]
2077  hfact( :,:,:), & ! [OUT]
2078  kgrd(:,:,:,:,:), & ! [OUT]
2079  vfact(:, :,:,:), & ! [OUT]
2080  flag_extrap = .false. ) ! [IN]
2081 
2082  end select
2083 
2084  endif
2085 
2086  call interp_interp3d( itp_nh_a, &
2087  ka_org, 1, ka_org, &
2088  ia_org, ja_org, &
2089  ka, ks, ke, &
2090  ia, ja, &
2091  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2092  hfact(:,:,:), & ! [IN]
2093  kgrd(:,:,:,:,:), & ! [IN]
2094  vfact(:,:,:,:), & ! [IN]
2095  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2096  w_org(:,:,:), & ! [IN]
2097  w(:,:,:), & ! [OUT]
2098  spline = .false., & ! [IN]
2099  threshold_undef = 1.0_rp, & ! [IN]
2100  wsum = wsum(:,:,:), & ! [OUT]
2101  val2 = work(:,:,:) ) ! [OUT]
2102  !$omp parallel do collapse(2) &
2103  !$omp private(kref)
2104  do j = 1, ja
2105  do i = 1, ia
2106 !CDIR NOVECTOR
2107  do k = ks, ka
2108  if ( w(k,i,j) .ne. undef ) then
2109  kref = k
2110  exit
2111  end if
2112  end do
2113  do k = kref-1, ks, -1
2114  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) ) &
2115  + work(k,i,j) * wsum(k,i,j)
2116  end do
2117  do k = kref+1, ke
2118  if ( w(k,i,j) == undef ) w(k,i,j) = w(k-1,i,j)
2119  end do
2120  end do
2121  end do
2122  if ( filter_niter > 0 ) then
2123  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2124  w(:,:,:), filter_order, filter_niter )
2125  call comm_vars8( w(:,:,:), 1 )
2126  call comm_wait ( w(:,:,:), 1, .false. )
2127  end if
2128 
2129  if ( .not. uvmet ) then
2130  ! rotation from map-projected field to latlon field
2131  !$omp parallel do collapse(2) &
2132  !$omp private(u_on_map,v_on_map)
2133  do j = 1, ja_org
2134  do i = 1, ia_org
2135  do k = 1, ka_org
2136  if ( u_org(k,i,j) > undef .and. v_org(k,i,j) > undef ) then
2137  u_on_map = u_org(k,i,j) * rotc_org(i,j,1) - v_org(k,i,j) * rotc_org(i,j,2)
2138  v_on_map = u_org(k,i,j) * rotc_org(i,j,2) + v_org(k,i,j) * rotc_org(i,j,1)
2139 
2140  u_org(k,i,j) = u_on_map
2141  v_org(k,i,j) = v_on_map
2142  end if
2143  enddo
2144  enddo
2145  enddo
2146  end if
2147 
2148 
2149  call interp_interp3d( itp_nh_a, &
2150  ka_org, 1, ka_org, &
2151  ia_org, ja_org, &
2152  ka, ks, ke, &
2153  ia, ja, &
2154  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2155  hfact(:,:,:), & ! [IN]
2156  kgrd(:,:,:,:,:), & ! [IN]
2157  vfact(:,:,:,:), & ! [IN]
2158  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2159  u_org(:,:,:), & ! [IN]
2160  u(:,:,:), & ! [OUT]
2161  spline = .false., & ! [IN]
2162  threshold_undef = 1.0_rp, & ! [IN]
2163  wsum = wsum(:,:,:), & ! [OUT]
2164  val2 = work(:,:,:) ) ! [OUT]
2165  !$omp parallel do collapse(2) &
2166  !$omp private(kref)
2167  do j = 1, ja
2168  do i = 1, ia
2169  do k = ks, ka
2170  if ( u(k,i,j) .ne. undef ) then
2171  kref = k
2172  exit
2173  end if
2174  end do
2175  do k = kref-1, ks, -1
2176  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) ) &
2177  + work(k,i,j) * wsum(k,i,j)
2178  end do
2179  do k = kref+1, ke
2180  if ( u(k,i,j) == undef ) u(k,i,j) = u(k-1,i,j)
2181  end do
2182  end do
2183  end do
2184  if ( filter_niter > 0 ) then
2185  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2186  u(:,:,:), filter_order, filter_niter )
2187  call comm_vars8( u(:,:,:), 1 )
2188  call comm_wait ( u(:,:,:), 1, .false. )
2189  end if
2190 
2191  call interp_interp3d( itp_nh_a, &
2192  ka_org, 1, ka_org, &
2193  ia_org, ja_org, &
2194  ka, ks, ke, &
2195  ia, ja, &
2196  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2197  hfact(:,:,:), & ! [IN]
2198  kgrd(:,:,:,:,:), & ! [IN]
2199  vfact(:,:,:,:), & ! [IN]
2200  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2201  v_org(:,:,:), & ! [IN]
2202  v(:,:,:), & ! [OUT]
2203  spline = .false., & ! [IN]
2204  threshold_undef = 1.0_rp, & ! [IN]
2205  wsum = wsum(:,:,:), & ! [OUT]
2206  val2 = work(:,:,:) ) ! [OUT]
2207  !$omp parallel do collapse(2) &
2208  !$omp private(kref)
2209  do j = 1, ja
2210  do i = 1, ia
2211  do k = ks, ka
2212  if ( v(k,i,j) .ne. undef ) then
2213  kref = k
2214  exit
2215  end if
2216  end do
2217  do k = kref-1, ks, -1
2218  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) ) &
2219  + work(k,i,j) * wsum(k,i,j)
2220  end do
2221  do k = kref+1, ke
2222  if ( v(k,i,j) == undef ) v(k,i,j) = v(k-1,i,j)
2223  end do
2224  end do
2225  end do
2226  if ( filter_niter > 0 ) then
2227  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2228  v(:,:,:), filter_order, filter_niter )
2229  call comm_vars8( v(:,:,:), 1 )
2230  call comm_wait ( v(:,:,:), 1, .false. )
2231  end if
2232 
2233  ! rotation from latlon field to map-projected field
2234  !$omp parallel do collapse(2) &
2235  !$omp private(u_on_map,v_on_map)
2236  do j = 1, ja
2237  do i = 1, ia
2238  do k = ks, ke
2239  u_on_map = u(k,i,j) * rotc(i,j,1) + v(k,i,j) * rotc(i,j,2)
2240  v_on_map = -u(k,i,j) * rotc(i,j,2) + v(k,i,j) * rotc(i,j,1)
2241 
2242  u(k,i,j) = u_on_map
2243  v(k,i,j) = v_on_map
2244  enddo
2245  enddo
2246  enddo
2247 
2248  ! from scalar point to staggered point
2249  !$omp parallel do collapse(2)
2250  do j = 1, ja
2251  do i = 1, ia
2252  do k = ks, ke-1
2253  velz(k,i,j) = 0.5_rp * ( w(k+1,i,j) + w(k,i,j) )
2254  enddo
2255  enddo
2256  enddo
2257 
2258  !$omp parallel do
2259  do j = 1, ja
2260  do i = 1, ia-1
2261  do k = ks, ke
2262  velx(k,i,j) = 0.5_rp * ( u(k,i+1,j) + u(k,i,j) )
2263  enddo
2264  enddo
2265  enddo
2266 
2267  i = ia
2268  !$omp parallel do
2269  do j = 1, ja
2270  do k = ks, ke
2271  velx(k,i,j) = u(k,i,j)
2272  enddo
2273  enddo
2274 
2275  !$omp parallel do
2276  do j = 1, ja-1
2277  do i = 1, ia
2278  do k = ks, ke
2279  vely(k,i,j) = 0.5_rp * ( v(k,i,j+1) + v(k,i,j) )
2280  enddo
2281  enddo
2282  enddo
2283 
2284  j = ja
2285  !$omp parallel do
2286  do i = 1, ia
2287  do k = ks, ke
2288  vely(k,i,j) = v(k,i,j)
2289  enddo
2290  enddo
2291 
2292  !$omp parallel do
2293  do j = 1, ja
2294  do i = 1, ia
2295  velz( 1:ks-1,i,j) = 0.0_rp
2296  velz(ke :ka ,i,j) = 0.0_rp
2297  velx( 1:ks-1,i,j) = 0.0_rp
2298  velx(ke+1:ka ,i,j) = 0.0_rp
2299  vely( 1:ks-1,i,j) = 0.0_rp
2300  vely(ke+1:ka ,i,j) = 0.0_rp
2301  enddo
2302  enddo
2303 
2304  call comm_vars8( velz(:,:,:), 1 )
2305  call comm_vars8( velx(:,:,:), 2 )
2306  call comm_vars8( vely(:,:,:), 3 )
2307  call comm_wait ( velz(:,:,:), 1, .false. )
2308  call comm_wait ( velx(:,:,:), 2, .false. )
2309  call comm_wait ( vely(:,:,:), 3, .false. )
2310 
2311  call interp_interp3d( itp_nh_a, &
2312  ka_org, 1, ka_org, &
2313  ia_org, ja_org, &
2314  ka, ks, ke, &
2315  ia, ja, &
2316  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2317  hfact(:,:,:), & ! [IN]
2318  kgrd(:,:,:,:,:), & ! [IN]
2319  vfact(:,:,:,:), & ! [IN]
2320  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2321  pt_org(:,:,:), & ! [IN]
2322  pott(:,:,:), & ! [OUT]
2323  spline = .false., & ! [IN]
2324  threshold_undef = 1.0_rp, & ! [IN]
2325  wsum = wsum(:,:,:), & ! [OUT]
2326  val2 = work(:,:,:) ) ! [OUT]
2327  !$omp parallel do collapse(2)
2328  do j = 1, ja
2329  do i = 1, ia
2330  do k = ks+1, ke
2331  if ( pott(k,i,j) == undef .and. pott(k-1,i,j) .ne. undef ) pott(k,i,j) = pott(k-1,i,j)
2332  end do
2333  do k = ke-1, ks, -1
2334  if ( pott(k,i,j) == undef ) then
2335  pott(k,i,j) = pott(k+1,i,j) * ( 1.0_rp - wsum(k,i,j) ) &
2336  + work(k,i,j) * wsum(k,i,j)
2337  end if
2338  end do
2339  pott( 1:ks-1,i,j) = undef
2340  pott(ke+1:ka ,i,j) = undef
2341  enddo
2342  enddo
2343  if ( filter_niter > 0 ) then
2344  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2345  pott(:,:,:), filter_order, filter_niter )
2346  call comm_vars8( pott(:,:,:), 1 )
2347  call comm_wait ( pott(:,:,:), 1, .false. )
2348  end if
2349 
2350  do iq = 1, qa
2351 
2352  if ( ( iq < qs_mp .or. iq > qe_mp ) .and. ( .not. qtrc_flag(iq) ) ) then
2353  !$omp parallel do collapse(2)
2354  do j = 1, ja
2355  do i = 1, ia
2356  do k = 1, ka
2357  qtrc(k,i,j,iq) = undef
2358  end do
2359  end do
2360  end do
2361  cycle
2362  end if
2363 
2364  call interp_interp3d( itp_nh_a, &
2365  ka_org, 1, ka_org, &
2366  ia_org, ja_org, &
2367  ka, ks, ke, &
2368  ia, ja, &
2369  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2370  hfact(:,:,:), & ! [IN]
2371  kgrd(:,:,:,:,:), & ! [IN]
2372  vfact(:,:,:,:), & ! [IN]
2373  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2374  qtrc_org(:,:,:,iq), & ! [IN]
2375  qtrc(:,:,:,iq), & ! [OUT]
2376  spline = .false., & ! [IN]
2377  threshold_undef = 1.0_rp, & ! [IN]
2378  wsum = wsum(:,:,:), & ! [OUT]
2379  val2 = work(:,:,:) ) ! [OUT]
2380  !$omp parallel do collapse(2)
2381  do j = 1, ja
2382  do i = 1, ia
2383  do k = ks+1, ke
2384  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)
2385  end do
2386  do k = ke-1, ks, -1
2387  if ( qtrc(k,i,j,iq) == undef .and. qtrc(k+1,i,j,iq) > undef ) then
2388  qtrc(k,i,j,iq) = qtrc(k+1,i,j,iq) * ( 1.0_rp - wsum(k,i,j) ) &
2389  + work(k,i,j) * wsum(k,i,j)
2390  end if
2391  end do
2392  do k = ks, ke
2393  qtrc(k,i,j,iq) = max( qtrc(k,i,j,iq), 0.0_rp )
2394  end do
2395  qtrc( 1:ks-1,i,j,iq) = 0.0_rp
2396  qtrc(ke+1:ka ,i,j,iq) = 0.0_rp
2397  enddo
2398  enddo
2399  if ( filter_niter > 0 ) then
2400  !$omp parallel do collapse(2)
2401  do j = 1, ja
2402  do i = 1, ia
2403  do k = 1, ka
2404  one(k,i,j) = 1.0_rp
2405  end do
2406  end do
2407  end do
2408  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2409  qtrc(:,:,:,iq), filter_order, filter_niter, &
2410  limiter_sign = one(:,:,:) )
2411  call comm_vars8( qtrc(:,:,:,iq), 1 )
2412  call comm_wait ( qtrc(:,:,:,iq), 1, .false. )
2413  end if
2414  enddo
2415 
2416  call interp_interp3d( itp_nh_a, &
2417  ka_org, 1, ka_org, &
2418  ia_org, ja_org, &
2419  ka, ks, ke, &
2420  ia, ja, &
2421  igrd( :,:,:), & ! [IN]
2422  jgrd( :,:,:), & ! [IN]
2423  hfact( :,:,:), & ! [IN]
2424  kgrd(:,:,:,:,:), & ! [IN]
2425  vfact(:, :,:,:), & ! [IN]
2426  cz_org(:,:,:), & ! [IN]
2427  cz(:,:,:), & ! [IN]
2428  pres_org(:,:,:), & ! [IN]
2429  pres(:,:,:), & ! [OUT]
2430  logwgt = .true. ) ! [IN, optional]
2431 
2432  !$omp parallel do collapse(2)
2433  do j = 1, ja
2434  do i = 1, ia
2435  do k = 1, ka
2436  qc(k,i,j) = 0.0_rp
2437  end do
2438  end do
2439  end do
2440  if ( atmos_hydrometeor_dry ) then
2441  !$omp parallel do collapse(2)
2442  do j = 1, ja
2443  do i = 1, ia
2444  do k = 1, ka
2445  qv(k,i,j) = 0.0_rp
2446  end do
2447  end do
2448  end do
2449  else
2450  !$omp parallel do collapse(2)
2451  do j = 1, ja
2452  do i = 1, ia
2453  do k = 1, ka
2454  qv(k,i,j) = qtrc(k,i,j,i_qv)
2455  do iq = qls, qle
2456  qc(k,i,j) = qc(k,i,j) + qtrc(k,i,j,iq)
2457  enddo
2458  end do
2459  end do
2460  end do
2461  end if
2462 
2463 
2464  !$omp parallel do collapse(2)
2465  do j = 1, ja
2466  do i = 1, ia
2467  do k = ks, ke
2468  pres2(k,i,j) = pres(k,i,j)
2469  end do
2470  end do
2471  end do
2472 
2473  if ( use_file_density ) then
2474  call interp_interp3d( itp_nh_a, &
2475  ka_org, 1, ka_org, &
2476  ia_org, ja_org, &
2477  ka, ks, ke, &
2478  ia, ja, &
2479  igrd(:,:,:), jgrd(:,:,:), & ! [IN]
2480  hfact(:,:,:), & ! [IN]
2481  kgrd(:,:,:,:,:), & ! [IN]
2482  vfact(:,:,:,:), & ! [IN]
2483  cz_org(:,:,:), cz(:,:,:), & ! [IN]
2484  dens_org(:,:,:), & ! [IN]
2485  dens(:,:,:), & ! [OUT]
2486  threshold_undef = 1.0_rp, & ! [IN]
2487  wsum = wsum(:,:,:), & ! [OUT]
2488  val2 = work(:,:,:) ) ! [OUT]
2489  call hydrostatic_buildrho_real( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2490  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2491  cz(:,:,:), & ! [IN]
2492  pres2(:,:,:), & ! [INOUT]
2493  dens2(:,:,:), temp(:,:,:) ) ! [OUT]
2494  !$omp parallel do collapse(2)
2495  do j = 1, ja
2496  do i = 1, ia
2497  do k = ks, ke
2498  if ( dens(k,i,j) == undef ) then
2499  dens(k,i,j) = dens2(k,i,j) * ( 1.0_rp - wsum(k,i,j) ) &
2500  + work(k,i,j) * wsum(k,i,j)
2501  end if
2502  end do
2503  end do
2504  end do
2505  else
2506  ! make density & pressure profile in moist condition
2507  call hydrostatic_buildrho_real( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
2508  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
2509  cz(:,:,:), & ! [IN]
2510  pres2(:,:,:), & ! [INOUT]
2511  dens(:,:,:), temp(:,:,:) ) ! [OUT]
2512  endif
2513 
2514  if ( filter_niter > 0 ) then
2515  call filter_hyperdiff( ka, ks, ke, ia, isb, ieb, ja, jsb, jeb, &
2516  dens(:,:,:), filter_order, filter_niter, &
2517  limiter_sign = one(:,:,:) )
2518  call comm_vars8( dens(:,:,:), 1 )
2519  call comm_wait ( dens(:,:,:), 1, .false. )
2520  end if
2521 
2522  !$omp parallel do collapse(2)
2523  do j = 1, ja
2524  do i = 1, ia
2525  do k = ks, ke
2526  if ( pres(k,i,j) == undef ) pres(k,i,j) = pres2(k,i,j)
2527  end do
2528  end do
2529  end do
2530 
2531 
2532  !$omp parallel do
2533  do j = 1, ja
2534  do i = 1, ia
2535  dens( 1:ks-1,i,j) = 0.0_rp
2536  dens(ke+1:ka ,i,j) = 0.0_rp
2537  enddo
2538  enddo
2539 
2540  !$omp parallel do collapse(2)
2541  do j = 1, ja
2542  do i = 1, ia
2543  do k = ks, ke-1
2544  momz(k,i,j) = velz(k,i,j) * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
2545  enddo
2546  enddo
2547  enddo
2548 
2549  !$omp parallel do
2550  do j = 1, ja
2551  do i = 1, ia-1
2552  do k = ks, ke
2553  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
2554  enddo
2555  enddo
2556  enddo
2557 
2558  i = ia
2559  !$omp parallel do
2560  do j = 1, ja
2561  do k = ks, ke
2562  momx(k,i,j) = velx(k,i,j) * dens(k,i,j)
2563  enddo
2564  enddo
2565 
2566  !$omp parallel do
2567  do j = 1, ja-1
2568  do i = 1, ia
2569  do k = ks, ke
2570  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
2571  enddo
2572  enddo
2573  enddo
2574 
2575  j = ja
2576  !$omp parallel do
2577  do i = 1, ia
2578  do k = ks, ke
2579  momy(k,i,j) = vely(k,i,j) * dens(k,i,j)
2580  enddo
2581  enddo
2582 
2583  !$omp parallel do collapse(2)
2584  do j = 1, ja
2585  do i = 1, ia
2586  do k = 1, ka
2587  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
2588  enddo
2589  enddo
2590  enddo
2591 
2592  !$omp parallel do
2593  do j = 1, ja
2594  do i = 1, ia
2595  momz( 1:ks-1,i,j) = 0.0_rp
2596  momz(ke :ka ,i,j) = 0.0_rp
2597  momx( 1:ks-1,i,j) = 0.0_rp
2598  momx(ke+1:ka ,i,j) = 0.0_rp
2599  momy( 1:ks-1,i,j) = 0.0_rp
2600  momy(ke+1:ka ,i,j) = 0.0_rp
2601  enddo
2602  enddo
2603 
2604  call comm_vars8( momz(:,:,:), 1 )
2605  call comm_vars8( momx(:,:,:), 2 )
2606  call comm_vars8( momy(:,:,:), 3 )
2607  call comm_wait ( momz(:,:,:), 1, .false. )
2608  call comm_wait ( momx(:,:,:), 2, .false. )
2609  call comm_wait ( momy(:,:,:), 3, .false. )
2610 
2611  first_atmos = .false.
2612 
2613  call prof_rapend ('___AtmosInterp',3)
2614 
2615  return
2616  end subroutine parentatmosinput
2617 
2618  !-----------------------------------------------------------------------------
2620  subroutine boundaryatmossetup( &
2621  basename, &
2622  title, &
2623  datatype, &
2624  timeintv, &
2625  qtrc_flag, &
2626  fid, &
2627  vid )
2628  use scale_file_cartesc, only: &
2629  file_cartesc_create, &
2630  file_cartesc_def_var, &
2631  file_cartesc_enddef
2632  use scale_time, only: &
2633  nowdate => time_nowdate
2634  use mod_atmos_phy_mp_vars, only: &
2635  qs_mp, &
2636  qe_mp
2637  implicit none
2638 
2639  character(len=*), intent(in) :: basename
2640  character(len=*), intent(in) :: title
2641  character(len=*), intent(in) :: datatype
2642  real(dp), intent(in) :: timeintv
2643  logical, intent(in) :: qtrc_flag(qa)
2644  integer, intent(out) :: fid
2645  integer, intent(out) :: vid(5+qa)
2646 
2647  integer :: iq
2648  !---------------------------------------------------------------------------
2649 
2650  call file_cartesc_create( basename, title, datatype, fid, date=nowdate )
2651 
2652  call file_cartesc_def_var( fid, &
2653  'DENS', 'Reference Density', 'kg/m3', 'ZXYT', datatype, & ! [IN]
2654  vid(1), & ! [OUT]
2655  timeintv=timeintv ) ! [IN]
2656  call file_cartesc_def_var( fid, &
2657  'VELZ', 'Reference VELZ', 'm/s', 'ZHXYT', datatype, & ! [IN]
2658  vid(2), & ! [OUT]
2659  timeintv=timeintv ) ! [IN]
2660  call file_cartesc_def_var( fid, &
2661  'VELX', 'Reference VELX', 'm/s', 'ZXHYT', datatype, & ! [IN]
2662  vid(3), & ! [OUT]
2663  timeintv=timeintv ) ! [IN]
2664  call file_cartesc_def_var( fid, &
2665  'VELY', 'Reference VELY', 'm/s', 'ZXYHT', datatype, & ! [IN]
2666  vid(4), & ! [OUT]
2667  timeintv=timeintv ) ! [IN]
2668  call file_cartesc_def_var( fid, &
2669  'PT', 'Reference PT', 'K', 'ZXYT', datatype, & ! [IN]
2670  vid(5), & ! [OUT]
2671  timeintv=timeintv ) ! [IN]
2672 
2673  do iq = qs_mp, qe_mp
2674  call file_cartesc_def_var( fid, & ! [IN]
2675  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
2676  'ZXYT', datatype, & ! [IN]
2677  vid(5+iq), & ! [OUT]
2678  timeintv = timeintv ) ! [IN]
2679  enddo
2680 
2681  do iq = 1, qa
2682  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
2683  if ( .not. qtrc_flag(iq) ) cycle
2684  call file_cartesc_def_var( fid, & ! [IN]
2685  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
2686  'ZXYT', datatype, & ! [IN]
2687  vid(5+iq), & ! [OUT]
2688  timeintv = timeintv ) ! [IN]
2689  enddo
2690 
2691  call file_cartesc_enddef( fid )
2692 
2693  return
2694  end subroutine boundaryatmossetup
2695 
2696  !-----------------------------------------------------------------------------
2698  subroutine boundaryatmosoutput( &
2699  DENS, &
2700  VELZ, &
2701  VELX, &
2702  VELY, &
2703  POTT, &
2704  QTRC, &
2705  qtrc_flag, &
2706  fid, vid, &
2707  timeintv, &
2708  istep )
2709  use scale_file_cartesc, only: &
2710  file_cartesc_write_var
2711  use mod_atmos_phy_mp_vars, only: &
2712  qs_mp, &
2713  qe_mp
2714  implicit none
2715 
2716  real(rp), intent(in) :: dens(ka,ia,ja)
2717  real(rp), intent(in) :: velz(ka,ia,ja)
2718  real(rp), intent(in) :: velx(ka,ia,ja)
2719  real(rp), intent(in) :: vely(ka,ia,ja)
2720  real(rp), intent(in) :: pott(ka,ia,ja)
2721  real(rp), intent(in) :: qtrc(ka,ia,ja,qa)
2722  logical, intent(in) :: qtrc_flag(qa)
2723  integer, intent(in) :: fid
2724  integer, intent(in) :: vid(5+qa)
2725  real(dp), intent(in) :: timeintv
2726  integer, intent(in) :: istep
2727 
2728  real(rp) :: work(ka,ia,ja,1)
2729 
2730  real(dp) :: timeofs
2731  integer :: iq
2732  !---------------------------------------------------------------------------
2733 
2734  call prof_rapstart('___AtmosOutput',3)
2735 
2736  timeofs = real(istep-1,kind=dp) * timeintv
2737 
2738 !OCL XFILL
2739  work(:,:,:,1) = dens(:,:,:)
2740  call file_cartesc_write_var( fid, vid(1), work(:,:,:,:), 'DENS', 'ZXYT', timeintv, timeofs=timeofs )
2741 !OCL XFILL
2742  work(:,:,:,1) = velz(:,:,:)
2743  call file_cartesc_write_var( fid, vid(2), work(:,:,:,:), 'VELZ', 'ZHXYT', timeintv, timeofs=timeofs )
2744 !OCL XFILL
2745  work(:,:,:,1) = velx(:,:,:)
2746  call file_cartesc_write_var( fid, vid(3), work(:,:,:,:), 'VELX', 'ZXHYT', timeintv, timeofs=timeofs )
2747 !OCL XFILL
2748  work(:,:,:,1) = vely(:,:,:)
2749  call file_cartesc_write_var( fid, vid(4), work(:,:,:,:), 'VELY', 'ZXYHT', timeintv, timeofs=timeofs )
2750 !OCL XFILL
2751  work(:,:,:,1) = pott(:,:,:)
2752  call file_cartesc_write_var( fid, vid(5), work(:,:,:,:), 'PT', 'ZXYT', timeintv, timeofs=timeofs )
2753 
2754  do iq = qs_mp, qe_mp
2755  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
2756  'ZXYT', timeintv, timeofs=timeofs )
2757  enddo
2758 
2759  do iq = 1, qa
2760  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
2761  if ( .not. qtrc_flag(iq) ) cycle
2762  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
2763  'ZXYT', timeintv, timeofs=timeofs )
2764  enddo
2765 
2766  call prof_rapend ('___AtmosOutput',3)
2767 
2768  return
2769  end subroutine boundaryatmosoutput
2770 
2771  !-----------------------------------------------------------------------------
2773  subroutine parentsurfacesetup( &
2774  ldims, odims, &
2775  lmdlid, omdlid, &
2776  timelen_land, &
2777  timelen_ocean, &
2778  basename_org_land, &
2779  basename_org_ocean, &
2780  basename_land, &
2781  basename_ocean, &
2782  filetype_land, &
2783  filetype_ocean, &
2784  use_file_landwater, &
2785  intrp_iter_max, &
2786  intrp_land_temp, &
2787  intrp_land_water, &
2788  intrp_land_sfc_temp, &
2789  intrp_ocean_temp, &
2790  intrp_ocean_sfc_temp )
2791  use scale_comm_cartesc, only: &
2792  comm_world, &
2793  comm_datatype
2794  use scale_atmos_grid_cartesc_real, only: &
2795  atmos_grid_cartesc_real_lon, &
2796  atmos_grid_cartesc_real_lat
2797  use mod_realinput_netcdf, only: &
2798  parentlandsetupnetcdf, &
2799  parentoceansetupnetcdf
2800  use mod_realinput_grads, only: &
2801  parentlandsetupgrads, &
2802  parentoceansetupgrads
2803  implicit none
2804 
2805  integer, intent(out) :: ldims(3) ! dims for land
2806  integer, intent(out) :: odims(2) ! dims for ocean
2807  integer, intent(out) :: lmdlid ! model id for land
2808  integer, intent(out) :: omdlid ! model id for ocean
2809  integer, intent(out) :: timelen_land ! number of time steps in land file
2810  integer, intent(out) :: timelen_ocean ! number of time steps in ocean file
2811 
2812  character(len=*), intent(in) :: basename_org_land
2813  character(len=*), intent(in) :: basename_org_ocean
2814  character(len=*), intent(in) :: basename_land
2815  character(len=*), intent(in) :: basename_ocean
2816  character(len=*), intent(in) :: filetype_land
2817  character(len=*), intent(in) :: filetype_ocean
2818  logical, intent(in) :: use_file_landwater ! use land water data from files
2819  integer, intent(in) :: intrp_iter_max
2820  character(len=*), intent(in) :: intrp_land_temp
2821  character(len=*), intent(in) :: intrp_land_water
2822  character(len=*), intent(in) :: intrp_land_sfc_temp
2823  character(len=*), intent(in) :: intrp_ocean_temp
2824  character(len=*), intent(in) :: intrp_ocean_sfc_temp
2825 
2826  real(rp), allocatable :: lon_all(:,:)
2827  real(rp), allocatable :: lat_all(:,:)
2828 
2829  real(rp) :: lon_min, lon_max
2830  real(rp) :: lat_min, lat_max
2831 
2832  integer :: ierr
2833  integer :: i, j
2834  !---------------------------------------------------------------------------
2835 
2836  log_newline
2837  log_info("ParentSurfaceSetup",*) 'Setup'
2838 
2839  ! Land
2840 
2841  if( lkmax < 4 )then
2842  log_error("ParentSurfaceSetup",*) 'LKMAX less than 4: ', lkmax
2843  log_error_cont(*) 'in Real Case, LKMAX should be set more than 4'
2844  call prc_abort
2845  endif
2846 
2847  log_info("ParentSurfaceSetup",*) 'Horizontal Interpolation Level: ', comm_cartesc_nest_interp_level
2848 
2849 
2850  if( serial_land .and. .not. prc_ismaster ) then
2851  do_read_land = .false.
2852  else
2853  do_read_land = .true.
2854  endif
2855 
2856  select case(filetype_land)
2857  case('NetCDF')
2858 
2859  lmdlid = inetcdf
2860  call parentlandsetupnetcdf( ldims, & ! (out)
2861  timelen_land, & ! (out)
2862  lon_all, lat_all, & ! (out)
2863  basename_org_land, & ! (in)
2864  basename_land, & ! (in)
2865  use_file_landwater, & ! (in)
2866  serial_land, & ! (inout)
2867  do_read_land ) ! (inout)
2868 
2869  case('GrADS')
2870 
2871  lmdlid = igrads
2872  if ( do_read_land ) call parentlandsetupgrads( ldims, & ! (out)
2873  timelen_land, & ! (out)
2874  lon_all, lat_all, & ! (out)
2875  basename_org_land, & ! (in)
2876  basename_land ) ! (in)
2877 
2878  case default
2879 
2880  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_land)
2881  call prc_abort
2882 
2883  endselect
2884 
2885  lon_min = minval( atmos_grid_cartesc_real_lon(:,:) )
2886  lon_max = maxval( atmos_grid_cartesc_real_lon(:,:) )
2887  lat_min = minval( atmos_grid_cartesc_real_lat(:,:) )
2888  lat_max = maxval( atmos_grid_cartesc_real_lat(:,:) )
2889 
2890  if ( serial_land ) then
2891  call comm_bcast( 3, ldims(:) )
2892  call comm_bcast( timelen_land )
2893 
2894  if ( .not. do_read_land ) then
2895  allocate( lon_all(ldims(2), ldims(3)) )
2896  allocate( lat_all(ldims(2), ldims(3)) )
2897  end if
2898  call comm_bcast( ldims(2), ldims(3), lon_all )
2899  call comm_bcast( ldims(2), ldims(3), lat_all )
2900 
2901  call mpi_allreduce( mpi_in_place, lon_min, 1, comm_datatype, mpi_min, comm_world, ierr )
2902  call mpi_allreduce( mpi_in_place, lon_max, 1, comm_datatype, mpi_max, comm_world, ierr )
2903  call mpi_allreduce( mpi_in_place, lat_min, 1, comm_datatype, mpi_min, comm_world, ierr )
2904  call mpi_allreduce( mpi_in_place, lat_max, 1, comm_datatype, mpi_max, comm_world, ierr )
2905  endif
2906 
2907  call get_ijrange( lis_org, lie_org, ljs_org, lje_org, & ! [OUT]
2908  ldims(2), ldims(3), & ! [IN]
2909  lon_min, lon_max, lat_min, lat_max, & ! [IN]
2910  lon_all, lat_all ) ! [IN]
2911  lis_org = max( lis_org - intrp_iter_max, 1 )
2912  lie_org = min( lie_org + intrp_iter_max, ldims(2) )
2913  ljs_org = max( ljs_org - intrp_iter_max, 1 )
2914  lje_org = min( lje_org + intrp_iter_max, ldims(3) )
2915 
2916  lks_org = 1
2917  lke_org = ldims(1)
2918  lka_org = lke_org - lks_org + 1
2919  lia_org = lie_org - lis_org + 1
2920  lja_org = lje_org - ljs_org + 1
2921 
2922  allocate( llon_org(lia_org, lja_org) )
2923  allocate( llat_org(lia_org, lja_org) )
2924 
2925  !$omp parallel do
2926  do j = 1, lja_org
2927  do i = 1, lia_org
2928  llon_org(i,j) = lon_all(i-1+lis_org,j-1+ljs_org)
2929  llat_org(i,j) = lat_all(i-1+lis_org,j-1+ljs_org)
2930  end do
2931  end do
2932 
2933  deallocate( lon_all )
2934  deallocate( lat_all )
2935 
2936 
2937  select case( intrp_land_temp )
2938  case( 'off' )
2939  i_intrp_land_temp = i_intrp_off
2940  case( 'mask' )
2941  i_intrp_land_temp = i_intrp_mask
2942  case( 'fill' )
2943  i_intrp_land_temp = i_intrp_fill
2944  case default
2945  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_TEMP is invalid. ', intrp_land_temp
2946  call prc_abort
2947  end select
2948  select case( intrp_land_sfc_temp )
2949  case( 'off' )
2950  i_intrp_land_sfc_temp = i_intrp_off
2951  case( 'mask' )
2952  i_intrp_land_sfc_temp = i_intrp_mask
2953  case( 'fill' )
2954  i_intrp_land_sfc_temp = i_intrp_fill
2955  case default
2956  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_SFC_TEMP is invalid. ', intrp_land_sfc_temp
2957  call prc_abort
2958  end select
2959  select case( intrp_land_water )
2960  case( 'off' )
2961  i_intrp_land_water = i_intrp_off
2962  case( 'mask' )
2963  i_intrp_land_water = i_intrp_mask
2964  case( 'fill' )
2965  i_intrp_land_water = i_intrp_fill
2966  case default
2967  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_WATER is invalid. ', intrp_land_water
2968  call prc_abort
2969  end select
2970 
2971  select case( lmdlid )
2972  case( inetcdf )
2973  i_intrp_land_temp = i_intrp_mask
2974  i_intrp_land_sfc_temp = i_intrp_mask
2975  i_intrp_land_water = i_intrp_mask
2976  end select
2977 
2978 
2979  ! Ocean
2980 
2981  if( serial_ocean .and. .not. prc_ismaster ) then
2982  do_read_ocean = .false.
2983  else
2984  do_read_ocean = .true.
2985  endif
2986 
2987  select case(filetype_ocean)
2988  case('NetCDF')
2989 
2990  omdlid = inetcdf
2991  call parentoceansetupnetcdf( odims, timelen_ocean, & ! (out)
2992  lon_all, lat_all, & ! (out)
2993  basename_org_ocean, & ! (in)
2994  basename_ocean, & ! (in)
2995  serial_ocean, & ! (inout)
2996  do_read_ocean ) ! (inout)
2997 
2998  case('GrADS')
2999 
3000  omdlid = igrads
3001  if ( do_read_ocean ) call parentoceansetupgrads( odims, timelen_ocean, & ! (out)
3002  lon_all, lat_all, & ! (out)
3003  basename_org_ocean, & ! (in)
3004  basename_ocean ) ! (in)
3005  case default
3006 
3007  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_ocean)
3008  call prc_abort
3009 
3010  endselect
3011 
3012  lon_min = minval( atmos_grid_cartesc_real_lon(:,:) )
3013  lon_max = maxval( atmos_grid_cartesc_real_lon(:,:) )
3014  lat_min = minval( atmos_grid_cartesc_real_lat(:,:) )
3015  lat_max = maxval( atmos_grid_cartesc_real_lat(:,:) )
3016 
3017  if ( serial_ocean ) then
3018  call comm_bcast( 2, odims(:) )
3019  call comm_bcast( timelen_ocean )
3020 
3021  if ( .not. do_read_ocean ) then
3022  allocate( lon_all(odims(1), odims(2)) )
3023  allocate( lat_all(odims(1), odims(2)) )
3024  end if
3025  call comm_bcast( odims(1), odims(2), lon_all )
3026  call comm_bcast( odims(1), odims(2), lat_all )
3027 
3028  call mpi_allreduce( mpi_in_place, lon_min, 1, comm_datatype, mpi_min, comm_world, ierr )
3029  call mpi_allreduce( mpi_in_place, lon_max, 1, comm_datatype, mpi_max, comm_world, ierr )
3030  call mpi_allreduce( mpi_in_place, lat_min, 1, comm_datatype, mpi_min, comm_world, ierr )
3031  call mpi_allreduce( mpi_in_place, lat_max, 1, comm_datatype, mpi_max, comm_world, ierr )
3032  endif
3033 
3034  call get_ijrange( ois_org, oie_org, ojs_org, oje_org, & ! [OUT]
3035  odims(1), odims(2), & ! [IN]
3036  lon_min, lon_max, lat_min, lat_max, & ! [IN]
3037  lon_all, lat_all ) ! [IN]
3038  ois_org = max( ois_org - intrp_iter_max, 1 )
3039  oie_org = min( oie_org + intrp_iter_max, odims(1) )
3040  ojs_org = max( ojs_org - intrp_iter_max, 1 )
3041  oje_org = min( oje_org + intrp_iter_max, odims(2) )
3042 
3043  oia_org = oie_org - ois_org + 1
3044  oja_org = oje_org - ojs_org + 1
3045 
3046  allocate( olon_org(oia_org, oja_org) )
3047  allocate( olat_org(oia_org, oja_org) )
3048 
3049  !$omp parallel do
3050  do j = 1, oja_org
3051  do i = 1, oia_org
3052  olon_org(i,j) = lon_all(i-1+ois_org,j-1+ojs_org)
3053  olat_org(i,j) = lat_all(i-1+ois_org,j-1+ojs_org)
3054  end do
3055  end do
3056 
3057  deallocate( lon_all )
3058  deallocate( lat_all )
3059 
3060  select case( intrp_ocean_temp )
3061  case( 'off' )
3062  i_intrp_ocean_temp = i_intrp_off
3063  case( 'mask' )
3064  i_intrp_ocean_temp = i_intrp_mask
3065  case( 'fill' )
3066  i_intrp_ocean_temp = i_intrp_fill
3067  case default
3068  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_TEMP is invalid. ', intrp_ocean_temp
3069  call prc_abort
3070  end select
3071  select case( intrp_ocean_sfc_temp )
3072  case( 'off' )
3073  i_intrp_ocean_sfc_temp = i_intrp_off
3074  case( 'mask' )
3075  i_intrp_ocean_sfc_temp = i_intrp_mask
3076  case( 'fill' )
3077  i_intrp_ocean_sfc_temp = i_intrp_fill
3078  case default
3079  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_SFC_TEMP is invalid. ', intrp_ocean_sfc_temp
3080  call prc_abort
3081  end select
3082 
3083  select case( omdlid )
3084  case( inetcdf )
3085  i_intrp_ocean_temp = i_intrp_mask
3086  i_intrp_ocean_sfc_temp = i_intrp_mask
3087  end select
3088 
3089 
3090  allocate( oigrd( ia, ja, itp_nh_a) )
3091  allocate( ojgrd( ia, ja, itp_nh_a) )
3092  allocate( ohfact( ia, ja, itp_nh_a) )
3093 
3094  allocate( hfact_ol(oia_org, oja_org, itp_nh_ol) )
3095  allocate( igrd_ol(oia_org, oja_org, itp_nh_ol) )
3096  allocate( jgrd_ol(oia_org, oja_org, itp_nh_ol) )
3097 
3098  return
3099  end subroutine parentsurfacesetup
3100 
3101  !-----------------------------------------------------------------------------
3103  subroutine parentsurfaceopen( &
3104  filetype_land, filetype_ocean, &
3105  basename_org_land, basename_org_ocean, &
3106  basename_land, basename_ocean )
3107  use mod_realinput_netcdf, only: &
3108  parentlandopennetcdf, &
3109  parentoceanopennetcdf
3110  implicit none
3111  character(len=*), intent(in) :: filetype_land
3112  character(len=*), intent(in) :: filetype_ocean
3113  character(len=*), intent(in) :: basename_org_land
3114  character(len=*), intent(in) :: basename_org_ocean
3115  character(len=*), intent(in) :: basename_land
3116  character(len=*), intent(in) :: basename_ocean
3117 
3118  select case ( filetype_land )
3119  case ( "NetCDF" )
3120  call parentlandopennetcdf( basename_org_land, basename_land )
3121  case ( "GrADS" )
3122  ! do nothing
3123  end select
3124 
3125  select case ( filetype_ocean )
3126  case ( "NetCDF" )
3127  call parentoceanopennetcdf( basename_org_ocean, basename_land )
3128  case ( "GrADS" )
3129  ! do nothing
3130  end select
3131 
3132  return
3133  end subroutine parentsurfaceopen
3134  !-----------------------------------------------------------------------------
3136  subroutine parentsurfacefinalize( &
3137  filetype_land, &
3138  filetype_ocean )
3139  use mod_realinput_netcdf, only: &
3140  parentlandfinalizenetcdf, &
3141  parentoceanfinalizenetcdf
3142  implicit none
3143 
3144  character(len=*), intent(in) :: filetype_land
3145  character(len=*), intent(in) :: filetype_ocean
3146  !---------------------------------------------------------------------------
3147 
3148  log_newline
3149  log_info("ParentSurfaceFinalize",*) 'Finalize'
3150 
3151  ! Land
3152 
3153  if( serial_land ) then
3154  if( prc_ismaster ) then
3155  do_read_land = .true.
3156  else
3157  do_read_land = .false.
3158  endif
3159  else
3160  do_read_land = .true.
3161  endif
3162 
3163  select case(trim(filetype_land))
3164  case('NetCDF')
3165 
3166  if ( do_read_ocean ) then
3167  call parentlandfinalizenetcdf
3168  end if
3169 
3170  case('GrADS')
3171 
3172  ! do nothing
3173 
3174  case default
3175 
3176  log_error("ParentSurfaceFinalize",*) 'Unsupported FILE TYPE:', trim(filetype_land)
3177  call prc_abort
3178 
3179  endselect
3180 
3181 
3182  ! Ocean
3183 
3184  if( serial_ocean ) then
3185  if( prc_ismaster ) then
3186  do_read_ocean = .true.
3187  else
3188  do_read_ocean = .false.
3189  endif
3190  else
3191  do_read_ocean = .true.
3192  endif
3193 
3194  select case(trim(filetype_ocean))
3195  case('NetCDF')
3196 
3197  if ( do_read_ocean ) then
3198  call parentoceanfinalizenetcdf
3199  end if
3200 
3201  case('GrADS')
3202 
3203  ! do nothing
3204 
3205  case default
3206 
3207  log_error("ParentSurfaceFinalize",*) 'Unsupported FILE TYPE:', trim(filetype_ocean)
3208  call prc_abort
3209 
3210  endselect
3211 
3212 
3213  deallocate( llon_org )
3214  deallocate( llat_org )
3215 
3216  deallocate( olon_org )
3217  deallocate( olat_org )
3218 
3219  deallocate( oigrd )
3220  deallocate( ojgrd )
3221  deallocate( ohfact )
3222 
3223  deallocate( hfact_ol )
3224  deallocate( igrd_ol )
3225  deallocate( jgrd_ol )
3226 
3227  first_surface = .true.
3228 
3229  return
3230  end subroutine parentsurfacefinalize
3231 
3232  !-----------------------------------------------------------------------------
3234  subroutine boundarysurfacesetup( &
3235  basename, &
3236  title, &
3237  timeintv, &
3238  multi_ocean, &
3239  multi_land, &
3240  fid, &
3241  vid )
3242  use scale_file_cartesc, only: &
3243  file_cartesc_create, &
3244  file_cartesc_def_var, &
3245  file_cartesc_enddef
3246  use scale_time, only: &
3247  nowdate => time_nowdate
3248  implicit none
3249  character(len=*), intent(in) :: basename
3250  character(len=*), intent(in) :: title
3251  real(dp), intent(in) :: timeintv
3252  logical, intent(in) :: multi_ocean
3253  logical, intent(in) :: multi_land
3254  integer, intent(out) :: fid
3255  integer, intent(out) :: vid(10)
3256 
3257  character(len=H_SHORT) :: boundary_out_dtype = 'DEFAULT'
3258  !---------------------------------------------------------------------------
3259 
3260  call file_cartesc_create( basename, title, boundary_out_dtype, fid, date=nowdate )
3261 
3262  if ( multi_land ) then
3263  call file_cartesc_def_var( fid, & ! [IN]
3264  'LAND_TEMP', 'Reference Land Temperature', 'K', & ! [IN]
3265  'LXYT', boundary_out_dtype, & ! [IN]
3266  vid(1), & ! [OUT]
3267  timeintv=timeintv ) ! [IN]
3268  call file_cartesc_def_var( fid, & ! [IN]
3269  'LAND_WATER', 'Reference Land Moisture', 'm3/m3', & ! [IN]
3270  'LXYT', boundary_out_dtype, & ! [IN]
3271  vid(2), & ! [OUT]
3272  timeintv=timeintv ) ! [IN]
3273  call file_cartesc_def_var( fid, & ! [IN]
3274  'LAND_SFC_TEMP', 'Reference Land Surface Temperature', 'K', & ! [IN]
3275  'XYT', boundary_out_dtype, & ! [IN]
3276  vid(3), & ! [OUT]
3277  timeintv=timeintv ) ! [IN]
3278  end if
3279 
3280  if ( multi_ocean ) then
3281  call file_cartesc_def_var( fid, & ! [IN]
3282  'OCEAN_TEMP', 'Reference Ocean Temperature', 'K', & ! [IN]
3283  'OXYT', boundary_out_dtype, & ! [IN]
3284  vid(6), & ! [OUT]
3285  timeintv=timeintv ) ! [IN]
3286  call file_cartesc_def_var( fid, & ! [IN]
3287  'OCEAN_SFC_TEMP', 'Reference Ocean Surface Temperature', 'K', & ! [IN]
3288  'XYT', boundary_out_dtype, & ! [IN]
3289  vid(7), & ! [OUT]
3290  timeintv=timeintv ) ! [IN]
3291  call file_cartesc_def_var( fid, & ! [IN]
3292  'OCEAN_SFC_Z0', 'Reference Ocean Surface Z0', 'm', & ! [IN]
3293  'XYT', boundary_out_dtype, & ! [IN]
3294  vid(10), & ! [OUT]
3295  timeintv=timeintv ) ! [IN]
3296  end if
3297 
3298  call file_cartesc_enddef( fid )
3299 
3300  return
3301  end subroutine boundarysurfacesetup
3302 
3303  !-----------------------------------------------------------------------------
3305  subroutine parentsurfaceinput( &
3306  tg, strg, lst, albg, &
3307  tc_urb, qc_urb, uc_urb, ust, albu, &
3308  lst_ocean, &
3309  lz_org, topo_org, &
3310  lmask_org, omask_org, &
3311  tw, sst, albw, z0w, &
3312  basename_land, basename_ocean, &
3313  mdlid_land, mdlid_ocean, &
3314  ldims, odims, &
3315  use_file_landwater, &
3316  init_landwater_ratio, &
3317 ! init_landwater_ratio_each, &
3318  init_ocean_alb_lw, &
3319  init_ocean_alb_sw, &
3320  init_ocean_z0w, &
3321  intrp_iter_max, &
3322  soilwater_ds2vc_flag, &
3323  elevation_correction_land, &
3324  elevation_correction_ocean, &
3325  oistep, listep, &
3326  multi_land, &
3327  URBAN_do, &
3328  DENS, MOMX, MOMY, RHOT, QTRC )
3329  use scale_comm_cartesc, only: &
3330  comm_bcast, &
3331  comm_vars8, &
3332  comm_wait
3333  use scale_const, only: &
3334  undef => const_undef, &
3335  eps => const_eps, &
3336  laps => const_laps
3337  use scale_topography, only: &
3338  topography_zsfc
3339  use scale_interp, only: &
3340  interp_factor2d, &
3341  interp_interp2d
3342  use scale_atmos_grid_cartesc, only: &
3343  cx => atmos_grid_cartesc_cx, &
3344  cy => atmos_grid_cartesc_cy
3345  use scale_land_grid_cartesc, only: &
3346  lcz => land_grid_cartesc_cz
3347  use scale_landuse, only: &
3348  lsmask_nest => landuse_frac_land, &
3349  landuse_pft_nmax
3350  use mod_realinput_netcdf, only: &
3351  parentoceaninputnetcdf, &
3352  parentlandinputnetcdf
3353  use mod_realinput_grads, only: &
3354  parentoceaninputgrads, &
3355  parentlandinputgrads
3356  implicit none
3357 
3358  real(rp), intent(inout) :: tg (lka,ia,ja)
3359  real(rp), intent(inout) :: strg(lka,ia,ja)
3360  real(rp), intent(inout) :: lst (ia,ja)
3361  real(rp), intent(inout) :: albg(ia,ja,n_rad_dir,n_rad_rgn)
3362  real(rp), intent(inout) :: tc_urb(ia,ja)
3363  real(rp), intent(inout) :: qc_urb(ia,ja)
3364  real(rp), intent(inout) :: uc_urb(ia,ja)
3365  real(rp), intent(inout) :: ust (ia,ja)
3366  real(rp), intent(inout) :: albu (ia,ja,n_rad_dir,n_rad_rgn)
3367  real(rp), intent(inout) :: lst_ocean(oia_org,oja_org)
3368  real(rp), intent(inout) :: tw (ia,ja)
3369  real(rp), intent(inout) :: lz_org(lka_org)
3370  real(rp), intent(inout) :: topo_org(lia_org,lja_org)
3371  real(rp), intent(inout) :: lmask_org(lia_org,lja_org)
3372  real(rp), intent(inout) :: omask_org(oia_org,oja_org)
3373  real(rp), intent(out) :: sst (ia,ja)
3374  real(rp), intent(out) :: albw(ia,ja,n_rad_dir,n_rad_rgn)
3375  real(rp), intent(out) :: z0w (ia,ja)
3376  character(len=*), intent(in) :: basename_land
3377  character(len=*), intent(in) :: basename_ocean
3378  integer, intent(in) :: mdlid_land
3379  integer, intent(in) :: mdlid_ocean
3380  integer, intent(in) :: ldims(3)
3381  integer, intent(in) :: odims(2)
3382  logical, intent(in) :: use_file_landwater ! use land water data from files
3383  real(rp), intent(in) :: init_landwater_ratio ! Ratio of land water to storage is constant,
3384 ! real(RP), intent(in) :: init_landwater_ratio_each(LANDUSE_PFT_nmax) ! Ratio of land water to storage is constant,
3385  ! if use_file_landwater is ".false." (each PFT)
3386  real(rp), intent(in) :: init_ocean_alb_lw
3387  real(rp), intent(in) :: init_ocean_alb_sw
3388  real(rp), intent(in) :: init_ocean_z0w
3389  integer, intent(in) :: intrp_iter_max
3390  logical, intent(in) :: soilwater_ds2vc_flag
3391  logical, intent(in) :: elevation_correction_land
3392  logical, intent(in) :: elevation_correction_ocean
3393  integer, intent(in) :: oistep
3394  integer, intent(in) :: listep
3395  logical, intent(in) :: multi_land
3396  logical, intent(in) :: urban_do
3397 
3398  real(rp), intent(in) :: dens(ka,ia,ja)
3399  real(rp), intent(in) :: momx(ka,ia,ja)
3400  real(rp), intent(in) :: momy(ka,ia,ja)
3401  real(rp), intent(in) :: rhot(ka,ia,ja)
3402  real(rp), intent(in) :: qtrc(ka,ia,ja,qa)
3403 
3404  ! land
3405  real(rp) :: tg_org (lka_org,lia_org,lja_org)
3406  real(rp) :: strg_org (lka_org,lia_org,lja_org)
3407  real(rp) :: smds_org (lka_org,lia_org,lja_org)
3408  real(rp) :: lst_org ( lia_org,lja_org)
3409  real(rp) :: ust_org ( lia_org,lja_org)
3410  real(rp) :: albg_org ( lia_org,lja_org,n_rad_dir,n_rad_rgn)
3411 
3412  ! ocean
3413  real(rp) :: tw_org (oia_org,oja_org)
3414  real(rp) :: sst_org (oia_org,oja_org)
3415  real(rp) :: z0w_org (oia_org,oja_org)
3416  real(rp) :: albw_org (oia_org,oja_org,n_rad_dir,n_rad_rgn)
3417  real(rp) :: omask (oia_org,oja_org)
3418 
3419  ! elevation correction
3420  real(rp) :: work(lia_org,lja_org)
3421 
3422  integer :: i, j
3423  !---------------------------------------------------------------------------
3424 
3425  call prof_rapstart('___SurfaceInput',3)
3426 
3427  if ( do_read_land .and. ( first_surface .or. multi_land ) ) then
3428 
3429  select case( mdlid_land )
3430  case( inetcdf ) ! TYPE: NetCDF
3431 
3432  call parentlandinputnetcdf( &
3433  lka_org, lks_org, lke_org, &
3434  lia_org, lis_org, lie_org, &
3435  lja_org, ljs_org, lje_org, &
3436  tg_org, strg_org, & ! (out)
3437  lst_org, ust_org, albg_org, & ! (out)
3438  topo_org, lmask_org, & ! (inout)
3439  lz_org, & ! (inout)
3440  use_file_landwater, & ! (in)
3441  ldims, & ! (in)
3442  listep ) ! (in)
3443 
3444  case( igrads ) ! TYPE: GrADS format
3445 
3446  call parentlandinputgrads( &
3447  lka_org, lks_org, lke_org, &
3448  lia_org, lis_org, lie_org, &
3449  lja_org, ljs_org, lje_org, &
3450  tg_org, strg_org, smds_org, & ! (out)
3451  lst_org, & ! (out)
3452  lz_org, & ! (out)
3453  topo_org, lmask_org, & ! (out)
3454  use_waterratio, & ! (out)
3455  ldims, & ! (in)
3456  basename_land, & ! (in)
3457  use_file_landwater, & ! (in)
3458  listep ) ! (in)
3459  ust_org = undef
3460  albg_org = undef
3461 
3462  end select
3463 
3464  end if
3465 
3466  call prof_rapend ('___SurfaceInput',3)
3467 
3468  call prof_rapstart('___SurfaceBcast',3)
3469 
3470  if ( serial_land .and. ( first_surface .or. multi_land ) ) then
3471  call comm_bcast( lka_org, lia_org, lja_org, tg_org )
3472  if ( use_waterratio ) then
3473  call comm_bcast( lka_org, lia_org, lja_org, smds_org )
3474  else
3475  call comm_bcast( lka_org, lia_org, lja_org, strg_org )
3476  end if
3477  call comm_bcast( lia_org, lja_org, lst_org )
3478  if ( urban_do ) call comm_bcast( lia_org, lja_org, ust_org )
3479  call comm_bcast( lia_org, lja_org, n_rad_dir, n_rad_rgn, albg_org(:,:,:,:) )
3480  call comm_bcast( lia_org, lja_org, topo_org )
3481  call comm_bcast( lia_org, lja_org, lmask_org )
3482  call comm_bcast( lka_org, lz_org )
3483  end if
3484 
3485  call prof_rapend ('___SurfaceBcast',3)
3486 
3487  call prof_rapstart('___SurfaceInput',3)
3488 
3489  if ( do_read_ocean ) then
3490 
3491  select case( mdlid_ocean )
3492  case( inetcdf ) ! TYPE: NetCDF
3493 
3494  call parentoceaninputnetcdf( &
3495  oia_org, ois_org, oie_org, &
3496  oja_org, ojs_org, oje_org, &
3497  tw_org, sst_org, & ! (out)
3498  albw_org, z0w_org, & ! (out)
3499  omask_org, & ! (inout)
3500  odims, & ! (in)
3501  oistep ) ! (in)
3502 
3503  case( igrads ) ! TYPE: GrADS format
3504 
3505  call parentoceaninputgrads( &
3506  oia_org, ois_org, oie_org, &
3507  oja_org, ojs_org, oje_org, &
3508  tw_org, sst_org, & ! (out)
3509  omask_org, & ! (out)
3510  basename_ocean, odims, & ! (in)
3511  oistep ) ! (in)
3512  albw_org = undef
3513  z0w_org = undef
3514 
3515  end select
3516 
3517  end if
3518 
3519  call prof_rapend ('___SurfaceInput',3)
3520 
3521  call prof_rapstart('___SurfaceBcast',3)
3522 
3523  if ( serial_ocean ) then
3524  call comm_bcast( oia_org, oja_org, tw_org )
3525  call comm_bcast( oia_org, oja_org, sst_org )
3526  call comm_bcast( oia_org, oja_org, n_rad_dir, n_rad_rgn, albw_org(:,:,:,:) )
3527 
3528  call comm_bcast( oia_org, oja_org, z0w_org )
3529  call comm_bcast( oia_org, oja_org, omask_org )
3530  end if
3531 
3532  call prof_rapend ('___SurfaceBcast',3)
3533 
3534  call prof_rapstart('___SurfaceInterp',3)
3535 
3536  if ( first_surface ) then
3537 
3538  if ( lia_org .ne. oia_org &
3539  .or. lja_org .ne. oja_org ) then
3540  ol_interp = .true.
3541  else
3542  ol_interp = .false.
3543  outer: do j = 1, lja_org
3544  do i = 1, lia_org
3545  if ( llon_org(i,j) .ne. olon_org(i,j) &
3546  .or. llat_org(i,j) .ne. olat_org(i,j) ) then
3547  ol_interp = .true.
3548  exit outer
3549  end if
3550  end do
3551  end do outer
3552  end if
3553 
3554  if ( ol_interp ) then
3555  ! interpolation factor between outer ocean grid and land grid
3556  call interp_factor2d( itp_nh_ol, & ! [IN]
3557  lia_org, lja_org, & ! [IN]
3558  oia_org, oja_org, & ! [IN]
3559  llon_org(:,:), & ! [IN]
3560  llat_org(:,:), & ! [IN]
3561  olon_org(:,:), & ! [IN]
3562  olat_org(:,:), & ! [IN]
3563  igrd_ol(:,:,:), & ! [OUT]
3564  jgrd_ol(:,:,:), & ! [OUT]
3565  hfact_ol(:,:,:) ) ! [OUT]
3566  end if
3567  end if
3568 
3569 
3570  ! Ocean temp: interpolate over the land
3571  if ( i_intrp_ocean_temp .ne. i_intrp_off ) then
3572  select case( i_intrp_ocean_temp )
3573  case( i_intrp_mask )
3574  call make_mask( omask, tw_org, oia_org, oja_org, landdata=.false.)
3575  !$omp parallel do
3576  do j = 1, oja_org
3577  do i = 1, oia_org
3578  if ( omask_org(i,j) .ne. undef ) omask(i,j) = omask_org(i,j)
3579  end do
3580  end do
3581  case( i_intrp_fill )
3582  call make_mask( omask, tw_org, oia_org, oja_org, landdata=.false.)
3583  end select
3584  call interp_oceanland_data(tw_org, omask, oia_org, oja_org, .false., intrp_iter_max)
3585  end if
3586 
3587  ! SST: interpolate over the land
3588  if ( i_intrp_ocean_sfc_temp .ne. i_intrp_off ) then
3589  select case( i_intrp_ocean_sfc_temp )
3590  case( i_intrp_mask )
3591  call make_mask( omask, sst_org, oia_org, oja_org, landdata=.false.)
3592  !$omp parallel do
3593  do j = 1, oja_org
3594  do i = 1, oia_org
3595  if ( omask_org(i,j) .ne. undef ) omask(i,j) = omask_org(i,j)
3596  end do
3597  end do
3598  case( i_intrp_fill )
3599  call make_mask( omask, sst_org, oia_org, oja_org, landdata=.false.)
3600  end select
3601  call interp_oceanland_data(sst_org, omask, oia_org, oja_org, .false., intrp_iter_max)
3602  end if
3603 
3604  if ( first_surface .or. multi_land ) then
3605 
3606  call land_interporation( &
3607  lka_org, lia_org, lja_org, &
3608  oia_org, oja_org, &
3609  tg(:,:,:), strg(:,:,:), & ! (out)
3610  lst(:,:), albg(:,:,:,:), & ! (out)
3611  tg_org, strg_org, smds_org, & ! (inout)
3612  lst_org, albg_org, & ! (inout)
3613  sst_org, & ! (in)
3614  lmask_org, & ! (in)
3615  lsmask_nest, & ! (in)
3616  topo_org, & ! (in)
3617  lz_org, llon_org, llat_org, & ! (in)
3618  lcz, cx, cy, lon, lat, & ! (in)
3619  maskval_tg, maskval_strg, & ! (in)
3620  init_landwater_ratio, & ! (in)
3621  ! init_landwater_ratio_each(:), & ! (in)
3622  use_file_landwater, & ! (in)
3623  use_waterratio, & ! (in)
3624  soilwater_ds2vc_flag, & ! (in)
3625  elevation_correction_land, & ! (in)
3626  intrp_iter_max, & ! (in)
3627  ol_interp ) ! (in)
3628 
3629  !$omp parallel do
3630  do j = 1, lja_org
3631  do i = 1, lia_org
3632  if ( topo_org(i,j) > undef ) then ! ignore UNDEF value
3633  work(i,j) = lst_org(i,j) + topo_org(i,j) * laps
3634  else
3635  work(i,j) = lst_org(i,j)
3636  end if
3637  end do
3638  end do
3639 
3640  if ( ol_interp ) then
3641  ! land surface temperature at ocean grid
3642  call interp_interp2d( itp_nh_ol, & ! [IN]
3643  lia_org, lja_org, & ! [IN]
3644  oia_org, oja_org, & ! [IN]
3645  igrd_ol(:,:,:), & ! [IN]
3646  jgrd_ol(:,:,:), & ! [IN]
3647  hfact_ol(:,:,:), & ! [IN]
3648  work(:,:), & ! [IN]
3649  lst_ocean(:,:) ) ! [OUT]
3650  else
3651  !$omp parallel do
3652  do j = 1, oja_org
3653  do i = 1, oia_org
3654  lst_ocean(i,j) = work(i,j)
3655  end do
3656  end do
3657  end if
3658 
3659  end if
3660 
3661  call replace_misval_map( sst_org, lst_ocean, oia_org, oja_org, "SST" )
3662  call replace_misval_map( tw_org, lst_ocean, oia_org, oja_org, "OCEAN_TEMP" )
3663 
3664  call ocean_interporation( oia_org, oja_org, & ! (in)
3665  sst_org(:,:), tw_org(:,:), & ! (in)
3666  albw_org(:,:,:,:), z0w_org(:,:), & ! (inout)
3667  cx(:), cy(:), & ! (in)
3668  elevation_correction_ocean, & ! (in)
3669  init_ocean_alb_lw, init_ocean_alb_sw, & ! (in)
3670  init_ocean_z0w, & ! (in)
3671  first_surface, & ! (in)
3672  sst(:,:), tw(:,:), & ! (out)
3673  albw(:,:,:,:), z0w(:,:) ) ! (out)
3674 
3675 
3676  if ( first_surface .or. multi_land ) then
3677  ! replace values over the ocean ####
3678  !$omp parallel do
3679  do j = 1, ja
3680  do i = 1, ia
3681  if( abs(lsmask_nest(i,j)-0.0_rp) < eps ) then ! ocean grid
3682  lst(i,j) = sst(i,j)
3683  endif
3684  enddo
3685  enddo
3686  end if
3687 
3688 
3689  if ( urban_do .and. first_surface ) then
3690  call urban_input( lst(:,:), albg(:,:,:,:), & ! [IN]
3691  dens, momx, momy, rhot, qtrc, & ! [IN]
3692  tc_urb(:,:), qc_urb(:,:), uc_urb(:,:), & ! [OUT]
3693  ust(:,:), albu(:,:,:,:) ) ! [OUT]
3694  end if
3695 
3696 
3697  first_surface = .false.
3698 
3699  call prof_rapend ('___SurfaceInterp',3)
3700 
3701 
3702  return
3703  end subroutine parentsurfaceinput
3704 
3705  !-----------------------------------------------------------------------------
3707  subroutine boundarysurfaceoutput( &
3708  tg, &
3709  strg, &
3710  lst, &
3711  tw, &
3712  sst, &
3713  z0, &
3714  multi_ocean, &
3715  multi_land, &
3716  fid, &
3717  vid, &
3718  timeintv, &
3719  istep )
3720  use scale_const, only: &
3721  i_sw => const_i_sw, &
3722  i_lw => const_i_lw
3723  use scale_file_cartesc, only: &
3724  file_cartesc_create, &
3725  file_cartesc_def_var, &
3726  file_cartesc_enddef, &
3727  file_cartesc_write_var
3728  use scale_time, only: &
3729  time_nowdate
3730  implicit none
3731 
3732  real(rp), intent(in) :: tg(lka,ia,ja,1)
3733  real(rp), intent(in) :: strg(lka,ia,ja,1)
3734  real(rp), intent(in) :: lst(ia,ja,1)
3735  real(rp), intent(in) :: tw(1,ia,ja,1)
3736  real(rp), intent(in) :: sst(ia,ja,1)
3737  real(rp), intent(in) :: z0(ia,ja,1)
3738  logical, intent(in) :: multi_ocean
3739  logical, intent(in) :: multi_land
3740  integer, intent(in) :: fid
3741  integer, intent(in) :: vid(10)
3742  real(dp), intent(in) :: timeintv
3743  integer, intent(in) :: istep
3744 
3745  real(dp) :: timeofs
3746  !---------------------------------------------------------------------------
3747 
3748  call prof_rapstart('___SurfaceOutput',3)
3749 
3750  timeofs = (istep - 1) * timeintv
3751 
3752  if ( multi_land ) then
3753  call file_cartesc_write_var( fid, vid(1), tg(:,:,:,:), 'LAND_TEMP', 'LXYT', timeintv, timeofs=timeofs )
3754  call file_cartesc_write_var( fid, vid(2), strg(:,:,:,:), 'LAND_WATER', 'LXYT', timeintv, timeofs=timeofs )
3755  call file_cartesc_write_var( fid, vid(3), lst(:,:,:), 'LAND_SFC_TEMP', 'XYT', timeintv, timeofs=timeofs )
3756  end if
3757 
3758  if ( multi_ocean ) then
3759  call file_cartesc_write_var( fid, vid(6), tw(:,:,:,:), 'OCEAN_TEMP', 'OXYT', timeintv, timeofs=timeofs )
3760  call file_cartesc_write_var( fid, vid(7), sst(:,:,:), 'OCEAN_SFC_TEMP', 'XYT', timeintv, timeofs=timeofs )
3761  call file_cartesc_write_var( fid, vid(10), z0(:,:,:), ' OCEAN_SFC_Z0', 'XYT', timeintv, timeofs=timeofs )
3762  end if
3763 
3764  call prof_rapend ('___SurfaceOutput',3)
3765 
3766  return
3767  end subroutine boundarysurfaceoutput
3768 
3769 
3770  !-------------------------------
3771  subroutine land_interporation( &
3772  kmax, imax, jmax, oimax,ojmax, &
3773  tg, strg, lst, albg, &
3774  tg_org, strg_org, smds_org, &
3775  lst_org, albg_org, &
3776  sst_org, &
3777  lmask_org, lsmask_nest, &
3778  topo_org, &
3779  lz_org, llon_org, llat_org, &
3780  LCZ, CX, CY, &
3781  LON, LAT, &
3782  maskval_tg, maskval_strg, &
3783  init_landwater_ratio, &
3784 ! init_landwater_ratio_each, &
3785  use_file_landwater, &
3786  use_waterratio, &
3787  soilwater_ds2vc_flag, &
3788  elevation_correction, &
3789  intrp_iter_max, &
3790  ol_interp )
3791  use scale_prc, only: &
3792  prc_abort
3793  use scale_const, only: &
3794  undef => const_undef, &
3795  eps => const_eps, &
3796  i_sw => const_i_sw, &
3797  i_lw => const_i_lw, &
3798  pi => const_pi, &
3799  laps => const_laps
3800  use scale_interp, only: &
3801  interp_factor2d, &
3802  interp_factor3d, &
3803  interp_interp2d, &
3804  interp_interp3d
3805  use scale_mapprojection, only: &
3806  mapprojection_lonlat2xy
3807  use scale_comm_cartesc, only: &
3808  comm_vars8, &
3809  comm_wait
3810  use scale_filter, only: &
3811  filter_hyperdiff
3812  use scale_topography, only: &
3813  topography_zsfc
3814  use scale_landuse, only: &
3815  landuse_pft_nmax, &
3816  landuse_index_pft
3817  use mod_land_vars, only: &
3818  convert_ws2vwc
3819  implicit none
3820  integer, intent(in) :: kmax, imax, jmax
3821  integer, intent(in) :: oimax, ojmax
3822  real(RP), intent(out) :: tg(LKMAX,IA,JA)
3823  real(RP), intent(out) :: strg(LKMAX,IA,JA)
3824  real(RP), intent(out) :: lst(IA,JA)
3825  real(RP), intent(out) :: albg(IA,JA,N_RAD_DIR,N_RAD_RGN)
3826  real(RP), intent(inout) :: tg_org(kmax,imax,jmax)
3827  real(RP), intent(inout) :: strg_org(kmax,imax,jmax)
3828  real(RP), intent(inout) :: smds_org(kmax,imax,jmax)
3829  real(RP), intent(inout) :: lst_org(imax,jmax)
3830  real(RP), intent(inout) :: albg_org(imax,jmax,N_RAD_DIR,N_RAD_RGN)
3831  real(RP), intent(inout) :: sst_org(oimax,ojmax)
3832  real(RP), intent(in) :: lmask_org(imax,jmax)
3833  real(RP), intent(in) :: lsmask_nest(IA,JA)
3834  real(RP), intent(in) :: topo_org(imax,jmax)
3835  real(RP), intent(in) :: lz_org(kmax)
3836  real(RP), intent(in) :: llon_org(imax,jmax)
3837  real(RP), intent(in) :: llat_org(imax,jmax)
3838  real(RP), intent(in) :: LCZ(LKMAX)
3839  real(RP), intent(in) :: CX(IA)
3840  real(RP), intent(in) :: CY(JA)
3841  real(RP), intent(in) :: LON(IA,JA)
3842  real(RP), intent(in) :: LAT(IA,JA)
3843  real(RP), intent(in) :: maskval_tg
3844  real(RP), intent(in) :: maskval_strg
3845  real(RP), intent(in) :: init_landwater_ratio
3846 ! real(RP), intent(in) :: init_landwater_ratio_each(LANDUSE_PFT_nmax)
3847  logical, intent(in) :: use_file_landwater
3848  logical, intent(in) :: use_waterratio
3849  logical, intent(in) :: soilwater_ds2vc_flag
3850  logical, intent(in) :: elevation_correction
3851  integer, intent(in) :: intrp_iter_max
3852  logical, intent(in) :: ol_interp
3853 
3854  real(RP) :: lmask(imax,jmax)
3855  real(RP) :: smds(LKMAX,IA,JA)
3856 
3857  ! data for interporation
3858  real(RP) :: hfact_l(imax,jmax,itp_nh_ol)
3859  integer :: igrd_l (imax,jmax,itp_nh_ol)
3860  integer :: jgrd_l (imax,jmax,itp_nh_ol)
3861  real(RP) :: lX_org (imax,jmax)
3862  real(RP) :: lY_org (imax,jmax)
3863  logical :: zonal, pole
3864  integer :: igrd ( IA,JA,itp_nh_l)
3865  integer :: jgrd ( IA,JA,itp_nh_l)
3866  real(RP) :: hfact( IA,JA,itp_nh_l)
3867  integer :: kgrdl (LKMAX,2,IA,JA,itp_nh_l)
3868  real(RP) :: vfactl(LKMAX, IA,JA,itp_nh_l)
3869 
3870 
3871  real(RP) :: sst_land(imax,jmax)
3872  real(RP) :: work (imax,jmax)
3873  real(RP) :: work2(imax,jmax)
3874 
3875  real(RP) :: lz3d_org(kmax,imax,jmax)
3876  real(RP) :: lcz_3D(LKMAX,IA,JA)
3877 
3878  ! elevation correction
3879  real(RP) :: topo(IA,JA)
3880  real(RP) :: tdiff
3881 
3882  real(RP) :: one2d(IA,JA)
3883  real(RP) :: one3d(LKMAX,IA,JA)
3884 
3885  integer :: k, i, j, m, n
3886 
3887 
3888  ! Surface skin temp: interpolate over the ocean
3889  if ( i_intrp_land_sfc_temp .ne. i_intrp_off ) then
3890  select case( i_intrp_land_sfc_temp )
3891  case( i_intrp_mask )
3892  call make_mask( lmask, lst_org, imax, jmax, landdata=.true.)
3893  !$omp parallel do
3894  do j = 1, jmax
3895  do i = 1, imax
3896  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
3897  end do
3898  end do
3899  case( i_intrp_fill )
3900  call make_mask( lmask, lst_org, imax, jmax, landdata=.true.)
3901  case default
3902  log_error("land_interporation",*) 'INTRP_LAND_SFC_TEMP is invalid.'
3903  call prc_abort
3904  end select
3905  call interp_oceanland_data(lst_org, lmask, imax, jmax, .true., intrp_iter_max)
3906  end if
3907 
3908  if ( ol_interp ) then
3909  ! interpolation facter between outer land grid and ocean grid
3910  call interp_factor2d( itp_nh_ol, & ! [IN]
3911  oimax, ojmax, & ! [IN]
3912  imax, jmax, & ! [IN]
3913  olon_org(:,:), & ! [IN]
3914  olat_org(:,:), & ! [IN]
3915  llon_org(:,:), & ! [IN]
3916  llat_org(:,:), & ! [IN]
3917  igrd_l(:,:,:), & ! [OUT]
3918  jgrd_l(:,:,:), & ! [OUT]
3919  hfact_l(:,:,:) ) ! [OUT]
3920 
3921  ! sst on land grid
3922  call interp_interp2d( itp_nh_ol, & ! [IN]
3923  oimax, ojmax, & ! [IN]
3924  imax, jmax, & ! [IN]
3925  igrd_l(:,:,:), & ! [IN]
3926  jgrd_l(:,:,:), & ! [IN]
3927  hfact_l(:,:,:), & ! [IN]
3928  sst_org(:,:), & ! [IN]
3929  sst_land(:,:) ) ! [OUT]
3930  else
3931  !$omp parallel do
3932  do j = 1, jmax
3933  do i = 1, imax
3934  sst_land(i,j) = sst_org(i,j)
3935  end do
3936  end do
3937  end if
3938 
3939  !$omp parallel do
3940  do j = 1, jmax
3941  do i = 1, imax
3942  if ( topo_org(i,j) > undef + eps ) then ! ignore UNDEF value
3943  sst_land(i,j) = sst_land(i,j) - topo_org(i,j) * laps
3944  end if
3945  end do
3946  end do
3947 
3948  call replace_misval_map( lst_org, sst_land, imax, jmax, "SKINT" )
3949 
3950  ! replace missing value
3951  !$omp parallel do
3952  do j = 1, jmax
3953  do i = 1, imax
3954 ! if ( skinw_org(i,j) == UNDEF ) skinw_org(i,j) = 0.0_RP
3955 ! if ( snowq_org(i,j) == UNDEF ) snowq_org(i,j) = 0.0_RP
3956 ! if ( snowt_org(i,j) == UNDEF ) snowt_org(i,j) = TEM00
3957  do m = 1, n_rad_dir
3958  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
3959  if( albg_org(i,j,m,i_r_nir) == undef ) albg_org(i,j,m,i_r_nir) = 0.22_rp
3960  if( albg_org(i,j,m,i_r_vis) == undef ) albg_org(i,j,m,i_r_vis) = 0.22_rp
3961  end do
3962  end do
3963  end do
3964 
3965  ! Land temp: interpolate over the ocean
3966  if ( i_intrp_land_temp .ne. i_intrp_off ) then
3967  do k = 1, kmax
3968  !$omp parallel do
3969  do j = 1, jmax
3970  do i = 1, imax
3971  work(i,j) = tg_org(k,i,j)
3972  end do
3973  end do
3974  select case( i_intrp_land_temp )
3975  case( i_intrp_mask )
3976  call make_mask( lmask, work, imax, jmax, landdata=.true.)
3977  !$omp parallel do
3978  do j = 1, jmax
3979  do i = 1, imax
3980  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
3981  end do
3982  end do
3983  case( i_intrp_fill )
3984  call make_mask( lmask, work, imax, jmax, landdata=.true.)
3985  end select
3986  call interp_oceanland_data( work, lmask, imax, jmax, .true., intrp_iter_max )
3987  !replace land temp using skin temp
3988  call replace_misval_map( work, lst_org, imax, jmax, "STEMP")
3989  !$omp parallel do
3990  do j = 1, jmax
3991  do i = 1, imax
3992  tg_org(k,i,j) = work(i,j)
3993  end do
3994  end do
3995  end do
3996  end if
3997 
3998 
3999  ! fill grid data
4000  !$omp parallel do collapse(2)
4001  do j = 1, jmax
4002  do i = 1, imax
4003  lz3d_org(:,i,j) = lz_org(:)
4004  end do
4005  end do
4006 
4007  !$omp parallel do collapse(2)
4008  do j = 1, ja
4009  do i = 1, ia
4010  lcz_3d(:,i,j) = lcz(:)
4011  enddo
4012  enddo
4013 
4014  select case( itp_type_l )
4015  case ( i_intrp_linear )
4016 
4017  if ( imax == 1 .or. jmax == 1 ) then
4018  log_error("land_interporation",*) 'LINER interpolation requires nx, ny > 1'
4019  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_LAND'
4020  call prc_abort
4021  end if
4022 
4023  !$omp parallel do
4024  do j = 1, jmax
4025  do i = 1, imax
4026  work(i,j) = sign( min( abs(llat_org(i,j)), pi * 0.499999_rp ), llat_org(i,j) )
4027  end do
4028  end do
4029 
4030  call mapprojection_lonlat2xy( imax, 1, imax, jmax, 1, jmax, &
4031  llon_org(:,:), work(:,:), & ! [IN]
4032  lx_org(:,:), ly_org(:,:) ) ! [OUT]
4033 
4034  zonal = ( maxval(llon_org) - minval(llon_org) ) > 2.0_rp * pi * 0.9_rp
4035  pole = ( maxval(llat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(llat_org) < - pi * 0.5_rp * 0.9_rp )
4036  call interp_factor3d( kmax, 1, kmax, & ! [IN]
4037  imax, jmax, & ! [IN]
4038  lkmax, lks, lke, & ! [IN]
4039  ia, ja, & ! [IN]
4040  lx_org(:,:), & ! [IN]
4041  ly_org(:,:), & ! [IN]
4042  lz3d_org(:,:,:), & ! [IN]
4043  cx(:), cy(:), & ! [IN]
4044  lcz_3d(:,:,:), & ! [IN]
4045  igrd( :,:,:), & ! [OUT]
4046  jgrd( :,:,:), & ! [OUT]
4047  hfact( :,:,:), & ! [OUT]
4048  kgrdl(:,:,:,:,:), & ! [OUT]
4049  vfactl(:, :,:,:), & ! [OUT]
4050  flag_extrap = .true., & ! [IN, optional]
4051  zonal = zonal, & ! [IN, optional]
4052  pole = pole ) ! [IN, optional]
4053 
4054  case ( i_intrp_dstwgt )
4055 
4056  call interp_factor3d( itp_nh_l, & ! [IN]
4057  kmax, 1, kmax, & ! [IN]
4058  imax, jmax, & ! [IN]
4059  lkmax, lks, lke, & ! [IN]
4060  ia, ja, & ! [IN]
4061  llon_org(:,:), & ! [IN]
4062  llat_org(:,:), & ! [IN]
4063  lz3d_org(:,:,:), & ! [IN]
4064  lon(:,:), lat(:,:), & ! [IN]
4065  lcz_3d(:,:,:), & ! [IN]
4066  igrd( :,:,:), & ! [OUT]
4067  jgrd( :,:,:), & ! [OUT]
4068  hfact( :,:,:), & ! [OUT]
4069  kgrdl(:,:,:,:,:), & ! [OUT]
4070  vfactl(:, :,:,:), & ! [OUT]
4071  flag_extrap = .true. ) ! [IN, optional]
4072 
4073  end select
4074 
4075  call interp_interp2d( itp_nh_l, & ! [IN]
4076  imax, jmax, & ! [IN]
4077  ia, ja, & ! [IN]
4078  igrd(:,:,:), & ! [IN]
4079  jgrd(:,:,:), & ! [IN]
4080  hfact(:,:,:), & ! [IN]
4081  lst_org(:,:), & ! [IN]
4082  lst(:,:) ) ! [OUT]
4083  if ( filter_niter > 0 ) then
4084  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4085  lst(:,:), filter_order, filter_niter )
4086  call comm_vars8( lst(:,:), 1 )
4087  call comm_wait ( lst(:,:), 1, .false. )
4088  end if
4089 
4090 
4091  if ( filter_niter > 0 ) then
4092  !$omp parallel do
4093  do j = 1, ja
4094  do i = 1, ia
4095  one2d(i,j) = 1.0_rp
4096  end do
4097  end do
4098  end if
4099 
4100  do n = 1, n_rad_rgn
4101  do m = 1, n_rad_dir
4102 
4103  call interp_interp2d( itp_nh_l, & ! [IN]
4104  imax, jmax, & ! [IN]
4105  ia, ja, & ! [IN]
4106  igrd(:,:,:), & ! [IN]
4107  jgrd(:,:,:), & ! [IN]
4108  hfact(:,:,:), & ! [IN]
4109  albg_org(:,:,m,n), & ! [IN]
4110  albg(:,:,m,n) ) ! [OUT]
4111  if ( filter_niter > 0 ) then
4112  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4113  albg(:,:,m,n), filter_order, filter_niter, &
4114  limiter_sign = one2d(:,:) )
4115  call comm_vars8( albg(:,:,m,n), 1 )
4116  call comm_wait ( albg(:,:,m,n), 1, .false. )
4117  end if
4118  end do
4119  end do
4120 
4121  call interp_interp3d( itp_nh_l, &
4122  kmax, 1, kmax, &
4123  imax, jmax, &
4124  lkmax, lks, lke, &
4125  ia, ja, &
4126  igrd( :,:,:), & ! [IN]
4127  jgrd( :,:,:), & ! [IN]
4128  hfact( :,:,:), & ! [IN]
4129  kgrdl(:,:,:,:,:), & ! [IN]
4130  vfactl(:, :,:,:), & ! [IN]
4131  lz3d_org(:,:,:), & ! [IN]
4132  lcz_3d(:,:,:), & ! [IN]
4133  tg_org(:,:,:), & ! [IN]
4134  tg(:,:,:) ) ! [OUT]
4135 
4136  !$omp parallel do
4137  do j = 1, ja
4138  do i = 1, ia
4139  tg(lkmax,i,j) = tg(lkmax-1,i,j)
4140  enddo
4141  enddo
4142 
4143  ! replace values over the ocean
4144  do k = 1, lkmax
4145  call replace_misval_const( tg(k,:,:), maskval_tg, lsmask_nest )
4146  enddo
4147  if ( filter_niter > 0 ) then
4148  call filter_hyperdiff( lkmax, 1, lkmax, ia, isb, ieb, ja, jsb, jeb, &
4149  tg(:,:,:), filter_order, filter_niter )
4150  call comm_vars8( tg(:,:,:), 1 )
4151  call comm_wait ( tg(:,:,:), 1, .false. )
4152  end if
4153 
4154 
4155  ! elevation correction
4156  if ( elevation_correction ) then
4157  call interp_interp2d( itp_nh_l, & ! [IN]
4158  imax, jmax, & ! [IN]
4159  ia, ja, & ! [IN]
4160  igrd(:,:,:), & ! [IN]
4161  jgrd(:,:,:), & ! [IN]
4162  hfact(:,:,:), & ! [IN]
4163  topo_org(:,:), & ! [IN]
4164  topo(:,:) ) ! [OUT]
4165  if ( filter_niter > 0 ) then
4166  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4167  topo(:,:), filter_order, filter_niter )
4168  call comm_vars8( topo(:,:), 1 )
4169  call comm_wait ( topo(:,:), 1, .false. )
4170  end if
4171 
4172  !$omp parallel do &
4173  !$omp private(tdiff)
4174  do j = 1, ja
4175  do i = 1, ia
4176  if ( topo(i,j) > undef + eps ) then ! ignore UNDEF value
4177  tdiff = ( topography_zsfc(i,j) - topo(i,j) ) * laps
4178  lst(i,j) = lst(i,j) - tdiff
4179  do k = 1, lkmax
4180  tg(k,i,j) = tg(k,i,j) - tdiff
4181  end do
4182  end if
4183  end do
4184  end do
4185 
4186  end if
4187 
4188 
4189 
4190  ! Land water: interpolate over the ocean
4191  if( use_file_landwater )then
4192 
4193  if ( use_waterratio ) then
4194 
4195  if ( i_intrp_land_water .ne. i_intrp_off ) then
4196  do k = 1, kmax
4197  !$omp parallel do
4198  do j = 1, jmax
4199  do i = 1, imax
4200  work(i,j) = smds_org(k,i,j)
4201  end do
4202  end do
4203  select case( i_intrp_land_water )
4204  case( i_intrp_mask )
4205  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4206  !$omp parallel do
4207  do j = 1, jmax
4208  do i = 1, imax
4209  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
4210  end do
4211  end do
4212  case( i_intrp_fill )
4213  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4214  end select
4215  call interp_oceanland_data(work, lmask, imax, jmax, .true., intrp_iter_max)
4216  !$omp parallel do
4217  do j = 1, jmax
4218  do i = 1, imax
4219 ! work2(i,j) = init_landwater_ratio_each( LANDUSE_index_PFT(i,j,1) )
4220  work2(i,j) = init_landwater_ratio
4221  end do
4222  end do
4223  !replace missing value to init_landwater_ratio_each
4224  call replace_misval_map( work, work2, imax, jmax, "SMOISDS")
4225  !$omp parallel do
4226  do j = 1, jmax
4227  do i = 1, imax
4228  smds_org(k,i,j) = work(i,j)
4229  end do
4230  end do
4231  enddo
4232  end if
4233 
4234  call interp_interp3d( itp_nh_l, &
4235  kmax, 1, kmax, &
4236  imax, jmax, &
4237  lkmax, lks, lke, &
4238  ia, ja, &
4239  igrd( :,:,:), & ! [IN]
4240  jgrd( :,:,:), & ! [IN]
4241  hfact( :,:,:), & ! [IN]
4242  kgrdl(:,:,:,:,:), & ! [IN]
4243  vfactl(:, :,:,:), & ! [IN]
4244  lz3d_org(:,:,:), & ! [IN]
4245  lcz_3d(:,:,:), & ! [IN]
4246  smds_org(:,:,:), & ! [IN]
4247  smds(:,:,:) ) ! [OUT]
4248 
4249  do k = 1, lkmax-1
4250  strg(k,:,:) = convert_ws2vwc( smds(k,:,:), critical=soilwater_ds2vc_flag )
4251  end do
4252 
4253  else
4254 
4255  if ( i_intrp_land_water .ne. i_intrp_off ) then
4256  do k = 1, kmax
4257  !$omp parallel do
4258  do j = 1, jmax
4259  do i = 1, imax
4260  work(i,j) = strg_org(k,i,j)
4261  end do
4262  end do
4263  select case( i_intrp_land_water )
4264  case( i_intrp_mask )
4265  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4266  !$omp parallel do
4267  do j = 1, jmax
4268  do i = 1, imax
4269  if ( lmask_org(i,j) .ne. undef ) lmask(i,j) = lmask_org(i,j)
4270  end do
4271  end do
4272  case( i_intrp_fill )
4273  call make_mask( lmask, work, imax, jmax, landdata=.true.)
4274  end select
4275  call interp_oceanland_data(work, lmask, imax, jmax, .true., intrp_iter_max)
4276  !$omp parallel do
4277  do j = 1, jmax
4278  do i = 1, imax
4279  lmask(i,j) = maskval_strg
4280  end do
4281  end do
4282  !replace missing value to init_landwater_ratio
4283  call replace_misval_map( work, lmask, imax, jmax, "SMOIS")
4284  !$omp parallel do
4285  do j = 1, jmax
4286  do i = 1, imax
4287  strg_org(k,i,j) = work(i,j)
4288  end do
4289  end do
4290  enddo
4291  end if
4292 
4293  call interp_interp3d( itp_nh_l, &
4294  kmax, 1, kmax, &
4295  imax, jmax, &
4296  lkmax, lks, lke, &
4297  ia, ja, &
4298  igrd( :,:,:), & ! [IN]
4299  jgrd( :,:,:), & ! [IN]
4300  hfact( :,:,:), & ! [IN]
4301  kgrdl(:,:,:,:,:), & ! [IN]
4302  vfactl(:, :,:,:), & ! [IN]
4303  lz3d_org(:,:,:), & ! [IN]
4304  lcz_3d(:,:,:), & ! [IN]
4305  strg_org(:,:,:), & ! [IN]
4306  strg(:,:,:) ) ! [OUT]
4307  end if
4308 
4309  ! replace values over the ocean
4310  do k = 1, lkmax-1
4311  call replace_misval_const( strg(k,:,:), maskval_strg, lsmask_nest )
4312  enddo
4313 
4314  !$omp parallel do collapse(2)
4315  do j = 1, ja
4316  do i = 1, ia
4317  do k = 1, lkmax
4318  strg(k,i,j) = max( min( strg(k,i,j), 1.0_rp ), 0.0_rp )
4319  end do
4320  end do
4321  end do
4322 
4323  if ( filter_niter > 0 ) then
4324  !$omp parallel do collapse(2)
4325  do j = 1, ja
4326  do i = 1, ia
4327  do k = 1, lkmax-1
4328  one3d(k,i,j) = 1.0_rp
4329  end do
4330  end do
4331  end do
4332  call filter_hyperdiff( lkmax, 1, lkmax-1, ia, isb, ieb, ja, jsb, jeb, &
4333  strg(:,:,:), filter_order, filter_niter, &
4334  limiter_sign = one3d(:,:,:) )
4335  call comm_vars8( strg(:,:,:), 1 )
4336  call comm_wait ( strg(:,:,:), 1, .false. )
4337  end if
4338 
4339  !$omp parallel do
4340  do j = 1, ja
4341  do i = 1, ia
4342  strg(lkmax,i,j) = strg(lkmax-1,i,j)
4343  enddo
4344  enddo
4345 
4346  else ! not read from boundary file
4347 
4348  do k = 1, lkmax
4349  !$omp parallel do
4350  do j = 1, ja
4351  do i = 1, ia
4352 ! work(i,j) = init_landwater_ratio_each( LANDUSE_index_PFT(i,j,1) )
4353  work(i,j) = init_landwater_ratio
4354  end do
4355  end do
4356  ! conversion from water saturation [fraction] to volumetric water content [m3/m3]
4357  strg(k,:,:) = convert_ws2vwc( work(:,:), critical=soilwater_ds2vc_flag )
4358  end do
4359 
4360  endif ! use_file_waterratio
4361 
4362 
4363  return
4364  end subroutine land_interporation
4365 
4366  subroutine ocean_interporation( &
4367  imax, jmax, &
4368  sst_org, tw_org, albw_org, z0w_org, &
4369  CX, CY, &
4370  elevation_correction_ocean, &
4371  init_ocean_alb_lw, init_ocean_alb_sw, &
4372  init_ocean_z0w, &
4373  first_surface, &
4374  sst, tw, albw, z0w )
4375  use scale_const, only: &
4376  undef => const_undef, &
4377  pi => const_pi, &
4378  laps => const_laps
4379  use scale_topography, only: &
4380  topography_zsfc
4381  use scale_interp, only: &
4382  interp_factor2d, &
4383  interp_interp2d
4384  use scale_filter, only: &
4385  filter_hyperdiff
4386  use scale_mapprojection, only: &
4387  mapprojection_lonlat2xy
4388  use scale_comm_cartesc, only: &
4389  comm_vars8, &
4390  comm_wait
4391  implicit none
4392  integer, intent(in) :: imax, jmax
4393  real(RP), intent(in) :: sst_org (imax,jmax)
4394  real(RP), intent(in) :: tw_org (imax,jmax)
4395  real(RP), intent(inout) :: albw_org(imax,jmax,N_RAD_DIR,N_RAD_RGN)
4396  real(RP), intent(inout) :: z0w_org (imax,jmax)
4397  real(RP), intent(in) :: CX(IA)
4398  real(RP), intent(in) :: CY(JA)
4399  logical, intent(in) :: elevation_correction_ocean
4400  real(RP), intent(in) :: init_ocean_alb_lw
4401  real(RP), intent(in) :: init_ocean_alb_sw
4402  real(RP), intent(in) :: init_ocean_z0w
4403  logical, intent(in) :: first_surface
4404 
4405  real(RP), intent(out) :: sst (IA,JA)
4406  real(RP), intent(out) :: tw (IA,JA)
4407  real(RP), intent(out) :: albw(IA,JA,N_RAD_DIR,N_RAD_RGN)
4408  real(RP), intent(out) :: z0w (IA,JA)
4409 
4410  ! for interpolation
4411  real(RP) :: oX_org(imax,jmax)
4412  real(RP) :: oY_org(imax,jmax)
4413  logical :: zonal, pole
4414 
4415  real(RP) :: one(IA,JA)
4416  real(RP) :: tdiff
4417 
4418  integer :: i, j, m, n
4419 
4420  !$omp parallel do
4421  do j = 1, jmax
4422  do i = 1, imax
4423  do m = 1, n_rad_dir
4424  if ( albw_org(i,j,m,i_r_ir ) == undef ) albw_org(i,j,m,i_r_ir ) = init_ocean_alb_lw
4425  if ( albw_org(i,j,m,i_r_nir) == undef ) albw_org(i,j,m,i_r_nir) = init_ocean_alb_sw
4426  if ( albw_org(i,j,m,i_r_vis) == undef ) albw_org(i,j,m,i_r_vis) = init_ocean_alb_sw
4427  if ( albw_org(i,j,m,i_r_vis) == undef ) albw_org(i,j,m,i_r_vis) = init_ocean_alb_sw
4428  end do
4429  if ( z0w_org(i,j) == undef ) z0w_org(i,j) = init_ocean_z0w
4430  end do
4431  end do
4432 
4433  if ( first_surface ) then
4434 
4435  ! interporation for ocean variables
4436 
4437  select case( itp_type_a )
4438  case ( i_intrp_linear )
4439 
4440  if ( imax == 1 .or. jmax == 1 ) then
4441  log_error("ocean_interporation",*) 'LINER interpolation requires nx, ny > 1'
4442  log_error_cont(*) 'Use "DIST-WEIGHT" as INTRP_TYPE of PARAM_MKINIT_REAL_OCEAN'
4443  call prc_abort
4444  end if
4445 
4446  !$omp parallel do
4447  do j = 1, jmax
4448  do i = 1, imax
4449  olat_org(i,j) = sign( min( abs(olat_org(i,j)), pi * 0.499999_rp ), olat_org(i,j) )
4450  end do
4451  end do
4452 
4453  call mapprojection_lonlat2xy( imax, 1, imax, jmax, 1, jmax, &
4454  olon_org(:,:), olat_org(:,:), & ! [IN]
4455  ox_org(:,:), oy_org(:,:) ) ! [OUT]
4456 
4457  zonal = ( maxval(olon_org) - minval(olon_org) ) > 2.0_rp * pi * 0.9_rp
4458  pole = ( maxval(olat_org) > pi * 0.5_rp * 0.9_rp ) .or. ( minval(olat_org) < - pi * 0.5_rp * 0.9_rp )
4459  call interp_factor2d( imax, jmax, & ! [IN]
4460  ia, ja, & ! [IN]
4461  ox_org(:,:), & ! [IN]
4462  oy_org(:,:), & ! [IN]
4463  cx(:), cy(:), & ! [IN]
4464  oigrd(:,:,:), & ! [OUT]
4465  ojgrd(:,:,:), & ! [OUT]
4466  ohfact(:,:,:), & ! [OUT]
4467  zonal = zonal, & ! [IN]
4468  pole = pole ) ! [IN]
4469 
4470  case ( i_intrp_dstwgt )
4471 
4472  call interp_factor2d( itp_nh_o, & ! [IN]
4473  imax, jmax, & ! [IN]
4474  ia, ja, & ! [IN]
4475  olon_org(:,:), & ! [IN]
4476  olat_org(:,:), & ! [IN]
4477  lon(:,:), lat(:,:), & ! [IN]
4478  oigrd(:,:,:), & ! [OUT]
4479  ojgrd(:,:,:), & ! [OUT]
4480  ohfact(:,:,:) ) ! [OUT]
4481 
4482  end select
4483 
4484  end if
4485 
4486 
4487  call interp_interp2d( itp_nh_o, & ! [IN]
4488  imax, jmax, & ! [IN]
4489  ia, ja, & ! [IN]
4490  oigrd(:,:,:), & ! [IN]
4491  ojgrd(:,:,:), & ! [IN]
4492  ohfact(:,:,:), & ! [IN]
4493  tw_org(:,:), & ! [IN]
4494  tw(:,:) ) ! [OUT]
4495  if ( filter_niter > 0 ) then
4496  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4497  tw(:,:), filter_order, filter_niter )
4498  call comm_vars8( tw(:,:), 1 )
4499  call comm_wait ( tw(:,:), 1, .false. )
4500  end if
4501 
4502  call interp_interp2d( itp_nh_o, & ! [IN]
4503  imax, jmax, & ! [IN]
4504  ia, ja, & ! [IN]
4505  oigrd(:,:,:), & ! [IN]
4506  ojgrd(:,:,:), & ! [IN]
4507  ohfact(:,:,:), & ! [IN]
4508  sst_org(:,:), & ! [IN]
4509  sst(:,:) ) ! [OUT]
4510  if ( filter_niter > 0 ) then
4511  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4512  sst(:,:), filter_order, filter_niter )
4513  call comm_vars8( sst(:,:), 1 )
4514  call comm_wait ( sst(:,:), 1, .false. )
4515  end if
4516 
4517  ! elevation correction
4518  if ( elevation_correction_ocean ) then
4519 
4520  !$omp parallel do &
4521  !$omp private(tdiff)
4522  do j = 1, ja
4523  do i = 1, ia
4524  tdiff = topography_zsfc(i,j) * laps
4525  sst(i,j) = sst(i,j) - tdiff
4526  tw(i,j) = tw(i,j) - tdiff
4527  end do
4528  end do
4529 
4530  end if
4531 
4532 
4533  if ( filter_niter > 0 ) then
4534  !$omp parallel do
4535  do j = 1, ja
4536  do i = 1, ia
4537  one(i,j) = 1.0_rp
4538  end do
4539  end do
4540  end if
4541 
4542  do n = 1, n_rad_rgn
4543  do m = 1, n_rad_dir
4544 
4545  call interp_interp2d( itp_nh_o, & ! [IN]
4546  imax, jmax, & ! [IN]
4547  ia, ja, & ! [IN]
4548  oigrd(:,:,:), & ! [IN]
4549  ojgrd(:,:,:), & ! [IN]
4550  ohfact(:,:,:), & ! [IN]
4551  albw_org(:,:,m,n), & ! [IN]
4552  albw(:,:,m,n) ) ! [OUT]
4553  if ( filter_niter > 0 ) then
4554  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4555  albw(:,:,m,n), filter_order, filter_niter, &
4556  limiter_sign = one(:,:) )
4557  call comm_vars8( albw(:,:,m,n), 1 )
4558  call comm_wait ( albw(:,:,m,n), 1, .false. )
4559  end if
4560 
4561  end do
4562  end do
4563 
4564  call interp_interp2d( itp_nh_o, & ! [IN]
4565  imax, jmax, & ! [IN]
4566  ia, ja, & ! [IN]
4567  oigrd(:,:,:), & ! [IN]
4568  ojgrd(:,:,:), & ! [IN]
4569  ohfact(:,:,:), & ! [IN]
4570  z0w_org(:,:), & ! [IN]
4571  z0w(:,:) ) ! [OUT]
4572  if ( filter_niter > 0 ) then
4573  call filter_hyperdiff( ia, isb, ieb, ja, jsb, jeb, &
4574  z0w(:,:), filter_order, filter_niter, &
4575  limiter_sign = one(:,:) )
4576  call comm_vars8( z0w(:,:), 1 )
4577  call comm_wait ( z0w(:,:), 1, .false. )
4578  end if
4579 
4580 
4581  return
4582  end subroutine ocean_interporation
4583 
4584  !-------------------------------
4585  subroutine urban_input( &
4586  lst, albg, &
4587  DENS, MOMX, MOMY, RHOT, &
4588  QTRC , &
4589  tc_urb, qc_urb, uc_urb, &
4590  ust, albu )
4591  use scale_atmos_hydrometeor, only: &
4592  i_qv
4593  use scale_atmos_thermodyn, only: &
4594  thermodyn_specific_heat => atmos_thermodyn_specific_heat, &
4595  thermodyn_rhot2temp_pres => atmos_thermodyn_rhot2temp_pres
4596  use scale_comm_cartesc, only: &
4597  comm_vars8, &
4598  comm_wait
4599  implicit none
4600  real(RP), intent(in) :: lst (IA,JA)
4601  real(RP), intent(in) :: albg (IA,JA,N_RAD_DIR,N_RAD_RGN)
4602  real(RP), intent(in) :: DENS(KA,IA,JA)
4603  real(RP), intent(in) :: MOMX(KA,IA,JA)
4604  real(RP), intent(in) :: MOMY(KA,IA,JA)
4605  real(RP), intent(in) :: RHOT(KA,IA,JA)
4606  real(RP), intent(in) :: QTRC(KA,IA,JA,QA)
4607  real(RP), intent(out) :: tc_urb(IA,JA)
4608  real(RP), intent(out) :: qc_urb(IA,JA)
4609  real(RP), intent(out) :: uc_urb(IA,JA)
4610  real(RP), intent(out) :: ust (IA,JA)
4611  real(RP), intent(out) :: albu (IA,JA,N_RAD_DIR,N_RAD_RGN)
4612 
4613  real(RP) :: temp, pres
4614  real(RP) :: Qdry
4615  real(RP) :: Rtot
4616  real(RP) :: CVtot
4617  real(RP) :: CPtot
4618 
4619  integer :: i, j
4620 
4621  ! urban data
4622 
4623  !$omp parallel do collapse(2) &
4624  !$omp private(Qdry,Rtot,CVtot,CPtot,temp,pres)
4625  do j = 1, ja
4626  do i = 1, ia
4627  call thermodyn_specific_heat( qa, &
4628  qtrc(ks,i,j,:), &
4629  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), & ! [IN]
4630  qdry, rtot, cvtot, cptot ) ! [OUT]
4631  call thermodyn_rhot2temp_pres( dens(ks,i,j), rhot(ks,i,j), rtot, cvtot, cptot, & ! [IN]
4632  temp, pres ) ! [OUT]
4633 
4634  tc_urb(i,j) = temp
4635  if ( i_qv > 0 ) then
4636  qc_urb(i,j) = qtrc(ks,i,j,i_qv)
4637  else
4638  qc_urb(i,j) = 0.0_rp
4639  end if
4640  enddo
4641  enddo
4642 
4643  !$omp parallel do
4644  do j = 1, ja-1
4645  do i = 1, ia-1
4646  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 &
4647  + ( momy(ks,i,j) / (dens(ks, i,j+1)+dens(ks,i,j)) * 2.0_rp )**2.0_rp ), &
4648  0.01_rp)
4649  enddo
4650  enddo
4651  !$omp parallel do
4652  do j = 1, ja-1
4653  uc_urb(ia,j) = max(sqrt( ( momx(ks,ia,j) / dens(ks,ia,j ) )**2.0_rp &
4654  + ( momy(ks,ia,j) / (dens(ks,ia,j+1)+dens(ks,ia,j)) * 2.0_rp )**2.0_rp ), &
4655  0.01_rp)
4656  enddo
4657  !$omp parallel do
4658  do i = 1, ia-1
4659  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 &
4660  + ( momy(ks,i,ja) / dens(ks,i ,ja) )**2.0_rp ), 0.01_rp)
4661  enddo
4662  uc_urb(ia,ja) = max(sqrt( ( momx(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp &
4663  + ( momy(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp ), 0.01_rp)
4664 
4665  call comm_vars8( uc_urb, 1 )
4666  call comm_wait ( uc_urb, 1, .false. )
4667 
4668 
4669 !!$ ! Urban surface temp: interpolate over the ocean
4670 !!$ if ( i_INTRP_URB_SFC_TEMP .ne. i_intrp_off ) then
4671 !!$ select case( i_INTRP_URB_SFC_TEMP )
4672 !!$ case( i_intrp_mask )
4673 !!$ call make_mask( lmask, ust_org, imax, jmax, landdata=.true.)
4674 !!$ !$omp parallel do
4675 !!$ do j = 1, jmax
4676 !!$ do i = 1, imax
4677 !!$ if ( lmask_org(i,j) .ne. UNDEF ) lmask(i,j) = lmask_org(i,j)
4678 !!$ end do
4679 !!$ end do
4680 !!$ case( i_intrp_fill )
4681 !!$ call make_mask( lmask, ust_org, imax, jmax, landdata=.true.)
4682 !!$ case default
4683 !!$ LOG_ERROR("urban_input",*) 'INTRP_URB_SFC_TEMP is invalid.'
4684 !!$ call PRC_abort
4685 !!$ end select
4686 !!$ call interp_OceanLand_data(ust_org, lmask, imax, jmax, .true., intrp_iter_max)
4687 !!$ end if
4688 !!$
4689 !!$ !$omp parallel do
4690 !!$ do j = 1, jmax
4691 !!$ do i = 1, imax
4692 !!$ if ( ust_org(i,j) == UNDEF ) ust_org(i,j) = lst_org(i,j)
4693 !!$ end do
4694 !!$ end do
4695 !!$
4696 !!$ call INTERP_interp2d( itp_nh_l, & ! [IN]
4697 !!$ imax, jmax, & ! [IN]
4698 !!$ IA, JA, & ! [IN]
4699 !!$ igrd (:,:,:), & ! [IN]
4700 !!$ jgrd (:,:,:), & ! [IN]
4701 !!$ hfact (:,:,:), & ! [IN]
4702 !!$ ust_org (:,:), & ! [IN]
4703 !!$ ust (:,:) ) ! [OUT]
4704 !!$ if ( FILTER_NITER > 0 ) then
4705 !!$ call FILTER_hyperdiff( IA, ISB, IEB, JA, JSB, JEB, &
4706 !!$ ust(:,:), FILTER_ORDER, FILTER_NITER )
4707 !!$ call COMM_vars8( ust(:,:), 1 )
4708 !!$ call COMM_wait ( ust(:,:), 1, .false. )
4709 !!$ end if
4710 !!$
4711 !!$ !$omp parallel do
4712 !!$ do j = 1, JA
4713 !!$ do i = 1, IA
4714 !!$ if( abs(lsmask_nest(i,j)-0.0_RP) < EPS ) then ! ocean grid
4715 !!$ ust(i,j) = sst(i,j,nn)
4716 !!$ endif
4717 !!$ enddo
4718 !!$ enddo
4719 !!$
4720 !!$ !$omp parallel do &
4721 !!$ !$omp private(tdiff)
4722 !!$ do j = 1, JA
4723 !!$ do i = 1, IA
4724 !!$ if ( topo(i,j) > 0.0_RP ) then ! ignore UNDEF value
4725 !!$ tdiff = ( TOPOGRAPHY_Zsfc(i,j) - topo(i,j) ) * LAPS
4726 !!$ ust(i,j) = ust(i,j) - tdiff
4727 !!$ end if
4728 !!$ end do
4729 !!$ end do
4730 
4731 
4732  !$omp parallel do
4733  do j = 1, ja
4734  do i = 1, ia
4735  ust(i,j) = lst(i,j)
4736  end do
4737  end do
4738 
4739 
4740  ! copy albedo of land to urban
4741  !$omp parallel do
4742  do j = 1, ja
4743  do i = 1, ia
4744  albu(i,j,:,:) = albg(i,j,:,:)
4745  enddo
4746  enddo
4747 
4748  return
4749  end subroutine urban_input
4750 
4751  !-------------------------------
4752  subroutine make_mask( &
4753  gmask, & ! (out)
4754  data, & ! (in)
4755  nx, & ! (in)
4756  ny, & ! (in)
4757  landdata ) ! (in)
4758  use scale_const, only: &
4759  eps => const_eps, &
4760  undef => const_undef
4761  implicit none
4762  real(RP), intent(out) :: gmask(:,:)
4763  real(RP), intent(in) :: data(:,:)
4764  integer, intent(in) :: nx
4765  integer, intent(in) :: ny
4766  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
4767 
4768  real(RP) :: dd
4769  integer :: i,j
4770 
4771  if( landdata )then
4772  !$omp parallel do
4773  do j = 1, ny
4774  do i = 1, nx
4775  gmask(i,j) = 1.0_rp ! gmask=1 will be skip in "interp_OceanLand_data"
4776  end do
4777  end do
4778  dd = 0.0_rp
4779  else
4780  !$omp parallel do
4781  do j = 1, ny
4782  do i = 1, nx
4783  gmask(i,j) = 0.0_rp ! gmask=0 will be skip in "interp_OceanLand_data"
4784  end do
4785  end do
4786  dd = 1.0_rp
4787  endif
4788 
4789  !$omp parallel do
4790  do j = 1, ny
4791  do i = 1, nx
4792  if( abs(data(i,j) - undef) < sqrt(eps) )then
4793  gmask(i,j) = dd
4794  endif
4795  enddo
4796  enddo
4797 
4798  return
4799  end subroutine make_mask
4800  !-----------------------------------------------------------------------------
4801  subroutine interp_oceanland_data( &
4802  data, &
4803  lsmask, &
4804  nx, &
4805  ny, &
4806  landdata, &
4807  iter_max )
4808  use scale_const, only: &
4809  undef => const_undef, &
4810  eps => const_eps
4811  implicit none
4812 
4813  integer, intent(in) :: nx
4814  integer, intent(in) :: ny
4815  real(RP), intent(inout) :: data (nx,ny)
4816  real(RP), intent(in) :: lsmask(nx,ny)
4817  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
4818  integer, intent(in) :: iter_max
4819 
4820  integer :: mask (nx,ny)
4821  integer :: mask_prev(nx,ny)
4822  real(RP) :: data_prev(nx,ny)
4823  real(RP) :: tmp, cnt, sw
4824  integer :: mask_target
4825 
4826  integer :: num_land, num_ocean, num_replaced
4827  integer :: istr, iend, jstr, jend
4828  integer :: i, j, ii, jj, ite
4829  !---------------------------------------------------------------------------
4830 
4831  log_newline
4832  log_info("interp_OceanLand_data",*) 'Interpolation'
4833 
4834  if ( landdata ) then
4835  log_info("interp_OceanLand_data",*) 'target mask : LAND'
4836  mask_target = 1 ! interpolation for land data
4837  else
4838  log_info("interp_OceanLand_data",*) 'target mask : OCEAN'
4839  mask_target = 0 ! interpolation for ocean data
4840  endif
4841 
4842  ! search target cell for interpolation
4843  num_land = 0
4844  num_ocean = 0
4845  !$omp parallel do &
4846  !$omp reduction(+:num_land,num_ocean)
4847  do j = 1, ny
4848  do i = 1, nx
4849  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
4850  num_land = num_land + ( mask(i,j) )
4851  num_ocean = num_ocean + ( 1-mask(i,j) )
4852  enddo
4853  enddo
4854 
4855  log_progress('(1x,A,I3.3,A,2I8)') 'ite=', 0, ', (land,ocean) = ', num_land, num_ocean
4856 
4857  ! start interpolation
4858  do ite = 1, iter_max
4859  ! save previous state
4860  !$omp parallel do
4861  do j = 1, ny
4862  do i = 1, nx
4863  mask_prev(i,j) = mask(i,j)
4864  data_prev(i,j) = data(i,j)
4865  end do
4866  end do
4867  num_replaced = 0
4868 
4869  !$omp parallel do collapse(2) &
4870  !$omp private(istr,iend,jstr,jend,tmp,cnt,sw) &
4871  !$omp reduction(+:num_replaced)
4872  do j = 1, ny
4873  do i = 1, nx
4874 
4875  if( mask(i,j) == mask_target ) cycle ! already filled
4876 
4877  ! collect neighbor grid
4878  istr = max(i-1,1 )
4879  iend = min(i+1,nx)
4880  jstr = max(j-1,1 )
4881  jend = min(j+1,ny)
4882 
4883  tmp = 0.0_rp
4884  cnt = 0.0_rp
4885  do jj = jstr, jend
4886  do ii = istr, iend
4887  sw = 0.5_rp - sign(0.5_rp,real(abs(mask_prev(ii,jj)-mask_target),kind=rp)-eps)
4888 
4889  tmp = tmp + sw * data_prev(ii,jj)
4890  cnt = cnt + sw
4891  enddo
4892  enddo
4893 
4894  if ( cnt >= 3.0_rp ) then ! replace by average of neighbor grid value
4895  data(i,j) = tmp / cnt
4896  mask(i,j) = mask_target
4897 
4898  num_replaced = num_replaced + 1
4899  endif
4900 
4901  enddo
4902  enddo
4903 
4904  if ( landdata ) then
4905  num_land = num_land + num_replaced
4906  num_ocean = num_ocean - num_replaced
4907  else
4908  num_land = num_land - num_replaced
4909  num_ocean = num_ocean + num_replaced
4910  endif
4911 ! LOG_PROGRESS('(1x,A,I3.3,A,3I8,A,I8)') 'ite=', ite, &
4912 ! ', (land,ocean,replaced) = ', num_land, num_ocean, num_replaced, ' / ', nx*ny
4913 
4914  if( num_replaced == 0 ) exit
4915 
4916  enddo ! itelation
4917 
4918  log_progress('(1x,A,I3.3,A,2I8)') 'ite=', ite, ', (land,ocean) = ', num_land, num_ocean
4919 
4920  !$omp parallel do
4921  do j = 1, ny
4922  do i = 1, nx
4923  if ( abs(mask(i,j)-mask_target) > eps ) data(i,j) = undef
4924  end do
4925  end do
4926 
4927 
4928  return
4929  end subroutine interp_oceanland_data
4930 
4931  !-----------------------------------------------------------------------------
4932  subroutine replace_misval_const( data, maskval, frac_land )
4933  use scale_const, only: &
4934  eps => const_eps
4935  implicit none
4936  real(RP), intent(inout) :: data(:,:)
4937  real(RP), intent(in) :: maskval
4938  real(RP), intent(in) :: frac_land(:,:)
4939  integer :: i, j
4940 
4941  !$omp parallel do
4942  do j = 1, ja
4943  do i = 1, ia
4944  if( abs(frac_land(i,j)-0.0_rp) < eps )then ! ocean grid
4945  data(i,j) = maskval
4946  endif
4947  enddo
4948  enddo
4949 
4950  end subroutine replace_misval_const
4951 
4952  !-----------------------------------------------------------------------------
4953  subroutine replace_misval_map( data, maskval, nx, ny, elem)
4954  use scale_const, only: &
4955  eps => const_eps, &
4956  undef => const_undef
4957  implicit none
4958 
4959  real(RP), intent(inout) :: data(:,:)
4960  real(RP), intent(in) :: maskval(:,:)
4961  integer, intent(in) :: nx, ny
4962  character(len=*), intent(in) :: elem
4963 
4964  integer :: i, j
4965  logical :: error
4966 
4967  error = .false.
4968  !$omp parallel do
4969  do j = 1, ny
4970  if ( error ) cycle
4971  do i = 1, nx
4972  if( abs(data(i,j) - undef) < sqrt(eps) )then
4973  if( abs(maskval(i,j) - undef) < sqrt(eps) )then
4974  log_error("replace_misval_map",*) "data for mask of "//trim(elem)//"(",i,",",j,") includes missing value."
4975  error = .true.
4976  exit
4977  else
4978  data(i,j) = maskval(i,j)
4979  endif
4980  endif
4981  enddo
4982  enddo
4983 
4984  if ( error ) then
4985  log_error_cont(*) "Please check input data of SKINTEMP or SST. "
4986  call prc_abort
4987  end if
4988 
4989  return
4990  end subroutine replace_misval_map
4991 
4992  subroutine get_ijrange( &
4993  IS_org, IE_org, JS_org, JE_org, &
4994  IA_org, JA_org, &
4995  LON_min, LON_max, LAT_min, LAT_max, &
4996  LON_all, LAT_all )
4997  use scale_const, only: &
4998  eps => const_eps
4999  use scale_atmos_grid_cartesc_real, only: &
5000  atmos_grid_cartesc_real_lon, &
5001  atmos_grid_cartesc_real_lat
5002  integer, intent(out) :: IS_org
5003  integer, intent(out) :: IE_org
5004  integer, intent(out) :: JS_org
5005  integer, intent(out) :: JE_org
5006 
5007  integer, intent(in) :: IA_org
5008  integer, intent(in) :: JA_org
5009  real(RP), intent(in) :: LON_min, LON_max
5010  real(RP), intent(in) :: LAT_min, LAT_max
5011  real(RP), intent(in) :: LON_all(IA_org,JA_org)
5012  real(RP), intent(in) :: LAT_all(IA_org,JA_org)
5013 
5014  real(RP) :: min, max
5015 
5016  logical :: LON_mask(IA_org)
5017  logical :: LAT_mask(JA_org)
5018 
5019  integer :: i, j
5020 
5021  if ( lon_min < minval( lon_all ) .or. lon_max > maxval( lon_all ) ) then
5022  ! probably global (cyclic) data
5023  is_org = 1
5024  ie_org = ia_org
5025  else
5026  min = maxval( minval( lon_all(:,:), dim=2 ), mask=all( lon_all(:,:) < lon_min, dim=2 ) )
5027  max = minval( maxval( lon_all(:,:), dim=2 ), mask=all( lon_all(:,:) > lon_max, dim=2 ) )
5028  lon_mask(:) = any( lon_all(:,:) - min > -eps, dim=2 ) .AND. any( lon_all(:,:) - max < eps, dim=2 )
5029  do i = 1, ia_org
5030  if( lon_mask(i) ) then
5031  is_org = i
5032  exit
5033  endif
5034  end do
5035  do i = ia_org, 1, -1
5036  if( lon_mask(i) ) then
5037  ie_org = i
5038  exit
5039  endif
5040  end do
5041  end if
5042 
5043  if ( lat_min < minval( lat_all ) .or. lat_max > maxval( lat_all ) ) then
5044  ! unexpected
5045  ! INTERP_domain_compatibility should been called
5046  log_error("get_IJrange",*) "unexpected error", lat_min, lat_max, minval( lat_all ), maxval( lat_all )
5047  call prc_abort
5048  end if
5049  min = maxval( minval( lat_all(:,:), dim=1 ), mask=all( lat_all(:,:) < lat_min, dim=1 ) )
5050  max = minval( maxval( lat_all(:,:), dim=1 ), mask=all( lat_all(:,:) > lat_max, dim=1 ) )
5051  lat_mask(:) = any( lat_all(:,:) - min > -eps, dim=1 ) .AND. any( lat_all(:,:) - max < eps, dim=1 )
5052  do j = 1, ja_org
5053  if( lat_mask(j) ) then
5054  js_org = j
5055  exit
5056  endif
5057  end do
5058  do j = ja_org, 1, -1
5059  if( lat_mask(j) ) then
5060  je_org = j
5061  exit
5062  endif
5063  end do
5064 
5065  return
5066  end subroutine get_ijrange
5067 
5068 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:2150
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:1649
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:101
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:349
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:4591
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:2191
mod_realinput_netcdf::parentlandfinalizenetcdf
subroutine, public parentlandfinalizenetcdf
Land Finalize.
Definition: mod_realinput_netcdf.F90:1690
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:1724
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_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_mptype, sfc_diagnoses, update_coord, dims, it)
Definition: mod_realinput_netcdf.F90:727
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_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:4933
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:4375
mod_land_vars
module LAND Variables
Definition: mod_land_vars.F90:11
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:4954
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:4758
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:102
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:1879
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:3791
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
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_mptype, pt_dry, serial, do_read)
Atmos Setup.
Definition: mod_realinput_netcdf.F90:150
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:4997
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:1362
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:2219
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:91
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