Regist data.
279 filegetalldatainfo, &
285 fileio_check_coordinates
301 character(len=*) ,
intent(in) :: basename
302 character(len=*) ,
intent(in) :: varname
303 character(len=*) ,
intent(in) :: axistype
304 integer ,
intent(in) :: step_fixed
305 logical ,
intent(in) :: enable_periodic_year
306 logical ,
intent(in) :: enable_periodic_month
307 logical ,
intent(in) :: enable_periodic_day
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
312 logical,
optional,
intent(out) :: exist
315 character(len=H_LONG) :: description
316 character(len=H_SHORT) :: unit
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
325 integer :: datadate(6)
326 real(DP) :: datasubsec
329 integer :: offset_year
331 integer :: dim1_max, dim1_S, dim1_E
332 integer :: dim2_max, dim2_S, dim2_E
333 integer :: dim3_max, dim3_S, dim3_E
335 integer :: step_limit_
341 if (
present(step_limit) )
then 342 if ( step_limit > 0 )
then 343 step_limit_ = step_limit
345 step_limit_ = extin_step_limit
348 step_limit_ = extin_step_limit
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)
358 extin_item_count = extin_item_count + 1
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
368 call filegetalldatainfo( step_limit_, &
379 time_start(1:step_limit_), &
380 time_end(1:step_limit_), &
383 if ( step_nmax == 0 )
then 384 if (
present(exist) )
then 388 write(*,*)
'xxx Data not found! basename,varname = ', trim(basename),
', ', trim(varname)
392 if (
present(exist) ) exist = .true.
398 nid = extin_item_count
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
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
413 extin_item(nid)%flag_periodic = 0
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
420 allocate( extin_item(nid)%time(step_nmax) )
421 extin_item(nid)%time(:) = 0.0_dp
423 do n = 1, extin_item(nid)%step_num
427 if ( extin_item(nid)%step_num == 1 )
then 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
433 else if ( step_fixed > 0 )
then 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
441 extin_item(nid)%fixed_step = .false.
444 extin_item(nid)%data_steppos(i_next) = 1
445 do n = 1, extin_item(nid)%step_num
447 extin_item(nid)%data_steppos(i_next) = n + 1
450 extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%data_steppos(i_next) - 1
452 if ( extin_item(nid)%flag_periodic > 0 )
then 454 if ( extin_item(nid)%data_steppos(i_next) == 1 )
then 457 extin_item(nid)%data_steppos(i_prev) = extin_item(nid)%step_num
459 elseif( extin_item(nid)%data_steppos(i_next) == extin_item(nid)%step_num+1 )
then 462 extin_item(nid)%data_steppos(i_next) = 1
465 do n = 1, extin_item(nid)%step_num
467 datasec = extin_item(nid)%time(n)
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
494 if( io_l )
write(io_fid_log,*)
'*** data time is updated.' 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)
510 if( io_l )
write(io_fid_log,
'(1x,A,A15)')
'*** Initial read of external data : ', trim(varname)
512 if ( dim_size(1) >= 1 &
513 .AND. dim_size(2) == 1 &
514 .AND. dim_size(3) == 1 )
then 516 call extin_get_dims_1d( &
517 dim1_max, dim1_s, dim1_e, &
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
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
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) )
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) )
548 elseif ( dim_size(1) >= 1 &
549 .AND. dim_size(2) > 1 &
550 .AND. dim_size(3) == 1 )
then 552 call extin_get_dims_2d( &
553 dim1_max, dim1_s, dim1_e, &
554 dim2_max, dim2_s, dim2_e, &
555 extin_item(nid)%transpose, &
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
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
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) )
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) )
588 elseif ( dim_size(1) >= 1 &
589 .AND. dim_size(2) > 1 &
590 .AND. dim_size(3) > 1 )
then 592 call extin_get_dims_3d( &
593 dim1_max, dim1_s, dim1_e, &
594 dim2_max, dim2_s, dim2_e, &
595 dim3_max, dim3_s, dim3_e, &
596 extin_item(nid)%transpose, &
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
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
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) )
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) )
634 write(*,*)
'xxx Unexpected dimsize: ', dim_size(:)
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 )
subroutine, public prc_mpistop
Abort MPI.
real(dp) function, public calendar_combine_daysec(absday, abssec)
Combine day and second.
real(dp), public time_nowdaysec
second of current time [sec]
real(dp), public time_startdaysec
second of start time [sec]
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]
integer, public prc_myrank
process num in local communicator
subroutine, public calendar_daysec2date(ymdhms, subsec, absday, abssec, offset_year)
Convert from gregorian date to absolute day/second.
subroutine, public calendar_date2daysec(absday, abssec, ymdhms, subsec, offset_year)
Convert from gregorian date to absolute day/second.