SCALE-RM
scale_file_external_input.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
13  !-----------------------------------------------------------------------------
14  !
15  !++ Used modules
16  !
17  use scale_precision
18  use scale_io
19  use scale_prof
20  !-----------------------------------------------------------------------------
21  implicit none
22  private
23  !-----------------------------------------------------------------------------
24  !
25  !++ Public procedures
26  !
28  public :: file_external_input_regist
29  public :: file_external_input_update
30  public :: file_external_input_put_ref
31  public :: file_external_input_get_ref
34 
35  interface file_external_input_regist
36  module procedure file_external_input_regist_file
40  end interface file_external_input_regist
41 
42  interface file_external_input_update
43  module procedure file_external_input_update_1d
44  module procedure file_external_input_update_2d
45  module procedure file_external_input_update_3d
46  end interface file_external_input_update
47 
48  interface file_external_input_put_ref
49  module procedure file_external_input_put_ref_1d
50  module procedure file_external_input_put_ref_2d
51  module procedure file_external_input_put_ref_3d
52  end interface file_external_input_put_ref
53 
54  interface file_external_input_get_ref
55  module procedure file_external_input_get_ref_1d
56  module procedure file_external_input_get_ref_2d
57  module procedure file_external_input_get_ref_3d
58  end interface file_external_input_get_ref
59 
60  abstract interface
61  subroutine get_dims1d( &
62  dim1_size, &
63  dim1_max, &
64  dim1_S, &
65  varname, &
66  axistype )
67  integer, intent(out) :: dim1_size
68  integer, intent(out) :: dim1_max
69  integer, intent(out) :: dim1_S
70  character(len=*), intent(in) :: varname
71  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
72  end subroutine get_dims1d
73 
74  subroutine get_dims2d( &
75  dim1_size, &
76  dim1_max, &
77  dim1_S, &
78  dim2_size, &
79  dim2_max, &
80  dim2_S, &
81  transpose, &
82  varname, &
83  axistype )
84  integer, intent(out) :: dim1_size
85  integer, intent(out) :: dim1_max
86  integer, intent(out) :: dim1_S
87  integer, intent(out) :: dim2_size
88  integer, intent(out) :: dim2_max
89  integer, intent(out) :: dim2_S
90  logical, intent(out) :: transpose
91  character(len=*), intent(in) :: varname
92  character(len=*), intent(in) :: axistype ! axis type (XY/XZ/ZX)
93  end subroutine get_dims2d
94 
95  subroutine get_dims3d( &
96  dim1_size, &
97  dim1_max, &
98  dim1_S, &
99  dim2_size, &
100  dim2_max, &
101  dim2_S, &
102  dim3_size, &
103  dim3_max, &
104  dim3_S, &
105  transpose, &
106  varname, &
107  axistype )
108  integer, intent(out) :: dim1_size
109  integer, intent(out) :: dim1_max
110  integer, intent(out) :: dim1_S
111  integer, intent(out) :: dim2_size
112  integer, intent(out) :: dim2_max
113  integer, intent(out) :: dim2_S
114  integer, intent(out) :: dim3_size
115  integer, intent(out) :: dim3_max
116  integer, intent(out) :: dim3_S
117  logical, intent(out) :: transpose
118  character(len=*), intent(in) :: varname
119  character(len=*), intent(in) :: axistype ! axis type (ZXY/XYZ/Land/Urban)
120  end subroutine get_dims3d
121 
122  subroutine read1d( fid, varname, dim_type, &
123  var, &
124  step )
125  use scale_precision
126  integer, intent(in) :: fid
127  character(len=*), intent(in) :: varname
128  character(len=*), intent(in) :: dim_type
129  real(RP), intent(out) :: var(:)
130  integer, intent(in), optional :: step
131  end subroutine read1d
132 
133  subroutine read2d( fid, varname, dim_type, &
134  var, &
135  step )
136  use scale_precision
137  integer, intent(in) :: fid
138  character(len=*), intent(in) :: varname
139  character(len=*), intent(in) :: dim_type
140  real(RP), intent(out) :: var(:,:)
141  integer, intent(in), optional :: step
142  end subroutine read2d
143 
144  subroutine read3d( fid, varname, dim_type, &
145  var, &
146  step )
147  use scale_precision
148  integer, intent(in) :: fid
149  character(len=*), intent(in) :: varname
150  character(len=*), intent(in) :: dim_type
151  real(RP), intent(out) :: var(:,:,:)
152  integer, intent(in), optional :: step
153  end subroutine read3d
154 
155  end interface
156 
157  procedure(get_dims1d), pointer :: file_external_input_get_dims1d => null()
158  procedure(get_dims2d), pointer :: file_external_input_get_dims2d => null()
159  procedure(get_dims3d), pointer :: file_external_input_get_dims3d => null()
163 
164  procedure(read1d), pointer :: file_external_input_read_1d => null()
165  procedure(read2d), pointer :: file_external_input_read_2d => null()
166  procedure(read3d), pointer :: file_external_input_read_3d => null()
170  !-----------------------------------------------------------------------------
171  !
172  !++ Public parameters & variables
173  !
174  integer, public, parameter :: i_prev = 1
175  integer, public, parameter :: i_next = 2
176 
177  !-----------------------------------------------------------------------------
178  !
179  !++ Private procedures
180  !
181  private :: file_external_input_query_id
182  private :: file_external_input_time_advance
183  private :: file_external_input_init_var
184  private :: file_external_input_regist_var
185 
186  !-----------------------------------------------------------------------------
187  !
188  !++ Private parameters & variables
189  !
190  integer, private, parameter :: i_periodic_year = 1
191  integer, private, parameter :: i_periodic_month = 2
192  integer, private, parameter :: i_periodic_day = 3
193 
194  integer, private, parameter :: file_external_input_item_limit = 1000
195  integer, private, parameter :: file_external_input_step_limit = 10000
196  integer, private, parameter :: file_external_input_dim_limit = 3
197  integer, private, parameter :: file_external_input_att_limit = 10
198 
199  type, private :: itemcontainer
200  character(len=H_SHORT) :: varname
201  logical :: file
202  integer :: nfile
203  integer :: file_current
204  character(len=H_LONG), allocatable :: basename(:)
205  integer :: fid
206  integer :: ndim
207  integer :: dim_size(file_external_input_dim_limit)
208  integer :: dim_start(file_external_input_dim_limit)
209  integer :: dim_max(file_external_input_dim_limit)
210  integer :: var_size(file_external_input_dim_limit)
211  integer :: var_start(file_external_input_dim_limit)
212  integer :: var_max(file_external_input_dim_limit)
213  integer :: step_limit
214  integer :: step_num
215  real(dp), allocatable :: time(:)
216  logical :: fixed_step
217  integer :: flag_periodic
218  integer :: data_step_prev
219  integer :: data_step_next
220  integer :: data_step_offset
221  real(rp), allocatable :: value(:,:,:,:)
222  character(len=H_SHORT) :: axistype
223  logical :: transpose
224  logical :: aggregate
225  logical :: allow_missing
226  end type itemcontainer
227 
228  integer, private :: file_external_input_item_count = 0
229  type(itemcontainer), private :: file_external_input_item(file_external_input_item_limit)
230 
231  !-----------------------------------------------------------------------------
232 contains
233  !-----------------------------------------------------------------------------
235  subroutine file_external_input_setup
236  use scale_prc, only: &
237  prc_abort
238  use scale_const, only: &
239  undef => const_undef
240  use scale_file, only: &
241  file_aggregate_default => file_aggregate
242  implicit none
243 
244  character(len=H_LONG) :: basename
245  logical :: basename_add_num
246  integer :: number_of_files
247  character(len=H_SHORT) :: varname
248  character(len=H_SHORT) :: axistype
249  integer :: step_limit ! limit number for reading data
250  integer :: step_fixed ! fixed step position to read
251  logical :: enable_periodic_year ! treat as yearly periodic data?
252  logical :: enable_periodic_month ! treat as yearly,monthly periodic data?
253  logical :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
254  real(rp) :: defval
255  logical :: check_coordinates
256  logical :: file_aggregate
257  logical :: allow_missing
258 
259  namelist / external_item / &
260  basename, &
261  basename_add_num, &
262  number_of_files, &
263  varname, &
264  axistype, &
265  step_limit, &
266  step_fixed, &
267  enable_periodic_year, &
268  enable_periodic_month, &
269  enable_periodic_day, &
270  defval, &
271  check_coordinates, &
272  file_aggregate, &
273  allow_missing
274 
275  integer :: count
276  integer :: ierr
277  !---------------------------------------------------------------------------
278 
279  log_newline
280  log_info("FILE_EXTERNAL_INPUT_setup",*) 'Setup'
281 
282  ! count external data from namelist
283  rewind(io_fid_conf)
284  do count = 1, file_external_input_item_limit
285  ! set default
286  step_limit = file_external_input_step_limit
287  basename = ''
288  basename_add_num = .false.
289  number_of_files = 1
290  varname = ''
291  axistype = ''
292  step_fixed = -1
293  enable_periodic_year = .false.
294  enable_periodic_month = .false.
295  enable_periodic_day = .false.
296  defval = undef
297  check_coordinates = .false.
298  file_aggregate = file_aggregate_default
299  allow_missing = .false.
300 
301  ! read namelist
302  read(io_fid_conf,nml=external_item,iostat=ierr)
303  if ( ierr < 0 ) then !--- no more items
304  exit
305  elseif( ierr > 0 ) then !--- fatal error
306  log_error("FILE_EXTERNAL_INPUT_setup",*) 'Not appropriate names in namelist EXTERNAL_ITEM. Check!', count
307  call prc_abort
308  endif
309  log_nml(external_item)
310 
311  call file_external_input_regist( basename, & ! [IN]
312  basename_add_num, & ! [IN]
313  number_of_files, & ! [IN]
314  varname, & ! [IN]
315  axistype, & ! [IN]
316  enable_periodic_year, & ! [IN]
317  enable_periodic_month, & ! [IN]
318  enable_periodic_day, & ! [IN]
319  step_fixed, & ! [IN]
320  defval, & ! [IN]
321  check_coordinates = check_coordinates, & ! [IN]
322  aggregate = file_aggregate, & ! [IN]
323  allow_missing = allow_missing, & ! [IN]
324  step_limit = step_limit ) ! [IN]
325  enddo
326 
327  !$acc enter data create(FILE_EXTERNAL_INPUT_item)
328 
329  return
330  end subroutine file_external_input_setup
331 
332  !-----------------------------------------------------------------------------
335  implicit none
336 
337  integer :: id
338 
339  log_newline
340  log_info("FILE_EXTERNAL_INPUT_finalize",*) 'Finalize'
341 
342  do id = 1, file_external_input_item_count
343  !$acc exit data delete(FILE_EXTERNAL_INPUT_item(id)%value)
344  deallocate( file_external_input_item(id)%value )
345  deallocate( file_external_input_item(id)%time )
346  if ( allocated( file_external_input_item(id)%basename ) ) &
347  deallocate( file_external_input_item(id)%basename )
348  end do
349 
350  !$acc exit data delete(FILE_EXTERNAL_INPUT_item)
351  file_external_input_item_count = 0
352 
353  return
354  end subroutine file_external_input_finalize
355 
356  !-----------------------------------------------------------------------------
358  subroutine file_external_input_init_var( &
359  varname, &
360  axistype, &
361  aggregate, &
362  allow_missing )
363  use scale_prc, only: &
364  prc_abort
365  implicit none
366  character(len=*), intent(in) :: varname
367  character(len=*), intent(in) :: axistype
368  logical, intent(in), optional :: aggregate
369  logical, intent(in), optional :: allow_missing
370 
371  logical :: aggregate_
372  logical :: allow_missing_
373  integer :: nid
374 
375  if ( present(aggregate) ) then
376  aggregate_ = aggregate
377  else
378  aggregate_ = .false.
379  end if
380 
381  if ( present(allow_missing) ) then
382  allow_missing_ = allow_missing
383  else
384  allow_missing_ = .false.
385  end if
386 
387  nid = file_external_input_getid( varname )
388  if ( nid > 0 ) then
389  log_error("FILE_EXTERNAL_INPUT_init_var",*) 'Data is already registered! varname = ', trim(varname)
390  call prc_abort
391  endif
392 
393  file_external_input_item_count = file_external_input_item_count + 1
394 
395  if ( file_external_input_item_count > file_external_input_item_limit ) then
396  log_error("FILE_EXTERNAL_INPUT_init_var",*) 'Number of EXT data exceedes the limit', file_external_input_item_count, file_external_input_item_limit
397  call prc_abort
398  endif
399 
400  nid = file_external_input_item_count
401 
402  ! setup item
403  file_external_input_item(nid)%varname = varname
404  file_external_input_item(nid)%axistype = axistype
405  file_external_input_item(nid)%allow_missing = allow_missing_
406  file_external_input_item(nid)%aggregate = aggregate_
407  file_external_input_item(nid)%fixed_step = .false.
408  file_external_input_item(nid)%flag_periodic = 0
409  file_external_input_item(nid)%file = .false.
410 
411  return
412  end subroutine file_external_input_init_var
413 
414  !-----------------------------------------------------------------------------
416  subroutine file_external_input_regist_var( &
417  varname, &
418  axistype, &
419  dim_rank, &
420  dim_size, &
421  step_num, &
422  file_num, &
423  time_now, &
424  time_step, &
425  defval )
426  use scale_prc, only: &
427  prc_abort
428  implicit none
429  character(len=*), intent(in) :: varname
430  character(len=*), intent(in) :: axistype
431  integer, intent(in) :: dim_rank
432  integer, intent(in) :: dim_size(dim_rank)
433  integer, intent(in) :: step_num ! number of steps in single file
434  integer, intent(in) :: file_num ! number of files
435  real(dp), intent(in) :: time_now
436  real(dp), intent(in) :: time_step
437  real(rp), intent(in) :: defval
438 
439  integer :: dim1_size, dim1_max, dim1_s
440  integer :: dim2_size, dim2_max, dim2_s
441  integer :: dim3_size, dim3_max, dim3_s
442 
443  integer :: nid
444  integer :: n
445 
446  nid = file_external_input_getid( varname )
447 
448  select case ( dim_rank )
449  case ( 1 )
450 
451  call file_external_input_get_dims1d( dim1_size, dim1_max, dim1_s, & ! [OUT]
452  varname, axistype ) ! [IN]
453 
454 
455  if ( file_external_input_item(nid)%aggregate &
456  .or. ( .not. file_external_input_item(nid)%file ) ) then
457  file_external_input_item(nid)%var_size (1) = dim1_size
458  file_external_input_item(nid)%var_start(1) = dim1_s
459  file_external_input_item(nid)%var_max (1) = dim1_max
460  else
461  if ( dim1_max /= dim_size(1) ) then
462  log_error("FILE_EXTERNAL_INPUT_regist_var",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
463  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
464  call prc_abort
465  endif
466  file_external_input_item(nid)%var_size (1) = dim1_max
467  file_external_input_item(nid)%var_start(1) = 1
468  file_external_input_item(nid)%var_max (1) = dim1_max
469  end if
470 
471  file_external_input_item(nid)%transpose = .false.
472  file_external_input_item(nid)%dim_size (1) = dim1_size
473  file_external_input_item(nid)%dim_start(1) = dim1_s
474  file_external_input_item(nid)%dim_max (1) = dim1_max
475 
476  case ( 2 )
477 
478  call file_external_input_get_dims2d( dim1_size, dim1_max, dim1_s, & ! [OUT]
479  dim2_size, dim2_max, dim2_s, & ! [OUT]
480  file_external_input_item(nid)%transpose, & ! [OUT]
481  varname, axistype ) ! [IN]
482 
483  if ( file_external_input_item(nid)%aggregate &
484  .or. ( .not. file_external_input_item(nid)%file ) ) then
485  file_external_input_item(nid)%var_size (1) = dim1_size
486  file_external_input_item(nid)%var_start(1) = dim1_s
487  file_external_input_item(nid)%var_max (1) = dim1_max
488  file_external_input_item(nid)%var_size (2) = dim2_size
489  file_external_input_item(nid)%var_start(2) = dim2_s
490  file_external_input_item(nid)%var_max (2) = dim2_max
491  else
492  if ( dim1_max /= dim_size(1) .OR. dim2_max /= dim_size(2) ) then
493  log_error("FILE_EXTERNAL_INPUT_regist_var",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
494  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
495  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
496  call prc_abort
497  endif
498  file_external_input_item(nid)%var_size (1) = dim1_max
499  file_external_input_item(nid)%var_start(1) = 1
500  file_external_input_item(nid)%var_max (1) = dim1_max
501  file_external_input_item(nid)%var_size (2) = dim2_max
502  file_external_input_item(nid)%var_start(2) = 1
503  file_external_input_item(nid)%var_max (2) = dim2_max
504  end if
505 
506  if ( file_external_input_item(nid)%transpose ) then
507  file_external_input_item(nid)%dim_size (1) = dim2_size
508  file_external_input_item(nid)%dim_start(1) = dim2_s
509  file_external_input_item(nid)%dim_max (1) = dim2_max
510  file_external_input_item(nid)%dim_size (2) = dim1_size
511  file_external_input_item(nid)%dim_start(2) = dim1_s
512  file_external_input_item(nid)%dim_max (2) = dim1_max
513  else
514  file_external_input_item(nid)%dim_size (1) = dim1_size
515  file_external_input_item(nid)%dim_start(1) = dim1_s
516  file_external_input_item(nid)%dim_max (1) = dim1_max
517  file_external_input_item(nid)%dim_size (2) = dim2_size
518  file_external_input_item(nid)%dim_start(2) = dim2_s
519  file_external_input_item(nid)%dim_max (2) = dim2_max
520  end if
521 
522 
523  case ( 3 )
524 
525  call file_external_input_get_dims3d( dim1_size, dim1_max, dim1_s, & ! [OUT]
526  dim2_size, dim2_max, dim2_s, & ! [OUT]
527  dim3_size, dim3_max, dim3_s, & ! [OUT]
528  file_external_input_item(nid)%transpose, & ! [OUT]
529  varname, axistype ) ! [IN]
530 
531  if ( file_external_input_item(nid)%aggregate &
532  .or. ( .not. file_external_input_item(nid)%file ) ) then
533  file_external_input_item(nid)%var_size (1) = dim1_size
534  file_external_input_item(nid)%var_start(1) = dim1_s
535  file_external_input_item(nid)%var_max (1) = dim1_max
536  file_external_input_item(nid)%var_size (2) = dim2_size
537  file_external_input_item(nid)%var_start(2) = dim2_s
538  file_external_input_item(nid)%var_max (2) = dim2_max
539  file_external_input_item(nid)%var_size (3) = dim3_size
540  file_external_input_item(nid)%var_start(3) = dim3_s
541  file_external_input_item(nid)%var_max (3) = dim3_max
542  else
543  if ( dim1_max /= dim_size(1) .OR. dim2_max /= dim_size(2) .OR. dim3_max /= dim_size(3) ) then
544  log_error("FILE_EXTERNAL_INPUT_regist_var",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
545  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
546  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
547  log_error_cont(*) 'dim 3 (data,requested) : ', dim_size(3), dim3_max
548  call prc_abort
549  endif
550  file_external_input_item(nid)%var_size (1) = dim1_max
551  file_external_input_item(nid)%var_start(1) = 1
552  file_external_input_item(nid)%var_max (1) = dim1_max
553  file_external_input_item(nid)%var_size (2) = dim2_max
554  file_external_input_item(nid)%var_start(2) = 1
555  file_external_input_item(nid)%var_max (2) = dim2_max
556  file_external_input_item(nid)%var_size (3) = dim3_max
557  file_external_input_item(nid)%var_start(3) = 1
558  file_external_input_item(nid)%var_max (3) = dim3_max
559  end if
560 
561  if ( file_external_input_item(nid)%transpose ) then
562  file_external_input_item(nid)%dim_size (1) = dim3_size
563  file_external_input_item(nid)%dim_start(1) = dim3_s
564  file_external_input_item(nid)%dim_max (1) = dim3_max
565  file_external_input_item(nid)%dim_size (2) = dim1_size
566  file_external_input_item(nid)%dim_start(2) = dim1_s
567  file_external_input_item(nid)%dim_max (2) = dim1_max
568  file_external_input_item(nid)%dim_size (3) = dim2_size
569  file_external_input_item(nid)%dim_start(3) = dim2_s
570  file_external_input_item(nid)%dim_max (3) = dim2_max
571  else
572  file_external_input_item(nid)%dim_size (1) = dim1_size
573  file_external_input_item(nid)%dim_start(1) = dim1_s
574  file_external_input_item(nid)%dim_max (1) = dim1_max
575  file_external_input_item(nid)%dim_size (2) = dim2_size
576  file_external_input_item(nid)%dim_start(2) = dim2_s
577  file_external_input_item(nid)%dim_max (2) = dim2_max
578  file_external_input_item(nid)%dim_size (3) = dim3_size
579  file_external_input_item(nid)%dim_start(3) = dim3_s
580  file_external_input_item(nid)%dim_max (3) = dim3_max
581  end if
582 
583  case default
584  log_error("FILE_EXTERNAL_INPUT_regist_var",*) 'Unexpected dim rank: ', dim_rank
585  call prc_abort
586  end select
587 
588  do n = dim_rank+1, 3
589  file_external_input_item(nid)%dim_size (n) = 1
590  file_external_input_item(nid)%dim_start(n) = 1
591  file_external_input_item(nid)%dim_max (n) = 0
592  file_external_input_item(nid)%var_size (n) = 1
593  file_external_input_item(nid)%var_start(n) = 1
594  file_external_input_item(nid)%var_max (n) = 0
595  enddo
596  !$acc update device(FILE_EXTERNAL_INPUT_item(nid)%dim_max,FILE_EXTERNAL_INPUT_item(nid)%dim_start,FILE_EXTERNAL_INPUT_item(nid)%var_start)
597 
598  file_external_input_item(nid)%ndim = dim_rank
599  file_external_input_item(nid)%step_num = step_num
600 
601 
602  allocate( file_external_input_item(nid)%value(file_external_input_item(nid)%dim_size(1),file_external_input_item(nid)%dim_size(2),file_external_input_item(nid)%dim_size(3),2) )
603  file_external_input_item(nid)%value(:,:,:,:) = defval
604  !$acc enter data copyin(FILE_EXTERNAL_INPUT_item(nid)%value)
605 
606  allocate( file_external_input_item(nid)%time(step_num*file_num) )
607  do n = 1, file_external_input_item(nid)%step_num*file_num
608  file_external_input_item(nid)%time(n) = time_step * ( n - 1 ) + time_now
609  end do
610 
611  file_external_input_item(nid)%data_step_prev = 1
612  file_external_input_item(nid)%data_step_next = 2
613 
614  return
615  end subroutine file_external_input_regist_var
616 
617  !-----------------------------------------------------------------------------
620  varname, &
621  var, &
622  axistype, &
623  step_nmax, &
624  time_now, &
625  time_step, &
626  aggregate, &
627  allow_missing )
628  use scale_const, only: &
629  undef => const_undef
630  implicit none
631  character(len=*), intent(in) :: varname
632  real(RP), intent(in) :: var(:)
633  character(len=*), intent(in) :: axistype
634  integer, intent(in) :: step_nmax
635  real(DP), intent(in) :: time_now
636  real(DP), intent(in) :: time_step
637  logical, intent(in), optional :: aggregate
638  logical, intent(in), optional :: allow_missing
639 
640  integer :: dim_size(1)
641  logical :: error
642  !---------------------------------------------------------------------------
643 
644  call file_external_input_init_var( &
645  varname, &
646  axistype, &
647  aggregate, &
648  allow_missing )
649 
650  dim_size(:) = shape( var )
651 
652  call file_external_input_regist_var( &
653  varname, &
654  axistype, &
655  1, &
656  dim_size(:), &
657  step_nmax, &
658  1, &
659  time_now, &
660  time_step, &
661  undef )
662 
664  varname, &
665  var(:), &
666  error )
667 
668  return
670 
671  !-----------------------------------------------------------------------------
674  varname, &
675  var, &
676  axistype, &
677  step_nmax, &
678  time_now, &
679  time_step, &
680  aggregate, &
681  allow_missing )
682  use scale_const, only: &
683  undef => const_undef
684  implicit none
685  character(len=*), intent(in) :: varname
686  real(RP), intent(in) :: var(:,:)
687  character(len=*), intent(in) :: axistype
688  integer, intent(in) :: step_nmax
689  real(DP), intent(in) :: time_now
690  real(DP), intent(in) :: time_step
691  logical, intent(in), optional :: aggregate
692  logical, intent(in), optional :: allow_missing
693 
694  integer :: dim_size(2)
695  logical :: error
696  !---------------------------------------------------------------------------
697 
698  call file_external_input_init_var( &
699  varname, &
700  axistype, &
701  aggregate, &
702  allow_missing )
703 
704  dim_size(:) = shape( var )
705 
706  call file_external_input_regist_var( &
707  varname, &
708  axistype, &
709  2, &
710  dim_size(:), &
711  step_nmax, &
712  1, &
713  time_now, &
714  time_step, &
715  undef )
716 
718  varname, &
719  var(:,:), &
720  error )
721 
722  return
724 
725  !-----------------------------------------------------------------------------
728  varname, &
729  var, &
730  axistype, &
731  step_nmax, &
732  time_now, &
733  time_step, &
734  aggregate, &
735  allow_missing )
736  use scale_const, only: &
737  undef => const_undef
738  implicit none
739  character(len=*), intent(in) :: varname
740  real(RP), intent(in) :: var(:,:,:)
741  character(len=*), intent(in) :: axistype
742  integer, intent(in) :: step_nmax
743  real(DP), intent(in) :: time_now
744  real(DP), intent(in) :: time_step
745  logical, intent(in), optional :: aggregate
746  logical, intent(in), optional :: allow_missing
747 
748  integer :: dim_size(3)
749  logical :: error
750  !---------------------------------------------------------------------------
751 
752  call file_external_input_init_var( &
753  varname, &
754  axistype, &
755  aggregate, &
756  allow_missing )
757 
758  dim_size(:) = shape( var )
759 
760  call file_external_input_regist_var( &
761  varname, &
762  axistype, &
763  3, &
764  dim_size(:), &
765  step_nmax, &
766  1, &
767  time_now, &
768  time_step, &
769  undef )
770 
772  varname, &
773  var(:,:,:), &
774  error )
775 
776  return
778 
779  !-----------------------------------------------------------------------------
781  subroutine file_external_input_regist_file( &
782  basename, &
783  basename_add_num, &
784  number_of_files, &
785  varname, &
786  axistype, &
787  enable_periodic_year, &
788  enable_periodic_month, &
789  enable_periodic_day, &
790  step_fixed, &
791  defval, &
792  check_coordinates, &
793  aggregate, &
794  allow_missing, &
795  step_limit, &
796  update_dt, &
797  exist )
798  use scale_file_h, only: &
799  file_fread
800  use scale_file, only: &
801  file_aggregate, &
802  file_open, &
803  file_get_all_datainfo, &
804  file_read
805  use scale_prc, only: &
806  prc_myrank, &
807  prc_abort
808  use scale_calendar, only: &
814  i_year, &
815  i_month, &
816  i_day
817  use scale_time, only: &
819  time_nowdaysec, &
821  use scale_file_cartesc, only: &
822  file_cartesc_check_coordinates
823  implicit none
824 
825  character(len=*), intent(in) :: basename
826  logical, intent(in) :: basename_add_num
827  integer, intent(in) :: number_of_files
828  character(len=*), intent(in) :: varname
829  character(len=*), intent(in) :: axistype
830  integer, intent(in) :: step_fixed ! fixed step position to read
831  logical, intent(in) :: enable_periodic_year ! treat as yearly periodic data?
832  logical, intent(in) :: enable_periodic_month ! treat as yearly,monthly periodic data?
833  logical, intent(in) :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
834  real(RP), intent(in) :: defval
835 
836  logical, intent(in), optional :: check_coordinates
837  logical, intent(in), optional :: aggregate
838  logical, intent(in), optional :: allow_missing
839  integer, intent(in), optional :: step_limit ! limit number for reading data
840  real(DP), intent(out), optional :: update_dt
841  logical, intent(out), optional :: exist
842 
843  integer :: step_nmax
844  character(len=H_MID) :: description
845  character(len=H_SHORT) :: unit
846  character(len=H_MID) :: standard_name
847  integer :: datatype
848  integer :: dim_rank
849  character(len=H_SHORT) :: dim_name (FILE_EXTERNAL_INPUT_dim_limit)
850  integer :: dim_size (FILE_EXTERNAL_INPUT_dim_limit)
851  integer :: natts
852  character(len=H_SHORT) :: att_name (FILE_EXTERNAL_INPUT_att_limit)
853  integer :: att_type (FILE_EXTERNAL_INPUT_att_limit)
854  integer :: att_len (FILE_EXTERNAL_INPUT_att_limit)
855  real(DP) :: time_start(FILE_EXTERNAL_INPUT_step_limit)
856  real(DP) :: time_end (FILE_EXTERNAL_INPUT_step_limit)
857  character(len=H_MID) :: time_units
858  character(len=H_SHORT) :: calendar
859 
860  integer :: datadate(6)
861  real(DP) :: datasubsec
862  integer :: dataday
863  real(DP) :: datasec
864  integer :: offset_year
865 
866  character(len=H_LONG) :: filename
867 
868  logical :: aggregate_
869  integer :: step_limit_
870 
871  real(RP), allocatable :: buf(:,:,:)
872 
873  logical :: error
874 
875  integer :: fid
876  integer :: nid, n
877  !---------------------------------------------------------------------------
878 
879  if ( present(aggregate) ) then
880  aggregate_ = aggregate
881  else
882  aggregate_ = file_aggregate
883  end if
884 
885  if ( present(step_limit) ) then
886  if ( step_limit > 0 ) then
887  step_limit_ = step_limit
888  else
889  step_limit_ = file_external_input_step_limit
890  endif
891  else
892  step_limit_ = file_external_input_step_limit
893  endif
894 
895  call file_external_input_init_var( &
896  varname, &
897  axistype, &
898  aggregate_, &
899  allow_missing )
900 
901 
902  nid = file_external_input_item_count
903 
904  file_external_input_item(nid)%file = .true.
905  file_external_input_item(nid)%nfile = number_of_files
906  file_external_input_item(nid)%file_current = 1
907  file_external_input_item(nid)%data_step_offset = 0
908  file_external_input_item(nid)%step_limit = step_limit_
909 
910  allocate( file_external_input_item(nid)%basename(number_of_files) )
911  if ( number_of_files > 1 .or. basename_add_num ) then
912  do n = 1, number_of_files
913  write(filename,'(A,A,I5.5)') trim(basename), '_', n - 1
914  file_external_input_item(nid)%basename(n) = filename
915  enddo
916  else
917  file_external_input_item(nid)%basename(1) = basename
918  end if
919 
920 
921  filename = file_external_input_item(nid)%basename(1)
922  call file_open( filename, & ! [IN]
923  fid, & ! [OUT]
924  aggregate=aggregate_, & ! [IN]
925  rankid=prc_myrank ) ! [IN]
926 
927  ! read from file
928  call file_get_all_datainfo( fid, varname, & ! [IN]
929  step_nmax, & ! [OUT]
930  description, unit, standard_name, & ! [OUT]
931  datatype, & ! [OUT]
932  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
933  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
934  time_start(1:step_limit_), time_end(1:step_limit_), & ! [OUT]
935  time_units, calendar ) ! [OUT]
936 
937  if ( step_nmax > 0 ) then
938  if ( present(exist) ) then
939  exist = .true.
940  endif
941  else
942  if ( present(exist) ) then
943  exist = .false.
944  return
945  else
946  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Data not found! filename,varname = ', trim(filename), ', ', trim(varname)
947  call prc_abort
948  endif
949  endif
950 
951  do n = dim_rank+1, 3
952  dim_size(n) = 1
953  enddo
954 
955  file_external_input_item(nid)%fid = fid
956 
957  if ( enable_periodic_day ) then
958  file_external_input_item(nid)%flag_periodic = i_periodic_day
959  elseif( enable_periodic_month ) then
960  file_external_input_item(nid)%flag_periodic = i_periodic_month
961  elseif( enable_periodic_year ) then
962  file_external_input_item(nid)%flag_periodic = i_periodic_year
963  endif
964 
965  call file_external_input_regist_var( &
966  varname, &
967  axistype, &
968  dim_rank, &
969  dim_size(:), &
970  step_nmax, &
971  number_of_files, &
972  0.0_dp, 0.0_dp, &
973  defval )
974 
975  do n = 1, file_external_input_item(nid)%step_num
976  file_external_input_item(nid)%time(n) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
977  enddo
978 
979  if ( file_external_input_item(nid)%step_num == 1 ) then
980 
981  file_external_input_item(nid)%fixed_step = .true.
982  file_external_input_item(nid)%data_step_prev = 1
983  file_external_input_item(nid)%data_step_next = 1
984 
985  else if ( step_fixed > 0 ) then ! fixed time step mode
986 
987  file_external_input_item(nid)%fixed_step = .true.
988  file_external_input_item(nid)%data_step_prev = step_fixed
989  file_external_input_item(nid)%data_step_next = step_fixed
990 
991  else
992 
993  ! seek start position
994  file_external_input_item(nid)%data_step_next = 1
995  do n = 1, file_external_input_item(nid)%step_num
996  if ( file_external_input_item(nid)%time(n) > time_nowdaysec ) exit
997  file_external_input_item(nid)%data_step_next = n + 1
998  enddo
999 
1000  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_next - 1
1001 
1002  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
1003 
1004  if ( file_external_input_item(nid)%data_step_next == 1 ) then ! between first-1 and first
1005 
1006  ! first-1 = last
1007  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%step_num
1008 
1009  elseif( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then ! between last and last+1
1010 
1011  ! last+1 = first
1012  file_external_input_item(nid)%data_step_next = 1
1013 
1014  ! update data time in periodic condition
1015  do n = 1, file_external_input_item(nid)%step_num
1016  dataday = 0
1017  datasec = file_external_input_item(nid)%time(n)
1018  offset_year = 0
1019  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
1020 
1021  call calendar_daysec2date( datadate(:), & ! [OUT]
1022  datasubsec, & ! [OUT]
1023  dataday, & ! [IN]
1024  datasec, & ! [IN]
1025  offset_year ) ! [IN]
1026 
1027  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
1028  datadate(i_day) = datadate(i_day) + 1
1029  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
1030  datadate(i_month) = datadate(i_month) + 1
1031  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
1032  datadate(i_year) = datadate(i_year) + 1
1033  endif
1034 
1035  call calendar_date2daysec( dataday, & ! [OUT]
1036  datasec, & ! [OUT]
1037  datadate(:), & ! [IN]
1038  datasubsec, & ! [IN]
1039  offset_year ) ! [IN]
1040 
1041  file_external_input_item(nid)%time(n) = calendar_combine_daysec( dataday, datasec )
1042  enddo
1043 
1044  log_info("FILE_EXTERNAL_INPUT_regist",*) 'data time is updated.'
1045  endif
1046 
1047  else ! normal mode
1048 
1049  if ( file_external_input_item(nid)%data_step_next == 1 &
1050  .OR. file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
1051  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Current time is out of period of external data! ', trim(varname)
1052  call prc_abort
1053  endif
1054 
1055  endif
1056 
1057  endif
1058 
1059  !--- read first data
1060  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A15)') 'Initial read of external data : ', trim(varname)
1061 
1062  allocate( buf(file_external_input_item(nid)%var_size(1),file_external_input_item(nid)%var_size(2),file_external_input_item(nid)%var_size(3)) )
1063  !$acc data create(buf)
1064 
1065  select case ( dim_rank )
1066  case ( 1 )
1067 
1068  ! read prev
1069  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1070  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
1071  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
1072 
1073  if ( file_external_input_item(nid)%aggregate ) then
1074  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
1075  file_external_input_item(nid)%varname, & ! [IN]
1076  file_external_input_item(nid)%axistype, & ! [IN]
1077  buf(:,1,1), & ! [OUT]
1078  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1079  else
1080  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1081  file_external_input_item(nid)%varname, & ! [IN]
1082  buf(:,1,1), & ! [OUT]
1083  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1084  end if
1085 
1086  call file_external_input_put_ref_1d( file_external_input_item(nid)%varname, &
1087  buf(:,1,1), &
1088  error )
1089 
1090  ! read next
1091  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1092  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
1093  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
1094 
1095  if ( file_external_input_item(nid)%aggregate ) then
1096  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
1097  file_external_input_item(nid)%varname, & ! [IN]
1098  file_external_input_item(nid)%axistype, & ! [IN]
1099  buf(:,1,1), & ! [OUT]
1100  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1101  else
1102  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1103  file_external_input_item(nid)%varname, & ! [IN]
1104  buf(:,1,1), & ! [OUT]
1105  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1106  end if
1107 
1108  call file_external_input_put_ref_1d( file_external_input_item(nid)%varname, &
1109  buf(:,1,1), &
1110  error )
1111 
1112  case ( 2 )
1113 
1114  ! read prev
1115  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1116  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
1117  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
1118 
1119  if ( file_external_input_item(nid)%aggregate ) then
1120  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
1121  file_external_input_item(nid)%varname, & ! [IN]
1122  file_external_input_item(nid)%axistype, & ! [IN]
1123  buf(:,:,1), & ! [OUT]
1124  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1125  else
1126  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1127  file_external_input_item(nid)%varname, & ! [IN]
1128  buf(:,:,1), & ! [OUT]
1129  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1130  end if
1131 
1132  call file_external_input_put_ref_2d( file_external_input_item(nid)%varname, &
1133  buf(:,:,1), &
1134  error )
1135 
1136  ! read next
1137  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1138  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
1139  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
1140 
1141  if ( file_external_input_item(nid)%aggregate ) then
1142  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
1143  file_external_input_item(nid)%varname, & ! [IN]
1144  file_external_input_item(nid)%axistype, & ! [IN]
1145  buf(:,:,1), & ! [OUT]
1146  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1147  else
1148  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1149  file_external_input_item(nid)%varname, & ! [IN]
1150  buf(:,:,1), & ! [OUT]
1151  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1152  end if
1153 
1154  call file_external_input_put_ref_2d( file_external_input_item(nid)%varname, &
1155  buf(:,:,1), &
1156  error )
1157 
1158  case ( 3 )
1159 
1160  ! read prev
1161  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1162  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
1163  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
1164 
1165  if ( file_external_input_item(nid)%aggregate ) then
1166  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
1167  file_external_input_item(nid)%varname, & ! [IN]
1168  file_external_input_item(nid)%axistype, & ! [IN]
1169  buf(:,:,:), & ! [OUT]
1170  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1171  else
1172  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1173  file_external_input_item(nid)%varname, & ! [IN]
1174  buf(:,:,:), & ! [OUT]
1175  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
1176  end if
1177 
1178  call file_external_input_put_ref_3d( file_external_input_item(nid)%varname, &
1179  buf(:,:,:), &
1180  error )
1181 
1182  ! read next
1183  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
1184  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
1185  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
1186 
1187  if ( file_external_input_item(nid)%aggregate ) then
1188  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
1189  file_external_input_item(nid)%varname, & ! [IN]
1190  file_external_input_item(nid)%axistype, & ! [IN]
1191  buf(:,:,:), & ! [OUT]
1192  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1193  else
1194  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1195  file_external_input_item(nid)%varname, & ! [IN]
1196  buf(:,:,:), & ! [OUT]
1197  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1198  end if
1199 
1200  call file_external_input_put_ref_3d( file_external_input_item(nid)%varname, &
1201  buf(:,:,:), &
1202  error )
1203 
1204  case default
1205  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Unexpected dim rank: ', dim_rank
1206  call prc_abort
1207  end select
1208 
1209  !$acc end data
1210 
1211  deallocate( buf )
1212 
1213  if ( present(check_coordinates) ) then
1214  if ( check_coordinates ) then
1215  call file_cartesc_check_coordinates( fid, &
1216  atmos = file_external_input_item(nid)%ndim==3, &
1217  transpose = file_external_input_item(nid)%transpose )
1218  endif
1219  endif
1220 
1221 
1222  if ( present(update_dt) ) then
1223  update_dt = file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_next) &
1224  - file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_prev)
1225  end if
1226 
1227  return
1228  end subroutine file_external_input_regist_file
1229 
1230  !-----------------------------------------------------------------------------
1232  subroutine file_external_input_update_1d( &
1233  varname, &
1234  time_current, &
1235  var, &
1236  error )
1237  use scale_const, only: &
1238  eps => const_eps, &
1239  undef => const_undef
1240  use scale_file, only: &
1241  file_read
1242  implicit none
1243  character(len=*), intent(in) :: varname ! item name
1244  real(DP), intent(in) :: time_current ! current time
1245  real(RP), intent(out) :: var(:) ! variable
1246  logical, intent(out) :: error ! error code
1247 
1248  integer :: nid
1249  real(RP) :: weight
1250  logical :: do_readfile
1251  integer :: step_next
1252 
1253  real(RP), allocatable :: buf(:)
1254 
1255  integer :: n1s, n1e
1256  integer :: n1
1257  !---------------------------------------------------------------------------
1258 
1259  nid = file_external_input_getid(varname)
1260 
1261  if ( nid == 0 ) then
1262  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'Variable was not registered: ', trim(varname)
1263  error = .true.
1264  return
1265  endif
1266 
1267  if ( file_external_input_item(nid)%ndim /= 1 ) then
1268  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'Data is not 1D var: ', trim(file_external_input_item(nid)%varname)
1269  error = .true.
1270  return
1271  endif
1272 
1273  call file_external_input_time_advance( nid, & ! [IN]
1274  time_current, & ! [IN]
1275  weight, & ! [OUT]
1276  do_readfile ) ! [OUT]
1277 
1278  if ( do_readfile ) then
1279 
1280  if ( file_external_input_item(nid)%file ) then
1281 
1282  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
1283 
1284  log_info("FILE_EXTERNAL_INPUT_update_1D",'(1x,A,A,A,I4,A,I4,A)') &
1285  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
1286  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
1287 
1288  allocate( buf(file_external_input_item(nid)%var_size(1)) )
1289  !$acc data create(buf)
1290 
1291  ! read next
1292  if ( file_external_input_item(nid)%aggregate ) then
1293  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
1294  file_external_input_item(nid)%varname, & ! [IN]
1295  file_external_input_item(nid)%axistype, & ! [IN]
1296  buf(:), & ! [OUT]
1297  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1298  else
1299  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1300  file_external_input_item(nid)%varname, & ! [IN]
1301  buf(:), & ! [OUT]
1302  step=step_next ) ! [IN]
1303  end if
1304 
1305  call file_external_input_put_ref_1d( file_external_input_item(nid)%varname, &
1306  buf(:), &
1307  error )
1308 
1309  !$acc end data
1310  deallocate( buf )
1311 
1312  if ( error ) return
1313  end if
1314 
1315  endif
1316 
1317 
1318  error = .false.
1319 
1320  n1s = file_external_input_item(nid)%dim_start(1)
1321  n1e = n1s - 1 + file_external_input_item(nid)%dim_max(1)
1322 
1323  !$acc data copyout(var)
1324 
1325  ! store data with weight
1326  if ( file_external_input_item(nid)%allow_missing ) then
1327  !$omp parallel do
1328  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1329  do n1 = n1s, n1e
1330  if ( abs( file_external_input_item(nid)%value(n1,1,1,i_prev) - undef ) > eps &
1331  .and. abs( file_external_input_item(nid)%value(n1,1,1,i_next) - undef ) > eps ) then
1332  var(n1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,1,1,i_prev) &
1333  + ( weight ) * file_external_input_item(nid)%value(n1,1,1,i_next)
1334  else
1335  var(n1) = undef
1336  end if
1337  enddo
1338  !$acc end kernels
1339  else
1340  !$omp parallel do
1341  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1342  do n1 = n1s, n1e
1343  var(n1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,1,1,i_prev) &
1344  + ( weight ) * file_external_input_item(nid)%value(n1,1,1,i_next)
1345  enddo
1346  !$acc end kernels
1347  end if
1348 
1349  !$acc end data
1350 
1351  return
1352  end subroutine file_external_input_update_1d
1353 
1354  !-----------------------------------------------------------------------------
1356  subroutine file_external_input_update_2d( &
1357  varname, &
1358  time_current, &
1359  var, &
1360  error )
1361  use scale_const, only: &
1362  eps => const_eps, &
1363  undef => const_undef
1364  use scale_file, only: &
1365  file_read
1366  implicit none
1367  character(len=*), intent(in) :: varname ! item name
1368  real(DP), intent(in) :: time_current ! current time
1369  real(RP), intent(out) :: var(:,:) ! variable
1370  logical, intent(out) :: error ! error code
1371 
1372  integer :: nid
1373  real(RP) :: weight
1374  logical :: do_readfile
1375  integer :: step_next
1376 
1377  real(RP), allocatable :: buf(:,:)
1378 
1379  integer :: n1s, n1e, n2s, n2e
1380  integer :: n1, n2
1381  !---------------------------------------------------------------------------
1382 
1383  nid = file_external_input_getid( varname )
1384 
1385  if ( nid == 0 ) then
1386  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'Variable was not registered: ', trim(varname)
1387  error = .true.
1388  return
1389  endif
1390 
1391  if ( file_external_input_item(nid)%ndim /= 2 ) then
1392  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'Data is not 2D var: ', trim(file_external_input_item(nid)%varname)
1393  error = .true.
1394  return
1395  endif
1396 
1397  call file_external_input_time_advance( nid, & ! [IN]
1398  time_current, & ! [IN]
1399  weight, & ! [OUT]
1400  do_readfile ) ! [OUT]
1401 
1402  if ( do_readfile ) then
1403 
1404  if ( file_external_input_item(nid)%file ) then
1405 
1406  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
1407 
1408  log_info("FILE_EXTERNAL_INPUT_update_2D",'(1x,A,A,A,I4,A,I4,A)') &
1409  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
1410  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
1411 
1412  allocate( buf(file_external_input_item(nid)%var_size(1),file_external_input_item(nid)%var_size(2)) )
1413  !$acc data create(buf)
1414 
1415  ! read next
1416  if ( file_external_input_item(nid)%aggregate ) then
1417  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
1418  file_external_input_item(nid)%varname, & ! [IN]
1419  file_external_input_item(nid)%axistype, & ! [IN]
1420  buf(:,:), & ! [OUT]
1421  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1422  else
1423  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1424  file_external_input_item(nid)%varname, & ! [IN]
1425  buf(:,:), & ! [OUT]
1426  step=step_next ) ! [IN]
1427  end if
1428 
1429  call file_external_input_put_ref_2d( file_external_input_item(nid)%varname, &
1430  buf(:,:), &
1431  error )
1432 
1433  !$acc end data
1434  deallocate( buf )
1435 
1436  if ( error ) return
1437  end if
1438 
1439  endif
1440 
1441  error = .false.
1442 
1443  n1s = file_external_input_item(nid)%dim_start(1)
1444  n1e = n1s - 1 + file_external_input_item(nid)%dim_max(1)
1445  n2s = file_external_input_item(nid)%dim_start(2)
1446  n2e = n2s - 1 + file_external_input_item(nid)%dim_max(2)
1447 
1448  !$acc data copyout(var)
1449 
1450  ! store data with weight
1451  if ( file_external_input_item(nid)%allow_missing ) then
1452  !$omp parallel do
1453  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1454  do n2 = n2s, n2e
1455  do n1 = n1s, n1e
1456  if ( abs( file_external_input_item(nid)%value(n1,n2,1,i_prev) - undef ) > eps &
1457  .and. abs( file_external_input_item(nid)%value(n1,n2,1,i_next) - undef ) > eps ) then
1458  var(n1,n2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
1459  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
1460  else
1461  var(n1,n2) = undef
1462  end if
1463  enddo
1464  enddo
1465  !$acc end kernels
1466  else
1467  !$omp parallel do
1468  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1469  do n2 = n2s, n2e
1470  do n1 = n1s, n1e
1471  var(n1,n2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
1472  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
1473  enddo
1474  enddo
1475  !$acc end kernels
1476  end if
1477 
1478  !$acc end data
1479 
1480  return
1481  end subroutine file_external_input_update_2d
1482 
1483  !-----------------------------------------------------------------------------
1485  subroutine file_external_input_update_3d( &
1486  varname, &
1487  time_current, &
1488  var, &
1489  error )
1490  use scale_const, only: &
1491  eps => const_eps, &
1492  undef => const_undef
1493  use scale_file, only: &
1494  file_read
1495  implicit none
1496  character(len=*), intent(in) :: varname ! item name
1497  real(DP), intent(in) :: time_current ! current time
1498  real(RP), intent(out) :: var(:,:,:) ! variable
1499  logical, intent(out) :: error ! error code
1500 
1501  integer :: nid
1502  real(RP) :: weight
1503  logical :: do_readfile
1504  integer :: step_next
1505 
1506  real(RP), allocatable :: buf(:,:,:)
1507 
1508  integer :: n1s, n1e, n2s, n2e, n3s, n3e
1509  integer :: n1, n2, n3
1510  !---------------------------------------------------------------------------
1511 
1512  nid = file_external_input_getid( varname )
1513 
1514  if ( nid == 0 ) then
1515  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'Variable was not registered: ', trim(varname)
1516  error = .true.
1517  return
1518  endif
1519 
1520  if ( file_external_input_item(nid)%ndim /= 3 ) then
1521  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'Data is not 3D var: ', trim(file_external_input_item(nid)%varname)
1522  error = .true.
1523  return
1524  endif
1525 
1526  call file_external_input_time_advance( nid, & ! [IN]
1527  time_current, & ! [IN]
1528  weight, & ! [OUT]
1529  do_readfile ) ! [OUT]
1530 
1531  if ( do_readfile ) then
1532 
1533  if ( file_external_input_item(nid)%file ) then
1534 
1535  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
1536 
1537  log_info("FILE_EXTERNAL_INPUT_update_3D",'(1x,A,A,A,I4,A,I4,A)') &
1538  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
1539  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
1540 
1541  allocate( buf(file_external_input_item(nid)%var_size(1),file_external_input_item(nid)%var_size(2),file_external_input_item(nid)%var_size(3)) )
1542  !$acc data create(buf)
1543 
1544  ! read next
1545  if ( file_external_input_item(nid)%aggregate ) then
1546  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
1547  file_external_input_item(nid)%varname, & ! [IN]
1548  file_external_input_item(nid)%axistype, & ! [IN]
1549  buf(:,:,:), & ! [OUT]
1550  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1551  else
1552  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1553  file_external_input_item(nid)%varname, & ! [IN]
1554  buf(:,:,:), & ! [OUT]
1555  step=step_next ) ! [IN]
1556  end if
1557 
1558  call file_external_input_put_ref_3d( file_external_input_item(nid)%varname, &
1559  buf(:,:,:), &
1560  error )
1561 
1562  !$acc end data
1563  deallocate(buf)
1564 
1565  if ( error ) return
1566  end if
1567 
1568  endif
1569 
1570  error = .false.
1571 
1572  n1s = file_external_input_item(nid)%dim_start(1)
1573  n1e = n1s - 1 + file_external_input_item(nid)%dim_max(1)
1574  n2s = file_external_input_item(nid)%dim_start(2)
1575  n2e = n2s - 1 + file_external_input_item(nid)%dim_max(2)
1576  n3s = file_external_input_item(nid)%dim_start(3)
1577  n3e = n3s - 1 + file_external_input_item(nid)%dim_max(3)
1578 
1579  !$acc data copyout(var)
1580 
1581  ! store data with weight
1582  if ( file_external_input_item(nid)%allow_missing ) then
1583  !$omp parallel do
1584  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1585  do n3 = n3s, n3e
1586  do n2 = n2s, n2e
1587  do n1 = n1s, n1e
1588  if ( abs( file_external_input_item(nid)%value(n1,n2,n3,i_prev) - undef ) > eps &
1589  .and. abs( file_external_input_item(nid)%value(n1,n2,n3,i_next) - undef ) > eps ) then
1590  var(n1,n2,n3) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
1591  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
1592  else
1593  var(n1,n2,n3) = undef
1594  end if
1595  enddo
1596  enddo
1597  enddo
1598  !$acc end kernels
1599  else
1600  !$omp parallel do
1601  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1602  do n3 = n3s, n3e
1603  do n2 = n2s, n2e
1604  do n1 = n1s, n1e
1605  var(n1,n2,n3) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
1606  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
1607  enddo
1608  enddo
1609  enddo
1610  !$acc end kernels
1611  end if
1612 
1613  !$acc end data
1614 
1615  return
1616  end subroutine file_external_input_update_3d
1617 
1618  !-----------------------------------------------------------------------------
1620  subroutine file_external_input_put_ref_1d( &
1621  varname, &
1622  var, &
1623  error )
1624  use scale_const, only: &
1625  eps => const_eps, &
1626  undef => const_undef
1627  implicit none
1628  character(len=*), intent(in) :: varname ! item name
1629  real(RP), intent(in) :: var(:) ! variable
1630  logical, intent(out) :: error ! error code
1631 
1632  integer :: nid
1633  integer :: n1, nn1, nnn1
1634 
1635  nid = file_external_input_getid( varname )
1636 
1637  if ( nid == 0 ) then
1638  log_info("FILE_EXTERNAL_INPUT_put_ref_1D",*) 'Variable was not registered: ', trim(varname)
1639  error = .true.
1640  return
1641  endif
1642 
1643  error = .false.
1644 
1645  !$omp workshare
1646  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1647  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
1648  !$acc end kernels
1649  !$omp end workshare
1650 
1651  !$omp parallel do private(nn1,nnn1)
1652  !$acc kernels copyin(var) present(FILE_EXTERNAL_INPUT_item(nid))
1653  !$acc loop reduction(.or.:error) independent
1654  do n1 = 1, file_external_input_item(nid)%dim_max(1)
1655  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1656  nnn1 = n1 + file_external_input_item(nid)%var_start(1) - 1
1657  if ( .not. file_external_input_item(nid)%allow_missing ) then
1658  if ( abs( var(nnn1) - undef ) < eps ) then
1659  log_warn("FILE_EXTERNAL_INPUT_put_ref_1D",*) 'missing value is found in ', &
1660 #ifdef _OPENACC
1661  file_external_input_item(nid)%varname, ' at (',nnn1,')'
1662 #else
1663  trim(file_external_input_item(nid)%varname), ' at (',nnn1,')'
1664 #endif
1665  error = .true.
1666  end if
1667  end if
1668  file_external_input_item(nid)%value(nn1,1,1,i_next) = var(nnn1)
1669  enddo
1670  !$acc end kernels
1671 
1672  return
1673  end subroutine file_external_input_put_ref_1d
1674 
1675  subroutine file_external_input_put_ref_2d( &
1676  varname, &
1677  var, &
1678  error )
1679  use scale_const, only: &
1680  eps => const_eps, &
1681  undef => const_undef
1682  implicit none
1683  character(len=*), intent(in) :: varname ! item name
1684  real(RP), intent(in) :: var(:,:) ! variable
1685  logical, intent(out) :: error ! error code
1686 
1687  integer :: nid
1688  integer :: n1, n2, nn1, nn2, nnn1, nnn2
1689 
1690  nid = file_external_input_getid( varname )
1691 
1692  if ( nid == 0 ) then
1693  log_info("FILE_EXTERNAL_INPUT_put_var_2D",*) 'Variable was not registered: ', trim(varname)
1694  error = .true.
1695  return
1696  endif
1697 
1698  error = .false.
1699 
1700  !$omp workshare
1701  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1702  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
1703  !$acc end kernels
1704  !$omp end workshare
1705 
1706  if ( file_external_input_item(nid)%transpose ) then
1707  ! (x,z)->(z,x)
1708  !$omp parallel do private(nn1,nn2,nnn1,nnn2)
1709  !$acc kernels copyin(var) present(FILE_EXTERNAL_INPUT_item(nid))
1710  !$acc loop collapse(2) reduction(.or.:error) independent
1711  do n2 = 1, file_external_input_item(nid)%dim_max(2)
1712 #ifndef _OPENACC
1713  if ( error ) cycle
1714  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1715  nnn2 = n2 + file_external_input_item(nid)%var_start(1) - 1
1716 #endif
1717  do n1 = 1, file_external_input_item(nid)%dim_max(1)
1718 #ifdef _OPENACC
1719  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1720  nnn2 = n2 + file_external_input_item(nid)%var_start(1) - 1
1721 #endif
1722  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1723  nnn1 = n1 + file_external_input_item(nid)%var_start(2) - 1
1724  if ( .not. file_external_input_item(nid)%allow_missing ) then
1725  if ( abs( var(nnn2,nnn1) - undef ) < eps ) then
1726  log_warn("FILE_EXTERNAL_INPUT_put_ref_2D",*) 'missing value is found in ', &
1727 #ifdef _OPENACC
1728  file_external_input_item(nid)%varname, ' at (',nnn2,',',nnn1,')'
1729 #else
1730  trim(file_external_input_item(nid)%varname), ' at (',nnn2,',',nnn1,')'
1731 #endif
1732  error = .true.
1733  end if
1734  end if
1735  file_external_input_item(nid)%value(nn1,nn2,1,i_next) = var(nnn2,nnn1)
1736  enddo
1737  enddo
1738  !$acc end kernels
1739  else
1740  ! (z,x)->(z,x)
1741  !$omp parallel do private(nn1,nn2,nnn1,nnn2)
1742  !$acc kernels copyin(var) present(FILE_EXTERNAL_INPUT_item(nid))
1743  !$acc loop collapse(2) reduction(.or.:error) independent
1744  do n2 = 1, file_external_input_item(nid)%dim_max(2)
1745 #ifndef _OPENACC
1746  if ( error ) cycle
1747  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1748  nnn2 = n2 + file_external_input_item(nid)%var_start(2) - 1
1749 #endif
1750  do n1 = 1, file_external_input_item(nid)%dim_max(1)
1751 #ifdef _OPENACC
1752  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1753  nnn2 = n2 + file_external_input_item(nid)%var_start(2) - 1
1754 #endif
1755  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1756  nnn1 = n1 + file_external_input_item(nid)%var_start(1) - 1
1757  if ( .not. file_external_input_item(nid)%allow_missing ) then
1758  if ( abs( var(nnn2,nnn1) - undef ) < eps ) then
1759  log_warn("FILE_EXTERNAL_INPUT_put_ref_2D",*) 'missing value is found in ', &
1760 #ifdef _OPENACC
1761  file_external_input_item(nid)%varname, ' at (',nnn1,',',nnn2,')'
1762 #else
1763  trim(file_external_input_item(nid)%varname), ' at (',nnn1,',',nnn2,')'
1764 #endif
1765  error = .true.
1766  end if
1767  end if
1768  file_external_input_item(nid)%value(nn1,nn2,1,i_next) = var(nnn1,nnn2)
1769  enddo
1770  enddo
1771  !$acc end kernels
1772  endif
1773 
1774  return
1775  end subroutine file_external_input_put_ref_2d
1776 
1777  subroutine file_external_input_put_ref_3d( &
1778  varname, &
1779  var, &
1780  error )
1781  use scale_const, only: &
1782  eps => const_eps, &
1783  undef => const_undef
1784  implicit none
1785  character(len=*), intent(in) :: varname ! item name
1786  real(RP), intent(in) :: var(:,:,:) ! variable
1787  logical, intent(out) :: error ! error code
1788 
1789  integer :: nid
1790  integer :: n1, n2, n3, nn1, nn2, nn3, nnn1, nnn2, nnn3
1791 
1792  nid = file_external_input_getid( varname )
1793 
1794  if ( nid == 0 ) then
1795  log_info("FILE_EXTERNAL_INPUT_put_ref_3D",*) 'Variable was not registered: ', trim(varname)
1796  error = .true.
1797  return
1798  endif
1799 
1800  error = .false.
1801 
1802  !$omp workshare
1803  !$acc kernels
1804  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
1805  !$acc end kernels
1806  !$omp end workshare
1807 
1808  if ( file_external_input_item(nid)%transpose ) then
1809  ! (x,y,z)->(z,x,y)
1810  !$omp parallel do private(nn1,nn2,nn3,nnn1,nnn2,nnn3)
1811  !$acc kernels copyin(var) present(FILE_EXTERNAL_INPUT_item(nid))
1812  !$acc loop collapse(3) reduction(.or.:error) independent
1813  do n3 = 1, file_external_input_item(nid)%dim_max(3)
1814 #ifndef _OPENACC
1815  if ( error ) cycle
1816  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1817  nnn3 = n3 + file_external_input_item(nid)%var_start(2) - 1
1818 #endif
1819  do n2 = 1, file_external_input_item(nid)%dim_max(2)
1820 #ifndef _OPENACC
1821  if ( error ) exit
1822  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1823  nnn2 = n2 + file_external_input_item(nid)%var_start(1) - 1
1824 #endif
1825  do n1 = 1, file_external_input_item(nid)%dim_max(1)
1826 #ifdef _OPENACC
1827  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1828  nnn3 = n3 + file_external_input_item(nid)%var_start(2) - 1
1829  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1830  nnn2 = n2 + file_external_input_item(nid)%var_start(1) - 1
1831 #endif
1832  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1833  nnn1 = n1 + file_external_input_item(nid)%var_start(3) - 1
1834  if ( .not. file_external_input_item(nid)%allow_missing ) then
1835  if ( abs( var(nnn2,nnn3,nnn1) - undef ) < eps ) then
1836  log_warn("FILE_EXTERNAL_INPUT_put_ref_3D",*) 'missing value is found in ', &
1837 #ifdef _OPENACC
1838  file_external_input_item(nid)%varname, ' at (',nnn2,',',nnn3,',',nnn1,')'
1839 #else
1840  trim(file_external_input_item(nid)%varname), ' at (',nnn2,',',nnn3,',',nnn1,')'
1841 #endif
1842  error = .true.
1843  end if
1844  end if
1845  file_external_input_item(nid)%value(nn1,nn2,nn3,i_next) = var(nnn2,nnn3,nnn1)
1846  enddo
1847  enddo
1848  enddo
1849  !$acc end kernels
1850  else
1851  ! (z,x,y)->(z,x,y)
1852  !$omp parallel do private(nn1,nn2,nn3,nnn1,nnn2,nnn3)
1853  !$acc kernels copyin(var) present(FILE_EXTERNAL_INPUT_item(nid))
1854  !$acc loop collapse(3) reduction(.or.:error) independent
1855  do n3 = 1, file_external_input_item(nid)%dim_max(3)
1856 #ifndef _OPENACC
1857  if ( error ) cycle
1858  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1859  nnn3 = n3 + file_external_input_item(nid)%var_start(3) - 1
1860 #endif
1861  do n2 = 1, file_external_input_item(nid)%dim_max(2)
1862 #ifndef _OPENACC
1863  if ( error ) exit
1864  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1865  nnn2 = n2 + file_external_input_item(nid)%var_start(2) - 1
1866 #endif
1867  do n1 = 1, file_external_input_item(nid)%dim_max(1)
1868 #ifdef _OPENACC
1869  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1870  nnn3 = n3 + file_external_input_item(nid)%var_start(3) - 1
1871  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1872  nnn2 = n2 + file_external_input_item(nid)%var_start(2) - 1
1873 #endif
1874  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1875  nnn1 = n1 + file_external_input_item(nid)%var_start(1) - 1
1876  if ( .not. file_external_input_item(nid)%allow_missing ) then
1877  if ( abs( var(nnn1,nnn2,nnn3) - undef ) < eps ) then
1878  log_warn("FILE_EXTERNAL_INPUT_put_ref_3D",*) 'missing value is found in ', &
1879 #ifdef _OPENACC
1880  file_external_input_item(nid)%varname, ' at (',nnn1,',',nnn2,',',nnn3,')'
1881 #else
1882  trim(file_external_input_item(nid)%varname), ' at (',nnn1,',',nnn2,',',nnn3,')'
1883 #endif
1884  error = .true.
1885  end if
1886  end if
1887  file_external_input_item(nid)%value(nn1,nn2,nn3,i_next) = var(nnn1,nnn2,nnn3)
1888  enddo
1889  enddo
1890  enddo
1891  !$acc end kernels
1892  endif
1893 
1894  return
1895  end subroutine file_external_input_put_ref_3d
1896 
1897  !-----------------------------------------------------------------------------
1899  subroutine file_external_input_get_ref_1d( &
1900  varname, &
1901  var, &
1902  error, &
1903  i_step )
1904  implicit none
1905  character(len=*), intent(in) :: varname ! item name
1906  real(RP), intent(out) :: var(:) ! variable
1907  logical, intent(out) :: error ! error code
1908 
1909  integer, optional, intent(in) :: i_step
1910 
1911  integer :: i_step_
1912  integer :: nid
1913 
1914  if ( present(i_step) ) then
1915  i_step_ = i_step
1916  else
1917  i_step_ = i_next
1918  end if
1919 
1920  nid = file_external_input_getid( varname )
1921 
1922  if ( nid == 0 ) then
1923  log_info("FILE_EXTERNAL_INPUT_get_ref_1D",*) 'Variable was not registered: ', trim(varname)
1924  error = .true.
1925  return
1926  endif
1927 
1928  error = .false.
1929 
1930  !$omp workshare
1931  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1932  var(:) = file_external_input_item(nid)%value(:,1,1,i_step_)
1933  !$acc end kernels
1934  !$omp end workshare
1935 
1936  return
1937  end subroutine file_external_input_get_ref_1d
1938 
1939  subroutine file_external_input_get_ref_2d( &
1940  varname, &
1941  var, &
1942  error, &
1943  i_step )
1944  implicit none
1945  character(len=*), intent(in) :: varname ! item name
1946  real(RP), intent(out) :: var(:,:) ! variable
1947  logical, intent(out) :: error ! error code
1948 
1949  integer, optional, intent(in) :: i_step
1950 
1951  integer :: i_step_
1952  integer :: nid
1953 
1954  if ( present(i_step) ) then
1955  i_step_ = i_step
1956  else
1957  i_step_ = i_next
1958  end if
1959 
1960  nid = file_external_input_getid( varname )
1961 
1962  if ( nid == 0 ) then
1963  log_info("FILE_EXTERNAL_INPUT_get_ref_2D",*) 'Variable was not registered: ', trim(varname)
1964  error = .true.
1965  return
1966  endif
1967 
1968  error = .false.
1969 
1970  !$omp workshare
1971  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
1972  var(:,:) = file_external_input_item(nid)%value(:,:,1,i_step_)
1973  !$acc end kernels
1974  !$omp end workshare
1975 
1976  return
1977  end subroutine file_external_input_get_ref_2d
1978 
1979  !-----------------------------------------------------------------------------
1981  subroutine file_external_input_get_ref_3d( &
1982  varname, &
1983  var, &
1984  error, &
1985  i_step )
1986  implicit none
1987  character(len=*), intent(in) :: varname ! item name
1988  real(RP), intent(out) :: var(:,:,:) ! variable
1989  logical, intent(out) :: error ! error code
1990 
1991  integer, optional, intent(in) :: i_step
1992 
1993  integer :: i_step_
1994  integer :: nid
1995 
1996  if ( present(i_step) ) then
1997  i_step_ = i_step
1998  else
1999  i_step_ = i_next
2000  end if
2001 
2002  nid = file_external_input_getid( varname )
2003 
2004  if ( nid == 0 ) then
2005  log_info("FILE_EXTERNAL_INPUT_get_ref_3D",*) 'Variable was not registered: ', trim(varname)
2006  error = .true.
2007  return
2008  endif
2009 
2010  error = .false.
2011 
2012  !$omp workshare
2013  !$acc kernels present(FILE_EXTERNAL_INPUT_item(nid))
2014  var(:,:,:) = file_external_input_item(nid)%value(:,:,:,i_step_)
2015  !$acc end kernels
2016  !$omp end workshare
2017 
2018  return
2019  end subroutine file_external_input_get_ref_3d
2020 
2021  !-----------------------------------------------------------------------------
2023  subroutine file_external_input_query( &
2024  varname, &
2025  time_current, &
2026  do_readdata )
2027  implicit none
2028  character(len=*), intent(in) :: varname ! variable name
2029  real(dp), intent(in) :: time_current ! current time
2030  logical, intent(out) :: do_readdata ! read new data at this time?
2031 
2032  integer :: nid
2033 
2034  nid = file_external_input_getid( varname )
2035 
2036  call file_external_input_query_id( nid, &
2037  time_current, &
2038  do_readdata )
2039 
2040  return
2041  end subroutine file_external_input_query
2042 
2043  subroutine file_external_input_query_id( &
2044  nid, &
2045  time_current, &
2046  do_readdata )
2047  implicit none
2048  integer, intent(in) :: nid ! variable id
2049  real(dp), intent(in) :: time_current ! current time
2050  logical, intent(out) :: do_readdata ! read new data at this time?
2051 
2052  if ( ( .not. file_external_input_item(nid)%fixed_step ) &
2053  .and. ( time_current > file_external_input_item(nid)%time( file_external_input_item(nid)%data_step_next ) ) &
2054  ) then
2055  do_readdata = .true.
2056  else
2057  do_readdata = .false.
2058  end if
2059 
2060  return
2061  end subroutine file_external_input_query_id
2062 
2063  !-----------------------------------------------------------------------------
2065  subroutine file_external_input_time_advance( &
2066  nid, &
2067  time_current, &
2068  weight, &
2069  do_readdata )
2070  use scale_file_h, only: &
2071  file_fread
2072  use scale_file, only: &
2073  file_open, &
2074  file_get_all_datainfo
2075  use scale_prc, only: &
2076  prc_myrank, &
2077  prc_abort
2078  use scale_calendar, only: &
2084  i_year, &
2085  i_month, &
2086  i_day
2087  use scale_time, only: &
2088  time_startdaysec, &
2090  implicit none
2091 
2092  integer, intent(in) :: nid ! item id
2093  real(dp), intent(in) :: time_current ! current time
2094  real(rp), intent(out) :: weight ! weight
2095  logical, intent(out) :: do_readdata ! read new data at this time?
2096 
2097  integer :: step_nmax
2098  character(len=H_MID) :: description
2099  character(len=H_SHORT) :: unit
2100  character(len=H_MID) :: standard_name
2101  integer :: datatype
2102  integer :: dim_rank
2103  character(len=H_SHORT) :: dim_name (file_external_input_dim_limit)
2104  integer :: dim_size (file_external_input_dim_limit)
2105  integer :: natts
2106  character(len=H_SHORT) :: att_name (file_external_input_att_limit)
2107  integer :: att_type (file_external_input_att_limit)
2108  integer :: att_len (file_external_input_att_limit)
2109  real(dp) :: time_start(file_external_input_step_limit)
2110  real(dp) :: time_end (file_external_input_step_limit)
2111  character(len=H_MID) :: time_units
2112  character(len=H_SHORT) :: calendar
2113 
2114  integer :: datadate(6)
2115  real(dp) :: datasubsec
2116  integer :: dataday
2117  real(dp) :: datasec
2118  integer :: offset_year
2119 
2120  real(dp) :: time_prev, time_next
2121  integer :: step_prev, step_next
2122  integer :: t
2123  integer :: fid
2124  integer :: n, nn
2125  !---------------------------------------------------------------------------
2126 
2127  call file_external_input_query_id( nid, & ! [IN]
2128  time_current, & ! [IN]
2129  do_readdata ) ! [OUT]
2130 
2131  if ( do_readdata ) then
2132 
2133  log_info("FILE_EXTERNAL_INPUT_time_advance",'(1x,A,A15)') 'Update external input : ', trim(file_external_input_item(nid)%varname)
2134 
2135  ! update step position
2136  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_next
2137  file_external_input_item(nid)%data_step_next = file_external_input_item(nid)%data_step_next + 1
2138 
2139  if ( file_external_input_item(nid)%file ) then
2140 
2141  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
2142 
2143  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
2144 
2145  ! last+1 = first
2146  file_external_input_item(nid)%data_step_next = 1
2147 
2148  ! update data time in periodic condition
2149  do t = 1, file_external_input_item(nid)%step_num
2150  dataday = 0
2151  datasec = file_external_input_item(nid)%time(t)
2152  offset_year = 0
2153  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
2154 
2155  call calendar_daysec2date( datadate(:), & ! [OUT]
2156  datasubsec, & ! [OUT]
2157  dataday, & ! [IN]
2158  datasec, & ! [IN]
2159  offset_year ) ! [IN]
2160 
2161  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
2162  datadate(i_day) = datadate(i_day) + 1
2163  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
2164  datadate(i_month) = datadate(i_month) + 1
2165  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
2166  datadate(i_year) = datadate(i_year) + 1
2167  endif
2168 
2169  call calendar_date2daysec( dataday, & ! [IN]
2170  datasec, & ! [IN]
2171  datadate(:), & ! [OUT]
2172  datasubsec, & ! [OUT]
2173  offset_year ) ! [IN]
2174 
2175  file_external_input_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
2176  enddo
2177  endif
2178 
2179  else ! normal mode
2180 
2181  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
2182 
2183  if ( file_external_input_item(nid)%file_current < file_external_input_item(nid)%nfile ) then
2184 
2185  file_external_input_item(nid)%file_current = file_external_input_item(nid)%file_current + 1
2186 
2187  call file_open( file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current), & ! [IN]
2188  fid, & ! [OUT]
2189  rankid=prc_myrank ) ! [IN]
2190 
2191  ! read from file
2192  call file_get_all_datainfo( fid, file_external_input_item(nid)%varname, & ! [IN]
2193  step_nmax, & ! [OUT]
2194  description, unit, standard_name, & ! [OUT]
2195  datatype, & ! [OUT]
2196  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
2197  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
2198  time_start(1:file_external_input_item(nid)%step_limit), & ! [OUT]
2199  time_end(1:file_external_input_item(nid)%step_limit), & ! [OUT]
2200  time_units, calendar ) ! [OUT]
2201 
2202  if ( step_nmax == 0 ) then
2203  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Data not found! basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
2204  ', varname = ', trim(file_external_input_item(nid)%varname)
2205  call prc_abort
2206  endif
2207 
2208  do n = 1, dim_rank
2209  if ( file_external_input_item(nid)%var_size(n) /= dim_size(n) ) then
2210  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'The size of dimension', n, ' is inconsistent! '
2211  log_error_cont(*) 'size (previous,current) = ', file_external_input_item(nid)%var_size(n), dim_size(n)
2212  log_error_cont(*) 'basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
2213  ', varname = ', trim(file_external_input_item(nid)%varname)
2214  call prc_abort
2215  endif
2216  enddo
2217 
2218  do n = 1, step_nmax
2219  nn = file_external_input_item(nid)%step_num + n
2220  file_external_input_item(nid)%time(nn) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
2221  enddo
2222 
2223  if ( file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_prev) > file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_next) ) then
2224  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Time in new file is earlier than last time of previous file! stop'
2225  log_error_cont(*) 'Time (previous,current) = ', file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_prev), &
2226  file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_next)
2227  log_error_cont(*) 'Data not found! basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
2228  ', varname = ', trim(file_external_input_item(nid)%varname)
2229  call prc_abort
2230  endif
2231 
2232  file_external_input_item(nid)%fid = fid
2233  file_external_input_item(nid)%data_step_offset = file_external_input_item(nid)%step_num
2234  file_external_input_item(nid)%step_num = file_external_input_item(nid)%step_num + step_nmax
2235 
2236  else
2237  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Current time is out of period of external data! '
2238  call prc_abort
2239  endif
2240 
2241  endif
2242 
2243  endif ! periodic or not
2244 
2245  endif ! read from file?
2246 
2247  endif ! do read?
2248 
2249 
2250  ! calc weight
2251  if ( file_external_input_item(nid)%fixed_step ) then
2252 
2253  weight = 0.0_rp
2254 
2255  elseif( file_external_input_item(nid)%data_step_next == 1 ) then ! periodic case
2256 
2257  step_prev = file_external_input_item(nid)%data_step_prev
2258  step_next = file_external_input_item(nid)%data_step_next
2259 
2260  dataday = 0
2261  datasec = file_external_input_item(nid)%time( step_prev )
2262  offset_year = 0
2263  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
2264 
2265  call calendar_daysec2date( datadate(:), & ! [OUT]
2266  datasubsec, & ! [OUT]
2267  dataday, & ! [IN]
2268  datasec, & ! [IN]
2269  offset_year ) ! [IN]
2270 
2271  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
2272  datadate(i_day) = datadate(i_day) - 1
2273  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
2274  datadate(i_month) = datadate(i_month) - 1
2275  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
2276  datadate(i_year) = datadate(i_year) - 1
2277  endif
2278 
2279  call calendar_date2daysec( dataday, & ! [IN]
2280  datasec, & ! [IN]
2281  datadate(:), & ! [OUT]
2282  datasubsec, & ! [OUT]
2283  offset_year ) ! [IN]
2284 
2285  time_prev = calendar_combine_daysec( dataday, datasec )
2286  time_next = file_external_input_item(nid)%time( step_next )
2287 
2288  weight = ( time_current - time_prev ) &
2289  / ( time_next - time_prev )
2290 
2291  else ! normal case
2292 
2293  step_prev = file_external_input_item(nid)%data_step_prev
2294  step_next = file_external_input_item(nid)%data_step_next
2295 
2296  time_prev = file_external_input_item(nid)%time( step_prev )
2297  time_next = file_external_input_item(nid)%time( step_next )
2298 
2299  weight = ( time_current - time_prev ) &
2300  / ( time_next - time_prev )
2301 
2302  endif
2303 
2304  return
2305  end subroutine file_external_input_time_advance
2306 
2307 
2308  function file_external_input_getid( varname ) result( nid )
2309  character(len=*), intent(in) :: varname
2310 
2311  integer nid, n
2312 
2313  ! searching the data ID
2314  nid = 0
2315  do n = 1, file_external_input_item_count
2316  if( varname == file_external_input_item(n)%varname ) then
2317  nid = n
2318  exit
2319  end if
2320  enddo
2321 
2322  return
2323  end function file_external_input_getid
2324 
2325 end module scale_file_external_input
scale_time::time_nowdaysec
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:72
scale_file_external_input::file_external_input_read_3d
procedure(read3d), pointer, public file_external_input_read_3d
Definition: scale_file_external_input.F90:166
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:350
scale_file_external_input::file_external_input_put_ref_3d
subroutine file_external_input_put_ref_3d(varname, var, error)
Definition: scale_file_external_input.F90:1781
scale_file_external_input::file_external_input_get_ref_1d
subroutine file_external_input_get_ref_1d(varname, var, error, i_step)
Get reference data.
Definition: scale_file_external_input.F90:1904
scale_file_external_input::file_external_input_query
subroutine, public file_external_input_query(varname, time_current, do_readdata)
Check time to read.
Definition: scale_file_external_input.F90:2027
scale_file_external_input::file_external_input_update_2d
subroutine file_external_input_update_2d(varname, time_current, var, error)
Read data.
Definition: scale_file_external_input.F90:1361
scale_file::file_open
subroutine, public file_open(basename, fid, mode, single, allnodes, aggregate, rankid, postfix)
Definition: scale_file.F90:536
scale_calendar::calendar_daysec2date
subroutine, public calendar_daysec2date(ymdhms, subsec, absday, abssec, offset_year)
Convert from gregorian date to absolute day/second.
Definition: scale_calendar.F90:255
scale_calendar::calendar_combine_daysec
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
Definition: scale_calendar.F90:467
scale_precision
module PRECISION
Definition: scale_precision.F90:14
scale_file_external_input::file_external_input_update_1d
subroutine file_external_input_update_1d(varname, time_current, var, error)
Read data.
Definition: scale_file_external_input.F90:1237
scale_file_external_input::file_external_input_finalize
subroutine, public file_external_input_finalize
finalize
Definition: scale_file_external_input.F90:335
scale_file_external_input::file_external_input_regist_external_1d
subroutine file_external_input_regist_external_1d(varname, var, axistype, step_nmax, time_now, time_step, aggregate, allow_missing)
Regist external data.
Definition: scale_file_external_input.F90:628
scale_const::const_eps
real(rp), public const_eps
small number
Definition: scale_const.F90:35
scale_file_external_input::file_external_input_getid
integer function file_external_input_getid(varname)
Definition: scale_file_external_input.F90:2309
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:91
scale_file_external_input::file_external_input_regist_external_2d
subroutine file_external_input_regist_external_2d(varname, var, axistype, step_nmax, time_now, time_step, aggregate, allow_missing)
Regist external data.
Definition: scale_file_external_input.F90:682
scale_file_external_input::file_external_input_setup
subroutine, public file_external_input_setup
Setup.
Definition: scale_file_external_input.F90:236
scale_file_external_input::file_external_input_get_dims3d
procedure(get_dims3d), pointer, public file_external_input_get_dims3d
Definition: scale_file_external_input.F90:159
scale_file_external_input::file_external_input_put_ref_2d
subroutine file_external_input_put_ref_2d(varname, var, error)
Definition: scale_file_external_input.F90:1679
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:13
scale_file_external_input::file_external_input_put_ref_1d
subroutine file_external_input_put_ref_1d(varname, var, error)
Put reference data.
Definition: scale_file_external_input.F90:1624
scale_file
module file
Definition: scale_file.F90:15
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_file_external_input::file_external_input_regist_file
subroutine file_external_input_regist_file(basename, basename_add_num, number_of_files, varname, axistype, enable_periodic_year, enable_periodic_month, enable_periodic_day, step_fixed, defval, check_coordinates, aggregate, allow_missing, step_limit, update_dt, exist)
Regist data.
Definition: scale_file_external_input.F90:798
scale_const
module CONSTANT
Definition: scale_const.F90:11
scale_file_external_input::i_prev
integer, parameter, public i_prev
[index] previous
Definition: scale_file_external_input.F90:174
scale_file_external_input::file_external_input_read_2d
procedure(read2d), pointer, public file_external_input_read_2d
Definition: scale_file_external_input.F90:165
scale_calendar::calendar_date2daysec
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.
Definition: scale_calendar.F90:192
scale_prof
module profiler
Definition: scale_prof.F90:11
scale_calendar::calendar_adjust_daysec
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
Definition: scale_calendar.F90:442
scale_precision::dp
integer, parameter, public dp
Definition: scale_precision.F90:32
scale_file_h
module file_h
Definition: scale_file_h.F90:11
scale_time
module TIME
Definition: scale_time.F90:11
scale_calendar::calendar_cfunits2sec
real(dp) function, public calendar_cfunits2sec(cftime, cfunits, offset_year, startdaysec)
Convert time in units of the CF convention to second.
Definition: scale_calendar.F90:550
scale_file_external_input::file_external_input_get_dims2d
procedure(get_dims2d), pointer, public file_external_input_get_dims2d
Definition: scale_file_external_input.F90:158
scale_calendar::i_month
integer, parameter, public i_month
[index] month
Definition: scale_calendar.F90:46
scale_file_external_input::file_external_input_read_1d
procedure(read1d), pointer, public file_external_input_read_1d
Definition: scale_file_external_input.F90:164
scale_file::file_aggregate
logical, public file_aggregate
Definition: scale_file.F90:196
scale_file_h::file_fread
integer, parameter, public file_fread
Definition: scale_file_h.F90:34
scale_file_external_input::i_next
integer, parameter, public i_next
[index] next
Definition: scale_file_external_input.F90:175
scale_file_external_input::file_external_input_update_3d
subroutine file_external_input_update_3d(varname, time_current, var, error)
Read data.
Definition: scale_file_external_input.F90:1490
scale_calendar::i_year
integer, parameter, public i_year
[index] year
Definition: scale_calendar.F90:45
scale_file_external_input::file_external_input_regist_external_3d
subroutine file_external_input_regist_external_3d(varname, var, axistype, step_nmax, time_now, time_step, aggregate, allow_missing)
Regist external data.
Definition: scale_file_external_input.F90:736
scale_calendar::i_day
integer, parameter, public i_day
[index] day
Definition: scale_calendar.F90:47
scale_file_external_input
module file / external_input
Definition: scale_file_external_input.F90:12
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_file_external_input::file_external_input_get_dims1d
procedure(get_dims1d), pointer, public file_external_input_get_dims1d
Definition: scale_file_external_input.F90:157
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:57
scale_time::time_startdaysec
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:77
scale_file_cartesc
module file / cartesianC
Definition: scale_file_cartesC.F90:11
scale_time::time_offset_year
integer, public time_offset_year
time offset [year]
Definition: scale_time.F90:76