SCALE-RM
scale_external_input.F90
Go to the documentation of this file.
1 !-------------------------------------------------------------------------------
10 !-------------------------------------------------------------------------------
11 module scale_external_input
12  !-----------------------------------------------------------------------------
13  !
14  !++ Used modules
15  !
16  use scale_precision
17  use scale_stdio
18  use scale_prof
19  use scale_grid_index
20  use scale_land_grid_index
21  use scale_urban_grid_index
22  use scale_process, only: &
23  prc_myrank, &
24  prc_mpistop
25  !-----------------------------------------------------------------------------
26  implicit none
27  private
28  !-----------------------------------------------------------------------------
29  !
30  !++ Public procedures
31  !
32  public :: extin_setup
33  public :: extin_regist
34  public :: extin_update
35 
36  interface extin_update
37  module procedure extin_update_1d
38  module procedure extin_update_2d
39  module procedure extin_update_3d
40  end interface extin_update
41 
42  !-----------------------------------------------------------------------------
43  !
44  !++ Public parameters & variables
45  !
46  !-----------------------------------------------------------------------------
47  !
48  !++ Private procedures
49  !
50  private :: extin_time_advance
51 
52  abstract interface
53  subroutine get_dims_1d( &
54  dim1_max, &
55  dim1_S, &
56  dim1_E, &
57  varname, &
58  axistype )
59  integer, intent(out) :: dim1_max
60  integer, intent(out) :: dim1_S
61  integer, intent(out) :: dim1_E
62  character(len=*), intent(in) :: varname
63  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
64  end subroutine get_dims_1d
65  subroutine get_dims_2d( &
66  dim1_max, &
67  dim1_S, &
68  dim1_E, &
69  dim2_max, &
70  dim2_S, &
71  dim2_E, &
72  transpose, &
73  varname, &
74  axistype )
75  integer, intent(out) :: dim1_max
76  integer, intent(out) :: dim1_S
77  integer, intent(out) :: dim1_E
78  integer, intent(out) :: dim2_max
79  integer, intent(out) :: dim2_S
80  integer, intent(out) :: dim2_E
81  logical, intent(out) :: transpose
82  character(len=*), intent(in) :: varname
83  character(len=*), intent(in) :: axistype ! axis type (XY/XZ/ZX)
84  end subroutine get_dims_2d
85  subroutine get_dims_3d( &
86  dim1_max, &
87  dim1_S, &
88  dim1_E, &
89  dim2_max, &
90  dim2_S, &
91  dim2_E, &
92  dim3_max, &
93  dim3_S, &
94  dim3_E, &
95  transpose, &
96  varname, &
97  axistype )
98  integer, intent(out) :: dim1_max
99  integer, intent(out) :: dim1_S
100  integer, intent(out) :: dim1_E
101  integer, intent(out) :: dim2_max
102  integer, intent(out) :: dim2_S
103  integer, intent(out) :: dim2_E
104  integer, intent(out) :: dim3_max
105  integer, intent(out) :: dim3_S
106  integer, intent(out) :: dim3_E
107  logical, intent(out) :: transpose
108  character(len=*), intent(in) :: varname
109  character(len=*), intent(in) :: axistype ! axis type (ZXY/XYZ/Land/Urban)
110  end subroutine get_dims_3d
111  end interface
112  procedure(get_dims_1D), pointer :: EXTIN_get_dims_1D => null()
113  procedure(get_dims_2D), pointer :: EXTIN_get_dims_2D => null()
114  procedure(get_dims_3D), pointer :: EXTIN_get_dims_3D => null()
115  private :: extin_get_dims_1d
116  private :: extin_get_dims_2d
117  private :: extin_get_dims_3d
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 :: EXTIN_item_limit = 1000
131  integer, private, parameter :: EXTIN_step_limit = 10000
132  integer, private, parameter :: EXTIN_dim_limit = 3
133 
134  type, private :: extin_itemcontainer
135  character(len=H_SHORT) :: varname
136  integer :: fid
137  integer :: ndim
138  integer :: dim_size(EXTIN_dim_limit)
139  integer, allocatable :: dim_start(:)
140  integer :: step_num
141  real(DP), allocatable :: time(:)
142  logical :: fixed_step
143  integer :: flag_periodic
144  real(RP) :: offset
145  integer :: data_steppos(2)
146  real(RP), allocatable :: value(:,:,:,:)
147  character(len=H_SHORT) :: axistype ! axis type
148  logical :: transpose
149  end type extin_itemcontainer
150 
151 
152  integer, private :: EXTIN_item_count = 0
153  type(EXTIN_itemcontainer), private :: EXTIN_item(EXTIN_item_limit)
154 
155  !-----------------------------------------------------------------------------
156 contains
157  !-----------------------------------------------------------------------------
159  subroutine extin_setup( model )
160  use scale_process, only: &
161  prc_mpistop
162  use scale_const, only: &
163  undef => const_undef
164  use scale_external_input_rm, only: &
165  extin_rm_get_dims_1d, &
166  extin_rm_get_dims_2d, &
167  extin_rm_get_dims_3d
168  implicit none
169  character(len=*), intent(in) :: model
170 
171  character(len=H_LONG) :: basename
172  character(len=H_SHORT) :: varname
173  character(len=H_SHORT) :: axistype
174  integer :: step_limit ! limit number for reading data
175  integer :: step_fixed ! fixed step position to read
176  logical :: enable_periodic_year ! treat as yearly periodic data?
177  logical :: enable_periodic_month ! treat as yearly,monthly periodic data?
178  logical :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
179  real(RP) :: offset
180  real(RP) :: defval
181  logical :: check_coordinates
182 
183  namelist /extitem/ &
184  basename, &
185  varname, &
186  axistype, &
187  step_limit, &
188  step_fixed, &
189  enable_periodic_year, &
190  enable_periodic_month, &
191  enable_periodic_day, &
192  offset, &
193  defval, &
194  check_coordinates
195 
196  integer :: count
197  integer :: ierr
198  !---------------------------------------------------------------------------
199 
200  if( io_l ) write(io_fid_log,*)
201  if( io_l ) write(io_fid_log,*) '++++++ Module[EXTIN] / Categ[ATMOS-RM IO] / Origin[SCALElib]'
202 
203  select case ( model )
204  case ( 'RM' )
205  extin_get_dims_1d => extin_rm_get_dims_1d
206  extin_get_dims_2d => extin_rm_get_dims_2d
207  extin_get_dims_3d => extin_rm_get_dims_3d
208 ! case ( 'GM' )
209  case default
210  write(*,*) 'xxx EXTIN is not support for the model: ', trim(model)
211  call prc_mpistop
212  end select
213 
214  ! count external data from namelist
215  rewind(io_fid_conf)
216  do count = 1, extin_item_limit
217 
218  ! set default
219  step_limit = extin_step_limit
220  basename = ''
221  varname = ''
222  axistype = ''
223  step_fixed = -1
224  enable_periodic_year = .false.
225  enable_periodic_month = .false.
226  enable_periodic_day = .false.
227  offset = 0.0_rp
228  defval = undef
229  check_coordinates = .false.
230 
231  ! read namelist
232  read(io_fid_conf,nml=extitem,iostat=ierr)
233 
234  if( ierr < 0 ) then !--- no more items
235  exit
236  elseif( ierr > 0 ) then !--- fatal error
237  write(*,*) 'xxx Not appropriate names in namelist EXTITEM. Check!', count
238  call prc_mpistop
239  endif
240 
241  if( io_nml .AND. io_fid_nml /= io_fid_log ) write(io_fid_nml,nml=extitem)
242 
243  call extin_regist( basename, & ! [IN]
244  varname, & ! [IN]
245  axistype, & ! [IN]
246  enable_periodic_year, & ! [IN]
247  enable_periodic_month, & ! [IN]
248  enable_periodic_day, & ! [IN]
249  step_fixed, & ! [IN]
250  offset, & ! [IN]
251  defval, & ! [IN]
252  check_coordinates, & ! [IN]
253  step_limit ) ! [IN]
254 
255  enddo
256 
257  return
258  end subroutine extin_setup
259 
260  !-----------------------------------------------------------------------------
262  subroutine extin_regist( &
263  basename, &
264  varname, &
265  axistype, &
266  enable_periodic_year, &
267  enable_periodic_month, &
268  enable_periodic_day, &
269  step_fixed, &
270  offset, &
271  defval, &
272  check_coordinates, &
273  step_limit, &
274  exist )
275  use gtool_file_h, only: &
276  file_fread
277  use gtool_file, only: &
278  fileopen, &
279  filegetalldatainfo, &
280  fileread
281  use scale_process, only: &
282  prc_myrank, &
283  prc_mpistop
284  use scale_fileio, only: &
285  fileio_check_coordinates
286  use scale_calendar, only: &
287  calendar_adjust_daysec, &
288  calendar_daysec2date, &
289  calendar_date2daysec, &
290  calendar_combine_daysec, &
291  calendar_cfunits2sec, &
292  i_year, &
293  i_month, &
294  i_day
295  use scale_time, only: &
296  time_startdaysec, &
297  time_nowdaysec, &
298  time_offset_year
299  implicit none
300 
301  character(len=*) , intent(in) :: basename
302  character(len=*) , intent(in) :: varname
303  character(len=*) , intent(in) :: axistype
304  integer , intent(in) :: step_fixed ! fixed step position to read
305  logical , intent(in) :: enable_periodic_year ! treat as yearly periodic data?
306  logical , intent(in) :: enable_periodic_month ! treat as yearly,monthly periodic data?
307  logical , intent(in) :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
308  real(RP) , intent(in) :: offset
309  real(RP) , intent(in) :: defval
310  logical, optional, intent(in) :: check_coordinates
311  integer, optional, intent(in) :: step_limit ! limit number for reading data
312  logical, optional, intent(out) :: exist
313 
314  integer :: step_nmax
315  character(len=H_LONG) :: description
316  character(len=H_SHORT) :: unit
317  integer :: datatype
318  integer :: dim_rank
319  character(len=H_SHORT) :: dim_name (3)
320  integer :: dim_size (3)
321  real(DP) :: time_start(extin_step_limit)
322  real(DP) :: time_end (extin_step_limit)
323  character(len=H_MID) :: time_units
324 
325  integer :: datadate(6)
326  real(DP) :: datasubsec
327  integer :: dataday
328  real(DP) :: datasec
329  integer :: offset_year
330 
331  integer :: dim1_max, dim1_s, dim1_e
332  integer :: dim2_max, dim2_s, dim2_e
333  integer :: dim3_max, dim3_s, dim3_e
334 
335  integer :: step_limit_
336 
337  integer :: fid
338  integer :: nid, n
339  !---------------------------------------------------------------------------
340 
341  if ( present(step_limit) ) then
342  if ( step_limit > 0 ) then
343  step_limit_ = step_limit
344  else
345  step_limit_ = extin_step_limit
346  end if
347  else
348  step_limit_ = extin_step_limit
349  end if
350 
351  do nid = 1, extin_item_count
352  if ( extin_item(nid)%varname == varname ) then
353  write(*,*) 'xxx Data is already registered! basename,varname = ', trim(basename), ', ', trim(varname)
354  call prc_mpistop
355  end if
356  end do
357 
358  extin_item_count = extin_item_count + 1
359 
360  if ( extin_item_count > extin_item_limit ) then
361  write(*,*) 'xxx Number of EXT data exceedes the limit', extin_item_count, extin_item_limit
362  call prc_mpistop
363  end if
364 
365  call fileopen( fid, basename, file_fread, myrank=prc_myrank )
366 
367  ! read from file
368  call filegetalldatainfo( step_limit_, & ! [IN]
369  extin_dim_limit, & ! [IN]
370  fid, & ! [IN]
371  varname, & ! [IN]
372  step_nmax, & ! [OUT]
373  description, & ! [OUT]
374  unit, & ! [OUT]
375  datatype, & ! [OUT]
376  dim_rank, & ! [OUT]
377  dim_name(:), & ! [OUT]
378  dim_size(:), & ! [OUT]
379  time_start(1:step_limit_), & ! [OUT]
380  time_end(1:step_limit_), & ! [OUT]
381  time_units ) ! [OUT]
382 
383  if ( step_nmax == 0 ) then
384  if ( present(exist) ) then
385  exist = .false.
386  return
387  end if
388  write(*,*) 'xxx Data not found! basename,varname = ', trim(basename), ', ', trim(varname)
389  call prc_mpistop
390  endif
391 
392  if ( present(exist) ) exist = .true.
393 
394  do n = dim_rank+1, 3
395  dim_size(n) = 1
396  end do
397 
398  nid = extin_item_count
399 
400  ! setup item
401  extin_item(nid)%fid = fid
402  extin_item(nid)%varname = varname
403  extin_item(nid)%dim_size(:) = dim_size(:)
404  extin_item(nid)%step_num = step_nmax
405 
406  if ( enable_periodic_day ) then
407  extin_item(nid)%flag_periodic = i_periodic_day
408  elseif( enable_periodic_month ) then
409  extin_item(nid)%flag_periodic = i_periodic_month
410  elseif( enable_periodic_year ) then
411  extin_item(nid)%flag_periodic = i_periodic_year
412  else
413  extin_item(nid)%flag_periodic = 0
414  endif
415 
416  allocate( extin_item(nid)%value(dim_size(1),dim_size(2),dim_size(3),2) )
417  extin_item(nid)%value(:,:,:,:) = defval
418  extin_item(nid)%offset = offset
419 
420  allocate( extin_item(nid)%time(step_nmax) )
421  extin_item(nid)%time(:) = 0.0_dp
422 
423  do n = 1, extin_item(nid)%step_num
424  extin_item(nid)%time(n) = calendar_cfunits2sec( time_end(n), time_units, time_offset_year, time_startdaysec )
425  enddo
426 
427  if ( extin_item(nid)%step_num == 1 ) then
428 
429  extin_item(nid)%fixed_step = .true.
430  extin_item(nid)%data_steppos(i_prev) = 1
431  extin_item(nid)%data_steppos(i_next) = 1
432 
433  else if ( step_fixed > 0 ) then ! fixed time step mode
434 
435  extin_item(nid)%fixed_step = .true.
436  extin_item(nid)%data_steppos(i_prev) = step_fixed
437  extin_item(nid)%data_steppos(i_next) = step_fixed
438 
439  else
440 
441  extin_item(nid)%fixed_step = .false.
442 
443  ! seek start position
444  extin_item(nid)%data_steppos(i_next) = 1
445  do n = 1, extin_item(nid)%step_num
446  if ( extin_item(nid)%time(n) > time_nowdaysec ) exit
447  extin_item(nid)%data_steppos(i_next) = n + 1
448  enddo
449 
450  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%data_steppos(i_next) - 1
451 
452  if ( extin_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
453 
454  if ( extin_item(nid)%data_steppos(i_next) == 1 ) then ! between first-1 and first
455 
456  ! first-1 = last
457  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%step_num
458 
459  elseif( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then ! between last and last+1
460 
461  ! last+1 = first
462  extin_item(nid)%data_steppos(i_next) = 1
463 
464  ! update data time in periodic condition
465  do n = 1, extin_item(nid)%step_num
466  dataday = 0
467  datasec = extin_item(nid)%time(n)
468  offset_year = 0
469  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
470 
471  call calendar_daysec2date( datadate(:), & ! [OUT]
472  datasubsec, & ! [OUT]
473  dataday, & ! [IN]
474  datasec, & ! [IN]
475  offset_year ) ! [IN]
476 
477  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
478  datadate(i_day) = datadate(i_day) + 1
479  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
480  datadate(i_month) = datadate(i_month) + 1
481  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
482  datadate(i_year) = datadate(i_year) + 1
483  endif
484 
485  call calendar_date2daysec( dataday, & ! [OUT]
486  datasec, & ! [OUT]
487  datadate(:), & ! [IN]
488  datasubsec, & ! [IN]
489  offset_year ) ! [IN]
490 
491  extin_item(nid)%time(n) = calendar_combine_daysec( dataday, datasec )
492  enddo
493 
494  if( io_l ) write(io_fid_log,*) '*** data time is updated.'
495  endif
496 
497  else ! normal mode
498 
499  if ( extin_item(nid)%data_steppos(i_next) == 1 &
500  .OR. extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
501  write(*,*) 'xxx Current time is out of period of external data! ', trim(varname)
502  call prc_mpistop
503  endif
504 
505  endif
506 
507  endif
508 
509  !--- read first data
510  if( io_l ) write(io_fid_log,'(1x,A,A15)') '*** Initial read of external data : ', trim(varname)
511 
512  if ( dim_size(1) >= 1 &
513  .AND. dim_size(2) == 1 &
514  .AND. dim_size(3) == 1 ) then ! 1D
515 
516  call extin_get_dims_1d( &
517  dim1_max, dim1_s, dim1_e, & ! (out)
518  varname, axistype ) ! (in)
519 
520  extin_item(nid)%ndim = 1
521  extin_item(nid)%transpose = .false.
522  allocate( extin_item(nid)%dim_start(1) )
523  extin_item(nid)%dim_start(1) = dim1_s
524 
525  if ( dim1_max /= dim_size(1) ) then
526  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
527  write(*,*) 'xxx dim 1 (data,requested) : ', dim_size(1), dim1_max
528  call prc_mpistop
529  endif
530 
531  ! read prev
532  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
533  '*** Read 1D var : ', trim(extin_item(nid)%varname), &
534  ' (step= ', extin_item(nid)%data_steppos(i_prev), ')'
535  call fileread( extin_item(nid)%value(:,1,1,i_prev), &
536  extin_item(nid)%fid, &
537  extin_item(nid)%varname, &
538  extin_item(nid)%data_steppos(i_prev) )
539  ! read next
540  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
541  '*** Read 1D var : ', trim(extin_item(nid)%varname), &
542  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
543  call fileread( extin_item(nid)%value(:,1,1,i_next), &
544  extin_item(nid)%fid, &
545  extin_item(nid)%varname, &
546  extin_item(nid)%data_steppos(i_next) )
547 
548  elseif ( dim_size(1) >= 1 &
549  .AND. dim_size(2) > 1 &
550  .AND. dim_size(3) == 1 ) then ! 2D
551 
552  call extin_get_dims_2d( &
553  dim1_max, dim1_s, dim1_e, & ! (out)
554  dim2_max, dim2_s, dim2_e, & ! (out)
555  extin_item(nid)%transpose, & ! (out)
556  varname, axistype ) ! (in)
557 
558  extin_item(nid)%ndim = 2
559  allocate( extin_item(nid)%dim_start(2) )
560  extin_item(nid)%dim_start(1) = dim1_s
561  extin_item(nid)%dim_start(2) = dim2_s
562 
563  if ( dim1_max /= dim_size(1) &
564  .OR. dim2_max /= dim_size(2) ) then
565  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
566  write(*,*) 'xxx dim 1 (data,requested) : ', dim_size(1), dim1_max
567  write(*,*) 'xxx dim 2 (data,requested) : ', dim_size(2), dim2_max
568  call prc_mpistop
569  endif
570 
571  ! read prev
572  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
573  '*** Read 2D var : ', trim(extin_item(nid)%varname), &
574  ' (step= ', extin_item(nid)%data_steppos(i_prev), ')'
575  call fileread( extin_item(nid)%value(:,:,1,i_prev), &
576  extin_item(nid)%fid, &
577  extin_item(nid)%varname, &
578  extin_item(nid)%data_steppos(i_prev) )
579  ! read next
580  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
581  '*** Read 2D var : ', trim(extin_item(nid)%varname), &
582  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
583  call fileread( extin_item(nid)%value(:,:,1,i_next), &
584  extin_item(nid)%fid, &
585  extin_item(nid)%varname, &
586  extin_item(nid)%data_steppos(i_next) )
587 
588  elseif ( dim_size(1) >= 1 &
589  .AND. dim_size(2) > 1 &
590  .AND. dim_size(3) > 1 ) then ! 3D
591 
592  call extin_get_dims_3d( &
593  dim1_max, dim1_s, dim1_e, & ! (out)
594  dim2_max, dim2_s, dim2_e, & ! (out)
595  dim3_max, dim3_s, dim3_e, & ! (out)
596  extin_item(nid)%transpose, & ! (out)
597  varname, axistype ) ! (in)
598 
599  extin_item(nid)%ndim = 3
600  allocate( extin_item(nid)%dim_start(3) )
601  extin_item(nid)%dim_start(1) = dim1_s
602  extin_item(nid)%dim_start(2) = dim2_s
603  extin_item(nid)%dim_start(3) = dim3_s
604 
605  if ( dim1_max /= dim_size(1) &
606  .OR. dim2_max /= dim_size(2) &
607  .OR. dim3_max /= dim_size(3) ) then
608  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
609  write(*,*) 'xxx dim 1 (data,requested) : ', dim_size(1), dim1_max
610  write(*,*) 'xxx dim 2 (data,requested) : ', dim_size(2), dim2_max
611  write(*,*) 'xxx dim 3 (data,requested) : ', dim_size(3), dim3_max
612  call prc_mpistop
613  endif
614 
615  ! read prev
616  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
617  '*** Read 3D var : ', trim(extin_item(nid)%varname), &
618  ' (step= ', extin_item(nid)%data_steppos(i_prev), ')'
619  call fileread( extin_item(nid)%value(:,:,:,i_prev), &
620  extin_item(nid)%fid, &
621  extin_item(nid)%varname, &
622  extin_item(nid)%data_steppos(i_prev) )
623 
624  ! read next
625  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
626  '*** Read 3D var : ', trim(extin_item(nid)%varname), &
627  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
628  call fileread( extin_item(nid)%value(:,:,:,i_next), &
629  extin_item(nid)%fid, &
630  extin_item(nid)%varname, &
631  extin_item(nid)%data_steppos(i_next) )
632 
633  else
634  write(*,*) 'xxx Unexpected dimsize: ', dim_size(:)
635  call prc_mpistop
636  endif
637 
638  if ( present(check_coordinates) ) then
639  if ( check_coordinates ) &
640  call fileio_check_coordinates( fid, &
641  atmos = extin_item(nid)%ndim==3, &
642  transpose = extin_item(nid)%transpose )
643  end if
644 
645  return
646  end subroutine extin_regist
647 
648  !-----------------------------------------------------------------------------
650  subroutine extin_update_1d( &
651  var, &
652  varname, &
653  current_time, &
654  error )
655  use gtool_file, only: &
656  fileread
657  use scale_process, only: &
658  prc_mpistop
659  implicit none
660 
661  real(RP), intent(out) :: var(:) ! variable
662  character(len=*), intent(in) :: varname ! item name
663  real(DP), intent(in) :: current_time ! current time
664  logical, intent(out) :: error ! error code
665 
666  integer :: nid
667  real(RP) :: weight
668  logical :: do_readfile
669 
670  integer :: n
671  integer :: n1
672  integer :: nn1
673  !---------------------------------------------------------------------------
674 
675  error = .true.
676 
677  ! searching the data ID
678  nid = -1
679  do n = 1, extin_item_count
680  if( varname == extin_item(n)%varname ) nid = n
681  enddo
682 
683  if ( nid == 0 ) then
684  if( io_l ) write(io_fid_log,*) 'xxx Variable was not registered: ', trim(varname)
685  return
686  end if
687 
688  if ( extin_item(nid)%ndim /= 1 ) then
689  write(*,*) 'xxx Data is not 1D var: ', trim(extin_item(nid)%varname)
690  call prc_mpistop
691  end if
692 
693  call extin_time_advance( nid, & ! [IN]
694  current_time, & ! [IN]
695  weight, & ! [OUT]
696  do_readfile ) ! [OUT]
697 
698  if ( do_readfile ) then
699 
700  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
701  '*** Read 1D var : ', trim(extin_item(nid)%varname), &
702  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
703 
704  ! next -> prev
705  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
706 
707  ! read next
708  call fileread( extin_item(nid)%value(:,1,1,i_next), & ! [OUT]
709  extin_item(nid)%fid, & ! [IN]
710  extin_item(nid)%varname, & ! [IN]
711  extin_item(nid)%data_steppos(i_next) )
712  endif
713 
714  ! store data with weight
715  do n1 = 1, extin_item(nid)%dim_size(1)
716  nn1 = n1 + extin_item(nid)%dim_start(1) - 1
717 
718  var(nn1) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,1,1,i_prev) &
719  + ( weight ) * extin_item(nid)%value(n1,1,1,i_next)
720  enddo
721 
722  error = .false.
723 
724  return
725  end subroutine extin_update_1d
726 
727  !-----------------------------------------------------------------------------
729  subroutine extin_update_2d( &
730  var, &
731  varname, &
732  current_time, &
733  error )
734  use gtool_file, only: &
735  fileread
736  use scale_process, only: &
737  prc_mpistop
738  implicit none
739 
740  real(RP), intent(out) :: var(:,:) ! variable
741  character(len=*), intent(in) :: varname ! item name
742  real(DP), intent(in) :: current_time ! current time
743  logical, intent(out) :: error ! error code
744 
745  integer :: nid
746  real(RP) :: weight
747  logical :: do_readfile
748 
749  integer :: n
750  integer :: n1, n2
751  integer :: nn1, nn2
752  !---------------------------------------------------------------------------
753 
754  error = .true.
755 
756  ! searching the data ID
757  nid = -1
758  do n = 1, extin_item_count
759  if( varname == extin_item(n)%varname ) nid = n
760  enddo
761 
762  if ( nid == 0 ) then
763  if( io_l ) write(io_fid_log,*) 'xxx variable was not registered: ', trim(varname)
764  return
765  end if
766 
767  call extin_time_advance( nid, & ! [IN]
768  current_time, & ! [IN]
769  weight, & ! [OUT]
770  do_readfile ) ! [OUT]
771 
772  if ( do_readfile ) then
773 
774  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
775  '*** Read 2D var : ', trim(extin_item(nid)%varname), &
776  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
777 
778  ! next -> prev
779  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
780 
781  ! read next
782  call fileread( extin_item(nid)%value(:,:,1,i_next), & ! [OUT]
783  extin_item(nid)%fid, & ! [IN]
784  extin_item(nid)%varname, & ! [IN]
785  extin_item(nid)%data_steppos(i_next) ) ! [IN]
786  endif
787 
788  if ( extin_item(nid)%transpose ) then
789  ! store data with weight (x,z)->(z,x)
790  do n1 = 1, extin_item(nid)%dim_size(1)
791  nn1 = n1 + extin_item(nid)%dim_start(1) - 1
792  do n2 = 1, extin_item(nid)%dim_size(2)
793 
794  nn2 = n2 + extin_item(nid)%dim_start(2) - 1
795  var(nn2,nn1) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,1,i_prev) &
796  + ( weight ) * extin_item(nid)%value(n1,n2,1,i_next)
797  enddo
798  enddo
799  else
800  ! store data with weight
801  do n2 = 1, extin_item(nid)%dim_size(2)
802  nn2 = n2 + extin_item(nid)%dim_start(2) - 1
803  do n1 = 1, extin_item(nid)%dim_size(1)
804  nn1 = n1 + extin_item(nid)%dim_start(1) - 1
805 
806  var(nn1,nn2) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,1,i_prev) &
807  + ( weight ) * extin_item(nid)%value(n1,n2,1,i_next)
808  enddo
809  enddo
810  end if
811 
812  error = .false.
813 
814  return
815  end subroutine extin_update_2d
816 
817  !-----------------------------------------------------------------------------
819  subroutine extin_update_3d( &
820  var, &
821  varname, &
822  current_time, &
823  error )
824  use gtool_file, only: &
825  fileread
826  use scale_process, only: &
827  prc_mpistop
828  implicit none
829 
830  real(RP), intent(out) :: var(:,:,:) ! variable
831  character(len=*), intent(in) :: varname ! item name
832  real(DP), intent(in) :: current_time ! current time
833  logical, intent(out) :: error ! error code
834 
835  integer :: nid
836  real(RP) :: weight
837  logical :: do_readfile
838 
839  integer :: n
840  integer :: n1, n2, n3
841  integer :: nn1, nn2, nn3
842  !---------------------------------------------------------------------------
843 
844  error = .true.
845 
846  ! searching the data ID
847  nid = -1
848  do n = 1, extin_item_count
849  if( varname == extin_item(n)%varname ) nid = n
850  enddo
851 
852  if ( nid == 0 ) then
853  if( io_l ) write(io_fid_log,*) 'xxx variable was not registered: ', trim(varname)
854  return
855  end if
856 
857  call extin_time_advance( nid, & ! [IN]
858  current_time, & ! [IN]
859  weight, & ! [OUT]
860  do_readfile ) ! [OUT]
861 
862  if ( do_readfile ) then
863 
864  if( io_l ) write(io_fid_log,'(1x,A,A,A,I4,A)') &
865  '*** Read 3D var : ', trim(extin_item(nid)%varname), &
866  ' (step= ', extin_item(nid)%data_steppos(i_next), ')'
867 
868  ! next -> prev
869  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
870 
871  ! read next
872  call fileread( extin_item(nid)%value(:,:,:,i_next), & ! [OUT]
873  extin_item(nid)%fid, & ! [IN]
874  extin_item(nid)%varname, & ! [IN]
875  extin_item(nid)%data_steppos(i_next) ) ! [IN]
876  endif
877 
878  if ( extin_item(nid)%transpose ) then
879  ! store data with weight (x,y,z)->(z,x,y)
880  do n2 = 1, extin_item(nid)%dim_size(2)
881  nn2 = n2 + extin_item(nid)%dim_start(2) - 1
882  do n1 = 1, extin_item(nid)%dim_size(1)
883  nn1 = n1 + extin_item(nid)%dim_start(1) - 1
884  do n3 = 1, extin_item(nid)%dim_size(3)
885  nn3 = n3 + extin_item(nid)%dim_start(3) - 1
886 
887  var(nn3,nn1,nn2) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,n3,i_prev) &
888  + ( weight ) * extin_item(nid)%value(n1,n2,n3,i_next)
889  enddo
890  enddo
891  enddo
892  else
893  ! store data with weight (z,x,y)->(z,x,y)
894  do n3 = 1, extin_item(nid)%dim_size(3)
895  nn3 = n3 + extin_item(nid)%dim_start(3) - 1
896  do n2 = 1, extin_item(nid)%dim_size(2)
897  nn2 = n2 + extin_item(nid)%dim_start(2) - 1
898  do n1 = 1, extin_item(nid)%dim_size(1)
899  nn1 = n1 + extin_item(nid)%dim_start(1) - 1
900 
901  var(nn1,nn2,nn3) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,n3,i_prev) &
902  + ( weight ) * extin_item(nid)%value(n1,n2,n3,i_next)
903  enddo
904  enddo
905  enddo
906  end if
907 
908  error = .false.
909 
910  return
911  end subroutine extin_update_3d
912 
913  !-----------------------------------------------------------------------------
915  subroutine extin_time_advance( &
916  nid, &
917  current_time, &
918  weight, &
919  do_readfile )
920  use scale_calendar, only: &
921  calendar_adjust_daysec, &
922  calendar_daysec2date, &
923  calendar_date2daysec, &
924  calendar_combine_daysec, &
925  i_year, &
926  i_month, &
927  i_day
928  implicit none
929 
930  integer, intent(in) :: nid ! item id
931  real(DP), intent(in) :: current_time ! current time
932  real(RP), intent(out) :: weight ! weight
933  logical, intent(out) :: do_readfile ! read new data at this time?
934 
935  integer :: datadate(6)
936  real(DP) :: datasubsec
937  integer :: dataday
938  real(DP) :: datasec
939  integer :: offset_year
940 
941  real(DP) :: prev_time, next_time
942  integer :: t
943  !---------------------------------------------------------------------------
944 
945  do_readfile = .false.
946 
947  if ( extin_item(nid)%fixed_step ) then
948  !--- no time-advance
949  else
950  ! time is passed?
951  if ( current_time > extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) ) ) then
952 
953  do_readfile = .true.
954 
955  if( io_l ) write(io_fid_log,'(1x,A,A15)') '*** Update external input : ', trim(extin_item(nid)%varname)
956 
957  ! update step position
958  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%data_steppos(i_prev) + 1
959  extin_item(nid)%data_steppos(i_next) = extin_item(nid)%data_steppos(i_next) + 1
960 
961  if ( extin_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
962 
963  if ( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
964 
965  ! last+1 = first
966  extin_item(nid)%data_steppos(i_next) = 1
967 
968  ! update data time in periodic condition
969  do t = 1, extin_item(nid)%step_num
970  dataday = 0
971  datasec = extin_item(nid)%time(t)
972  offset_year = 0
973  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
974 
975  call calendar_daysec2date( datadate(:), & ! [OUT]
976  datasubsec, & ! [OUT]
977  dataday, & ! [IN]
978  datasec, & ! [IN]
979  offset_year ) ! [IN]
980 
981  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
982  datadate(i_day) = datadate(i_day) + 1
983  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
984  datadate(i_month) = datadate(i_month) + 1
985  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
986  datadate(i_year) = datadate(i_year) + 1
987  endif
988 
989  call calendar_date2daysec( dataday, & ! [IN]
990  datasec, & ! [IN]
991  datadate(:), & ! [OUT]
992  datasubsec, & ! [OUT]
993  offset_year ) ! [IN]
994 
995  extin_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
996  enddo
997  endif
998 
999  else ! normal mode
1000 
1001  if ( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
1002  write(*,*) 'xxx Current time is out of period of external data! '
1003  call prc_mpistop
1004  endif
1005 
1006  endif
1007 
1008  endif
1009 
1010  endif
1011 
1012  ! calc weight
1013  if ( extin_item(nid)%fixed_step ) then
1014 
1015  weight = 0.0_rp
1016 
1017  elseif( extin_item(nid)%data_steppos(i_next) == 1 ) then
1018 
1019  dataday = 0
1020  datasec = extin_item(nid)%time( extin_item(nid)%data_steppos(i_prev) )
1021  offset_year = 0
1022  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
1023 
1024  call calendar_daysec2date( datadate(:), & ! [OUT]
1025  datasubsec, & ! [OUT]
1026  dataday, & ! [IN]
1027  datasec, & ! [IN]
1028  offset_year ) ! [IN]
1029 
1030  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
1031  datadate(i_day) = datadate(i_day) - 1
1032  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
1033  datadate(i_month) = datadate(i_month) - 1
1034  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
1035  datadate(i_year) = datadate(i_year) - 1
1036  endif
1037 
1038  call calendar_date2daysec( dataday, & ! [IN]
1039  datasec, & ! [IN]
1040  datadate(:), & ! [OUT]
1041  datasubsec, & ! [OUT]
1042  offset_year ) ! [IN]
1043 
1044  prev_time = calendar_combine_daysec( dataday, datasec )
1045 
1046  next_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) )
1047 
1048  weight = ( current_time - prev_time ) &
1049  / ( next_time - prev_time )
1050 
1051  else
1052 
1053  prev_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_prev) )
1054  next_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) )
1055 
1056  weight = ( current_time - prev_time ) &
1057  / ( next_time - prev_time )
1058 
1059  endif
1060 
1061  return
1062  end subroutine extin_time_advance
1063 
1064 end module scale_external_input
scale_calendar::i_month
integer, parameter, public i_month
[index] month
Definition: scale_calendar.F90:46
gtool_file
module GTOOL_FILE
Definition: gtool_file.f90:17
scale_calendar::i_year
integer, parameter, public i_year
[index] year
Definition: scale_calendar.F90:45
scale_external_input_rm
module EXTERNAL INPUT
Definition: scale_external_input_rm.F90:11
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:267
scale_calendar::calendar_combine_daysec
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
Definition: scale_calendar.F90:347
scale_external_input::extin_update_2d
subroutine extin_update_2d(var, varname, current_time, error)
Read data.
Definition: scale_external_input.F90:734
scale_external_input_rm::extin_rm_get_dims_2d
subroutine, public extin_rm_get_dims_2d(dim1_max, dim1_S, dim1_E, dim2_max, dim2_S, dim2_E, transpose, varname, axistype)
Definition: scale_external_input_rm.F90:95
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:61
scale_time::time_nowdaysec
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:69
scale_stdio
module STDIO
Definition: scale_stdio.F90:12
scale_time::time_startdaysec
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:74
scale_external_input::extin_setup
subroutine, public extin_setup(model)
Setup.
Definition: scale_external_input.F90:160
scale_fileio
module FILE I/O (netcdf)
Definition: scale_fileio.F90:14
scale_external_input::extin_update_1d
subroutine extin_update_1d(var, varname, current_time, error)
Read data.
Definition: scale_external_input.F90:655
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_external_input::extin_update_3d
subroutine extin_update_3d(var, varname, current_time, error)
Read data.
Definition: scale_external_input.F90:824
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_stdio::io_nml
logical, public io_nml
output log or not? (for namelist, this process)
Definition: scale_stdio.F90:62
scale_calendar::calendar_adjust_daysec
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
Definition: scale_calendar.F90:327
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:397
scale_external_input_rm::extin_rm_get_dims_3d
subroutine, public extin_rm_get_dims_3d(dim1_max, dim1_S, dim1_E, dim2_max, dim2_S, dim2_E, dim3_max, dim3_S, dim3_E, transpose, varname, axistype)
Definition: scale_external_input_rm.F90:154
scale_time::time_offset_year
integer, public time_offset_year
time offset [year]
Definition: scale_time.F90:73
scale_time
module TIME
Definition: scale_time.F90:15
scale_process
module PROCESS
Definition: scale_process.F90:14
gtool_file_h::file_fread
integer, parameter, public file_fread
Definition: gtool_file_h.f90:50
scale_external_input::extin_regist
subroutine, public extin_regist(basename, varname, axistype, enable_periodic_year, enable_periodic_month, enable_periodic_day, step_fixed, offset, defval, check_coordinates, step_limit, exist)
Regist data.
Definition: scale_external_input.F90:275
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_external_input
module EXTERNAL INPUT
Definition: scale_external_input.F90:11
scale_process::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_process.F90:79
scale_calendar::i_day
integer, parameter, public i_day
[index] day
Definition: scale_calendar.F90:47
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:149
scale_prof
module profiler
Definition: scale_prof.F90:10
scale_external_input_rm::extin_rm_get_dims_1d
subroutine, public extin_rm_get_dims_1d(dim1_max, dim1_S, dim1_E, varname, axistype)
get_dims
Definition: scale_external_input_rm.F90:55
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:15
scale_land_grid_index
module land grid index
Definition: scale_land_grid_index.F90:10
gtool_file_h
module FILE I/O HEADER
Definition: gtool_file_h.f90:14
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
gtool_file::fileopen
subroutine, public fileopen(fid, basename, mode, single, comm, myrank)
Definition: gtool_file.f90:495
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
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:117
scale_stdio::io_fid_nml
integer, public io_fid_nml
Log file ID (only for output namelist)
Definition: scale_stdio.F90:57
scale_urban_grid_index
module urban grid index
Definition: scale_urban_grid_index.F90:10
Generated by   doxygen 1.8.14