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_update
34 
35  interface extin_update
36  module procedure extin_update_1d
37  module procedure extin_update_2d
38  module procedure extin_update_3d
39  end interface extin_update
40 
41  !-----------------------------------------------------------------------------
42  !
43  !++ Public parameters & variables
44  !
45  !-----------------------------------------------------------------------------
46  !
47  !++ Private procedures
48  !
49  private :: extin_time_advance
50 
51  !-----------------------------------------------------------------------------
52  !
53  !++ Private parameters & variables
54  !
55  integer, private, parameter :: i_prev = 1
56  integer, private, parameter :: i_next = 2
57 
58  integer, private, parameter :: i_periodic_year = 1
59  integer, private, parameter :: i_periodic_month = 2
60  integer, private, parameter :: i_periodic_day = 3
61 
62  integer, private, parameter :: extin_item_limit = 1000
63  integer, private, parameter :: extin_step_limit = 10000
64  integer, private, parameter :: extin_dim_limit = 3
65 
66  type, private :: extin_itemcontainer
67  character(len=H_LONG) :: basename
68  character(len=H_SHORT) :: varname
69  integer :: dim_size(extin_dim_limit)
70  integer :: step_num
71  real(DP), allocatable :: time(:)
72  logical :: fixed_step
73  integer :: flag_periodic
74  real(RP) :: offset
75  integer :: data_steppos(2)
76  real(RP), allocatable :: value(:,:,:,:)
77  end type extin_itemcontainer
78 
79 
80  integer, private :: extin_item_count = 0
81  type(extin_itemcontainer), private, allocatable :: extin_item(:)
82 
83  !-----------------------------------------------------------------------------
84 contains
85  !-----------------------------------------------------------------------------
87  subroutine extin_setup
88  use gtool_file, only: &
89  filegetalldatainfo, &
90  fileread
91  use scale_process, only: &
92  prc_myrank, &
93  prc_mpistop
94  use scale_const, only: &
95  undef => const_undef
96  use scale_calendar, only: &
97  calendar_adjust_daysec, &
98  calendar_daysec2date, &
99  calendar_date2daysec, &
100  calendar_combine_daysec, &
101  calendar_cfunits2sec, &
102  i_year, &
103  i_month, &
104  i_day
105  use scale_time, only: &
106  time_startdaysec, &
107  time_nowdaysec, &
108  time_offset_year
109  implicit none
110 
111  character(len=H_LONG) :: basename
112  character(len=H_SHORT) :: varname
113  integer :: step_limit ! limit number for reading data
114  integer :: step_fixed ! fixed step position to read
115  logical :: enable_periodic_year ! treat as yearly periodic data?
116  logical :: enable_periodic_month ! treat as yearly,monthly periodic data?
117  logical :: enable_periodic_day ! treat as yearly,monthly,daily periodic data?
118  real(RP) :: offset
119  real(RP) :: defval
120 
121  namelist /extitem/ &
122  basename, &
123  varname, &
124  step_limit, &
125  step_fixed, &
126  enable_periodic_year, &
127  enable_periodic_month, &
128  enable_periodic_day, &
129  offset, &
130  defval
131 
132  integer :: step_nmax
133  character(len=H_LONG) :: description
134  character(len=H_SHORT) :: unit
135  integer :: datatype
136  integer :: dim_rank
137  character(len=H_SHORT) :: dim_name (3)
138  integer :: dim_size (3)
139  real(DP) :: time_start(extin_step_limit)
140  real(DP) :: time_end (extin_step_limit)
141  character(len=H_MID) :: time_units
142 
143  integer :: datadate(6)
144  real(DP) :: datasubsec
145  integer :: dataday
146  real(DP) :: datasec
147  integer :: offset_year
148  real(DP) :: cftime
149 
150  integer :: count, nid, t, n
151  integer :: ierr
152  !---------------------------------------------------------------------------
153 
154  if( io_l ) write(io_fid_log,*)
155  if( io_l ) write(io_fid_log,*) '++++++ Module[EXTIN] / Categ[ATMOS-RM IO] / Origin[SCALElib]'
156 
157  ! count external data from namelist
158  rewind(io_fid_conf)
159  do count = 1, extin_item_limit
160  read(io_fid_conf,nml=extitem,iostat=ierr)
161 
162  if( ierr < 0 ) then !--- no more items
163  exit
164  elseif( ierr > 0 ) then !--- fatal error
165  write(*,*) 'xxx Not appropriate names in namelist EXTITEM. Check!', count
166  call prc_mpistop
167  endif
168  enddo
169  extin_item_count = count - 1
170 
171  if( io_l ) write(io_fid_log,*)
172  if ( extin_item_count == 0 ) then
173  if( io_l ) write(io_fid_log,*) '*** No external file specified.'
174  return
175  endif
176  if( io_l ) write(io_fid_log,*) '*** Number of external item : ', extin_item_count
177 
178  ! allocate item container
179  allocate( extin_item(extin_item_count) )
180 
181  ! read detail of external data from namelist
182  rewind(io_fid_conf)
183  do nid = 1, extin_item_count
184 
185  ! set default
186  step_limit = extin_step_limit
187  basename = ''
188  varname = ''
189  step_fixed = -1
190  enable_periodic_year = .false.
191  enable_periodic_month = .false.
192  enable_periodic_day = .false.
193  offset = 0.0_rp
194  defval = undef
195 
196  ! read namelist
197  read(io_fid_conf,nml=extitem)
198 
199  ! read from file
200  call filegetalldatainfo( step_limit, & ! [IN]
201  extin_dim_limit, & ! [IN]
202  basename, & ! [IN]
203  varname, & ! [IN]
204  prc_myrank, & ! [IN]
205  step_nmax, & ! [OUT]
206  description, & ! [OUT]
207  unit, & ! [OUT]
208  datatype, & ! [OUT]
209  dim_rank, & ! [OUT]
210  dim_name(:), & ! [OUT]
211  dim_size(:), & ! [OUT]
212  time_start(1:step_limit), & ! [OUT]
213  time_end(1:step_limit), & ! [OUT]
214  time_units ) ! [OUT]
215 
216  if ( step_nmax == 0 ) then
217  write(*,*) 'xxx Data not found! basename,varname = ', trim(basename), ', ', trim(varname)
218  call prc_mpistop
219  endif
220 
221  do n=dim_rank+1, 3
222  dim_size(n) = 1
223  end do
224 
225  ! setup item
226  extin_item(nid)%basename = basename
227  extin_item(nid)%varname = varname
228  extin_item(nid)%dim_size(:) = dim_size(:)
229  extin_item(nid)%step_num = step_nmax
230 
231  if ( enable_periodic_day ) then
232  extin_item(nid)%flag_periodic = i_periodic_day
233  elseif( enable_periodic_month ) then
234  extin_item(nid)%flag_periodic = i_periodic_month
235  elseif( enable_periodic_year ) then
236  extin_item(nid)%flag_periodic = i_periodic_year
237  else
238  extin_item(nid)%flag_periodic = 0
239  endif
240 
241  allocate( extin_item(nid)%value( dim_size(1),dim_size(2),dim_size(3),2) )
242  extin_item(nid)%value(:,:,:,:) = defval
243  extin_item(nid)%offset = offset
244 
245  allocate( extin_item(nid)%time(step_nmax) )
246  extin_item(nid)%time(:) = 0.0_dp
247 
248  do t = 1, extin_item(nid)%step_num
249  cftime = 0.5_dp * ( time_start(t) + time_end(t) )
250 
251  extin_item(nid)%time(t) = calendar_cfunits2sec( cftime, time_units, time_offset_year, time_startdaysec )
252  enddo
253 
254  if ( extin_item(nid)%step_num == 1 ) then
255  step_fixed = 1
256  endif
257 
258 
259 
260  if ( step_fixed > 0 ) then ! fixed time step mode
261 
262  extin_item(nid)%fixed_step = .true.
263  extin_item(nid)%data_steppos(i_prev) = step_fixed
264  extin_item(nid)%data_steppos(i_next) = step_fixed
265 
266  else
267 
268  extin_item(nid)%fixed_step = .false.
269 
270  ! seek start position
271  extin_item(nid)%data_steppos(i_next) = 1
272  do t = 1, extin_item(nid)%step_num
273  if ( extin_item(nid)%time(t) > time_nowdaysec ) exit
274  extin_item(nid)%data_steppos(i_next) = t + 1
275  enddo
276 
277  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%data_steppos(i_next) - 1
278 
279  if ( extin_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
280 
281  if ( extin_item(nid)%data_steppos(i_next) == 1 ) then ! between first-1 and first
282 
283  ! first-1 = last
284  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%step_num
285 
286  elseif( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then ! between last and last+1
287 
288  ! last+1 = first
289  extin_item(nid)%data_steppos(i_next) = 1
290 
291  ! update data time in periodic condition
292  do t = 1, extin_item(nid)%step_num
293  dataday = 0
294  datasec = extin_item(nid)%time(t)
295  offset_year = 0
296  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
297 
298  call calendar_daysec2date( datadate(:), & ! [OUT]
299  datasubsec, & ! [OUT]
300  dataday, & ! [IN]
301  datasec, & ! [IN]
302  offset_year ) ! [IN]
303 
304  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
305  datadate(i_day) = datadate(i_day) + 1
306  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
307  datadate(i_month) = datadate(i_month) + 1
308  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
309  datadate(i_year) = datadate(i_year) + 1
310  endif
311 
312  call calendar_date2daysec( dataday, & ! [OUT]
313  datasec, & ! [OUT]
314  datadate(:), & ! [IN]
315  datasubsec, & ! [IN]
316  offset_year ) ! [IN]
317 
318  extin_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
319  enddo
320 
321  if( io_l ) write(io_fid_log,*) '*** data time is updated.'
322  endif
323 
324  else ! normal mode
325 
326  if ( extin_item(nid)%data_steppos(i_next) == 1 &
327  .OR. extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
328  write(*,*) 'xxx Current time is out of period of external data! ', extin_item(nid)%varname
329  call prc_mpistop
330  endif
331 
332  endif
333 
334  endif
335 
336  !--- read first data
337  if ( dim_size(1) >= 1 &
338  .AND. dim_size(2) == 1 &
339  .AND. dim_size(3) == 1 ) then ! 1D
340 
341  ! read prev
342  call fileread( extin_item(nid)%value(:,1,1,i_prev), &
343  extin_item(nid)%basename, &
344  extin_item(nid)%varname, &
345  extin_item(nid)%data_steppos(i_prev), &
346  prc_myrank )
347  ! read next
348  call fileread( extin_item(nid)%value(:,1,1,i_next), &
349  extin_item(nid)%basename, &
350  extin_item(nid)%varname, &
351  extin_item(nid)%data_steppos(i_next), &
352  prc_myrank )
353 
354  elseif ( dim_size(1) >= 1 &
355  .AND. dim_size(2) > 1 &
356  .AND. dim_size(3) == 1 ) then ! 2D
357 
358  ! read prev
359  call fileread( extin_item(nid)%value(:,:,1,i_prev), &
360  extin_item(nid)%basename, &
361  extin_item(nid)%varname, &
362  extin_item(nid)%data_steppos(i_prev), &
363  prc_myrank )
364  ! read next
365  call fileread( extin_item(nid)%value(:,:,1,i_next), &
366  extin_item(nid)%basename, &
367  extin_item(nid)%varname, &
368  extin_item(nid)%data_steppos(i_next), &
369  prc_myrank )
370 
371  elseif ( dim_size(1) >= 1 &
372  .AND. dim_size(2) > 1 &
373  .AND. dim_size(3) > 1 ) then ! 3D
374 
375  ! read prev
376  call fileread( extin_item(nid)%value(:,:,:,i_prev), &
377  extin_item(nid)%basename, &
378  extin_item(nid)%varname, &
379  extin_item(nid)%data_steppos(i_prev), &
380  prc_myrank )
381  ! read next
382  call fileread( extin_item(nid)%value(:,:,:,i_next), &
383  extin_item(nid)%basename, &
384  extin_item(nid)%varname, &
385  extin_item(nid)%data_steppos(i_next), &
386  prc_myrank )
387 
388  else
389  write(*,*) 'xxx Unexpected dimsize: ', dim_size(:)
390  call prc_mpistop
391  endif
392 
393  enddo
394 
395  return
396  end subroutine extin_setup
397 
398  !-----------------------------------------------------------------------------
400  subroutine extin_update_1d( &
401  var, &
402  varname, &
403  axistype, &
404  current_time, &
405  error )
406  use gtool_file, only: &
407  fileread
408  use scale_process, only: &
409  prc_myrank, &
410  prc_mpistop
411  implicit none
412 
413  real(RP), intent(out) :: var(:) ! variable
414  character(len=*), intent(in) :: varname ! item name
415  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
416  real(DP), intent(in) :: current_time ! current time
417  logical, intent(out) :: error ! error code
418 
419  integer :: nid
420  real(RP) :: weight
421  logical :: do_readfile
422 
423  integer :: dim1_max, dim1_S, dim1_E, n1, nn1
424  integer :: n
425  !---------------------------------------------------------------------------
426 
427  error = .true.
428 
429  ! searching the data ID
430  nid = -1
431  do n = 1, extin_item_count
432  if( varname == extin_item(n)%varname ) nid = n
433  enddo
434 
435  if( nid == 0 ) return
436 
437  if ( axistype == 'Z' ) then
438  dim1_max = kmax
439  dim1_s = ks
440  dim1_e = ke
441  elseif( axistype == 'X' ) then
442  dim1_max = imaxb
443  dim1_s = isb
444  dim1_e = ieb
445  elseif( axistype == 'Y' ) then
446  dim1_max = jmaxb
447  dim1_s = jsb
448  dim1_e = jeb
449  else
450  write(*,*) 'xxx unsupported axis type. Check!', trim(axistype), ' item:',trim(varname)
451  call prc_mpistop
452  endif
453 
454  if ( dim1_max /= extin_item(nid)%dim_size(1) ) then
455  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
456  write(*,*) 'xxx dim 1 (data,requested) : ', extin_item(nid)%dim_size(1), dim1_max
457  call prc_mpistop
458  endif
459 
460  call extin_time_advance( nid, & ! [IN]
461  current_time, & ! [IN]
462  weight, & ! [OUT]
463  do_readfile ) ! [OUT]
464 
465  if ( do_readfile ) then
466  if( io_l ) write(io_fid_log,'(1x,A,A15)') '*** Read 1D var: ', trim(extin_item(nid)%varname)
467 
468  ! next -> prev
469  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
470 
471  ! read next
472  call fileread( extin_item(nid)%value(:,1,1,i_next), & ! [OUT]
473  extin_item(nid)%basename, & ! [IN]
474  extin_item(nid)%varname, & ! [IN]
475  extin_item(nid)%data_steppos(i_next), & ! [IN]
476  prc_myrank ) ! [IN]
477  endif
478 
479  ! store data with weight
480  do n1 = 1, dim1_max
481  nn1 = n1 + dim1_s - 1
482 
483  var(nn1) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,1,1,i_prev) &
484  + ( weight ) * extin_item(nid)%value(n1,1,1,i_next)
485  enddo
486 
487  error = .false.
488 
489  return
490  end subroutine extin_update_1d
491 
492  !-----------------------------------------------------------------------------
494  subroutine extin_update_2d( &
495  var, &
496  varname, &
497  axistype, &
498  current_time, &
499  error )
500  use gtool_file, only: &
501  fileread
502  use scale_process, only: &
503  prc_myrank, &
504  prc_mpistop
505  implicit none
506 
507  real(RP), intent(out) :: var(:,:) ! variable
508  character(len=*), intent(in) :: varname ! item name
509  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
510  real(DP), intent(in) :: current_time ! current time
511  logical, intent(out) :: error ! error code
512 
513  integer :: nid
514  real(RP) :: weight
515  logical :: do_readfile
516 
517  integer :: dim1_max, dim1_S, dim1_E, n1, nn1
518  integer :: dim2_max, dim2_S, dim2_E, n2, nn2
519  integer :: n
520  !---------------------------------------------------------------------------
521 
522  error = .true.
523 
524  ! searching the data ID
525  nid = -1
526  do n = 1, extin_item_count
527  if( varname == extin_item(n)%varname ) nid = n
528  enddo
529 
530  if( nid == 0 ) return
531 
532  if ( axistype == 'XY' ) then
533  dim1_max = imaxb
534  dim2_max = jmaxb
535  dim1_s = isb
536  dim1_e = ieb
537  dim2_s = jsb
538  dim2_e = jeb
539  elseif( axistype == 'ZX' ) then
540  dim1_max = kmax
541  dim2_max = imaxb
542  dim1_s = ks
543  dim1_e = ke
544  dim2_s = isb
545  dim2_e = ieb
546  else
547  write(*,*) 'xxx unsupported axis type. Check!', trim(axistype), ' item:',trim(varname)
548  call prc_mpistop
549  endif
550 
551  if ( dim1_max /= extin_item(nid)%dim_size(1) &
552  .OR. dim2_max /= extin_item(nid)%dim_size(2) ) then
553  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
554  write(*,*) 'xxx dim 1 (data,requested) : ', extin_item(nid)%dim_size(1), dim1_max
555  write(*,*) 'xxx dim 2 (data,requested) : ', extin_item(nid)%dim_size(2), dim2_max
556  call prc_mpistop
557  endif
558 
559  call extin_time_advance( nid, & ! [IN]
560  current_time, & ! [IN]
561  weight, & ! [OUT]
562  do_readfile ) ! [OUT]
563 
564  if ( do_readfile ) then
565 
566  if( io_l ) write(io_fid_log,'(1x,A,A15)') '*** Read 2D var: ', trim(extin_item(nid)%varname)
567  ! next -> prev
568  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
569 
570  ! read next
571  call fileread( extin_item(nid)%value(:,:,1,i_next), & ! [OUT]
572  extin_item(nid)%basename, & ! [IN]
573  extin_item(nid)%varname, & ! [IN]
574  extin_item(nid)%data_steppos(i_next), & ! [IN]
575  prc_myrank ) ! [IN]
576  endif
577 
578  ! store data with weight
579  do n2 = 1, dim2_max
580  nn2 = n2 + dim2_s - 1
581  do n1 = 1, dim1_max
582  nn1 = n1 + dim1_s - 1
583 
584  var(nn1,nn2) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,1,i_prev) &
585  + ( weight ) * extin_item(nid)%value(n1,n2,1,i_next)
586  enddo
587  enddo
588 
589  error = .false.
590 
591  return
592  end subroutine extin_update_2d
593 
594  !-----------------------------------------------------------------------------
596  subroutine extin_update_3d( &
597  var, &
598  varname, &
599  axistype, &
600  current_time, &
601  error )
602  use gtool_file, only: &
603  fileread
604  use scale_process, only: &
605  prc_myrank, &
606  prc_mpistop
607  implicit none
608 
609  real(RP), intent(out) :: var(:,:,:) ! variable
610  character(len=*), intent(in) :: varname ! item name
611  character(len=*), intent(in) :: axistype ! axis type (Z/X/Y)
612  real(DP), intent(in) :: current_time ! current time
613  logical, intent(out) :: error ! error code
614 
615  integer :: nid
616  real(RP) :: weight
617  logical :: do_readfile
618 
619  integer :: dim1_max, dim1_S, dim1_E, n1, nn1
620  integer :: dim2_max, dim2_S, dim2_E, n2, nn2
621  integer :: dim3_max, dim3_S, dim3_E, n3, nn3
622  integer :: n
623  !---------------------------------------------------------------------------
624 
625  error = .true.
626 
627  ! searching the data ID
628  nid = -1
629  do n = 1, extin_item_count
630  if( varname == extin_item(n)%varname ) nid = n
631  enddo
632 
633  if( nid == 0 ) return
634 
635  if ( axistype == 'ZXY' ) then
636  dim1_max = kmax
637  dim2_max = imaxb
638  dim3_max = jmaxb
639  dim1_s = ks
640  dim1_e = ke
641  dim2_s = isb
642  dim2_e = ieb
643  dim3_s = jsb
644  dim3_e = jeb
645  else if ( axistype == 'Land' ) then
646  dim1_max = lkmax
647  dim2_max = imaxb
648  dim3_max = jmaxb
649  dim1_s = lks
650  dim1_e = lke
651  dim2_s = isb
652  dim2_e = ieb
653  dim3_s = jsb
654  dim3_e = jeb
655  else if ( axistype == 'Urban' ) then
656  dim1_max = ukmax
657  dim2_max = imaxb
658  dim3_max = jmaxb
659  dim1_s = uks
660  dim1_e = uke
661  dim2_s = isb
662  dim2_e = ieb
663  dim3_s = jsb
664  dim3_e = jeb
665  else
666  write(*,*) 'xxx unsupported axis type. Check!', trim(axistype), ' item:',trim(varname)
667  call prc_mpistop
668  endif
669 
670  if ( dim1_max /= extin_item(nid)%dim_size(1) &
671  .OR. dim2_max /= extin_item(nid)%dim_size(2) &
672  .OR. dim3_max /= extin_item(nid)%dim_size(3) ) then
673  write(*,*) 'xxx data length does not match! ', trim(axistype), ' item:', trim(varname)
674  write(*,*) 'xxx dim 1 (data,requested) : ', extin_item(nid)%dim_size(1), dim1_max
675  write(*,*) 'xxx dim 2 (data,requested) : ', extin_item(nid)%dim_size(2), dim2_max
676  write(*,*) 'xxx dim 3 (data,requested) : ', extin_item(nid)%dim_size(3), dim3_max
677  call prc_mpistop
678  endif
679 
680  call extin_time_advance( nid, & ! [IN]
681  current_time, & ! [IN]
682  weight, & ! [OUT]
683  do_readfile ) ! [OUT]
684 
685  if ( do_readfile ) then
686  if( io_l ) write(io_fid_log,'(1x,A,A15)') '*** Read 3D var: ', trim(extin_item(nid)%varname)
687  ! next -> prev
688  extin_item(nid)%value(:,:,:,i_prev) = extin_item(nid)%value(:,:,:,i_next)
689 
690  ! read next
691  call fileread( extin_item(nid)%value(:,:,:,i_next), & ! [OUT]
692  extin_item(nid)%basename, & ! [IN]
693  extin_item(nid)%varname, & ! [IN]
694  extin_item(nid)%data_steppos(i_next), & ! [IN]
695  prc_myrank ) ! [IN]
696  endif
697 
698  ! store data with weight
699  do n3 = 1, dim3_max
700  nn3 = n3 + dim3_s - 1
701  do n2 = 1, dim2_max
702  nn2 = n2 + dim2_s - 1
703  do n1 = 1, dim1_max
704  nn1 = n1 + dim1_s - 1
705 
706  var(nn1,nn2,nn3) = ( 1.0_rp-weight ) * extin_item(nid)%value(n1,n2,n3,i_prev) &
707  + ( weight ) * extin_item(nid)%value(n1,n2,n3,i_next)
708  enddo
709  enddo
710  enddo
711 
712  error = .false.
713 
714  return
715  end subroutine extin_update_3d
716 
717  !-----------------------------------------------------------------------------
719  subroutine extin_time_advance( &
720  nid, &
721  current_time, &
722  weight, &
723  do_readfile )
724  use scale_calendar, only: &
725  calendar_adjust_daysec, &
726  calendar_daysec2date, &
727  calendar_date2daysec, &
728  calendar_combine_daysec, &
729  i_year, &
730  i_month, &
731  i_day
732  implicit none
733 
734  integer, intent(in) :: nid ! item id
735  real(DP), intent(in) :: current_time ! current time
736  real(RP), intent(out) :: weight ! weight
737  logical, intent(out) :: do_readfile ! read new data at this time?
738 
739  integer :: datadate(6)
740  real(DP) :: datasubsec
741  integer :: dataday
742  real(DP) :: datasec
743  integer :: offset_year
744 
745  real(DP) :: prev_time, next_time
746  integer :: t
747  !---------------------------------------------------------------------------
748 
749  do_readfile = .false.
750 
751  if ( extin_item(nid)%fixed_step ) then
752  !--- no time-advance
753  else
754  ! time is passed?
755  if ( current_time > extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) ) ) then
756 
757  do_readfile = .true.
758 
759  if( io_l ) write(io_fid_log,*) '*** Update external input : ', trim(extin_item(nid)%varname)
760 
761  ! update step position
762  extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%data_steppos(i_prev) + 1
763  extin_item(nid)%data_steppos(i_next) = extin_item(nid)%data_steppos(i_next) + 1
764 
765  if ( extin_item(nid)%flag_periodic > 0 ) then ! periodic time step mode
766 
767  if ( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
768 
769  ! last+1 = first
770  extin_item(nid)%data_steppos(i_next) = 1
771 
772  ! update data time in periodic condition
773  do t = 1, extin_item(nid)%step_num
774  dataday = 0
775  datasec = extin_item(nid)%time(t)
776  offset_year = 0
777  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
778 
779  call calendar_daysec2date( datadate(:), & ! [OUT]
780  datasubsec, & ! [OUT]
781  dataday, & ! [IN]
782  datasec, & ! [IN]
783  offset_year ) ! [IN]
784 
785  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
786  datadate(i_day) = datadate(i_day) + 1
787  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
788  datadate(i_month) = datadate(i_month) + 1
789  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
790  datadate(i_year) = datadate(i_year) + 1
791  endif
792 
793  call calendar_date2daysec( dataday, & ! [IN]
794  datasec, & ! [IN]
795  datadate(:), & ! [OUT]
796  datasubsec, & ! [OUT]
797  offset_year ) ! [IN]
798 
799  extin_item(nid)%time(t) = calendar_combine_daysec( dataday, datasec )
800  enddo
801  endif
802 
803  else ! normal mode
804 
805  if ( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 ) then
806  write(*,*) 'xxx Current time is out of period of external data! '
807  call prc_mpistop
808  endif
809 
810  endif
811 
812  endif
813 
814  endif
815 
816  ! calc weight
817  if ( extin_item(nid)%fixed_step ) then
818 
819  weight = 0.0_rp
820 
821  elseif( extin_item(nid)%data_steppos(i_next) == 1 ) then
822 
823  dataday = 0
824  datasec = extin_item(nid)%time( extin_item(nid)%data_steppos(i_prev) )
825  offset_year = 0
826  call calendar_adjust_daysec( dataday, datasec ) ! [INOUT]
827 
828  call calendar_daysec2date( datadate(:), & ! [OUT]
829  datasubsec, & ! [OUT]
830  dataday, & ! [IN]
831  datasec, & ! [IN]
832  offset_year ) ! [IN]
833 
834  if ( extin_item(nid)%flag_periodic == i_periodic_day ) then
835  datadate(i_day) = datadate(i_day) - 1
836  elseif( extin_item(nid)%flag_periodic == i_periodic_month ) then
837  datadate(i_month) = datadate(i_month) - 1
838  elseif( extin_item(nid)%flag_periodic == i_periodic_year ) then
839  datadate(i_year) = datadate(i_year) - 1
840  endif
841 
842  call calendar_date2daysec( dataday, & ! [IN]
843  datasec, & ! [IN]
844  datadate(:), & ! [OUT]
845  datasubsec, & ! [OUT]
846  offset_year ) ! [IN]
847 
848  prev_time = calendar_combine_daysec( dataday, datasec )
849 
850  next_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) )
851 
852  weight = ( current_time - prev_time ) &
853  / ( next_time - prev_time )
854 
855  else
856 
857  prev_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_prev) )
858  next_time = extin_item(nid)%time( extin_item(nid)%data_steppos(i_next) )
859 
860  weight = ( current_time - prev_time ) &
861  / ( next_time - prev_time )
862 
863  endif
864 
865  return
866  end subroutine extin_time_advance
867 
868 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_urban_grid_index::uke
integer, public uke
Definition: scale_urban_grid_index.F90:34
scale_calendar::i_year
integer, parameter, public i_year
[index] year
Definition: scale_calendar.F90:45
scale_process::prc_mpistop
subroutine, public prc_mpistop
Abort MPI.
Definition: scale_process.F90:234
scale_calendar::calendar_combine_daysec
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
Definition: scale_calendar.F90:347
scale_grid_index::jeb
integer, public jeb
Definition: scale_grid_index.F90:74
scale_external_input::extin_update_1d
subroutine extin_update_1d(var, varname, axistype, current_time, error)
Read data.
Definition: scale_external_input.F90:406
scale_stdio::io_l
logical, public io_l
output log or not? (this process)
Definition: scale_stdio.F90:59
gtool_file::filegetalldatainfo
subroutine, public filegetalldatainfo(step_limit, dim_limit, basename, varname, myrank, step_nmax, description, units, datatype, dim_rank, dim_name, dim_size, time_start, time_end, time_units, single)
Definition: gtool_file.f90:1514
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_grid_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_grid_index.F90:59
scale_grid_index::imaxb
integer, public imaxb
Definition: scale_grid_index.F90:69
scale_grid_index::jmaxb
integer, public jmaxb
Definition: scale_grid_index.F90:70
scale_const::const_undef
real(rp), public const_undef
Definition: scale_const.F90:43
scale_grid_index::ieb
integer, public ieb
Definition: scale_grid_index.F90:72
scale_grid_index
module grid index
Definition: scale_grid_index.F90:14
scale_calendar::calendar_adjust_daysec
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
Definition: scale_calendar.F90:327
scale_land_grid_index::lks
integer, public lks
Definition: scale_land_grid_index.F90:33
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_time::time_offset_year
integer, public time_offset_year
time offset [year]
Definition: scale_time.F90:73
scale_grid_index::kmax
integer, public kmax
of computational cells: z
Definition: scale_grid_index.F90:43
scale_urban_grid_index::ukmax
integer, public ukmax
Definition: scale_urban_grid_index.F90:31
scale_external_input::extin_update_2d
subroutine extin_update_2d(var, varname, axistype, current_time, error)
Read data.
Definition: scale_external_input.F90:500
scale_time
module TIME
Definition: scale_time.F90:15
scale_process
module PROCESS
Definition: scale_process.F90:14
scale_const
module CONSTANT
Definition: scale_const.F90:14
scale_external_input
module EXTERNAL INPUT
Definition: scale_external_input.F90:11
scale_grid_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_grid_index.F90:58
scale_process::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_process.F90:78
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_urban_grid_index::uks
integer, public uks
Definition: scale_urban_grid_index.F90:33
offset
#define offset(Z, X, Y)
Definition: scale_rdma.c:25
scale_land_grid_index::lke
integer, public lke
Definition: scale_land_grid_index.F90:34
scale_precision
module PRECISION
Definition: scale_precision.F90:13
scale_grid_index::isb
integer, public isb
Definition: scale_grid_index.F90:71
scale_calendar
module CALENDAR
Definition: scale_calendar.F90:15
scale_land_grid_index
module land grid index
Definition: scale_land_grid_index.F90:10
scale_stdio::io_fid_conf
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
scale_external_input::extin_update_3d
subroutine extin_update_3d(var, varname, axistype, current_time, error)
Read data.
Definition: scale_external_input.F90:602
scale_stdio::io_fid_log
integer, public io_fid_log
Log file ID.
Definition: scale_stdio.F90:56
scale_grid_index::jsb
integer, public jsb
Definition: scale_grid_index.F90:73
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_external_input::extin_setup
subroutine, public extin_setup
Setup.
Definition: scale_external_input.F90:88
scale_urban_grid_index
module urban grid index
Definition: scale_urban_grid_index.F90:10
scale_land_grid_index::lkmax
integer, public lkmax
Definition: scale_land_grid_index.F90:31
Generated by   doxygen 1.8.13