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  !
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_max, &
40  dim1_S, &
41  dim1_E, &
42  varname, &
43  axistype )
44  integer, intent(out) :: dim1_max
45  integer, intent(out) :: dim1_s
46  integer, intent(out) :: dim1_e
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_max, &
53  dim1_S, &
54  dim1_E, &
55  dim2_max, &
56  dim2_S, &
57  dim2_E, &
58  transpose, &
59  varname, &
60  axistype )
61  integer, intent(out) :: dim1_max
62  integer, intent(out) :: dim1_s
63  integer, intent(out) :: dim1_e
64  integer, intent(out) :: dim2_max
65  integer, intent(out) :: dim2_s
66  integer, intent(out) :: dim2_e
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_max, &
74  dim1_S, &
75  dim1_E, &
76  dim2_max, &
77  dim2_S, &
78  dim2_E, &
79  dim3_max, &
80  dim3_S, &
81  dim3_E, &
82  transpose, &
83  varname, &
84  axistype )
85  integer, intent(out) :: dim1_max
86  integer, intent(out) :: dim1_s
87  integer, intent(out) :: dim1_e
88  integer, intent(out) :: dim2_max
89  integer, intent(out) :: dim2_s
90  integer, intent(out) :: dim2_e
91  integer, intent(out) :: dim3_max
92  integer, intent(out) :: dim3_s
93  integer, intent(out) :: dim3_e
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  end interface
99 
100  procedure(get_dims1d), pointer :: file_external_input_get_dims1d => null()
101  procedure(get_dims2d), pointer :: file_external_input_get_dims2d => null()
102  procedure(get_dims3d), pointer :: file_external_input_get_dims3d => null()
106 
107  !-----------------------------------------------------------------------------
108  !
109  !++ Public parameters & variables
110  !
111  integer, public, parameter :: file_external_input_file_limit = 100
112 
113  !-----------------------------------------------------------------------------
114  !
115  !++ Private procedures
116  !
117  private :: file_external_input_time_advance
118 
119  !-----------------------------------------------------------------------------
120  !
121  !++ Private parameters & variables
122  !
123  integer, private, parameter :: i_prev = 1
124  integer, private, parameter :: i_next = 2
125 
126  integer, private, parameter :: i_periodic_year = 1
127  integer, private, parameter :: i_periodic_month = 2
128  integer, private, parameter :: i_periodic_day = 3
129 
130  integer, private, parameter :: file_external_input_item_limit = 1000
131  integer, private, parameter :: file_external_input_step_limit = 10000
132  integer, private, parameter :: file_external_input_dim_limit = 3
133  integer, private, parameter :: file_external_input_att_limit = 10
134 
135  type, private :: itemcontainer
136  character(len=H_SHORT) :: varname
137  integer :: nfile
138  integer :: file_current
139  character(len=H_LONG), allocatable :: basename(:)
140  integer :: fid
141  integer :: ndim
142  integer :: dim_size(file_external_input_dim_limit)
143  integer, allocatable :: dim_start(:)
144  integer :: step_limit
145  integer :: step_num
146  real(DP), allocatable :: time(:)
147  logical :: fixed_step
148  integer :: flag_periodic
149  real(RP) :: offset
150  integer :: data_step_prev
151  integer :: data_step_next
152  integer :: data_step_offset
153  real(RP), allocatable :: value(:,:,:,:)
154  character(len=H_SHORT) :: axistype
155  logical :: transpose
156  end type itemcontainer
157 
158  integer, private :: file_external_input_item_count = 0
159  type(itemcontainer), private :: file_external_input_item(file_external_input_item_limit)
160 
161  !-----------------------------------------------------------------------------
162 contains
163  !-----------------------------------------------------------------------------
165  subroutine file_external_input_setup
166  use scale_prc, only: &
167  prc_abort
168  use scale_const, only: &
169  undef => const_undef
170  implicit none
171 
172  character(len=H_LONG) :: basename(file_external_input_file_limit)
173  character(len=H_SHORT) :: varname
174  character(len=H_SHORT) :: axistype
175  integer :: step_limit ! limit number for reading data
176  integer :: step_fixed ! fixed step position to read
177  logical :: enable_periodic_year ! treat as yearly periodic data?
178  logical :: enable_periodic_month ! treat as yearly,monthly periodic data?
179  logical :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
180  real(RP) :: offset
181  real(RP) :: defval
182  logical :: check_coordinates
183 
184  namelist / external_item / &
185  basename, &
186  varname, &
187  axistype, &
188  step_limit, &
189  step_fixed, &
190  enable_periodic_year, &
191  enable_periodic_month, &
192  enable_periodic_day, &
193  offset, &
194  defval, &
195  check_coordinates
196 
197  integer :: count
198  integer :: ierr
199  !---------------------------------------------------------------------------
200 
201  log_newline
202  log_info("FILE_EXTERNAL_INPUT_setup",*) 'Setup'
203 
204  ! count external data from namelist
205  rewind(io_fid_conf)
206  do count = 1, file_external_input_item_limit
207  ! set default
208  step_limit = file_external_input_step_limit
209  basename(:) = ''
210  varname = ''
211  axistype = ''
212  step_fixed = -1
213  enable_periodic_year = .false.
214  enable_periodic_month = .false.
215  enable_periodic_day = .false.
216  offset = 0.0_rp
217  defval = undef
218  check_coordinates = .false.
219 
220  ! read namelist
221  read(io_fid_conf,nml=external_item,iostat=ierr)
222  if ( ierr < 0 ) then !--- no more items
223  exit
224  elseif( ierr > 0 ) then !--- fatal error
225  log_error("FILE_EXTERNAL_INPUT_setup",*) 'Not appropriate names in namelist EXTERNAL_ITEM. Check!', count
226  call prc_abort
227  endif
228  log_nml(external_item)
229 
230  call file_external_input_regist( basename(:), & ! [IN]
231  varname, & ! [IN]
232  axistype, & ! [IN]
233  enable_periodic_year, & ! [IN]
234  enable_periodic_month, & ! [IN]
235  enable_periodic_day, & ! [IN]
236  step_fixed, & ! [IN]
237  offset, & ! [IN]
238  defval, & ! [IN]
239  check_coordinates, & ! [IN]
240  step_limit ) ! [IN]
241  enddo
242 
243  return
244  end subroutine file_external_input_setup
245 
246  !-----------------------------------------------------------------------------
248  subroutine file_external_input_regist( &
249  basename, &
250  varname, &
251  axistype, &
252  enable_periodic_year, &
253  enable_periodic_month, &
254  enable_periodic_day, &
255  step_fixed, &
256  offset, &
257  defval, &
258  check_coordinates, &
259  step_limit, &
260  exist )
261  use scale_file_h, only: &
262  file_fread
263  use scale_file, only: &
264  file_open, &
265  file_get_all_datainfo, &
266  file_read
267  use scale_prc, only: &
268  prc_myrank, &
269  prc_abort
270  use scale_calendar, only: &
276  i_year, &
277  i_month, &
278  i_day
279  use scale_time, only: &
281  time_nowdaysec, &
283  use scale_file_cartesc, only: &
284  file_cartesc_check_coordinates
285  implicit none
286 
287  character(len=*), intent(in) :: basename(file_external_input_file_limit)
288  character(len=*), intent(in) :: varname
289  character(len=*), intent(in) :: axistype
290  integer, intent(in) :: step_fixed ! fixed step position to read
291  logical, intent(in) :: enable_periodic_year ! treat as yearly periodic data?
292  logical, intent(in) :: enable_periodic_month ! treat as yearly,monthly periodic data?
293  logical, intent(in) :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
294  real(RP), intent(in) :: offset
295  real(RP), intent(in) :: defval
296 
297  logical, intent(in), optional :: check_coordinates
298  integer, intent(in), optional :: step_limit ! limit number for reading data
299  logical, intent(out), optional :: exist
300 
301  integer :: step_nmax
302  character(len=H_MID) :: description
303  character(len=H_SHORT) :: unit
304  character(len=H_MID) :: standard_name
305  integer :: datatype
306  integer :: dim_rank
307  character(len=H_SHORT) :: dim_name (file_external_input_dim_limit)
308  integer :: dim_size (file_external_input_dim_limit)
309  integer :: natts
310  character(len=H_SHORT) :: att_name (file_external_input_att_limit)
311  integer :: att_type (file_external_input_att_limit)
312  integer :: att_len (file_external_input_att_limit)
313  real(DP) :: time_start(file_external_input_step_limit)
314  real(DP) :: time_end (file_external_input_step_limit)
315  character(len=H_MID) :: time_units
316  character(len=H_SHORT) :: calendar
317 
318  integer :: datadate(6)
319  real(DP) :: datasubsec
320  integer :: dataday
321  real(DP) :: datasec
322  integer :: offset_year
323 
324  integer :: dim1_max, dim1_S, dim1_E
325  integer :: dim2_max, dim2_S, dim2_E
326  integer :: dim3_max, dim3_S, dim3_E
327 
328  integer :: step_limit_
329 
330  integer :: fid
331  integer :: nid, n
332  !---------------------------------------------------------------------------
333 
334  if ( present(step_limit) ) then
335  if ( step_limit > 0 ) then
336  step_limit_ = step_limit
337  else
338  step_limit_ = file_external_input_step_limit
339  endif
340  else
341  step_limit_ = file_external_input_step_limit
342  endif
343 
344  do nid = 1, file_external_input_item_count
345  if ( file_external_input_item(nid)%varname == varname ) then
346  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Data is already registered! basename,varname = ', trim(basename(1)), ', ', trim(varname)
347  call prc_abort
348  endif
349  enddo
350 
351  file_external_input_item_count = file_external_input_item_count + 1
352 
353  if ( file_external_input_item_count > file_external_input_item_limit ) then
354  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Number of EXT data exceedes the limit', file_external_input_item_count, file_external_input_item_limit
355  call prc_abort
356  endif
357 
358  call file_open( basename(1), & ! [IN]
359  fid, & ! [OUT]
360  rankid=prc_myrank ) ! [IN]
361 
362  ! read from file
363  call file_get_all_datainfo( fid, varname, & ! [IN]
364  step_nmax, & ! [OUT]
365  description, unit, standard_name, & ! [OUT]
366  datatype, & ! [OUT]
367  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
368  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
369  time_start(1:step_limit_), time_end(1:step_limit_), & ! [OUT]
370  time_units, calendar ) ! [OUT]
371 
372  if ( step_nmax > 0 ) then
373  if ( present(exist) ) then
374  exist = .true.
375  endif
376  else
377  if ( present(exist) ) then
378  exist = .false.
379  return
380  else
381  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Data not found! basename,varname = ', trim(basename(1)), ', ', trim(varname)
382  call prc_abort
383  endif
384  endif
385 
386  do n = dim_rank+1, 3
387  dim_size(n) = 1
388  enddo
389 
390  nid = file_external_input_item_count
391 
393  if( basename(n) == '' ) exit
394  enddo
395  file_external_input_item(nid)%nfile = n - 1
396  file_external_input_item(nid)%file_current = 1
397  file_external_input_item(nid)%data_step_offset = 0
398 
399  allocate( file_external_input_item(nid)%basename(file_external_input_item(nid)%nfile) )
400  file_external_input_item(nid)%basename(1:file_external_input_item(nid)%nfile) = basename(1:file_external_input_item(nid)%nfile)
401 
402  ! setup item
403  file_external_input_item(nid)%fid = fid
404  file_external_input_item(nid)%varname = varname
405  file_external_input_item(nid)%dim_size(:) = dim_size(:)
406  file_external_input_item(nid)%step_num = step_nmax
407  file_external_input_item(nid)%step_limit = step_limit_
408 
409  if ( enable_periodic_day ) then
410  file_external_input_item(nid)%flag_periodic = i_periodic_day
411  elseif( enable_periodic_month ) then
412  file_external_input_item(nid)%flag_periodic = i_periodic_month
413  elseif( enable_periodic_year ) then
414  file_external_input_item(nid)%flag_periodic = i_periodic_year
415  else
416  file_external_input_item(nid)%flag_periodic = 0
417  endif
418 
419  allocate( file_external_input_item(nid)%value(dim_size(1),dim_size(2),dim_size(3),2) )
420  file_external_input_item(nid)%value(:,:,:,:) = defval
421  file_external_input_item(nid)%offset = offset
422 
423  allocate( file_external_input_item(nid)%time(step_limit_) )
424  file_external_input_item(nid)%time(:) = 0.0_dp
425 
426  do n = 1, file_external_input_item(nid)%step_num
427  file_external_input_item(nid)%time(n) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
428  enddo
429 
430  if ( file_external_input_item(nid)%step_num == 1 ) then
431 
432  file_external_input_item(nid)%fixed_step = .true.
433  file_external_input_item(nid)%data_step_prev = 1
434  file_external_input_item(nid)%data_step_next = 1
435 
436  else if ( step_fixed > 0 ) then ! fixed time step mode
437 
438  file_external_input_item(nid)%fixed_step = .true.
439  file_external_input_item(nid)%data_step_prev = step_fixed
440  file_external_input_item(nid)%data_step_next = step_fixed
441 
442  else
443 
444  file_external_input_item(nid)%fixed_step = .false.
445 
446  ! seek start position
447  file_external_input_item(nid)%data_step_next = 1
448  do n = 1, file_external_input_item(nid)%step_num
449  if ( file_external_input_item(nid)%time(n) > time_nowdaysec ) exit
450  file_external_input_item(nid)%data_step_next = n + 1
451  enddo
452 
453  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_next - 1
454 
455  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
456 
457  if ( file_external_input_item(nid)%data_step_next == 1 ) then ! between first-1 and first
458 
459  ! first-1 = last
460  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%step_num
461 
462  elseif( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then ! between last and last+1
463 
464  ! last+1 = first
465  file_external_input_item(nid)%data_step_next = 1
466 
467  ! update data time in periodic condition
468  do n = 1, file_external_input_item(nid)%step_num
469  dataday = 0
470  datasec = file_external_input_item(nid)%time(n)
471  offset_year = 0
472  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
473 
474  call calendar_daysec2date( datadate(:), & ! [OUT]
475  datasubsec, & ! [OUT]
476  dataday, & ! [IN]
477  datasec, & ! [IN]
478  offset_year ) ! [IN]
479 
480  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
481  datadate(i_day) = datadate(i_day) + 1
482  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
483  datadate(i_month) = datadate(i_month) + 1
484  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
485  datadate(i_year) = datadate(i_year) + 1
486  endif
487 
488  call calendar_date2daysec( dataday, & ! [OUT]
489  datasec, & ! [OUT]
490  datadate(:), & ! [IN]
491  datasubsec, & ! [IN]
492  offset_year ) ! [IN]
493 
494  file_external_input_item(nid)%time(n) = calendar_combine_daysec( dataday, datasec )
495  enddo
496 
497  log_info("FILE_EXTERNAL_INPUT_regist",*) 'data time is updated.'
498  endif
499 
500  else ! normal mode
501 
502  if ( file_external_input_item(nid)%data_step_next == 1 &
503  .OR. file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
504  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Current time is out of period of external data! ', trim(varname)
505  call prc_abort
506  endif
507 
508  endif
509 
510  endif
511 
512  !--- read first data
513  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A15)') 'Initial read of external data : ', trim(varname)
514 
515  if ( dim_size(1) >= 1 &
516  .AND. dim_size(2) == 1 &
517  .AND. dim_size(3) == 1 ) then ! 1D
518 
519  call file_external_input_get_dims1d( dim1_max, dim1_s, dim1_e, & ! [OUT]
520  varname, axistype ) ! [IN]
521 
522  file_external_input_item(nid)%ndim = 1
523  file_external_input_item(nid)%transpose = .false.
524  allocate( file_external_input_item(nid)%dim_start(1) )
525  file_external_input_item(nid)%dim_start(1) = dim1_s
526 
527  if ( dim1_max /= dim_size(1) ) then
528  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
529  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
530  call prc_abort
531  endif
532 
533  ! read prev
534  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
535  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
536  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
537 
538  call file_read( file_external_input_item(nid)%fid, & ! [IN]
539  file_external_input_item(nid)%varname, & ! [IN]
540  file_external_input_item(nid)%value(:,1,1,i_prev), & ! [OUT]
541  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
542  ! read next
543  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
544  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
545  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
546 
547  call file_read( file_external_input_item(nid)%fid, & ! [IN]
548  file_external_input_item(nid)%varname, & ! [IN]
549  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
550  step=file_external_input_item(nid)%data_step_next ) ! [IN]
551 
552  elseif( dim_size(1) >= 1 &
553  .AND. dim_size(2) > 1 &
554  .AND. dim_size(3) == 1 ) then ! 2D
555 
556  call file_external_input_get_dims2d( dim1_max, dim1_s, dim1_e, & ! [OUT]
557  dim2_max, dim2_s, dim2_e, & ! [OUT]
558  file_external_input_item(nid)%transpose, & ! [OUT]
559  varname, axistype ) ! [IN]
560 
561  file_external_input_item(nid)%ndim = 2
562  allocate( file_external_input_item(nid)%dim_start(2) )
563  file_external_input_item(nid)%dim_start(1) = dim1_s
564  file_external_input_item(nid)%dim_start(2) = dim2_s
565 
566  if ( dim1_max /= dim_size(1) &
567  .OR. dim2_max /= dim_size(2) ) then
568  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
569  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
570  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
571  call prc_abort
572  endif
573 
574  ! read prev
575  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
576  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
577  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
578 
579  call file_read( file_external_input_item(nid)%fid, & ! [IN]
580  file_external_input_item(nid)%varname, & ! [IN]
581  file_external_input_item(nid)%value(:,:,1,i_prev), & ! [OUT]
582  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
583  ! read next
584  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
585  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
586  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
587 
588  call file_read( file_external_input_item(nid)%fid, & ! [IN]
589  file_external_input_item(nid)%varname, & ! [IN]
590  file_external_input_item(nid)%value(:,:,1,i_next), & ! [OUT]
591  step=file_external_input_item(nid)%data_step_next ) ! [IN]
592 
593  elseif( dim_size(1) >= 1 &
594  .AND. dim_size(2) > 1 &
595  .AND. dim_size(3) > 1 ) then ! 3D
596 
597  call file_external_input_get_dims3d( dim1_max, dim1_s, dim1_e, & ! [OUT]
598  dim2_max, dim2_s, dim2_e, & ! [OUT]
599  dim3_max, dim3_s, dim3_e, & ! [OUT]
600  file_external_input_item(nid)%transpose, & ! [OUT]
601  varname, axistype ) ! [IN]
602 
603  file_external_input_item(nid)%ndim = 3
604  allocate( file_external_input_item(nid)%dim_start(3) )
605  file_external_input_item(nid)%dim_start(1) = dim1_s
606  file_external_input_item(nid)%dim_start(2) = dim2_s
607  file_external_input_item(nid)%dim_start(3) = dim3_s
608 
609  if ( dim1_max /= dim_size(1) &
610  .OR. dim2_max /= dim_size(2) &
611  .OR. dim3_max /= dim_size(3) ) then
612  log_error("FILE_EXTERNAL_INPUT_regist",*) 'data length does not match! ', trim(axistype), ' item:', trim(varname)
613  log_error_cont(*) 'dim 1 (data,requested) : ', dim_size(1), dim1_max
614  log_error_cont(*) 'dim 2 (data,requested) : ', dim_size(2), dim2_max
615  log_error_cont(*) 'dim 3 (data,requested) : ', dim_size(3), dim3_max
616  call prc_abort
617  endif
618 
619  ! read prev
620  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
621  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
622  ' (step= ', file_external_input_item(nid)%data_step_prev, ')'
623 
624  call file_read( file_external_input_item(nid)%fid, & ! [IN]
625  file_external_input_item(nid)%varname, & ! [IN]
626  file_external_input_item(nid)%value(:,:,:,i_prev), & ! [OUT]
627  step=file_external_input_item(nid)%data_step_prev ) ! [IN]
628 
629  ! read next
630  log_info("FILE_EXTERNAL_INPUT_regist",'(1x,A,A,A,I4,A)') &
631  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
632  ' (step= ', file_external_input_item(nid)%data_step_next, ')'
633 
634  call file_read( file_external_input_item(nid)%fid, & ! [IN]
635  file_external_input_item(nid)%varname, & ! [IN]
636  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
637  step=file_external_input_item(nid)%data_step_next ) ! [IN]
638 
639  else
640  log_error("FILE_EXTERNAL_INPUT_regist",*) 'Unexpected dimsize: ', dim_size(:)
641  call prc_abort
642  endif
643 
644  if ( present(check_coordinates) ) then
645  if ( check_coordinates ) then
646  call file_cartesc_check_coordinates( fid, &
647  atmos = file_external_input_item(nid)%ndim==3, &
648  transpose = file_external_input_item(nid)%transpose )
649  endif
650  endif
651 
652  return
653  end subroutine file_external_input_regist
654 
655  !-----------------------------------------------------------------------------
657  subroutine file_external_input_update_1d( &
658  varname, &
659  time_current, &
660  var, &
661  error )
662  use scale_file, only: &
663  file_read
664  use scale_prc, only: &
665  prc_abort
666  implicit none
667  character(len=*), intent(in) :: varname ! item name
668  real(DP), intent(in) :: time_current ! current time
669  real(RP), intent(out) :: var(:) ! variable
670  logical, intent(out) :: error ! error code
671 
672  integer :: nid
673  real(RP) :: weight
674  logical :: do_readfile
675  integer :: step_next
676 
677  integer :: n
678  integer :: n1
679  integer :: nn1
680  !---------------------------------------------------------------------------
681 
682  error = .true.
683 
684  ! searching the data ID
685  nid = -1
686  do n = 1, file_external_input_item_count
687  if( varname == file_external_input_item(n)%varname ) nid = n
688  enddo
689 
690  if ( nid == 0 ) then
691  log_info("FILE_EXTERNAL_INPUT_update_1D",*) 'Variable was not registered: ', trim(varname)
692  return
693  endif
694 
695  if ( file_external_input_item(nid)%ndim /= 1 ) then
696  log_error("FILE_EXTERNAL_INPUT_update_1D",*) 'Data is not 1D var: ', trim(file_external_input_item(nid)%varname)
697  call prc_abort
698  endif
699 
700  call file_external_input_time_advance( nid, & ! [IN]
701  time_current, & ! [IN]
702  weight, & ! [OUT]
703  do_readfile ) ! [OUT]
704 
705  if ( do_readfile ) then
706  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
707 
708  log_info("FILE_EXTERNAL_INPUT_update_1D",'(1x,A,A,A,I4,A,I4,A)') &
709  'Read 1D var : ', trim(file_external_input_item(nid)%varname), &
710  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
711 
712  ! next -> prev
713  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
714 
715  ! read next
716  call file_read( file_external_input_item(nid)%fid, & ! [IN]
717  file_external_input_item(nid)%varname, & ! [IN]
718  file_external_input_item(nid)%value(:,1,1,i_next), & ! [OUT]
719  step=step_next ) ! [IN]
720  endif
721 
722  ! store data with weight
723  do n1 = 1, file_external_input_item(nid)%dim_size(1)
724  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
725 
726  var(nn1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,1,1,i_prev) &
727  + ( weight ) * file_external_input_item(nid)%value(n1,1,1,i_next)
728  enddo
729 
730  error = .false.
731 
732  return
733  end subroutine file_external_input_update_1d
734 
735  !-----------------------------------------------------------------------------
737  subroutine file_external_input_update_2d( &
738  varname, &
739  time_current, &
740  var, &
741  error )
742  use scale_file, only: &
743  file_read
744  implicit none
745  character(len=*), intent(in) :: varname ! item name
746  real(DP), intent(in) :: time_current ! current time
747  real(RP), intent(out) :: var(:,:) ! variable
748  logical, intent(out) :: error ! error code
749 
750  integer :: nid
751  real(RP) :: weight
752  logical :: do_readfile
753  integer :: step_next
754 
755  integer :: n
756  integer :: n1, n2
757  integer :: nn1, nn2
758  !---------------------------------------------------------------------------
759 
760  error = .true.
761 
762  ! searching the data ID
763  nid = -1
764  do n = 1, file_external_input_item_count
765  if( varname == file_external_input_item(n)%varname ) nid = n
766  enddo
767 
768  if ( nid == 0 ) then
769  log_info("FILE_EXTERNAL_INPUT_update_2D",*) 'Variable was not registered: ', trim(varname)
770  return
771  endif
772 
773  call file_external_input_time_advance( nid, & ! [IN]
774  time_current, & ! [IN]
775  weight, & ! [OUT]
776  do_readfile ) ! [OUT]
777 
778  if ( do_readfile ) then
779 
780  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
781 
782  log_info("FILE_EXTERNAL_INPUT_update_2D",'(1x,A,A,A,I4,A,I4,A)') &
783  'Read 2D var : ', trim(file_external_input_item(nid)%varname), &
784  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
785 
786  ! next -> prev
787  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
788 
789  ! read next
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=step_next ) ! [IN]
794  endif
795 
796  if ( file_external_input_item(nid)%transpose ) then
797  ! store data with weight (x,z)->(z,x)
798  do n1 = 1, file_external_input_item(nid)%dim_size(1)
799  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
800 
801  do n2 = 1, file_external_input_item(nid)%dim_size(2)
802  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
803 
804  var(nn2,nn1) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
805  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
806  enddo
807  enddo
808  else
809  ! store data with weight
810  do n2 = 1, file_external_input_item(nid)%dim_size(2)
811  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
812 
813  do n1 = 1, file_external_input_item(nid)%dim_size(1)
814  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
815 
816  var(nn1,nn2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,1,i_prev) &
817  + ( weight ) * file_external_input_item(nid)%value(n1,n2,1,i_next)
818  enddo
819  enddo
820  endif
821 
822  error = .false.
823 
824  return
825  end subroutine file_external_input_update_2d
826 
827  !-----------------------------------------------------------------------------
829  subroutine file_external_input_update_3d( &
830  varname, &
831  time_current, &
832  var, &
833  error )
834  use scale_file, only: &
835  file_read
836  implicit none
837  character(len=*), intent(in) :: varname ! item name
838  real(DP), intent(in) :: time_current ! current time
839  real(RP), intent(out) :: var(:,:,:) ! variable
840  logical, intent(out) :: error ! error code
841 
842  integer :: nid
843  real(RP) :: weight
844  logical :: do_readfile
845  integer :: step_next
846 
847  integer :: n
848  integer :: n1, n2, n3
849  integer :: nn1, nn2, nn3
850  !---------------------------------------------------------------------------
851 
852  error = .true.
853 
854  ! searching the data ID
855  nid = -1
856  do n = 1, file_external_input_item_count
857  if( varname == file_external_input_item(n)%varname ) nid = n
858  enddo
859 
860  if ( nid == 0 ) then
861  log_info("FILE_EXTERNAL_INPUT_update_3D",*) 'Variable was not registered: ', trim(varname)
862  return
863  endif
864 
865  call file_external_input_time_advance( nid, & ! [IN]
866  time_current, & ! [IN]
867  weight, & ! [OUT]
868  do_readfile ) ! [OUT]
869 
870  if ( do_readfile ) then
871 
872  step_next = file_external_input_item(nid)%data_step_next - file_external_input_item(nid)%data_step_offset
873 
874  log_info("FILE_EXTERNAL_INPUT_update_3D",'(1x,A,A,A,I4,A,I4,A)') &
875  'Read 3D var : ', trim(file_external_input_item(nid)%varname), &
876  ' (step= ', file_external_input_item(nid)%data_step_next, ', file step=', step_next, ')'
877 
878  ! next -> prev
879  file_external_input_item(nid)%value(:,:,:,i_prev) = file_external_input_item(nid)%value(:,:,:,i_next)
880 
881  ! read next
882  call file_read( file_external_input_item(nid)%fid, & ! [IN]
883  file_external_input_item(nid)%varname, & ! [IN]
884  file_external_input_item(nid)%value(:,:,:,i_next), & ! [OUT]
885  step=step_next ) ! [IN]
886  endif
887 
888  if ( file_external_input_item(nid)%transpose ) then
889  ! store data with weight (x,y,z)->(z,x,y)
890  do n2 = 1, file_external_input_item(nid)%dim_size(2)
891  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
892 
893  do n1 = 1, file_external_input_item(nid)%dim_size(1)
894  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
895 
896  do n3 = 1, file_external_input_item(nid)%dim_size(3)
897  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
898 
899  var(nn3,nn1,nn2) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
900  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
901  enddo
902  enddo
903  enddo
904  else
905  ! store data with weight (z,x,y)->(z,x,y)
906  do n3 = 1, file_external_input_item(nid)%dim_size(3)
907  nn3 = n3 + file_external_input_item(nid)%dim_start(3) - 1
908 
909  do n2 = 1, file_external_input_item(nid)%dim_size(2)
910  nn2 = n2 + file_external_input_item(nid)%dim_start(2) - 1
911 
912  do n1 = 1, file_external_input_item(nid)%dim_size(1)
913  nn1 = n1 + file_external_input_item(nid)%dim_start(1) - 1
914 
915  var(nn1,nn2,nn3) = ( 1.0_rp-weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_prev) &
916  + ( weight ) * file_external_input_item(nid)%value(n1,n2,n3,i_next)
917  enddo
918  enddo
919  enddo
920  endif
921 
922  error = .false.
923 
924  return
925  end subroutine file_external_input_update_3d
926 
927  !-----------------------------------------------------------------------------
929  subroutine file_external_input_time_advance( &
930  nid, &
931  time_current, &
932  weight, &
933  do_readfile )
934  use scale_file_h, only: &
935  file_fread
936  use scale_file, only: &
937  file_open, &
938  file_get_all_datainfo
939  use scale_prc, only: &
940  prc_myrank, &
941  prc_abort
942  use scale_calendar, only: &
948  i_year, &
949  i_month, &
950  i_day
951  use scale_time, only: &
954  implicit none
955 
956  integer, intent(in) :: nid ! item id
957  real(DP), intent(in) :: time_current ! current time
958  real(RP), intent(out) :: weight ! weight
959  logical, intent(out) :: do_readfile ! read new data at this time?
960 
961  integer :: step_nmax
962  character(len=H_MID) :: description
963  character(len=H_SHORT) :: unit
964  character(len=H_MID) :: standard_name
965  integer :: datatype
966  integer :: dim_rank
967  character(len=H_SHORT) :: dim_name (file_external_input_dim_limit)
968  integer :: dim_size (file_external_input_dim_limit)
969  integer :: natts
970  character(len=H_SHORT) :: att_name (file_external_input_att_limit)
971  integer :: att_type (file_external_input_att_limit)
972  integer :: att_len (file_external_input_att_limit)
973  real(DP) :: time_start(file_external_input_step_limit)
974  real(DP) :: time_end (file_external_input_step_limit)
975  character(len=H_MID) :: time_units
976  character(len=H_SHORT) :: calendar
977 
978  integer :: datadate(6)
979  real(DP) :: datasubsec
980  integer :: dataday
981  real(DP) :: datasec
982  integer :: offset_year
983 
984  real(DP) :: time_prev, time_next
985  integer :: step_prev, step_next
986  integer :: t
987  integer :: fid
988  integer :: n, nn
989  !---------------------------------------------------------------------------
990 
991  do_readfile = .false.
992 
993  if ( file_external_input_item(nid)%fixed_step ) then
994  !--- no time-advance
995  else
996  ! time is passed?
997  if ( time_current > file_external_input_item(nid)%time( file_external_input_item(nid)%data_step_next ) ) then
998 
999  do_readfile = .true.
1000 
1001  log_info("FILE_EXTERNAL_INPUT_time_advance",'(1x,A,A15)') 'Update external input : ', trim(file_external_input_item(nid)%varname)
1002 
1003  ! update step position
1004  file_external_input_item(nid)%data_step_prev = file_external_input_item(nid)%data_step_prev + 1
1005  file_external_input_item(nid)%data_step_next = file_external_input_item(nid)%data_step_next + 1
1006 
1007  if ( file_external_input_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
1008 
1009  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
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 t = 1, file_external_input_item(nid)%step_num
1016  dataday = 0
1017  datasec = file_external_input_item(nid)%time(t)
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, & ! [IN]
1036  datasec, & ! [IN]
1037  datadate(:), & ! [OUT]
1038  datasubsec, & ! [OUT]
1039  offset_year ) ! [IN]
1040 
1041  file_external_input_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
1042  enddo
1043  endif
1044 
1045  else ! normal mode
1046 
1047  if ( file_external_input_item(nid)%data_step_next == file_external_input_item(nid)%step_num+1 ) then
1048 
1049  if ( file_external_input_item(nid)%file_current < file_external_input_item(nid)%nfile ) then
1050 
1051  file_external_input_item(nid)%file_current = file_external_input_item(nid)%file_current + 1
1052 
1053  call file_open( file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current), & ! [IN]
1054  fid, & ! [OUT]
1055  rankid=prc_myrank ) ! [IN]
1056 
1057  ! read from file
1058  call file_get_all_datainfo( fid, file_external_input_item(nid)%varname, & ! [IN]
1059  step_nmax, & ! [OUT]
1060  description, unit, standard_name, & ! [OUT]
1061  datatype, & ! [OUT]
1062  dim_rank, dim_name(:), dim_size(:), & ! [OUT]
1063  natts, att_name(:), att_type(:), att_len(:), & ! [OUT]
1064  time_start(1:file_external_input_item(nid)%step_limit), & ! [OUT]
1065  time_end(1:file_external_input_item(nid)%step_limit), & ! [OUT]
1066  time_units, calendar ) ! [OUT]
1067 
1068  if ( step_nmax == 0 ) then
1069  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)), &
1070  ', varname = ', trim(file_external_input_item(nid)%varname)
1071  call prc_abort
1072  endif
1073 
1074  do n = 1, dim_rank
1075  if ( file_external_input_item(nid)%dim_size(n) /= dim_size(n) ) then
1076  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'The size of dimension', n, ' is inconsistent! '
1077  log_error_cont(*) 'size (previous,current) = ', file_external_input_item(nid)%dim_size(n), dim_size(n)
1078  log_error_cont(*) 'basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
1079  ', varname = ', trim(file_external_input_item(nid)%varname)
1080  call prc_abort
1081  endif
1082  enddo
1083 
1084  do n = 1, step_nmax
1085  nn = file_external_input_item(nid)%step_num + n
1086  file_external_input_item(nid)%time(nn) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
1087  enddo
1088 
1089  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
1090  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Time in new file is earlier than last time of previous file! stop'
1091  log_error_cont(*) 'Time (previous,current) = ', file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_prev), &
1092  file_external_input_item(nid)%time(file_external_input_item(nid)%data_step_next)
1093  log_error_cont(*) 'Data not found! basename = ', trim(file_external_input_item(nid)%basename(file_external_input_item(nid)%file_current)), &
1094  ', varname = ', trim(file_external_input_item(nid)%varname)
1095  call prc_abort
1096  endif
1097 
1098  file_external_input_item(nid)%fid = fid
1099  file_external_input_item(nid)%data_step_offset = file_external_input_item(nid)%step_num
1100  file_external_input_item(nid)%step_num = file_external_input_item(nid)%step_num + step_nmax
1101 
1102  else
1103  log_error("FILE_EXTERNAL_INPUT_time_advance",*) 'Current time is out of period of external data! '
1104  call prc_abort
1105  endif
1106 
1107  endif
1108 
1109  endif ! periodic or not
1110 
1111  endif ! time is passed?
1112 
1113  endif ! fixed step or not
1114 
1115  ! calc weight
1116  if ( file_external_input_item(nid)%fixed_step ) then
1117 
1118  weight = 0.0_rp
1119 
1120  elseif( file_external_input_item(nid)%data_step_next == 1 ) then ! periodic case
1121 
1122  step_prev = file_external_input_item(nid)%data_step_prev
1123  step_next = file_external_input_item(nid)%data_step_next
1124 
1125  dataday = 0
1126  datasec = file_external_input_item(nid)%time( step_prev )
1127  offset_year = 0
1128  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
1129 
1130  call calendar_daysec2date( datadate(:), & ! [OUT]
1131  datasubsec, & ! [OUT]
1132  dataday, & ! [IN]
1133  datasec, & ! [IN]
1134  offset_year ) ! [IN]
1135 
1136  if ( file_external_input_item(nid)%flag_periodic == i_periodic_day ) then
1137  datadate(i_day) = datadate(i_day) - 1
1138  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_month ) then
1139  datadate(i_month) = datadate(i_month) - 1
1140  elseif( file_external_input_item(nid)%flag_periodic == i_periodic_year ) then
1141  datadate(i_year) = datadate(i_year) - 1
1142  endif
1143 
1144  call calendar_date2daysec( dataday, & ! [IN]
1145  datasec, & ! [IN]
1146  datadate(:), & ! [OUT]
1147  datasubsec, & ! [OUT]
1148  offset_year ) ! [IN]
1149 
1150  time_prev = calendar_combine_daysec( dataday, datasec )
1151  time_next = file_external_input_item(nid)%time( step_next )
1152 
1153  weight = ( time_current - time_prev ) &
1154  / ( time_next - time_prev )
1155 
1156  else ! normal case
1157 
1158  step_prev = file_external_input_item(nid)%data_step_prev
1159  step_next = file_external_input_item(nid)%data_step_next
1160 
1161  time_prev = file_external_input_item(nid)%time( step_prev )
1162  time_next = file_external_input_item(nid)%time( step_next )
1163 
1164  weight = ( time_current - time_prev ) &
1165  / ( time_next - time_prev )
1166 
1167  endif
1168 
1169  return
1170  end subroutine file_external_input_time_advance
1171 
1172 end module scale_file_external_input
integer, parameter, public i_month
[index] month
integer, parameter, public i_year
[index] year
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
subroutine file_external_input_update_2d(varname, time_current, var, error)
Read data.
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:73
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:78
integer, public io_fid_conf
Config file ID.
Definition: scale_io.F90:55
module file / external_input
subroutine file_external_input_update_3d(varname, time_current, var, error)
Read data.
subroutine, public file_open(basename, fid, mode, single, aggregate, rankid, postfix)
Definition: scale_file.F90:464
subroutine, public file_external_input_regist(basename, varname, axistype, enable_periodic_year, enable_periodic_month, enable_periodic_day, step_fixed, offset, defval, check_coordinates, step_limit, exist)
Regist data.
real(rp), public const_undef
Definition: scale_const.F90:41
module file
Definition: scale_file.F90:15
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
procedure(get_dims2d), pointer, public file_external_input_get_dims2d
integer, parameter, public file_external_input_file_limit
limit of file (for one item)
integer, parameter, public file_fread
real(dp) function, public calendar_cfunits2sec(cftime, cfunits, offset_year, startdaysec)
Convert time in units of the CF convention to second.
integer, public time_offset_year
time offset [year]
Definition: scale_time.F90:77
module PROCESS
Definition: scale_prc.F90:11
module TIME
Definition: scale_time.F90:16
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:89
subroutine, public prc_abort
Abort Process.
Definition: scale_prc.F90:338
module CONSTANT
Definition: scale_const.F90:11
integer, parameter, public i_day
[index] day
subroutine, public calendar_daysec2date(ymdhms, subsec, absday, abssec, offset_year)
Convert from gregorian date to absolute day/second.
module profiler
Definition: scale_prof.F90:11
subroutine, public file_external_input_setup
Setup.
module PRECISION
module file / cartesianC
module CALENDAR
module STDIO
Definition: scale_io.F90:10
procedure(get_dims3d), pointer, public file_external_input_get_dims3d
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.
subroutine file_external_input_update_1d(varname, time_current, var, error)
Read data.
module file_h
procedure(get_dims1d), pointer, public file_external_input_get_dims1d