SCALE-RM
Data Types | Functions/Subroutines
scale_external_input Module Reference

module EXTERNAL INPUT More...

Functions/Subroutines

subroutine, public extin_setup
 Setup. More...
 
subroutine extin_update_1d (var, varname, axistype, current_time, error)
 Read data. More...
 
subroutine extin_update_2d (var, varname, axistype, current_time, error)
 Read data. More...
 
subroutine extin_update_3d (var, varname, axistype, current_time, error)
 Read data. More...
 

Detailed Description

module EXTERNAL INPUT

Description
External file input module
Author
Team SCALE

Function/Subroutine Documentation

◆ extin_setup()

subroutine, public scale_external_input::extin_setup ( )

Setup.

Definition at line 88 of file scale_external_input.F90.

References scale_calendar::calendar_adjust_daysec(), scale_calendar::calendar_cfunits2sec(), scale_calendar::calendar_combine_daysec(), scale_calendar::calendar_date2daysec(), scale_calendar::calendar_daysec2date(), scale_const::const_undef, gtool_file::filegetalldatainfo(), scale_calendar::i_day, scale_calendar::i_month, scale_calendar::i_year, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_l, scale_process::prc_mpistop(), scale_process::prc_myrank, scale_time::time_nowdaysec, scale_time::time_offset_year, and scale_time::time_startdaysec.

Referenced by mod_rm_driver::scalerm().

88  use gtool_file, only: &
90  fileread
91  use scale_process, only: &
92  prc_myrank, &
94  use scale_const, only: &
95  undef => const_undef
96  use scale_calendar, only: &
102  i_year, &
103  i_month, &
104  i_day
105  use scale_time, only: &
107  time_nowdaysec, &
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
integer, parameter, public i_month
[index] month
module GTOOL_FILE
Definition: gtool_file.f90:17
integer, parameter, public i_year
[index] year
subroutine, public prc_mpistop
Abort MPI.
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
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)
real(dp), public time_nowdaysec
second of current time [sec]
Definition: scale_time.F90:69
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:74
real(rp), public const_undef
Definition: scale_const.F90:43
subroutine, public calendar_adjust_daysec(absday, abssec)
Adjust day and second.
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:73
module TIME
Definition: scale_time.F90:15
module PROCESS
module CONSTANT
Definition: scale_const.F90:14
integer, public prc_myrank
process num in local communicator
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.
#define offset(Z, X, Y)
Definition: scale_rdma.c:25
module CALENDAR
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.
Here is the call graph for this function:
Here is the caller graph for this function:

◆ extin_update_1d()

subroutine scale_external_input::extin_update_1d ( real(rp), dimension(:), intent(out)  var,
character(len=*), intent(in)  varname,
character(len=*), intent(in)  axistype,
real(dp), intent(in)  current_time,
logical, intent(out)  error 
)

Read data.

Definition at line 406 of file scale_external_input.F90.

References scale_grid_index::ieb, scale_grid_index::imaxb, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::isb, scale_grid_index::jeb, scale_grid_index::jmaxb, scale_grid_index::jsb, scale_grid_index::ke, scale_grid_index::kmax, scale_grid_index::ks, scale_process::prc_mpistop(), and scale_process::prc_myrank.

406  use gtool_file, only: &
407  fileread
408  use scale_process, only: &
409  prc_myrank, &
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
module GTOOL_FILE
Definition: gtool_file.f90:17
subroutine, public prc_mpistop
Abort MPI.
integer, public jeb
integer, public ke
end point of inner domain: z, local
integer, public imaxb
integer, public jmaxb
integer, public ieb
integer, public kmax
of computational cells: z
module PROCESS
integer, public ks
start point of inner domain: z, local
integer, public prc_myrank
process num in local communicator
integer, public isb
integer, public jsb
Here is the call graph for this function:

◆ extin_update_2d()

subroutine scale_external_input::extin_update_2d ( real(rp), dimension(:,:), intent(out)  var,
character(len=*), intent(in)  varname,
character(len=*), intent(in)  axistype,
real(dp), intent(in)  current_time,
logical, intent(out)  error 
)

Read data.

Definition at line 500 of file scale_external_input.F90.

References scale_grid_index::ieb, scale_grid_index::imaxb, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::isb, scale_grid_index::jeb, scale_grid_index::jmaxb, scale_grid_index::jsb, scale_grid_index::ke, scale_grid_index::kmax, scale_grid_index::ks, scale_process::prc_mpistop(), and scale_process::prc_myrank.

500  use gtool_file, only: &
501  fileread
502  use scale_process, only: &
503  prc_myrank, &
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
module GTOOL_FILE
Definition: gtool_file.f90:17
subroutine, public prc_mpistop
Abort MPI.
integer, public jeb
integer, public ke
end point of inner domain: z, local
integer, public imaxb
integer, public jmaxb
integer, public ieb
integer, public kmax
of computational cells: z
module PROCESS
integer, public ks
start point of inner domain: z, local
integer, public prc_myrank
process num in local communicator
integer, public isb
integer, public jsb
Here is the call graph for this function:

◆ extin_update_3d()

subroutine scale_external_input::extin_update_3d ( real(rp), dimension(:,:,:), intent(out)  var,
character(len=*), intent(in)  varname,
character(len=*), intent(in)  axistype,
real(dp), intent(in)  current_time,
logical, intent(out)  error 
)

Read data.

Definition at line 602 of file scale_external_input.F90.

References scale_calendar::calendar_adjust_daysec(), scale_calendar::calendar_combine_daysec(), scale_calendar::calendar_date2daysec(), scale_calendar::calendar_daysec2date(), scale_calendar::i_day, scale_calendar::i_month, scale_calendar::i_year, scale_grid_index::ieb, scale_grid_index::imaxb, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::isb, scale_grid_index::jeb, scale_grid_index::jmaxb, scale_grid_index::jsb, scale_grid_index::ke, scale_grid_index::kmax, scale_grid_index::ks, scale_land_grid_index::lke, scale_land_grid_index::lkmax, scale_land_grid_index::lks, scale_process::prc_mpistop(), scale_process::prc_myrank, scale_urban_grid_index::uke, scale_urban_grid_index::ukmax, and scale_urban_grid_index::uks.

602  use gtool_file, only: &
603  fileread
604  use scale_process, only: &
605  prc_myrank, &
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
module GTOOL_FILE
Definition: gtool_file.f90:17
subroutine, public prc_mpistop
Abort MPI.
integer, public jeb
integer, public ke
end point of inner domain: z, local
integer, public imaxb
integer, public jmaxb
integer, public ieb
integer, public kmax
of computational cells: z
module PROCESS
integer, public ks
start point of inner domain: z, local
integer, public prc_myrank
process num in local communicator
integer, public isb
integer, public jsb
Here is the call graph for this function: