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