SCALE-RM
mod_realinput_grads.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 #include "scalelib.h"
11 module mod_realinput_grads
12  !-----------------------------------------------------------------------------
13  !
14  !++ used modules
15  !
16  use scale_precision
17  use scale_io
18  use scale_tracer
19  use scale_prc, only: &
20  myrank => prc_myrank, &
21  prc_abort
22  !-----------------------------------------------------------------------------
23  implicit none
24  private
25  !-----------------------------------------------------------------------------
26  !
27  !++ Public procedure
28  !
29  public :: parentatmossetupgrads
30  public :: parentatmosinputgrads
31  public :: parentlandsetupgrads
32  public :: parentlandinputgrads
33  public :: parentoceansetupgrads
34  public :: parentoceaninputgrads
35 
36  !-----------------------------------------------------------------------------
37  !
38  !++ Public parameters & variables
39  !
40  !-----------------------------------------------------------------------------
41  !
42  !++ Private procedure
43  !
44  !-----------------------------------------------------------------------------
45  !
46  !++ Private parameters & variables
47  !
48  integer :: file_id_atm, file_id_ocn, file_id_lnd
49 
50  !-----------------------------------------------------------------------------
51 contains
52  !-----------------------------------------------------------------------------
54  subroutine parentatmossetupgrads( &
55  dims, &
56  timelen, &
57  qtrc_flag, &
58  LON_all, &
59  LAT_all, &
60  basename_org, &
61  basename_num )
62  use scale_const, only: &
63  d2r => const_d2r
64  use scale_file_grads, only: &
65  file_grads_open, &
66  file_grads_varid, &
67  file_grads_get_shape
68  use mod_atmos_phy_mp_vars, only: &
69  qs_mp, &
70  qe_mp
71  implicit none
72  integer, intent(out) :: dims(6)
73  integer, intent(out) :: timelen
74  logical, intent(out) :: qtrc_flag(qa)
75  real(rp), allocatable, intent(out) :: lon_all(:,:)
76  real(rp), allocatable, intent(out) :: lat_all(:,:)
77 
78  character(len=*), intent(in) :: basename_org
79  character(len=*), intent(in) :: basename_num
80 
81 ! namelist / PARAM_MKINIT_REAL_GrADS /
82 
83  integer :: var_id
84  real(rp), allocatable :: lon1d(:), lat1d(:)
85 
86 
87  integer :: i, j, iq
88  integer :: ierr
89  !---------------------------------------------------------------------------
90 
91  log_newline
92  log_info("ParentAtmosSetupGrADS",*) 'Setup'
93 
94 !!$ !--- read namelist
95 !!$ rewind(IO_FID_CONF)
96 !!$ read(IO_FID_CONF,nml=PARAM_MKINIT_REAL_GrADS,iostat=ierr)
97 !!$
98 !!$ if( ierr > 0 ) then
99 !!$ LOG_ERROR("ParentAtmosSetupGrADS",*) 'Not appropriate names in namelist PARAM_MKINIT_REAL_GrADS. Check!'
100 !!$ call PRC_abort
101 !!$ endif
102 !!$ LOG_NML(PARAM_MKINIT_REAL_GrADS)
103 
104 
105  if ( basename_org == "" ) then
106  log_error("ParentAtmosSetupGrADS",*) '"BASENAME_ORG" is not specified in "PARAM_MKINIT_REAL_ATMOS"!', trim(basename_org)
107  call prc_abort
108  endif
109 
110  call file_grads_open( basename_org, & ! (in)
111  file_id_atm ) ! (out)
112 
113 #ifdef QUICKDEBUG
114  qtrc_flag(:) = .false.
115 #endif
116  do iq = 1, qa
117  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
118  call file_grads_varid( file_id_atm, tracer_name(iq), var_id )
119  qtrc_flag(iq) = var_id > 0
120  end do
121 
122  call file_grads_get_shape( file_id_atm, "U", & ! (in)
123  dims(:3) ) ! (out)
124 
125  ! half level
126  dims(4) = dims(1)
127  dims(5) = dims(2)
128  dims(6) = dims(3)
129 
130 
131  allocate( lon_all(dims(2), dims(3)) )
132  allocate( lat_all(dims(2), dims(3)) )
133 
134 
135  call read2d( (/1,1/), dims(2:3), lon_all(:,:), "lon", file_id_atm, basename_num, oned=1 )
136  lon_all(:,:) = lon_all(:,:) * d2r
137 
138  call read2d( (/1,1/), dims(2:3), lat_all(:,:), "lat", file_id_atm, basename_num, oned=2 )
139  lat_all(:,:) = lat_all(:,:) * d2r
140 
141  ! tentative
142  timelen = 1
143 
144  return
145  end subroutine parentatmossetupgrads
146 
147  !-----------------------------------------------------------------------------
148  subroutine parentatmosinputgrads( &
149  KA_org, KS_org, KE_org, &
150  IA_org, IS_org, IE_org, &
151  JA_org, JS_org, JE_org, &
152  QA, &
153  w_org, &
154  u_org, &
155  v_org, &
156  pres_org, &
157  dens_org, &
158  pt_org, &
159  temp_org, &
160  qv_org, &
161  rh_org, &
162  qhyd_org, &
163  qtrc_org,&
164  cz_org, &
165  nopres, nodens, &
166  temp2pt, rh2qv, &
167  basename_num, &
168  sfc_diagnoses, &
169  nt )
170  use scale_const, only: &
171  undef => const_undef, &
172  d2r => const_d2r, &
173  eps => const_eps, &
174  epsvap => const_epsvap, &
175  epstvap => const_epstvap, &
176  grav => const_grav, &
177  laps => const_laps, &
178  p00 => const_pre00, &
179  rdry => const_rdry, &
180  cpdry => const_cpdry
181  use scale_atmos_hydrometeor, only: &
182  hyd_name, &
183  n_hyd
184  use mod_atmos_phy_mp_vars, only: &
185  qs_mp, &
186  qe_mp
187  implicit none
188  integer, intent(in) :: ka_org
189  integer, intent(in) :: ks_org
190  integer, intent(in) :: ke_org
191  integer, intent(in) :: ia_org
192  integer, intent(in) :: is_org
193  integer, intent(in) :: ie_org
194  integer, intent(in) :: ja_org
195  integer, intent(in) :: js_org
196  integer, intent(in) :: je_org
197  integer, intent(in) :: qa
198  real(rp), intent(out) :: w_org(ka_org,ia_org,ja_org)
199  real(rp), intent(out) :: u_org(ka_org,ia_org,ja_org)
200  real(rp), intent(out) :: v_org(ka_org,ia_org,ja_org)
201  real(rp), intent(out) :: pres_org(ka_org,ia_org,ja_org)
202  real(rp), intent(out) :: dens_org(ka_org,ia_org,ja_org)
203  real(rp), intent(out) :: pt_org(ka_org,ia_org,ja_org)
204  real(rp), intent(out) :: temp_org(ka_org,ia_org,ja_org)
205  real(rp), intent(out) :: qv_org(ka_org,ia_org,ja_org)
206  real(rp), intent(out) :: rh_org(ka_org,ia_org,ja_org)
207  real(rp), intent(out) :: qhyd_org(ka_org,ia_org,ja_org,n_hyd)
208  real(rp), intent(out) :: qtrc_org(ka_org,ia_org,ja_org,qa)
209  real(rp), intent(out) :: cz_org(ka_org,ia_org,ja_org)
210  logical, intent(out) :: nopres
211  logical, intent(out) :: nodens
212  logical, intent(out) :: temp2pt
213  logical, intent(out) :: rh2qv
214  character(len=*), intent(in) :: basename_num
215  logical, intent(in) :: sfc_diagnoses
216  integer, intent(in) :: nt
217 
218  character(len=H_SHORT) :: item
219 
220  integer :: lm_layer(ia_org,ja_org)
221 
222  real(rp) :: work(ka_org-2,ia_org,ja_org)
223  real(rp) :: work2d(ia_org,ja_org)
224  real(rp) :: coef
225  integer :: start(3), count(3)
226 
227  logical :: exist
228 
229  integer :: i, j, k, iq
230  !---------------------------------------------------------------------------
231 
232  start(:) = (/1,is_org,js_org/)
233  count(:) = (/ka_org-2,ia_org,ja_org/)
234 
235  ! pressure
236  nopres = .false.
237  call read3d( start(:), count(:), work(:,:,:), "pressure", file_id_atm, basename_num, exist=exist, step=nt )
238  if ( .not. exist ) then
239  call read3d( start(:), count(:), work(:,:,:), "plev", file_id_atm, basename_num, exist=exist, step=nt )
240  if ( .not. exist ) nopres = .true.
241  end if
242  if ( .not. nopres ) then
243  !$omp parallel do collapse(2)
244  do j = 1, ja_org
245  do i = 1, ia_org
246  do k = 1, ka_org-2
247  pres_org(k+2,i,j) = work(k,i,j)
248  enddo
249  enddo
250  enddo
251  end if
252 
253 
254  ! dens
255  call read3d( start(:), count(:), work(:,:,:), "DENS", file_id_atm, basename_num, exist=exist, step=nt )
256  if ( exist ) then
257  !$omp parallel do collapse(2)
258  do j = 1, ja_org
259  do i = 1, ia_org
260  do k = 1, ka_org-2
261  dens_org(k+2,i,j) = work(k,i,j)
262  enddo
263  enddo
264  enddo
265  nodens = .false.
266  else
267  nodens = .true.
268  end if
269 
270  ! W
271  call read3d( start(:), count(:), work(:,:,:), "W", file_id_atm, basename_num, exist=exist, step=nt )
272  if ( exist ) then
273  !$omp parallel do collapse(2)
274  do j = 1, ja_org
275  do i = 1, ia_org
276  do k = 1, ka_org-2
277  w_org(k+2,i,j) = work(k,i,j)
278  enddo
279  enddo
280  enddo
281  else
282  !$omp parallel do collapse(2)
283  do j = 1, ja_org
284  do i = 1, ia_org
285  do k = 1, ka_org-2
286  w_org(k+2,i,j) = 0.0_rp
287  enddo
288  enddo
289  enddo
290  end if
291 
292  ! U
293  call read3d( start(:), count(:), work(:,:,:), "U", file_id_atm, basename_num, exist=exist, step=nt )
294  if ( exist ) then
295  !$omp parallel do collapse(2)
296  do j = 1, ja_org
297  do i = 1, ia_org
298  do k = 1, ka_org-2
299  u_org(k+2,i,j) = work(k,i,j)
300  enddo
301  enddo
302  enddo
303  else
304  log_error("ParentAtmosInputGrADS",*) '"U" is requierd'
305  call prc_abort
306  end if
307 
308  ! V
309  call read3d( start(:), count(:), work(:,:,:), "V", file_id_atm, basename_num, exist=exist, step=nt )
310  if ( exist ) then
311  !$omp parallel do collapse(2)
312  do j = 1, ja_org
313  do i = 1, ia_org
314  do k = 1, ka_org-2
315  v_org(k+2,i,j) = work(k,i,j)
316  enddo
317  enddo
318  enddo
319  else
320  log_error("ParentAtmosInputGrADS",*) '"V" is requierd'
321  call prc_abort
322  end if
323 
324  ! T
325  call read3d( start(:), count(:), work(:,:,:), "PT", file_id_atm, basename_num, exist=exist, step=nt )
326  if ( exist ) then
327  !$omp parallel do collapse(2)
328  do j = 1, ja_org
329  do i = 1, ia_org
330  do k = 1, ka_org-2
331  pt_org(k+2,i,j) = work(k,i,j)
332  enddo
333  enddo
334  enddo
335  temp2pt = .false.
336  else
337  call read3d( start(:), count(:), work(:,:,:), "T", file_id_atm, basename_num, exist=exist, step=nt )
338  if ( exist ) then
339  !$omp parallel do collapse(2)
340  do j = 1, ja_org
341  do i = 1, ia_org
342  do k = 1, ka_org-2
343  temp_org(k+2,i,j) = work(k,i,j)
344  enddo
345  enddo
346  enddo
347  temp2pt = .true.
348  else
349  log_error("ParentAtmosInputGrADS",*) '"PT" or "T" is requierd'
350  call prc_abort
351  end if
352  end if
353 
354  ! height
355  coef = 1.0_rp
356  call read3d( start(:), count(:), work(:,:,:), "height", file_id_atm, basename_num, exist=exist, step=nt )
357  if ( .not. exist ) then
358  call read3d( start(:), count(:), work(:,:,:), "HGT", file_id_atm, basename_num, exist=exist, step=nt )
359  if ( .not. exist ) then
360  ! geopotential to height
361  coef = 1.0_rp / grav
362  call read3d( start(:), count(:), work(:,:,:), "GP", file_id_atm, basename_num, exist=exist, step=nt )
363  if ( .not. exist ) then
364  log_error("ParentAtmosInputGrADS",*) '"height", "HGT", or "GP" is requierd'
365  call prc_abort
366  end if
367  end if
368  end if
369  !$omp parallel do collapse(2)
370  do j = 1, ja_org
371  do i = 1, ia_org
372  do k = 1, ka_org-2
373  cz_org(k+2,i,j) = work(k,i,j) * coef
374  enddo
375  enddo
376  enddo
377 
378  ! QV
379  call read3d( start(:), count(:), work(:,:,:), "QV", file_id_atm, basename_num, exist=exist, step=nt )
380  if ( exist ) then
381  !$omp parallel do collapse(2)
382  do j = 1, ja_org
383  do i = 1, ia_org
384  do k = 1, ka_org-2
385  qv_org(k+2,i,j) = work(k,i,j)
386  enddo
387  enddo
388  enddo
389  rh2qv = .false.
390  else
391  call read3d( start(:), count(:), work(:,:,:), "RH", file_id_atm, basename_num, exist=exist, step=nt )
392  if ( exist ) then
393  !$omp parallel do collapse(2)
394  do j = 1, ja_org
395  do i = 1, ia_org
396  do k = 1, ka_org-2
397  rh_org(k+2,i,j) = work(k,i,j)
398  enddo
399  enddo
400  enddo
401  rh2qv = .true.
402  else
403  !$omp parallel do collapse(2)
404  do j = 1, ja_org
405  do i = 1, ia_org
406  do k = 1, ka_org-2
407  qv_org(k+2,i,j) = 0.0_rp
408  enddo
409  enddo
410  enddo
411  rh2qv = .false.
412  end if
413  end if
414 
415  ! QC, QR, QI, QS, QG, QH
416  do iq = 1, n_hyd
417  call read3d( start(:), count(:), work(:,:,:), hyd_name(iq), file_id_atm, basename_num, exist=exist, step=nt )
418  if ( exist ) then
419  !$omp parallel do collapse(2)
420  do j = 1, ja_org
421  do i = 1, ia_org
422  do k = 1, ka_org-2
423  qhyd_org(k+2,i,j,iq) = work(k,i,j)
424  enddo
425  enddo
426  enddo
427  else
428  !$omp parallel do collapse(2)
429  do j = 1, ja_org
430  do i = 1, ia_org
431  do k = 1, ka_org-2
432  qhyd_org(k+2,i,j,iq) = 0.0_rp
433  enddo
434  enddo
435  enddo
436  end if
437 #ifdef QUICKDEBUG
438  !$omp parallel do collapse(2)
439  do j = 1, ja_org
440  do i = 1, ia_org
441  do k = 1, 2
442  qhyd_org(k,i,j,iq) = undef
443  enddo
444  enddo
445  enddo
446 #endif
447  end do
448 
449  ! QTRC
450  do iq = 1, qa
451  if ( iq >= qs_mp .and. iq <= qe_mp ) cycle
452  call read3d( start(:), count(:), work(:,:,:), tracer_name(iq), file_id_atm, basename_num, exist=exist, step=nt )
453  if ( exist ) then
454  !$omp parallel do collapse(2)
455  do j = 1, ja_org
456  do i = 1, ia_org
457  do k = 1, ka_org-2
458  qtrc_org(k+2,i,j,iq) = work(k,i,j)
459  enddo
460  enddo
461  enddo
462  else
463  !$omp parallel do collapse(2)
464  do j = 1, ja_org
465  do i = 1, ia_org
466  do k = 1, ka_org-2
467  qtrc_org(k+2,i,j,iq) = undef
468  enddo
469  enddo
470  enddo
471  end if
472  end do
473 
474 
475  if ( sfc_diagnoses ) then
476 
477  ! MSLP
478  call read2d( start(2:), count(2:), work2d(:,:), "MSLP", file_id_atm, basename_num, exist=exist, step=nt )
479  if ( exist ) then
480  !$omp parallel do
481  do j = 1, ja_org
482  do i = 1, ia_org
483  pres_org(1,i,j) = work2d(i,j)
484  enddo
485  enddo
486  else
487  !$omp parallel do
488  do j = 1, ja_org
489  do i = 1, ia_org
490  pres_org(1,i,j) = undef
491  enddo
492  enddo
493  end if
494 
495  ! SFC_PRES, PSFC
496  call read2d( start(2:), count(2:), work2d(:,:), "SFC_PRES", file_id_atm, basename_num, exist=exist, step=nt )
497  if ( .not. exist ) then
498  call read2d( start(2:), count(2:), work2d(:,:), "PSFC", file_id_atm, basename_num, exist=exist, step=nt )
499  end if
500  if ( exist ) then
501  !$omp parallel do
502  do j = 1, ja_org
503  do i = 1, ia_org
504  pres_org(2,i,j) = work2d(i,j)
505  enddo
506  enddo
507  else
508  !$omp parallel do
509  do j = 1, ja_org
510  do i = 1, ia_org
511  pres_org(2,i,j) = undef
512  enddo
513  enddo
514  end if
515 
516  ! U10
517  call read2d( start(2:), count(2:), work2d(:,:), "U10", file_id_atm, basename_num, exist=exist, step=nt )
518  if ( exist ) then
519  !$omp parallel do
520  do j = 1, ja_org
521  do i = 1, ia_org
522  u_org(2,i,j) = work2d(i,j)
523  enddo
524  enddo
525  else
526  !$omp parallel do
527  do j = 1, ja_org
528  do i = 1, ia_org
529  u_org(2,i,j) = undef
530  enddo
531  enddo
532  end if
533 
534  ! V10
535  call read2d( start(2:), count(2:), work2d(:,:), "V10", file_id_atm, basename_num, exist=exist, step=nt )
536  if ( exist ) then
537  !$omp parallel do
538  do j = 1, ja_org
539  do i = 1, ia_org
540  v_org(2,i,j) = work2d(i,j)
541  enddo
542  enddo
543  else
544  !$omp parallel do
545  do j = 1, ja_org
546  do i = 1, ia_org
547  v_org(2,i,j) = undef
548  enddo
549  enddo
550  end if
551 
552  ! T2
553  call read2d( start(2:), count(2:), work2d(:,:), "T2", file_id_atm, basename_num, exist=exist, step=nt )
554  if ( exist ) then
555  !$omp parallel do
556  do j = 1, ja_org
557  do i = 1, ia_org
558  temp_org(2,i,j) = work2d(i,j)
559  enddo
560  enddo
561  else
562  !$omp parallel do
563  do j = 1, ja_org
564  do i = 1, ia_org
565  temp_org(2,i,j) = undef
566  enddo
567  enddo
568  end if
569 
570  ! Q2, RH2
571  if ( rh2qv ) then
572  call read2d( start(2:), count(2:), work2d(:,:), "RH2", file_id_atm, basename_num, exist=exist, step=nt )
573  if ( exist ) then
574  !$omp parallel do
575  do j = 1, ja_org
576  do i = 1, ia_org
577  rh_org(2,i,j) = work2d(i,j)
578  enddo
579  enddo
580  else
581  !$omp parallel do
582  do j = 1, ja_org
583  do i = 1, ia_org
584  rh_org(2,i,j) = undef
585  enddo
586  enddo
587  end if
588  else
589  call read2d( start(2:), count(2:), work2d(:,:), "Q2", file_id_atm, basename_num, exist=exist, step=nt )
590  if ( exist ) then
591  !$omp parallel do
592  do j = 1, ja_org
593  do i = 1, ia_org
594  qv_org(2,i,j) = work2d(i,j)
595  enddo
596  enddo
597  else
598  !$omp parallel do
599  do j = 1, ja_org
600  do i = 1, ia_org
601  qv_org(2,i,j) = undef
602  enddo
603  enddo
604  end if
605 
606  end if
607 
608  ! topo
609  coef = 1.0_rp
610  call read2d( start(2:), count(2:), work2d(:,:), "topo", file_id_atm, basename_num, exist=exist, step=nt )
611  if ( .not. exist ) then
612  ! surface geopotential
613  coef = 1.0_rp / grav
614  call read2d( start(2:), count(2:), work2d(:,:), "SGP", file_id_atm, basename_num, exist=exist, step=nt )
615  end if
616  if ( exist ) then
617  !$omp parallel do
618  do j = 1, ja_org
619  do i = 1, ia_org
620  cz_org(2,i,j) = work2d(i,j) * coef
621  enddo
622  enddo
623  else
624  !$omp parallel do
625  do j = 1, ja_org
626  do i = 1, ia_org
627  cz_org(2,i,j) = undef
628  enddo
629  enddo
630  end if
631 
632  end if
633 
634  return
635  end subroutine parentatmosinputgrads
636 
637  !-----------------------------------------------------------------------------
639  subroutine parentlandsetupgrads( &
640  ldims, &
641  timelen, &
642  lon_all, lat_all, &
643  basename, &
644  basename_num )
645  use scale_const, only: &
646  d2r => const_d2r
647  use scale_file_grads, only: &
648  file_grads_open, &
649  file_grads_get_shape, &
650  file_grads_varid, &
651  file_grads_isoned
652  implicit none
653  integer, intent(out) :: ldims(3)
654  integer, intent(out) :: timelen
655  real(rp), allocatable, intent(out) :: lon_all(:,:)
656  real(rp), allocatable, intent(out) :: lat_all(:,:)
657 
658  character(len=*), intent(in) :: basename
659  character(len=*), intent(in) :: basename_num
660 
661  character(len=7) :: vname
662  integer :: vid
663  integer :: shape(2)
664  logical :: exist
665  !---------------------------------------------------------------------------
666 
667  log_info("ParentLandSetupGrADS",*) 'Real Case/Land Input File Type: GrADS format'
668 
669 
670  if ( basename == "" ) then
671  log_error("ParentLandSetupGrADS",*) '"BASENAME_ORG" is not specified in "PARAM_MKINIT_REAL_LAND"!', trim(basename)
672  call prc_abort
673  endif
674 
675  ! open
676  call file_grads_open( basename, & ! (in)
677  file_id_lnd ) ! (out)
678 
679  ! get shape
680  call file_grads_varid( file_id_lnd, "LAND_SFC_TEMP", & ! (in)
681  vid ) ! (out)
682  if ( vid < 0 ) then
683  call file_grads_varid( file_id_lnd, "LAND_TEMP", & ! (in)
684  vid ) ! (out)
685  end if
686  if ( vid < 0 ) then
687  call file_grads_varid( file_id_lnd, "SFC_TEMP", & ! (in)
688  vid ) ! (out)
689  end if
690  if ( vid < 0 ) then
691  call file_grads_varid( file_id_lnd, "STEMP", & ! (in)
692  vid ) ! (out)
693  end if
694  if ( vid < 0 ) then
695  log_error("ParentLandSetupGrADS",*) '"LAND_SFC_TEMP", "LAND_TEMP", "SFC_TEMP" or "STEMP" is necessary'
696  call prc_abort
697  end if
698  call file_grads_get_shape( file_id_lnd, vid, & ! (in)
699  ldims(:) ) ! (out)
700 
701 
702  ! get lon, lat
703  allocate( lon_all(ldims(2), ldims(3)) )
704  allocate( lat_all(ldims(2), ldims(3)) )
705 
706 
707  call file_grads_varid( file_id_lnd, "lon_sfc", & ! (in)
708  vid ) ! (out)
709  if ( vid > 0 ) then
710  vname = "lon_sfc"
711  else
712  call file_grads_varid( file_id_lnd, "lon", & ! (in)
713  vid ) ! (out)
714  if ( vid < 0 ) then
715  log_error("ParentLandSetupGrADS",*) '"lon_sfc" or "lon" is necessary'
716  call prc_abort
717  end if
718  call file_grads_get_shape( file_id_lnd, vid, & ! (in)
719  shape(:) ) ! (out)
720  if ( file_grads_isoned( file_id_lnd, vid ) ) then
721  if ( ldims(2) .ne. shape(1) .and. shape(1) .ne. -1 ) then
722  log_error("ParentLandSetupGrADS",*) 'dimension of "lon" is different! ', ldims(2), shape(1)
723  call prc_abort
724  end if
725  else
726  if ( ldims(2) .ne. shape(1) .or. ldims(3) .ne. shape(2) ) then
727  log_error("ParentLandSetupGrADS",*) 'dimension of "lon" is different! ', ldims(2), shape(1), ldims(3), shape(2)
728  call prc_abort
729  end if
730  end if
731  vname = "lon"
732  end if
733  call read2d( (/1,1/), ldims(2:3), lon_all(:,:), vname, file_id_lnd, basename_num, oned=1 )
734  lon_all(:,:) = lon_all(:,:) * d2r
735 
736 
737  call file_grads_varid( file_id_lnd, "lat_sfc", & ! (in)
738  vid ) ! (out)
739  if ( vid > 0 ) then
740  vname = "lat_sfc"
741  else
742  call file_grads_varid( file_id_lnd, "lat", & ! (in)
743  vid ) ! (out)
744  if ( vid < 0 ) then
745  log_error("ParentLandSetupGrADS",*) '"lat_sfc" or "lat" is necessary'
746  call prc_abort
747  end if
748  call file_grads_get_shape( file_id_lnd, vid, & ! (in)
749  shape(:) ) ! (out)
750  if ( file_grads_isoned( file_id_lnd, vid ) ) then
751  if ( ldims(3) .ne. shape(1) .and. shape(1) .ne. -1 ) then
752  log_error("ParentLandSetupGrADS",*) 'dimension of "lat" is different! ', ldims(2), shape(1)
753  call prc_abort
754  end if
755  else
756  if ( ldims(2) .ne. shape(1) .or. ldims(3) .ne. shape(2) ) then
757  log_error("ParentLandSetupGrADS",*) 'dimension of "lat" is different! ', ldims(2), shape(1), ldims(3), shape(2)
758  call prc_abort
759  end if
760  end if
761  vname = "lat"
762  end if
763  call read2d( (/1,1/), ldims(2:3), lat_all(:,:), vname, file_id_atm, basename_num, oned=2 )
764  lat_all(:,:) = lat_all(:,:) * d2r
765 
766 
767  ! tentative
768  timelen = 1
769 
770 
771  return
772  end subroutine parentlandsetupgrads
773 
774  subroutine parentlandinputgrads( &
775  KA_org, KS_org, KE_org, &
776  IA_org, IS_org, IE_org, &
777  JA_org, JS_org, JE_org, &
778  tg_org, & ! (out)
779  strg_org, & ! (out)
780  smds_org, & ! (out)
781  lst_org, & ! (out)
782  lz_org, & ! (out)
783  topo_org, & ! (out)
784  lmask_org, & ! (out)
785  use_waterratio, & ! (out)
786  ldims, & ! (in)
787  basename_num, & ! (in)
788  use_file_landwater, & ! (in)
789  nt ) ! (in)
790  use scale_prc, only: &
791  prc_abort
792  use scale_const, only: &
793  undef => const_undef, &
794  d2r => const_d2r, &
795  grav => const_grav, &
796  tem00 => const_tem00, &
797  eps => const_eps
798  use scale_file_grads, only: &
799  file_grads_varcheck, &
800  file_grads_get_shape, &
801  file_grads_read
802  implicit none
803  integer, intent(in) :: ka_org, ks_org, ke_org
804  integer, intent(in) :: ia_org, is_org, ie_org
805  integer, intent(in) :: ja_org, js_org, je_org
806 
807  real(rp), intent(out) :: tg_org (ka_org,ia_org,ja_org)
808  real(rp), intent(out) :: strg_org (ka_org,ia_org,ja_org)
809  real(rp), intent(out) :: smds_org (ka_org,ia_org,ja_org)
810  real(rp), intent(out) :: lst_org (ia_org,ja_org)
811  real(rp), intent(out) :: lz_org (ka_org)
812  real(rp), intent(out) :: topo_org (ia_org,ja_org)
813  real(rp), intent(out) :: lmask_org(ia_org,ja_org)
814  logical, intent(out) :: use_waterratio
815 
816  integer, intent(in) :: ldims(3)
817  character(len=*), intent(in) :: basename_num
818  logical, intent(in) :: use_file_landwater ! use land water data from files
819  integer, intent(in) :: nt
820 
821  integer :: start(3), count(3), shape(2)
822  logical :: exist
823 
824  integer :: vid
825  integer :: i, j, k
826  !---------------------------------------------------------------------------
827 
828  start(:) = (/ks_org,is_org,js_org/)
829  count(:) = (/ka_org,ia_org,ja_org/)
830 
831  ! lsmask
832  call read2d( start(2:), count(2:), lmask_org(:,:), "lsmask", file_id_lnd, basename_num, exist=exist, step=nt )
833  if ( .not. exist ) then
834  !$omp parallel do
835  do j = 1, ja_org
836  do i = 1, ia_org
837  lmask_org(i,j) = undef
838  end do
839  end do
840  end if
841 
842  ! llev
843  call file_grads_get_shape( file_id_lnd, "llev", & ! (in)
844  shape(:) ) ! (out)
845  if ( ldims(1) .ne. shape(1) )then
846  log_error("ParentLandInputGrADS",*) '"nz" must be equal to nz of "STEMP" for llev. :', shape(1), ldims(1)
847  call prc_abort
848  endif
849  call file_grads_read( file_id_lnd, "llev", & ! (in)
850  lz_org(:) ) ! (out)
851 
852  ! LAND_TEMP, STEMP
853  call read3d( start(:), count(:), tg_org(:,:,:), "LAND_TEMP", file_id_lnd, basename_num, exist=exist, step=nt )
854  if ( .not. exist ) then
855  call read3d( start(:), count(:), tg_org(:,:,:), "STEMP", file_id_lnd, basename_num, exist=exist )
856  end if
857  if ( .not. exist ) then
858  log_error("ParentAtmosInputGrADS",*) '"LAND_TEMP" or "STEMP" is necessary'
859  call prc_abort
860  endif
861 
862  if ( use_file_landwater ) then
863  ! LAND_WATER, SMOISVC, SMOISDS
864  call read3d( start(:), count(:), strg_org(:,:,:), "LAND_WATER", file_id_lnd, basename_num, exist=exist, step=nt )
865  if ( .not. exist ) then
866  call read3d( start(:), count(:), strg_org(:,:,:), "SMOISVC", file_id_lnd, basename_num, exist=exist, step=nt )
867  end if
868  if ( exist ) then
869  !$omp parallel do collapse(2)
870  do j = 1, ja_org
871  do i = 1, ia_org
872  do k = 2, ka_org
873  if ( strg_org(k,i,j) == undef ) strg_org(k,i,j) = strg_org(k-1,i,j)
874  end do
875  end do
876  end do
877  use_waterratio = .false.
878  else
879  call read3d( start(:), count(:), smds_org(:,:,:), "SMOISDS", file_id_lnd, basename_num, exist=exist, step=nt )
880  if ( exist ) then
881  !$omp parallel do collapse(2)
882  do j = 1, ja_org
883  do i = 1, ia_org
884  do k = 2, ka_org
885  if ( smds_org(k,i,j) == undef ) smds_org(k,i,j) = smds_org(k-1,i,j)
886  end do
887  end do
888  end do
889  use_waterratio = .true.
890  else
891  log_error("ParentAtmosInputGrADS",*) '"LAND_WATER", "SMOISVC", or "SMOISDS" is necessary'
892  call prc_abort
893  end if
894  endif
895 
896  end if ! use_file_landwater
897 
898 
899  ! LAND_SFC_TEMP, SFC_TEMP, SKINT
900  call read2d( start(2:), count(2:), lst_org(:,:), "LAND_SFC_TEMP", file_id_lnd, basename_num, exist=exist, step=nt )
901  if ( .not. exist ) then
902  call read2d( start(2:), count(2:), lst_org(:,:), "SFC_TEMP", file_id_lnd, basename_num, exist=exist )
903  end if
904  if ( .not. exist ) then
905  call read2d( start(2:), count(2:), lst_org(:,:), "SKINT", file_id_lnd, basename_num, exist=exist )
906  end if
907  if ( .not. exist ) then
908  log_error("ParentAtmosInputGrADS",*) '"LAND_SFC_TEMP", "SFC_TEMP", or "SKINT" is necessary'
909  call prc_abort
910  endif
911 
912 
913  ! topo_sfc, topo, SGP
914 
915  call read2d( start(2:), count(2:), topo_org(:,:), "topo_sfc", file_id_lnd, basename_num, exist=exist, step=nt )
916  if ( .not. exist ) then
917  call file_grads_varcheck( file_id_lnd, "topo", & ! (in)
918  exist ) ! (out)
919  if ( exist ) then
920  call file_grads_get_shape( file_id_lnd, "topo", & ! (in)
921  shape(:) ) ! (out)
922  if ( ldims(2).ne.shape(1) .or. ldims(3).ne.shape(2) ) then
923  log_warn_cont(*) 'dimension of "topo" is different! ', ldims(2), shape(1), ldims(3), shape(2)
924  exist = .false.
925  else
926  call read2d( start(2:), count(2:), topo_org(:,:), "topo", file_id_lnd, basename_num, exist=exist )
927  end if
928  end if
929  end if
930  if ( .not. exist ) then
931  call file_grads_varcheck( file_id_lnd, "SGP", & ! (in)
932  exist ) ! (out)
933  if ( exist ) then
934  call file_grads_get_shape( file_id_lnd, "SGP", & ! (in)
935  shape(:) ) ! (out)
936  if ( ldims(2).ne.shape(1) .or. ldims(3).ne.shape(2) ) then
937  log_warn_cont(*) 'dimension of "SGP" is different! ', ldims(2), shape(1), ldims(3), shape(2)
938  exist = .false.
939  else
940  call read2d( start(2:), count(2:), topo_org(:,:), "SGP", file_id_lnd, basename_num, exist=exist )
941  !$omp parallel do
942  do j = 1, ja_org
943  do i = 1, ia_org
944  topo_org(i,j) = topo_org(i,j) / grav
945  end do
946  end do
947  end if
948  end if
949  end if
950  if ( .not. exist ) then
951  log_warn("ParentLandInputGrADS",*) '"topo_sfc", "topo", or "SGP" is not found in grads namelist'
952  end if
953 
954  return
955  end subroutine parentlandinputgrads
956 
957  !-----------------------------------------------------------------------------
959  subroutine parentoceansetupgrads( &
960  odims, & ! (out)
961  timelen, & ! (out)
962  lon_all, lat_all, & ! (out)
963  basename, & ! (in)
964  basename_num ) ! (in)
965  use scale_const, only: &
966  d2r => const_d2r
967  use scale_file_grads, only: &
968  file_grads_open, &
969  file_grads_varid, &
970  file_grads_get_shape, &
971  file_grads_isoned
972  implicit none
973 
974  integer, intent(out) :: odims(2)
975  integer, intent(out) :: timelen
976  real(rp), allocatable, intent(out) :: lon_all(:,:)
977  real(rp), allocatable, intent(out) :: lat_all(:,:)
978 
979  character(len=*), intent(in) :: basename
980  character(len=*), intent(in) :: basename_num
981 
982  character(len=7) :: vname
983  integer :: vid
984  integer :: shape(2)
985  logical :: exist
986  !---------------------------------------------------------------------------
987 
988  log_info("ParentOceanSetupGrADS",*) 'Real Case/Ocean Input File Type: GrADS format'
989 
990  if ( basename == "" ) then
991  log_error("ParentOceanSetupGrADS",*) '"BASENAME_ORG" is not specified in "PARAM_MKINIT_REAL_OCEAN"!', trim(basename)
992  call prc_abort
993  endif
994  call file_grads_open( basename, & ! (in)
995  file_id_ocn ) ! (out)
996 
997  call file_grads_varid( file_id_ocn, "OCEAN_SFC_TEMP", & ! (in)
998  vid ) ! (out)
999  if ( vid < 0 ) then
1000  call file_grads_varid( file_id_ocn, "SST", & ! (in)
1001  vid ) ! (out)
1002  end if
1003  if ( vid < 0 ) then
1004  call file_grads_varid( file_id_ocn, "SFC_TEMP", & ! (in)
1005  vid ) ! (out)
1006  end if
1007  if ( vid < 0 ) then
1008  call file_grads_varid( file_id_ocn, "SKINT", & ! (in)
1009  vid ) ! (out)
1010  end if
1011  if ( vid < 0 ) then
1012  log_error("ParentOceanSetupGrADS",*) '"OCEAN_SFC_TEMP", "SST", "SFC_TEMP", or "SKINT" is necessary'
1013  call prc_abort
1014  end if
1015 
1016  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1017  odims(:) ) ! (out)
1018 
1019 
1020  ! get lon, lat
1021 
1022  allocate( lon_all(odims(1), odims(2)) )
1023  allocate( lat_all(odims(1), odims(2)) )
1024 
1025 
1026  call file_grads_varid( file_id_ocn, "lon_sst", & ! (in)
1027  vid ) ! (out)
1028  if ( vid > 0 ) then
1029  vname = "lon_sst"
1030  else
1031  call file_grads_varid( file_id_ocn, "lon_sfc", & ! (in)
1032  vid ) ! (out)
1033  if ( vid > 0 ) then
1034  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1035  shape(:) ) ! (out)
1036  if ( file_grads_isoned( file_id_lnd, vid ) ) then
1037  if ( odims(1) .eq. shape(1) .or. shape(1) .eq. -1 ) then
1038  vname = "lon_sfc"
1039  else
1040  vid = -1
1041  end if
1042  else
1043  if ( odims(1) .eq. shape(1) .and. odims(2) .eq. shape(2) ) then
1044  vname = "lon_sfc"
1045  else
1046  vid = -1
1047  end if
1048  end if
1049  end if
1050  end if
1051  if ( vid < 0 ) then
1052  call file_grads_varid( file_id_ocn, "lon", & ! (in)
1053  vid ) ! (out)
1054  if ( vid < 0 ) then
1055  log_error("ParentLandSetupGrADS",*) '"lon_sst", "lon_sfc", or "lon" is necessary'
1056  call prc_abort
1057  end if
1058  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1059  shape(:) ) ! (out)
1060  if ( file_grads_isoned( file_id_ocn, vid ) ) then
1061  if ( odims(1) .eq. shape(1) .or. shape(1) .eq. -1 ) then
1062  vname = "lon"
1063  else
1064  vid = -1
1065  end if
1066  else
1067  if ( odims(1) .eq. shape(1) .and. odims(2) .eq. shape(2) ) then
1068  vname = "lon"
1069  else
1070  vid = -1
1071  end if
1072  end if
1073  if ( vid < 0 ) then
1074  log_error("ParentOceanSetupGrADS",*) 'dimension of "lon_sfc" and "lon" is different! ', odims(:), shape(:)
1075  call prc_abort
1076  end if
1077  end if
1078  call read2d( (/1,1/), odims(:), lon_all(:,:), vname, file_id_ocn, basename_num, oned=1 )
1079  lon_all(:,:) = lon_all(:,:) * d2r
1080 
1081 
1082  call file_grads_varid( file_id_ocn, "lat_sst", & ! (in)
1083  vid ) ! (out)
1084  if ( vid > 0 ) then
1085  vname = "lat_sst"
1086  else
1087  call file_grads_varid( file_id_ocn, "lat_sfc", & ! (in)
1088  vid ) ! (out)
1089  if ( vid > 0 ) then
1090  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1091  shape(:) ) ! (out)
1092  if ( file_grads_isoned( file_id_lnd, vid ) ) then
1093  if ( odims(2) .eq. shape(1) .or. shape(1) .eq. -1 ) then
1094  vname = "lat_sfc"
1095  else
1096  vid = -1
1097  end if
1098  else
1099  if ( odims(1) .eq. shape(1) .and. odims(2) .eq. shape(2) ) then
1100  vname = "lat_sfc"
1101  else
1102  vid = -1
1103  end if
1104  end if
1105  end if
1106  end if
1107  if ( vid < 0 ) then
1108  call file_grads_varid( file_id_lnd, "lat", & ! (in)
1109  vid ) ! (out)
1110  if ( vid < 0 ) then
1111  log_error("ParentLandSetupGrADS",*) '"lat_sst", "lat_sfc", or "lat" is necessary'
1112  call prc_abort
1113  end if
1114  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1115  shape(:) ) ! (out)
1116  if ( file_grads_isoned( file_id_lnd, vid ) ) then
1117  if ( odims(2) .eq. shape(1) .or. shape(1) .eq. -1 ) then
1118  vname = "lat"
1119  else
1120  vid = -1
1121  end if
1122  else
1123  if ( odims(1) .eq. shape(1) .and. odims(2) .eq. shape(2) ) then
1124  vname = "lat"
1125  else
1126  vid = -1
1127  end if
1128  end if
1129  if ( vid < 0 ) then
1130  log_error("ParentOceanSetupGrADS",*) 'dimension of "lat_sfc" and "lat" is different! ', odims(:), shape(:)
1131  call prc_abort
1132  end if
1133  end if
1134  call read2d( (/1,1/), odims(:), lat_all(:,:), vname, file_id_ocn, basename_num, oned=2 )
1135  lat_all(:,:) = lat_all(:,:) * d2r
1136 
1137 
1138  ! tentative
1139  timelen = 1
1140 
1141  return
1142  end subroutine parentoceansetupgrads
1143 
1144  !-----------------------------------------------------------------------------
1145  subroutine parentoceaninputgrads( &
1146  IA_org, IS_org, IE_org, &
1147  JA_org, JS_org, JE_org, &
1148  tw_org, &
1149  sst_org, &
1150  omask_org, &
1151  basename_num, &
1152  odims, &
1153  nt )
1154  use scale_const, only: &
1155  undef => const_undef, &
1156  d2r => const_d2r, &
1157  tem00 => const_tem00, &
1158  eps => const_eps
1159  use scale_file_grads, only: &
1160  file_grads_get_shape, &
1161  file_grads_varid, &
1162  file_grads_read
1163  implicit none
1164  integer, intent(in) :: ia_org, is_org, ie_org
1165  integer, intent(in) :: ja_org, js_org, je_org
1166 
1167  real(rp), intent(out) :: tw_org (ia_org,ja_org)
1168  real(rp), intent(out) :: sst_org (ia_org,ja_org)
1169  real(rp), intent(out) :: omask_org(ia_org,ja_org)
1170 
1171  character(len=*), intent(in) :: basename_num
1172  integer, intent(in) :: odims(2)
1173  integer, intent(in) :: nt
1174 
1175  integer :: start(2), count(2), shape(2)
1176  integer :: vid
1177  logical :: exist
1178  integer :: i, j
1179  !---------------------------------------------------------------------------
1180 
1181 
1182  start(:) = (/is_org,js_org/)
1183  count(:) = (/ia_org,ja_org/)
1184 
1185  ! lsmask
1186  call read2d( start(:), count(:), omask_org(:,:), "lsmask_sst", file_id_ocn, basename_num, exist=exist, step=nt )
1187  if ( .not. exist ) then
1188  call file_grads_varid( file_id_ocn, "lsmask", & ! (in)
1189  vid ) ! (out)
1190  if ( vid > 0 ) then
1191  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1192  shape(:) ) ! (out)
1193  if ( odims(1) .ne. shape(1) .or. odims(2) .ne. shape(2) ) then
1194  log_warn("ParentOceanInputGrADS",*) 'dimension of lsmask is different. not use'
1195  else
1196  call read2d( start(:), count(:), omask_org(:,:), "lsmask", file_id_ocn, basename_num, exist=exist, step=nt )
1197  end if
1198  end if
1199  end if
1200  if ( .not. exist ) then
1201  !$omp parallel do
1202  do j = 1, ja_org
1203  do i = 1, ia_org
1204  omask_org(i,j) = undef
1205  end do
1206  end do
1207  end if
1208 
1209  ! OCEAN_SFC_TEMP, SST, SFC_TEMP, SKINT
1210  call read2d( start(:), count(:), sst_org(:,:), "OCEAN_SFC_TEMP", file_id_ocn, basename_num, exist=exist, step=nt )
1211  if ( .not. exist ) then
1212  call read2d( start(:), count(:), sst_org(:,:), "SST", file_id_ocn, basename_num, exist=exist, step=nt )
1213  end if
1214  if ( .not. exist ) then
1215  call file_grads_varid( file_id_ocn, "SFC_TEMP", & ! (in)
1216  vid ) ! (out)
1217  if ( vid > 0 ) then
1218  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1219  shape(:) ) ! (out)
1220  if ( odims(1).eq.shape(1) .and. odims(2).eq.shape(2) ) then
1221  call read2d( start(:), count(:), sst_org(:,:), "SFC_TEMP", file_id_ocn, basename_num, exist=exist, step=nt )
1222  else
1223  exist = .false.
1224  end if
1225  else
1226  exist = .false.
1227  end if
1228  end if
1229  if ( .not. exist ) then
1230  call file_grads_varid( file_id_ocn, "SKINT", & ! (in)
1231  vid ) ! (out)
1232  call file_grads_get_shape( file_id_ocn, vid, & ! (in)
1233  shape(:) ) ! (out)
1234  if ( odims(1).eq.shape(1) .and. odims(2).eq.shape(2) ) then
1235  call read2d( start(:), count(:), sst_org(:,:), "SKINT", file_id_ocn, basename_num, step=nt )
1236  else
1237  log_error("ParentOceanInputGrADS",*) 'dimension of "SFC_TEMP" and/or "SKINT" is different'
1238  call prc_abort
1239  end if
1240  end if
1241 
1242  tw_org = sst_org
1243 
1244  return
1245  end subroutine parentoceaninputgrads
1246 
1247  ! private
1248 
1249  subroutine read2d( start, count, data, name, fid, postfix, exist, oneD, step )
1250  use scale_file_grads, only: &
1251  file_grads_varid, &
1252  file_grads_read, &
1253  file_grads_isoned
1254  integer, intent(in) :: start(2)
1255  integer, intent(in) :: count(2)
1256  real(RP), intent(out) :: data(count(1),count(2))
1257  character(len=*), intent(in) :: name
1258  integer, intent(in) :: fid
1259  character(len=*), intent(in) :: postfix
1260 
1261  logical, intent(out), optional :: exist
1262  integer, intent(in), optional :: oneD
1263  integer, intent(in), optional :: step
1264 
1265  integer :: vid
1266  real(RP), allocatable :: v1d(:)
1267  integer :: oneD_
1268  integer :: i, j
1269 
1270  call file_grads_varid( fid, name, & ! (in)
1271  vid ) ! (out)
1272  if ( vid < 0 ) then
1273  if ( present(exist) ) then
1274  exist = .false.
1275  return
1276  end if
1277  log_error("read2d",*) '"', trim(name), '" is required'
1278  call prc_abort
1279  end if
1280  if ( present(exist) ) exist = .true.
1281 
1282  if( file_grads_isoned( fid, vid ) ) then
1283  if ( present(oned) ) then
1284  oned_ = oned
1285  else
1286  oned_ = 1
1287  end if
1288  allocate( v1d(count(oned_)) )
1289  call file_grads_read( fid, vid, & ! (in)
1290  v1d(:), & ! (out)
1291  step=step, & ! (in)
1292  start=start(oned_:oned_), & ! (in)
1293  count=count(oned_:oned_) ) ! (in)
1294  if ( oned_ == 1 ) then
1295  !$omp parallel do
1296  do j = 1, count(2)
1297  do i = 1, count(1)
1298  data(i,j) = v1d(i)
1299  enddo
1300  enddo
1301  else
1302  !$omp parallel do
1303  do j = 1, count(2)
1304  do i = 1, count(1)
1305  data(i,j) = v1d(j)
1306  enddo
1307  enddo
1308  end if
1309  deallocate( v1d )
1310  else
1311  call file_grads_read( fid, vid, & ! (in)
1312  data(:,:), & ! (out)
1313  step=step, & ! (in)
1314  start=start(:), & ! (in)
1315  count=count(:), & ! (in)
1316  postfix=postfix ) ! (in)
1317  end if
1318 
1319  return
1320  end subroutine read2d
1321 
1322  subroutine read3d( start, count, data, name, fid, postfix, exist, step )
1323  use scale_file_grads, only: &
1324  file_grads_varid, &
1325  file_grads_read, &
1326  file_grads_isoned
1327  integer, intent(in) :: start(3)
1328  integer, intent(in) :: count(3)
1329  real(RP), intent(out) :: data(count(1),count(2),count(3))
1330  character(len=*), intent(in) :: name
1331  integer, intent(in) :: fid
1332  character(len=*), intent(in) :: postfix
1333 
1334  logical, intent(out), optional :: exist
1335  integer, intent(in), optional :: step
1336 
1337  integer :: vid
1338  real(RP), allocatable :: v1d(:)
1339  integer :: k, i, j
1340 
1341  call file_grads_varid( fid, name, & ! (in)
1342  vid ) ! (out)
1343  if ( vid < 0 ) then
1344  if ( present(exist) ) then
1345  exist = .false.
1346  return
1347  end if
1348  log_error("read3d",*) '"', trim(name), '" is required'
1349  call prc_abort
1350  end if
1351  if ( present(exist) ) exist = .true.
1352 
1353  if( file_grads_isoned( fid, vid ) ) then
1354  allocate( v1d(count(1)) )
1355  call file_grads_read( fid, vid, & ! (in)
1356  v1d(:), & ! (out)
1357  step=step, &
1358  start=start(1:1), & ! (in)
1359  count=count(1:1) ) ! (in)
1360  !$omp parallel do collapse(2)
1361  do j = 1, count(3)
1362  do i = 1, count(2)
1363  do k = 1, count(1)
1364  data(k,i,j) = v1d(k)
1365  enddo
1366  enddo
1367  enddo
1368  deallocate( v1d )
1369  else
1370  call file_grads_read( fid, vid, & ! (in)
1371  data(:,:,:), & ! (out)
1372  step=step, & ! (in)
1373  start=start(:), & ! (in)
1374  count=count(:), & ! (in)
1375  postfix=postfix ) ! (in)
1376  end if
1377 
1378  return
1379  end subroutine read3d
1380 
1381 end module mod_realinput_grads
scale_const::const_grav
real(rp), public const_grav
standard acceleration of gravity [m/s2]
Definition: scale_const.F90:49
mod_atmos_phy_mp_vars
module Atmosphere / Physics Cloud Microphysics
Definition: mod_atmos_phy_mp_vars.F90:12
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_file_grads::file_grads_isoned
logical function, public file_grads_isoned(file_id, var_id)
Definition: scale_file_grads.F90:373
scale_const::const_epstvap
real(rp), public const_epstvap
1 / epsilon - 1
Definition: scale_const.F90:76
scale_tracer::qa
integer, public qa
Definition: scale_tracer.F90:35
scale_file_grads::file_grads_open
subroutine, public file_grads_open(file_name, file_id)
Open.
Definition: scale_file_grads.F90:104
scale_atmos_hydrometeor::hyd_name
character(len=h_short), dimension(n_hyd), parameter, public hyd_name
Definition: scale_atmos_hydrometeor.F90:104
scale_const::const_epsvap
real(rp), public const_epsvap
Rdry / Rvap.
Definition: scale_const.F90:75
scale_precision
module PRECISION
Definition: scale_precision.F90:14
mod_realinput_grads::parentoceansetupgrads
subroutine, public parentoceansetupgrads(odims, timelen, lon_all, lat_all, basename, basename_num)
Ocean Setup.
Definition: mod_realinput_grads.F90:965
mod_atmos_phy_mp_vars::qs_mp
integer, public qs_mp
Definition: mod_atmos_phy_mp_vars.F90:79
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
mod_realinput_grads::parentlandinputgrads
subroutine, public parentlandinputgrads(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tg_org, strg_org, smds_org, lst_org, lz_org, topo_org, lmask_org, use_waterratio, ldims, basename_num, use_file_landwater, nt)
Definition: mod_realinput_grads.F90:790
scale_atmos_hydrometeor
module atmosphere / hydrometeor
Definition: scale_atmos_hydrometeor.F90:12
scale_file_grads::file_grads_varcheck
subroutine, public file_grads_varcheck(file_id, var_name, exist)
Definition: scale_file_grads.F90:344
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:91
scale_file_grads::file_grads_varid
subroutine, public file_grads_varid(file_id, var_name, var_id)
Definition: scale_file_grads.F90:312
mod_realinput_grads::read2d
subroutine read2d(start, count, data, name, fid, postfix, exist, oneD, step)
Definition: mod_realinput_grads.F90:1250
scale_prc
module PROCESS
Definition: scale_prc.F90:11
scale_precision::rp
integer, parameter, public rp
Definition: scale_precision.F90:41
scale_io
module STDIO
Definition: scale_io.F90:10
scale_tracer::k
real(rp), public k
Definition: scale_tracer.F90:45
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_const::const_cpdry
real(rp), public const_cpdry
specific heat (dry air,constant pressure) [J/kg/K]
Definition: scale_const.F90:60
scale_tracer::tracer_name
character(len=h_short), dimension(qa_max), public tracer_name
Definition: scale_tracer.F90:39
scale_file_grads
module file_grads
Definition: scale_file_grads.F90:11
mod_realinput_grads::parentatmossetupgrads
subroutine, public parentatmossetupgrads(dims, timelen, qtrc_flag, LON_all, LAT_all, basename_org, basename_num)
Atmos Setup.
Definition: mod_realinput_grads.F90:62
scale_tracer
module TRACER
Definition: scale_tracer.F90:12
mod_realinput_grads
module REAL input GrADS
Definition: mod_realinput_grads.F90:11
mod_realinput_grads::parentlandsetupgrads
subroutine, public parentlandsetupgrads(ldims, timelen, lon_all, lat_all, basename, basename_num)
Land Setup.
Definition: mod_realinput_grads.F90:645
scale_const::const_tem00
real(rp), parameter, public const_tem00
temperature reference (0C) [K]
Definition: scale_const.F90:99
mod_realinput_grads::parentoceaninputgrads
subroutine, public parentoceaninputgrads(IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, tw_org, sst_org, omask_org, basename_num, odims, nt)
Definition: mod_realinput_grads.F90:1154
scale_const::const_rdry
real(rp), public const_rdry
specific gas constant (dry air) [J/kg/K]
Definition: scale_const.F90:59
mod_atmos_phy_mp_vars::qe_mp
integer, public qe_mp
Definition: mod_atmos_phy_mp_vars.F90:80
scale_const::const_d2r
real(rp), public const_d2r
degree to radian
Definition: scale_const.F90:33
mod_realinput_grads::parentatmosinputgrads
subroutine, public parentatmosinputgrads(KA_org, KS_org, KE_org, IA_org, IS_org, IE_org, JA_org, JS_org, JE_org, QA, w_org, u_org, v_org, pres_org, dens_org, pt_org, temp_org, qv_org, rh_org, qhyd_org, qtrc_org, cz_org, nopres, nodens, temp2pt, rh2qv, basename_num, sfc_diagnoses, nt)
Definition: mod_realinput_grads.F90:170
scale_const::const_laps
real(rp), public const_laps
lapse rate of ISA [K/m]
Definition: scale_const.F90:62
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
mod_realinput_grads::read3d
subroutine read3d(start, count, data, name, fid, postfix, exist, step)
Definition: mod_realinput_grads.F90:1323
scale_const::const_pre00
real(rp), public const_pre00
pressure reference [Pa]
Definition: scale_const.F90:97
scale_atmos_hydrometeor::n_hyd
integer, parameter, public n_hyd
Definition: scale_atmos_hydrometeor.F90:95
Generated by   doxygen 1.8.17