SCALE-RM
mod_realinput.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_prof
23  use scale_index
24  use scale_tracer
26 
27  use scale_prc, only: &
28  prc_ismaster, &
29  prc_abort
30  use scale_comm_cartesc, only: &
31  comm_bcast
37  use scale_comm_cartesc_nest, only: &
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  real(RP), private, allocatable :: lon_org (:,:)
78  real(RP), private, allocatable :: lat_org (:,:)
79  real(RP), private, allocatable :: cz_org (:,:,:)
80 
81  real(RP), private, allocatable :: w_org (:,:,:) ! scalar point
82  real(RP), private, allocatable :: u_org (:,:,:) ! scalar point
83  real(RP), private, allocatable :: v_org (:,:,:) ! scalar point
84  real(RP), private, allocatable :: dens_org(:,:,:)
85  real(RP), private, allocatable :: pott_org(:,:,:)
86  real(RP), private, allocatable :: temp_org(:,:,:)
87  real(RP), private, allocatable :: pres_org(:,:,:)
88  real(RP), private, allocatable :: qtrc_org (:,:,:,:)
89  real(RP), private, allocatable :: qv_org (:,:,:)
90  real(RP), private, allocatable :: qhyd_org (:,:,:,:)
91  real(RP), private, allocatable :: qnum_org (:,:,:,:)
92 
93  real(RP), private, allocatable :: rn222_org(:,:,:)
94 
95  integer, private, allocatable :: igrd (:,:,:)
96  integer, private, allocatable :: jgrd (:,:,:)
97  real(RP), private, allocatable :: hfact(:,:,:)
98  integer, private, allocatable :: kgrd (:,:,:,:,:)
99  real(RP), private, allocatable :: vfact(:,:,:,:,:)
100 
101  real(RP), private, allocatable :: tw_org (:,:)
102  real(RP), private, allocatable :: sst_org (:,:)
103  real(RP), private, allocatable :: albw_org (:,:,:,:)
104  real(RP), private, allocatable :: olon_org (:,:)
105  real(RP), private, allocatable :: olat_org (:,:)
106  real(RP), private, allocatable :: omask_org(:,:)
107 
108  integer, private :: itp_nh = 4
109  integer, private :: itp_nv = 2
110 
111  logical, private :: serial_atmos
112  logical, private :: serial_land
113  logical, private :: serial_ocean
114  logical, private :: read_by_myproc_atmos
115  logical, private :: do_read_land
116  logical, private :: do_read_ocean
117 
118  logical, private :: temp2pott
119  logical, private :: apply_rotate_uv
120  logical, private :: update_coord
121  logical, private :: use_waterratio
122 
123  integer, private, parameter :: i_intrp_off = 0
124  integer, private, parameter :: i_intrp_mask = 1
125  integer, private, parameter :: i_intrp_fill = 2
126 
127  integer, private :: i_intrp_land_temp
128  integer, private :: i_intrp_land_water
129  integer, private :: i_intrp_land_sfc_temp
130  integer, private :: i_intrp_ocean_temp
131  integer, private :: i_intrp_ocean_sfc_temp
132 
133  ! replace missing value
134  real(RP), private, parameter :: maskval_tg = 298.0_rp ! mask value 298K
135  real(RP), private, parameter :: maskval_strg = 0.02_rp ! mask value 0.02
136  ! default value 0.02: set as value of forest at 40% of evapolation rate.
137  ! forest is considered as a typical landuse over Japan area.
138 
139  ! for namelist
140  integer, private :: number_of_files = 1
141  integer, private :: number_of_tsteps = 1 ! num of time steps in one file
142  integer, private :: number_of_skip_tsteps = 0 ! num of skipped first several data
143 
144  logical, private :: serial_proc_read = .true. ! read by one MPI process and broadcast
145 
146  character(len=H_LONG), private :: filetype_org = ''
147  character(len=H_LONG), private :: basename_org = ''
148  logical, private :: basename_add_num = .false.
149 
150  character(len=H_LONG), private :: basename_boundary = ''
151  logical, private :: boundary_postfix_timelabel = .false.
152  character(len=H_LONG), private :: boundary_title = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
153  character(len=H_SHORT), private :: boundary_dtype = 'DEFAULT'
154  real(DP), private :: boundary_update_dt = 0.0_dp ! inteval time of boudary data update [s]
155 
156  integer, private :: filter_order = 8 ! order of the hyper-diffusion (must be even)
157  integer, private :: filter_niter = 5 ! times for hyper-diffusion iteration
158 
159  logical, private :: use_file_density = .false. ! use density data from files
160  logical, private :: same_mp_type = .false. ! microphysics type of the parent model is same as it in this model
161 
162  logical, private :: first = .true.
163  !-----------------------------------------------------------------------------
164 contains
165  !-----------------------------------------------------------------------------
166  subroutine realinput_atmos
167  use scale_time, only: &
169  use mod_atmos_vars, only: &
170  dens, &
171  momz, &
172  momx, &
173  momy, &
174  rhot, &
175  qtrc
176  use mod_atmos_admin, only: &
178  implicit none
179 
180  namelist / param_mkinit_real_atmos / &
181  number_of_files, &
182  number_of_tsteps, &
183  number_of_skip_tsteps, &
184  serial_proc_read, &
185  filetype_org, &
186  basename_org, &
187  basename_add_num, &
188  basename_boundary, &
189  boundary_postfix_timelabel, &
190  boundary_title, &
191  boundary_dtype, &
192  boundary_update_dt, &
193  filter_order, &
194  filter_niter, &
195  use_file_density, &
196  same_mp_type
197 
198  character(len=H_LONG) :: basename_mod
199  character(len=H_LONG) :: basename_out_mod
200  character(len=19) :: timelabel
201 
202  integer :: dims(6) ! dims 1-3: normal, 4-6: staggerd
203  integer :: timelen
204 
205  integer :: fid_atmos
206  integer :: vid_atmos(5+qa)
207 
208  real(RP) :: DENS_in(ka,ia,ja)
209  real(RP) :: MOMZ_in(ka,ia,ja) ! staggered point
210  real(RP) :: MOMX_in(ka,ia,ja) ! staggered point
211  real(RP) :: MOMY_in(ka,ia,ja) ! staggered point
212  real(RP) :: RHOT_in(ka,ia,ja)
213  real(RP) :: QTRC_in(ka,ia,ja,qa)
214 
215  real(RP) :: VELZ_in(ka,ia,ja) ! staggered point
216  real(RP) :: VELX_in(ka,ia,ja) ! staggered point
217  real(RP) :: VELY_in(ka,ia,ja) ! staggered point
218  real(RP) :: POTT_in(ka,ia,ja)
219 
220  integer :: ifile, istep, t, tall
221  integer :: k, i, j, iq
222  integer :: ierr
223  !---------------------------------------------------------------------------
224 
225  log_newline
226  log_info('REALINPUT_atmos',*) 'Setup'
227 
228  !--- read namelist
229  rewind(io_fid_conf)
230  read(io_fid_conf,nml=param_mkinit_real_atmos,iostat=ierr)
231  if( ierr < 0 ) then !--- missing
232  log_info("REALINPUT_atmos",*) 'Not found namelist. Default used.'
233  elseif( ierr > 0 ) then !--- fatal error
234  log_error("REALINPUT_atmos",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_ATMOS. Check!'
235  call prc_abort
236  endif
237  log_nml(param_mkinit_real_atmos)
238 
239  if ( boundary_update_dt <= 0.0_dp ) then
240  log_error("REALINPUT_atmos",*) 'BOUNDARY_UPDATE_DT is necessary in real case preprocess'
241  call prc_abort
242  endif
243 
244  if ( filetype_org == 'GrADS' ) then
245  basename_mod = trim(basename_org) ! namelist file name
246  else
247  if ( number_of_files > 1 .OR. basename_add_num ) then
248  basename_mod = trim(basename_org)//'_00000'
249  else
250  basename_mod = trim(basename_org)
251  endif
252  endif
253 
254  call parentatmossetup( filetype_org, & ![IN]
255  basename_mod, & ![IN]
256  serial_proc_read, & ![IN]
257  use_file_density, & ![IN]
258  dims(:), & ![OUT]
259  timelen ) ![OUT]
260 
261  if ( timelen > 0 ) then
262  number_of_tsteps = timelen ! read from file
263  endif
264 
265  log_newline
266  log_info("REALINPUT_atmos",*) 'Number of temporal data in each file : ', number_of_tsteps
267 
268  do ifile = 1, number_of_files
269 
270  if ( filetype_org == 'GrADS' ) then
271  if ( number_of_files > 1 .OR. basename_add_num ) then
272  write(basename_mod,'(A,I5.5)') '_', ifile-1 ! only the number postfix
273  else
274  basename_mod = ''
275  endif
276  else
277  if ( number_of_files > 1 .OR. basename_add_num ) then
278  write(basename_mod,'(A,A,I5.5)') trim(basename_org), '_', ifile-1
279  else
280  basename_mod = trim(basename_org)
281  endif
282  endif
283 
284  log_newline
285  log_info("REALINPUT_atmos",*) 'read external data from : ', trim(basename_mod)
286 
287  call parentatmosopen( filetype_org, & ![IN]
288  basename_mod, & ![IN]
289  dims(:) ) ![IN]
290 
291  do istep = 1, number_of_tsteps
292 
293  tall = number_of_tsteps * (ifile-1) + istep ! consecutive time step (input)
294  t = tall - number_of_skip_tsteps ! time step (output)
295 
296  if ( t <= 0 ) then
297  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
298  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, '] ...skip.'
299  cycle
300  endif
301 
302  if ( t == 1 .OR. basename_boundary /= '' ) then
303 
304  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
305  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, ']'
306 
307  ! read prepared data
308  call parentatmosinput( filetype_org, & ! [IN]
309  basename_mod, & ! [IN]
310  dims(:), & ! [IN]
311  istep, & ! [IN]
312  same_mp_type, & ! [IN]
313  dens_in(:,:,:), & ! [OUT]
314  momz_in(:,:,:), & ! [OUT]
315  momx_in(:,:,:), & ! [OUT]
316  momy_in(:,:,:), & ! [OUT]
317  rhot_in(:,:,:), & ! [OUT]
318  qtrc_in(:,:,:,:), & ! [OUT]
319  velz_in(:,:,:), & ! [OUT]
320  velx_in(:,:,:), & ! [OUT]
321  vely_in(:,:,:), & ! [OUT]
322  pott_in(:,:,:) ) ! [OUT]
323  else
324  log_progress('(1x,A,I4,A,I5,A,I6,A)') &
325  '[file,step,cons.] = [', ifile, ',', istep, ',', tall, '] ...skip.'
326  endif
327 
328  !--- store prognostic variables as initial
329  if ( t == 1 ) then
330  log_newline
331  log_info("REALINPUT_atmos",*) 'store initial state.'
332 
333  do j = 1, ja
334  do i = 1, ia
335  do k = 1, ka
336  dens(k,i,j) = dens_in(k,i,j)
337  momz(k,i,j) = momz_in(k,i,j)
338  momx(k,i,j) = momx_in(k,i,j)
339  momy(k,i,j) = momy_in(k,i,j)
340  rhot(k,i,j) = rhot_in(k,i,j)
341  enddo
342  enddo
343  enddo
344 
345  do iq = 1, qa
346  do j = 1, ja
347  do i = 1, ia
348  do k = 1, ka
349  qtrc(k,i,j,iq) = qtrc_in(k,i,j,iq)
350  enddo
351  enddo
352  enddo
353  enddo
354 
355  endif
356 
357  !--- output boundary data
358  if ( basename_boundary /= '' ) then
359 
360  if ( t == 1 ) then
361  if ( boundary_postfix_timelabel ) then
362  call time_gettimelabel( timelabel )
363  basename_out_mod = trim(basename_boundary)//'_'//trim(timelabel)
364  else
365  basename_out_mod = trim(basename_boundary)
366  endif
367 
368  call boundaryatmossetup( basename_out_mod, & ! [IN]
369  boundary_title, & ! [IN]
370  boundary_dtype, & ! [IN]
371  boundary_update_dt, & ! [IN]
372  fid_atmos, & ! [OUT]
373  vid_atmos(:) ) ! [OUT]
374  endif
375 
376  call boundaryatmosoutput( dens_in(:,:,:), & ! [IN]
377  velz_in(:,:,:), & ! [IN]
378  velx_in(:,:,:), & ! [IN]
379  vely_in(:,:,:), & ! [IN]
380  pott_in(:,:,:), & ! [IN]
381  qtrc_in(:,:,:,:), & ! [IN]
382  fid_atmos, & ! [IN]
383  vid_atmos(:), & ! [IN]
384  boundary_update_dt, & ! [IN]
385  t ) ! [IN]
386  endif
387 
388  enddo ! istep loop
389  enddo ! ifile loop
390 
391  return
392  end subroutine realinput_atmos
393 
394  !-----------------------------------------------------------------------------
395  subroutine realinput_surface
396  use scale_time, only: &
398  use scale_landuse, only: &
399  fact_ocean => landuse_fact_ocean, &
400  fact_land => landuse_fact_land, &
401  fact_urban => landuse_fact_urban
402  use mod_atmos_phy_sf_vars, only: &
408  use mod_ocean_admin, only: &
409  ocean_do
410  use scale_ocean_phy_ice_simple, only: &
412  use mod_ocean_vars, only: &
413  ocean_temp, &
414  ocean_salt, &
415  ocean_uvel, &
416  ocean_vvel, &
417  ocean_ocn_z0m, &
418  ocean_ice_temp, &
419  ocean_ice_mass, &
420  ocean_sfc_temp, &
422  ocean_sfc_z0m, &
423  ocean_sfc_z0h, &
425  use mod_land_admin, only: &
426  land_do
427  use mod_land_vars, only: &
428  land_temp, &
429  land_water, &
430  land_sfc_temp, &
432  use mod_urban_admin, only: &
433  urban_do
434  use mod_urban_vars, only: &
435  urban_tc, &
436  urban_qc, &
437  urban_uc, &
438  urban_tr, &
439  urban_tb, &
440  urban_tg, &
441  urban_trl, &
442  urban_tbl, &
443  urban_tgl, &
444  urban_rainr, &
445  urban_rainb, &
446  urban_raing, &
447  urban_roff, &
448  urban_sfc_temp, &
450  implicit none
451 
452  logical :: USE_FILE_LANDWATER = .true. ! use land water data from files
453  real(RP) :: INIT_LANDWATER_RATIO = 0.5_rp ! Ratio of land water to storage is constant, if USE_FILE_LANDWATER is ".false."
454  real(RP) :: INIT_OCEAN_ALB_LW = 0.04_rp ! initial LW albedo on the ocean
455  real(RP) :: INIT_OCEAN_ALB_SW = 0.10_rp ! initial SW albedo on the ocean
456  real(RP) :: INIT_OCEAN_Z0W = 1.0e-3_rp ! initial surface roughness on the ocean
457  character(len=H_SHORT) :: INTRP_LAND_TEMP = 'off'
458  character(len=H_SHORT) :: INTRP_LAND_WATER = 'off'
459  character(len=H_SHORT) :: INTRP_LAND_SFC_TEMP = 'off'
460  character(len=H_SHORT) :: INTRP_OCEAN_TEMP = 'off'
461  character(len=H_SHORT) :: INTRP_OCEAN_SFC_TEMP = 'off'
462  integer :: INTRP_ITER_MAX = 100
463  character(len=H_SHORT) :: SOILWATER_DS2VC = 'limit'
464  logical :: soilwater_DS2VC_flag ! true: 'critical', false: 'limit'
465  logical :: elevation_collection = .true.
466  logical :: elevation_collection_land
467  logical :: elevation_collection_ocean
468 
469  namelist / param_mkinit_real_land / &
470  number_of_files, &
471  number_of_tsteps, &
472  number_of_skip_tsteps, &
473  filetype_org, &
474  basename_org, &
475  basename_add_num, &
476  basename_boundary, &
477  boundary_postfix_timelabel, &
478  boundary_title, &
479  boundary_update_dt, &
480  use_file_landwater, &
481  init_landwater_ratio, &
482  intrp_land_temp, &
483  intrp_land_water, &
484  intrp_land_sfc_temp, &
485  intrp_iter_max, &
486  filter_order, &
487  filter_niter, &
488  soilwater_ds2vc, &
489  elevation_collection, &
490  serial_proc_read
491 
492  namelist / param_mkinit_real_ocean / &
493  number_of_files, &
494  number_of_tsteps, &
495  number_of_skip_tsteps, &
496  filetype_org, &
497  basename_org, &
498  basename_add_num, &
499  basename_boundary, &
500  boundary_postfix_timelabel, &
501  boundary_title, &
502  boundary_update_dt, &
503  init_ocean_alb_lw, &
504  init_ocean_alb_sw, &
505  init_ocean_z0w, &
506  intrp_ocean_temp, &
507  intrp_ocean_sfc_temp, &
508  intrp_iter_max, &
509  filter_order, &
510  filter_niter, &
511  serial_proc_read
512 
513  character(len=H_LONG) :: FILETYPE_LAND
514  character(len=H_LONG) :: FILETYPE_OCEAN
515  character(len=H_LONG) :: BASENAME_LAND
516  character(len=H_LONG) :: BASENAME_OCEAN
517  character(len=5) :: NUM = ''
518 
519  ! land
520  real(RP), allocatable :: LAND_TEMP_org (:,:,:,:)
521  real(RP), allocatable :: LAND_WATER_org (:,:,:,:)
522  real(RP), allocatable :: LAND_SFC_TEMP_org (:,:,:)
523  real(RP), allocatable :: LAND_SFC_albedo_org(:,:,:,:,:)
524 
525  ! urban
526  real(RP) :: URBAN_TC_ORG(ia,ja)
527  real(RP) :: URBAN_QC_ORG(ia,ja)
528  real(RP) :: URBAN_UC_ORG(ia,ja)
529  real(RP) :: URBAN_SFC_TEMP_ORG(ia,ja)
530  real(RP) :: URBAN_SFC_albedo_ORG(ia,ja,n_rad_dir,n_rad_rgn)
531 
532  ! ocean
533  real(RP), allocatable :: OCEAN_TEMP_org (:,:,:,:)
534  real(RP), allocatable :: OCEAN_SFC_TEMP_org (:,:,:)
535  real(RP), allocatable :: OCEAN_SFC_albedo_org(:,:,:,:,:)
536  real(RP), allocatable :: OCEAN_SFC_Z0_org (:,:,:)
537 
538  integer :: NUMBER_OF_FILES_LAND = 1
539  integer :: NUMBER_OF_FILES_OCEAN = 1
540  integer :: NUMBER_OF_TSTEPS_LAND = 1 ! num of time steps in one file
541  integer :: NUMBER_OF_TSTEPS_OCEAN = 1 ! num of time steps in one file
542  integer :: NUMBER_OF_SKIP_TSTEPS_LAND = 0 ! num of skipped first several data
543  integer :: NUMBER_OF_SKIP_TSTEPS_OCEAN = 0 ! num of skipped first several data
544 
545  character(len=H_LONG) :: BASENAME_BOUNDARY_LAND = ''
546  character(len=H_LONG) :: BASENAME_BOUNDARY_OCEAN = ''
547  logical :: BOUNDARY_POSTFIX_TIMELABEL_LAND = .false.
548  logical :: BOUNDARY_POSTFIX_TIMELABEL_OCEAN = .false.
549  character(len=H_LONG) :: BOUNDARY_TITLE_LAND = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
550  character(len=H_LONG) :: BOUNDARY_TITLE_OCEAN = 'SCALE-RM BOUNDARY CONDITION for REAL CASE'
551  real(DP) :: BOUNDARY_UPDATE_DT_LAND = 0.0_dp ! inteval time of boudary data update [s]
552  real(DP) :: BOUNDARY_UPDATE_DT_OCEAN = 0.0_dp ! inteval time of boudary data update [s]
553 
554  integer :: mdlid_land, mdlid_ocean
555  integer :: ldims(3), odims(2)
556 
557  integer :: totaltimesteps = 1
558  integer :: timelen
559  integer :: skip_steps
560  integer :: ierr
561 
562  character(len=H_LONG) :: basename_out_mod
563  character(len=19) :: timelabel
564 
565  logical :: boundary_flag = .false.
566  logical :: land_flag
567 
568  integer :: k, i, j, n, ns, ne, idir, irgn
569  !---------------------------------------------------------------------------
570 
571  if ( land_do .or. urban_do ) then
572  land_flag = .true.
573  else
574  land_flag = .false.
575  end if
576 
577  if ( .not. land_flag .or. .not. ocean_do ) then
578  log_error("REALINPUT_surface",*) 'OCEAN_ and LAND_DYN_TYPE must be set'
579  end if
580 
581 
582  log_newline
583  log_info('REALINPUT_surface',*) 'Setup LAND'
584 
585  ! LAND/URBAN
586 
587  !--- read namelist
588  rewind(io_fid_conf)
589  read(io_fid_conf,nml=param_mkinit_real_land,iostat=ierr)
590  if( ierr < 0 ) then !--- missing
591  log_info("REALINPUT_surface",*) 'Not found namelist. Default used.'
592  elseif( ierr > 0 ) then !--- fatal error
593  log_error("REALINPUT_surface",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_LAND. Check!'
594  call prc_abort
595  endif
596  log_nml(param_mkinit_real_land)
597 
598  number_of_files_land = number_of_files
599  number_of_tsteps_land = number_of_tsteps
600  number_of_skip_tsteps_land = number_of_skip_tsteps
601  filetype_land = filetype_org
602  basename_boundary_land = basename_boundary
603  boundary_postfix_timelabel_land = boundary_postfix_timelabel
604  boundary_title_land = boundary_title
605  boundary_update_dt_land = boundary_update_dt
606  elevation_collection_land = elevation_collection
607 
608  if ( filetype_land .ne. "GrADS" .and. ( number_of_files > 1 .OR. basename_add_num ) ) then
609  basename_land = trim(basename_org)//"_00000"
610  else
611  basename_land = trim(basename_org)
612  endif
613 
614  select case( soilwater_ds2vc )
615  case( 'critical' )
616  soilwater_ds2vc_flag = .true.
617  case('limit' )
618  soilwater_ds2vc_flag = .false.
619  case default
620  log_error("REALINPUT_surface",*) 'Unsupported SOILWATER_DS2CV TYPE:', trim(soilwater_ds2vc)
621  call prc_abort
622  end select
623 
624  serial_land = serial_proc_read
625 
626  log_newline
627  log_info('REALINPUT_surface',*) 'Setup OCEAN'
628 
629  !--- read namelist
630  rewind(io_fid_conf)
631  read(io_fid_conf,nml=param_mkinit_real_ocean,iostat=ierr)
632  if( ierr < 0 ) then !--- missing
633  log_info("REALINPUT_surface",*) 'Not found namelist. Default used.'
634  elseif( ierr > 0 ) then !--- fatal error
635  log_error("REALINPUT_surface",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_OCEAN. Check!'
636  call prc_abort
637  endif
638  log_nml(param_mkinit_real_ocean)
639 
640  number_of_files_ocean = number_of_files
641  number_of_tsteps_ocean = number_of_tsteps
642  number_of_skip_tsteps_ocean = number_of_skip_tsteps
643  filetype_ocean = filetype_org
644  basename_boundary_ocean = basename_boundary
645  boundary_postfix_timelabel_ocean = boundary_postfix_timelabel
646  boundary_title_ocean = boundary_title
647  boundary_update_dt_ocean = boundary_update_dt
648  elevation_collection_ocean = elevation_collection
649 
650  if ( filetype_ocean .ne. "GrADS" .and. ( number_of_files > 1 .OR. basename_add_num ) ) then
651  basename_ocean = trim(basename_org)//"_00000"
652  else
653  basename_ocean = trim(basename_org)
654  endif
655 
656  serial_ocean = serial_proc_read
657 
658  ! check land/ocean parameters
659  if( number_of_files_land .NE. number_of_files_ocean .OR. &
660  number_of_tsteps_land .NE. number_of_tsteps_ocean .OR. &
661  number_of_skip_tsteps_land .NE. number_of_skip_tsteps_ocean .OR. &
662  basename_boundary_land .NE. basename_boundary_ocean .OR. &
663  boundary_postfix_timelabel_land .NEQV. boundary_postfix_timelabel_ocean .OR. &
664  boundary_title_land .NE. boundary_title_ocean .OR. &
665  boundary_update_dt_land .NE. boundary_update_dt_ocean ) then
666  log_error("REALINPUT_surface",*) 'The following LAND/OCEAN parameters must be consistent due to technical problem:'
667  log_error_cont(*) ' NUMBER_OF_FILES, NUMBER_OF_TSTEPS, NUMBER_OF_SKIP_TSTEPS,'
668  log_error_cont(*) ' BASENAME_BOUNDARY, BOUNDARY_POSTFIX_TIMELABEL, BOUNDARY_TITLE, BOUNDARY_UPDATE_DT.'
669  call prc_abort
670  end if
671 
672  call parentsurfacesetup( ldims, odims, & ![OUT]
673  mdlid_land, & ![OUT]
674  mdlid_ocean, & ![OUT]
675  timelen, & ![OUT]
676  basename_land, & ![IN]
677  basename_ocean, & ![IN]
678  filetype_land, & ![IN]
679  filetype_ocean, & ![IN]
680  use_file_landwater, & ![IN]
681  intrp_land_temp, & ![IN]
682  intrp_land_water, & ![IN]
683  intrp_land_sfc_temp, & ![IN]
684  intrp_ocean_temp, & ![IN]
685  intrp_ocean_sfc_temp ) ![IN]
686 
687  if ( timelen > 0 ) then
688  number_of_tsteps = timelen ! read from file
689  endif
690 
691  totaltimesteps = number_of_files * number_of_tsteps
692 
693  allocate( land_temp_org(lkmax,ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
694  allocate( land_water_org(lkmax,ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
695  allocate( land_sfc_temp_org( ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
696  allocate( land_sfc_albedo_org( ia,ja,n_rad_dir,n_rad_rgn,1+number_of_skip_tsteps:totaltimesteps) )
697 
698  allocate( ocean_temp_org(okmax,ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
699  allocate( ocean_sfc_temp_org( ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
700  allocate( ocean_sfc_albedo_org( ia,ja,n_rad_dir,n_rad_rgn,1+number_of_skip_tsteps:totaltimesteps) )
701  allocate( ocean_sfc_z0_org( ia,ja, 1+number_of_skip_tsteps:totaltimesteps) )
702 
703  if ( mdlid_ocean == igrads ) then
704  basename_org = ""
705  endif
706 
707  if ( basename_boundary /= '' ) then
708  boundary_flag = .true.
709  endif
710 
711  !--- read external file
712  do n = 1, number_of_files
713 
714  if ( number_of_files > 1 .OR. basename_add_num ) then
715  write(num,'(I5.5)') n-1
716  basename_land = trim(basename_org)//"_"//num
717  basename_ocean = trim(basename_org)//"_"//num
718  else
719  basename_land = trim(basename_org)
720  basename_ocean = trim(basename_org)
721  endif
722 
723  log_newline
724  log_info("REALINPUT_surface",*) 'Target File Name (Land) : ', trim(basename_land)
725  log_info("REALINPUT_surface",*) 'Target File Name (Ocean): ', trim(basename_ocean)
726  log_info("REALINPUT_surface",*) 'Time Steps in One File : ', number_of_tsteps
727 
728  ns = number_of_tsteps * (n - 1) + 1
729  ne = ns + (number_of_tsteps - 1)
730 
731  if ( ne <= number_of_skip_tsteps ) then
732  log_info("REALINPUT_surface",*) ' SKIP'
733  cycle
734  endif
735 
736  skip_steps = max(number_of_skip_tsteps - ns + 1, 0)
737  ns = max(ns, number_of_skip_tsteps+1)
738 
739  ! read all prepared data
740  call parentsurfaceinput( land_temp_org(:,:,:, ns:ne), &
741  land_water_org(:,:,:, ns:ne), &
742  land_sfc_temp_org(:,:, ns:ne), &
743  land_sfc_albedo_org(:,:,:,:,ns:ne), &
744  urban_tc_org, &
745  urban_qc_org, &
746  urban_uc_org, &
747  urban_sfc_temp_org, &
748  urban_sfc_albedo_org, &
749  ocean_temp_org(oks,:,:, ns:ne), &
750  ocean_sfc_temp_org( :,:, ns:ne), &
751  ocean_sfc_albedo_org( :,:,:,:,ns:ne), &
752  ocean_sfc_z0_org( :,:, ns:ne), &
753  basename_land, &
754  basename_ocean, &
755  mdlid_land, mdlid_ocean, &
756  ldims, odims, &
757  use_file_landwater, &
758  init_landwater_ratio, &
759  init_ocean_alb_lw, &
760  init_ocean_alb_sw, &
761  init_ocean_z0w, &
762  intrp_iter_max, &
763  soilwater_ds2vc_flag, &
764  elevation_collection_land, &
765  elevation_collection_ocean, &
766  boundary_flag, &
767  number_of_tsteps, skip_steps, &
768  urban_do )
769 
770  ! required one-step data only
771  if( basename_boundary == '' ) exit
772 
773  enddo
774 
775 
776  !--- input initial data
777  ns = number_of_skip_tsteps + 1 ! skip first several data
778 
779  do j = 1, ja
780  do i = 1, ia
781  ocean_sfc_temp(i,j) = ocean_sfc_temp_org(i,j,ns)
782  ocean_sfc_z0m(i,j) = ocean_sfc_z0_org(i,j,ns)
783  ocean_sfc_z0h(i,j) = ocean_sfc_z0_org(i,j,ns)
784  ocean_sfc_z0e(i,j) = ocean_sfc_z0_org(i,j,ns)
785  do irgn = i_r_ir, i_r_vis
786  do idir = i_r_direct, i_r_diffuse
787  ocean_sfc_albedo(i,j,idir,irgn) = ocean_sfc_albedo_org(i,j,idir,irgn,ns)
788  enddo
789  enddo
790  do k = 1, okmax
791  ocean_temp(k,i,j) = ocean_temp_org(oks,i,j,ns)
792  ocean_salt(k,i,j) = 0.0_rp
793  ocean_uvel(k,i,j) = 0.0_rp
794  ocean_vvel(k,i,j) = 0.0_rp
795  enddo
796  ocean_ocn_z0m(i,j) = ocean_sfc_z0_org(i,j,ns)
797  ocean_ice_temp(i,j) = min( ocean_sfc_temp_org(i,j,ns), ocean_phy_ice_freezetemp )
798  ocean_ice_mass(i,j) = 0.0_rp
799 
800  land_sfc_temp(i,j) = land_sfc_temp_org(i,j, ns)
801  do irgn = i_r_ir, i_r_vis
802  do idir = i_r_direct, i_r_diffuse
803  land_sfc_albedo(i,j,idir,irgn) = land_sfc_albedo_org(i,j,idir,irgn,ns)
804  enddo
805  enddo
806  do k = 1, lkmax
807  land_temp(k,i,j) = land_temp_org(k,i,j,ns)
808  land_water(k,i,j) = land_water_org(k,i,j,ns)
809  enddo
810 
811  if ( urban_do ) then
812  urban_sfc_temp(i,j) = urban_sfc_temp_org(i,j)
813  do irgn = i_r_ir, i_r_vis
814  do idir = i_r_direct, i_r_diffuse
815  urban_sfc_albedo(i,j,idir,irgn) = urban_sfc_albedo_org(i,j,idir,irgn)
816  enddo
817  enddo
818  do k = 1, ukmax
819  urban_trl(k,i,j) = urban_sfc_temp_org(i,j)
820  urban_tbl(k,i,j) = urban_sfc_temp_org(i,j)
821  urban_tgl(k,i,j) = urban_sfc_temp_org(i,j)
822  enddo
823  urban_tc(i,j) = urban_tc_org(i,j)
824  urban_qc(i,j) = urban_qc_org(i,j)
825  urban_uc(i,j) = urban_uc_org(i,j)
826  urban_tr(i,j) = urban_sfc_temp_org(i,j)
827  urban_tb(i,j) = urban_sfc_temp_org(i,j)
828  urban_tg(i,j) = urban_sfc_temp_org(i,j)
829  urban_rainr(i,j) = 0.0_rp
830  urban_rainb(i,j) = 0.0_rp
831  urban_raing(i,j) = 0.0_rp
832  urban_roff(i,j) = 0.0_rp
833  end if
834 
838 
839  if ( urban_do ) then
840  atmos_phy_sf_sfc_temp(i,j) = fact_ocean(i,j) * ocean_sfc_temp(i,j) &
841  + fact_land(i,j) * land_sfc_temp(i,j) &
842  + fact_urban(i,j) * urban_sfc_temp(i,j)
843  do irgn = i_r_ir, i_r_vis
844  do idir = i_r_direct, i_r_diffuse
845  atmos_phy_sf_sfc_albedo(i,j,idir,irgn) = fact_ocean(i,j) * ocean_sfc_albedo(i,j,idir,irgn) &
846  + fact_land(i,j) * land_sfc_albedo(i,j,idir,irgn) &
847  + fact_urban(i,j) * urban_sfc_albedo(i,j,idir,irgn)
848  enddo
849  enddo
850  else
851  atmos_phy_sf_sfc_temp(i,j) = fact_ocean(i,j) * ocean_sfc_temp(i,j) &
852  + fact_land(i,j) * land_sfc_temp(i,j)
853  do irgn = i_r_ir, i_r_vis
854  do idir = i_r_direct, i_r_diffuse
855  atmos_phy_sf_sfc_albedo(i,j,idir,irgn) = fact_ocean(i,j) * ocean_sfc_albedo(i,j,idir,irgn) &
856  + fact_land(i,j) * land_sfc_albedo(i,j,idir,irgn)
857  enddo
858  enddo
859  endif
860  enddo
861  enddo
862 
863 
864  !--- output boundary data
865  if( basename_boundary /= '' ) then
866  totaltimesteps = totaltimesteps - number_of_skip_tsteps ! skip first several data
867  if ( totaltimesteps > 1 ) then
868  if ( boundary_update_dt <= 0.0_dp ) then
869  log_error("REALINPUT_surface",*) 'BOUNDARY_UPDATE_DT is necessary in real case preprocess'
870  call prc_abort
871  endif
872 
873  if ( boundary_postfix_timelabel ) then
874  call time_gettimelabel( timelabel )
875  basename_out_mod = trim(basename_boundary)//'_'//trim(timelabel)
876  else
877  basename_out_mod = trim(basename_boundary)
878  endif
879 
880  call parentsurfaceboundary( land_temp_org(:,:,:,ns:ne), &
881  land_water_org(:,:,:,ns:ne), &
882  land_sfc_temp_org( :,:,ns:ne), &
883  ocean_temp_org(:,:,:,ns:ne), &
884  ocean_sfc_temp_org( :,:,ns:ne), &
885  ocean_sfc_z0_org( :,:,ns:ne), &
886  totaltimesteps, &
887  boundary_update_dt, &
888  basename_out_mod, &
889  boundary_title )
890 
891  endif
892  endif
893 
894  deallocate( land_temp_org )
895  deallocate( land_water_org )
896  deallocate( land_sfc_temp_org )
897  deallocate( land_sfc_albedo_org )
898  deallocate( ocean_temp_org )
899  deallocate( ocean_sfc_temp_org )
900  deallocate( ocean_sfc_albedo_org )
901  deallocate( ocean_sfc_z0_org )
902 
903  return
904  end subroutine realinput_surface
905 
906 
907  !-----------------------------------------------------------------------------
909  subroutine parentatmossetup( &
910  inputtype, &
911  basename, &
912  serial_in, &
913  use_file_density_in, &
914  dims, &
915  timelen )
916  use mod_realinput_scale, only: &
918  use mod_realinput_wrfarw, only: &
920 !!$ use mod_realinput_nicam, only: &
921 !!$ ParentAtmosSetupNICAM
922  use mod_realinput_grads, only: &
924  use mod_atmos_phy_ch_vars, only: &
925  qs_ch, &
926  qe_ch
927  use scale_atmos_hydrometeor, only: &
928  n_hyd
929  implicit none
930 
931  character(len=*), intent(in) :: inputtype
932  character(len=*), intent(in) :: basename
933  logical, intent(in) :: serial_in ! read by a serial process
934  logical, intent(in) :: use_file_density_in ! use density data from files
935  integer, intent(out) :: dims(6)
936  integer, intent(out) :: timelen
937  !---------------------------------------------------------------------------
938 
939  serial_atmos = serial_in
940  if ( serial_atmos ) then
941  if( prc_ismaster ) then
942  read_by_myproc_atmos = .true.
943  else
944  read_by_myproc_atmos = .false.
945  endif
946  else
947  read_by_myproc_atmos = .true.
948  endif
949 
950  select case(inputtype)
951  case('SCALE-RM')
952 
953  serial_atmos = .false. ! force false
954  read_by_myproc_atmos = .true.
955 
956  call parentatmossetupscale( dims(:) ) ! [OUT]
957  timelen = -1
958 
959  use_file_density = use_file_density_in
960  temp2pott = .false.
961  update_coord = .false.
962  apply_rotate_uv = .false.
963 
964  case('GrADS')
965 
966  if ( read_by_myproc_atmos ) then
967  call parentatmossetupgrads ( dims(:), & ! [OUT]
968  basename ) ! [IN]
969  endif
970  timelen = -1
971 
972  use_file_density = use_file_density_in
973  temp2pott = .true.
974  update_coord = .true.
975  apply_rotate_uv = .true.
976 
977  case('WRF-ARW')
978 
979  if ( read_by_myproc_atmos ) then
980  call parentatmossetupwrfarw( dims(:), & ! [OUT]
981  timelen, & ! [OUT]
982  basename ) ! [IN]
983  endif
984 
985  use_file_density = .false.
986  temp2pott = .true.
987  update_coord = .true.
988  apply_rotate_uv = .true.
989 
990 !!$ case('NICAM-NETCDF')
991 !!$
992 !!$ if ( read_by_myproc_atmos ) then
993 !!$ call ParentAtmosSetupNICAM ( dims(:), & ! [OUT]
994 !!$ timelen, & ! [OUT]
995 !!$ basename ) ! [IN]
996 !!$ endif
997 !!$
998 !!$ use_file_density = .false.
999 !!$ temp2pott = .true.
1000 !!$ update_coord = .false.
1001 !!$ apply_rotate_uv = .true.
1002 !!$
1003  case default
1004 
1005  log_error("ParentAtmosSetup",*) 'Unsupported type of input data : ', trim(inputtype)
1006  call prc_abort
1007 
1008  end select
1009 
1010  if ( serial_atmos ) then
1011  call comm_bcast( dims(:), 6 )
1012  call comm_bcast( timelen )
1013  endif
1014 
1015  allocate( lon_org( dims(2), dims(3) ) )
1016  allocate( lat_org( dims(2), dims(3) ) )
1017  allocate( cz_org( dims(1)+2, dims(2), dims(3) ) )
1018 
1019  allocate( w_org( dims(1)+2, dims(2), dims(3) ) )
1020  allocate( u_org( dims(1)+2, dims(2), dims(3) ) )
1021  allocate( v_org( dims(1)+2, dims(2), dims(3) ) )
1022  allocate( pott_org( dims(1)+2, dims(2), dims(3) ) )
1023  allocate( temp_org( dims(1)+2, dims(2), dims(3) ) )
1024  allocate( pres_org( dims(1)+2, dims(2), dims(3) ) )
1025  allocate( dens_org( dims(1)+2, dims(2), dims(3) ) )
1026  allocate( qtrc_org( dims(1)+2, dims(2), dims(3), qa ) )
1027 
1028  allocate( qv_org( dims(1)+2, dims(2), dims(3) ) )
1029  allocate( qhyd_org( dims(1)+2, dims(2), dims(3), n_hyd ) )
1030  allocate( qnum_org( dims(1)+2, dims(2), dims(3), n_hyd ) )
1031  allocate( rn222_org( dims(1)+2, dims(2), dims(3) ) )
1032 
1033  log_info("ParentAtmosSetup",*) 'Horizontal Interpolation Level: ', comm_cartesc_nest_interp_level
1035  itp_nv = 2
1036 
1037  allocate( igrd( ia,ja,itp_nh) )
1038  allocate( jgrd( ia,ja,itp_nh) )
1039  allocate( hfact( ia,ja,itp_nh) )
1040  allocate( kgrd(ka,itp_nv,ia,ja,itp_nh) )
1041  allocate( vfact(ka,itp_nv,ia,ja,itp_nh) )
1042 
1043  return
1044  end subroutine parentatmossetup
1045 
1046  !-----------------------------------------------------------------------------
1048  subroutine parentatmosopen( &
1049  inputtype, &
1050  basename, &
1051  dims )
1052  use mod_realinput_scale, only: &
1054  use mod_realinput_wrfarw, only: &
1056 !!$ use mod_realinput_nicam, only: &
1057 !!$ ParentAtmosOpenNICAM
1058  use mod_realinput_grads, only: &
1060  implicit none
1061 
1062  character(len=*), intent(in) :: inputtype
1063  character(len=*), intent(in) :: basename
1064  integer, intent(in) :: dims(6)
1065  !---------------------------------------------------------------------------
1066 
1067  if ( read_by_myproc_atmos ) then
1068 
1069  select case(inputtype)
1070  case('SCALE-RM')
1071  call parentatmosopenscale( lon_org(:,:), & ! [OUT]
1072  lat_org(:,:), & ! [OUT]
1073  cz_org(:,:,:), & ! [OUT]
1074  basename, & ! [IN]
1075  dims(:) ) ! [IN]
1076  case('GrADS')
1078  case('WRF-ARW')
1080  case('NETCDF')
1081  call parentatmosopenscale( lon_org(:,:), & ! [OUT]
1082  lat_org(:,:), & ! [OUT]
1083  cz_org(:,:,:), & ! [OUT]
1084  basename, & ! [IN]
1085  dims(:) ) ! [IN]
1086  end select
1087 
1088  endif
1089 
1090  return
1091  end subroutine parentatmosopen
1092 
1093  !-----------------------------------------------------------------------------
1095  subroutine parentatmosinput( &
1096  inputtype, &
1097  basename, &
1098  dims, &
1099  istep, &
1100  same_mptype, &
1101  DENS, &
1102  MOMZ, &
1103  MOMX, &
1104  MOMY, &
1105  RHOT, &
1106  QTRC, &
1107  VELZ, &
1108  VELX, &
1109  VELY, &
1110  POTT )
1111  use scale_comm_cartesc, only: &
1112  comm_vars8, &
1113  comm_wait
1114  use scale_atmos_grid_cartesc_metric, only: &
1116  use scale_atmos_hydrometeor, only: &
1118  i_qv, &
1119  qls, &
1120  qle
1121  use scale_atmos_thermodyn, only: &
1122  thermodyn_qdry => atmos_thermodyn_qdry, &
1123  thermodyn_r => atmos_thermodyn_r, &
1124  thermodyn_cp => atmos_thermodyn_cp, &
1125  thermodyn_temp_pres2pott => atmos_thermodyn_temp_pres2pott
1126  use scale_atmos_hydrostatic, only: &
1127  hydrostatic_buildrho_real => atmos_hydrostatic_buildrho_real
1128  use scale_interp, only: &
1130  interp_factor3d, &
1132  use scale_filter, only: &
1133  filter_hyperdiff
1134  use mod_atmos_admin, only: &
1136  use mod_realinput_scale, only: &
1138  use mod_realinput_wrfarw, only: &
1140 !!$ use mod_realinput_nicam, only: &
1141 !!$ ParentAtmosInputNICAM
1142  use mod_realinput_grads, only: &
1144  use mod_atmos_phy_mp_vars, only: &
1145  qs_mp, &
1146  qe_mp
1147  use mod_atmos_phy_ch_vars, only: &
1148  qs_ch, &
1149  qe_ch
1150  use mod_atmos_phy_mp_driver, only: &
1152  use scale_atmos_grid_cartesc_real, only: &
1154  implicit none
1155 
1156  character(len=*), intent(in) :: inputtype
1157  character(len=*), intent(in) :: basename
1158  integer, intent(in) :: dims(6)
1159  integer, intent(in) :: istep
1160  logical, intent(in) :: same_mptype ! Is microphysics type same between outer and inner model
1161  real(RP), intent(out) :: DENS(ka,ia,ja)
1162  real(RP), intent(out) :: MOMZ(ka,ia,ja)
1163  real(RP), intent(out) :: MOMX(ka,ia,ja)
1164  real(RP), intent(out) :: MOMY(ka,ia,ja)
1165  real(RP), intent(out) :: RHOT(ka,ia,ja)
1166  real(RP), intent(out) :: QTRC(ka,ia,ja,qa)
1167  real(RP), intent(out) :: VELZ(ka,ia,ja)
1168  real(RP), intent(out) :: VELX(ka,ia,ja)
1169  real(RP), intent(out) :: VELY(ka,ia,ja)
1170  real(RP), intent(out) :: POTT(ka,ia,ja)
1171 
1172  real(RP) :: PRES (ka,ia,ja)
1173  real(RP) :: TEMP (ka,ia,ja)
1174  real(RP) :: W (ka,ia,ja)
1175  real(RP) :: U (ka,ia,ja)
1176  real(RP) :: V (ka,ia,ja)
1177  real(RP) :: QV (ka,ia,ja)
1178  real(RP) :: QC (ka,ia,ja)
1179  real(RP) :: u_on_map, v_on_map
1180 
1181  real(RP) :: qdry, Rtot, CPtot
1182 
1183  logical, save :: first = .true.
1184 
1185  logical :: same_mptype_ = .false.
1186 
1187  real(RP) :: one(ka,ia,ja)
1188 
1189  integer :: k, i, j, iq
1190  !---------------------------------------------------------------------------
1191 
1192  call prof_rapstart('___AtmosInput',3)
1193 
1194  if ( read_by_myproc_atmos ) then
1195  select case(inputtype)
1196  case('SCALE-RM')
1197  call parentatmosinputscale ( w_org(:,:,:), & ! [OUT]
1198  u_org(:,:,:), & ! [OUT]
1199  v_org(:,:,:), & ! [OUT]
1200  pres_org(:,:,:), & ! [OUT]
1201  dens_org(:,:,:), & ! [OUT]
1202  pott_org(:,:,:), & ! [OUT]
1203  qv_org(:,:,:), & ! [OUT]
1204  qtrc_org(:,:,:,:), & ! [OUT]
1205  cz_org(:,:,:), & ! [IN]
1206  basename, & ! [IN]
1207  same_mptype, & ! [IN]
1208  dims(:), & ! [IN]
1209  istep ) ! [IN]
1210  same_mptype_ = .true.
1211  case('GrADS')
1212  call parentatmosinputgrads ( w_org(:,:,:), & ! [OUT]
1213  u_org(:,:,:), & ! [OUT]
1214  v_org(:,:,:), & ! [OUT]
1215  pres_org(:,:,:), & ! [OUT]
1216  dens_org(:,:,:), & ! [OUT]
1217  temp_org(:,:,:), & ! [OUT]
1218  qv_org(:,:,:), & ! [OUT]
1219  qhyd_org(:,:,:,:), & ! [OUT]
1220  rn222_org(:,:,:), & ! [OUT]
1221  lon_org(:,:), & ! [OUT]
1222  lat_org(:,:), & ! [OUT]
1223  cz_org(:,:,:), & ! [OUT]
1224  basename, & ! [IN]
1225  dims(:), & ! [IN]
1226  istep ) ! [IN]
1227  same_mptype_ = .false.
1228  qnum_org(:,:,:,:) = 0.0_rp
1229  case('WRF-ARW')
1230  call parentatmosinputwrfarw( w_org(:,:,:), & ! [OUT]
1231  u_org(:,:,:), & ! [OUT]
1232  v_org(:,:,:), & ! [OUT]
1233  pres_org(:,:,:), & ! [OUT]
1234  temp_org(:,:,:), & ! [OUT]
1235  qv_org(:,:,:), & ! [OUT]
1236  qhyd_org(:,:,:,:), & ! [OUT]
1237  qnum_org(:,:,:,:), & ! [OUT]
1238  lon_org(:,:), & ! [OUT]
1239  lat_org(:,:), & ! [OUT]
1240  cz_org(:,:,:), & ! [OUT]
1241  basename, & ! [IN]
1242  dims(:), & ! [IN]
1243  istep ) ! [IN]
1244  same_mptype_ = .false.
1245  dens_org(:,:,:) = 0.0_rp
1246 !!$ case('NETCDF')
1247 !!$ call ParentAtmosInputNICAM ( W_org (:,:,:), & ! [OUT]
1248 !!$ U_org (:,:,:), & ! [OUT]
1249 !!$ V_org (:,:,:), & ! [OUT]
1250 !!$ PRES_org(:,:,:), & ! [OUT]
1251 !!$ TEMP_org(:,:,:), & ! [OUT]
1252 !!$ QTRC_org(:,:,:,:), & ! [OUT]
1253 !!$ basename, & ! [IN]
1254 !!$ dims(:), & ! [IN]
1255 !!$ istep ) ! [IN]
1256 !!$ DENS_org(:,:,:) = 0.0_RP
1257  end select
1258 
1259  if ( .not. same_mptype_ ) then
1260  call atmos_phy_mp_driver_qhyd2qtrc( dims(1)+2, 1, dims(1)+2, dims(2), 1, dims(2), dims(3), 1, dims(3), &
1261  qv_org(:,:,:), qhyd_org(:,:,:,:), & ! [IN]
1262  qtrc_org(:,:,:,qs_mp:qe_mp), & ! [OUT]
1263  qnum=qnum_org(:,:,:,:) ) ! [IN]
1264  end if
1265 
1266  if ( atmos_phy_ch_type == 'RN222' ) then
1267  qtrc_org(:,:,:,qs_ch) = rn222_org(:,:,:)
1268  endif
1269 
1270  if ( temp2pott ) then
1271  do j = 1, dims(3)
1272  do i = 1, dims(2)
1273  do k = 1, dims(1)+2
1274  call thermodyn_qdry( qa, qtrc_org(k,i,j,:), tracer_mass(:), qdry )
1275  call thermodyn_r ( qa, qtrc_org(k,i,j,:), tracer_r(:), qdry, rtot )
1276  call thermodyn_cp ( qa, qtrc_org(k,i,j,:), tracer_cp(:), qdry, cptot )
1277  call thermodyn_temp_pres2pott( temp_org(k,i,j), pres_org(k,i,j), cptot, rtot, & ! [IN]
1278  pott_org(k,i,j) ) ! [OUT]
1279  enddo
1280  enddo
1281  enddo
1282  endif
1283 
1284  endif ! read by this process?
1285 
1286  call prof_rapend ('___AtmosInput',3)
1287 
1288  call prof_rapstart('___AtmosBcast',3)
1289 
1290  if ( serial_atmos ) then
1291  if ( first .OR. update_coord ) then
1292  call comm_bcast( lon_org, dims(2), dims(3) )
1293  call comm_bcast( lat_org, dims(2), dims(3) )
1294  call comm_bcast( cz_org, dims(1)+2, dims(2), dims(3) )
1295  endif
1296 
1297  call comm_bcast( w_org , dims(1)+2, dims(2), dims(3) )
1298  call comm_bcast( u_org , dims(1)+2, dims(2), dims(3) )
1299  call comm_bcast( v_org , dims(1)+2, dims(2), dims(3) )
1300  call comm_bcast( pott_org, dims(1)+2, dims(2), dims(3) )
1301  call comm_bcast( pres_org, dims(1)+2, dims(2), dims(3) )
1302  call comm_bcast( dens_org, dims(1)+2, dims(2), dims(3) )
1303  call comm_bcast( qtrc_org, dims(1)+2, dims(2), dims(3), qa )
1304 
1305  endif
1306 
1307  call prof_rapend ('___AtmosBcast',3)
1308 
1309  do iq = 1, qa
1310  do j = 1, dims(3)
1311  do i = 1, dims(2)
1312  do k = 1, dims(1)+2
1313  qtrc_org(k,i,j,iq) = max( qtrc_org(k,i,j,iq), 0.0_rp )
1314  enddo
1315  enddo
1316  enddo
1317  enddo
1318 
1319  ! interpolation
1320  call prof_rapstart('___AtmosInterp',3)
1321 
1322  if ( first .OR. update_coord ) then
1323  first = .false.
1324 
1325  k = dims(1) + 2
1326  call interp_domain_compatibility( lon_org(:,:), & ! [IN]
1327  lat_org(:,:), & ! [IN]
1328  cz_org(k,:,:), & ! [IN]
1329  lon(:,:), & ! [IN]
1330  lat(:,:), & ! [IN]
1331  cz(ke,:,:), & ! [IN]
1332  fz(ke,:,:) ) ! [IN]
1333 
1334  ! full level
1335  call interp_factor3d( itp_nh, & ! [IN]
1336  dims(1)+2, 1, dims(1)+2, & ! [IN]
1337  dims(2), dims(3), & ! [IN]
1338  lon_org(:,:), & ! [IN]
1339  lat_org(:,:), & ! [IN]
1340  cz_org(:,:,:), & ! [IN]
1341  ka, ks, ke, & ! [IN]
1342  ia, ja, & ! [IN]
1343  lon(:,:), & ! [IN]
1344  lat(:,:), & ! [IN]
1345  cz(:,:,:), & ! [IN]
1346  igrd( :,:,:), & ! [OUT]
1347  jgrd( :,:,:), & ! [OUT]
1348  hfact( :,:,:), & ! [OUT]
1349  kgrd(:,:,:,:,:), & ! [OUT]
1350  vfact(:,:,:,:,:) ) ! [OUT]
1351  endif
1352 
1353  call interp_interp3d( itp_nh, & ! [IN]
1354  dims(1)+2, dims(2), dims(3), & ! [IN]
1355  ka, ks, ke, & ! [IN]
1356  ia, ja, & ! [IN]
1357  igrd( :,:,:), & ! [IN]
1358  jgrd( :,:,:), & ! [IN]
1359  hfact( :,:,:), & ! [IN]
1360  kgrd(:,:,:,:,:), & ! [IN]
1361  vfact(:,:,:,:,:), & ! [IN]
1362  w_org(:,:,:), & ! [IN]
1363  w(:,:,:) ) ! [OUT]
1364  if ( filter_niter > 0 ) then
1365  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1366  w(:,:,:), filter_order, filter_niter )
1367  call comm_vars8( w(:,:,:), 1 )
1368  call comm_wait ( w(:,:,:), 1 )
1369  end if
1370 
1371 
1372  call interp_interp3d( itp_nh, & ! [IN]
1373  dims(1)+2, dims(2), dims(3), & ! [IN]
1374  ka, ks, ke, & ! [IN]
1375  ia, ja, & ! [IN]
1376  igrd( :,:,:), & ! [IN]
1377  jgrd( :,:,:), & ! [IN]
1378  hfact( :,:,:), & ! [IN]
1379  kgrd(:,:,:,:,:), & ! [IN]
1380  vfact(:,:,:,:,:), & ! [IN]
1381  u_org(:,:,:), & ! [IN]
1382  u(:,:,:) ) ! [OUT]
1383  if ( filter_niter > 0 ) then
1384  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1385  u(:,:,:), filter_order, filter_niter )
1386  call comm_vars8( u(:,:,:), 1 )
1387  call comm_wait ( u(:,:,:), 1 )
1388  end if
1389 
1390  call interp_interp3d( itp_nh, & ! [IN]
1391  dims(1)+2, dims(2), dims(3), & ! [IN]
1392  ka, ks, ke, & ! [IN]
1393  ia, ja, & ! [IN]
1394  igrd( :,:,:), & ! [IN]
1395  jgrd( :,:,:), & ! [IN]
1396  hfact( :,:,:), & ! [IN]
1397  kgrd(:,:,:,:,:), & ! [IN]
1398  vfact(:,:,:,:,:), & ! [IN]
1399  v_org(:,:,:), & ! [IN]
1400  v(:,:,:) ) ! [OUT]
1401  if ( filter_niter > 0 ) then
1402  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1403  v(:,:,:), filter_order, filter_niter )
1404  call comm_vars8( v(:,:,:), 1 )
1405  call comm_wait ( v(:,:,:), 1 )
1406  end if
1407 
1408  if ( apply_rotate_uv ) then ! rotation from latlon field to map-projected field
1409  do j = 1, ja
1410  do i = 1, ia
1411  do k = ks, ke
1412  u_on_map = u(k,i,j) * rotc(i,j,1) + v(k,i,j) * rotc(i,j,2)
1413  v_on_map = -u(k,i,j) * rotc(i,j,2) + v(k,i,j) * rotc(i,j,1)
1414 
1415  u(k,i,j) = u_on_map
1416  v(k,i,j) = v_on_map
1417  enddo
1418  enddo
1419  enddo
1420  endif
1421 
1422  ! from scalar point to staggered point
1423  do j = 1, ja
1424  do i = 1, ia
1425  do k = ks, ke-1
1426  velz(k,i,j) = 0.5_rp * ( w(k+1,i,j) + w(k,i,j) )
1427  enddo
1428  enddo
1429  enddo
1430 
1431  do j = 1, ja
1432  do i = 1, ia-1
1433  do k = ks, ke
1434  velx(k,i,j) = 0.5_rp * ( u(k,i+1,j) + u(k,i,j) )
1435  enddo
1436  enddo
1437  enddo
1438 
1439  i = ia
1440  do j = 1, ja
1441  do k = ks, ke
1442  velx(k,i,j) = u(k,i,j)
1443  enddo
1444  enddo
1445 
1446  do j = 1, ja-1
1447  do i = 1, ia
1448  do k = ks, ke
1449  vely(k,i,j) = 0.5_rp * ( v(k,i,j+1) + v(k,i,j) )
1450  enddo
1451  enddo
1452  enddo
1453 
1454  j = ja
1455  do i = 1, ia
1456  do k = ks, ke
1457  vely(k,i,j) = v(k,i,j)
1458  enddo
1459  enddo
1460 
1461  do j = 1, ja
1462  do i = 1, ia
1463  velz( 1:ks-1,i,j) = 0.0_rp
1464  velz(ke :ka ,i,j) = 0.0_rp
1465  velx( 1:ks-1,i,j) = 0.0_rp
1466  velx(ke+1:ka ,i,j) = 0.0_rp
1467  vely( 1:ks-1,i,j) = 0.0_rp
1468  vely(ke+1:ka ,i,j) = 0.0_rp
1469  enddo
1470  enddo
1471 
1472  call comm_vars8( velz(:,:,:), 1 )
1473  call comm_vars8( velx(:,:,:), 2 )
1474  call comm_vars8( vely(:,:,:), 3 )
1475  call comm_wait ( velz(:,:,:), 1, .false. )
1476  call comm_wait ( velx(:,:,:), 2, .false. )
1477  call comm_wait ( vely(:,:,:), 3, .false. )
1478 
1479  call interp_interp3d( itp_nh, & ! [IN]
1480  dims(1)+2, dims(2), dims(3), & ! [IN]
1481  ka, ks, ke, & ! [IN]
1482  ia, ja, & ! [IN]
1483  igrd( :,:,:), & ! [IN]
1484  jgrd( :,:,:), & ! [IN]
1485  hfact( :,:,:), & ! [IN]
1486  kgrd(:,:,:,:,:), & ! [IN]
1487  vfact(:,:,:,:,:), & ! [IN]
1488  pott_org(:,:,:), & ! [IN]
1489  pott(:,:,:) ) ! [OUT]
1490  if ( filter_niter > 0 ) then
1491  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1492  pott(:,:,:), filter_order, filter_niter )
1493  call comm_vars8( pott(:,:,:), 1 )
1494  call comm_wait ( pott(:,:,:), 1 )
1495  end if
1496 
1497  do j = 1, ja
1498  do i = 1, ia
1499  pott( 1:ks-1,i,j) = 0.0_rp
1500  pott(ke+1:ka ,i,j) = 0.0_rp
1501  enddo
1502  enddo
1503 
1504  do iq = 1, qa
1505  call interp_interp3d( itp_nh, & ! [IN]
1506  dims(1)+2, dims(2), dims(3), & ! [IN]
1507  ka, ks, ke, & ! [IN]
1508  ia, ja, & ! [IN]
1509  igrd( :,:,:), & ! [IN]
1510  jgrd( :,:,:), & ! [IN]
1511  hfact( :,:,:), & ! [IN]
1512  kgrd(:,:,:,:,:), & ! [IN]
1513  vfact(:,:,:,:,:), & ! [IN]
1514  qtrc_org(:,:,:,iq), & ! [IN]
1515  qtrc(:,:,:,iq) ) ! [OUT]
1516  if ( filter_niter > 0 ) then
1517  one(:,:,:) = 1.0_rp
1518  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1519  qtrc(:,:,:,iq), filter_order, filter_niter, &
1520  limiter_sign = one(:,:,:) )
1521  call comm_vars8( qtrc(:,:,:,iq), 1 )
1522  call comm_wait ( qtrc(:,:,:,iq), 1 )
1523  end if
1524 
1525  do j = 1, ja
1526  do i = 1, ia
1527  qtrc( 1:ks-1,i,j,iq) = 0.0_rp
1528  qtrc(ke+1:ka ,i,j,iq) = 0.0_rp
1529  enddo
1530  enddo
1531  enddo
1532 
1533  if ( use_file_density ) then
1534  call interp_interp3d( itp_nh, & ! [IN]
1535  dims(1)+2, dims(2), dims(3), & ! [IN]
1536  ka, ks, ke, & ! [IN]
1537  ia, ja, & ! [IN]
1538  igrd( :,:,:), & ! [IN]
1539  jgrd( :,:,:), & ! [IN]
1540  hfact( :,:,:), & ! [IN]
1541  kgrd(:,:,:,:,:), & ! [IN]
1542  vfact(:,:,:,:,:), & ! [IN]
1543  dens_org(:,:,:), & ! [IN]
1544  dens(:,:,:), & ! [OUT]
1545  logwgt = .true. ) ! [IN]
1546  if ( filter_niter > 0 ) then
1547  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1548  dens(:,:,:), filter_order, filter_niter, &
1549  limiter_sign = one(:,:,:) )
1550  call comm_vars8( dens(:,:,:), 1 )
1551  call comm_wait ( dens(:,:,:), 1 )
1552  end if
1553  else
1554  call interp_interp3d( itp_nh, & ! [IN]
1555  dims(1)+2, dims(2), dims(3), & ! [IN]
1556  ka, ks, ke, & ! [IN]
1557  ia, ja, & ! [IN]
1558  igrd( :,:,:), & ! [IN]
1559  jgrd( :,:,:), & ! [IN]
1560  hfact( :,:,:), & ! [IN]
1561  kgrd(:,:,:,:,:), & ! [IN]
1562  vfact(:,:,:,:,:), & ! [IN]
1563  pres_org(:,:,:), & ! [IN]
1564  pres(:,:,:), & ! [OUT]
1565  logwgt = .true. ) ! [IN]
1566  if ( filter_niter > 0 ) then
1567  call filter_hyperdiff( ka, ks, ke, ia, is, ie, ja, js, je, &
1568  pres(:,:,:), filter_order, filter_niter, &
1569  limiter_sign = one(:,:,:) )
1570  call comm_vars8( pres(:,:,:), 1 )
1571  call comm_wait ( pres(:,:,:), 1 )
1572  end if
1573 
1574  qc(:,:,:) = 0.0_rp
1575  if ( atmos_hydrometeor_dry ) then
1576  qv(:,:,:) = 0.0_rp
1577  else
1578  qv(:,:,:) = qtrc(:,:,:,i_qv)
1579  do iq = qls, qle
1580  qc(:,:,:) = qc(:,:,:) + qtrc(:,:,:,iq)
1581  enddo
1582  end if
1583 
1584  ! make density & pressure profile in moist condition
1585  call hydrostatic_buildrho_real( ka, ks, ke, ia, 1, ia, ja, 1, ja, &
1586  pott(:,:,:), qv(:,:,:), qc(:,:,:), & ! [IN]
1587  cz(:,:,:), & ! [IN]
1588  pres(:,:,:), & ! [INOUT]
1589  dens(:,:,:), temp(:,:,:) ) ! [OUT]
1590 
1591  call comm_vars8( dens(:,:,:), 1 )
1592  call comm_wait ( dens(:,:,:), 1 )
1593  endif
1594 
1595  do j = 1, ja
1596  do i = 1, ia
1597  dens( 1:ks-1,i,j) = 0.0_rp
1598  dens(ke+1:ka ,i,j) = 0.0_rp
1599  enddo
1600  enddo
1601 
1602  do j = 1, ja
1603  do i = 1, ia
1604  do k = ks, ke-1
1605  momz(k,i,j) = velz(k,i,j) * 0.5_rp * ( dens(k+1,i,j) + dens(k,i,j) )
1606  enddo
1607  enddo
1608  enddo
1609 
1610  do j = 1, ja
1611  do i = 1, ia-1
1612  do k = ks, ke
1613  momx(k,i,j) = velx(k,i,j) * 0.5_rp * ( dens(k,i+1,j) + dens(k,i,j) )
1614  enddo
1615  enddo
1616  enddo
1617 
1618  i = ia
1619  do j = 1, ja
1620  do k = ks, ke
1621  momx(k,i,j) = velx(k,i,j) * dens(k,i,j)
1622  enddo
1623  enddo
1624 
1625  do j = 1, ja-1
1626  do i = 1, ia
1627  do k = ks, ke
1628  momy(k,i,j) = vely(k,i,j) * 0.5_rp * ( dens(k,i,j+1) + dens(k,i,j) )
1629  enddo
1630  enddo
1631  enddo
1632 
1633  j = ja
1634  do i = 1, ia
1635  do k = ks, ke
1636  momy(k,i,j) = vely(k,i,j) * dens(k,i,j)
1637  enddo
1638  enddo
1639 
1640  do j = 1, ja
1641  do i = 1, ia
1642  do k = 1, ka
1643  rhot(k,i,j) = pott(k,i,j) * dens(k,i,j)
1644  enddo
1645  enddo
1646  enddo
1647 
1648  do j = 1, ja
1649  do i = 1, ia
1650  momz( 1:ks-1,i,j) = 0.0_rp
1651  momz(ke :ka ,i,j) = 0.0_rp
1652  momx( 1:ks-1,i,j) = 0.0_rp
1653  momx(ke+1:ka ,i,j) = 0.0_rp
1654  momy( 1:ks-1,i,j) = 0.0_rp
1655  momy(ke+1:ka ,i,j) = 0.0_rp
1656  enddo
1657  enddo
1658 
1659  call comm_vars8( momz(:,:,:), 1 )
1660  call comm_vars8( momx(:,:,:), 2 )
1661  call comm_vars8( momy(:,:,:), 3 )
1662  call comm_wait ( momz(:,:,:), 1, .false. )
1663  call comm_wait ( momx(:,:,:), 2, .false. )
1664  call comm_wait ( momy(:,:,:), 3, .false. )
1665 
1666  call prof_rapend ('___AtmosInterp',3)
1667 
1668  return
1669  end subroutine parentatmosinput
1670 
1671  !-----------------------------------------------------------------------------
1673  subroutine boundaryatmossetup( &
1674  basename, &
1675  title, &
1676  datatype, &
1677  timeintv, &
1678  fid, &
1679  vid )
1680  use scale_file_cartesc, only: &
1684  use scale_time, only: &
1685  nowdate => time_nowdate
1686  use mod_atmos_phy_mp_vars, only: &
1687  qs_mp, &
1688  qe_mp
1689  use mod_atmos_phy_ch_vars, only: &
1690  qs_ch, &
1691  qe_ch
1692  implicit none
1693 
1694  character(len=*), intent(in) :: basename
1695  character(len=*), intent(in) :: title
1696  character(len=*), intent(in) :: datatype
1697  real(DP), intent(in) :: timeintv
1698  integer, intent(out) :: fid
1699  integer, intent(out) :: vid(5+qa)
1700 
1701  integer :: iq
1702  !---------------------------------------------------------------------------
1703 
1704  call file_cartesc_create( basename, title, datatype, fid, date=nowdate )
1705 
1706  call file_cartesc_def_var( fid, &
1707  'DENS', 'Reference Density', 'kg/m3', 'ZXYT', datatype, & ! [IN]
1708  vid(1), & ! [OUT]
1709  timeintv=timeintv ) ! [IN]
1710  call file_cartesc_def_var( fid, &
1711  'VELZ', 'Reference VELZ', 'm/s', 'ZHXYT', datatype, & ! [IN]
1712  vid(2), & ! [OUT]
1713  timeintv=timeintv ) ! [IN]
1714  call file_cartesc_def_var( fid, &
1715  'VELX', 'Reference VELX', 'm/s', 'ZXHYT', datatype, & ! [IN]
1716  vid(3), & ! [OUT]
1717  timeintv=timeintv ) ! [IN]
1718  call file_cartesc_def_var( fid, &
1719  'VELY', 'Reference VELY', 'm/s', 'ZXYHT', datatype, & ! [IN]
1720  vid(4), & ! [OUT]
1721  timeintv=timeintv ) ! [IN]
1722  call file_cartesc_def_var( fid, &
1723  'POTT', 'Reference PT', 'K', 'ZXYT', datatype, & ! [IN]
1724  vid(5), & ! [OUT]
1725  timeintv=timeintv ) ! [IN]
1726 
1727  do iq = qs_mp, qe_mp
1728  call file_cartesc_def_var( fid, & ! [IN]
1729  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
1730  'ZXYT', datatype, & ! [IN]
1731  vid(5+iq), & ! [OUT]
1732  timeintv = timeintv ) ! [IN]
1733  enddo
1734 
1735  do iq = qs_ch, qe_ch
1736  call file_cartesc_def_var( fid, & ! [IN]
1737  tracer_name(iq), 'Reference '//tracer_name(iq), 'kg/kg', & ! [IN]
1738  'ZXYT', datatype, & ! [IN]
1739  vid(5+iq), & ! [OUT]
1740  timeintv = timeintv ) ! [IN]
1741  enddo
1742 
1743  call file_cartesc_enddef( fid )
1744 
1745  return
1746  end subroutine boundaryatmossetup
1747 
1748  !-----------------------------------------------------------------------------
1750  subroutine boundaryatmosoutput( &
1751  DENS, &
1752  VELZ, &
1753  VELX, &
1754  VELY, &
1755  POTT, &
1756  QTRC, &
1757  fid, &
1758  vid, &
1759  timeintv, &
1760  istep )
1761  use scale_file_cartesc, only: &
1762  file_cartesc_write_var
1763  use mod_atmos_phy_mp_vars, only: &
1764  qs_mp, &
1765  qe_mp
1766  use mod_atmos_phy_ch_vars, only: &
1767  qs_ch, &
1768  qe_ch
1769  implicit none
1770 
1771  real(RP), intent(in) :: DENS(ka,ia,ja)
1772  real(RP), intent(in) :: VELZ(ka,ia,ja)
1773  real(RP), intent(in) :: VELX(ka,ia,ja)
1774  real(RP), intent(in) :: VELY(ka,ia,ja)
1775  real(RP), intent(in) :: POTT(ka,ia,ja)
1776  real(RP), intent(in) :: QTRC(ka,ia,ja,qa)
1777  integer, intent(in) :: fid
1778  integer, intent(in) :: vid(5+qa)
1779  real(DP), intent(in) :: timeintv
1780  integer, intent(in) :: istep
1781 
1782  real(RP) :: work(ka,ia,ja,1)
1783 
1784  real(DP) :: timeofs
1785  integer :: iq
1786  !---------------------------------------------------------------------------
1787 
1788  call prof_rapstart('___AtmosOutput',3)
1789 
1790  timeofs = real(istep-1,kind=DP) * timeintv
1791 
1792 !OCL XFILL
1793  work(:,:,:,1) = dens(:,:,:)
1794  call file_cartesc_write_var( fid, vid(1), work(:,:,:,:), 'DENS', 'ZXYT', timeintv, timeofs=timeofs )
1795 !OCL XFILL
1796  work(:,:,:,1) = velz(:,:,:)
1797  call file_cartesc_write_var( fid, vid(2), work(:,:,:,:), 'VELZ', 'ZHXYT', timeintv, timeofs=timeofs )
1798 !OCL XFILL
1799  work(:,:,:,1) = velx(:,:,:)
1800  call file_cartesc_write_var( fid, vid(3), work(:,:,:,:), 'VELX', 'ZXHYT', timeintv, timeofs=timeofs )
1801 !OCL XFILL
1802  work(:,:,:,1) = vely(:,:,:)
1803  call file_cartesc_write_var( fid, vid(4), work(:,:,:,:), 'VELY', 'ZXYHT', timeintv, timeofs=timeofs )
1804 !OCL XFILL
1805  work(:,:,:,1) = pott(:,:,:)
1806  call file_cartesc_write_var( fid, vid(5), work(:,:,:,:), 'POTT', 'ZXYT', timeintv, timeofs=timeofs )
1807 
1808  do iq = qs_mp, qe_mp
1809  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
1810  'ZXYT', timeintv, timeofs=timeofs )
1811  enddo
1812 
1813  do iq = qs_ch, qe_ch
1814  call file_cartesc_write_var( fid, vid(5+iq),qtrc(:,:,:,iq:iq), tracer_name(iq), &
1815  'ZXYT', timeintv, timeofs=timeofs )
1816  enddo
1817 
1818  call prof_rapend ('___AtmosOutput',3)
1819 
1820  return
1821  end subroutine boundaryatmosoutput
1822 
1823  !-----------------------------------------------------------------------------
1825  subroutine parentsurfacesetup( &
1826  ldims, odims, &
1827  lmdlid, omdlid, &
1828  timelen, &
1829  basename_land, &
1830  basename_ocean, &
1831  filetype_land, &
1832  filetype_ocean, &
1833  use_file_landwater, &
1834  intrp_land_temp, &
1835  intrp_land_water, &
1836  intrp_land_sfc_temp, &
1837  intrp_ocean_temp, &
1838  intrp_ocean_sfc_temp )
1839  use mod_realinput_scale, only: &
1842  use mod_realinput_wrfarw, only: &
1845 !!$ use mod_realinput_nicam, only: &
1846 !!$ ParentLandSetupNICAM, &
1847 !!$ ParentOceanSetupNICAM
1848  use mod_realinput_grads, only: &
1851  implicit none
1852 
1853  integer, intent(out) :: ldims(3) ! dims for land
1854  integer, intent(out) :: odims(2) ! dims for ocean
1855  integer, intent(out) :: lmdlid ! model id for land
1856  integer, intent(out) :: omdlid ! model id for ocean
1857  integer, intent(out) :: timelen ! number of time steps in ocean file
1858  character(len=*), intent(in) :: basename_land
1859  character(len=*), intent(in) :: basename_ocean
1860  character(len=*), intent(in) :: filetype_land
1861  character(len=*), intent(in) :: filetype_ocean
1862  logical, intent(in) :: use_file_landwater ! use land water data from files
1863  character(len=*), intent(in) :: intrp_land_temp
1864  character(len=*), intent(in) :: intrp_land_water
1865  character(len=*), intent(in) :: intrp_land_sfc_temp
1866  character(len=*), intent(in) :: intrp_ocean_temp
1867  character(len=*), intent(in) :: intrp_ocean_sfc_temp
1868  !---------------------------------------------------------------------------
1869 
1870  log_newline
1871  log_info("ParentSurfaceSetup",*) 'Setup'
1872 
1873  ! Land
1874 
1875  if( lkmax < 4 )then
1876  log_error("ParentSurfaceSetup",*) 'LKMAX less than 4: ', lkmax
1877  log_error_cont(*) 'in Real Case, LKMAX should be set more than 4'
1878  call prc_abort
1879  endif
1880 
1881  if( serial_land ) then
1882  if( prc_ismaster ) then
1883  do_read_land = .true.
1884  else
1885  do_read_land = .false.
1886  endif
1887  else
1888  do_read_land = .true.
1889  endif
1890 
1891  select case(trim(filetype_land))
1892  case('SCALE-RM')
1893 
1894  lmdlid = iscale
1895  serial_land = .false.
1896  do_read_land = .true.
1897  call parentlandsetupscale( ldims ) ! (out)
1898  use_waterratio = .false.
1899 
1900  case('WRF-ARW')
1901 
1902  lmdlid = iwrfarw
1903  if ( do_read_land ) call parentlandsetupwrfarw( ldims, & ! (out)
1904  basename_land ) ! (in)
1905  use_waterratio = .false.
1906 
1907 !!$ case('NICAM-NETCDF')
1908 !!$
1909 !!$ lmdlid = iNICAM
1910 !!$ if ( do_read_land ) call ParentLandSetupNICAM( ldims, & ! (out)
1911 !!$ basename_land ) ! (in)
1912 !!$ use_waterratio = .false.
1913 !!$
1914  case('GrADS')
1915 
1916  lmdlid = igrads
1917  if ( do_read_land ) call parentlandsetupgrads( ldims, & ! (out)
1918  use_waterratio, & ! (out)
1919  use_file_landwater, & ! (in)
1920  basename_land ) ! (in)
1921 
1922  case default
1923 
1924  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_land)
1925  call prc_abort
1926 
1927  endselect
1928 
1929  if( serial_land ) then
1930  call comm_bcast( ldims(:), 3 )
1931  call comm_bcast( use_waterratio )
1932  endif
1933 
1934 
1935  select case( intrp_land_temp )
1936  case( 'off' )
1937  i_intrp_land_temp = i_intrp_off
1938  case( 'mask' )
1939  i_intrp_land_temp = i_intrp_mask
1940  case( 'fill' )
1941  i_intrp_land_temp = i_intrp_fill
1942  case default
1943  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_TEMP is invalid. ', intrp_land_temp
1944  call prc_abort
1945  end select
1946  select case( intrp_land_sfc_temp )
1947  case( 'off' )
1948  i_intrp_land_sfc_temp = i_intrp_off
1949  case( 'mask' )
1950  i_intrp_land_sfc_temp = i_intrp_mask
1951  case( 'fill' )
1952  i_intrp_land_sfc_temp = i_intrp_fill
1953  case default
1954  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_SFC_TEMP is invalid. ', intrp_land_sfc_temp
1955  call prc_abort
1956  end select
1957  select case( intrp_land_water )
1958  case( 'off' )
1959  i_intrp_land_water = i_intrp_off
1960  case( 'mask' )
1961  i_intrp_land_water = i_intrp_mask
1962  case( 'fill' )
1963  i_intrp_land_water = i_intrp_fill
1964  case default
1965  log_error("ParentSurfaceSetup",*) 'INTRP_LAND_WATER is invalid. ', intrp_land_water
1966  call prc_abort
1967  end select
1968 
1969  select case( lmdlid )
1970 ! case( iSCALE, iWRFARW, iNICAM )
1971  case( iscale, iwrfarw )
1972  i_intrp_land_temp = i_intrp_mask
1973  i_intrp_land_sfc_temp = i_intrp_mask
1974  i_intrp_land_water = i_intrp_mask
1975  end select
1976 
1977 
1978  ! Ocean
1979 
1980  if( serial_ocean ) then
1981  if( prc_ismaster ) then
1982  do_read_ocean = .true.
1983  else
1984  do_read_ocean = .false.
1985  endif
1986  else
1987  do_read_ocean = .true.
1988  endif
1989 
1990  select case(trim(filetype_ocean))
1991  case('SCALE-RM')
1992 
1993  timelen = -1
1994  omdlid = iscale
1995  serial_ocean = .false.
1996  do_read_ocean = .true.
1997  call parentoceansetupscale( odims )
1998  update_coord = .false.
1999 
2000  case('WRF-ARW')
2001 
2002  omdlid = iwrfarw
2003  if ( do_read_ocean ) call parentoceansetupwrfarw( odims, timelen, & ! (out)
2004  basename_ocean ) ! (in)
2005  update_coord = .true.
2006 
2007 !!$ case('NICAM-NETCDF')
2008 !!$
2009 !!$ omdlid = iNICAM
2010 !!$ if ( do_read_ocean ) call ParentOceanSetupNICAM( odims, timelen, & ! (out)
2011 !!$ basename_ocean ) ! (in)
2012 !!$ update_coord = .false.
2013 !!$
2014  case('GrADS')
2015 
2016  omdlid = igrads
2017  if ( do_read_ocean ) call parentoceansetupgrads( odims, timelen, & ! (out)
2018  basename_ocean ) ! (out)
2019  update_coord = .false.
2020 
2021  case default
2022 
2023  log_error("ParentSurfaceSetup",*) 'Unsupported FILE TYPE:', trim(filetype_ocean)
2024  call prc_abort
2025 
2026  endselect
2027 
2028  if( serial_ocean ) then
2029  call comm_bcast( odims(:), 2 )
2030  call comm_bcast( timelen )
2031  endif
2032 
2033 
2034  select case( intrp_ocean_temp )
2035  case( 'off' )
2036  i_intrp_ocean_temp = i_intrp_off
2037  case( 'mask' )
2038  i_intrp_ocean_temp = i_intrp_mask
2039  case( 'fill' )
2040  i_intrp_ocean_temp = i_intrp_fill
2041  case default
2042  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_TEMP is invalid. ', intrp_ocean_temp
2043  call prc_abort
2044  end select
2045  select case( intrp_ocean_sfc_temp )
2046  case( 'off' )
2047  i_intrp_ocean_sfc_temp = i_intrp_off
2048  case( 'mask' )
2049  i_intrp_ocean_sfc_temp = i_intrp_mask
2050  case( 'fill' )
2051  i_intrp_ocean_sfc_temp = i_intrp_fill
2052  case default
2053  log_error("ParentSurfaceSetup",*) 'INTRP_OCEAN_SFC_TEMP is invalid. ', intrp_ocean_sfc_temp
2054  call prc_abort
2055  end select
2056 
2057  select case( omdlid )
2058 ! case( iSCALE, iWRFARW, iNICAM )
2059  case( iscale, iwrfarw )
2060  i_intrp_ocean_temp = i_intrp_mask
2061  i_intrp_ocean_sfc_temp = i_intrp_mask
2062  end select
2063 
2064 
2065  allocate( tw_org(odims(1),odims(2)) )
2066  allocate( sst_org(odims(1),odims(2)) )
2067  allocate( albw_org(odims(1),odims(2),n_rad_dir,n_rad_rgn) )
2068  allocate( olon_org(odims(1),odims(2)) )
2069  allocate( olat_org(odims(1),odims(2)) )
2070  allocate( omask_org(odims(1),odims(2)) )
2071 
2072  first = .true.
2073 
2074  return
2075  end subroutine parentsurfacesetup
2076 
2077  !-----------------------------------------------------------------------------
2079  subroutine parentsurfaceinput( &
2080  tg, strg, lst, albg, &
2081  tc_urb, qc_urb, uc_urb, ust, albu, &
2082  tw, sst, albw, z0w, &
2083  basename_land, basename_ocean, &
2084  mdlid_land, mdlid_ocean, &
2085  ldims, odims, &
2086  use_file_landwater, &
2087  init_landwater_ratio, &
2088  init_ocean_alb_lw, &
2089  init_ocean_alb_sw, &
2090  init_ocean_z0w, &
2091  intrp_iter_max, &
2092  soilwater_ds2vc_flag, &
2093  elevation_collection_land, &
2094  elevation_collection_ocean, &
2095  boundary_flag, &
2096  timelen, skiplen, &
2097  URBAN_do )
2098  use scale_comm_cartesc, only: &
2099  comm_bcast, &
2100  comm_vars8, &
2101  comm_wait
2102  use scale_const, only: &
2103  eps => const_eps, &
2104  undef => const_undef, &
2105  laps => const_laps
2106  use scale_topography, only: &
2107  topo_zsfc
2108  use scale_interp, only: &
2109  interp_factor2d, &
2111  use scale_filter, only: &
2112  filter_hyperdiff
2113  use scale_land_grid_cartesc, only: &
2114  lcz => land_grid_cartesc_cz
2115  use scale_atmos_thermodyn, only: &
2116  thermodyn_specific_heat => atmos_thermodyn_specific_heat, &
2117  thermodyn_rhot2temp_pres => atmos_thermodyn_rhot2temp_pres
2118  use scale_atmos_hydrometeor, only: &
2119  i_qv
2120  use scale_landuse, only: &
2121  lsmask_nest => landuse_frac_land
2122  use mod_realinput_scale, only: &
2126  use mod_realinput_wrfarw, only: &
2130 !!$ use mod_realinput_nicam, only: &
2131 !!$ ParentOceanOpenNICAM, &
2132 !!$ ParentOceanInputNICAM, &
2133 !!$ ParentLandInputNICAM
2134  use mod_realinput_grads, only: &
2138  use mod_atmos_vars, only: &
2139  dens, &
2140  momz, &
2141  momx, &
2142  momy, &
2143  rhot, &
2144  qtrc
2145  implicit none
2146 
2147  real(RP), intent(out) :: tg (:,:,:,:)
2148  real(RP), intent(out) :: strg(:,:,:,:)
2149  real(RP), intent(out) :: lst (:,:,:)
2150  real(RP), intent(out) :: albg(:,:,:,:,:)
2151  real(RP), intent(inout) :: tc_urb(ia,ja)
2152  real(RP), intent(inout) :: qc_urb(ia,ja)
2153  real(RP), intent(inout) :: uc_urb(ia,ja)
2154  real(RP), intent(inout) :: ust (ia,ja)
2155  real(RP), intent(inout) :: albu (ia,ja,n_rad_dir,n_rad_rgn)
2156  real(RP), intent(out) :: tw (:,:,:)
2157  real(RP), intent(out) :: sst (:,:,:)
2158  real(RP), intent(out) :: albw(:,:,:,:,:)
2159  real(RP), intent(out) :: z0w (:,:,:)
2160  character(len=*), intent(in) :: basename_land
2161  character(len=*), intent(in) :: basename_ocean
2162  integer, intent(in) :: mdlid_land
2163  integer, intent(in) :: mdlid_ocean
2164  integer, intent(in) :: ldims(3)
2165  integer, intent(in) :: odims(2)
2166  logical, intent(in) :: use_file_landwater ! use land water data from files
2167  real(RP), intent(in) :: init_landwater_ratio ! Ratio of land water to storage is constant,
2168  ! if use_file_landwater is ".false."
2169  real(RP), intent(in) :: init_ocean_alb_lw
2170  real(RP), intent(in) :: init_ocean_alb_sw
2171  real(RP), intent(in) :: init_ocean_z0w
2172  integer, intent(in) :: intrp_iter_max
2173  logical, intent(in) :: soilwater_ds2vc_flag
2174  logical, intent(in) :: elevation_collection_land
2175  logical, intent(in) :: elevation_collection_ocean
2176  logical, intent(in) :: boundary_flag ! switch for making boundary file
2177  integer, intent(in) :: timelen ! time steps in one file
2178  integer, intent(in) :: skiplen ! skip steps
2179  logical, intent(in) :: URBAN_do
2180 
2181  ! land
2182  real(RP) :: tg_org (ldims(1),ldims(2),ldims(3))
2183  real(RP) :: strg_org (ldims(1),ldims(2),ldims(3))
2184  real(RP) :: smds_org (ldims(1),ldims(2),ldims(3))
2185 ! real(RP) :: skint_org( ldims(2),ldims(3))
2186  real(RP) :: lst_org ( ldims(2),ldims(3))
2187  real(RP) :: ust_org ( ldims(2),ldims(3))
2188  real(RP) :: albg_org ( ldims(2),ldims(3),n_rad_dir,n_rad_rgn)
2189  real(RP) :: topo_org ( ldims(2),ldims(3))
2190  real(RP) :: lmask_org( ldims(2),ldims(3))
2191  real(RP) :: lz_org (ldims(1) )
2192  real(RP) :: llon_org ( ldims(2),ldims(3))
2193  real(RP) :: llat_org ( ldims(2),ldims(3))
2194 
2195  ! ocean
2196  real(RP) :: z0w_org ( odims(1),odims(2))
2197  real(RP) :: omask ( odims(1),odims(2))
2198  real(RP) :: lst_ocean( odims(1),odims(2))
2199 
2200  logical :: ol_interp
2201 
2202  real(RP) :: hfact_o(odims(1),odims(2),itp_nh)
2203  integer :: igrd_o (odims(1),odims(2),itp_nh)
2204  integer :: jgrd_o (odims(1),odims(2),itp_nh)
2205 
2206  real(RP) :: Qdry, Rtot, CVtot, CPtot
2207  real(RP) :: temp, pres
2208 
2209  ! elevation collection
2210  real(RP) :: work(ldims(2),ldims(3))
2211  real(RP) :: tdiff
2212 
2213  real(RP) :: one(ia,ja)
2214 
2215  integer :: i, j
2216  integer :: n, nn
2217  !---------------------------------------------------------------------------
2218 
2219  first = .true.
2220 
2221  if ( first ) then ! read data only once
2222 
2223  ! urban data
2224 
2225  if ( urban_do ) then
2226  do j = 1, ja
2227  do i = 1, ia
2228  call thermodyn_specific_heat( qa, &
2229  qtrc(ks,i,j,:), &
2230  tracer_mass(:), tracer_r(:), tracer_cv(:), tracer_cp(:), & ! [IN]
2231  qdry, rtot, cvtot, cptot ) ! [OUT]
2232  call thermodyn_rhot2temp_pres( dens(ks,i,j), rhot(ks,i,j), rtot, cvtot, cptot, &
2233  temp, pres )
2234 
2235  tc_urb(i,j) = temp
2236 #ifdef DRY
2237  qc_urb(i,j) = 0.0_rp
2238 #else
2239  qc_urb(i,j) = qtrc(ks,i,j,i_qv)
2240 #endif
2241  enddo
2242  enddo
2243 
2244  do j = 1, ja-1
2245  do i = 1, ia-1
2246  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 &
2247  + ( momy(ks,i,j) / (dens(ks, i,j+1)+dens(ks,i,j)) * 2.0_rp )**2.0_rp ), &
2248  0.01_rp)
2249  enddo
2250  enddo
2251  do j = 1, ja-1
2252  uc_urb(ia,j) = max(sqrt( ( momx(ks,ia,j) / dens(ks,ia,j ) )**2.0_rp &
2253  + ( momy(ks,ia,j) / (dens(ks,ia,j+1)+dens(ks,ia,j)) * 2.0_rp )**2.0_rp ), &
2254  0.01_rp)
2255  enddo
2256  do i = 1, ia-1
2257  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 &
2258  + ( momy(ks,i,ja) / dens(ks,i ,ja) )**2.0_rp ), 0.01_rp)
2259  enddo
2260  uc_urb(ia,ja) = max(sqrt( ( momx(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp &
2261  + ( momy(ks,ia,ja) / dens(ks,ia,ja) )**2.0_rp ), 0.01_rp)
2262 
2263  call comm_vars8( uc_urb, 1 )
2264  call comm_wait ( uc_urb, 1, .false. )
2265 
2266  end if
2267 
2268  end if ! first
2269 
2270 
2271  if ( do_read_ocean ) then
2272 
2273  select case( mdlid_ocean )
2274  case( iscale ) ! TYPE: SCALE-RM
2275 
2276  call parentoceanopenscale( olon_org, olat_org, & ! (out)
2277  omask_org, & ! (out)
2278  basename_ocean, & ! (in)
2279  odims ) ! (in)
2280 
2281  case( iwrfarw ) ! TYPE: WRF-ARW
2282 
2284 
2285 !!$ case( iNICAM ) ! TYPE: NICAM-NETCDF
2286 !!$
2287 !!$ call ParentOceanOpenNICAM( olon_org, olat_org, & ! (out)
2288 !!$ omask_org, & ! (out)
2289 !!$ basename_ocean, & ! (in)
2290 !!$ odims ) ! (in)
2291 !!$
2292  case( igrads ) ! TYPE: GrADS format
2293 
2295 
2296  end select
2297 
2298  end if
2299 
2300 
2301  do n = skiplen+1, timelen
2302  nn = n - skiplen
2303 
2304  call prof_rapstart('___SurfaceInput',3)
2305 
2306  if ( do_read_land ) then
2307 
2308  select case( mdlid_land )
2309  case( iscale ) ! TYPE: SCALE-RM
2310 
2311  call parentlandinputscale( &
2312  tg_org, strg_org, & ! (out)
2313  lst_org, ust_org, albg_org, & ! (out)
2314  topo_org, lmask_org, & ! (out)
2315  llon_org, llat_org, lz_org, & ! (out)
2316  basename_land, ldims, & ! (in)
2317  use_file_landwater, n ) ! (in)
2318 
2319  case( iwrfarw ) ! TYPE: WRF-ARW
2320 
2321  call parentlandinputwrfarw( &
2322  tg_org, strg_org, & ! (out)
2323  lst_org, ust_org, albg_org, & ! (out)
2324  topo_org, lmask_org, & ! (out)
2325  llon_org, llat_org, lz_org, & ! (out)
2326  basename_land, ldims, & ! (in)
2327  use_file_landwater, n ) ! (in)
2328 
2329 !!$ case( iNICAM ) ! TYPE: NICAM-NETCDF
2330 !!$
2331 !!$ call ParentLandInputNICAM( &
2332 !!$ tg_org, strg_org, & ! (out)
2333 !!$ lst_org, & ! (out)
2334 !!$ llon_org, llat_org, lz_org, & ! (out)
2335 !!$ topo_org, lmask_org, & ! (out)
2336 !!$ basename_land, ldims, & ! (in)
2337 !!$ use_file_landwater, n ) ! (in)
2338 !!$ ust_org = UNDEF
2339 !!$ albg_org = UNDEF
2340 !!$
2341  case( igrads ) ! TYPE: GrADS format
2342 
2343  call parentlandinputgrads( &
2344  tg_org, strg_org, smds_org, & ! (out)
2345  lst_org, & ! (out)
2346  llon_org, llat_org, lz_org, & ! (out)
2347  topo_org, lmask_org, & ! (out)
2348  basename_land, ldims, & ! (in)
2349  use_file_landwater, n ) ! (in)
2350  ust_org = undef
2351  albg_org = undef
2352 
2353  end select
2354 
2355  end if
2356 
2357  call prof_rapend ('___SurfaceInput',3)
2358 
2359  call prof_rapstart('___SurfaceBcast',3)
2360 
2361  if ( serial_land ) then
2362  call comm_bcast( tg_org, ldims(1), ldims(2), ldims(3) )
2363  if ( use_waterratio ) then
2364  call comm_bcast( smds_org, ldims(1), ldims(2), ldims(3) )
2365  else
2366  call comm_bcast( strg_org, ldims(1), ldims(2), ldims(3) )
2367  end if
2368  call comm_bcast( lst_org, ldims(2), ldims(3) )
2369  if ( urban_do ) call comm_bcast( ust_org, ldims(2), ldims(3) )
2370  call comm_bcast( albg_org(:,:,i_r_direct ,i_r_ir ), ldims(2), ldims(3) )
2371  call comm_bcast( albg_org(:,:,i_r_diffuse,i_r_ir ), ldims(2), ldims(3) )
2372  call comm_bcast( albg_org(:,:,i_r_direct ,i_r_nir), ldims(2), ldims(3) )
2373  call comm_bcast( albg_org(:,:,i_r_diffuse,i_r_nir), ldims(2), ldims(3) )
2374  call comm_bcast( albg_org(:,:,i_r_direct ,i_r_vis), ldims(2), ldims(3) )
2375  call comm_bcast( albg_org(:,:,i_r_diffuse,i_r_vis), ldims(2), ldims(3) )
2376  call comm_bcast( topo_org, ldims(2), ldims(3) )
2377  call comm_bcast( lmask_org, ldims(2), ldims(3) )
2378  call comm_bcast( llon_org, ldims(2), ldims(3) )
2379  call comm_bcast( llat_org, ldims(2), ldims(3) )
2380  call comm_bcast( lz_org, ldims(1) )
2381  end if
2382 
2383  call prof_rapend ('___SurfaceBcast',3)
2384 
2385  call prof_rapstart('___SurfaceInput',3)
2386 
2387  if ( do_read_ocean ) then
2388 
2389  select case( mdlid_ocean )
2390  case( iscale ) ! TYPE: SCALE-RM
2391 
2392  call parentoceaninputscale( &
2393  tw_org, sst_org, & ! (out)
2394  albw_org, z0w_org, & ! (out)
2395  omask_org, & ! (out)
2396  basename_ocean, odims, & ! (in)
2397  n ) ! (in)
2398 
2399  case( iwrfarw ) ! TYPE: WRF-ARW
2400 
2401  call parentoceaninputwrfarw( &
2402  tw_org, sst_org, & ! (out)
2403  albw_org, z0w_org, & ! (out)
2404  omask_org, & ! (out)
2405  olon_org, olat_org, & ! (out)
2406  basename_ocean, odims, & ! (in)
2407  n ) ! (in)
2408 
2409 !!$ case( iNICAM ) ! TYPE: NICAM-NETCDF
2410 !!$
2411 !!$ call ParentOceanInputNICAM( &
2412 !!$ tw_org, sst_org, & ! (out)
2413 !!$ basename_ocean, odims, & ! (in)
2414 !!$ omask_org, & ! (in)
2415 !!$ n ) ! (in)
2416 !!$ albw_org = UNDEF
2417 !!$ z0w_org = UNDEF
2418 !!$
2419  case( igrads ) ! TYPE: GrADS format
2420 
2421  call parentoceaninputgrads( &
2422  tw_org, sst_org, & ! (out)
2423  omask_org, & ! (out)
2424  olon_org, olat_org, & ! (out)
2425  basename_ocean, odims, & ! (in)
2426  n ) ! (in)
2427  albw_org = undef
2428  z0w_org = undef
2429 
2430  end select
2431 
2432  end if
2433 
2434  call prof_rapend ('___SurfaceInput',3)
2435 
2436  call prof_rapstart('___SurfaceBcast',3)
2437 
2438  if ( serial_ocean ) then
2439  call comm_bcast( tw_org, odims(1), odims(2) )
2440  call comm_bcast( sst_org, odims(1), odims(2) )
2441  call comm_bcast( albw_org(:,:,i_r_direct ,i_r_ir ), odims(1), odims(2) )
2442  call comm_bcast( albw_org(:,:,i_r_diffuse,i_r_ir ), odims(1), odims(2) )
2443  call comm_bcast( albw_org(:,:,i_r_direct ,i_r_nir), odims(1), odims(2) )
2444  call comm_bcast( albw_org(:,:,i_r_diffuse,i_r_nir), odims(1), odims(2) )
2445  call comm_bcast( albw_org(:,:,i_r_direct ,i_r_vis), odims(1), odims(2) )
2446  call comm_bcast( albw_org(:,:,i_r_diffuse,i_r_vis), odims(1), odims(2) )
2447  call comm_bcast( z0w_org, odims(1), odims(2) )
2448  call comm_bcast( omask_org, odims(1), odims(2) )
2449  if ( first .or. update_coord ) then
2450  call comm_bcast( olon_org, odims(1), odims(2) )
2451  call comm_bcast( olat_org, odims(1), odims(2) )
2452  end if
2453  end if
2454 
2455  call prof_rapend ('___SurfaceBcast',3)
2456 
2457  call prof_rapstart('___SurfaceInterp',3)
2458 
2459  if ( first .or. update_coord ) then
2460 
2461  if ( ldims(2) .ne. odims(1) &
2462  .or. ldims(3) .ne. odims(2) ) then
2463  ol_interp = .true.
2464  else
2465  ol_interp = .false.
2466  do j = 1, ldims(3)
2467  do i = 1, ldims(2)
2468  if ( llon_org(i,j) .ne. olon_org(i,j) &
2469  .or. llat_org(i,j) .ne. olat_org(i,j) ) then
2470  ol_interp = .true.
2471  exit
2472  end if
2473  end do
2474  end do
2475  end if
2476 
2477  if ( ol_interp ) then
2478  ! interpolation factor between outer ocean grid and land grid
2479  call interp_factor2d( itp_nh, & ! [IN]
2480  ldims(2), ldims(3), & ! [IN]
2481  llon_org(:,:), & ! [IN]
2482  llat_org(:,:), & ! [IN]
2483  odims(1), odims(2), & ! [IN]
2484  olon_org(:,:), & ! [IN]
2485  olat_org(:,:), & ! [IN]
2486  igrd_o(:,:,:), & ! [OUT]
2487  jgrd_o(:,:,:), & ! [OUT]
2488  hfact_o(:,:,:) ) ! [OUT]
2489  end if
2490  end if
2491 
2492  ! Ocean temp: interpolate over the land
2493  if ( i_intrp_ocean_temp .ne. i_intrp_off ) then
2494  select case( i_intrp_ocean_temp )
2495  case( i_intrp_mask )
2496  omask = omask_org
2497  case( i_intrp_fill )
2498  call make_mask( omask, tw_org, odims(1), odims(2), landdata=.false.)
2499  end select
2500  call interp_oceanland_data(tw_org, omask, odims(1), odims(2), .false., intrp_iter_max)
2501  end if
2502 
2503  ! SST: interpolate over the land
2504  if ( i_intrp_ocean_sfc_temp .ne. i_intrp_off ) then
2505  select case( i_intrp_ocean_sfc_temp )
2506  case( i_intrp_mask )
2507  omask = omask_org
2508  case( i_intrp_fill )
2509  call make_mask( omask, sst_org, odims(1), odims(2), landdata=.false.)
2510  end select
2511  call interp_oceanland_data(sst_org, omask, odims(1), odims(2), .false., intrp_iter_max)
2512  end if
2513 
2514  call land_interporation( &
2515  tg(:,:,:,nn), strg(:,:,:,nn), & ! (out)
2516  lst(:,:,nn), albg(:,:,:,:,nn), & ! (out)
2517  ust, albu, & ! (out)
2518  tg_org, strg_org, smds_org, & ! (inout)
2519  lst_org, albg_org, & ! (inout)
2520  ust_org, & ! (inout)
2521  sst_org, & ! (in)
2522  lmask_org, & ! (in)
2523  lsmask_nest, & ! (in)
2524  topo_org, & ! (in)
2525  lz_org, llon_org, llat_org, & ! (in)
2526  lcz, lon, lat, & ! (in)
2527  ldims, odims, & ! (in)
2528  maskval_tg, maskval_strg, & ! (in)
2529  init_landwater_ratio, & ! (in)
2530  use_file_landwater, & ! (in)
2531  use_waterratio, & ! (in)
2532  soilwater_ds2vc_flag, & ! (in)
2533  elevation_collection_land, & ! (in)
2534  intrp_iter_max, & ! (in)
2535  ol_interp, & ! (in)
2536  urban_do ) ! (in)
2537 
2538  do j = 1, ldims(3)
2539  do i = 1, ldims(2)
2540  if ( topo_org(i,j) > undef + eps ) then ! ignore UNDEF value
2541  work(i,j) = lst_org(i,j) + topo_org(i,j) * laps
2542  end if
2543  end do
2544  end do
2545 
2546  if ( ol_interp ) then
2547  ! land surface temperature at ocean grid
2548  call interp_interp2d( itp_nh, & ! [IN]
2549  ldims(2), ldims(3), & ! [IN]
2550  odims(1), odims(2), & ! [IN]
2551  igrd_o(:,:,:), & ! [IN]
2552  jgrd_o(:,:,:), & ! [IN]
2553  hfact_o(:,:,:), & ! [IN]
2554  work(:,:), & ! [IN]
2555  lst_ocean(:,:) ) ! [OUT]
2556  else
2557  lst_ocean(:,:) = work(:,:)
2558  end if
2559 
2560  call replace_misval_map( sst_org, lst_ocean, odims(1), odims(2), "SST" )
2561  call replace_misval_map( tw_org, lst_ocean, odims(1), odims(2), "OCEAN_TEMP" )
2562 
2563  do j = 1, odims(2)
2564  do i = 1, odims(1)
2565  if ( albw_org(i,j,i_r_direct ,i_r_ir ) == undef ) albw_org(i,j,i_r_direct ,i_r_ir ) = init_ocean_alb_lw
2566  if ( albw_org(i,j,i_r_diffuse,i_r_ir ) == undef ) albw_org(i,j,i_r_diffuse,i_r_ir ) = init_ocean_alb_lw
2567  if ( albw_org(i,j,i_r_direct ,i_r_nir) == undef ) albw_org(i,j,i_r_direct ,i_r_nir) = init_ocean_alb_sw
2568  if ( albw_org(i,j,i_r_diffuse,i_r_nir) == undef ) albw_org(i,j,i_r_diffuse,i_r_nir) = init_ocean_alb_sw
2569  if ( albw_org(i,j,i_r_direct ,i_r_vis) == undef ) albw_org(i,j,i_r_direct ,i_r_vis) = init_ocean_alb_sw
2570  if ( albw_org(i,j,i_r_diffuse,i_r_vis) == undef ) albw_org(i,j,i_r_diffuse,i_r_vis) = init_ocean_alb_sw
2571  if ( z0w_org(i,j) == undef ) z0w_org(i,j) = init_ocean_z0w
2572  end do
2573  end do
2574 
2575 
2576  if ( first .or. update_coord ) then
2577  ! interporation for ocean variables
2578  call interp_factor2d( itp_nh, & ! [IN]
2579  odims(1), odims(2), & ! [IN]
2580  olon_org(:,:), & ! [IN]
2581  olat_org(:,:), & ! [IN]
2582  ia, ja, & ! [IN]
2583  lon(:,:), & ! [IN]
2584  lat(:,:), & ! [IN]
2585  igrd(:,:,:), & ! [OUT]
2586  jgrd(:,:,:), & ! [OUT]
2587  hfact(:,:,:) ) ! [OUT]
2588  end if
2589 
2590  call interp_interp2d( itp_nh, & ! [IN]
2591  odims(1), odims(2), & ! [IN]
2592  ia, ja, & ! [IN]
2593  igrd(:,:,:), & ! [IN]
2594  jgrd(:,:,:), & ! [IN]
2595  hfact(:,:,:), & ! [IN]
2596  tw_org(:,:), & ! [IN]
2597  tw(:,:,nn) ) ! [OUT]
2598  if ( filter_niter > 0 ) then
2599  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2600  tw(:,:,nn), filter_order, filter_niter )
2601  call comm_vars8( tw(:,:,nn), 1 )
2602  call comm_wait ( tw(:,:,nn), 1 )
2603  end if
2604 
2605  call interp_interp2d( itp_nh, & ! [IN]
2606  odims(1), odims(2), & ! [IN]
2607  ia, ja, & ! [IN]
2608  igrd(:,:,:), & ! [IN]
2609  jgrd(:,:,:), & ! [IN]
2610  hfact(:,:,:), & ! [IN]
2611  sst_org(:,:), & ! [IN]
2612  sst(:,:,nn) ) ! [OUT]
2613  if ( filter_niter > 0 ) then
2614  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2615  sst(:,:,nn), filter_order, filter_niter )
2616  call comm_vars8( sst(:,:,nn), 1 )
2617  call comm_wait ( sst(:,:,nn), 1 )
2618  end if
2619 
2620  ! elevation collection
2621  if ( elevation_collection_ocean ) then
2622 
2623  do j = 1, ja
2624  do i = 1, ia
2625  tdiff = topo_zsfc(i,j) * laps
2626  sst(i,j,nn) = sst(i,j,nn) - tdiff
2627  tw(i,j,nn) = tw(i,j,nn) - tdiff
2628  end do
2629  end do
2630 
2631  end if
2632 
2633  call interp_interp2d( itp_nh, & ! [IN]
2634  odims(1), odims(2), & ! [IN]
2635  ia, ja, & ! [IN]
2636  igrd(:,:,:), & ! [IN]
2637  jgrd(:,:,:), & ! [IN]
2638  hfact(:,:,:), & ! [IN]
2639  albw_org(:,:,i_r_direct ,i_r_ir ), & ! [IN]
2640  albw(:,:,i_r_direct ,i_r_ir ,nn) ) ! [OUT]
2641  if ( filter_niter > 0 ) then
2642  one(:,:) = 1.0_rp
2643  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2644  albw(:,:,i_r_direct,i_r_ir,nn), filter_order, filter_niter, &
2645  limiter_sign = one(:,:) )
2646  call comm_vars8( albw(:,:,i_r_direct,i_r_ir,nn), 1 )
2647  call comm_wait ( albw(:,:,i_r_direct,i_r_ir,nn), 1 )
2648  end if
2649 
2650  call interp_interp2d( itp_nh, & ! [IN]
2651  odims(1), odims(2), & ! [IN]
2652  ia, ja, & ! [IN]
2653  igrd(:,:,:), & ! [IN]
2654  jgrd(:,:,:), & ! [IN]
2655  hfact(:,:,:), & ! [IN]
2656  albw_org(:,:,i_r_diffuse,i_r_ir ), & ! [IN]
2657  albw(:,:,i_r_diffuse,i_r_ir ,nn) ) ! [OUT]
2658  if ( filter_niter > 0 ) then
2659  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2660  albw(:,:,i_r_diffuse,i_r_ir,nn), filter_order, filter_niter, &
2661  limiter_sign = one(:,:) )
2662  call comm_vars8( albw(:,:,i_r_diffuse,i_r_ir,nn), 1 )
2663  call comm_wait ( albw(:,:,i_r_diffuse,i_r_ir,nn), 1 )
2664  end if
2665 
2666  call interp_interp2d( itp_nh, & ! [IN]
2667  odims(1), odims(2), & ! [IN]
2668  ia, ja, & ! [IN]
2669  igrd(:,:,:), & ! [IN]
2670  jgrd(:,:,:), & ! [IN]
2671  hfact(:,:,:), & ! [IN]
2672  albw_org(:,:,i_r_direct ,i_r_nir), & ! [IN]
2673  albw(:,:,i_r_direct ,i_r_nir,nn) ) ! [OUT]
2674  if ( filter_niter > 0 ) then
2675  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2676  albw(:,:,i_r_direct,i_r_nir,nn), filter_order, filter_niter, &
2677  limiter_sign = one(:,:) )
2678  call comm_vars8( albw(:,:,i_r_direct,i_r_nir,nn), 1 )
2679  call comm_wait ( albw(:,:,i_r_direct,i_r_nir,nn), 1 )
2680  end if
2681 
2682  call interp_interp2d( itp_nh, & ! [IN]
2683  odims(1), odims(2), & ! [IN]
2684  ia, ja, & ! [IN]
2685  igrd(:,:,:), & ! [IN]
2686  jgrd(:,:,:), & ! [IN]
2687  hfact(:,:,:), & ! [IN]
2688  albw_org(:,:,i_r_diffuse,i_r_nir), & ! [IN]
2689  albw(:,:,i_r_diffuse,i_r_nir,nn) ) ! [OUT]
2690  if ( filter_niter > 0 ) then
2691  call filter_hyperdiff( ia, js, ie, ja, js, je, &
2692  albw(:,:,i_r_diffuse,i_r_nir,nn), filter_order, filter_niter, &
2693  limiter_sign = one(:,:) )
2694  call comm_vars8( albw(:,:,i_r_diffuse,i_r_nir,nn), 1 )
2695  call comm_wait ( albw(:,:,i_r_diffuse,i_r_nir,nn), 1 )
2696  end if
2697 
2698  call interp_interp2d( itp_nh, & ! [IN]
2699  odims(1), odims(2), & ! [IN]
2700  ia, ja, & ! [IN]
2701  igrd(:,:,:), & ! [IN]
2702  jgrd(:,:,:), & ! [IN]
2703  hfact(:,:,:), & ! [IN]
2704  albw_org(:,:,i_r_direct ,i_r_vis), & ! [IN]
2705  albw(:,:,i_r_direct ,i_r_vis,nn) ) ! [OUT]
2706  if ( filter_niter > 0 ) then
2707  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2708  albw(:,:,i_r_direct,i_r_vis,nn), filter_order, filter_niter, &
2709  limiter_sign = one(:,:) )
2710  call comm_vars8( albw(:,:,i_r_direct,i_r_vis,nn), 1 )
2711  call comm_wait ( albw(:,:,i_r_direct,i_r_vis,nn), 1 )
2712  end if
2713 
2714  call interp_interp2d( itp_nh, & ! [IN]
2715  odims(1), odims(2), & ! [IN]
2716  ia, ja, & ! [IN]
2717  igrd(:,:,:), & ! [IN]
2718  jgrd(:,:,:), & ! [IN]
2719  hfact(:,:,:), & ! [IN]
2720  albw_org(:,:,i_r_diffuse,i_r_vis), & ! [IN]
2721  albw(:,:,i_r_diffuse,i_r_vis,nn) ) ! [OUT]
2722  if ( filter_niter > 0 ) then
2723  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2724  albw(:,:,i_r_diffuse,i_r_vis,nn), filter_order, filter_niter, &
2725  limiter_sign = one(:,:) )
2726  call comm_vars8( albw(:,:,i_r_diffuse,i_r_vis,nn), 1 )
2727  call comm_wait ( albw(:,:,i_r_diffuse,i_r_vis,nn), 1 )
2728  end if
2729 
2730  call interp_interp2d( itp_nh, & ! [IN]
2731  odims(1), odims(2), & ! [IN]
2732  ia, ja, & ! [IN]
2733  igrd(:,:,:), & ! [IN]
2734  jgrd(:,:,:), & ! [IN]
2735  hfact(:,:,:), & ! [IN]
2736  z0w_org(:,:), & ! [IN]
2737  z0w(:,:,nn) ) ! [OUT]
2738  if ( filter_niter > 0 ) then
2739  call filter_hyperdiff( ia, is, ie, ja, js, je, &
2740  z0w(:,:,nn), filter_order, filter_niter, &
2741  limiter_sign = one(:,:) )
2742  call comm_vars8( z0w(:,:,nn), 1 )
2743  call comm_wait ( z0w(:,:,nn), 1 )
2744  end if
2745 
2746  ! replace values over the ocean ####
2747  do j = 1, ja
2748  do i = 1, ia
2749  if( abs(lsmask_nest(i,j)-0.0_rp) < eps ) then ! ocean grid
2750  lst(i,j,nn) = sst(i,j,nn)
2751  endif
2752  enddo
2753  enddo
2754  if ( urban_do .and. first ) then
2755  do j = 1, ja
2756  do i = 1, ia
2757  if( abs(lsmask_nest(i,j)-0.0_rp) < eps ) then ! ocean grid
2758  ust(i,j) = sst(i,j,nn)
2759  endif
2760  enddo
2761  enddo
2762  end if
2763 
2764  first = .false.
2765 
2766  call prof_rapend ('___SurfaceInterp',3)
2767 
2768  ! required one-step data only
2769  if( .NOT. boundary_flag ) exit
2770 
2771  end do ! time loop
2772 
2773  return
2774  end subroutine parentsurfaceinput
2775 
2777  subroutine parentsurfaceboundary( &
2778  tg, &
2779  strg, &
2780  lst, &
2781  tw, &
2782  sst, &
2783  z0, &
2784  numsteps, &
2785  update_dt, &
2786  basename, &
2787  title )
2788  use scale_const, only: &
2789  i_sw => const_i_sw, &
2790  i_lw => const_i_lw
2791  use scale_file_cartesc, only: &
2795  file_cartesc_write_var
2796  use scale_time, only: &
2797  time_nowdate
2798  implicit none
2799 
2800  real(RP), intent(in) :: tg(:,:,:,:)
2801  real(RP), intent(in) :: strg(:,:,:,:)
2802  real(RP), intent(in) :: lst(:,:,:)
2803  real(RP), intent(in) :: tw(:,:,:,:)
2804  real(RP), intent(in) :: sst(:,:,:)
2805  real(RP), intent(in) :: z0(:,:,:)
2806  real(DP), intent(in) :: update_dt
2807  character(len=*), intent(in) :: basename
2808  character(len=*), intent(in) :: title
2809  integer, intent(in) :: numsteps ! total time steps
2810 
2811  character(len=H_SHORT) :: boundary_out_dtype = 'DEFAULT'
2812  integer :: nowdate(6)
2813  integer :: fid, vid(10)
2814  integer :: ts, te
2815  !---------------------------------------------------------------------------
2816 
2817  call prof_rapstart('___SurfaceOutput',3)
2818 
2819  ts = 1
2820  te = numsteps
2821 
2822  nowdate = time_nowdate
2823  nowdate(1) = nowdate(1)
2824 
2825  call file_cartesc_create( basename, title, boundary_out_dtype, fid, date=nowdate )
2826 
2827  call file_cartesc_def_var( fid, & ! [IN]
2828  'LAND_TEMP', 'Reference Land Temperature', 'K', & ! [IN]
2829  'LXYT', boundary_out_dtype, & ! [IN]
2830  vid(1), & ! [OUT]
2831  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2832  call file_cartesc_def_var( fid, & ! [IN]
2833  'LAND_WATER', 'Reference Land Moisture', 'm3/m3', & ! [IN]
2834  'LXYT', boundary_out_dtype, & ! [IN]
2835  vid(2), & ! [OUT]
2836  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2837  call file_cartesc_def_var( fid, & ! [IN]
2838  'LAND_SFC_TEMP', 'Reference Land Surface Temperature', 'K', & ! [IN]
2839  'XYT', boundary_out_dtype, & ! [IN]
2840  vid(3), & ! [OUT]
2841  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2842  call file_cartesc_def_var( fid, & ! [IN]
2843  'OCEAN_TEMP', 'Reference Ocean Temperature', 'K', & ! [IN]
2844  'OXYT', boundary_out_dtype, & ! [IN]
2845  vid(6), & ! [OUT]
2846  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2847  call file_cartesc_def_var( fid, & ! [IN]
2848  'OCEAN_SFC_TEMP', 'Reference Ocean Surface Temperature', 'K', & ! [IN]
2849  'XYT', boundary_out_dtype, & ! [IN]
2850  vid(7), & ! [OUT]
2851  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2852  call file_cartesc_def_var( fid, & ! [IN]
2853  'OCEAN_SFC_Z0', 'Reference Ocean Surface Z0', 'm', & ! [IN]
2854  'XYT', boundary_out_dtype, & ! [IN]
2855  vid(10), & ! [OUT]
2856  timeintv=update_dt, nsteps=numsteps ) ! [IN]
2857 
2858  call file_cartesc_enddef( fid )
2859 
2860  call file_cartesc_write_var( fid, vid(1), tg(:,:,:,ts:te), 'LAND_TEMP', 'LXYT', update_dt )
2861  call file_cartesc_write_var( fid, vid(2), strg(:,:,:,ts:te), 'LAND_WATER', 'LXYT', update_dt )
2862  call file_cartesc_write_var( fid, vid(3), lst( :,:,ts:te), 'LAND_SFC_TEMP', 'XYT', update_dt )
2863  call file_cartesc_write_var( fid, vid(6), tw(:,:,:,ts:te), 'OCEAN_TEMP', 'OXYT', update_dt )
2864  call file_cartesc_write_var( fid, vid(7), sst( :,:,ts:te), 'OCEAN_SFC_TEMP', 'XYT', update_dt )
2865  call file_cartesc_write_var( fid, vid(10), z0( :,:,ts:te), 'OCEAN_SFC_Z0', 'XYT', update_dt )
2866 
2867  call prof_rapend ('___SurfaceOutput',3)
2868 
2869  return
2870  end subroutine parentsurfaceboundary
2871 
2872 
2873  !-------------------------------
2874  subroutine land_interporation( &
2875  tg, &
2876  strg, &
2877  lst, &
2878  albg, &
2879  ust, &
2880  albu, &
2881  tg_org, &
2882  strg_org, &
2883  smds_org, &
2884  lst_org, &
2885  albg_org, &
2886  ust_org, &
2887  sst_org, &
2888  lmask_org, &
2889  lsmask_nest, &
2890  topo_org, &
2891  lz_org, &
2892  llon_org, &
2893  llat_org, &
2894  LCZ, &
2895  LON, &
2896  LAT, &
2897  ldims, &
2898  odims, &
2899  maskval_tg, &
2900  maskval_strg, &
2901  init_landwater_ratio, &
2902  use_file_landwater, &
2903  use_waterratio, &
2904  soilwater_ds2vc_flag, &
2905  elevation_collection, &
2906  intrp_iter_max, &
2907  ol_interp, &
2908  URBAN_do )
2909  use scale_prc, only: &
2910  prc_abort
2911  use scale_const, only: &
2912  undef => const_undef, &
2913  eps => const_eps, &
2914  i_sw => const_i_sw, &
2915  i_lw => const_i_lw, &
2916  laps => const_laps
2917  use scale_interp, only: &
2918  interp_factor2d, &
2919  interp_factor3d, &
2920  interp_interp2d, &
2922  use scale_comm_cartesc, only: &
2923  comm_vars8, &
2924  comm_wait
2925  use scale_filter, only: &
2926  filter_hyperdiff
2927  use scale_topography, only: &
2928  topo_zsfc
2929  use mod_land_vars, only: &
2931  implicit none
2932  real(RP), intent(out) :: tg(lkmax,ia,ja)
2933  real(RP), intent(out) :: strg(lkmax,ia,ja)
2934  real(RP), intent(out) :: lst(ia,ja)
2935  real(RP), intent(out) :: albg(ia,ja,n_rad_dir,n_rad_rgn)
2936  real(RP), intent(out) :: ust(ia,ja)
2937  real(RP), intent(out) :: albu(ia,ja,n_rad_dir,n_rad_rgn)
2938  real(RP), intent(inout) :: tg_org(:,:,:)
2939  real(RP), intent(inout) :: strg_org(:,:,:)
2940  real(RP), intent(inout) :: smds_org(:,:,:)
2941  real(RP), intent(inout) :: lst_org(:,:)
2942  real(RP), intent(inout) :: albg_org(:,:,:,:)
2943  real(RP), intent(inout) :: ust_org(:,:)
2944  real(RP), intent(inout) :: sst_org(:,:)
2945  real(RP), intent(in) :: lmask_org(:,:)
2946  real(RP), intent(in) :: lsmask_nest(:,:)
2947  real(RP), intent(in) :: topo_org(:,:)
2948  real(RP), intent(in) :: lz_org(:)
2949  real(RP), intent(in) :: llon_org(:,:)
2950  real(RP), intent(in) :: llat_org(:,:)
2951  real(RP), intent(in) :: LCZ(lkmax)
2952  real(RP), intent(in) :: LON(ia,ja)
2953  real(RP), intent(in) :: LAT(ia,ja)
2954  integer, intent(in) :: ldims(3)
2955  integer, intent(in) :: odims(2)
2956  real(RP), intent(in) :: maskval_tg
2957  real(RP), intent(in) :: maskval_strg
2958  real(RP), intent(in) :: init_landwater_ratio
2959  logical, intent(in) :: use_file_landwater
2960  logical, intent(in) :: use_waterratio
2961  logical, intent(in) :: soilwater_ds2vc_flag
2962  logical, intent(in) :: elevation_collection
2963  integer, intent(in) :: intrp_iter_max
2964  logical, intent(in) :: ol_interp
2965  logical, intent(in) :: URBAN_do
2966 
2967  real(RP) :: lmask(ldims(2), ldims(3))
2968  real(RP) :: smds(lkmax,ia,ja)
2969 
2970  ! data for interporation
2971  real(RP) :: hfact_l(ldims(2), ldims(3), itp_nh)
2972  integer :: igrd_l (ldims(2), ldims(3), itp_nh)
2973  integer :: jgrd_l (ldims(2), ldims(3), itp_nh)
2974  real(RP) :: vfactl(lkmax,ia,ja,itp_nh,itp_nv)
2975  integer :: kgrdl (lkmax,ia,ja,itp_nh,itp_nv)
2976 
2977  real(RP) :: sst_land(ldims(2), ldims(3))
2978  real(RP) :: work(ldims(2), ldims(3))
2979 
2980  real(RP) :: lz3d_org(ldims(1),ldims(2),ldims(3))
2981  real(RP) :: lcz_3D(lkmax,ia,ja)
2982 
2983  ! elevation collection
2984  real(RP) :: topo(ia,ja)
2985  real(RP) :: tdiff
2986 
2987  real(RP) :: one2d(ia,ja)
2988  real(RP) :: one3d(ka,ia,ja)
2989 
2990  integer :: k, i, j
2991 
2992 
2993  ! Surface skin temp: interpolate over the ocean
2994  if ( i_intrp_land_sfc_temp .ne. i_intrp_off ) then
2995  select case( i_intrp_land_sfc_temp )
2996  case( i_intrp_mask )
2997  lmask = lmask_org
2998  case( i_intrp_fill )
2999  call make_mask( lmask, lst_org, ldims(2), ldims(3), landdata=.true.)
3000  case default
3001  log_error("land_interporation",*) 'INTRP_LAND_SFC_TEMP is invalid.'
3002  call prc_abort
3003  end select
3004  call interp_oceanland_data(lst_org, lmask, ldims(2), ldims(3), .true., intrp_iter_max)
3005  end if
3006 
3007  ! Urban surface temp: interpolate over the ocean
3008  ! if ( i_INTRP_URB_SFC_TEMP .ne. i_intrp_off ) then
3009  ! select case( i_INTRP_URB_SFC_TEMP )
3010  ! case( i_intrp_mask )
3011  ! lmask = lmask_org
3012  ! case( i_intrp_fill )
3013  ! call make_mask( lmask, ust_org, ldims(2), ldims(3), landdata=.true.)
3014  ! case default
3015  ! LOG_ERROR("land_interporation",*) 'INTRP_URB_SFC_TEMP is invalid.'
3016  ! call PRC_abort
3017  ! end select
3018  ! call interp_OceanLand_data(ust_org, lmask, ldims(2), ldims(3), .true., intrp_iter_max)
3019  !end if
3020 
3021  if ( ol_interp ) then
3022  ! interpolation facter between outer land grid and ocean grid
3023  call interp_factor2d( itp_nh, & ! [IN]
3024  odims(1), odims(2), & ! [IN]
3025  olon_org(:,:), & ! [IN]
3026  olat_org(:,:), & ! [IN]
3027  ldims(2), ldims(3), & ! [IN]
3028  llon_org(:,:), & ! [IN]
3029  llat_org(:,:), & ! [IN]
3030  igrd_l(:,:,:), & ! [OUT]
3031  jgrd_l(:,:,:), & ! [OUT]
3032  hfact_l(:,:,:) ) ! [OUT]
3033 
3034  ! sst on land grid
3035  call interp_interp2d( itp_nh, & ! [IN]
3036  odims(1), odims(2), & ! [IN]
3037  ldims(2), ldims(3), & ! [IN]
3038  igrd_l(:,:,:), & ! [IN]
3039  jgrd_l(:,:,:), & ! [IN]
3040  hfact_l(:,:,:), & ! [IN]
3041  sst_org(:,:), & ! [IN]
3042  sst_land(:,:) ) ! [OUT]
3043  else
3044  sst_land(:,:) = sst_org(:,:)
3045  end if
3046 
3047  do j = 1, ldims(3)
3048  do i = 1, ldims(2)
3049  if ( topo_org(i,j) > undef + eps ) then ! ignore UNDEF value
3050  sst_land(i,j) = sst_land(i,j) - topo_org(i,j) * laps
3051  end if
3052  end do
3053  end do
3054 
3055  call replace_misval_map( lst_org, sst_land, ldims(2), ldims(3), "SKINT" )
3056 
3057  ! replace missing value
3058  do j = 1, ldims(3)
3059  do i = 1, ldims(2)
3060 ! if ( skinw_org(i,j) == UNDEF ) skinw_org(i,j) = 0.0_RP
3061 ! if ( snowq_org(i,j) == UNDEF ) snowq_org(i,j) = 0.0_RP
3062 ! if ( snowt_org(i,j) == UNDEF ) snowt_org(i,j) = TEM00
3063  if( albg_org(i,j,i_r_direct ,i_r_ir ) == undef ) albg_org(i,j,i_r_direct ,i_r_ir ) = 0.03_rp
3064  if( albg_org(i,j,i_r_diffuse,i_r_ir ) == undef ) albg_org(i,j,i_r_diffuse,i_r_ir ) = 0.03_rp ! emissivity of general ground surface : 0.95-0.98
3065  if( albg_org(i,j,i_r_direct ,i_r_nir) == undef ) albg_org(i,j,i_r_direct ,i_r_nir) = 0.22_rp
3066  if( albg_org(i,j,i_r_diffuse,i_r_nir) == undef ) albg_org(i,j,i_r_diffuse,i_r_nir) = 0.22_rp
3067  if( albg_org(i,j,i_r_direct ,i_r_vis) == undef ) albg_org(i,j,i_r_direct ,i_r_vis) = 0.22_rp
3068  if( albg_org(i,j,i_r_diffuse,i_r_vis) == undef ) albg_org(i,j,i_r_diffuse,i_r_vis) = 0.22_rp
3069  end do
3070  end do
3071  if ( urban_do ) then
3072  do j = 1, ldims(3)
3073  do i = 1, ldims(2)
3074  if ( ust_org(i,j) == undef ) ust_org(i,j) = lst_org(i,j)
3075  end do
3076  end do
3077  end if
3078 
3079  ! Land temp: interpolate over the ocean
3080  if ( i_intrp_land_temp .ne. i_intrp_off ) then
3081  do k = 1, ldims(1)
3082  work(:,:) = tg_org(k,:,:)
3083  select case( i_intrp_land_temp )
3084  case( i_intrp_mask )
3085  lmask = lmask_org
3086  case( i_intrp_fill )
3087  call make_mask( lmask, work, ldims(2), ldims(3), landdata=.true.)
3088  end select
3089  call interp_oceanland_data( work, lmask, ldims(2), ldims(3), .true., intrp_iter_max )
3090  !replace land temp using skin temp
3091  call replace_misval_map( work, lst_org, ldims(2), ldims(3), "STEMP")
3092  tg_org(k,:,:) = work(:,:)
3093  end do
3094  end if
3095 
3096 
3097  ! fill grid data
3098  do j = 1, ldims(3)
3099  do i = 1, ldims(2)
3100  lz3d_org(:,i,j) = lz_org(:)
3101  end do
3102  end do
3103 
3104  do j = 1, ja
3105  do i = 1, ia
3106  lcz_3d(:,i,j) = lcz(:)
3107  enddo
3108  enddo
3109 
3110  call interp_factor3d( itp_nh, & ! [IN]
3111  ldims(1), 1, ldims(1), & ! [IN]
3112  ldims(2), ldims(3), & ! [IN]
3113  llon_org(:,:), & ! [IN]
3114  llat_org(:,:), & ! [IN]
3115  lz3d_org(:,:,:), & ! [IN]
3116  lkmax, lks, lke, & ! [IN]
3117  ia, ja, & ! [IN]
3118  lon(:,:), & ! [IN]
3119  lat(:,:), & ! [IN]
3120  lcz_3d(:,:,:), & ! [IN]
3121  igrd( :,:,:), & ! [OUT]
3122  jgrd( :,:,:), & ! [OUT]
3123  hfact( :,:,:), & ! [OUT]
3124  kgrdl(:,:,:,:,:), & ! [OUT]
3125  vfactl(:,:,:,:,:) ) ! [OUT]
3126 
3127  call interp_interp2d( itp_nh, & ! [IN]
3128  ldims(2), ldims(3), & ! [IN]
3129  ia, ja, & ! [IN]
3130  igrd(:,:,:), & ! [IN]
3131  jgrd(:,:,:), & ! [IN]
3132  hfact(:,:,:), & ! [IN]
3133  lst_org(:,:), & ! [IN]
3134  lst(:,:) ) ! [OUT]
3135  if ( filter_niter > 0 ) then
3136  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3137  lst(:,:), filter_order, filter_niter )
3138  call comm_vars8( lst(:,:), 1 )
3139  call comm_wait ( lst(:,:), 1 )
3140  end if
3141 
3142  if ( urban_do ) then
3143  call interp_interp2d( itp_nh, & ! [IN]
3144  ldims(2), ldims(3), & ! [IN]
3145  ia, ja, & ! [IN]
3146  igrd(:,:,:), & ! [IN]
3147  jgrd(:,:,:), & ! [IN]
3148  hfact(:,:,:), & ! [IN]
3149  ust_org(:,:), & ! [IN]
3150  ust(:,:) ) ! [OUT]
3151  if ( filter_niter > 0 ) then
3152  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3153  ust(:,:), filter_order, filter_niter )
3154  call comm_vars8( ust(:,:), 1 )
3155  call comm_wait ( ust(:,:), 1 )
3156  end if
3157  end if
3158 
3159  call interp_interp2d( itp_nh, & ! [IN]
3160  ldims(2), ldims(3), & ! [IN]
3161  ia, ja, & ! [IN]
3162  igrd(:,:,:), & ! [IN]
3163  jgrd(:,:,:), & ! [IN]
3164  hfact(:,:,:), & ! [IN]
3165  albg_org(:,:,i_r_direct ,i_r_ir ), & ! [IN]
3166  albg(:,:,i_r_direct ,i_r_ir ) ) ! [OUT]
3167  if ( filter_niter > 0 ) then
3168  one2d(:,:) = 1.0_rp
3169  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3170  albg(:,:,i_r_direct,i_r_ir), filter_order, filter_niter, &
3171  limiter_sign = one2d(:,:) )
3172  call comm_vars8( albg(:,:,i_r_direct,i_r_ir), 1 )
3173  call comm_wait ( albg(:,:,i_r_direct,i_r_ir), 1 )
3174  end if
3175 
3176  call interp_interp2d( itp_nh, & ! [IN]
3177  ldims(2), ldims(3), & ! [IN]
3178  ia, ja, & ! [IN]
3179  igrd(:,:,:), & ! [IN]
3180  jgrd(:,:,:), & ! [IN]
3181  hfact(:,:,:), & ! [IN]
3182  albg_org(:,:,i_r_diffuse,i_r_ir ), & ! [IN]
3183  albg(:,:,i_r_diffuse,i_r_ir ) ) ! [OUT]
3184  if ( filter_niter > 0 ) then
3185  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3186  albg(:,:,i_r_diffuse,i_r_ir), filter_order, filter_niter, &
3187  limiter_sign = one2d(:,:) )
3188  call comm_vars8( albg(:,:,i_r_diffuse,i_r_ir), 1 )
3189  call comm_wait ( albg(:,:,i_r_diffuse,i_r_ir), 1 )
3190  end if
3191 
3192  call interp_interp2d( itp_nh, & ! [IN]
3193  ldims(2), ldims(3), & ! [IN]
3194  ia, ja, & ! [IN]
3195  igrd(:,:,:), & ! [IN]
3196  jgrd(:,:,:), & ! [IN]
3197  hfact(:,:,:), & ! [IN]
3198  albg_org(:,:,i_r_direct ,i_r_nir), & ! [IN]
3199  albg(:,:,i_r_direct ,i_r_nir) ) ! [OUT]
3200  if ( filter_niter > 0 ) then
3201  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3202  albg(:,:,i_r_direct,i_r_nir), filter_order, filter_niter, &
3203  limiter_sign = one2d(:,:) )
3204  call comm_vars8( albg(:,:,i_r_direct,i_r_nir), 1 )
3205  call comm_wait ( albg(:,:,i_r_direct,i_r_nir), 1 )
3206  end if
3207 
3208  call interp_interp2d( itp_nh, & ! [IN]
3209  ldims(2), ldims(3), & ! [IN]
3210  ia, ja, & ! [IN]
3211  igrd(:,:,:), & ! [IN]
3212  jgrd(:,:,:), & ! [IN]
3213  hfact(:,:,:), & ! [IN]
3214  albg_org(:,:,i_r_diffuse,i_r_nir), & ! [IN]
3215  albg(:,:,i_r_diffuse,i_r_nir) ) ! [OUT]
3216  if ( filter_niter > 0 ) then
3217  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3218  albg(:,:,i_r_diffuse,i_r_nir), filter_order, filter_niter, &
3219  limiter_sign = one2d(:,:) )
3220  call comm_vars8( albg(:,:,i_r_diffuse,i_r_nir), 1 )
3221  call comm_wait ( albg(:,:,i_r_diffuse,i_r_nir), 1 )
3222  end if
3223 
3224  call interp_interp2d( itp_nh, & ! [IN]
3225  ldims(2), ldims(3), & ! [IN]
3226  ia, ja, & ! [IN]
3227  igrd(:,:,:), & ! [IN]
3228  jgrd(:,:,:), & ! [IN]
3229  hfact(:,:,:), & ! [IN]
3230  albg_org(:,:,i_r_direct ,i_r_vis), & ! [IN]
3231  albg(:,:,i_r_direct ,i_r_vis) ) ! [OUT]
3232  if ( filter_niter > 0 ) then
3233  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3234  albg(:,:,i_r_direct,i_r_vis), filter_order, filter_niter, &
3235  limiter_sign = one2d(:,:) )
3236  call comm_vars8( albg(:,:,i_r_direct,i_r_vis), 1 )
3237  call comm_wait ( albg(:,:,i_r_direct,i_r_vis), 1 )
3238  end if
3239 
3240  call interp_interp2d( itp_nh, & ! [IN]
3241  ldims(2), ldims(3), & ! [IN]
3242  ia, ja, & ! [IN]
3243  igrd(:,:,:), & ! [IN]
3244  jgrd(:,:,:), & ! [IN]
3245  hfact(:,:,:), & ! [IN]
3246  albg_org(:,:,i_r_diffuse,i_r_vis), & ! [IN]
3247  albg(:,:,i_r_diffuse,i_r_vis) ) ! [OUT]
3248  if ( filter_niter > 0 ) then
3249  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3250  albg(:,:,i_r_diffuse,i_r_vis), filter_order, filter_niter, &
3251  limiter_sign = one2d(:,:) )
3252  call comm_vars8( albg(:,:,i_r_diffuse,i_r_vis), 1 )
3253  call comm_wait ( albg(:,:,i_r_diffuse,i_r_vis), 1 )
3254  end if
3255 
3256  call interp_interp3d( itp_nh, & ! [IN]
3257  ldims(1), ldims(2), ldims(3), & ! [IN]
3258  lkmax, lks, lke, & ! [IN]
3259  ia, ja, & ! [IN]
3260  igrd( :,:,:), & ! [IN]
3261  jgrd( :,:,:), & ! [IN]
3262  hfact( :,:,:), & ! [IN]
3263  kgrdl(:,:,:,:,:), & ! [IN]
3264  vfactl(:,:,:,:,:), & ! [IN]
3265  tg_org(:,:,:), & ! [IN]
3266  tg(:,:,:) ) ! [OUT]
3267 
3268  do j = 1, ja
3269  do i = 1, ia
3270  tg(lkmax,i,j) = tg(lkmax-1,i,j)
3271  enddo
3272  enddo
3273 
3274  ! replace values over the ocean
3275  do k = 1, lkmax
3276  call replace_misval_const( tg(k,:,:), maskval_tg, lsmask_nest )
3277  enddo
3278  if ( filter_niter > 0 ) then
3279  call filter_hyperdiff( lkmax, 1, lkmax, ia, is, ie, ja, js, je, &
3280  tg(:,:,:), filter_order, filter_niter )
3281  call comm_vars8( tg(:,:,:), 1 )
3282  call comm_wait ( tg(:,:,:), 1 )
3283  end if
3284 
3285 
3286  ! elevation collection
3287  if ( elevation_collection ) then
3288  call interp_interp2d( itp_nh, & ! [IN]
3289  ldims(2), ldims(3), & ! [IN]
3290  ia, ja, & ! [IN]
3291  igrd(:,:,:), & ! [IN]
3292  jgrd(:,:,:), & ! [IN]
3293  hfact(:,:,:), & ! [IN]
3294  topo_org(:,:), & ! [IN]
3295  topo(:,:) ) ! [OUT]
3296  if ( filter_niter > 0 ) then
3297  call filter_hyperdiff( ia, is, ie, ja, js, je, &
3298  topo(:,:), filter_order, filter_niter )
3299  call comm_vars8( topo(:,:), 1 )
3300  call comm_wait ( topo(:,:), 1 )
3301  end if
3302 
3303  do j = 1, ja
3304  do i = 1, ia
3305  if ( topo(i,j) > undef + eps ) then ! ignore UNDEF value
3306  tdiff = ( topo_zsfc(i,j) - topo(i,j) ) * laps
3307  lst(i,j) = lst(i,j) - tdiff
3308  do k = 1, lkmax
3309  tg(k,i,j) = tg(k,i,j) - tdiff
3310  end do
3311  end if
3312  end do
3313  end do
3314 
3315  if ( urban_do ) then
3316  do j = 1, ja
3317  do i = 1, ia
3318  if ( topo(i,j) > 0.0_rp ) then ! ignore UNDEF value
3319  tdiff = ( topo_zsfc(i,j) - topo(i,j) ) * laps
3320  ust(i,j) = ust(i,j) - tdiff
3321  end if
3322  end do
3323  end do
3324  end if
3325 
3326  end if
3327 
3328 
3329 
3330  ! Land water: interpolate over the ocean
3331  if( use_file_landwater )then
3332 
3333  if ( use_waterratio ) then
3334 
3335  if ( i_intrp_land_water .ne. i_intrp_off ) then
3336  do k = 1, ldims(1)
3337  work(:,:) = smds_org(k,:,:)
3338  select case( i_intrp_land_water )
3339  case( i_intrp_mask )
3340  lmask = lmask_org
3341  case( i_intrp_fill )
3342  call make_mask( lmask, work, ldims(2), ldims(3), landdata=.true.)
3343  end select
3344  call interp_oceanland_data(work, lmask, ldims(2), ldims(3), .true., intrp_iter_max)
3345  lmask(:,:) = init_landwater_ratio
3346  !replace missing value to init_landwater_ratio
3347  call replace_misval_map( work, lmask, ldims(2), ldims(3), "SMOISDS")
3348  smds_org(k,:,:) = work(:,:)
3349  enddo
3350  end if
3351 
3352  call interp_interp3d( itp_nh, & ! [IN]
3353  ldims(1), ldims(2), ldims(3), & ! [IN]
3354  lkmax, lks, lke, & ! [IN]
3355  ia, ja, & ! [IN]
3356  igrd( :,:,:), & ! [IN]
3357  jgrd( :,:,:), & ! [IN]
3358  hfact( :,:,:), & ! [IN]
3359  kgrdl(:,:,:,:,:), & ! [IN]
3360  vfactl(:,:,:,:,:), & ! [IN]
3361  smds_org(:,:,:), & ! [IN]
3362  smds(:,:,:) ) ! [OUT]
3363 
3364  do k = 1, lkmax-1
3365  strg(k,:,:) = convert_ws2vwc( smds(k,:,:), critical=soilwater_ds2vc_flag )
3366  end do
3367 
3368  else
3369 
3370  if ( i_intrp_land_water .ne. i_intrp_off ) then
3371  do k = 1, ldims(1)
3372  work(:,:) = strg_org(k,:,:)
3373  select case( i_intrp_land_water )
3374  case( i_intrp_mask )
3375  lmask = lmask_org
3376  case( i_intrp_fill )
3377  call make_mask( lmask, work, ldims(2), ldims(3), landdata=.true.)
3378  end select
3379  call interp_oceanland_data(work, lmask, ldims(2), ldims(3), .true., intrp_iter_max)
3380  lmask(:,:) = maskval_strg
3381  !replace missing value to init_landwater_ratio
3382  call replace_misval_map( work, lmask, ldims(2), ldims(3), "SMOIS")
3383  strg_org(k,:,:) = work(:,:)
3384  enddo
3385  end if
3386 
3387  call interp_interp3d( itp_nh, & ! [IN]
3388  ldims(1), ldims(2), ldims(3), & ! [IN]
3389  lkmax, lks, lke, & ! [IN]
3390  ia, ja, & ! [IN]
3391  igrd( :,:,:), & ! [IN]
3392  jgrd( :,:,:), & ! [IN]
3393  hfact( :,:,:), & ! [IN]
3394  kgrdl(:,:,:,:,:), & ! [IN]
3395  vfactl(:,:,:,:,:), & ! [IN]
3396  strg_org(:,:,:), & ! [IN]
3397  strg(:,:,:) ) ! [OUT]
3398  end if
3399 
3400  ! replace values over the ocean
3401  do k = 1, lkmax-1
3402  call replace_misval_const( strg(k,:,:), maskval_strg, lsmask_nest )
3403  enddo
3404 
3405  if ( filter_niter > 0 ) then
3406  one3d(:,:,:) = 1.0_rp
3407  call filter_hyperdiff( lkmax, 1, lkmax-1, ia, is, ie, ja, js, je, &
3408  strg(:,:,:), filter_order, filter_niter, &
3409  limiter_sign = one3d(:,:,:) )
3410  call comm_vars8( strg(:,:,:), 1 )
3411  call comm_wait ( strg(:,:,:), 1 )
3412  end if
3413 
3414  do j = 1, ja
3415  do i = 1, ia
3416  strg(lkmax,i,j) = strg(lkmax-1,i,j)
3417  enddo
3418  enddo
3419 
3420  else ! not read from boundary file
3421 
3422  smds(:,:,:) = init_landwater_ratio
3423  ! conversion from water saturation [fraction] to volumetric water content [m3/m3]
3424  do k = 1, lkmax
3425  strg(k,:,:) = convert_ws2vwc( smds(k,:,:), critical=.true. )
3426  end do
3427 
3428  endif ! use_file_waterratio
3429 
3430 
3431  if ( urban_do ) then
3432  ! copy albedo of land to urban
3433  do j = 1, ja
3434  do i = 1, ia
3435  albu(i,j,:,:) = albg(i,j,:,:)
3436  enddo
3437  enddo
3438  end if
3439 
3440 
3441  return
3442  end subroutine land_interporation
3443 
3444  !-------------------------------
3445  subroutine make_mask( &
3446  gmask, & ! (out)
3447  data, & ! (in)
3448  nx, & ! (in)
3449  ny, & ! (in)
3450  landdata ) ! (in)
3451  use scale_const, only: &
3452  eps => const_eps, &
3453  undef => const_undef
3454  implicit none
3455  real(RP), intent(out) :: gmask(:,:)
3456  real(RP), intent(in) :: data(:,:)
3457  integer, intent(in) :: nx
3458  integer, intent(in) :: ny
3459  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
3460 
3461  real(RP) :: dd
3462  integer :: i,j
3463 
3464  if( landdata )then
3465  gmask(:,:) = 1.0_rp ! gmask=1 will be skip in "interp_OceanLand_data"
3466  dd = 0.0_rp
3467  else
3468  gmask(:,:) = 0.0_rp ! gmask=0 will be skip in "interp_OceanLand_data"
3469  dd = 1.0_rp
3470  endif
3471 
3472  do j = 1, ny
3473  do i = 1, nx
3474  if( abs(data(i,j) - undef) < sqrt(eps) )then
3475  gmask(i,j) = dd
3476  endif
3477  enddo
3478  enddo
3479 
3480  return
3481  end subroutine make_mask
3482  !-----------------------------------------------------------------------------
3483  subroutine interp_oceanland_data( &
3484  data, &
3485  lsmask, &
3486  nx, &
3487  ny, &
3488  landdata, &
3489  iter_max )
3490  use scale_const, only: &
3491  eps => const_eps
3492  implicit none
3493 
3494  integer, intent(in) :: nx
3495  integer, intent(in) :: ny
3496  real(RP), intent(inout) :: data (nx,ny)
3497  real(RP), intent(in) :: lsmask(nx,ny)
3498  logical, intent(in) :: landdata ! .true. => land data , .false. => ocean data
3499  integer, intent(in) :: iter_max
3500 
3501  integer :: mask (nx,ny)
3502  integer :: mask_prev(nx,ny)
3503  real(RP) :: data_prev(nx,ny)
3504  real(RP) :: tmp, cnt, sw
3505  integer :: mask_target
3506 
3507  integer :: num_land, num_ocean, num_replaced
3508  integer :: istr, iend, jstr, jend
3509  integer :: i, j, ii, jj, ite
3510  !---------------------------------------------------------------------------
3511 
3512  log_newline
3513  log_info("interp_OceanLand_data",*) 'Interpolation'
3514 
3515  if ( landdata ) then
3516  log_info("interp_OceanLand_data",*) 'target mask : LAND'
3517  mask_target = 1 ! interpolation for land data
3518  else
3519  log_info("interp_OceanLand_data",*) 'target mask : OCEAN'
3520  mask_target = 0 ! interpolation for ocean data
3521  endif
3522 
3523  ! search target cell for interpolation
3524  num_land = 0
3525  num_ocean = 0
3526  do j = 1, ny
3527  do i = 1, nx
3528  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
3529  num_land = num_land + ( mask(i,j) )
3530  num_ocean = num_ocean + ( 1-mask(i,j) )
3531  enddo
3532  enddo
3533 
3534  log_progress('(1x,A,I3.3,A,3I8,A,I8)') 'ite=', 0, &
3535  ', (land,ocean,replaced) = ', num_land, num_ocean, 0, ' / ', nx*ny
3536 
3537  ! start interpolation
3538  do ite = 1, iter_max
3539  ! save previous state
3540  mask_prev(:,:) = mask(:,:)
3541  data_prev(:,:) = data(:,:)
3542  num_replaced = 0
3543 
3544  do j = 1, ny
3545  do i = 1, nx
3546 
3547  if( mask(i,j) == mask_target ) cycle ! already filled
3548 
3549  ! collect neighbor grid
3550  istr = max(i-1,1 )
3551  iend = min(i+1,nx)
3552  jstr = max(j-1,1 )
3553  jend = min(j+1,ny)
3554 
3555  tmp = 0.0_rp
3556  cnt = 0.0_rp
3557  do jj = jstr, jend
3558  do ii = istr, iend
3559  sw = 0.5_rp - sign(0.5_rp,real(abs(mask_prev(ii,jj)-mask_target),kind=rp)-eps)
3560 
3561  tmp = tmp + sw * data_prev(ii,jj)
3562  cnt = cnt + sw
3563  enddo
3564  enddo
3565 
3566  if ( cnt >= 3.0_rp ) then ! replace by average of neighbor grid value
3567  data(i,j) = tmp / cnt
3568  mask(i,j) = mask_target
3569 
3570  num_replaced = num_replaced + 1
3571  endif
3572 
3573  enddo
3574  enddo
3575 
3576  if ( landdata ) then
3577  num_land = num_land + num_replaced
3578  num_ocean = num_ocean - num_replaced
3579  else
3580  num_land = num_land - num_replaced
3581  num_ocean = num_ocean + num_replaced
3582  endif
3583  log_progress('(1x,A,I3.3,A,3I8,A,I8)') 'ite=', ite, &
3584  ', (land,ocean,replaced) = ', num_land, num_ocean, num_replaced, ' / ', nx*ny
3585 
3586  if( num_replaced == 0 ) exit
3587 
3588  enddo ! itelation
3589 
3590 
3591  return
3592  end subroutine interp_oceanland_data
3593 
3594  !-----------------------------------------------------------------------------
3595  subroutine replace_misval_const( data, maskval, frac_land )
3596  use scale_const, only: &
3597  eps => const_eps
3598  implicit none
3599  real(RP), intent(inout) :: data(:,:)
3600  real(RP), intent(in) :: maskval
3601  real(RP), intent(in) :: frac_land(:,:)
3602  integer :: i, j
3603 
3604  do j = 1, ja
3605  do i = 1, ia
3606  if( abs(frac_land(i,j)-0.0_rp) < eps )then ! ocean grid
3607  data(i,j) = maskval
3608  endif
3609  enddo
3610  enddo
3611 
3612  end subroutine replace_misval_const
3613 
3614  !-----------------------------------------------------------------------------
3615  subroutine replace_misval_map( data, maskval, nx, ny, elem)
3616  use scale_const, only: &
3617  eps => const_eps, &
3618  undef => const_undef
3619  implicit none
3620 
3621  real(RP), intent(inout) :: data(:,:)
3622  real(RP), intent(in) :: maskval(:,:)
3623  integer, intent(in) :: nx, ny
3624  character(len=*), intent(in) :: elem
3625 
3626  integer :: i, j
3627 
3628  do j = 1, ny
3629  do i = 1, nx
3630  if( abs(data(i,j) - undef) < sqrt(eps) )then
3631  if( abs(maskval(i,j) - undef) < sqrt(eps) )then
3632  log_error("replace_misval_map",*) "data for mask of "//trim(elem)//"(",i,",",j,") includes missing value."
3633  log_error_cont(*) "Please check input data of SKINTEMP or SST. "
3634  call prc_abort
3635  else
3636  data(i,j) = maskval(i,j)
3637  endif
3638  endif
3639  enddo
3640  enddo
3641 
3642  end subroutine replace_misval_map
3643 
3644 end module mod_realinput
module ATMOS admin
module Land admin
subroutine replace_misval_map(data, maskval, nx, ny, elem)
real(rp), dimension(:,:,:), allocatable, target, public momz
subroutine make_mask(gmask, data, nx, ny, landdata)
subroutine, public parentoceaninputgrads(tw_org, sst_org, omask_org, olon_org, olat_org, basename_num, odims, nt)
subroutine, public parentatmossetupgrads(dims, basename)
Atmos Setup.
real(rp), dimension(:), allocatable, public land_grid_cartesc_cz
center coordinate [m]: z, local=global
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0e
subroutine, public parentoceanopengrads
integer, public const_i_lw
long-wave radiation index
Definition: scale_const.F90:93
real(rp), dimension(:,:), allocatable, public urban_qc
real(rp), dimension(:,:), allocatable, public landuse_fact_urban
urban factor
module coupler / surface-atmospehre
subroutine, public parentatmosopenwrfarw
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)
module REAL input WRF-ARW
real(rp), dimension(:,:,:), allocatable, target, public rhot
real(rp), dimension(qa_max), public tracer_r
integer, public ia
of whole cells: x, local, with HALO
real(rp) function, dimension(lia, lja), public convert_ws2vwc(WS, critical)
conversion from water saturation [fraction] to volumetric water content [m3/m3]
module Atmosphere / Physics Cloud Microphysics
subroutine, public parentlandsetupwrfarw(ldims, basename_land)
Land Setup.
subroutine, public parentoceanopenscale(olon_org, olat_org, omask_org, basename_ocean, odims)
integer, parameter, public i_r_vis
module land / grid / cartesianC / index
module Atmosphere Grid CartesianC metirc
logical, public ocean_do
module ATMOSPHERIC Variables
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lat
latitude [rad,-pi,pi]
real(rp), dimension(:,:,:), allocatable, target, public momx
module INTERPOLATION
real(rp), dimension(:,:), allocatable, public ocean_sfc_temp
ocean surface skin temperature [K]
real(rp), dimension(:,:), allocatable, public ocean_ice_mass
sea ice mass [kg]
integer, public qa
subroutine, public interp_factor3d(npoints, KA_ref, KS_ref, KE_ref, IA_ref, JA_ref, lon_ref, lat_ref, hgt_ref, KA, KS, KE, IA, JA, lon, lat, hgt, idx_i, idx_j, hfact, idx_k, vfact)
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_temp
subroutine land_interporation(tg, strg, lst, albg, ust, albu, tg_org, strg_org, smds_org, lst_org, albg_org, ust_org, sst_org, lmask_org, lsmask_nest, topo_org, lz_org, llon_org, llat_org, LCZ, LON, LAT, ldims, odims, maskval_tg, maskval_strg, init_landwater_ratio, use_file_landwater, use_waterratio, soilwater_ds2vc_flag, elevation_collection, intrp_iter_max, ol_interp, URBAN_do)
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_fz
geopotential height [m] (wxy)
integer, public ja
of whole cells: y, local, with HALO
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:55
subroutine, public parentlandsetupscale(ldims)
Land Setup.
real(rp), dimension(:,:), allocatable, public urban_tb
integer, parameter, public n_rad_dir
real(rp), dimension(:,:,:), allocatable, target, public dens
integer, parameter, public n_rad_rgn
real(rp), public const_laps
lapse rate of ISA [K/m]
Definition: scale_const.F90:58
subroutine, public parentoceaninputwrfarw(tw_org, sst_org, albw_org, z0w_org, omask_org, olon_org, olat_org, basename, odims, it)
module URBAN Variables
real(rp), dimension(:,:), allocatable, public urban_raing
subroutine, public interp_interp3d(npoints, KA_ref, IA_ref, JA_ref, KA, KS, KE, IA, JA, idx_i, idx_j, hfact, idx_k, vfact, val_ref, val, logwgt)
real(rp), dimension(:,:), allocatable, public atmos_grid_cartesc_real_lon
longitude [rad,0-2pi]
character(len=h_short), dimension(qa_max), public tracer_name
subroutine, public parentlandsetupgrads(ldims, use_waterratio, use_file_landwater, basename)
Land Setup.
real(rp), dimension(qa_max), public tracer_cv
subroutine, public parentatmossetupwrfarw(dims, timelen, basename_org)
Atmos Setup.
module urban / grid / icosahedralA / index
real(rp), dimension(:,:), allocatable, public urban_uc
real(rp), public const_undef
Definition: scale_const.F90:41
real(rp), dimension(:,:,:,:), allocatable, public urban_sfc_albedo
character(len=h_short), public atmos_phy_ch_type
module COMMUNICATION
real(rp), dimension(:,:), allocatable, public land_sfc_temp
land surface skin temperature [K]
integer, public is
start point of inner domain: x, local
real(rp), dimension(qa_max), public tracer_cp
module ATMOSPHERIC Surface Variables
integer, public ie
end point of inner domain: x, local
subroutine, public file_cartesc_create(basename, title, datatype, fid, date, subsec, haszcoord, append, aggregate, single)
Create/open a netCDF file.
subroutine, public parentoceansetupwrfarw(odims, timelen, basename_org)
Ocean Setup.
module TRACER
module Index
Definition: scale_index.F90:11
real(rp), dimension(:,:), allocatable, public urban_tr
real(rp), dimension(:,:,:,:), allocatable, public atmos_phy_sf_sfc_albedo
module REAL input
real(rp), dimension(:,:,:), allocatable, public urban_tgl
module atmosphere / hydrometeor
real(rp), dimension(:,:,:,:), allocatable, public land_sfc_albedo
land surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
subroutine, public atmos_phy_mp_driver_qhyd2qtrc(KA, KS, KE, IA, IS, IE, JA, JS, JE, QV, QHYD, QTRC, QNUM)
real(rp), dimension(:,:,:), allocatable, public ocean_salt
ocean salinity [PSU]
subroutine, public parentoceaninputscale(tw_org, sst_org, albw_org, z0w_org, omask_org, basename_ocean, odims, it)
module LANDUSE
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0h
subroutine, public time_gettimelabel(timelabel)
generate time label
Definition: scale_time.F90:94
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0h
ocean surface roughness length for heat [m]
integer, public comm_cartesc_nest_interp_level
horizontal interpolation level
module FILTER
module atmosphere / grid / cartesC index
integer, public ke
end point of inner domain: z, local
real(rp), dimension(:,:,:), allocatable, public ocean_temp
ocean temperature [K]
module REAL input SCALE
module PROCESS
Definition: scale_prc.F90:11
integer, public je
end point of inner domain: y, local
subroutine, public parentatmosopengrads
real(rp), dimension(:,:,:), allocatable, public land_temp
temperature of each soil layer [K]
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)
module atmosphere / hydrostatic barance
real(rp), dimension(:,:), allocatable, public landuse_fact_ocean
ocean factor
subroutine, public file_cartesc_enddef(fid)
Exit netCDF file define mode.
module TIME
Definition: scale_time.F90:16
subroutine, public parentatmossetupscale(dims)
Atmos Setup.
real(rp), dimension(:,:), allocatable, public urban_roff
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)
integer, public ks
start point of inner domain: z, local
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_metric_rotc
rotation coefficient
module Ocean admin
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)
subroutine, public interp_interp2d(npoints, IA_ref, JA_ref, IA, JA, idx_i, idx_j, hfact, val_ref, val)
module LAND Variables
subroutine, public parentoceansetupgrads(odims, timelen, basename)
Ocean Setup.
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
module CONSTANT
Definition: scale_const.F90:11
module Communication CartesianC nesting
integer, public js
start point of inner domain: y, local
integer, parameter, public i_r_direct
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.
character(len=h_short), public atmos_phy_mp_type
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, dims, it)
real(rp), dimension(:,:), allocatable, public urban_tc
real(rp), dimension(:,:,:), allocatable, target, public momy
module Atmosphere / Physics Chemistry
subroutine, public parentatmosinputscale(velz_org, velx_org, vely_org, pres_org, dens_org, pott_org, qv_org, qtrc_org, cz_org, basename_org, same_mptype, dims, it)
real(rp), dimension(:,:), allocatable, public urban_rainr
module land / grid / cartesianC
subroutine, public prof_rapstart(rapname_base, level)
Start raptime.
Definition: scale_prof.F90:157
real(rp), dimension(:,:,:), allocatable, public land_water
moisture of each soil layer [m3/m3]
module ocean / grid / cartesianC / index
real(rp), dimension(:,:,:), allocatable, public atmos_grid_cartesc_real_cz
geopotential height [m] (zxy)
module profiler
Definition: scale_prof.F90:11
logical, public prc_ismaster
master process in local communicator?
Definition: scale_prc.F90:90
real(rp), public const_eps
small number
Definition: scale_const.F90:33
integer, parameter, public i_r_nir
module atmosphere / thermodyn
real(rp), dimension(:,:,:), allocatable, public ocean_vvel
ocean meridional velocity [m/s]
module Atmosphere GRID CartesC Real(real space)
module ocean / physics / ice / simple
integer, public const_i_sw
short-wave radiation index
Definition: scale_const.F90:94
subroutine, public parentoceansetupscale(odims)
Ocean Setup.
module PRECISION
module file / cartesianC
real(rp), dimension(:,:), allocatable, public topo_zsfc
absolute ground height [m]
subroutine, public parentatmosopenscale(lon_org, lat_org, cz_org, basename_org, dims)
integer, public ka
of whole cells: z, local, with HALO
module REAL input GrADS
subroutine, public realinput_atmos
module TOPOGRAPHY
real(rp), dimension(:,:), allocatable, public urban_tg
integer, parameter, public iwrfarw
real(rp), dimension(:,:), allocatable, public atmos_phy_sf_sfc_z0m
real(rp), dimension(:,:), allocatable, public urban_sfc_temp
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:69
real(rp), dimension(:,:,:), allocatable, public urban_trl
integer, parameter, public i_r_ir
subroutine, public interp_factor2d(npoints, IA_ref, JA_ref, lon_ref, lat_ref, IA, JA, lon, lat, idx_i, idx_j, hfact, search_limit, latlon_structure, weight_order)
real(rp), dimension(:,:), allocatable, public ocean_ice_temp
sea ice temperature [K]
subroutine, public parentoceanopenwrfarw
module STDIO
Definition: scale_io.F90:10
real(rp), dimension(:,:), allocatable, public ocean_ocn_z0m
surface roughness length for momentum, open ocean [m]
real(rp), dimension(:,:), allocatable, public landuse_fact_land
land factor
integer, parameter, public i_r_diffuse
integer, parameter, public n_hyd
real(rp), dimension(:,:,:,:), allocatable, public ocean_sfc_albedo
ocean surface albedo (direct/diffuse,IR/near-IR/VIS) (0-1)
subroutine, public realinput_surface
module atmosphere / physics / cloud microphysics
subroutine, public prof_rapend(rapname_base, level)
Save raptime.
Definition: scale_prof.F90:210
integer, parameter, public rp
module Urban admin
subroutine, public parentatmosinputgrads(velz_org, velx_org, vely_org, pres_org, dens_org, temp_org, qv_org, qhyd_org, RN222_org, lon_org, lat_org, cz_org, basename_num, dims, nt)
real(rp), dimension(:,:,:), allocatable, public urban_tbl
logical, public urban_do
integer, parameter, public igrads
real(rp), dimension(:,:), allocatable, public landuse_frac_land
land fraction
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0m
ocean surface roughness length for momentum [m]
real(rp), dimension(:,:,:), allocatable, public ocean_uvel
ocean zonal velocity [m/s]
module OCEAN Variables
logical, public land_do
real(rp), dimension(:,:), allocatable, public urban_rainb
real(rp), dimension(:,:), allocatable, public ocean_sfc_z0e
ocean surface roughness length for vapor [m]
subroutine replace_misval_const(data, maskval, frac_land)
real(rp), dimension(qa_max), public tracer_mass
real(rp), dimension(:,:,:,:), allocatable, target, public qtrc
integer, parameter, public iscale