SCALE-RM
scale_file_external_input.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 #include "scalelib.h"
12 module scale_file_external_input
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  !
27  public :: file_external_input_setup
28  public :: file_external_input_regist
29  public :: file_external_input_update
30 
31  interface file_external_input_update
32  module procedure file_external_input_update_1d
33  module procedure file_external_input_update_2d
34  module procedure file_external_input_update_3d
35  end interface file_external_input_update
36 
37  abstract interface
38  subroutine get_dims1d( &
39  dim1_size, &
40  dim1_max, &
41  dim1_S, &
42  varname, &
43  axistype )
44  integer, intent(out) :: dim1_size
45  integer, intent(out) :: dim1_max
46  integer, intent(out) :: dim1_S
47  character(len=*), intent(in) :: varname
48  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
49  end subroutine get_dims1d
50 
51  subroutine get_dims2d( &
52  dim1_size, &
53  dim1_max, &
54  dim1_S, &
55  dim2_size, &
56  dim2_max, &
57  dim2_S, &
58  transpose, &
59  varname, &
60  axistype )
61  integer, intent(out) :: dim1_size
62  integer, intent(out) :: dim1_max
63  integer, intent(out) :: dim1_S
64  integer, intent(out) :: dim2_size
65  integer, intent(out) :: dim2_max
66  integer, intent(out) :: dim2_S
67  logical, intent(out) :: transpose
68  character(len=*), intent(in) :: varname
69  character(len=*), intent(in) :: axistype ! axis type (XY/XZ/ZX)
70  end subroutine get_dims2d
71 
72  subroutine get_dims3d( &
73  dim1_size, &
74  dim1_max, &
75  dim1_S, &
76  dim2_size, &
77  dim2_max, &
78  dim2_S, &
79  dim3_size, &
80  dim3_max, &
81  dim3_S, &
82  transpose, &
83  varname, &
84  axistype )
85  integer, intent(out) :: dim1_size
86  integer, intent(out) :: dim1_max
87  integer, intent(out) :: dim1_S
88  integer, intent(out) :: dim2_size
89  integer, intent(out) :: dim2_max
90  integer, intent(out) :: dim2_S
91  integer, intent(out) :: dim3_size
92  integer, intent(out) :: dim3_max
93  integer, intent(out) :: dim3_S
94  logical, intent(out) :: transpose
95  character(len=*), intent(in) :: varname
96  character(len=*), intent(in) :: axistype ! axis type (ZXY/XYZ/Land/Urban)
97  end subroutine get_dims3d
98 
99  subroutine read1d( fid, varname, dim_type, &
100  var, &
101  step )
102  use scale_precision
103  integer, intent(in) :: fid
104  character(len=*), intent(in) :: varname
105  character(len=*), intent(in) :: dim_type
106  real(RP), intent(out) :: var(:)
107  integer, intent(in), optional :: step
108  end subroutine read1d
109 
110  subroutine read2d( fid, varname, dim_type, &
111  var, &
112  step )
113  use scale_precision
114  integer, intent(in) :: fid
115  character(len=*), intent(in) :: varname
116  character(len=*), intent(in) :: dim_type
117  real(RP), intent(out) :: var(:,:)
118  integer, intent(in), optional :: step
119  end subroutine read2d
120 
121  subroutine read3d( fid, varname, dim_type, &
122  var, &
123  step )
124  use scale_precision
125  integer, intent(in) :: fid
126  character(len=*), intent(in) :: varname
127  character(len=*), intent(in) :: dim_type
128  real(RP), intent(out) :: var(:,:,:)
129  integer, intent(in), optional :: step
130  end subroutine read3d
131 
132  end interface
133 
134  procedure(get_dims1d), pointer :: file_external_input_get_dims1d => null()
135  procedure(get_dims2d), pointer :: file_external_input_get_dims2d => null()
136  procedure(get_dims3d), pointer :: file_external_input_get_dims3d => null()
137  public :: file_external_input_get_dims1d
138  public :: file_external_input_get_dims2d
139  public :: file_external_input_get_dims3d
140 
141  procedure(read1d), pointer :: file_external_input_read_1d => null()
142  procedure(read2d), pointer :: file_external_input_read_2d => null()
143  procedure(read3d), pointer :: file_external_input_read_3d => null()
144  public :: file_external_input_read_1d
145  public :: file_external_input_read_2d
146  public :: file_external_input_read_3d
147  !-----------------------------------------------------------------------------
148  !
149  !++ Public parameters & variables
150  !
151  !-----------------------------------------------------------------------------
152  !
153  !++ Private procedures
154  !
155  private :: file_external_input_time_advance
156 
157  !-----------------------------------------------------------------------------
158  !
159  !++ Private parameters & variables
160  !
161  integer, private, parameter :: i_prev = 1
162  integer, private, parameter :: i_next = 2
163 
164  integer, private, parameter :: i_periodic_year = 1
165  integer, private, parameter :: i_periodic_month = 2
166  integer, private, parameter :: i_periodic_day = 3
167 
168  integer, private, parameter :: file_external_input_item_limit = 1000
169  integer, private, parameter :: file_external_input_step_limit = 10000
170  integer, private, parameter :: file_external_input_dim_limit = 3
171  integer, private, parameter :: file_external_input_att_limit = 10
172 
173  type, private :: itemcontainer
174  character(len=H_SHORT) :: varname
175  integer :: nfile
176  integer :: file_current
177  character(len=H_LONG), allocatable :: basename(:)
178  integer :: fid
179  integer :: ndim
180  integer :: dim_size(file_external_input_dim_limit)
181  integer :: dim_start(file_external_input_dim_limit)
182  integer :: var_start(file_external_input_dim_limit)
183  integer :: step_limit
184  integer :: step_num
185  real(dp), allocatable :: time(:)
186  logical :: fixed_step
187  integer :: flag_periodic
188  real(rp) :: offset
189  integer :: data_step_prev
190  integer :: data_step_next
191  integer :: data_step_offset
192  real(rp), allocatable :: value(:,:,:,:)
193  character(len=H_SHORT) :: axistype
194  logical :: transpose
195  logical :: aggregate
196  logical :: allow_missing
197  end type itemcontainer
198 
199  integer, private :: file_external_input_item_count = 0
200  type(itemcontainer), private :: file_external_input_item(file_external_input_item_limit)
201 
202  !-----------------------------------------------------------------------------
203 contains
204  !-----------------------------------------------------------------------------
206  subroutine file_external_input_setup
207  use scale_prc, only: &
208  prc_abort
209  use scale_const, only: &
210  undef => const_undef
211  use scale_file, only: &
212  file_aggregate_default => file_aggregate
213  implicit none
214 
215  character(len=H_LONG) :: basename
216  logical :: basename_add_num
217  integer :: number_of_files
218  character(len=H_SHORT) :: varname
219  character(len=H_SHORT) :: axistype
220  integer :: step_limit ! limit number for reading data
221  integer :: step_fixed ! fixed step position to read
222  logical :: enable_periodic_year ! treat as yearly periodic data?
223  logical :: enable_periodic_month ! treat as yearly,monthly periodic data?
224  logical :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
225  real(rp) :: offset
226  real(rp) :: defval
227  logical :: check_coordinates
228  logical :: file_aggregate
229  logical :: allow_missing
230 
231  namelist / external_item / &
232  basename, &
233  basename_add_num, &
234  number_of_files, &
235  varname, &
236  axistype, &
237  step_limit, &
238  step_fixed, &
239  enable_periodic_year, &
240  enable_periodic_month, &
241  enable_periodic_day, &
242  offset, &
243  defval, &
244  check_coordinates, &
245  file_aggregate, &
246  allow_missing
247 
248  integer :: count
249  integer :: ierr
250  !---------------------------------------------------------------------------
251 
252  log_newline
253  log_info("FILE_EXTERNAL_INPUT_setup",*) 'Setup'
254 
255  ! count external data from namelist
256  rewind(io_fid_conf)
257  do count = 1, file_external_input_item_limit
258  ! set default
259  step_limit = file_external_input_step_limit
260  basename = ''
261  basename_add_num = .false.
262  number_of_files = 1
263  varname = ''
264  axistype = ''
265  step_fixed = -1
266  enable_periodic_year = .false.
267  enable_periodic_month = .false.
268  enable_periodic_day = .false.
269  offset = 0.0_rp
270  defval = undef
271  check_coordinates = .false.
272  file_aggregate = file_aggregate_default
273  allow_missing = .false.
274 
275  ! read namelist
276  read(io_fid_conf,nml=external_item,iostat=ierr)
277  if ( ierr < 0 ) then !--- no more items
278  exit
279  elseif( ierr > 0 ) then !--- fatal error
280  log_error("FILE_EXTERNAL_INPUT_setup",*) 'Not appropriate names in namelist EXTERNAL_ITEM. Check!', count
281  call prc_abort
282  endif
283  log_nml(external_item)
284 
285  call file_external_input_regist( basename, & ! [IN]
286  basename_add_num, & ! [IN]
287  number_of_files, & ! [IN]
288  varname, & ! [IN]
289  axistype, & ! [IN]
290  enable_periodic_year, & ! [IN]
291  enable_periodic_month, & ! [IN]
292  enable_periodic_day, & ! [IN]
293  step_fixed, & ! [IN]
294  offset, & ! [IN]
295  defval, & ! [IN]
296  check_coordinates = check_coordinates, & ! [IN]
297  aggregate = file_aggregate, & ! [IN]
298  allow_missing = allow_missing, & ! [IN]
299  step_limit = step_limit ) ! [IN]
300  enddo
301 
302  return
303  end subroutine file_external_input_setup
304 
305  !-----------------------------------------------------------------------------
307  subroutine file_external_input_regist( &
308  basename, &
309  basename_add_num, &
310  number_of_files, &
311  varname, &
312  axistype, &
313  enable_periodic_year, &
314  enable_periodic_month, &
315  enable_periodic_day, &
316  step_fixed, &
317  offset, &
318  defval, &
319  check_coordinates, &
320  aggregate, &
321  allow_missing, &
322  step_limit, &
323  exist )
324  use scale_file_h, only: &
325  file_fread
326  use scale_file, only: &
327  file_aggregate, &
328  file_open, &
329  file_get_all_datainfo, &
330  file_read
331  use scale_prc, only: &
332  prc_myrank, &
333  prc_abort
334  use scale_calendar, only: &
335  calendar_adjust_daysec, &
336  calendar_daysec2date, &
337  calendar_date2daysec, &
338  calendar_combine_daysec, &
339  calendar_cfunits2sec, &
340  i_year, &
341  i_month, &
342  i_day
343  use scale_time, only: &
344  time_startdaysec, &
345  time_nowdaysec, &
346  time_offset_year
347  use scale_file_cartesc, only: &
348  file_cartesc_check_coordinates
349  implicit none
350 
351  character(len=*), intent(in) :: basename
352  logical, intent(in) :: basename_add_num
353  integer, intent(in) :: number_of_files
354  character(len=*), intent(in) :: varname
355  character(len=*), intent(in) :: axistype
356  integer, intent(in) :: step_fixed ! fixed step position to read
357  logical, intent(in) :: enable_periodic_year ! treat as yearly periodic data?
358  logical, intent(in) :: enable_periodic_month ! treat as yearly,monthly periodic data?
359  logical, intent(in) :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
360  real(rp), intent(in) :: offset
361  real(rp), intent(in) :: defval
362 
363  logical, intent(in), optional :: check_coordinates
364  logical, intent(in), optional :: aggregate
365  logical, intent(in), optional :: allow_missing
366  integer, intent(in), optional :: step_limit ! limit number for reading data
367  logical, intent(out), optional :: exist
368 
369  integer :: step_nmax
370  character(len=H_MID) :: description
371  character(len=H_SHORT) :: unit
372  character(len=H_MID) :: standard_name
373  integer :: datatype
374  integer :: dim_rank
375  character(len=H_SHORT) :: dim_name (file_external_input_dim_limit)
376  integer :: dim_size (file_external_input_dim_limit)
377  integer :: var_size (file_external_input_dim_limit)
378  integer :: natts
379  character(len=H_SHORT) :: att_name (file_external_input_att_limit)
380  integer :: att_type (file_external_input_att_limit)
381  integer :: att_len (file_external_input_att_limit)
382  real(dp) :: time_start(file_external_input_step_limit)
383  real(dp) :: time_end (file_external_input_step_limit)
384  character(len=H_MID) :: time_units
385  character(len=H_SHORT) :: calendar
386 
387  integer :: datadate(6)
388  real(dp) :: datasubsec
389  integer :: dataday
390  real(dp) :: datasec
391  integer :: offset_year
392 
393  integer :: dim1_size, dim1_max, dim1_s
394  integer :: dim2_size, dim2_max, dim2_s
395  integer :: dim3_size, dim3_max, dim3_s
396 
397  integer :: step_limit_
398  logical :: aggregate_
399  logical :: allow_missing_
400 
401  character(len=H_LONG) :: filename
402 
403  integer :: fid
404  integer :: nid, n
405  !---------------------------------------------------------------------------
406 
407  if ( present(step_limit) ) then
408  if ( step_limit > 0 ) then
409  step_limit_ = step_limit
410  else
411  step_limit_ = file_external_input_step_limit
412  endif
413  else
414  step_limit_ = file_external_input_step_limit
415  endif
416 
417  if ( present(aggregate) ) then
418  aggregate_ = aggregate
419  else
420  aggregate_ = file_aggregate
421  end if
422 
423  if ( present(allow_missing) ) then
424  allow_missing_ = allow_missing
425  else
426  allow_missing_ = .false.
427  end if
428 
429  do nid = 1, file_external_input_item_count
430  if ( file_external_input_item(nid)%varname == varname ) then
431  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Data is already registered! basename,varname = ', trim(basename), ', ', trim(varname)
432  call prc_abort
433  endif
434  enddo
435 
436  file_external_input_item_count = file_external_input_item_count + 1
437 
438  if ( file_external_input_item_count > file_external_input_item_limit ) then
439  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Number of EXT data exceedes the limit', file_external_input_item_count, file_external_input_item_limit
440  call prc_abort
441  endif
442 
443  if ( number_of_files > 1 .or. basename_add_num ) then
444  filename = trim(basename) // '_00000'
445  else
446  filename = basename
447  end if
448 
449  call file_open( filename, & ! [IN]
450  fid, & ! [OUT]
451  aggregate=aggregate_, & ! [IN]
452  rankid=prc_myrank ) ! [IN]
453 
454  ! read from file
455  call file_get_all_datainfo( fid, varname, & ! [IN]
456  step_nmax, & ! [OUT]
457  description, unit, standard_name, & ! [OUT]
458  datatype, & ! [OUT]
459  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
460  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
461  time_start(1:step_limit_), time_end(1:step_limit_), & ! [OUT]
462  time_units, calendar ) ! [OUT]
463 
464  if ( step_nmax > 0 ) then
465  if ( present(exist) ) then
466  exist = .true.
467  endif
468  else
469  if ( present(exist) ) then
470  exist = .false.
471  return
472  else
473  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Data not found! filename,varname = ', trim(filename), ', ', trim(varname)
474  call prc_abort
475  endif
476  endif
477 
478  do n = dim_rank+1, 3
479  dim_size(n) = 1
480  var_size(n) = 1
481  enddo
482 
483  nid = file_external_input_item_count
484 
485  file_external_input_item(nid)%nfile = number_of_files
486  file_external_input_item(nid)%file_current = 1
487  file_external_input_item(nid)%data_step_offset = 0
488 
489  allocate( file_external_input_item(nid)%basename(number_of_files) )
490  if ( number_of_files > 1 .or. basename_add_num ) then
491  do n = 1, number_of_files
492  write(filename,'(A,A,I5.5)') trim(basename), '_', n - 1
493  file_external_input_item(nid)%basename(n) = filename
494  enddo
495  else
496  file_external_input_item(nid)%basename(1) = basename
497  end if
498 
499  ! setup item
500  file_external_input_item(nid)%fid = fid
501  file_external_input_item(nid)%varname = varname
502  file_external_input_item(nid)%axistype = axistype
503  file_external_input_item(nid)%ndim = dim_rank
504  file_external_input_item(nid)%step_num = step_nmax
505  file_external_input_item(nid)%step_limit = step_limit_
506  file_external_input_item(nid)%allow_missing = allow_missing_
507  file_external_input_item(nid)%aggregate = aggregate_
508 
509 
510  select case ( dim_rank )
511  case ( 1 )
512 
513  call file_external_input_get_dims1d( dim1_size, dim1_max, dim1_s, & ! [OUT]
514  varname, axistype ) ! [IN]
515 
516  if ( aggregate_ ) then
517  dim_size(1) = dim1_max
518  var_size(1) = dim1_size
519  file_external_input_item(nid)%var_start(1) = dim1_s
520  else
521  if ( dim1_max /= dim_size(1) ) then
522  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
523  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
524  call prc_abort
525  endif
526  var_size(1) = dim1_max
527  file_external_input_item(nid)%var_start(1) = 1
528  end if
529 
530  file_external_input_item(nid)%transpose = .false.
531  file_external_input_item(nid)%dim_start(1) = dim1_s
532 
533  case ( 2 )
534 
535  call file_external_input_get_dims2d( dim1_size, dim1_max, dim1_s, & ! [OUT]
536  dim2_size, dim2_max, dim2_s, & ! [OUT]
537  file_external_input_item(nid)%transpose, & ! [OUT]
538  varname, axistype ) ! [IN]
539 
540  if ( aggregate_ ) then
541  dim_size(1) = dim1_max
542  var_size(1) = dim1_size
543  dim_size(2) = dim2_max
544  var_size(2) = dim2_size
545  file_external_input_item(nid)%var_start(1) = dim1_s
546  file_external_input_item(nid)%var_start(1) = dim2_s
547  else
548  if ( dim1_max /= dim_size(1) &
549  .OR. dim2_max /= dim_size(2) ) then
550  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
551  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
552  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
553  call prc_abort
554  endif
555  var_size(1) = dim1_max
556  var_size(2) = dim2_max
557  file_external_input_item(nid)%var_start(1) = 1
558  file_external_input_item(nid)%var_start(1) = 1
559  end if
560 
561  file_external_input_item(nid)%dim_start(1) = dim1_s
562  file_external_input_item(nid)%dim_start(2) = dim2_s
563 
564  case ( 3 )
565 
566  call file_external_input_get_dims3d( dim1_size, dim1_max, dim1_s, & ! [OUT]
567  dim2_size, dim2_max, dim2_s, & ! [OUT]
568  dim3_size, dim3_max, dim3_s, & ! [OUT]
569  file_external_input_item(nid)%transpose, & ! [OUT]
570  varname, axistype ) ! [IN]
571 
572  if ( aggregate_ ) then
573  dim_size(1) = dim1_max
574  var_size(1) = dim1_size
575  dim_size(2) = dim2_max
576  var_size(2) = dim2_size
577  dim_size(3) = dim3_max
578  var_size(3) = dim3_size
579  file_external_input_item(nid)%var_start(1) = dim1_s
580  file_external_input_item(nid)%var_start(2) = dim2_s
581  file_external_input_item(nid)%var_start(3) = dim3_s
582  else
583  if ( dim1_max /= dim_size(1) &
584  .OR. dim2_max /= dim_size(2) &
585  .OR. dim3_max /= dim_size(3) ) then
586  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
587  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
588  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
589  log_error_cont(*) 'dim 3 (data,requested) : ', dim_size(3), dim3_max
590  call prc_abort
591  endif
592  var_size(1) = dim1_max
593  var_size(2) = dim2_max
594  var_size(3) = dim3_max
595  file_external_input_item(nid)%var_start(1) = 1
596  file_external_input_item(nid)%var_start(2) = 1
597  file_external_input_item(nid)%var_start(3) = 1
598  end if
599 
600  file_external_input_item(nid)%dim_start(1) = dim1_s
601  file_external_input_item(nid)%dim_start(2) = dim2_s
602  file_external_input_item(nid)%dim_start(3) = dim3_s
603 
604  case default
605  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Unexpected dim rank: ', dim_rank
606  call prc_abort
607  end select
608 
609  file_external_input_item(nid)%dim_size(:) = dim_size(:)
610 
611 
612  if ( enable_periodic_day ) then
613  file_external_input_item(nid)%flag_periodic = i_periodic_day
614  elseif( enable_periodic_month ) then
615  file_external_input_item(nid)%flag_periodic = i_periodic_month
616  elseif( enable_periodic_year ) then
617  file_external_input_item(nid)%flag_periodic = i_periodic_year
618  else
619  file_external_input_item(nid)%flag_periodic = 0
620  endif
621 
622  allocate( file_external_input_item(nid)%value(var_size(1),var_size(2),var_size(3),2) )
623 
624 
625  file_external_input_item(nid)%value(:,:,:,:) = defval
626  file_external_input_item(nid)%offset = offset
627 
628  allocate( file_external_input_item(nid)%time(step_limit_) )
629  file_external_input_item(nid)%time(:) = 0.0_dp
630 
631  do n = 1, file_external_input_item(nid)%step_num
632  file_external_input_item(nid)%time(n) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
633  enddo
634 
635  if ( file_external_input_item(nid)%step_num == 1 ) then
636 
637  file_external_input_item(nid)%fixed_step = .true.
638  file_external_input_item(nid)%data_step_prev = 1
639  file_external_input_item(nid)%data_step_next = 1
640 
641  else if ( step_fixed > 0 ) then ! fixed time step mode
642 
643  file_external_input_item(nid)%fixed_step = .true.
644  file_external_input_item(nid)%data_step_prev = step_fixed
645  file_external_input_item(nid)%data_step_next = step_fixed
646 
647  else
648 
649  file_external_input_item(nid)%fixed_step = .false.
650 
651  ! seek start position
652  file_external_input_item(nid)%data_step_next = 1
653  do n = 1, file_external_input_item(nid)%step_num
654  if ( file_external_input_item(nid)%time(n) > time_nowdaysec ) exit
655  file_external_input_item(nid)%data_step_next = n + 1
656  enddo
657 
658  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_next - 1
659 
660  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
661 
662  if ( file_external_input_item(nid)%data_step_next == 1 ) then ! between first-1 and first
663 
664  ! first-1 = last
665  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%step_num
666 
667  elseif( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then ! between last and last+1
668 
669  ! last+1 = first
670  file_external_input_item(nid)%data_step_next = 1
671 
672  ! update data time in periodic condition
673  do n = 1, file_external_input_item(nid)%step_num
674  dataday = 0
675  datasec = file_external_input_item(nid)%time(n)
676  offset_year = 0
677  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
678 
679  call calendar_daysec2date( datadate(:), & ! [OUT]
680  datasubsec, & ! [OUT]
681  dataday, & ! [IN]
682  datasec, & ! [IN]
683  offset_year ) ! [IN]
684 
685  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
686  datadate(i_day) = datadate(i_day) + 1
687  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
688  datadate(i_month) = datadate(i_month) + 1
689  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
690  datadate(i_year) = datadate(i_year) + 1
691  endif
692 
693  call calendar_date2daysec( dataday, & ! [OUT]
694  datasec, & ! [OUT]
695  datadate(:), & ! [IN]
696  datasubsec, & ! [IN]
697  offset_year ) ! [IN]
698 
699  file_external_input_item(nid)%time(n) = calendar_combine_daysec( dataday, datasec )
700  enddo
701 
702  log_info("FILE_EXTERNAL_INPUT_regist",*) 'data time is updated.'
703  endif
704 
705  else ! normal mode
706 
707  if ( file_external_input_item(nid)%data_step_next == 1 &
708  .OR. file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
709  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Current time is out of period of external data! ', trim(varname)
710  call prc_abort
711  endif
712 
713  endif
714 
715  endif
716 
717  !--- read first data
718  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A15)') 'Initial read of external data : ', trim(varname)
719 
720  select case ( dim_rank )
721  case ( 1 )
722 
723  ! read prev
724  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
725  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
726  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
727 
728  if ( file_external_input_item(nid)%aggregate ) then
729  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
730  file_external_input_item(nid)%varname, & ! [IN]
731  file_external_input_item(nid)%axistype, & ! [IN]
732  file_external_input_item(nid)%value(:,1,1,i_prev), & ! [OUT]
733  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
734  else
735  call file_read( file_external_input_item(nid)%fid, & ! [IN]
736  file_external_input_item(nid)%varname, & ! [IN]
737  file_external_input_item(nid)%value(:,1,1,i_prev), & ! [OUT]
738  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
739  end if
740 
741  ! read next
742  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
743  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
744  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
745 
746  if ( file_external_input_item(nid)%aggregate ) then
747  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
748  file_external_input_item(nid)%varname, & ! [IN]
749  file_external_input_item(nid)%axistype, & ! [IN]
750  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
751  step=file_external_input_item(nid)%data_step_next ) ! [IN]
752  else
753  call file_read( file_external_input_item(nid)%fid, & ! [IN]
754  file_external_input_item(nid)%varname, & ! [IN]
755  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
756  step=file_external_input_item(nid)%data_step_next ) ! [IN]
757  end if
758 
759  case ( 2 )
760 
761  ! read prev
762  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
763  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
764  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
765 
766  if ( file_external_input_item(nid)%aggregate ) then
767  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
768  file_external_input_item(nid)%varname, & ! [IN]
769  file_external_input_item(nid)%axistype, & ! [IN]
770  file_external_input_item(nid)%value(:,:,1,i_prev), & ! [OUT]
771  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
772  else
773  call file_read( file_external_input_item(nid)%fid, & ! [IN]
774  file_external_input_item(nid)%varname, & ! [IN]
775  file_external_input_item(nid)%value(:,:,1,i_prev), & ! [OUT]
776  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
777  end if
778  ! read next
779  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
780  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
781  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
782 
783  if ( file_external_input_item(nid)%aggregate ) then
784  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
785  file_external_input_item(nid)%varname, & ! [IN]
786  file_external_input_item(nid)%axistype, & ! [IN]
787  file_external_input_item(nid)%value(:,:,1,i_next), & ! [OUT]
788  step=file_external_input_item(nid)%data_step_next ) ! [IN]
789  else
790  call file_read( file_external_input_item(nid)%fid, & ! [IN]
791  file_external_input_item(nid)%varname, & ! [IN]
792  file_external_input_item(nid)%value(:,:,1,i_next), & ! [OUT]
793  step=file_external_input_item(nid)%data_step_next ) ! [IN]
794  end if
795 
796  case ( 3 )
797 
798  ! read prev
799  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
800  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
801  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
802 
803  if ( file_external_input_item(nid)%aggregate ) then
804  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
805  file_external_input_item(nid)%varname, & ! [IN]
806  file_external_input_item(nid)%axistype, & ! [IN]
807  file_external_input_item(nid)%value(:,:,:,i_prev), & ! [OUT]
808  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
809  else
810  call file_read( file_external_input_item(nid)%fid, & ! [IN]
811  file_external_input_item(nid)%varname, & ! [IN]
812  file_external_input_item(nid)%value(:,:,:,i_prev), & ! [OUT]
813  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
814  end if
815 
816  ! read next
817  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
818  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
819  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
820 
821  if ( file_external_input_item(nid)%aggregate ) then
822  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
823  file_external_input_item(nid)%varname, & ! [IN]
824  file_external_input_item(nid)%axistype, & ! [IN]
825  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
826  step=file_external_input_item(nid)%data_step_next ) ! [IN]
827  else
828  call file_read( file_external_input_item(nid)%fid, & ! [IN]
829  file_external_input_item(nid)%varname, & ! [IN]
830  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
831  step=file_external_input_item(nid)%data_step_next ) ! [IN]
832  end if
833 
834  case default
835  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Unexpected dim rank: ', dim_rank
836  call prc_abort
837  end select
838 
839  if ( present(check_coordinates) ) then
840  if ( check_coordinates ) then
841  call file_cartesc_check_coordinates( fid, &
842  atmos = file_external_input_item(nid)%ndim==3, &
843  transpose = file_external_input_item(nid)%transpose )
844  endif
845  endif
846 
847 
848  return
849  end subroutine file_external_input_regist
850 
851  !-----------------------------------------------------------------------------
853  subroutine file_external_input_update_1d( &
854  varname, &
855  time_current, &
856  var, &
857  error )
858  use scale_const, only: &
859  undef => const_undef
860  use scale_file, only: &
861  file_read
862  implicit none
863  character(len=*), intent(in) :: varname ! item name
864  real(DP), intent(in) :: time_current ! current time
865  real(RP), intent(out) :: var(:) ! variable
866  logical, intent(out) :: error ! error code
867 
868  integer :: nid
869  real(RP) :: weight
870  logical :: do_readfile
871  integer :: step_next
872 
873  integer :: n
874  integer :: n1
875  integer :: nn1
876  !---------------------------------------------------------------------------
877 
878  ! searching the data ID
879  nid = -1
880  do n = 1, file_external_input_item_count
881  if( varname == file_external_input_item(n)%varname ) nid = n
882  enddo
883 
884  if ( nid == 0 ) then
885  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'Variable was not registered: ', trim(varname)
886  error = .true.
887  return
888  endif
889 
890  if ( file_external_input_item(nid)%ndim /= 1 ) then
891  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'Data is not 1D var: ', trim(file_external_input_item(nid)%varname)
892  error = .true.
893  return
894  endif
895 
896  call file_external_input_time_advance( nid, & ! [IN]
897  time_current, & ! [IN]
898  weight, & ! [OUT]
899  do_readfile ) ! [OUT]
900 
901  if ( do_readfile ) then
902  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
903 
904  log_info("FILE_EXTERNAL_INPUT_update_1D",'(1x,A,A,A,I4,A,I4,A)') &
905  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
906  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
907 
908  ! next -> prev
909  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
910 
911  ! read next
912  if ( file_external_input_item(nid)%aggregate ) then
913  call file_external_input_read_1d( file_external_input_item(nid)%fid, & ! [IN]
914  file_external_input_item(nid)%varname, & ! [IN]
915  file_external_input_item(nid)%axistype, & ! [IN]
916  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
917  step=file_external_input_item(nid)%data_step_next ) ! [IN]
918  else
919  call file_read( file_external_input_item(nid)%fid, & ! [IN]
920  file_external_input_item(nid)%varname, & ! [IN]
921  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
922  step=step_next ) ! [IN]
923  end if
924  endif
925 
926  error = .false.
927 
928  ! store data with weight
929  do n1 = 1, file_external_input_item(nid)%dim_size(1)
930  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
931 
932  if ( abs( file_external_input_item(nid)%value(n1,1,1,i_prev) - undef ) > abs( undef * 0.1_rp ) &
933  .and. abs( file_external_input_item(nid)%value(n1,1,1,i_next) - undef ) > abs( undef * 0.1_rp ) ) then
934  var(nn1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,1,1,i_prev) &
935  + ( weight ) * file_external_input_item(nid)%value(n1,1,1,i_next)
936  else
937  if ( file_external_input_item(nid)%allow_missing ) then
938  var(nn1) = undef
939  else
940  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'missing value is found in ', &
941  trim(file_external_input_item(nid)%varname), ' at (',n1,')'
942  error = .true.
943  exit
944  end if
945  end if
946  enddo
947 
948  return
949  end subroutine file_external_input_update_1d
950 
951  !-----------------------------------------------------------------------------
953  subroutine file_external_input_update_2d( &
954  varname, &
955  time_current, &
956  var, &
957  error )
958  use scale_const, only: &
959  undef => const_undef
960  use scale_file, only: &
961  file_read
962  implicit none
963  character(len=*), intent(in) :: varname ! item name
964  real(DP), intent(in) :: time_current ! current time
965  real(RP), intent(out) :: var(:,:) ! variable
966  logical, intent(out) :: error ! error code
967 
968  integer :: nid
969  real(RP) :: weight
970  logical :: do_readfile
971  integer :: step_next
972 
973  integer :: n
974  integer :: n1, n2
975  integer :: nn1, nn2
976  !---------------------------------------------------------------------------
977 
978  ! searching the data ID
979  nid = -1
980  do n = 1, file_external_input_item_count
981  if( varname == file_external_input_item(n)%varname ) nid = n
982  enddo
983 
984  if ( nid == 0 ) then
985  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'Variable was not registered: ', trim(varname)
986  error = .true.
987  return
988  endif
989 
990  if ( file_external_input_item(nid)%ndim /= 2 ) then
991  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'Data is not 2D var: ', trim(file_external_input_item(nid)%varname)
992  error = .true.
993  return
994  endif
995 
996  call file_external_input_time_advance( nid, & ! [IN]
997  time_current, & ! [IN]
998  weight, & ! [OUT]
999  do_readfile ) ! [OUT]
1000 
1001  if ( do_readfile ) then
1002 
1003  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
1004 
1005  log_info("FILE_EXTERNAL_INPUT_update_2D",'(1x,A,A,A,I4,A,I4,A)') &
1006  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
1007  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
1008 
1009  ! next -> prev
1010  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
1011 
1012  ! read next
1013  if ( file_external_input_item(nid)%aggregate ) then
1014  call file_external_input_read_2d( file_external_input_item(nid)%fid, & ! [IN]
1015  file_external_input_item(nid)%varname, & ! [IN]
1016  file_external_input_item(nid)%axistype, & ! [IN]
1017  file_external_input_item(nid)%value(:,:,1,i_next), & ! [OUT]
1018  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1019  else
1020  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1021  file_external_input_item(nid)%varname, & ! [IN]
1022  file_external_input_item(nid)%value(:,:,1,i_next), & ! [OUT]
1023  step=step_next ) ! [IN]
1024  end if
1025  endif
1026 
1027  error = .false.
1028 
1029  if ( file_external_input_item(nid)%transpose ) then
1030  ! store data with weight (x,z)->(z,x)
1031  do n1 = 1, file_external_input_item(nid)%dim_size(1)
1032  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1033 
1034  do n2 = 1, file_external_input_item(nid)%dim_size(2)
1035  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1036 
1037  if ( abs( file_external_input_item(nid)%value(n1,n2,1,i_prev) - undef ) > abs( undef * 0.1_rp ) &
1038  .and. abs( file_external_input_item(nid)%value(n1,n2,1,i_next) - undef ) > abs( undef * 0.1_rp ) ) then
1039  var(nn2,nn1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
1040  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
1041  else
1042  if ( file_external_input_item(nid)%allow_missing ) then
1043  var(nn2,nn1) = undef
1044  else
1045  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'missing value is found in ', &
1046  trim(file_external_input_item(nid)%varname), ' at (',n1,',',n2,')'
1047  error = .true.
1048  exit
1049  end if
1050  end if
1051  enddo
1052  enddo
1053  else
1054  ! store data with weight
1055  do n2 = 1, file_external_input_item(nid)%dim_size(2)
1056  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1057 
1058  do n1 = 1, file_external_input_item(nid)%dim_size(1)
1059  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1060 
1061  if ( abs( file_external_input_item(nid)%value(n1,n2,1,i_prev) - undef ) > abs( undef * 0.1_rp ) &
1062  .and. abs( file_external_input_item(nid)%value(n1,n2,1,i_next) - undef ) > abs( undef * 0.1_rp ) ) then
1063  var(nn1,nn2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
1064  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
1065  else
1066  if ( file_external_input_item(nid)%allow_missing ) then
1067  var(nn1,nn2) = undef
1068  else
1069  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'missing value is found in ', &
1070  trim(file_external_input_item(nid)%varname), ' at (',n1,',',n2,')'
1071  error = .true.
1072  exit
1073  end if
1074  end if
1075  enddo
1076  enddo
1077  endif
1078 
1079  return
1080  end subroutine file_external_input_update_2d
1081 
1082  !-----------------------------------------------------------------------------
1084  subroutine file_external_input_update_3d( &
1085  varname, &
1086  time_current, &
1087  var, &
1088  error )
1089  use scale_const, only: &
1090  undef => const_undef
1091  use scale_file, only: &
1092  file_read
1093  implicit none
1094  character(len=*), intent(in) :: varname ! item name
1095  real(DP), intent(in) :: time_current ! current time
1096  real(RP), intent(out) :: var(:,:,:) ! variable
1097  logical, intent(out) :: error ! error code
1098 
1099  integer :: nid
1100  real(RP) :: weight
1101  logical :: do_readfile
1102  integer :: step_next
1103 
1104  integer :: n
1105  integer :: n1, n2, n3
1106  integer :: nn1, nn2, nn3
1107  !---------------------------------------------------------------------------
1108 
1109  ! searching the data ID
1110  nid = -1
1111  do n = 1, file_external_input_item_count
1112  if( varname == file_external_input_item(n)%varname ) nid = n
1113  enddo
1114 
1115  if ( nid == 0 ) then
1116  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'Variable was not registered: ', trim(varname)
1117  error = .true.
1118  return
1119  endif
1120 
1121  if ( file_external_input_item(nid)%ndim /= 3 ) then
1122  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'Data is not 3D var: ', trim(file_external_input_item(nid)%varname)
1123  error = .true.
1124  return
1125  endif
1126 
1127  call file_external_input_time_advance( nid, & ! [IN]
1128  time_current, & ! [IN]
1129  weight, & ! [OUT]
1130  do_readfile ) ! [OUT]
1131 
1132  if ( do_readfile ) then
1133 
1134  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
1135 
1136  log_info("FILE_EXTERNAL_INPUT_update_3D",'(1x,A,A,A,I4,A,I4,A)') &
1137  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
1138  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
1139 
1140  ! next -> prev
1141  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
1142 
1143  ! read next
1144  if ( file_external_input_item(nid)%aggregate ) then
1145  call file_external_input_read_3d( file_external_input_item(nid)%fid, & ! [IN]
1146  file_external_input_item(nid)%varname, & ! [IN]
1147  file_external_input_item(nid)%axistype, & ! [IN]
1148  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
1149  step=file_external_input_item(nid)%data_step_next ) ! [IN]
1150  else
1151  call file_read( file_external_input_item(nid)%fid, & ! [IN]
1152  file_external_input_item(nid)%varname, & ! [IN]
1153  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
1154  step=step_next ) ! [IN]
1155  end if
1156  endif
1157 
1158  error = .false.
1159 
1160  if ( file_external_input_item(nid)%transpose ) then
1161  ! store data with weight (x,y,z)->(z,x,y)
1162  do n2 = 1, file_external_input_item(nid)%dim_size(2)
1163  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1164 
1165  do n1 = 1, file_external_input_item(nid)%dim_size(1)
1166  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1167 
1168  do n3 = 1, file_external_input_item(nid)%dim_size(3)
1169  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1170 
1171  if ( abs( file_external_input_item(nid)%value(n1,n2,n3,i_prev) - undef ) > abs( undef * 0.1_rp ) &
1172  .and. abs( file_external_input_item(nid)%value(n1,n2,n3,i_next) - undef ) > abs( undef * 0.1_rp ) ) then
1173  var(nn3,nn1,nn2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
1174  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
1175  else
1176  if ( file_external_input_item(nid)%allow_missing ) then
1177  var(nn3,nn1,nn2) = undef
1178  else
1179  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'missing value is found in ', &
1180  trim(file_external_input_item(nid)%varname), ' at (',n1,',',n2,',',n3,')'
1181  error = .true.
1182  exit
1183  end if
1184  end if
1185  enddo
1186  enddo
1187  enddo
1188  else
1189  ! store data with weight (z,x,y)->(z,x,y)
1190  do n3 = 1, file_external_input_item(nid)%dim_size(3)
1191  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
1192 
1193  do n2 = 1, file_external_input_item(nid)%dim_size(2)
1194  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
1195 
1196  do n1 = 1, file_external_input_item(nid)%dim_size(1)
1197  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
1198 
1199  if ( abs( file_external_input_item(nid)%value(n1,n2,n3,i_prev) - undef ) > abs( undef * 0.1_rp ) &
1200  .and. abs( file_external_input_item(nid)%value(n1,n2,n3,i_next) - undef ) > abs( undef * 0.1_rp ) ) then
1201  var(nn1,nn2,nn3) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
1202  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
1203  else
1204  if ( file_external_input_item(nid)%allow_missing ) then
1205  var(nn1,nn2,nn3) = undef
1206  else
1207  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'missing value is found in ', &
1208  trim(file_external_input_item(nid)%varname), ' at (',n1,',',n2,',',n3,')'
1209  error = .true.
1210  exit
1211  end if
1212  end if
1213  enddo
1214  enddo
1215  enddo
1216  endif
1217 
1218  return
1219  end subroutine file_external_input_update_3d
1220 
1221  !-----------------------------------------------------------------------------
1223  subroutine file_external_input_time_advance( &
1224  nid, &
1225  time_current, &
1226  weight, &
1227  do_readfile )
1228  use scale_file_h, only: &
1229  file_fread
1230  use scale_file, only: &
1231  file_open, &
1232  file_get_all_datainfo
1233  use scale_prc, only: &
1234  prc_myrank, &
1235  prc_abort
1236  use scale_calendar, only: &
1237  calendar_adjust_daysec, &
1238  calendar_daysec2date, &
1239  calendar_date2daysec, &
1240  calendar_combine_daysec, &
1241  calendar_cfunits2sec, &
1242  i_year, &
1243  i_month, &
1244  i_day
1245  use scale_time, only: &
1246  time_startdaysec, &
1247  time_offset_year
1248  implicit none
1249 
1250  integer, intent(in) :: nid ! item id
1251  real(DP), intent(in) :: time_current ! current time
1252  real(RP), intent(out) :: weight ! weight
1253  logical, intent(out) :: do_readfile ! read new data at this time?
1254 
1255  integer :: step_nmax
1256  character(len=H_MID) :: description
1257  character(len=H_SHORT) :: unit
1258  character(len=H_MID) :: standard_name
1259  integer :: datatype
1260  integer :: dim_rank
1261  character(len=H_SHORT) :: dim_name (FILE_EXTERNAL_INPUT_dim_limit)
1262  integer :: dim_size (FILE_EXTERNAL_INPUT_dim_limit)
1263  integer :: natts
1264  character(len=H_SHORT) :: att_name (FILE_EXTERNAL_INPUT_att_limit)
1265  integer :: att_type (FILE_EXTERNAL_INPUT_att_limit)
1266  integer :: att_len (FILE_EXTERNAL_INPUT_att_limit)
1267  real(DP) :: time_start(FILE_EXTERNAL_INPUT_step_limit)
1268  real(DP) :: time_end (FILE_EXTERNAL_INPUT_step_limit)
1269  character(len=H_MID) :: time_units
1270  character(len=H_SHORT) :: calendar
1271 
1272  integer :: datadate(6)
1273  real(DP) :: datasubsec
1274  integer :: dataday
1275  real(DP) :: datasec
1276  integer :: offset_year
1277 
1278  real(DP) :: time_prev, time_next
1279  integer :: step_prev, step_next
1280  integer :: t
1281  integer :: fid
1282  integer :: n, nn
1283  !---------------------------------------------------------------------------
1284 
1285  do_readfile = .false.
1286 
1287  if ( file_external_input_item(nid)%fixed_step ) then
1288  !--- no time-advance
1289  else
1290  ! time is passed?
1291  if ( time_current > file_external_input_item(nid)%time( file_external_input_item(nid)%data_step_next ) ) then
1292 
1293  do_readfile = .true.
1294 
1295  log_info("FILE_EXTERNAL_INPUT_time_advance",'(1x,A,A15)') 'Update external input : ', trim(file_external_input_item(nid)%varname)
1296 
1297  ! update step position
1298  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_prev + 1
1299  file_external_input_item(nid)%data_step_next = file_external_input_item(nid)%data_step_next + 1
1300 
1301  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
1302 
1303  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
1304 
1305  ! last+1 = first
1306  file_external_input_item(nid)%data_step_next = 1
1307 
1308  ! update data time in periodic condition
1309  do t = 1, file_external_input_item(nid)%step_num
1310  dataday = 0
1311  datasec = file_external_input_item(nid)%time(t)
1312  offset_year = 0
1313  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
1314 
1315  call calendar_daysec2date( datadate(:), & ! [OUT]
1316  datasubsec, & ! [OUT]
1317  dataday, & ! [IN]
1318  datasec, & ! [IN]
1319  offset_year ) ! [IN]
1320 
1321  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
1322  datadate(i_day) = datadate(i_day) + 1
1323  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
1324  datadate(i_month) = datadate(i_month) + 1
1325  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
1326  datadate(i_year) = datadate(i_year) + 1
1327  endif
1328 
1329  call calendar_date2daysec( dataday, & ! [IN]
1330  datasec, & ! [IN]
1331  datadate(:), & ! [OUT]
1332  datasubsec, & ! [OUT]
1333  offset_year ) ! [IN]
1334 
1335  file_external_input_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
1336  enddo
1337  endif
1338 
1339  else ! normal mode
1340 
1341  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
1342 
1343  if ( file_external_input_item(nid)%file_current < file_external_input_item(nid)%nfile ) then
1344 
1345  file_external_input_item(nid)%file_current = file_external_input_item(nid)%file_current + 1
1346 
1347  call file_open( file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current), & ! [IN]
1348  fid, & ! [OUT]
1349  rankid=prc_myrank ) ! [IN]
1350 
1351  ! read from file
1352  call file_get_all_datainfo( fid, file_external_input_item(nid)%varname, & ! [IN]
1353  step_nmax, & ! [OUT]
1354  description, unit, standard_name, & ! [OUT]
1355  datatype, & ! [OUT]
1356  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
1357  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
1358  time_start(1:file_external_input_item(nid)%step_limit), & ! [OUT]
1359  time_end(1:file_external_input_item(nid)%step_limit), & ! [OUT]
1360  time_units, calendar ) ! [OUT]
1361 
1362  if ( step_nmax == 0 ) then
1363  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)), &
1364  ', varname = ', trim(file_external_input_item(nid)%varname)
1365  call prc_abort
1366  endif
1367 
1368  do n = 1, dim_rank
1369  if ( file_external_input_item(nid)%dim_size(n) /= dim_size(n) ) then
1370  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'The size of dimension', n, ' is inconsistent! '
1371  log_error_cont(*) 'size (previous,current) = ', file_external_input_item(nid)%dim_size(n), dim_size(n)
1372  log_error_cont(*) 'basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
1373  ', varname = ', trim(file_external_input_item(nid)%varname)
1374  call prc_abort
1375  endif
1376  enddo
1377 
1378  do n = 1, step_nmax
1379  nn = file_external_input_item(nid)%step_num + n
1380  file_external_input_item(nid)%time(nn) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
1381  enddo
1382 
1383  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
1384  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Time in new file is earlier than last time of previous file! stop'
1385  log_error_cont(*) 'Time (previous,current) = ', file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_prev), &
1386  file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_next)
1387  log_error_cont(*) 'Data not found! basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
1388  ', varname = ', trim(file_external_input_item(nid)%varname)
1389  call prc_abort
1390  endif
1391 
1392  file_external_input_item(nid)%fid = fid
1393  file_external_input_item(nid)%data_step_offset = file_external_input_item(nid)%step_num
1394  file_external_input_item(nid)%step_num = file_external_input_item(nid)%step_num + step_nmax
1395 
1396  else
1397  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Current time is out of period of external data! '
1398  call prc_abort
1399  endif
1400 
1401  endif
1402 
1403  endif ! periodic or not
1404 
1405  endif ! time is passed?
1406 
1407  endif ! fixed step or not
1408 
1409  ! calc weight
1410  if ( file_external_input_item(nid)%fixed_step ) then
1411 
1412  weight = 0.0_rp
1413 
1414  elseif( file_external_input_item(nid)%data_step_next == 1 ) then ! periodic case
1415 
1416  step_prev = file_external_input_item(nid)%data_step_prev
1417  step_next = file_external_input_item(nid)%data_step_next
1418 
1419  dataday = 0
1420  datasec = file_external_input_item(nid)%time( step_prev )
1421  offset_year = 0
1422  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
1423 
1424  call calendar_daysec2date( datadate(:), & ! [OUT]
1425  datasubsec, & ! [OUT]
1426  dataday, & ! [IN]
1427  datasec, & ! [IN]
1428  offset_year ) ! [IN]
1429 
1430  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
1431  datadate(i_day) = datadate(i_day) - 1
1432  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
1433  datadate(i_month) = datadate(i_month) - 1
1434  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
1435  datadate(i_year) = datadate(i_year) - 1
1436  endif
1437 
1438  call calendar_date2daysec( dataday, & ! [IN]
1439  datasec, & ! [IN]
1440  datadate(:), & ! [OUT]
1441  datasubsec, & ! [OUT]
1442  offset_year ) ! [IN]
1443 
1444  time_prev = calendar_combine_daysec( dataday, datasec )
1445  time_next = file_external_input_item(nid)%time( step_next )
1446 
1447  weight = ( time_current - time_prev ) &
1448  / ( time_next - time_prev )
1449 
1450  else ! normal case
1451 
1452  step_prev = file_external_input_item(nid)%data_step_prev
1453  step_next = file_external_input_item(nid)%data_step_next
1454 
1455  time_prev = file_external_input_item(nid)%time( step_prev )
1456  time_next = file_external_input_item(nid)%time( step_next )
1457 
1458  weight = ( time_current - time_prev ) &
1459  / ( time_next - time_prev )
1460 
1461  endif
1462 
1463  return
1464  end subroutine file_external_input_time_advance
1465 
1466 end module scale_file_external_input
scale_time::time_nowdaysec
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:70
scale_file_external_input::file_external_input_read_3d
procedure(read3d), pointer, public file_external_input_read_3d
Definition: scale_file_external_input.F90:143
scale_prc::prc_abort
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:342
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:958
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:191
scale_file_external_input::file_external_input_regist
subroutine, public file_external_input_regist(basename, basename_add_num, number_of_files, varname, axistype, enable_periodic_year, enable_periodic_month, enable_periodic_day, step_fixed, offset, defval, check_coordinates, aggregate, allow_missing, step_limit, exist)
Regist data.
Definition: scale_file_external_input.F90:324
scale_calendar::calendar_combine_daysec
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
Definition: scale_calendar.F90:405
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:858
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:90
scale_file_external_input::file_external_input_setup
subroutine, public file_external_input_setup
Setup.
Definition: scale_file_external_input.F90:207
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:136
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:13
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_const
module CONSTANT
Definition: scale_const.F90:11
scale_file_external_input::file_external_input_read_2d
procedure(read2d), pointer, public file_external_input_read_2d
Definition: scale_file_external_input.F90:142
scale_file::file_open
subroutine, public file_open(basename, fid, mode, single, aggregate, rankid, postfix)
Definition: scale_file.F90:487
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:159
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:380
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:488
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:135
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:141
scale_file::file_aggregate
logical, public file_aggregate
Definition: scale_file.F90:182
scale_file_h::file_fread
integer, parameter, public file_fread
Definition: scale_file_h.F90:32
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:1089
scale_calendar::i_year
integer, parameter, public i_year
[index] year
Definition: scale_calendar.F90:45
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:41
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:134
scale_io::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:56
scale_time::time_startdaysec
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:75
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:74
Generated by   doxygen 1.8.17