38 & varname, array, arraysize, history, range, &
39 & time, quiet, difftime, timed, time_average_store, err )
66 character(*),
intent(in):: varname
67 integer,
intent(in):: arraysize
68 real,
intent(in):: array(arraysize)
69 type(
gt_history),
intent(inout),
target,
optional:: history
70 character(*),
intent(in),
optional:: range
86 real,
intent(in),
optional:: time
108 logical,
intent(in),
optional:: quiet
125 real(
dp),
intent(in),
optional:: timed
131 logical,
intent(in),
optional:: time_average_store
148 logical,
intent(out),
optional:: err
163 character(STRING):: url, file, time_str
164 real:: time_value(1:1)
167 character(STRING):: avr_msg
168 real,
target:: array_work(arraysize)
169 real,
pointer:: array_work2(:) =>null()
170 integer:: arraysize_work2
171 integer,
allocatable:: start(:), count(:), stride(:)
174 character(STRING):: time_name
175 character(*),
parameter:: bnds_suffix =
'_bnds'
177 integer:: bnds_ord, time_count, bnds_rank
178 logical:: output_step
182 integer,
allocatable:: array_overwrap(:)
184 integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
185 character(STRING):: dimname
186 integer:: st_mpi(mpi_status_size)
187 real,
allocatable:: array_mpi_tmp(:)
188 real,
allocatable:: array_mpi_all(:,:)
191 character(STRING):: cause_c
193 subroutine timegoahead( varname, var, head, history, err )
196 character(len = *),
intent(in):: varname
198 real,
intent(in):: head
199 type(
gt_history),
intent(inout),
optional,
target:: history
200 logical,
intent(out),
optional:: err
203 character(*),
parameter:: subname =
"HistoryPutRealEx"
205 call beginsub(subname,
'varname=%a range=%a', &
209 if (
present(history))
then
218 if ( .not. hst % initialized )
then
220 cause_c =
'GT_HISTORY'
227 if ( (
present(time) .or.
present(difftime) .or.
present(timed) ) &
230 &
'(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
231 & c1 = trim(varname) )
233 cause_c =
'"range" and "time" or "timed" or "difftime" are not suppored at the same time'
240 if ( .not. hst % mpi_gather )
then
243 if ( hst % mpi_myrank == 0 )
then
246 call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
247 call dbgmessage(
'v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
254 if (
present(difftime) )
then
255 timedw =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
256 elseif (
present(timed) )
then
258 elseif (
present(time) )
then
261 if ( v_ord > 0 )
then
268 if ( hst % var_avr_count( v_ord ) > -1 )
then
273 if ( .not.
present(time) &
274 & .and. .not.
present(timed) &
275 & .and. .not.
present(difftime) )
then
277 &
'(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
278 &
'when "time_average=.true." is specified to "HistoryAddVariable"', &
279 & c1 = trim(varname) )
291 if ( arraysize /= hst % var_avr_data( v_ord ) % length )
then
293 &
'(varname=%c) size of array should be (%d). size of array is (%d)', &
294 & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
295 & c1 = trim(varname) )
311 if ( hst % var_avr_firstput( v_ord ) )
then
312 if ( hst % var_avr_count( v_ord ) == 0 )
then
314 hst % var_avr_prevtime( v_ord ) = timedw
316 hst % var_avr_baseint( v_ord ) = &
317 & timedw - hst % var_avr_prevtime( v_ord )
319 hst % var_avr_prevtime( v_ord ) = timedw
320 hst % var_avr_firstput( v_ord ) = .false.
330 if ( hst % var_avr_count( v_ord ) == 0 )
then
331 hst % var_avr_baseint( v_ord ) = &
332 & timedw - hst % var_avr_prevtime( v_ord )
334 hst % var_avr_prevtime( v_ord ) = timedw
341 avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
342 & / hst % var_avr_baseint( v_ord )
343 hst % var_avr_prevtime( v_ord ) = timedw
349 hst % var_avr_data( v_ord ) % a_DataAvr = &
350 & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
355 hst % var_avr_count( v_ord ) = &
356 & hst % var_avr_count( v_ord ) + 1
357 hst % var_avr_coefsum( v_ord ) = &
358 & hst % var_avr_coefsum( v_ord ) + avr_coef
362 if (
present(difftime) )
then
363 hst % time_bnds(2:2) =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
364 elseif (
present (timed) )
then
365 hst % time_bnds(2:2) = timed
367 hst % time_bnds(2:2) = time
375 if ( .not. hst % origin_setting )
then
376 if (
present(difftime) )
then
377 hst % origin =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
378 hst % time_bnds =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
379 hst % origin_setting = .true.
380 elseif (
present(timed) )
then
382 hst % time_bnds = timed
383 hst % origin_setting = .true.
384 elseif (
present(time) )
then
386 hst % time_bnds = time
387 hst % origin_setting = .true.
413 output_step = .false.
414 elseif (
present(difftime) .or.
present(timed) .or.
present(time) )
then
415 output_step = .false.
416 if ( abs( hst % interval ) <
dp_eps )
then
419 if ( abs(
mod( timedw - hst % origin, hst % interval ) ) <
dp_eps )
then
427 if ( .not. output_step )
then
432 if ( v_ord > 0 )
then
433 if ( hst % var_avr_count( v_ord ) > -1 )
then
435 avr_msg =
'(time average of ' // trim(
tochar(hst % var_avr_count( v_ord )) ) //
' step data)'
444 & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
445 & kind = kind(array_work) )
448 hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
449 hst % var_avr_count( v_ord ) = 0
450 hst % var_avr_coefsum( v_ord ) = 0.0_dp
451 hst % var_avr_firstput( v_ord ) = .false.
455 if ( .not. hst % mpi_gather )
then
456 array_work2 => array_work
457 arraysize_work2 = arraysize
463 numdims =
size( hst % mpi_fileinfo % axes )
464 if ( hst % mpi_myrank == 0 )
then
468 & hst % mpi_fileinfo % axes(i), &
470 if ( trim(varname) == trim(dimname) )
then
475 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
477 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
479 if ( dimord > 0 )
then
481 & hst % mpi_fileinfo % axes(dimord), &
482 &
size = dimsize_max )
483 dimsize =
size( array )
484 if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord )
then
486 &
'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' // &
487 &
'the data will be trancated. ', &
488 & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
489 dimsize = dimsize_max
491 if (
associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) )
then
492 deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
494 allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
495 hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
496 hst % mpi_dimdata_each( dimord ) % length = dimsize
503 if ( v_ord > 0 )
then
504 if ( .not.
associated( hst % mpi_gthr_info ) )
then
508 if ( .not.
associated( hst % mpi_vars_index( v_ord ) % allcount ) )
then
517 if ( v_ord > 0 )
then
518 arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
519 if ( arraysize_work2 < 1 ) arraysize_work2 = 1
520 if ( hst % mpi_myrank == 0 )
then
521 do ra = 1, hst % mpi_nprocs - 1
522 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
523 call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
526 call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
528 if ( hst % mpi_myrank /= 0 )
then
529 call mpi_send( array_work, allcount, &
530 & mpi_real, 0, 0, mpi_comm_world, err_mpi )
532 allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
533 allocate( array_mpi_tmp( arraysize_work2 ) )
534 array_mpi_all(:,:) = 0.0
535 array_mpi_tmp(:) = 0.0
536 allcount = hst % mpi_vars_index(v_ord) % allcount(0)
537 array_mpi_all(0,1:allcount) = array_work
538 do ra = 1, hst % mpi_nprocs - 1
539 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
540 call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
541 & mpi_real, ra, 0, mpi_comm_world, st_mpi, err_mpi )
542 array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
544 allocate( array_work2( arraysize_work2 ) )
545 allocate( array_overwrap( arraysize_work2 ) )
547 array_overwrap(:) = 0
548 do ra = 0, hst % mpi_nprocs - 1
549 do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
550 new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
551 array_work2( new_index ) = &
552 & array_work2( new_index ) + array_mpi_all( ra, i )
553 array_overwrap( new_index ) = array_overwrap( new_index ) + 1
556 where ( array_overwrap == 0 )
559 array_work2(:) = array_work2(:) / array_overwrap(:)
560 deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
564 array_work2 => array_work
565 arraysize_work2 = arraysize
572 if ( .not. hst % mpi_gather &
573 & .or. ( hst % mpi_gather .and. &
574 & hst % mpi_myrank == 0 .and. &
575 & hst % mpi_fileinfo % already_output) )
then
577 & varname = varname, &
578 & head = real(array_work2(1)), &
580 & history = history, &
585 call dbgmessage(
'varname=<%c> has no dimension. so range is ignoread.', &
590 call put(var, array_work2, arraysize_work2)
595 allocate(start(dims), count(dims), stride(dims))
597 call get_slice(var, i, start(i), count(i), stride(i))
600 call slice(var, range, slice_err)
601 call put(var, array_work2, arraysize_work2)
604 call slice(var, i, start(i), count(i), stride(i))
606 deallocate(start, count, stride)
609 if ( hst % mpi_gather .and. v_ord > 0 )
then
610 deallocate( array_work2 )
617 if ( .not. hst % mpi_gather &
618 & .or. ( hst % mpi_gather .and. &
619 & hst % mpi_myrank == 0 .and. &
620 & hst % mpi_fileinfo % already_output ) )
then
621 if ( v_ord > 0 )
then
622 if ( hst % var_avr_count( v_ord ) > -1 )
then
626 timevar = hst % dimvars( hst % unlimited_index )
636 call open( var = bndsvar, &
637 & url =
urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
646 if ( bnds_rank > 1 )
then
649 & dimord = hst % growable_indices(bnds_ord), &
650 & allcount = time_count )
652 if ( (hst % time_bnds_output_count < 1) &
653 & .or. (hst % time_bnds_output_count < time_count) )
then
654 call slice(bndsvar, hst % growable_indices(bnds_ord), &
655 & start=hst % time_bnds_output_count+1, count=1)
656 call put(bndsvar, hst % time_bnds, 2)
657 hst % time_bnds_output_count = hst % time_bnds_output_count + 1
659 call close( var = bndsvar )
660 if (
present(difftime) )
then
661 hst % time_bnds(1:1) = &
662 &
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
663 elseif (
present(timed) )
then
664 hst % time_bnds(1:1) = timed
666 hst % time_bnds(1:1) = time
675 if ( .not. hst % mpi_gather &
676 & .or. ( hst % mpi_gather .and. &
677 & hst % mpi_myrank == 0 .and. &
678 & hst % mpi_fileinfo % already_output ) )
then
680 call inquire( hst % dimvars(1), &
684 if ( hst % unlimited_index < 1 )
then
687 timevar = hst % dimvars(hst % unlimited_index)
688 call slice( timevar, &
689 & 1, start = hst % count(v_ord), count = 1 )
694 time_str =
'(time=' // trim(
tochar( time_value(1) )) //
')'
697 &
'"%a" => "%a" %a %a', &
698 & ca =
stoa( varname, file, time_str, avr_msg ) )
706 call storeerror( stat, subname, err, cause_c )
710 & varname, array, arraysize, history, range, &
711 & time, quiet, difftime, timed, time_average_store, err )
738 character(*),
intent(in):: varname
739 integer,
intent(in):: arraysize
740 real(
dp),
intent(in):: array(arraysize)
741 type(
gt_history),
intent(inout),
target,
optional:: history
742 character(*),
intent(in),
optional:: range
758 real,
intent(in),
optional:: time
780 logical,
intent(in),
optional:: quiet
797 real(
dp),
intent(in),
optional:: timed
803 logical,
intent(in),
optional:: time_average_store
820 logical,
intent(out),
optional:: err
835 character(STRING):: url, file, time_str
836 real:: time_value(1:1)
839 character(STRING):: avr_msg
840 real(
dp),
target:: array_work(arraysize)
841 real(
dp),
pointer:: array_work2(:) =>null()
842 integer:: arraysize_work2
843 integer,
allocatable:: start(:), count(:), stride(:)
846 character(STRING):: time_name
847 character(*),
parameter:: bnds_suffix =
'_bnds'
849 integer:: bnds_ord, time_count, bnds_rank
850 logical:: output_step
854 integer,
allocatable:: array_overwrap(:)
856 integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
857 character(STRING):: dimname
858 integer:: st_mpi(mpi_status_size)
859 real(
dp),
allocatable:: array_mpi_tmp(:)
860 real(
dp),
allocatable:: array_mpi_all(:,:)
863 character(STRING):: cause_c
865 subroutine timegoahead( varname, var, head, history, err )
868 character(len = *),
intent(in):: varname
870 real,
intent(in):: head
871 type(
gt_history),
intent(inout),
optional,
target:: history
872 logical,
intent(out),
optional:: err
875 character(*),
parameter:: subname =
"HistoryPutDoubleEx"
877 call beginsub(subname,
'varname=%a range=%a', &
881 if (
present(history))
then
890 if ( .not. hst % initialized )
then
892 cause_c =
'GT_HISTORY'
899 if ( (
present(time) .or.
present(difftime) .or.
present(timed) ) &
902 &
'(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
903 & c1 = trim(varname) )
905 cause_c =
'"range" and "time" or "timed" or "difftime" are not suppored at the same time'
912 if ( .not. hst % mpi_gather )
then
915 if ( hst % mpi_myrank == 0 )
then
918 call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
919 call dbgmessage(
'v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
926 if (
present(difftime) )
then
927 timedw =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
928 elseif (
present(timed) )
then
930 elseif (
present(time) )
then
933 if ( v_ord > 0 )
then
940 if ( hst % var_avr_count( v_ord ) > -1 )
then
945 if ( .not.
present(time) &
946 & .and. .not.
present(timed) &
947 & .and. .not.
present(difftime) )
then
949 &
'(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
950 &
'when "time_average=.true." is specified to "HistoryAddVariable"', &
951 & c1 = trim(varname) )
963 if ( arraysize /= hst % var_avr_data( v_ord ) % length )
then
965 &
'(varname=%c) size of array should be (%d). size of array is (%d)', &
966 & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
967 & c1 = trim(varname) )
983 if ( hst % var_avr_firstput( v_ord ) )
then
984 if ( hst % var_avr_count( v_ord ) == 0 )
then
986 hst % var_avr_prevtime( v_ord ) = timedw
988 hst % var_avr_baseint( v_ord ) = &
989 & timedw - hst % var_avr_prevtime( v_ord )
991 hst % var_avr_prevtime( v_ord ) = timedw
992 hst % var_avr_firstput( v_ord ) = .false.
1002 if ( hst % var_avr_count( v_ord ) == 0 )
then
1003 hst % var_avr_baseint( v_ord ) = &
1004 & timedw - hst % var_avr_prevtime( v_ord )
1006 hst % var_avr_prevtime( v_ord ) = timedw
1013 avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
1014 & / hst % var_avr_baseint( v_ord )
1015 hst % var_avr_prevtime( v_ord ) = timedw
1021 hst % var_avr_data( v_ord ) % a_DataAvr = &
1022 & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
1027 hst % var_avr_count( v_ord ) = &
1028 & hst % var_avr_count( v_ord ) + 1
1029 hst % var_avr_coefsum( v_ord ) = &
1030 & hst % var_avr_coefsum( v_ord ) + avr_coef
1034 if (
present(difftime) )
then
1035 hst % time_bnds(2:2) =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1036 elseif (
present (timed) )
then
1037 hst % time_bnds(2:2) = timed
1039 hst % time_bnds(2:2) = time
1047 if ( .not. hst % origin_setting )
then
1048 if (
present(difftime) )
then
1049 hst % origin =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1050 hst % time_bnds =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1051 hst % origin_setting = .true.
1052 elseif (
present(timed) )
then
1053 hst % origin = timed
1054 hst % time_bnds = timed
1055 hst % origin_setting = .true.
1056 elseif (
present(time) )
then
1058 hst % time_bnds = time
1059 hst % origin_setting = .true.
1081 output_step = .true.
1083 output_step = .true.
1085 output_step = .false.
1086 elseif (
present(difftime) .or.
present(timed) .or.
present(time) )
then
1087 output_step = .false.
1088 if ( abs( hst % interval ) <
dp_eps )
then
1089 output_step = .true.
1091 if ( abs(
mod( timedw - hst % origin, hst % interval ) ) <
dp_eps )
then
1092 output_step = .true.
1099 if ( .not. output_step )
then
1104 if ( v_ord > 0 )
then
1105 if ( hst % var_avr_count( v_ord ) > -1 )
then
1107 avr_msg =
'(time average of ' // trim(
tochar(hst % var_avr_count( v_ord )) ) //
' step data)'
1115 array_work = real( &
1116 & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
1117 & kind = kind(array_work) )
1120 hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
1121 hst % var_avr_count( v_ord ) = 0
1122 hst % var_avr_coefsum( v_ord ) = 0.0_dp
1123 hst % var_avr_firstput( v_ord ) = .false.
1127 if ( .not. hst % mpi_gather )
then
1128 array_work2 => array_work
1129 arraysize_work2 = arraysize
1135 numdims =
size( hst % mpi_fileinfo % axes )
1136 if ( hst % mpi_myrank == 0 )
then
1140 & hst % mpi_fileinfo % axes(i), &
1142 if ( trim(varname) == trim(dimname) )
then
1147 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
1149 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
1151 if ( dimord > 0 )
then
1153 & hst % mpi_fileinfo % axes(dimord), &
1154 &
size = dimsize_max )
1155 dimsize =
size( array )
1156 if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord )
then
1158 &
'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' // &
1159 &
'the data will be trancated. ', &
1160 & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
1161 dimsize = dimsize_max
1163 if (
associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) )
then
1164 deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
1166 allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
1167 hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
1168 hst % mpi_dimdata_each( dimord ) % length = dimsize
1175 if ( v_ord > 0 )
then
1176 if ( .not.
associated( hst % mpi_gthr_info ) )
then
1180 if ( .not.
associated( hst % mpi_vars_index( v_ord ) % allcount ) )
then
1189 if ( v_ord > 0 )
then
1190 arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
1191 if ( arraysize_work2 < 1 ) arraysize_work2 = 1
1192 if ( hst % mpi_myrank == 0 )
then
1193 do ra = 1, hst % mpi_nprocs - 1
1194 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
1195 call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
1198 call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
1200 if ( hst % mpi_myrank /= 0 )
then
1201 call mpi_send( array_work, allcount, &
1202 & mpi_double_precision, 0, 0, mpi_comm_world, err_mpi )
1204 allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
1205 allocate( array_mpi_tmp( arraysize_work2 ) )
1206 array_mpi_all(:,:) = 0.0_dp
1207 array_mpi_tmp(:) = 0.0_dp
1208 allcount = hst % mpi_vars_index(v_ord) % allcount(0)
1209 array_mpi_all(0,1:allcount) = array_work
1210 do ra = 1, hst % mpi_nprocs - 1
1211 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
1212 call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
1213 & mpi_double_precision, ra, 0, mpi_comm_world, st_mpi, err_mpi )
1214 array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
1216 allocate( array_work2( arraysize_work2 ) )
1217 allocate( array_overwrap( arraysize_work2 ) )
1218 array_work2 = 0.0_dp
1219 array_overwrap(:) = 0
1220 do ra = 0, hst % mpi_nprocs - 1
1221 do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
1222 new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
1223 array_work2( new_index ) = &
1224 & array_work2( new_index ) + array_mpi_all( ra, i )
1225 array_overwrap( new_index ) = array_overwrap( new_index ) + 1
1228 where ( array_overwrap == 0 )
1231 array_work2(:) = array_work2(:) / array_overwrap(:)
1232 deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
1236 array_work2 => array_work
1237 arraysize_work2 = arraysize
1244 if ( .not. hst % mpi_gather &
1245 & .or. ( hst % mpi_gather .and. &
1246 & hst % mpi_myrank == 0 .and. &
1247 & hst % mpi_fileinfo % already_output) )
then
1249 & varname = varname, &
1250 & head = real(array_work2(1)), &
1252 & history = history, &
1257 call dbgmessage(
'varname=<%c> has no dimension. so range is ignoread.', &
1262 call put(var, array_work2, arraysize_work2)
1267 allocate(start(dims), count(dims), stride(dims))
1269 call get_slice(var, i, start(i), count(i), stride(i))
1272 call slice(var, range, slice_err)
1273 call put(var, array_work2, arraysize_work2)
1276 call slice(var, i, start(i), count(i), stride(i))
1278 deallocate(start, count, stride)
1281 if ( hst % mpi_gather .and. v_ord > 0 )
then
1282 deallocate( array_work2 )
1289 if ( .not. hst % mpi_gather &
1290 & .or. ( hst % mpi_gather .and. &
1291 & hst % mpi_myrank == 0 .and. &
1292 & hst % mpi_fileinfo % already_output ) )
then
1293 if ( v_ord > 0 )
then
1294 if ( hst % var_avr_count( v_ord ) > -1 )
then
1298 timevar = hst % dimvars( hst % unlimited_index )
1302 & name = time_name )
1308 call open( var = bndsvar, &
1309 & url =
urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
1316 & rank = bnds_rank )
1318 if ( bnds_rank > 1 )
then
1321 & dimord = hst % growable_indices(bnds_ord), &
1322 & allcount = time_count )
1324 if ( (hst % time_bnds_output_count < 1) &
1325 & .or. (hst % time_bnds_output_count < time_count) )
then
1326 call slice(bndsvar, hst % growable_indices(bnds_ord), &
1327 & start=hst % time_bnds_output_count+1, count=1)
1328 call put(bndsvar, hst % time_bnds, 2)
1329 hst % time_bnds_output_count = hst % time_bnds_output_count + 1
1331 call close( var = bndsvar )
1332 if (
present(difftime) )
then
1333 hst % time_bnds(1:1) = &
1334 &
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1335 elseif (
present(timed) )
then
1336 hst % time_bnds(1:1) = timed
1338 hst % time_bnds(1:1) = time
1347 if ( .not. hst % mpi_gather &
1348 & .or. ( hst % mpi_gather .and. &
1349 & hst % mpi_myrank == 0 .and. &
1350 & hst % mpi_fileinfo % already_output ) )
then
1352 call inquire( hst % dimvars(1), &
1356 if ( hst % unlimited_index < 1 )
then
1359 timevar = hst % dimvars(hst % unlimited_index)
1360 call slice( timevar, &
1361 & 1, start = hst % count(v_ord), count = 1 )
1362 call get( timevar, &
1366 time_str =
'(time=' // trim(
tochar( time_value(1) )) //
')'
1369 &
'"%a" => "%a" %a %a', &
1370 & ca =
stoa( varname, file, time_str, avr_msg ) )
1378 call storeerror( stat, subname, err, cause_c )
1382 & varname, array, arraysize, history, range, &
1383 & time, quiet, difftime, timed, time_average_store, err )
1410 character(*),
intent(in):: varname
1411 integer,
intent(in):: arraysize
1412 integer,
intent(in):: array(arraysize)
1413 type(
gt_history),
intent(inout),
target,
optional:: history
1414 character(*),
intent(in),
optional:: range
1430 real,
intent(in),
optional:: time
1452 logical,
intent(in),
optional:: quiet
1463 type(
dc_difftime),
intent(in),
optional:: difftime
1469 real(
dp),
intent(in),
optional:: timed
1475 logical,
intent(in),
optional:: time_average_store
1492 logical,
intent(out),
optional:: err
1507 character(STRING):: url, file, time_str
1508 real:: time_value(1:1)
1511 character(STRING):: avr_msg
1512 integer,
target:: array_work(arraysize)
1513 integer,
pointer:: array_work2(:) =>null()
1514 integer:: arraysize_work2
1515 integer,
allocatable:: start(:), count(:), stride(:)
1517 logical :: slice_err
1518 character(STRING):: time_name
1519 character(*),
parameter:: bnds_suffix =
'_bnds'
1521 integer:: bnds_ord, time_count, bnds_rank
1522 logical:: output_step
1526 integer,
allocatable:: array_overwrap(:)
1528 integer:: numdims, dimord, dimsize, dimsize_max, allcount, ra
1529 character(STRING):: dimname
1530 integer:: st_mpi(mpi_status_size)
1531 integer,
allocatable:: array_mpi_tmp(:)
1532 integer,
allocatable:: array_mpi_all(:,:)
1535 character(STRING):: cause_c
1537 subroutine timegoahead( varname, var, head, history, err )
1540 character(len = *),
intent(in):: varname
1542 real,
intent(in):: head
1543 type(
gt_history),
intent(inout),
optional,
target:: history
1544 logical,
intent(out),
optional:: err
1547 character(*),
parameter:: subname =
"HistoryPutIntEx"
1549 call beginsub(subname,
'varname=%a range=%a', &
1553 if (
present(history))
then
1562 if ( .not. hst % initialized )
then
1564 cause_c =
'GT_HISTORY'
1571 if ( (
present(time) .or.
present(difftime) .or.
present(timed) ) &
1574 &
'(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
1575 & c1 = trim(varname) )
1577 cause_c =
'"range" and "time" or "timed" or "difftime" are not suppored at the same time'
1584 if ( .not. hst % mpi_gather )
then
1587 if ( hst % mpi_myrank == 0 )
then
1590 call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
1591 call dbgmessage(
'v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
1598 if (
present(difftime) )
then
1599 timedw =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1600 elseif (
present(timed) )
then
1602 elseif (
present(time) )
then
1605 if ( v_ord > 0 )
then
1612 if ( hst % var_avr_count( v_ord ) > -1 )
then
1617 if ( .not.
present(time) &
1618 & .and. .not.
present(timed) &
1619 & .and. .not.
present(difftime) )
then
1621 &
'(varname=%c) arguments "time" or "timed" or "difftime" are needed ' // &
1622 &
'when "time_average=.true." is specified to "HistoryAddVariable"', &
1623 & c1 = trim(varname) )
1635 if ( arraysize /= hst % var_avr_data( v_ord ) % length )
then
1637 &
'(varname=%c) size of array should be (%d). size of array is (%d)', &
1638 & i = (/hst % var_avr_data( v_ord ) % length, arraysize/), &
1639 & c1 = trim(varname) )
1655 if ( hst % var_avr_firstput( v_ord ) )
then
1656 if ( hst % var_avr_count( v_ord ) == 0 )
then
1658 hst % var_avr_prevtime( v_ord ) = timedw
1660 hst % var_avr_baseint( v_ord ) = &
1661 & timedw - hst % var_avr_prevtime( v_ord )
1663 hst % var_avr_prevtime( v_ord ) = timedw
1664 hst % var_avr_firstput( v_ord ) = .false.
1674 if ( hst % var_avr_count( v_ord ) == 0 )
then
1675 hst % var_avr_baseint( v_ord ) = &
1676 & timedw - hst % var_avr_prevtime( v_ord )
1678 hst % var_avr_prevtime( v_ord ) = timedw
1685 avr_coef = ( timedw - hst % var_avr_prevtime( v_ord ) ) &
1686 & / hst % var_avr_baseint( v_ord )
1687 hst % var_avr_prevtime( v_ord ) = timedw
1693 hst % var_avr_data( v_ord ) % a_DataAvr = &
1694 & hst % var_avr_data( v_ord ) % a_DataAvr + array * avr_coef
1699 hst % var_avr_count( v_ord ) = &
1700 & hst % var_avr_count( v_ord ) + 1
1701 hst % var_avr_coefsum( v_ord ) = &
1702 & hst % var_avr_coefsum( v_ord ) + avr_coef
1706 if (
present(difftime) )
then
1707 hst % time_bnds(2:2) =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1708 elseif (
present (timed) )
then
1709 hst % time_bnds(2:2) = timed
1711 hst % time_bnds(2:2) = time
1719 if ( .not. hst % origin_setting )
then
1720 if (
present(difftime) )
then
1721 hst % origin =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1722 hst % time_bnds =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
1723 hst % origin_setting = .true.
1724 elseif (
present(timed) )
then
1725 hst % origin = timed
1726 hst % time_bnds = timed
1727 hst % origin_setting = .true.
1728 elseif (
present(time) )
then
1730 hst % time_bnds = time
1731 hst % origin_setting = .true.
1753 output_step = .true.
1755 output_step = .true.
1757 output_step = .false.
1758 elseif (
present(difftime) .or.
present(timed) .or.
present(time) )
then
1759 output_step = .false.
1760 if ( abs( hst % interval ) <
dp_eps )
then
1761 output_step = .true.
1763 if ( abs(
mod( timedw - hst % origin, hst % interval ) ) <
dp_eps )
then
1764 output_step = .true.
1771 if ( .not. output_step )
then
1776 if ( v_ord > 0 )
then
1777 if ( hst % var_avr_count( v_ord ) > -1 )
then
1779 avr_msg =
'(time average of ' // trim(
tochar(hst % var_avr_count( v_ord )) ) //
' step data)'
1788 & ( hst % var_avr_data( v_ord ) % a_DataAvr ) / ( hst % var_avr_coefsum( v_ord ) ), &
1789 & kind = kind(array_work) )
1792 hst % var_avr_data( v_ord ) % a_DataAvr = 0.0
1793 hst % var_avr_count( v_ord ) = 0
1794 hst % var_avr_coefsum( v_ord ) = 0.0_dp
1795 hst % var_avr_firstput( v_ord ) = .false.
1799 if ( .not. hst % mpi_gather )
then
1800 array_work2 => array_work
1801 arraysize_work2 = arraysize
1807 numdims =
size( hst % mpi_fileinfo % axes )
1808 if ( hst % mpi_myrank == 0 )
then
1812 & hst % mpi_fileinfo % axes(i), &
1814 if ( trim(varname) == trim(dimname) )
then
1819 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
1821 call mpi_bcast( dimord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
1823 if ( dimord > 0 )
then
1825 & hst % mpi_fileinfo % axes(dimord), &
1826 &
size = dimsize_max )
1827 dimsize =
size( array )
1828 if ( dimsize > dimsize_max .and. hst % unlimited_index /= dimord )
then
1830 &
'dim=<%c> data size (%d) exceeds size of the dim (%d) by HistoryCreate. ' // &
1831 &
'the data will be trancated. ', &
1832 & i = (/ dimsize, dimsize_max /), c1 = trim(varname) )
1833 dimsize = dimsize_max
1835 if (
associated( hst % mpi_dimdata_each( dimord ) % a_Axis ) )
then
1836 deallocate( hst % mpi_dimdata_each( dimord ) % a_Axis )
1838 allocate( hst % mpi_dimdata_each( dimord ) % a_Axis(dimsize) )
1839 hst % mpi_dimdata_each( dimord ) % a_Axis = array(1:dimsize)
1840 hst % mpi_dimdata_each( dimord ) % length = dimsize
1847 if ( v_ord > 0 )
then
1848 if ( .not.
associated( hst % mpi_gthr_info ) )
then
1852 if ( .not.
associated( hst % mpi_vars_index( v_ord ) % allcount ) )
then
1861 if ( v_ord > 0 )
then
1862 arraysize_work2 = hst % mpi_vars_index(v_ord) % allcount_all
1863 if ( arraysize_work2 < 1 ) arraysize_work2 = 1
1864 if ( hst % mpi_myrank == 0 )
then
1865 do ra = 1, hst % mpi_nprocs - 1
1866 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
1867 call mpi_send( allcount, 1, mpi_integer, ra, 0, mpi_comm_world, err_mpi )
1870 call mpi_recv( allcount, 1, mpi_integer, 0, 0, mpi_comm_world, st_mpi, err_mpi )
1872 if ( hst % mpi_myrank /= 0 )
then
1873 call mpi_send( array_work, allcount, &
1874 & mpi_integer, 0, 0, mpi_comm_world, err_mpi )
1876 allocate( array_mpi_all(0: hst % mpi_nprocs - 1, arraysize_work2 ) )
1877 allocate( array_mpi_tmp( arraysize_work2 ) )
1878 array_mpi_all(:,:) = 0
1879 array_mpi_tmp(:) = 0
1880 allcount = hst % mpi_vars_index(v_ord) % allcount(0)
1881 array_mpi_all(0,1:allcount) = array_work
1882 do ra = 1, hst % mpi_nprocs - 1
1883 allcount = hst % mpi_vars_index(v_ord) % allcount(ra)
1884 call mpi_recv( array_mpi_tmp(1:allcount), allcount, &
1885 & mpi_integer, ra, 0, mpi_comm_world, st_mpi, err_mpi )
1886 array_mpi_all(ra,1:allcount) = array_mpi_tmp(1:allcount)
1888 allocate( array_work2( arraysize_work2 ) )
1889 allocate( array_overwrap( arraysize_work2 ) )
1891 array_overwrap(:) = 0
1892 do ra = 0, hst % mpi_nprocs - 1
1893 do i = 1, hst % mpi_vars_index(v_ord) % allcount(ra)
1894 new_index = hst % mpi_vars_index(v_ord) % each2all(ra, i)
1895 array_work2( new_index ) = &
1896 & array_work2( new_index ) + array_mpi_all( ra, i )
1897 array_overwrap( new_index ) = array_overwrap( new_index ) + 1
1900 where ( array_overwrap == 0 )
1903 array_work2(:) = array_work2(:) / array_overwrap(:)
1904 deallocate( array_mpi_all, array_mpi_tmp, array_overwrap )
1908 array_work2 => array_work
1909 arraysize_work2 = arraysize
1916 if ( .not. hst % mpi_gather &
1917 & .or. ( hst % mpi_gather .and. &
1918 & hst % mpi_myrank == 0 .and. &
1919 & hst % mpi_fileinfo % already_output) )
then
1921 & varname = varname, &
1922 & head = real(array_work2(1)), &
1924 & history = history, &
1929 call dbgmessage(
'varname=<%c> has no dimension. so range is ignoread.', &
1934 call put(var, array_work2, arraysize_work2)
1939 allocate(start(dims), count(dims), stride(dims))
1941 call get_slice(var, i, start(i), count(i), stride(i))
1944 call slice(var, range, slice_err)
1945 call put(var, array_work2, arraysize_work2)
1948 call slice(var, i, start(i), count(i), stride(i))
1950 deallocate(start, count, stride)
1953 if ( hst % mpi_gather .and. v_ord > 0 )
then
1954 deallocate( array_work2 )
1961 if ( .not. hst % mpi_gather &
1962 & .or. ( hst % mpi_gather .and. &
1963 & hst % mpi_myrank == 0 .and. &
1964 & hst % mpi_fileinfo % already_output ) )
then
1965 if ( v_ord > 0 )
then
1966 if ( hst % var_avr_count( v_ord ) > -1 )
then
1970 timevar = hst % dimvars( hst % unlimited_index )
1974 & name = time_name )
1980 call open( var = bndsvar, &
1981 & url =
urlmerge(file=file, var=trim(time_name) // bnds_suffix) )
1988 & rank = bnds_rank )
1990 if ( bnds_rank > 1 )
then
1993 & dimord = hst % growable_indices(bnds_ord), &
1994 & allcount = time_count )
1996 if ( (hst % time_bnds_output_count < 1) &
1997 & .or. (hst % time_bnds_output_count < time_count) )
then
1998 call slice(bndsvar, hst % growable_indices(bnds_ord), &
1999 & start=hst % time_bnds_output_count+1, count=1)
2000 call put(bndsvar, hst % time_bnds, 2)
2001 hst % time_bnds_output_count = hst % time_bnds_output_count + 1
2003 call close( var = bndsvar )
2004 if (
present(difftime) )
then
2005 hst % time_bnds(1:1) = &
2006 &
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
2007 elseif (
present(timed) )
then
2008 hst % time_bnds(1:1) = timed
2010 hst % time_bnds(1:1) = time
2019 if ( .not. hst % mpi_gather &
2020 & .or. ( hst % mpi_gather .and. &
2021 & hst % mpi_myrank == 0 .and. &
2022 & hst % mpi_fileinfo % already_output ) )
then
2024 call inquire( hst % dimvars(1), &
2028 if ( hst % unlimited_index < 1 )
then
2031 timevar = hst % dimvars(hst % unlimited_index)
2032 call slice( timevar, &
2033 & 1, start = hst % count(v_ord), count = 1 )
2034 call get( timevar, &
2038 time_str =
'(time=' // trim(
tochar( time_value(1) )) //
')'
2041 &
'"%a" => "%a" %a %a', &
2042 & ca =
stoa( varname, file, time_str, avr_msg ) )
2050 call storeerror( stat, subname, err, cause_c )
2054 & varname, array, arraysize, history, range, &
2055 & time, quiet, difftime, timed, time_average_store, err )
2082 character(*),
intent(in):: varname
2083 integer,
intent(in):: arraysize
2084 character(*),
intent(in):: array(arraysize)
2085 type(
gt_history),
intent(inout),
target,
optional:: history
2086 character(*),
intent(in),
optional:: range
2102 real,
intent(in),
optional:: time
2124 logical,
intent(in),
optional:: quiet
2135 type(
dc_difftime),
intent(in),
optional:: difftime
2141 real(
dp),
intent(in),
optional:: timed
2147 logical,
intent(in),
optional:: time_average_store
2164 logical,
intent(out),
optional:: err
2179 character(STRING):: url, file, time_str
2180 real:: time_value(1:1)
2183 character(STRING):: avr_msg
2186 character(STRING):: cause_c
2188 subroutine timegoahead( varname, var, head, history, err )
2191 character(len = *),
intent(in):: varname
2193 real,
intent(in):: head
2194 type(
gt_history),
intent(inout),
optional,
target:: history
2195 logical,
intent(out),
optional:: err
2198 character(*),
parameter:: subname =
"HistoryPutCharEx"
2200 call beginsub(subname,
'varname=%a range=%a', &
2204 if (
present(history))
then
2213 if ( .not. hst % initialized )
then
2215 cause_c =
'GT_HISTORY'
2222 if ( (
present(time) .or.
present(difftime) .or.
present(timed) ) &
2225 &
'(varname=%c) "range" and "time" or "timed" or "difftime" are not suppored at the same time', &
2226 & c1 = trim(varname) )
2228 cause_c =
'"range" and "time" or "timed" or "difftime" are not suppored at the same time'
2235 if ( .not. hst % mpi_gather )
then
2238 if ( hst % mpi_myrank == 0 )
then
2241 call mpi_bcast( v_ord, 1, mpi_integer, 0, mpi_comm_world, err_mpi )
2242 call dbgmessage(
'v_ord=<%d> is shared on all nodes.', i = (/v_ord/) )
2244 if (
present(time_average_store) )
then
2251 if ( .not. hst % origin_setting )
then
2252 if (
present(difftime) )
then
2253 hst % origin =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
2254 hst % time_bnds =
evalbyunit( difftime,
'', hst % unlimited_units_symbol )
2255 hst % origin_setting = .true.
2256 elseif (
present(timed) )
then
2257 hst % origin = timed
2258 hst % time_bnds = timed
2259 hst % origin_setting = .true.
2260 elseif (
present(time) )
then
2262 hst % time_bnds = time
2263 hst % origin_setting = .true.
2286 if ( .not. hst % mpi_gather &
2287 & .or. ( hst % mpi_gather .and. &
2288 & hst % mpi_myrank == 0 .and. &
2289 & hst % mpi_fileinfo % already_output) )
then
2291 & varname = varname, &
2294 & history = history, &
2297 call dbgmessage(
'varname=<%c> is string. so range is ignoread.', &
2300 call put(var, array, arraysize)
2307 if ( .not. hst % mpi_gather &
2308 & .or. ( hst % mpi_gather .and. &
2309 & hst % mpi_myrank == 0 .and. &
2310 & hst % mpi_fileinfo % already_output ) )
then
2312 call inquire( hst % dimvars(1), &
2316 if ( hst % unlimited_index < 1 )
then
2319 timevar = hst % dimvars(hst % unlimited_index)
2320 call slice( timevar, &
2321 & 1, start = hst % count(v_ord), count = 1 )
2322 call get( timevar, &
2326 time_str =
'(time=' // trim(
tochar( time_value(1) )) //
')'
2329 &
'"%a" => "%a" %a %a', &
2330 & ca =
stoa( varname, file, time_str, avr_msg ) )
2338 call storeerror( stat, subname, err, cause_c )
2377 character(*),
intent(in):: varname
2378 real,
intent(in):: array(:)
2379 type(
gt_history),
intent(inout),
optional,
target:: history
2380 logical,
intent(out),
optional:: err
2382 integer:: dimord, dimsize, numdims, i, j, attr_size
2384 character(STRING):: dimname
2385 character(STRING):: name, longname, units, xtype, origin_str, url
2386 real(DP):: origin_work
2388 character(STRING):: cause_c
2389 character(*),
parameter:: subname =
"HistoryPutAxisMPIReal"
2391 call beginsub(subname,
'varname=%c', c1 = trim(varname) )
2394 if (
present(history))
then
2399 if ( .not. hst % initialized )
then
2401 cause_c =
'GT_HISTORY'
2404 call dbgmessage(
'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
2405 if ( .not. hst % mpi_gather )
then
2408 numdims =
size( hst % dimvars )
2412 & hst % mpi_fileinfo % axes(i), &
2414 if ( trim(varname) == trim(dimname) )
then
2419 if ( dimord < 1 )
then
2424 dimsize =
size( array )
2425 if (
associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) )
then
2426 deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
2428 allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
2429 hst % mpi_dimdata_all( dimord ) % a_Axis = array
2430 hst % mpi_dimdata_all( dimord ) % length = dimsize
2435 numdims =
size( hst % dimvars )
2437 if ( hst % unlimited_index == i ) cycle
2438 if ( hst % time_nv_index == i ) cycle
2439 if ( hst % mpi_dimdata_all( i ) % length < 1 )
goto 999
2441 if ( hst % mpi_myrank /= 0 )
goto 2000
2442 if ( hst % mpi_fileinfo % already_output )
goto 999
2445 & name, dimsize, longname, units, xtype )
2446 url =
urlmerge(file = hst % mpi_fileinfo % file, var = name)
2450 if ( hst % unlimited_index /= i )
then
2451 dimsize = hst % mpi_dimdata_all( i ) % length
2457 & hst % dimvars(i), trim(url), &
2458 & dimsize, xtype = xtype, &
2459 & overwrite = hst % mpi_fileinfo % overwrite )
2463 call put_attr(hst % dimvars(i),
'+Conventions', trim(hst % mpi_fileinfo % conventions ))
2464 if ( hst % mpi_fileinfo % gtver_add )
then
2465 call put_attr(hst % dimvars(i),
'+gt_version', trim(hst % mpi_fileinfo % gt_version ))
2468 call put_attr(hst % dimvars(i),
'+title', hst % mpi_fileinfo % title)
2469 call put_attr(hst % dimvars(i),
'+source', hst % mpi_fileinfo % source)
2470 call put_attr(hst % dimvars(i),
'+institution', trim(hst % mpi_fileinfo % institution))
2471 call put_attr(hst % dimvars(i),
'+history', trim(hst % mpi_fileinfo % nc_history))
2472 call put_attr(hst % dimvars(i),
'long_name', longname)
2473 call put_attr(hst % dimvars(i),
'units', units)
2474 origin_work = hst % origin
2476 origin_str = trim(
tochar( origin_work ) ) // &
2477 &
' [' // trim( hst % unlimited_units ) //
']'
2481 if ( hst % unlimited_index /= i )
then
2482 call put(hst % dimvars(i), &
2483 & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
2484 hst % dim_value_written(i) = .true.
2489 attrs => hst % mpi_dimdata_all(i) % attrs
2490 if (
associated( attrs ) )
then
2491 attr_size =
size( attrs )
2493 if (
strhead(
'char', trim(
lchar(attrs(j)%attrtype))) )
then
2495 & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
2496 elseif (
strhead(
'int', trim(
lchar(attrs(j)%attrtype))) )
then
2497 if ( attrs(j)%array )
then
2500 & attrs(j) % attrname, attrs(j) % Intarray )
2504 & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
2506 elseif (
strhead(
'real', trim(
lchar(attrs(j)%attrtype))) )
then
2507 if ( attrs(j)%array )
then
2510 & attrs(j) % attrname, attrs(j) % Realarray )
2514 & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
2516 elseif (
strhead(
'double', trim(
lchar(attrs(j)%attrtype))) )
then
2517 if ( attrs(j)%array )
then
2518 call dbgmessage(
'Doublearray(:) is selected.')
2520 & attrs(j) % attrname, attrs(j) % Doublearray )
2524 & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
2526 elseif (
strhead(
'logical', trim(
lchar(attrs(j)%attrtype))) )
then
2528 & attrs(j) % attrname, attrs(j) % Logicalvalue )
2530 call dbgmessage(
'attrtype=<%c>=<%c>is Invalid.' , &
2531 & c1=trim(attrs(j)%attrtype) , &
2532 & c2=trim(
lchar(attrs(j)%attrtype)) )
2537 if ( .not. hst % mpi_fileinfo % quiet )
then
2539 &
'"%c" is created (origin=%c)', &
2540 & c1 = trim( hst % mpi_fileinfo % file ), &
2541 & c2 = trim( origin_str ) )
2544 hst % mpi_fileinfo % already_output = .true.
2549 call storeerror( stat, subname, err, cause_c )
2588 character(*),
intent(in):: varname
2600 real(DP),
intent(in):: array(:)
2604 type(
gt_history),
intent(inout),
optional,
target:: history
2619 logical,
intent(out),
optional:: err
2634 integer:: dimord, dimsize, numdims, i, j, attr_size
2636 character(STRING):: dimname
2637 character(STRING):: name, longname, units, xtype, origin_str, url
2638 real(DP):: origin_work
2640 character(STRING):: cause_c
2641 character(*),
parameter:: subname =
"HistoryPutAxisMPIDouble"
2643 call beginsub(subname,
'varname=%c', c1 = trim(varname) )
2646 if (
present(history))
then
2651 if ( .not. hst % initialized )
then
2653 cause_c =
'GT_HISTORY'
2656 call dbgmessage(
'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
2657 if ( .not. hst % mpi_gather )
then
2660 numdims =
size( hst % dimvars )
2664 & hst % mpi_fileinfo % axes(i), &
2666 if ( trim(varname) == trim(dimname) )
then
2671 if ( dimord < 1 )
then
2676 dimsize =
size( array )
2677 if (
associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) )
then
2678 deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
2680 allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
2681 hst % mpi_dimdata_all( dimord ) % a_Axis = array
2682 hst % mpi_dimdata_all( dimord ) % length = dimsize
2687 numdims =
size( hst % dimvars )
2689 if ( hst % unlimited_index == i ) cycle
2690 if ( hst % time_nv_index == i ) cycle
2691 if ( hst % mpi_dimdata_all( i ) % length < 1 )
goto 999
2693 if ( hst % mpi_myrank /= 0 )
goto 2000
2694 if ( hst % mpi_fileinfo % already_output )
goto 999
2697 & name, dimsize, longname, units, xtype )
2698 url =
urlmerge(file = hst % mpi_fileinfo % file, var = name)
2702 if ( hst % unlimited_index /= i )
then
2703 dimsize = hst % mpi_dimdata_all( i ) % length
2709 & hst % dimvars(i), trim(url), &
2710 & dimsize, xtype = xtype, &
2711 & overwrite = hst % mpi_fileinfo % overwrite )
2715 call put_attr(hst % dimvars(i),
'+Conventions', trim(hst % mpi_fileinfo % conventions ))
2716 if ( hst % mpi_fileinfo % gtver_add )
then
2717 call put_attr(hst % dimvars(i),
'+gt_version', trim(hst % mpi_fileinfo % gt_version ))
2720 call put_attr(hst % dimvars(i),
'+title', hst % mpi_fileinfo % title)
2721 call put_attr(hst % dimvars(i),
'+source', hst % mpi_fileinfo % source)
2722 call put_attr(hst % dimvars(i),
'+institution', trim(hst % mpi_fileinfo % institution))
2723 call put_attr(hst % dimvars(i),
'+history', trim(hst % mpi_fileinfo % nc_history))
2724 call put_attr(hst % dimvars(i),
'long_name', longname)
2725 call put_attr(hst % dimvars(i),
'units', units)
2726 origin_work = hst % origin
2728 origin_str = trim(
tochar( origin_work ) ) // &
2729 &
' [' // trim( hst % unlimited_units ) //
']'
2733 if ( hst % unlimited_index /= i )
then
2734 call put(hst % dimvars(i), &
2735 & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
2736 hst % dim_value_written(i) = .true.
2741 attrs => hst % mpi_dimdata_all(i) % attrs
2742 if (
associated( attrs ) )
then
2743 attr_size =
size( attrs )
2745 if (
strhead(
'char', trim(
lchar(attrs(j)%attrtype))) )
then
2747 & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
2748 elseif (
strhead(
'int', trim(
lchar(attrs(j)%attrtype))) )
then
2749 if ( attrs(j)%array )
then
2752 & attrs(j) % attrname, attrs(j) % Intarray )
2756 & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
2758 elseif (
strhead(
'real', trim(
lchar(attrs(j)%attrtype))) )
then
2759 if ( attrs(j)%array )
then
2762 & attrs(j) % attrname, attrs(j) % Realarray )
2766 & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
2768 elseif (
strhead(
'double', trim(
lchar(attrs(j)%attrtype))) )
then
2769 if ( attrs(j)%array )
then
2770 call dbgmessage(
'Doublearray(:) is selected.')
2772 & attrs(j) % attrname, attrs(j) % Doublearray )
2776 & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
2778 elseif (
strhead(
'logical', trim(
lchar(attrs(j)%attrtype))) )
then
2780 & attrs(j) % attrname, attrs(j) % Logicalvalue )
2782 call dbgmessage(
'attrtype=<%c>=<%c>is Invalid.' , &
2783 & c1=trim(attrs(j)%attrtype) , &
2784 & c2=trim(
lchar(attrs(j)%attrtype)) )
2789 if ( .not. hst % mpi_fileinfo % quiet )
then
2791 &
'"%c" is created (origin=%c)', &
2792 & c1 = trim( hst % mpi_fileinfo % file ), &
2793 & c2 = trim( origin_str ) )
2796 hst % mpi_fileinfo % already_output = .true.
2801 call storeerror( stat, subname, err, cause_c )
2840 character(*),
intent(in):: varname
2841 integer,
intent(in):: array(:)
2842 type(
gt_history),
intent(inout),
optional,
target:: history
2843 logical,
intent(out),
optional:: err
2845 integer:: dimord, dimsize, numdims, i, j, attr_size
2847 character(STRING):: dimname
2848 character(STRING):: name, longname, units, xtype, origin_str, url
2849 real(DP):: origin_work
2851 character(STRING):: cause_c
2852 character(*),
parameter:: subname =
"HistoryPutAxisMPIInt"
2854 call beginsub(subname,
'varname=%c', c1 = trim(varname) )
2857 if (
present(history))
then
2862 if ( .not. hst % initialized )
then
2864 cause_c =
'GT_HISTORY'
2867 call dbgmessage(
'mpi_gather=<%b>', l = (/ hst % mpi_gather /) )
2868 if ( .not. hst % mpi_gather )
then
2871 numdims =
size( hst % dimvars )
2875 & hst % mpi_fileinfo % axes(i), &
2877 if ( trim(varname) == trim(dimname) )
then
2882 if ( dimord < 1 )
then
2887 dimsize =
size( array )
2888 if (
associated( hst % mpi_dimdata_all( dimord ) % a_Axis ) )
then
2889 deallocate( hst % mpi_dimdata_all( dimord ) % a_Axis )
2891 allocate( hst % mpi_dimdata_all( dimord ) % a_Axis(dimsize) )
2892 hst % mpi_dimdata_all( dimord ) % a_Axis = array
2893 hst % mpi_dimdata_all( dimord ) % length = dimsize
2898 numdims =
size( hst % dimvars )
2900 if ( hst % unlimited_index == i ) cycle
2901 if ( hst % time_nv_index == i ) cycle
2902 if ( hst % mpi_dimdata_all( i ) % length < 1 )
goto 999
2904 if ( hst % mpi_myrank /= 0 )
goto 2000
2905 if ( hst % mpi_fileinfo % already_output )
goto 999
2908 & name, dimsize, longname, units, xtype )
2909 url =
urlmerge(file = hst % mpi_fileinfo % file, var = name)
2913 if ( hst % unlimited_index /= i )
then
2914 dimsize = hst % mpi_dimdata_all( i ) % length
2920 & hst % dimvars(i), trim(url), &
2921 & dimsize, xtype = xtype, &
2922 & overwrite = hst % mpi_fileinfo % overwrite )
2926 call put_attr(hst % dimvars(i),
'+Conventions', trim(hst % mpi_fileinfo % conventions ))
2927 if ( hst % mpi_fileinfo % gtver_add )
then
2928 call put_attr(hst % dimvars(i),
'+gt_version', trim(hst % mpi_fileinfo % gt_version ))
2931 call put_attr(hst % dimvars(i),
'+title', hst % mpi_fileinfo % title)
2932 call put_attr(hst % dimvars(i),
'+source', hst % mpi_fileinfo % source)
2933 call put_attr(hst % dimvars(i),
'+institution', trim(hst % mpi_fileinfo % institution))
2934 call put_attr(hst % dimvars(i),
'+history', trim(hst % mpi_fileinfo % nc_history))
2935 call put_attr(hst % dimvars(i),
'long_name', longname)
2936 call put_attr(hst % dimvars(i),
'units', units)
2937 origin_work = hst % origin
2939 origin_str = trim(
tochar( origin_work ) ) // &
2940 &
' [' // trim( hst % unlimited_units ) //
']'
2944 if ( hst % unlimited_index /= i )
then
2945 call put(hst % dimvars(i), &
2946 & hst % mpi_dimdata_all( i ) % a_Axis, dimsize )
2947 hst % dim_value_written(i) = .true.
2952 attrs => hst % mpi_dimdata_all(i) % attrs
2953 if (
associated( attrs ) )
then
2954 attr_size =
size( attrs )
2956 if (
strhead(
'char', trim(
lchar(attrs(j)%attrtype))) )
then
2958 & attrs(j) % attrname, trim( attrs(j) % Charvalue ) )
2959 elseif (
strhead(
'int', trim(
lchar(attrs(j)%attrtype))) )
then
2960 if ( attrs(j)%array )
then
2963 & attrs(j) % attrname, attrs(j) % Intarray )
2967 & attrs(j) % attrname, (/attrs(j) % Intvalue/) )
2969 elseif (
strhead(
'real', trim(
lchar(attrs(j)%attrtype))) )
then
2970 if ( attrs(j)%array )
then
2973 & attrs(j) % attrname, attrs(j) % Realarray )
2977 & attrs(j) % attrname, (/attrs(j) % Realvalue/) )
2979 elseif (
strhead(
'double', trim(
lchar(attrs(j)%attrtype))) )
then
2980 if ( attrs(j)%array )
then
2981 call dbgmessage(
'Doublearray(:) is selected.')
2983 & attrs(j) % attrname, attrs(j) % Doublearray )
2987 & attrs(j) % attrname, (/attrs(j) % Doublevalue/) )
2989 elseif (
strhead(
'logical', trim(
lchar(attrs(j)%attrtype))) )
then
2991 & attrs(j) % attrname, attrs(j) % Logicalvalue )
2993 call dbgmessage(
'attrtype=<%c>=<%c>is Invalid.' , &
2994 & c1=trim(attrs(j)%attrtype) , &
2995 & c2=trim(
lchar(attrs(j)%attrtype)) )
3000 if ( .not. hst % mpi_fileinfo % quiet )
then
3002 &
'"%c" is created (origin=%c)', &
3003 & c1 = trim( hst % mpi_fileinfo % file ), &
3004 & c2 = trim( origin_str ) )
3007 hst % mpi_fileinfo % already_output = .true.
3012 call storeerror( stat, subname, err, cause_c )
3016 & history, range, time, quiet, &
3017 & difftime, timed, time_average_store, err )
3057 character(*),
intent(in):: varname
3067 real(DP),
intent(in):: value
3078 type(
gt_history),
intent(inout),
optional,
target:: history
3086 character(*),
intent(in),
optional:: range
3102 real,
intent(in),
optional:: time
3128 logical,
intent(in),
optional:: quiet
3135 type(
dc_difftime),
intent(in),
optional:: difftime
3140 real(DP),
intent(in),
optional:: timed
3145 logical,
intent(in),
optional:: time_average_store
3162 logical,
intent(out),
optional:: err
3178 & varname, array, arraysize, history, range, &
3179 & time, quiet, difftime, timed, time_average_store, err )
3183 character(*),
intent(in):: varname
3184 integer,
intent(in):: arraysize
3185 real(DP),
intent(in):: array(arraysize)
3186 type(
gt_history),
intent(inout),
target,
optional:: history
3187 character(*),
intent(in),
optional:: range
3188 real,
intent(in),
optional:: time
3189 logical,
intent(in),
optional:: quiet
3190 type(
dc_difftime),
intent(in),
optional:: difftime
3191 real(DP),
intent(in),
optional:: timed
3192 logical,
intent(in),
optional:: time_average_store
3193 logical,
intent(out),
optional:: err
3196 character(*),
parameter:: subname =
"HistoryPutDouble0"
3202 & history = history, &
3206 & difftime = difftime, &
3208 & time_average_store = &
3209 & time_average_store, &
3214 & history, range, time, quiet, &
3215 & difftime, timed, time_average_store, err )
3223 character(*),
intent(in):: varname
3224 real(DP),
intent(in):: array(:)
3225 type(
gt_history),
intent(inout),
optional,
target:: history
3226 character(*),
intent(in),
optional:: range
3227 real,
intent(in),
optional:: time
3228 logical,
intent(in),
optional:: quiet
3229 type(
dc_difftime),
intent(in),
optional:: difftime
3230 real(DP),
intent(in),
optional:: timed
3231 logical,
intent(in),
optional:: time_average_store
3232 logical,
intent(out),
optional:: err
3235 & varname, array, arraysize, history, range, &
3236 & time, quiet, difftime, timed, time_average_store, err )
3240 character(*),
intent(in):: varname
3241 integer,
intent(in):: arraysize
3242 real(DP),
intent(in):: array(arraysize)
3243 type(
gt_history),
intent(inout),
target,
optional:: history
3244 character(*),
intent(in),
optional:: range
3245 real,
intent(in),
optional:: time
3246 logical,
intent(in),
optional:: quiet
3247 type(
dc_difftime),
intent(in),
optional:: difftime
3248 real(DP),
intent(in),
optional:: timed
3249 logical,
intent(in),
optional:: time_average_store
3250 logical,
intent(out),
optional:: err
3253 character(*),
parameter:: subname =
"HistoryPutDouble1"
3258 & pack(array, .true.),
size(array), &
3259 & history = history, &
3263 & difftime = difftime, &
3265 & time_average_store = &
3266 & time_average_store, &
3271 & history, range, time, quiet, &
3272 & difftime, timed, time_average_store, err )
3280 character(*),
intent(in):: varname
3281 real(DP),
intent(in):: array(:,:)
3282 type(
gt_history),
intent(inout),
optional,
target:: history
3283 character(*),
intent(in),
optional:: range
3284 real,
intent(in),
optional:: time
3285 logical,
intent(in),
optional:: quiet
3286 type(
dc_difftime),
intent(in),
optional:: difftime
3287 real(DP),
intent(in),
optional:: timed
3288 logical,
intent(in),
optional:: time_average_store
3289 logical,
intent(out),
optional:: err
3292 & varname, array, arraysize, history, range, &
3293 & time, quiet, difftime, timed, time_average_store, err )
3297 character(*),
intent(in):: varname
3298 integer,
intent(in):: arraysize
3299 real(DP),
intent(in):: array(arraysize)
3300 type(
gt_history),
intent(inout),
target,
optional:: history
3301 character(*),
intent(in),
optional:: range
3302 real,
intent(in),
optional:: time
3303 logical,
intent(in),
optional:: quiet
3304 type(
dc_difftime),
intent(in),
optional:: difftime
3305 real(DP),
intent(in),
optional:: timed
3306 logical,
intent(in),
optional:: time_average_store
3307 logical,
intent(out),
optional:: err
3310 character(*),
parameter:: subname =
"HistoryPutDouble2"
3315 & pack(array, .true.),
size(array), &
3316 & history = history, &
3320 & difftime = difftime, &
3322 & time_average_store = &
3323 & time_average_store, &
3328 & history, range, time, quiet, &
3329 & difftime, timed, time_average_store, err )
3337 character(*),
intent(in):: varname
3338 real(DP),
intent(in):: array(:,:,:)
3339 type(
gt_history),
intent(inout),
optional,
target:: history
3340 character(*),
intent(in),
optional:: range
3341 real,
intent(in),
optional:: time
3342 logical,
intent(in),
optional:: quiet
3343 type(
dc_difftime),
intent(in),
optional:: difftime
3344 real(DP),
intent(in),
optional:: timed
3345 logical,
intent(in),
optional:: time_average_store
3346 logical,
intent(out),
optional:: err
3349 & varname, array, arraysize, history, range, &
3350 & time, quiet, difftime, timed, time_average_store, err )
3354 character(*),
intent(in):: varname
3355 integer,
intent(in):: arraysize
3356 real(DP),
intent(in):: array(arraysize)
3357 type(
gt_history),
intent(inout),
target,
optional:: history
3358 character(*),
intent(in),
optional:: range
3359 real,
intent(in),
optional:: time
3360 logical,
intent(in),
optional:: quiet
3361 type(
dc_difftime),
intent(in),
optional:: difftime
3362 real(DP),
intent(in),
optional:: timed
3363 logical,
intent(in),
optional:: time_average_store
3364 logical,
intent(out),
optional:: err
3367 character(*),
parameter:: subname =
"HistoryPutDouble3"
3372 & pack(array, .true.),
size(array), &
3373 & history = history, &
3377 & difftime = difftime, &
3379 & time_average_store = &
3380 & time_average_store, &
3385 & history, range, time, quiet, &
3386 & difftime, timed, time_average_store, err )
3394 character(*),
intent(in):: varname
3395 real(DP),
intent(in):: array(:,:,:,:)
3396 type(
gt_history),
intent(inout),
optional,
target:: history
3397 character(*),
intent(in),
optional:: range
3398 real,
intent(in),
optional:: time
3399 logical,
intent(in),
optional:: quiet
3400 type(
dc_difftime),
intent(in),
optional:: difftime
3401 real(DP),
intent(in),
optional:: timed
3402 logical,
intent(in),
optional:: time_average_store
3403 logical,
intent(out),
optional:: err
3406 & varname, array, arraysize, history, range, &
3407 & time, quiet, difftime, timed, time_average_store, err )
3411 character(*),
intent(in):: varname
3412 integer,
intent(in):: arraysize
3413 real(DP),
intent(in):: array(arraysize)
3414 type(
gt_history),
intent(inout),
target,
optional:: history
3415 character(*),
intent(in),
optional:: range
3416 real,
intent(in),
optional:: time
3417 logical,
intent(in),
optional:: quiet
3418 type(
dc_difftime),
intent(in),
optional:: difftime
3419 real(DP),
intent(in),
optional:: timed
3420 logical,
intent(in),
optional:: time_average_store
3421 logical,
intent(out),
optional:: err
3424 character(*),
parameter:: subname =
"HistoryPutDouble4"
3429 & pack(array, .true.),
size(array), &
3430 & history = history, &
3434 & difftime = difftime, &
3436 & time_average_store = &
3437 & time_average_store, &
3442 & history, range, time, quiet, &
3443 & difftime, timed, time_average_store, err )
3451 character(*),
intent(in):: varname
3452 real(DP),
intent(in):: array(:,:,:,:,:)
3453 type(
gt_history),
intent(inout),
optional,
target:: history
3454 character(*),
intent(in),
optional:: range
3455 real,
intent(in),
optional:: time
3456 logical,
intent(in),
optional:: quiet
3457 type(
dc_difftime),
intent(in),
optional:: difftime
3458 real(DP),
intent(in),
optional:: timed
3459 logical,
intent(in),
optional:: time_average_store
3460 logical,
intent(out),
optional:: err
3463 & varname, array, arraysize, history, range, &
3464 & time, quiet, difftime, timed, time_average_store, err )
3468 character(*),
intent(in):: varname
3469 integer,
intent(in):: arraysize
3470 real(DP),
intent(in):: array(arraysize)
3471 type(
gt_history),
intent(inout),
target,
optional:: history
3472 character(*),
intent(in),
optional:: range
3473 real,
intent(in),
optional:: time
3474 logical,
intent(in),
optional:: quiet
3475 type(
dc_difftime),
intent(in),
optional:: difftime
3476 real(DP),
intent(in),
optional:: timed
3477 logical,
intent(in),
optional:: time_average_store
3478 logical,
intent(out),
optional:: err
3481 character(*),
parameter:: subname =
"HistoryPutDouble5"
3486 & pack(array, .true.),
size(array), &
3487 & history = history, &
3491 & difftime = difftime, &
3493 & time_average_store = &
3494 & time_average_store, &
3499 & history, range, time, quiet, &
3500 & difftime, timed, time_average_store, err )
3508 character(*),
intent(in):: varname
3509 real(DP),
intent(in):: array(:,:,:,:,:,:)
3510 type(
gt_history),
intent(inout),
optional,
target:: history
3511 character(*),
intent(in),
optional:: range
3512 real,
intent(in),
optional:: time
3513 logical,
intent(in),
optional:: quiet
3514 type(
dc_difftime),
intent(in),
optional:: difftime
3515 real(DP),
intent(in),
optional:: timed
3516 logical,
intent(in),
optional:: time_average_store
3517 logical,
intent(out),
optional:: err
3520 & varname, array, arraysize, history, range, &
3521 & time, quiet, difftime, timed, time_average_store, err )
3525 character(*),
intent(in):: varname
3526 integer,
intent(in):: arraysize
3527 real(DP),
intent(in):: array(arraysize)
3528 type(
gt_history),
intent(inout),
target,
optional:: history
3529 character(*),
intent(in),
optional:: range
3530 real,
intent(in),
optional:: time
3531 logical,
intent(in),
optional:: quiet
3532 type(
dc_difftime),
intent(in),
optional:: difftime
3533 real(DP),
intent(in),
optional:: timed
3534 logical,
intent(in),
optional:: time_average_store
3535 logical,
intent(out),
optional:: err
3538 character(*),
parameter:: subname =
"HistoryPutDouble6"
3543 & pack(array, .true.),
size(array), &
3544 & history = history, &
3548 & difftime = difftime, &
3550 & time_average_store = &
3551 & time_average_store, &
3556 & history, range, time, quiet, &
3557 & difftime, timed, time_average_store, err )
3565 character(*),
intent(in):: varname
3566 real(DP),
intent(in):: array(:,:,:,:,:,:,:)
3567 type(
gt_history),
intent(inout),
optional,
target:: history
3568 character(*),
intent(in),
optional:: range
3569 real,
intent(in),
optional:: time
3570 logical,
intent(in),
optional:: quiet
3571 type(
dc_difftime),
intent(in),
optional:: difftime
3572 real(DP),
intent(in),
optional:: timed
3573 logical,
intent(in),
optional:: time_average_store
3574 logical,
intent(out),
optional:: err
3577 & varname, array, arraysize, history, range, &
3578 & time, quiet, difftime, timed, time_average_store, err )
3582 character(*),
intent(in):: varname
3583 integer,
intent(in):: arraysize
3584 real(DP),
intent(in):: array(arraysize)
3585 type(
gt_history),
intent(inout),
target,
optional:: history
3586 character(*),
intent(in),
optional:: range
3587 real,
intent(in),
optional:: time
3588 logical,
intent(in),
optional:: quiet
3589 type(
dc_difftime),
intent(in),
optional:: difftime
3590 real(DP),
intent(in),
optional:: timed
3591 logical,
intent(in),
optional:: time_average_store
3592 logical,
intent(out),
optional:: err
3595 character(*),
parameter:: subname =
"HistoryPutDouble7"
3600 & pack(array, .true.),
size(array), &
3601 & history = history, &
3605 & difftime = difftime, &
3607 & time_average_store = &
3608 & time_average_store, &
3613 & history, range, time, quiet, &
3614 & difftime, timed, time_average_store, err )
3622 character(*),
intent(in):: varname
3623 real,
intent(in):: value
3624 type(
gt_history),
intent(inout),
optional,
target:: history
3625 character(*),
intent(in),
optional:: range
3626 real,
intent(in),
optional:: time
3627 logical,
intent(in),
optional:: quiet
3628 type(
dc_difftime),
intent(in),
optional:: difftime
3629 real(DP),
intent(in),
optional:: timed
3630 logical,
intent(in),
optional:: time_average_store
3631 logical,
intent(out),
optional:: err
3634 & varname, array, arraysize, history, range, &
3635 & time, quiet, difftime, timed, time_average_store, err )
3639 character(*),
intent(in):: varname
3640 integer,
intent(in):: arraysize
3641 real,
intent(in):: array(arraysize)
3642 type(
gt_history),
intent(inout),
target,
optional:: history
3643 character(*),
intent(in),
optional:: range
3644 real,
intent(in),
optional:: time
3645 logical,
intent(in),
optional:: quiet
3646 type(
dc_difftime),
intent(in),
optional:: difftime
3647 real(DP),
intent(in),
optional:: timed
3648 logical,
intent(in),
optional:: time_average_store
3649 logical,
intent(out),
optional:: err
3652 character(*),
parameter:: subname =
"HistoryPutReal0"
3658 & history = history, &
3662 & difftime = difftime, &
3664 & time_average_store = &
3665 & time_average_store, &
3670 & history, range, time, quiet, &
3671 & difftime, timed, time_average_store, err )
3679 character(*),
intent(in):: varname
3680 real,
intent(in):: array(:)
3681 type(
gt_history),
intent(inout),
optional,
target:: history
3682 character(*),
intent(in),
optional:: range
3683 real,
intent(in),
optional:: time
3684 logical,
intent(in),
optional:: quiet
3685 type(
dc_difftime),
intent(in),
optional:: difftime
3686 real(DP),
intent(in),
optional:: timed
3687 logical,
intent(in),
optional:: time_average_store
3688 logical,
intent(out),
optional:: err
3691 & varname, array, arraysize, history, range, &
3692 & time, quiet, difftime, timed, time_average_store, err )
3696 character(*),
intent(in):: varname
3697 integer,
intent(in):: arraysize
3698 real,
intent(in):: array(arraysize)
3699 type(
gt_history),
intent(inout),
target,
optional:: history
3700 character(*),
intent(in),
optional:: range
3701 real,
intent(in),
optional:: time
3702 logical,
intent(in),
optional:: quiet
3703 type(
dc_difftime),
intent(in),
optional:: difftime
3704 real(DP),
intent(in),
optional:: timed
3705 logical,
intent(in),
optional:: time_average_store
3706 logical,
intent(out),
optional:: err
3709 character(*),
parameter:: subname =
"HistoryPutReal1"
3714 & pack(array, .true.),
size(array), &
3715 & history = history, &
3719 & difftime = difftime, &
3721 & time_average_store = &
3722 & time_average_store, &
3727 & history, range, time, quiet, &
3728 & difftime, timed, time_average_store, err )
3736 character(*),
intent(in):: varname
3737 real,
intent(in):: array(:,:)
3738 type(
gt_history),
intent(inout),
optional,
target:: history
3739 character(*),
intent(in),
optional:: range
3740 real,
intent(in),
optional:: time
3741 logical,
intent(in),
optional:: quiet
3742 type(
dc_difftime),
intent(in),
optional:: difftime
3743 real(DP),
intent(in),
optional:: timed
3744 logical,
intent(in),
optional:: time_average_store
3745 logical,
intent(out),
optional:: err
3748 & varname, array, arraysize, history, range, &
3749 & time, quiet, difftime, timed, time_average_store, err )
3753 character(*),
intent(in):: varname
3754 integer,
intent(in):: arraysize
3755 real,
intent(in):: array(arraysize)
3756 type(
gt_history),
intent(inout),
target,
optional:: history
3757 character(*),
intent(in),
optional:: range
3758 real,
intent(in),
optional:: time
3759 logical,
intent(in),
optional:: quiet
3760 type(
dc_difftime),
intent(in),
optional:: difftime
3761 real(DP),
intent(in),
optional:: timed
3762 logical,
intent(in),
optional:: time_average_store
3763 logical,
intent(out),
optional:: err
3766 character(*),
parameter:: subname =
"HistoryPutReal2"
3771 & pack(array, .true.),
size(array), &
3772 & history = history, &
3776 & difftime = difftime, &
3778 & time_average_store = &
3779 & time_average_store, &
3784 & history, range, time, quiet, &
3785 & difftime, timed, time_average_store, err )
3793 character(*),
intent(in):: varname
3794 real,
intent(in):: array(:,:,:)
3795 type(
gt_history),
intent(inout),
optional,
target:: history
3796 character(*),
intent(in),
optional:: range
3797 real,
intent(in),
optional:: time
3798 logical,
intent(in),
optional:: quiet
3799 type(
dc_difftime),
intent(in),
optional:: difftime
3800 real(DP),
intent(in),
optional:: timed
3801 logical,
intent(in),
optional:: time_average_store
3802 logical,
intent(out),
optional:: err
3805 & varname, array, arraysize, history, range, &
3806 & time, quiet, difftime, timed, time_average_store, err )
3810 character(*),
intent(in):: varname
3811 integer,
intent(in):: arraysize
3812 real,
intent(in):: array(arraysize)
3813 type(
gt_history),
intent(inout),
target,
optional:: history
3814 character(*),
intent(in),
optional:: range
3815 real,
intent(in),
optional:: time
3816 logical,
intent(in),
optional:: quiet
3817 type(
dc_difftime),
intent(in),
optional:: difftime
3818 real(DP),
intent(in),
optional:: timed
3819 logical,
intent(in),
optional:: time_average_store
3820 logical,
intent(out),
optional:: err
3823 character(*),
parameter:: subname =
"HistoryPutReal3"
3828 & pack(array, .true.),
size(array), &
3829 & history = history, &
3833 & difftime = difftime, &
3835 & time_average_store = &
3836 & time_average_store, &
3841 & history, range, time, quiet, &
3842 & difftime, timed, time_average_store, err )
3850 character(*),
intent(in):: varname
3851 real,
intent(in):: array(:,:,:,:)
3852 type(
gt_history),
intent(inout),
optional,
target:: history
3853 character(*),
intent(in),
optional:: range
3854 real,
intent(in),
optional:: time
3855 logical,
intent(in),
optional:: quiet
3856 type(
dc_difftime),
intent(in),
optional:: difftime
3857 real(DP),
intent(in),
optional:: timed
3858 logical,
intent(in),
optional:: time_average_store
3859 logical,
intent(out),
optional:: err
3862 & varname, array, arraysize, history, range, &
3863 & time, quiet, difftime, timed, time_average_store, err )
3867 character(*),
intent(in):: varname
3868 integer,
intent(in):: arraysize
3869 real,
intent(in):: array(arraysize)
3870 type(
gt_history),
intent(inout),
target,
optional:: history
3871 character(*),
intent(in),
optional:: range
3872 real,
intent(in),
optional:: time
3873 logical,
intent(in),
optional:: quiet
3874 type(
dc_difftime),
intent(in),
optional:: difftime
3875 real(DP),
intent(in),
optional:: timed
3876 logical,
intent(in),
optional:: time_average_store
3877 logical,
intent(out),
optional:: err
3880 character(*),
parameter:: subname =
"HistoryPutReal4"
3885 & pack(array, .true.),
size(array), &
3886 & history = history, &
3890 & difftime = difftime, &
3892 & time_average_store = &
3893 & time_average_store, &
3898 & history, range, time, quiet, &
3899 & difftime, timed, time_average_store, err )
3907 character(*),
intent(in):: varname
3908 real,
intent(in):: array(:,:,:,:,:)
3909 type(
gt_history),
intent(inout),
optional,
target:: history
3910 character(*),
intent(in),
optional:: range
3911 real,
intent(in),
optional:: time
3912 logical,
intent(in),
optional:: quiet
3913 type(
dc_difftime),
intent(in),
optional:: difftime
3914 real(DP),
intent(in),
optional:: timed
3915 logical,
intent(in),
optional:: time_average_store
3916 logical,
intent(out),
optional:: err
3919 & varname, array, arraysize, history, range, &
3920 & time, quiet, difftime, timed, time_average_store, err )
3924 character(*),
intent(in):: varname
3925 integer,
intent(in):: arraysize
3926 real,
intent(in):: array(arraysize)
3927 type(
gt_history),
intent(inout),
target,
optional:: history
3928 character(*),
intent(in),
optional:: range
3929 real,
intent(in),
optional:: time
3930 logical,
intent(in),
optional:: quiet
3931 type(
dc_difftime),
intent(in),
optional:: difftime
3932 real(DP),
intent(in),
optional:: timed
3933 logical,
intent(in),
optional:: time_average_store
3934 logical,
intent(out),
optional:: err
3937 character(*),
parameter:: subname =
"HistoryPutReal5"
3942 & pack(array, .true.),
size(array), &
3943 & history = history, &
3947 & difftime = difftime, &
3949 & time_average_store = &
3950 & time_average_store, &
3955 & history, range, time, quiet, &
3956 & difftime, timed, time_average_store, err )
3964 character(*),
intent(in):: varname
3965 real,
intent(in):: array(:,:,:,:,:,:)
3966 type(
gt_history),
intent(inout),
optional,
target:: history
3967 character(*),
intent(in),
optional:: range
3968 real,
intent(in),
optional:: time
3969 logical,
intent(in),
optional:: quiet
3970 type(
dc_difftime),
intent(in),
optional:: difftime
3971 real(DP),
intent(in),
optional:: timed
3972 logical,
intent(in),
optional:: time_average_store
3973 logical,
intent(out),
optional:: err
3976 & varname, array, arraysize, history, range, &
3977 & time, quiet, difftime, timed, time_average_store, err )
3981 character(*),
intent(in):: varname
3982 integer,
intent(in):: arraysize
3983 real,
intent(in):: array(arraysize)
3984 type(
gt_history),
intent(inout),
target,
optional:: history
3985 character(*),
intent(in),
optional:: range
3986 real,
intent(in),
optional:: time
3987 logical,
intent(in),
optional:: quiet
3988 type(
dc_difftime),
intent(in),
optional:: difftime
3989 real(DP),
intent(in),
optional:: timed
3990 logical,
intent(in),
optional:: time_average_store
3991 logical,
intent(out),
optional:: err
3994 character(*),
parameter:: subname =
"HistoryPutReal6"
3999 & pack(array, .true.),
size(array), &
4000 & history = history, &
4004 & difftime = difftime, &
4006 & time_average_store = &
4007 & time_average_store, &
4012 & history, range, time, quiet, &
4013 & difftime, timed, time_average_store, err )
4021 character(*),
intent(in):: varname
4022 real,
intent(in):: array(:,:,:,:,:,:,:)
4023 type(
gt_history),
intent(inout),
optional,
target:: history
4024 character(*),
intent(in),
optional:: range
4025 real,
intent(in),
optional:: time
4026 logical,
intent(in),
optional:: quiet
4027 type(
dc_difftime),
intent(in),
optional:: difftime
4028 real(DP),
intent(in),
optional:: timed
4029 logical,
intent(in),
optional:: time_average_store
4030 logical,
intent(out),
optional:: err
4033 & varname, array, arraysize, history, range, &
4034 & time, quiet, difftime, timed, time_average_store, err )
4038 character(*),
intent(in):: varname
4039 integer,
intent(in):: arraysize
4040 real,
intent(in):: array(arraysize)
4041 type(
gt_history),
intent(inout),
target,
optional:: history
4042 character(*),
intent(in),
optional:: range
4043 real,
intent(in),
optional:: time
4044 logical,
intent(in),
optional:: quiet
4045 type(
dc_difftime),
intent(in),
optional:: difftime
4046 real(DP),
intent(in),
optional:: timed
4047 logical,
intent(in),
optional:: time_average_store
4048 logical,
intent(out),
optional:: err
4051 character(*),
parameter:: subname =
"HistoryPutReal7"
4056 & pack(array, .true.),
size(array), &
4057 & history = history, &
4061 & difftime = difftime, &
4063 & time_average_store = &
4064 & time_average_store, &
4069 & history, range, time, quiet, &
4070 & difftime, timed, time_average_store, err )
4078 character(*),
intent(in):: varname
4079 integer,
intent(in):: value
4080 type(
gt_history),
intent(inout),
optional,
target:: history
4081 character(*),
intent(in),
optional:: range
4082 real,
intent(in),
optional:: time
4083 logical,
intent(in),
optional:: quiet
4084 type(
dc_difftime),
intent(in),
optional:: difftime
4085 real(DP),
intent(in),
optional:: timed
4086 logical,
intent(in),
optional:: time_average_store
4087 logical,
intent(out),
optional:: err
4090 & varname, array, arraysize, history, range, &
4091 & time, quiet, difftime, timed, time_average_store, err )
4095 character(*),
intent(in):: varname
4096 integer,
intent(in):: arraysize
4097 integer,
intent(in):: array(arraysize)
4098 type(
gt_history),
intent(inout),
target,
optional:: history
4099 character(*),
intent(in),
optional:: range
4100 real,
intent(in),
optional:: time
4101 logical,
intent(in),
optional:: quiet
4102 type(
dc_difftime),
intent(in),
optional:: difftime
4103 real(DP),
intent(in),
optional:: timed
4104 logical,
intent(in),
optional:: time_average_store
4105 logical,
intent(out),
optional:: err
4108 character(*),
parameter:: subname =
"HistoryPutInt0"
4114 & history = history, &
4118 & difftime = difftime, &
4120 & time_average_store = &
4121 & time_average_store, &
4126 & history, range, time, quiet, &
4127 & difftime, timed, time_average_store, err )
4135 character(*),
intent(in):: varname
4136 integer,
intent(in):: array(:)
4137 type(
gt_history),
intent(inout),
optional,
target:: history
4138 character(*),
intent(in),
optional:: range
4139 real,
intent(in),
optional:: time
4140 logical,
intent(in),
optional:: quiet
4141 type(
dc_difftime),
intent(in),
optional:: difftime
4142 real(DP),
intent(in),
optional:: timed
4143 logical,
intent(in),
optional:: time_average_store
4144 logical,
intent(out),
optional:: err
4147 & varname, array, arraysize, history, range, &
4148 & time, quiet, difftime, timed, time_average_store, err )
4152 character(*),
intent(in):: varname
4153 integer,
intent(in):: arraysize
4154 integer,
intent(in):: array(arraysize)
4155 type(
gt_history),
intent(inout),
target,
optional:: history
4156 character(*),
intent(in),
optional:: range
4157 real,
intent(in),
optional:: time
4158 logical,
intent(in),
optional:: quiet
4159 type(
dc_difftime),
intent(in),
optional:: difftime
4160 real(DP),
intent(in),
optional:: timed
4161 logical,
intent(in),
optional:: time_average_store
4162 logical,
intent(out),
optional:: err
4165 character(*),
parameter:: subname =
"HistoryPutInt1"
4170 & pack(array, .true.),
size(array), &
4171 & history = history, &
4175 & difftime = difftime, &
4177 & time_average_store = &
4178 & time_average_store, &
4183 & history, range, time, quiet, &
4184 & difftime, timed, time_average_store, err )
4192 character(*),
intent(in):: varname
4193 integer,
intent(in):: array(:,:)
4194 type(
gt_history),
intent(inout),
optional,
target:: history
4195 character(*),
intent(in),
optional:: range
4196 real,
intent(in),
optional:: time
4197 logical,
intent(in),
optional:: quiet
4198 type(
dc_difftime),
intent(in),
optional:: difftime
4199 real(DP),
intent(in),
optional:: timed
4200 logical,
intent(in),
optional:: time_average_store
4201 logical,
intent(out),
optional:: err
4204 & varname, array, arraysize, history, range, &
4205 & time, quiet, difftime, timed, time_average_store, err )
4209 character(*),
intent(in):: varname
4210 integer,
intent(in):: arraysize
4211 integer,
intent(in):: array(arraysize)
4212 type(
gt_history),
intent(inout),
target,
optional:: history
4213 character(*),
intent(in),
optional:: range
4214 real,
intent(in),
optional:: time
4215 logical,
intent(in),
optional:: quiet
4216 type(
dc_difftime),
intent(in),
optional:: difftime
4217 real(DP),
intent(in),
optional:: timed
4218 logical,
intent(in),
optional:: time_average_store
4219 logical,
intent(out),
optional:: err
4222 character(*),
parameter:: subname =
"HistoryPutInt2"
4227 & pack(array, .true.),
size(array), &
4228 & history = history, &
4232 & difftime = difftime, &
4234 & time_average_store = &
4235 & time_average_store, &
4240 & history, range, time, quiet, &
4241 & difftime, timed, time_average_store, err )
4249 character(*),
intent(in):: varname
4250 integer,
intent(in):: array(:,:,:)
4251 type(
gt_history),
intent(inout),
optional,
target:: history
4252 character(*),
intent(in),
optional:: range
4253 real,
intent(in),
optional:: time
4254 logical,
intent(in),
optional:: quiet
4255 type(
dc_difftime),
intent(in),
optional:: difftime
4256 real(DP),
intent(in),
optional:: timed
4257 logical,
intent(in),
optional:: time_average_store
4258 logical,
intent(out),
optional:: err
4261 & varname, array, arraysize, history, range, &
4262 & time, quiet, difftime, timed, time_average_store, err )
4266 character(*),
intent(in):: varname
4267 integer,
intent(in):: arraysize
4268 integer,
intent(in):: array(arraysize)
4269 type(
gt_history),
intent(inout),
target,
optional:: history
4270 character(*),
intent(in),
optional:: range
4271 real,
intent(in),
optional:: time
4272 logical,
intent(in),
optional:: quiet
4273 type(
dc_difftime),
intent(in),
optional:: difftime
4274 real(DP),
intent(in),
optional:: timed
4275 logical,
intent(in),
optional:: time_average_store
4276 logical,
intent(out),
optional:: err
4279 character(*),
parameter:: subname =
"HistoryPutInt3"
4284 & pack(array, .true.),
size(array), &
4285 & history = history, &
4289 & difftime = difftime, &
4291 & time_average_store = &
4292 & time_average_store, &
4297 & history, range, time, quiet, &
4298 & difftime, timed, time_average_store, err )
4306 character(*),
intent(in):: varname
4307 integer,
intent(in):: array(:,:,:,:)
4308 type(
gt_history),
intent(inout),
optional,
target:: history
4309 character(*),
intent(in),
optional:: range
4310 real,
intent(in),
optional:: time
4311 logical,
intent(in),
optional:: quiet
4312 type(
dc_difftime),
intent(in),
optional:: difftime
4313 real(DP),
intent(in),
optional:: timed
4314 logical,
intent(in),
optional:: time_average_store
4315 logical,
intent(out),
optional:: err
4318 & varname, array, arraysize, history, range, &
4319 & time, quiet, difftime, timed, time_average_store, err )
4323 character(*),
intent(in):: varname
4324 integer,
intent(in):: arraysize
4325 integer,
intent(in):: array(arraysize)
4326 type(
gt_history),
intent(inout),
target,
optional:: history
4327 character(*),
intent(in),
optional:: range
4328 real,
intent(in),
optional:: time
4329 logical,
intent(in),
optional:: quiet
4330 type(
dc_difftime),
intent(in),
optional:: difftime
4331 real(DP),
intent(in),
optional:: timed
4332 logical,
intent(in),
optional:: time_average_store
4333 logical,
intent(out),
optional:: err
4336 character(*),
parameter:: subname =
"HistoryPutInt4"
4341 & pack(array, .true.),
size(array), &
4342 & history = history, &
4346 & difftime = difftime, &
4348 & time_average_store = &
4349 & time_average_store, &
4354 & history, range, time, quiet, &
4355 & difftime, timed, time_average_store, err )
4363 character(*),
intent(in):: varname
4364 integer,
intent(in):: array(:,:,:,:,:)
4365 type(
gt_history),
intent(inout),
optional,
target:: history
4366 character(*),
intent(in),
optional:: range
4367 real,
intent(in),
optional:: time
4368 logical,
intent(in),
optional:: quiet
4369 type(
dc_difftime),
intent(in),
optional:: difftime
4370 real(DP),
intent(in),
optional:: timed
4371 logical,
intent(in),
optional:: time_average_store
4372 logical,
intent(out),
optional:: err
4375 & varname, array, arraysize, history, range, &
4376 & time, quiet, difftime, timed, time_average_store, err )
4380 character(*),
intent(in):: varname
4381 integer,
intent(in):: arraysize
4382 integer,
intent(in):: array(arraysize)
4383 type(
gt_history),
intent(inout),
target,
optional:: history
4384 character(*),
intent(in),
optional:: range
4385 real,
intent(in),
optional:: time
4386 logical,
intent(in),
optional:: quiet
4387 type(
dc_difftime),
intent(in),
optional:: difftime
4388 real(DP),
intent(in),
optional:: timed
4389 logical,
intent(in),
optional:: time_average_store
4390 logical,
intent(out),
optional:: err
4393 character(*),
parameter:: subname =
"HistoryPutInt5"
4398 & pack(array, .true.),
size(array), &
4399 & history = history, &
4403 & difftime = difftime, &
4405 & time_average_store = &
4406 & time_average_store, &
4411 & history, range, time, quiet, &
4412 & difftime, timed, time_average_store, err )
4420 character(*),
intent(in):: varname
4421 integer,
intent(in):: array(:,:,:,:,:,:)
4422 type(
gt_history),
intent(inout),
optional,
target:: history
4423 character(*),
intent(in),
optional:: range
4424 real,
intent(in),
optional:: time
4425 logical,
intent(in),
optional:: quiet
4426 type(
dc_difftime),
intent(in),
optional:: difftime
4427 real(DP),
intent(in),
optional:: timed
4428 logical,
intent(in),
optional:: time_average_store
4429 logical,
intent(out),
optional:: err
4432 & varname, array, arraysize, history, range, &
4433 & time, quiet, difftime, timed, time_average_store, err )
4437 character(*),
intent(in):: varname
4438 integer,
intent(in):: arraysize
4439 integer,
intent(in):: array(arraysize)
4440 type(
gt_history),
intent(inout),
target,
optional:: history
4441 character(*),
intent(in),
optional:: range
4442 real,
intent(in),
optional:: time
4443 logical,
intent(in),
optional:: quiet
4444 type(
dc_difftime),
intent(in),
optional:: difftime
4445 real(DP),
intent(in),
optional:: timed
4446 logical,
intent(in),
optional:: time_average_store
4447 logical,
intent(out),
optional:: err
4450 character(*),
parameter:: subname =
"HistoryPutInt6"
4455 & pack(array, .true.),
size(array), &
4456 & history = history, &
4460 & difftime = difftime, &
4462 & time_average_store = &
4463 & time_average_store, &
4468 & history, range, time, quiet, &
4469 & difftime, timed, time_average_store, err )
4477 character(*),
intent(in):: varname
4478 integer,
intent(in):: array(:,:,:,:,:,:,:)
4479 type(
gt_history),
intent(inout),
optional,
target:: history
4480 character(*),
intent(in),
optional:: range
4481 real,
intent(in),
optional:: time
4482 logical,
intent(in),
optional:: quiet
4483 type(
dc_difftime),
intent(in),
optional:: difftime
4484 real(DP),
intent(in),
optional:: timed
4485 logical,
intent(in),
optional:: time_average_store
4486 logical,
intent(out),
optional:: err
4489 & varname, array, arraysize, history, range, &
4490 & time, quiet, difftime, timed, time_average_store, err )
4494 character(*),
intent(in):: varname
4495 integer,
intent(in):: arraysize
4496 integer,
intent(in):: array(arraysize)
4497 type(
gt_history),
intent(inout),
target,
optional:: history
4498 character(*),
intent(in),
optional:: range
4499 real,
intent(in),
optional:: time
4500 logical,
intent(in),
optional:: quiet
4501 type(
dc_difftime),
intent(in),
optional:: difftime
4502 real(DP),
intent(in),
optional:: timed
4503 logical,
intent(in),
optional:: time_average_store
4504 logical,
intent(out),
optional:: err
4507 character(*),
parameter:: subname =
"HistoryPutInt7"
4512 & pack(array, .true.),
size(array), &
4513 & history = history, &
4517 & difftime = difftime, &
4519 & time_average_store = &
4520 & time_average_store, &
4525 & history, range, time, quiet, &
4526 & difftime, timed, time_average_store, err )
4534 character(*),
intent(in):: varname
4535 character(*),
intent(in):: value
4536 type(
gt_history),
intent(inout),
optional,
target:: history
4537 character(*),
intent(in),
optional:: range
4538 real,
intent(in),
optional:: time
4539 logical,
intent(in),
optional:: quiet
4540 type(
dc_difftime),
intent(in),
optional:: difftime
4541 real(DP),
intent(in),
optional:: timed
4542 logical,
intent(in),
optional:: time_average_store
4543 logical,
intent(out),
optional:: err
4546 & varname, array, arraysize, history, range, &
4547 & time, quiet, difftime, timed, time_average_store, err )
4551 character(*),
intent(in):: varname
4552 integer,
intent(in):: arraysize
4553 character(*),
intent(in):: array(arraysize)
4554 type(
gt_history),
intent(inout),
target,
optional:: history
4555 character(*),
intent(in),
optional:: range
4556 real,
intent(in),
optional:: time
4557 logical,
intent(in),
optional:: quiet
4558 type(
dc_difftime),
intent(in),
optional:: difftime
4559 real(DP),
intent(in),
optional:: timed
4560 logical,
intent(in),
optional:: time_average_store
4561 logical,
intent(out),
optional:: err
4564 character(*),
parameter:: subname =
"HistoryPutChar0"
4570 & history = history, &
4574 & difftime = difftime, &
4576 & time_average_store = &
4577 & time_average_store, &
4609 use,non_intrinsic ::
dc_date_generic, only: evalbyunit,
operator(+),
operator(*), &
4614 character(len = *),
intent(in) :: varname
4616 real,
intent(in):: head
4617 type(
gt_history),
intent(inout),
optional,
target:: history
4618 logical,
intent(out),
optional :: err
4622 real,
pointer:: time(:) =>null()
4625 integer:: timestart, rest
4630 character(STRING):: cause_c, subname_r
4631 character(*),
parameter:: subname =
"TimeGoAhead"
4633 call beginsub(subname,
'varname=%c head=%r', &
4634 & c1=trim(varname), r=(/head/))
4638 if (
present(history))
then
4647 if (v_ord == 0)
goto 1000
4649 if (hst % growable_indices(v_ord) == 0)
then
4652 if (hst % dim_value_written(hst % unlimited_index))
then
4658 call slice(var, hst % growable_indices(v_ord), &
4659 & start=hst % count(1), count=1)
4667 hst % count(v_ord) = hst % count(v_ord) + 1
4668 call slice(var, hst % growable_indices(v_ord), &
4669 & start=hst % count(v_ord), count=1)
4677 timevar = hst % dimvars(hst % unlimited_index)
4678 call get_slice(timevar, 1, start=timestart)
4679 call dbgmessage(
'map(timevar)start is <%d>. map(%c)start is <%d>', &
4680 & i=(/timestart, hst % count(v_ord)/), &
4681 & c1=trim(varname) )
4682 call get(timevar, time, get_err)
4683 call dbgmessage(
'time(%d)=<%*r>, err=<%b>', &
4684 & i=(/
size(time)/), r=(/time(:)/), &
4685 & l=(/get_err/), n=(/
size(time)/) )
4686 if (get_err .or. hst % count(v_ord) == 1 .and. timestart == 1)
then
4692 call slice(timevar, 1, start=1, count=1)
4693 curtime = hst % origin
4695 call put(timevar, (/curtime/), 1)
4696 elseif (hst % count(v_ord) > timestart)
then
4702 rest = timestart + 1
4704 call slice(timevar, 1, start=rest, count=1)
4705 curtime = hst % origin + hst % interval * (rest - 1)
4709 call put(timevar, (/curtime/), 1 )
4711 if ( rest > hst % count(v_ord) )
exit
4728 if (d_ord == 0)
then
4729 subname_r =
'HistoryPut'
4731 cause_c =
'varname="' // trim(varname) //
'" is not found'
4734 hst % dim_value_written(d_ord) = .true.
4735 if (d_ord /= hst % unlimited_index)
then
4741 hst % count(:) = maxval(hst % count(:)) + 1
4746 call slice(var, 1, start=hst % count(1), count=1)
4748 call storeerror(stat, trim(subname_r), err, cause_c)
subroutine dcdifftimeputline(diff, unit, indent)
subroutine historyputint7(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputreal7(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputint6(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputreal3(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble1(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble0(varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
データ出力
recursive subroutine historyputdoubleex(varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
データ出力
recursive subroutine historyputcharex(varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
データ出力
recursive subroutine historyputrealex(varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
データ出力
subroutine historyputdouble5(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble6(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputaxismpiint(varname, array, history, err)
subroutine historyputreal4(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputaxismpireal(varname, array, history, err)
subroutine historyputreal5(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputreal6(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble4(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputint1(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
recursive subroutine historyputintex(varname, array, arraysize, history, range, time, quiet, difftime, timed, time_average_store, err)
データ出力
subroutine historyputint0(varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputint4(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputreal1(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputaxismpidouble(varname, array, history, err)
subroutine historyputreal2(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble3(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble7(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputint3(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputint2(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputreal0(varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputdouble2(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine timegoahead(varname, var, head, history, err)
subroutine historyputint5(varname, array, history, range, time, quiet, difftime, timed, time_average_store, err)
subroutine historyputchar0(varname, value, history, range, time, quiet, difftime, timed, time_average_store, err)
Interface declarations for procedures provided from dc_date.
Derived types and parameters for date and time.
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public usr_errno
-1000 or less: User-defined errors
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public dc_enotinit
-400 or less: DC utilities errors
integer, parameter, public dc_earglack
integer, parameter, public gt_ebaddimname
integer, parameter, public gt_eargsizemismatch
Judge optional control parameters.
logical function, public present_and_false(arg)
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
Handling character types.
character(string) function, public joinchar(carray, expr)
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string
real(dp), parameter, public dp_eps
Machine epsilon for dobule precision real number.
Variable URL string parser.
type(gt_history), target, save, public default