gtool5 Fortran 90/95 ライブラリ 1.0.0-rc5
English
Loading...
Searching...
No Matches
historyget.f90
Go to the documentation of this file.
1! -*- coding: utf-8; mode: f90 -*-
2!-------------------------------------------------------------------------------------
3! Copyright (c) 2000-2026 Gtool Development Group. All rights reserved.
4!-------------------------------------------------------------------------------------
5! ** Important**
6!
7! This file is generated from ../../../../../src/gtool/gtool_history/historyget.erb by ERB included Ruby 3.3.8.
8! Please do not edit this file directly. @see "../../../../../src/gtool/gtool_history/historyget.erb"
9!-------------------------------------------------------------------------------------
30 !
91subroutine historygetdouble0(file, varname, array, range, &
92 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
93 use gtdata_types, only: gt_variable
94 use gtdata_generic, only: open, inquire, close, get
95 use dc_string, only: tochar
97 use dc_regex, only: match
98 use dc_types, only: string, dp
99 use dc_message, only: messagenotify
101 implicit none
102 character(*), intent(in):: file
103 character(*), intent(in):: varname
104 character(*), intent(in), optional:: range
105 logical, intent(in), optional:: quiet
106 logical, intent(in), optional:: flag_mpi_split
107 real(DP), intent(out), optional:: returned_time ! データの時刻
108 logical, intent(out), optional:: flag_time_exist
109 logical, intent(out), optional:: err
110 real(DP), intent(out) :: array
111 real(DP) :: array_tmp(1)
112 type(gt_variable):: var
113 character(STRING):: file_work, url, actual_url
114 integer:: rank, alldims, array_rank
115 integer:: domain
116 character(STRING):: tname
117 integer:: stat
118 character(STRING):: cause_c
119 character(*), parameter :: subname = "HistoryGetDouble0"
120 interface
121 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
122 character(*), intent(in):: file
123 character(*), intent(in):: varname
124 character(*), intent(out):: url
125 character(*), intent(in), optional:: range
126 logical, intent(out), optional:: flag_time_exist
127 character(*), intent(out), optional:: time_name
128 logical, intent(out), optional:: err
129 end subroutine lookup_growable_url
130 end interface
131 interface
132 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
133 use dc_types, only: dp
134 character(*), intent(in) :: url ! 変数 URL
135 character(*), intent(out), optional :: actual_url
136 ! 正確な入出力範囲指定
137 real(DP), intent(out), optional:: returned_time ! データの時刻
138 character(*), intent(in), optional:: time_name ! 時刻次元の名称
139 logical, intent(out), optional :: err ! エラーのフラグ
140 end subroutine actual_iorange_dump
141 end interface
142 interface
143 function file_rename_mpi( file ) result(result)
144 use dc_types, only: string
145 character(*), intent(in):: file
146 character(STRING):: result
147 end function file_rename_mpi
148 end interface
149 continue
150 cause_c = ''
151 stat = dc_noerr
152 file_work = file
153 ! ファイル名の変更 (MPI 用)
154 ! Change filename (for MPI)
155 !
156 if ( present_and_true( flag_mpi_split ) ) &
157 & file_work = file_rename_mpi( file_work )
158 ! 最新時刻の URL 取得
159 ! Get URL of latest time
160 !
161 call lookup_growable_url(file_work, varname, url, range, &
162 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
163 if ( present_and_true(err) ) then
164 stat = gt_enoturl
165 cause_c = url
166 goto 999
167 end if
168 ! ファイルオープン
169 ! File open
170 call open( var, url, err = err )
171 if ( present_and_true(err) ) then
172 stat = gt_enoturl
173 cause_c = url
174 goto 999
175 end if
176 !-------------------------------------------------------------------
177 ! 配列形状のチェック
178 ! Check array shape
179 !-------------------------------------------------------------------
180 ! 入力ファイル中のデータの次元数
181 ! Get size of dimesions in data of an input file
182 !
183 call inquire( var = var, & ! (in)
184 & rank = rank, alldims = alldims ) ! (out)
185 ! 引数の次元数のチェック (縮退されている場合には減らす)
186 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
187 array_rank = 0
188 ! 次元数の比較
189 ! Compare sizes of dimensions
190 !
191 if ( .not. 0 == rank .and. .not. array_rank == rank ) then
192 if ( .not. present_and_true(quiet) ) then
193 call messagenotify('W', subname, &
194 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
195 & i = (/rank, 0/), c1 = trim(url) )
196 end if
197 stat = gt_erankmismatch
198 cause_c = 'array'
199 goto 999
200 end if
201 ! 入力ファイル中のデータの配列形状取得
202 ! Get shape of data in an input file
203 !-------------------------------------
204 ! データ取得
205 ! Get data
206 call inquire( var = var, & ! (in)
207 & size = domain ) ! (out)
208 call get( var = var, & ! (inout)
209 & nvalue = domain, & ! (in)
210 & value = array_tmp) ! (out)
211 array = array_tmp(1)
212 call close( var )
213 !-------------------------------------
214 ! データファイル名と切り出し範囲の印字
215 ! Print data filename and clipping range
216 call actual_iorange_dump(url, & ! (in)
217 & actual_url, returned_time, & ! (out) optional
218 & time_name = tname, & ! (in) optional
219 & err = err) ! (out) optional
220 if ( .not. present_and_true(quiet) ) then
221 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
222 end if
223999 continue
224 call storeerror(stat, subname, err, cause_c)
225end subroutine historygetdouble0
226subroutine historygetdouble1(file, varname, array, range, &
227 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
228 use gtdata_types, only: gt_variable
229 use gtdata_generic, only: open, inquire, close, get
230 use dc_string, only: tochar
232 use dc_regex, only: match
233 use dc_types, only: string, dp
234 use dc_message, only: messagenotify
237 implicit none
238 character(*), intent(in):: file
239 character(*), intent(in):: varname
240 character(*), intent(in), optional:: range
241 logical, intent(in), optional:: quiet
242 logical, intent(in), optional:: flag_mpi_split
243 real(DP), intent(out), optional:: returned_time ! データの時刻
244 logical, intent(out), optional:: flag_time_exist
245 logical, intent(out), optional:: err
246 real(DP), intent(out) :: array(:)
247 real(DP), allocatable :: array_tmp(:)
248 integer:: array_allsize
249 integer:: array_shape(1), data_shape(1), array_shape_check(1)
250 integer:: allcount
251 logical:: inq_err
252 type(gt_variable):: var
253 character(STRING):: file_work, url, actual_url
254 integer:: rank, alldims, array_rank
255 integer:: domain
256 character(STRING):: tname
257 integer:: stat
258 character(STRING):: cause_c
259 character(*), parameter :: subname = "HistoryGetDouble1"
260 interface
261 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
262 character(*), intent(in):: file
263 character(*), intent(in):: varname
264 character(*), intent(out):: url
265 character(*), intent(in), optional:: range
266 logical, intent(out), optional:: flag_time_exist
267 character(*), intent(out), optional:: time_name
268 logical, intent(out), optional:: err
269 end subroutine lookup_growable_url
270 end interface
271 interface
272 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
273 use dc_types, only: dp
274 character(*), intent(in) :: url ! 変数 URL
275 character(*), intent(out), optional :: actual_url
276 ! 正確な入出力範囲指定
277 real(DP), intent(out), optional:: returned_time ! データの時刻
278 character(*), intent(in), optional:: time_name ! 時刻次元の名称
279 logical, intent(out), optional :: err ! エラーのフラグ
280 end subroutine actual_iorange_dump
281 end interface
282 interface
283 function file_rename_mpi( file ) result(result)
284 use dc_types, only: string
285 character(*), intent(in):: file
286 character(STRING):: result
287 end function file_rename_mpi
288 end interface
289 continue
290 cause_c = ''
291 stat = dc_noerr
292 file_work = file
293 array_shape = shape( array )
294 array_allsize = size( array )
295 ! ファイル名の変更 (MPI 用)
296 ! Change filename (for MPI)
297 !
298 if ( present_and_true( flag_mpi_split ) ) &
299 & file_work = file_rename_mpi( file_work )
300 ! 最新時刻の URL 取得
301 ! Get URL of latest time
302 !
303 call lookup_growable_url(file_work, varname, url, range, &
304 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
305 if ( present_and_true(err) ) then
306 stat = gt_enoturl
307 cause_c = url
308 goto 999
309 end if
310 ! ファイルオープン
311 ! File open
312 call open( var, url, err = err )
313 if ( present_and_true(err) ) then
314 stat = gt_enoturl
315 cause_c = url
316 goto 999
317 end if
318 !-------------------------------------------------------------------
319 ! 配列形状のチェック
320 ! Check array shape
321 !-------------------------------------------------------------------
322 ! 入力ファイル中のデータの次元数
323 ! Get size of dimesions in data of an input file
324 !
325 call inquire( var = var, & ! (in)
326 & rank = rank, alldims = alldims ) ! (out)
327 ! 引数の次元数のチェック (縮退されている場合には減らす)
328 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
329 array_rank = 1
330 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
331 ! 次元数の比較
332 ! Compare sizes of dimensions
333 !
334 if ( .not. 1 == rank .and. .not. array_rank == rank ) then
335 if ( .not. present_and_true(quiet) ) then
336 call messagenotify('W', subname, &
337 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
338 & i = (/rank, 1/), c1 = trim(url) )
339 end if
340 stat = gt_erankmismatch
341 cause_c = 'array'
342 goto 999
343 end if
344 ! 入力ファイル中のデータの配列形状取得
345 ! Get shape of data in an input file
346 call inquire( var = var , dimord = 1, & ! (in)
347 & allcount = allcount, err = inq_err ) ! (out)
348 if ( .not. inq_err ) then
349 data_shape(1) = allcount
350 else
351 data_shape(1) = 1
352 end if
353 ! 引数の配列形状整形
354 ! Arrange shape of an argument
355 !
356 array_shape_check = array_shape
357 ! 配列形状の比較
358 ! Compare shapes
359 !
360 if ( .not. all( array_shape_check == data_shape ) ) then
361 if ( .not. present_and_true(quiet) ) then
362 call messagenotify('W', subname, &
363 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
364 & c1 = trim( url ), &
365 & c2 = trim( tochar( data_shape(1:rank) ) ), &
366 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
367 end if
369 cause_c = 'array'
370 goto 999
371 end if
372 !-------------------------------------
373 ! データ取得
374 ! Get data
375 call inquire( var = var, & ! (in)
376 & size = domain ) ! (out)
377 if ( allocated( array_tmp ) ) deallocate( array_tmp )
378 allocate( array_tmp(array_allsize) )
379 call get( var, array_tmp, domain )
380 array = reshape( array_tmp, array_shape )
381 deallocate( array_tmp )
382 call close( var )
383 !-------------------------------------
384 ! データファイル名と切り出し範囲の印字
385 ! Print data filename and clipping range
386 call actual_iorange_dump(url, & ! (in)
387 & actual_url, returned_time, & ! (out) optional
388 & time_name = tname, & ! (in) optional
389 & err = err) ! (out) optional
390 if ( .not. present_and_true(quiet) ) then
391 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
392 end if
393999 continue
394 call storeerror(stat, subname, err, cause_c)
395end subroutine historygetdouble1
396subroutine historygetdouble2(file, varname, array, range, &
397 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
398 use gtdata_types, only: gt_variable
399 use gtdata_generic, only: open, inquire, close, get
400 use dc_string, only: tochar
402 use dc_regex, only: match
403 use dc_types, only: string, dp
404 use dc_message, only: messagenotify
407 implicit none
408 character(*), intent(in):: file
409 character(*), intent(in):: varname
410 character(*), intent(in), optional:: range
411 logical, intent(in), optional:: quiet
412 logical, intent(in), optional:: flag_mpi_split
413 real(DP), intent(out), optional:: returned_time ! データの時刻
414 logical, intent(out), optional:: flag_time_exist
415 logical, intent(out), optional:: err
416 real(DP), intent(out) :: array(:,:)
417 real(DP), allocatable :: array_tmp(:)
418 integer:: array_allsize
419 integer:: array_shape(2), data_shape(2), array_shape_check(2)
420 integer:: allcount
421 integer:: i, sd
422 logical:: inq_err
423 type(gt_variable):: var
424 character(STRING):: file_work, url, actual_url
425 integer:: rank, alldims, array_rank
426 integer:: domain
427 character(STRING):: tname
428 integer:: stat
429 character(STRING):: cause_c
430 character(*), parameter :: subname = "HistoryGetDouble2"
431 interface
432 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
433 character(*), intent(in):: file
434 character(*), intent(in):: varname
435 character(*), intent(out):: url
436 character(*), intent(in), optional:: range
437 logical, intent(out), optional:: flag_time_exist
438 character(*), intent(out), optional:: time_name
439 logical, intent(out), optional:: err
440 end subroutine lookup_growable_url
441 end interface
442 interface
443 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
444 use dc_types, only: dp
445 character(*), intent(in) :: url ! 変数 URL
446 character(*), intent(out), optional :: actual_url
447 ! 正確な入出力範囲指定
448 real(DP), intent(out), optional:: returned_time ! データの時刻
449 character(*), intent(in), optional:: time_name ! 時刻次元の名称
450 logical, intent(out), optional :: err ! エラーのフラグ
451 end subroutine actual_iorange_dump
452 end interface
453 interface
454 function file_rename_mpi( file ) result(result)
455 use dc_types, only: string
456 character(*), intent(in):: file
457 character(STRING):: result
458 end function file_rename_mpi
459 end interface
460 continue
461 cause_c = ''
462 stat = dc_noerr
463 file_work = file
464 array_shape = shape( array )
465 array_allsize = size( array )
466 ! ファイル名の変更 (MPI 用)
467 ! Change filename (for MPI)
468 !
469 if ( present_and_true( flag_mpi_split ) ) &
470 & file_work = file_rename_mpi( file_work )
471 ! 最新時刻の URL 取得
472 ! Get URL of latest time
473 !
474 call lookup_growable_url(file_work, varname, url, range, &
475 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
476 if ( present_and_true(err) ) then
477 stat = gt_enoturl
478 cause_c = url
479 goto 999
480 end if
481 ! ファイルオープン
482 ! File open
483 call open( var, url, err = err )
484 if ( present_and_true(err) ) then
485 stat = gt_enoturl
486 cause_c = url
487 goto 999
488 end if
489 !-------------------------------------------------------------------
490 ! 配列形状のチェック
491 ! Check array shape
492 !-------------------------------------------------------------------
493 ! 入力ファイル中のデータの次元数
494 ! Get size of dimesions in data of an input file
495 !
496 call inquire( var = var, & ! (in)
497 & rank = rank, alldims = alldims ) ! (out)
498 ! 引数の次元数のチェック (縮退されている場合には減らす)
499 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
500 array_rank = 2
501 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
502 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
503 ! 次元数の比較
504 ! Compare sizes of dimensions
505 !
506 if ( .not. 2 == rank .and. .not. array_rank == rank ) then
507 if ( .not. present_and_true(quiet) ) then
508 call messagenotify('W', subname, &
509 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
510 & i = (/rank, 2/), c1 = trim(url) )
511 end if
512 stat = gt_erankmismatch
513 cause_c = 'array'
514 goto 999
515 end if
516 ! 入力ファイル中のデータの配列形状取得
517 ! Get shape of data in an input file
518 call inquire( var = var , dimord = 1, & ! (in)
519 & allcount = allcount, err = inq_err ) ! (out)
520 if ( .not. inq_err ) then
521 data_shape(1) = allcount
522 else
523 data_shape(1) = 1
524 end if
525 call inquire( var = var , dimord = 2, & ! (in)
526 & allcount = allcount, err = inq_err ) ! (out)
527 if ( .not. inq_err ) then
528 data_shape(2) = allcount
529 else
530 data_shape(2) = 1
531 end if
532 ! 引数の配列形状整形
533 ! Arrange shape of an argument
534 !
535 array_shape_check = array_shape
536 sd = 1
537 do i = 1, 2 - 1
538 if ( array_shape_check(sd) == 1 ) then
539 array_shape_check(sd:2) = cshift( array_shape_check(sd:2), 1, 1 )
540 else
541 sd = sd + 1
542 end if
543 end do
544 ! 配列形状の比較
545 ! Compare shapes
546 !
547 if ( .not. all( array_shape_check == data_shape ) ) then
548 if ( .not. present_and_true(quiet) ) then
549 call messagenotify('W', subname, &
550 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
551 & c1 = trim( url ), &
552 & c2 = trim( tochar( data_shape(1:rank) ) ), &
553 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
554 end if
556 cause_c = 'array'
557 goto 999
558 end if
559 !-------------------------------------
560 ! データ取得
561 ! Get data
562 call inquire( var = var, & ! (in)
563 & size = domain ) ! (out)
564 if ( allocated( array_tmp ) ) deallocate( array_tmp )
565 allocate( array_tmp(array_allsize) )
566 call get( var, array_tmp, domain )
567 array = reshape( array_tmp, array_shape )
568 deallocate( array_tmp )
569 call close( var )
570 !-------------------------------------
571 ! データファイル名と切り出し範囲の印字
572 ! Print data filename and clipping range
573 call actual_iorange_dump(url, & ! (in)
574 & actual_url, returned_time, & ! (out) optional
575 & time_name = tname, & ! (in) optional
576 & err = err) ! (out) optional
577 if ( .not. present_and_true(quiet) ) then
578 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
579 end if
580999 continue
581 call storeerror(stat, subname, err, cause_c)
582end subroutine historygetdouble2
583subroutine historygetdouble3(file, varname, array, range, &
584 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
585 use gtdata_types, only: gt_variable
586 use gtdata_generic, only: open, inquire, close, get
587 use dc_string, only: tochar
589 use dc_regex, only: match
590 use dc_types, only: string, dp
591 use dc_message, only: messagenotify
594 implicit none
595 character(*), intent(in):: file
596 character(*), intent(in):: varname
597 character(*), intent(in), optional:: range
598 logical, intent(in), optional:: quiet
599 logical, intent(in), optional:: flag_mpi_split
600 real(DP), intent(out), optional:: returned_time ! データの時刻
601 logical, intent(out), optional:: flag_time_exist
602 logical, intent(out), optional:: err
603 real(DP), intent(out) :: array(:,:,:)
604 real(DP), allocatable :: array_tmp(:)
605 integer:: array_allsize
606 integer:: array_shape(3), data_shape(3), array_shape_check(3)
607 integer:: allcount
608 integer:: i, sd
609 logical:: inq_err
610 type(gt_variable):: var
611 character(STRING):: file_work, url, actual_url
612 integer:: rank, alldims, array_rank
613 integer:: domain
614 character(STRING):: tname
615 integer:: stat
616 character(STRING):: cause_c
617 character(*), parameter :: subname = "HistoryGetDouble3"
618 interface
619 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
620 character(*), intent(in):: file
621 character(*), intent(in):: varname
622 character(*), intent(out):: url
623 character(*), intent(in), optional:: range
624 logical, intent(out), optional:: flag_time_exist
625 character(*), intent(out), optional:: time_name
626 logical, intent(out), optional:: err
627 end subroutine lookup_growable_url
628 end interface
629 interface
630 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
631 use dc_types, only: dp
632 character(*), intent(in) :: url ! 変数 URL
633 character(*), intent(out), optional :: actual_url
634 ! 正確な入出力範囲指定
635 real(DP), intent(out), optional:: returned_time ! データの時刻
636 character(*), intent(in), optional:: time_name ! 時刻次元の名称
637 logical, intent(out), optional :: err ! エラーのフラグ
638 end subroutine actual_iorange_dump
639 end interface
640 interface
641 function file_rename_mpi( file ) result(result)
642 use dc_types, only: string
643 character(*), intent(in):: file
644 character(STRING):: result
645 end function file_rename_mpi
646 end interface
647 continue
648 cause_c = ''
649 stat = dc_noerr
650 file_work = file
651 array_shape = shape( array )
652 array_allsize = size( array )
653 ! ファイル名の変更 (MPI 用)
654 ! Change filename (for MPI)
655 !
656 if ( present_and_true( flag_mpi_split ) ) &
657 & file_work = file_rename_mpi( file_work )
658 ! 最新時刻の URL 取得
659 ! Get URL of latest time
660 !
661 call lookup_growable_url(file_work, varname, url, range, &
662 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
663 if ( present_and_true(err) ) then
664 stat = gt_enoturl
665 cause_c = url
666 goto 999
667 end if
668 ! ファイルオープン
669 ! File open
670 call open( var, url, err = err )
671 if ( present_and_true(err) ) then
672 stat = gt_enoturl
673 cause_c = url
674 goto 999
675 end if
676 !-------------------------------------------------------------------
677 ! 配列形状のチェック
678 ! Check array shape
679 !-------------------------------------------------------------------
680 ! 入力ファイル中のデータの次元数
681 ! Get size of dimesions in data of an input file
682 !
683 call inquire( var = var, & ! (in)
684 & rank = rank, alldims = alldims ) ! (out)
685 ! 引数の次元数のチェック (縮退されている場合には減らす)
686 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
687 array_rank = 3
688 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
689 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
690 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
691 ! 次元数の比較
692 ! Compare sizes of dimensions
693 !
694 if ( .not. 3 == rank .and. .not. array_rank == rank ) then
695 if ( .not. present_and_true(quiet) ) then
696 call messagenotify('W', subname, &
697 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
698 & i = (/rank, 3/), c1 = trim(url) )
699 end if
700 stat = gt_erankmismatch
701 cause_c = 'array'
702 goto 999
703 end if
704 ! 入力ファイル中のデータの配列形状取得
705 ! Get shape of data in an input file
706 call inquire( var = var , dimord = 1, & ! (in)
707 & allcount = allcount, err = inq_err ) ! (out)
708 if ( .not. inq_err ) then
709 data_shape(1) = allcount
710 else
711 data_shape(1) = 1
712 end if
713 call inquire( var = var , dimord = 2, & ! (in)
714 & allcount = allcount, err = inq_err ) ! (out)
715 if ( .not. inq_err ) then
716 data_shape(2) = allcount
717 else
718 data_shape(2) = 1
719 end if
720 call inquire( var = var , dimord = 3, & ! (in)
721 & allcount = allcount, err = inq_err ) ! (out)
722 if ( .not. inq_err ) then
723 data_shape(3) = allcount
724 else
725 data_shape(3) = 1
726 end if
727 ! 引数の配列形状整形
728 ! Arrange shape of an argument
729 !
730 array_shape_check = array_shape
731 sd = 1
732 do i = 1, 3 - 1
733 if ( array_shape_check(sd) == 1 ) then
734 array_shape_check(sd:3) = cshift( array_shape_check(sd:3), 1, 1 )
735 else
736 sd = sd + 1
737 end if
738 end do
739 ! 配列形状の比較
740 ! Compare shapes
741 !
742 if ( .not. all( array_shape_check == data_shape ) ) then
743 if ( .not. present_and_true(quiet) ) then
744 call messagenotify('W', subname, &
745 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
746 & c1 = trim( url ), &
747 & c2 = trim( tochar( data_shape(1:rank) ) ), &
748 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
749 end if
751 cause_c = 'array'
752 goto 999
753 end if
754 !-------------------------------------
755 ! データ取得
756 ! Get data
757 call inquire( var = var, & ! (in)
758 & size = domain ) ! (out)
759 if ( allocated( array_tmp ) ) deallocate( array_tmp )
760 allocate( array_tmp(array_allsize) )
761 call get( var, array_tmp, domain )
762 array = reshape( array_tmp, array_shape )
763 deallocate( array_tmp )
764 call close( var )
765 !-------------------------------------
766 ! データファイル名と切り出し範囲の印字
767 ! Print data filename and clipping range
768 call actual_iorange_dump(url, & ! (in)
769 & actual_url, returned_time, & ! (out) optional
770 & time_name = tname, & ! (in) optional
771 & err = err) ! (out) optional
772 if ( .not. present_and_true(quiet) ) then
773 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
774 end if
775999 continue
776 call storeerror(stat, subname, err, cause_c)
777end subroutine historygetdouble3
778subroutine historygetdouble4(file, varname, array, range, &
779 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
780 use gtdata_types, only: gt_variable
781 use gtdata_generic, only: open, inquire, close, get
782 use dc_string, only: tochar
784 use dc_regex, only: match
785 use dc_types, only: string, dp
786 use dc_message, only: messagenotify
789 implicit none
790 character(*), intent(in):: file
791 character(*), intent(in):: varname
792 character(*), intent(in), optional:: range
793 logical, intent(in), optional:: quiet
794 logical, intent(in), optional:: flag_mpi_split
795 real(DP), intent(out), optional:: returned_time ! データの時刻
796 logical, intent(out), optional:: flag_time_exist
797 logical, intent(out), optional:: err
798 real(DP), intent(out) :: array(:,:,:,:)
799 real(DP), allocatable :: array_tmp(:)
800 integer:: array_allsize
801 integer:: array_shape(4), data_shape(4), array_shape_check(4)
802 integer:: allcount
803 integer:: i, sd
804 logical:: inq_err
805 type(gt_variable):: var
806 character(STRING):: file_work, url, actual_url
807 integer:: rank, alldims, array_rank
808 integer:: domain
809 character(STRING):: tname
810 integer:: stat
811 character(STRING):: cause_c
812 character(*), parameter :: subname = "HistoryGetDouble4"
813 interface
814 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
815 character(*), intent(in):: file
816 character(*), intent(in):: varname
817 character(*), intent(out):: url
818 character(*), intent(in), optional:: range
819 logical, intent(out), optional:: flag_time_exist
820 character(*), intent(out), optional:: time_name
821 logical, intent(out), optional:: err
822 end subroutine lookup_growable_url
823 end interface
824 interface
825 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
826 use dc_types, only: dp
827 character(*), intent(in) :: url ! 変数 URL
828 character(*), intent(out), optional :: actual_url
829 ! 正確な入出力範囲指定
830 real(DP), intent(out), optional:: returned_time ! データの時刻
831 character(*), intent(in), optional:: time_name ! 時刻次元の名称
832 logical, intent(out), optional :: err ! エラーのフラグ
833 end subroutine actual_iorange_dump
834 end interface
835 interface
836 function file_rename_mpi( file ) result(result)
837 use dc_types, only: string
838 character(*), intent(in):: file
839 character(STRING):: result
840 end function file_rename_mpi
841 end interface
842 continue
843 cause_c = ''
844 stat = dc_noerr
845 file_work = file
846 array_shape = shape( array )
847 array_allsize = size( array )
848 ! ファイル名の変更 (MPI 用)
849 ! Change filename (for MPI)
850 !
851 if ( present_and_true( flag_mpi_split ) ) &
852 & file_work = file_rename_mpi( file_work )
853 ! 最新時刻の URL 取得
854 ! Get URL of latest time
855 !
856 call lookup_growable_url(file_work, varname, url, range, &
857 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
858 if ( present_and_true(err) ) then
859 stat = gt_enoturl
860 cause_c = url
861 goto 999
862 end if
863 ! ファイルオープン
864 ! File open
865 call open( var, url, err = err )
866 if ( present_and_true(err) ) then
867 stat = gt_enoturl
868 cause_c = url
869 goto 999
870 end if
871 !-------------------------------------------------------------------
872 ! 配列形状のチェック
873 ! Check array shape
874 !-------------------------------------------------------------------
875 ! 入力ファイル中のデータの次元数
876 ! Get size of dimesions in data of an input file
877 !
878 call inquire( var = var, & ! (in)
879 & rank = rank, alldims = alldims ) ! (out)
880 ! 引数の次元数のチェック (縮退されている場合には減らす)
881 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
882 array_rank = 4
883 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
884 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
885 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
886 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
887 ! 次元数の比較
888 ! Compare sizes of dimensions
889 !
890 if ( .not. 4 == rank .and. .not. array_rank == rank ) then
891 if ( .not. present_and_true(quiet) ) then
892 call messagenotify('W', subname, &
893 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
894 & i = (/rank, 4/), c1 = trim(url) )
895 end if
896 stat = gt_erankmismatch
897 cause_c = 'array'
898 goto 999
899 end if
900 ! 入力ファイル中のデータの配列形状取得
901 ! Get shape of data in an input file
902 call inquire( var = var , dimord = 1, & ! (in)
903 & allcount = allcount, err = inq_err ) ! (out)
904 if ( .not. inq_err ) then
905 data_shape(1) = allcount
906 else
907 data_shape(1) = 1
908 end if
909 call inquire( var = var , dimord = 2, & ! (in)
910 & allcount = allcount, err = inq_err ) ! (out)
911 if ( .not. inq_err ) then
912 data_shape(2) = allcount
913 else
914 data_shape(2) = 1
915 end if
916 call inquire( var = var , dimord = 3, & ! (in)
917 & allcount = allcount, err = inq_err ) ! (out)
918 if ( .not. inq_err ) then
919 data_shape(3) = allcount
920 else
921 data_shape(3) = 1
922 end if
923 call inquire( var = var , dimord = 4, & ! (in)
924 & allcount = allcount, err = inq_err ) ! (out)
925 if ( .not. inq_err ) then
926 data_shape(4) = allcount
927 else
928 data_shape(4) = 1
929 end if
930 ! 引数の配列形状整形
931 ! Arrange shape of an argument
932 !
933 array_shape_check = array_shape
934 sd = 1
935 do i = 1, 4 - 1
936 if ( array_shape_check(sd) == 1 ) then
937 array_shape_check(sd:4) = cshift( array_shape_check(sd:4), 1, 1 )
938 else
939 sd = sd + 1
940 end if
941 end do
942 ! 配列形状の比較
943 ! Compare shapes
944 !
945 if ( .not. all( array_shape_check == data_shape ) ) then
946 if ( .not. present_and_true(quiet) ) then
947 call messagenotify('W', subname, &
948 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
949 & c1 = trim( url ), &
950 & c2 = trim( tochar( data_shape(1:rank) ) ), &
951 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
952 end if
954 cause_c = 'array'
955 goto 999
956 end if
957 !-------------------------------------
958 ! データ取得
959 ! Get data
960 call inquire( var = var, & ! (in)
961 & size = domain ) ! (out)
962 if ( allocated( array_tmp ) ) deallocate( array_tmp )
963 allocate( array_tmp(array_allsize) )
964 call get( var, array_tmp, domain )
965 array = reshape( array_tmp, array_shape )
966 deallocate( array_tmp )
967 call close( var )
968 !-------------------------------------
969 ! データファイル名と切り出し範囲の印字
970 ! Print data filename and clipping range
971 call actual_iorange_dump(url, & ! (in)
972 & actual_url, returned_time, & ! (out) optional
973 & time_name = tname, & ! (in) optional
974 & err = err) ! (out) optional
975 if ( .not. present_and_true(quiet) ) then
976 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
977 end if
978999 continue
979 call storeerror(stat, subname, err, cause_c)
980end subroutine historygetdouble4
981subroutine historygetdouble5(file, varname, array, range, &
982 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
983 use gtdata_types, only: gt_variable
984 use gtdata_generic, only: open, inquire, close, get
985 use dc_string, only: tochar
987 use dc_regex, only: match
988 use dc_types, only: string, dp
989 use dc_message, only: messagenotify
992 implicit none
993 character(*), intent(in):: file
994 character(*), intent(in):: varname
995 character(*), intent(in), optional:: range
996 logical, intent(in), optional:: quiet
997 logical, intent(in), optional:: flag_mpi_split
998 real(DP), intent(out), optional:: returned_time ! データの時刻
999 logical, intent(out), optional:: flag_time_exist
1000 logical, intent(out), optional:: err
1001 real(DP), intent(out) :: array(:,:,:,:,:)
1002 real(DP), allocatable :: array_tmp(:)
1003 integer:: array_allsize
1004 integer:: array_shape(5), data_shape(5), array_shape_check(5)
1005 integer:: allcount
1006 integer:: i, sd
1007 logical:: inq_err
1008 type(gt_variable):: var
1009 character(STRING):: file_work, url, actual_url
1010 integer:: rank, alldims, array_rank
1011 integer:: domain
1012 character(STRING):: tname
1013 integer:: stat
1014 character(STRING):: cause_c
1015 character(*), parameter :: subname = "HistoryGetDouble5"
1016 interface
1017 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1018 character(*), intent(in):: file
1019 character(*), intent(in):: varname
1020 character(*), intent(out):: url
1021 character(*), intent(in), optional:: range
1022 logical, intent(out), optional:: flag_time_exist
1023 character(*), intent(out), optional:: time_name
1024 logical, intent(out), optional:: err
1025 end subroutine lookup_growable_url
1026 end interface
1027 interface
1028 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1029 use dc_types, only: dp
1030 character(*), intent(in) :: url ! 変数 URL
1031 character(*), intent(out), optional :: actual_url
1032 ! 正確な入出力範囲指定
1033 real(DP), intent(out), optional:: returned_time ! データの時刻
1034 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1035 logical, intent(out), optional :: err ! エラーのフラグ
1036 end subroutine actual_iorange_dump
1037 end interface
1038 interface
1039 function file_rename_mpi( file ) result(result)
1040 use dc_types, only: string
1041 character(*), intent(in):: file
1042 character(STRING):: result
1043 end function file_rename_mpi
1044 end interface
1045 continue
1046 cause_c = ''
1047 stat = dc_noerr
1048 file_work = file
1049 array_shape = shape( array )
1050 array_allsize = size( array )
1051 ! ファイル名の変更 (MPI 用)
1052 ! Change filename (for MPI)
1053 !
1054 if ( present_and_true( flag_mpi_split ) ) &
1055 & file_work = file_rename_mpi( file_work )
1056 ! 最新時刻の URL 取得
1057 ! Get URL of latest time
1058 !
1059 call lookup_growable_url(file_work, varname, url, range, &
1060 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
1061 if ( present_and_true(err) ) then
1062 stat = gt_enoturl
1063 cause_c = url
1064 goto 999
1065 end if
1066 ! ファイルオープン
1067 ! File open
1068 call open( var, url, err = err )
1069 if ( present_and_true(err) ) then
1070 stat = gt_enoturl
1071 cause_c = url
1072 goto 999
1073 end if
1074 !-------------------------------------------------------------------
1075 ! 配列形状のチェック
1076 ! Check array shape
1077 !-------------------------------------------------------------------
1078 ! 入力ファイル中のデータの次元数
1079 ! Get size of dimesions in data of an input file
1080 !
1081 call inquire( var = var, & ! (in)
1082 & rank = rank, alldims = alldims ) ! (out)
1083 ! 引数の次元数のチェック (縮退されている場合には減らす)
1084 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
1085 array_rank = 5
1086 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
1087 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
1088 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
1089 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
1090 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
1091 ! 次元数の比較
1092 ! Compare sizes of dimensions
1093 !
1094 if ( .not. 5 == rank .and. .not. array_rank == rank ) then
1095 if ( .not. present_and_true(quiet) ) then
1096 call messagenotify('W', subname, &
1097 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
1098 & i = (/rank, 5/), c1 = trim(url) )
1099 end if
1100 stat = gt_erankmismatch
1101 cause_c = 'array'
1102 goto 999
1103 end if
1104 ! 入力ファイル中のデータの配列形状取得
1105 ! Get shape of data in an input file
1106 call inquire( var = var , dimord = 1, & ! (in)
1107 & allcount = allcount, err = inq_err ) ! (out)
1108 if ( .not. inq_err ) then
1109 data_shape(1) = allcount
1110 else
1111 data_shape(1) = 1
1112 end if
1113 call inquire( var = var , dimord = 2, & ! (in)
1114 & allcount = allcount, err = inq_err ) ! (out)
1115 if ( .not. inq_err ) then
1116 data_shape(2) = allcount
1117 else
1118 data_shape(2) = 1
1119 end if
1120 call inquire( var = var , dimord = 3, & ! (in)
1121 & allcount = allcount, err = inq_err ) ! (out)
1122 if ( .not. inq_err ) then
1123 data_shape(3) = allcount
1124 else
1125 data_shape(3) = 1
1126 end if
1127 call inquire( var = var , dimord = 4, & ! (in)
1128 & allcount = allcount, err = inq_err ) ! (out)
1129 if ( .not. inq_err ) then
1130 data_shape(4) = allcount
1131 else
1132 data_shape(4) = 1
1133 end if
1134 call inquire( var = var , dimord = 5, & ! (in)
1135 & allcount = allcount, err = inq_err ) ! (out)
1136 if ( .not. inq_err ) then
1137 data_shape(5) = allcount
1138 else
1139 data_shape(5) = 1
1140 end if
1141 ! 引数の配列形状整形
1142 ! Arrange shape of an argument
1143 !
1144 array_shape_check = array_shape
1145 sd = 1
1146 do i = 1, 5 - 1
1147 if ( array_shape_check(sd) == 1 ) then
1148 array_shape_check(sd:5) = cshift( array_shape_check(sd:5), 1, 1 )
1149 else
1150 sd = sd + 1
1151 end if
1152 end do
1153 ! 配列形状の比較
1154 ! Compare shapes
1155 !
1156 if ( .not. all( array_shape_check == data_shape ) ) then
1157 if ( .not. present_and_true(quiet) ) then
1158 call messagenotify('W', subname, &
1159 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
1160 & c1 = trim( url ), &
1161 & c2 = trim( tochar( data_shape(1:rank) ) ), &
1162 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
1163 end if
1164 stat = gt_eargsizemismatch
1165 cause_c = 'array'
1166 goto 999
1167 end if
1168 !-------------------------------------
1169 ! データ取得
1170 ! Get data
1171 call inquire( var = var, & ! (in)
1172 & size = domain ) ! (out)
1173 if ( allocated( array_tmp ) ) deallocate( array_tmp )
1174 allocate( array_tmp(array_allsize) )
1175 call get( var, array_tmp, domain )
1176 array = reshape( array_tmp, array_shape )
1177 deallocate( array_tmp )
1178 call close( var )
1179 !-------------------------------------
1180 ! データファイル名と切り出し範囲の印字
1181 ! Print data filename and clipping range
1182 call actual_iorange_dump(url, & ! (in)
1183 & actual_url, returned_time, & ! (out) optional
1184 & time_name = tname, & ! (in) optional
1185 & err = err) ! (out) optional
1186 if ( .not. present_and_true(quiet) ) then
1187 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
1188 end if
1189999 continue
1190 call storeerror(stat, subname, err, cause_c)
1191end subroutine historygetdouble5
1192subroutine historygetdouble6(file, varname, array, range, &
1193 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
1194 use gtdata_types, only: gt_variable
1195 use gtdata_generic, only: open, inquire, close, get
1196 use dc_string, only: tochar
1198 use dc_regex, only: match
1199 use dc_types, only: string, dp
1200 use dc_message, only: messagenotify
1203 implicit none
1204 character(*), intent(in):: file
1205 character(*), intent(in):: varname
1206 character(*), intent(in), optional:: range
1207 logical, intent(in), optional:: quiet
1208 logical, intent(in), optional:: flag_mpi_split
1209 real(DP), intent(out), optional:: returned_time ! データの時刻
1210 logical, intent(out), optional:: flag_time_exist
1211 logical, intent(out), optional:: err
1212 real(DP), intent(out) :: array(:,:,:,:,:,:)
1213 real(DP), allocatable :: array_tmp(:)
1214 integer:: array_allsize
1215 integer:: array_shape(6), data_shape(6), array_shape_check(6)
1216 integer:: allcount
1217 integer:: i, sd
1218 logical:: inq_err
1219 type(gt_variable):: var
1220 character(STRING):: file_work, url, actual_url
1221 integer:: rank, alldims, array_rank
1222 integer:: domain
1223 character(STRING):: tname
1224 integer:: stat
1225 character(STRING):: cause_c
1226 character(*), parameter :: subname = "HistoryGetDouble6"
1227 interface
1228 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1229 character(*), intent(in):: file
1230 character(*), intent(in):: varname
1231 character(*), intent(out):: url
1232 character(*), intent(in), optional:: range
1233 logical, intent(out), optional:: flag_time_exist
1234 character(*), intent(out), optional:: time_name
1235 logical, intent(out), optional:: err
1236 end subroutine lookup_growable_url
1237 end interface
1238 interface
1239 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1240 use dc_types, only: dp
1241 character(*), intent(in) :: url ! 変数 URL
1242 character(*), intent(out), optional :: actual_url
1243 ! 正確な入出力範囲指定
1244 real(DP), intent(out), optional:: returned_time ! データの時刻
1245 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1246 logical, intent(out), optional :: err ! エラーのフラグ
1247 end subroutine actual_iorange_dump
1248 end interface
1249 interface
1250 function file_rename_mpi( file ) result(result)
1251 use dc_types, only: string
1252 character(*), intent(in):: file
1253 character(STRING):: result
1254 end function file_rename_mpi
1255 end interface
1256 continue
1257 cause_c = ''
1258 stat = dc_noerr
1259 file_work = file
1260 array_shape = shape( array )
1261 array_allsize = size( array )
1262 ! ファイル名の変更 (MPI 用)
1263 ! Change filename (for MPI)
1264 !
1265 if ( present_and_true( flag_mpi_split ) ) &
1266 & file_work = file_rename_mpi( file_work )
1267 ! 最新時刻の URL 取得
1268 ! Get URL of latest time
1269 !
1270 call lookup_growable_url(file_work, varname, url, range, &
1271 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
1272 if ( present_and_true(err) ) then
1273 stat = gt_enoturl
1274 cause_c = url
1275 goto 999
1276 end if
1277 ! ファイルオープン
1278 ! File open
1279 call open( var, url, err = err )
1280 if ( present_and_true(err) ) then
1281 stat = gt_enoturl
1282 cause_c = url
1283 goto 999
1284 end if
1285 !-------------------------------------------------------------------
1286 ! 配列形状のチェック
1287 ! Check array shape
1288 !-------------------------------------------------------------------
1289 ! 入力ファイル中のデータの次元数
1290 ! Get size of dimesions in data of an input file
1291 !
1292 call inquire( var = var, & ! (in)
1293 & rank = rank, alldims = alldims ) ! (out)
1294 ! 引数の次元数のチェック (縮退されている場合には減らす)
1295 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
1296 array_rank = 6
1297 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
1298 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
1299 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
1300 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
1301 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
1302 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
1303 ! 次元数の比較
1304 ! Compare sizes of dimensions
1305 !
1306 if ( .not. 6 == rank .and. .not. array_rank == rank ) then
1307 if ( .not. present_and_true(quiet) ) then
1308 call messagenotify('W', subname, &
1309 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
1310 & i = (/rank, 6/), c1 = trim(url) )
1311 end if
1312 stat = gt_erankmismatch
1313 cause_c = 'array'
1314 goto 999
1315 end if
1316 ! 入力ファイル中のデータの配列形状取得
1317 ! Get shape of data in an input file
1318 call inquire( var = var , dimord = 1, & ! (in)
1319 & allcount = allcount, err = inq_err ) ! (out)
1320 if ( .not. inq_err ) then
1321 data_shape(1) = allcount
1322 else
1323 data_shape(1) = 1
1324 end if
1325 call inquire( var = var , dimord = 2, & ! (in)
1326 & allcount = allcount, err = inq_err ) ! (out)
1327 if ( .not. inq_err ) then
1328 data_shape(2) = allcount
1329 else
1330 data_shape(2) = 1
1331 end if
1332 call inquire( var = var , dimord = 3, & ! (in)
1333 & allcount = allcount, err = inq_err ) ! (out)
1334 if ( .not. inq_err ) then
1335 data_shape(3) = allcount
1336 else
1337 data_shape(3) = 1
1338 end if
1339 call inquire( var = var , dimord = 4, & ! (in)
1340 & allcount = allcount, err = inq_err ) ! (out)
1341 if ( .not. inq_err ) then
1342 data_shape(4) = allcount
1343 else
1344 data_shape(4) = 1
1345 end if
1346 call inquire( var = var , dimord = 5, & ! (in)
1347 & allcount = allcount, err = inq_err ) ! (out)
1348 if ( .not. inq_err ) then
1349 data_shape(5) = allcount
1350 else
1351 data_shape(5) = 1
1352 end if
1353 call inquire( var = var , dimord = 6, & ! (in)
1354 & allcount = allcount, err = inq_err ) ! (out)
1355 if ( .not. inq_err ) then
1356 data_shape(6) = allcount
1357 else
1358 data_shape(6) = 1
1359 end if
1360 ! 引数の配列形状整形
1361 ! Arrange shape of an argument
1362 !
1363 array_shape_check = array_shape
1364 sd = 1
1365 do i = 1, 6 - 1
1366 if ( array_shape_check(sd) == 1 ) then
1367 array_shape_check(sd:6) = cshift( array_shape_check(sd:6), 1, 1 )
1368 else
1369 sd = sd + 1
1370 end if
1371 end do
1372 ! 配列形状の比較
1373 ! Compare shapes
1374 !
1375 if ( .not. all( array_shape_check == data_shape ) ) then
1376 if ( .not. present_and_true(quiet) ) then
1377 call messagenotify('W', subname, &
1378 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
1379 & c1 = trim( url ), &
1380 & c2 = trim( tochar( data_shape(1:rank) ) ), &
1381 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
1382 end if
1383 stat = gt_eargsizemismatch
1384 cause_c = 'array'
1385 goto 999
1386 end if
1387 !-------------------------------------
1388 ! データ取得
1389 ! Get data
1390 call inquire( var = var, & ! (in)
1391 & size = domain ) ! (out)
1392 if ( allocated( array_tmp ) ) deallocate( array_tmp )
1393 allocate( array_tmp(array_allsize) )
1394 call get( var, array_tmp, domain )
1395 array = reshape( array_tmp, array_shape )
1396 deallocate( array_tmp )
1397 call close( var )
1398 !-------------------------------------
1399 ! データファイル名と切り出し範囲の印字
1400 ! Print data filename and clipping range
1401 call actual_iorange_dump(url, & ! (in)
1402 & actual_url, returned_time, & ! (out) optional
1403 & time_name = tname, & ! (in) optional
1404 & err = err) ! (out) optional
1405 if ( .not. present_and_true(quiet) ) then
1406 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
1407 end if
1408999 continue
1409 call storeerror(stat, subname, err, cause_c)
1410end subroutine historygetdouble6
1411subroutine historygetdouble7(file, varname, array, range, &
1412 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
1413 use gtdata_types, only: gt_variable
1414 use gtdata_generic, only: open, inquire, close, get
1415 use dc_string, only: tochar
1417 use dc_regex, only: match
1418 use dc_types, only: string, dp
1419 use dc_message, only: messagenotify
1422 implicit none
1423 character(*), intent(in):: file
1424 character(*), intent(in):: varname
1425 character(*), intent(in), optional:: range
1426 logical, intent(in), optional:: quiet
1427 logical, intent(in), optional:: flag_mpi_split
1428 real(DP), intent(out), optional:: returned_time ! データの時刻
1429 logical, intent(out), optional:: flag_time_exist
1430 logical, intent(out), optional:: err
1431 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
1432 real(DP), allocatable :: array_tmp(:)
1433 integer:: array_allsize
1434 integer:: array_shape(7), data_shape(7), array_shape_check(7)
1435 integer:: allcount
1436 integer:: i, sd
1437 logical:: inq_err
1438 type(gt_variable):: var
1439 character(STRING):: file_work, url, actual_url
1440 integer:: rank, alldims, array_rank
1441 integer:: domain
1442 character(STRING):: tname
1443 integer:: stat
1444 character(STRING):: cause_c
1445 character(*), parameter :: subname = "HistoryGetDouble7"
1446 interface
1447 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1448 character(*), intent(in):: file
1449 character(*), intent(in):: varname
1450 character(*), intent(out):: url
1451 character(*), intent(in), optional:: range
1452 logical, intent(out), optional:: flag_time_exist
1453 character(*), intent(out), optional:: time_name
1454 logical, intent(out), optional:: err
1455 end subroutine lookup_growable_url
1456 end interface
1457 interface
1458 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1459 use dc_types, only: dp
1460 character(*), intent(in) :: url ! 変数 URL
1461 character(*), intent(out), optional :: actual_url
1462 ! 正確な入出力範囲指定
1463 real(DP), intent(out), optional:: returned_time ! データの時刻
1464 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1465 logical, intent(out), optional :: err ! エラーのフラグ
1466 end subroutine actual_iorange_dump
1467 end interface
1468 interface
1469 function file_rename_mpi( file ) result(result)
1470 use dc_types, only: string
1471 character(*), intent(in):: file
1472 character(STRING):: result
1473 end function file_rename_mpi
1474 end interface
1475 continue
1476 cause_c = ''
1477 stat = dc_noerr
1478 file_work = file
1479 array_shape = shape( array )
1480 array_allsize = size( array )
1481 ! ファイル名の変更 (MPI 用)
1482 ! Change filename (for MPI)
1483 !
1484 if ( present_and_true( flag_mpi_split ) ) &
1485 & file_work = file_rename_mpi( file_work )
1486 ! 最新時刻の URL 取得
1487 ! Get URL of latest time
1488 !
1489 call lookup_growable_url(file_work, varname, url, range, &
1490 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
1491 if ( present_and_true(err) ) then
1492 stat = gt_enoturl
1493 cause_c = url
1494 goto 999
1495 end if
1496 ! ファイルオープン
1497 ! File open
1498 call open( var, url, err = err )
1499 if ( present_and_true(err) ) then
1500 stat = gt_enoturl
1501 cause_c = url
1502 goto 999
1503 end if
1504 !-------------------------------------------------------------------
1505 ! 配列形状のチェック
1506 ! Check array shape
1507 !-------------------------------------------------------------------
1508 ! 入力ファイル中のデータの次元数
1509 ! Get size of dimesions in data of an input file
1510 !
1511 call inquire( var = var, & ! (in)
1512 & rank = rank, alldims = alldims ) ! (out)
1513 ! 引数の次元数のチェック (縮退されている場合には減らす)
1514 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
1515 array_rank = 7
1516 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
1517 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
1518 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
1519 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
1520 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
1521 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
1522 if ( size( array, 7 ) == 1 ) array_rank = array_rank - 1
1523 ! 次元数の比較
1524 ! Compare sizes of dimensions
1525 !
1526 if ( .not. 7 == rank .and. .not. array_rank == rank ) then
1527 if ( .not. present_and_true(quiet) ) then
1528 call messagenotify('W', subname, &
1529 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
1530 & i = (/rank, 7/), c1 = trim(url) )
1531 end if
1532 stat = gt_erankmismatch
1533 cause_c = 'array'
1534 goto 999
1535 end if
1536 ! 入力ファイル中のデータの配列形状取得
1537 ! Get shape of data in an input file
1538 call inquire( var = var , dimord = 1, & ! (in)
1539 & allcount = allcount, err = inq_err ) ! (out)
1540 if ( .not. inq_err ) then
1541 data_shape(1) = allcount
1542 else
1543 data_shape(1) = 1
1544 end if
1545 call inquire( var = var , dimord = 2, & ! (in)
1546 & allcount = allcount, err = inq_err ) ! (out)
1547 if ( .not. inq_err ) then
1548 data_shape(2) = allcount
1549 else
1550 data_shape(2) = 1
1551 end if
1552 call inquire( var = var , dimord = 3, & ! (in)
1553 & allcount = allcount, err = inq_err ) ! (out)
1554 if ( .not. inq_err ) then
1555 data_shape(3) = allcount
1556 else
1557 data_shape(3) = 1
1558 end if
1559 call inquire( var = var , dimord = 4, & ! (in)
1560 & allcount = allcount, err = inq_err ) ! (out)
1561 if ( .not. inq_err ) then
1562 data_shape(4) = allcount
1563 else
1564 data_shape(4) = 1
1565 end if
1566 call inquire( var = var , dimord = 5, & ! (in)
1567 & allcount = allcount, err = inq_err ) ! (out)
1568 if ( .not. inq_err ) then
1569 data_shape(5) = allcount
1570 else
1571 data_shape(5) = 1
1572 end if
1573 call inquire( var = var , dimord = 6, & ! (in)
1574 & allcount = allcount, err = inq_err ) ! (out)
1575 if ( .not. inq_err ) then
1576 data_shape(6) = allcount
1577 else
1578 data_shape(6) = 1
1579 end if
1580 call inquire( var = var , dimord = 7, & ! (in)
1581 & allcount = allcount, err = inq_err ) ! (out)
1582 if ( .not. inq_err ) then
1583 data_shape(7) = allcount
1584 else
1585 data_shape(7) = 1
1586 end if
1587 ! 引数の配列形状整形
1588 ! Arrange shape of an argument
1589 !
1590 array_shape_check = array_shape
1591 sd = 1
1592 do i = 1, 7 - 1
1593 if ( array_shape_check(sd) == 1 ) then
1594 array_shape_check(sd:7) = cshift( array_shape_check(sd:7), 1, 1 )
1595 else
1596 sd = sd + 1
1597 end if
1598 end do
1599 ! 配列形状の比較
1600 ! Compare shapes
1601 !
1602 if ( .not. all( array_shape_check == data_shape ) ) then
1603 if ( .not. present_and_true(quiet) ) then
1604 call messagenotify('W', subname, &
1605 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
1606 & c1 = trim( url ), &
1607 & c2 = trim( tochar( data_shape(1:rank) ) ), &
1608 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
1609 end if
1610 stat = gt_eargsizemismatch
1611 cause_c = 'array'
1612 goto 999
1613 end if
1614 !-------------------------------------
1615 ! データ取得
1616 ! Get data
1617 call inquire( var = var, & ! (in)
1618 & size = domain ) ! (out)
1619 if ( allocated( array_tmp ) ) deallocate( array_tmp )
1620 allocate( array_tmp(array_allsize) )
1621 call get( var, array_tmp, domain )
1622 array = reshape( array_tmp, array_shape )
1623 deallocate( array_tmp )
1624 call close( var )
1625 !-------------------------------------
1626 ! データファイル名と切り出し範囲の印字
1627 ! Print data filename and clipping range
1628 call actual_iorange_dump(url, & ! (in)
1629 & actual_url, returned_time, & ! (out) optional
1630 & time_name = tname, & ! (in) optional
1631 & err = err) ! (out) optional
1632 if ( .not. present_and_true(quiet) ) then
1633 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
1634 end if
1635999 continue
1636 call storeerror(stat, subname, err, cause_c)
1637end subroutine historygetdouble7
1638subroutine historygetreal0(file, varname, array, range, &
1639 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
1640 use gtdata_types, only: gt_variable
1641 use gtdata_generic, only: open, inquire, close, get
1642 use dc_string, only: tochar
1644 use dc_regex, only: match
1645 use dc_types, only: string, dp, sp
1646 use dc_message, only: messagenotify
1648 implicit none
1649 character(*), intent(in):: file
1650 character(*), intent(in):: varname
1651 character(*), intent(in), optional:: range
1652 logical, intent(in), optional:: quiet
1653 logical, intent(in), optional:: flag_mpi_split
1654 real(DP), intent(out), optional:: returned_time ! データの時刻
1655 logical, intent(out), optional:: flag_time_exist
1656 logical, intent(out), optional:: err
1657 real(SP), intent(out) :: array
1658 real(SP) :: array_tmp(1)
1659 type(gt_variable):: var
1660 character(STRING):: file_work, url, actual_url
1661 integer:: rank, alldims, array_rank
1662 integer:: domain
1663 character(STRING):: tname
1664 integer:: stat
1665 character(STRING):: cause_c
1666 character(*), parameter :: subname = "HistoryGetReal0"
1667 interface
1668 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1669 character(*), intent(in):: file
1670 character(*), intent(in):: varname
1671 character(*), intent(out):: url
1672 character(*), intent(in), optional:: range
1673 logical, intent(out), optional:: flag_time_exist
1674 character(*), intent(out), optional:: time_name
1675 logical, intent(out), optional:: err
1676 end subroutine lookup_growable_url
1677 end interface
1678 interface
1679 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1680 use dc_types, only: dp
1681 character(*), intent(in) :: url ! 変数 URL
1682 character(*), intent(out), optional :: actual_url
1683 ! 正確な入出力範囲指定
1684 real(DP), intent(out), optional:: returned_time ! データの時刻
1685 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1686 logical, intent(out), optional :: err ! エラーのフラグ
1687 end subroutine actual_iorange_dump
1688 end interface
1689 interface
1690 function file_rename_mpi( file ) result(result)
1691 use dc_types, only: string
1692 character(*), intent(in):: file
1693 character(STRING):: result
1694 end function file_rename_mpi
1695 end interface
1696 continue
1697 cause_c = ''
1698 stat = dc_noerr
1699 file_work = file
1700 ! ファイル名の変更 (MPI 用)
1701 ! Change filename (for MPI)
1702 !
1703 if ( present_and_true( flag_mpi_split ) ) &
1704 & file_work = file_rename_mpi( file_work )
1705 ! 最新時刻の URL 取得
1706 ! Get URL of latest time
1707 !
1708 call lookup_growable_url(file_work, varname, url, range, &
1709 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
1710 if ( present_and_true(err) ) then
1711 stat = gt_enoturl
1712 cause_c = url
1713 goto 999
1714 end if
1715 ! ファイルオープン
1716 ! File open
1717 call open( var, url, err = err )
1718 if ( present_and_true(err) ) then
1719 stat = gt_enoturl
1720 cause_c = url
1721 goto 999
1722 end if
1723 !-------------------------------------------------------------------
1724 ! 配列形状のチェック
1725 ! Check array shape
1726 !-------------------------------------------------------------------
1727 ! 入力ファイル中のデータの次元数
1728 ! Get size of dimesions in data of an input file
1729 !
1730 call inquire( var = var, & ! (in)
1731 & rank = rank, alldims = alldims ) ! (out)
1732 ! 引数の次元数のチェック (縮退されている場合には減らす)
1733 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
1734 array_rank = 0
1735 ! 次元数の比較
1736 ! Compare sizes of dimensions
1737 !
1738 if ( .not. 0 == rank .and. .not. array_rank == rank ) then
1739 if ( .not. present_and_true(quiet) ) then
1740 call messagenotify('W', subname, &
1741 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
1742 & i = (/rank, 0/), c1 = trim(url) )
1743 end if
1744 stat = gt_erankmismatch
1745 cause_c = 'array'
1746 goto 999
1747 end if
1748 ! 入力ファイル中のデータの配列形状取得
1749 ! Get shape of data in an input file
1750 !-------------------------------------
1751 ! データ取得
1752 ! Get data
1753 call inquire( var = var, & ! (in)
1754 & size = domain ) ! (out)
1755 call get( var = var, & ! (inout)
1756 & nvalue = domain, & ! (in)
1757 & value = array_tmp) ! (out)
1758 array = array_tmp(1)
1759 call close( var )
1760 !-------------------------------------
1761 ! データファイル名と切り出し範囲の印字
1762 ! Print data filename and clipping range
1763 call actual_iorange_dump(url, & ! (in)
1764 & actual_url, returned_time, & ! (out) optional
1765 & time_name = tname, & ! (in) optional
1766 & err = err) ! (out) optional
1767 if ( .not. present_and_true(quiet) ) then
1768 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
1769 end if
1770999 continue
1771 call storeerror(stat, subname, err, cause_c)
1772end subroutine historygetreal0
1773subroutine historygetreal1(file, varname, array, range, &
1774 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
1775 use gtdata_types, only: gt_variable
1776 use gtdata_generic, only: open, inquire, close, get
1777 use dc_string, only: tochar
1779 use dc_regex, only: match
1780 use dc_types, only: string, dp, sp
1781 use dc_message, only: messagenotify
1784 implicit none
1785 character(*), intent(in):: file
1786 character(*), intent(in):: varname
1787 character(*), intent(in), optional:: range
1788 logical, intent(in), optional:: quiet
1789 logical, intent(in), optional:: flag_mpi_split
1790 real(DP), intent(out), optional:: returned_time ! データの時刻
1791 logical, intent(out), optional:: flag_time_exist
1792 logical, intent(out), optional:: err
1793 real(SP), intent(out) :: array(:)
1794 real(SP), allocatable :: array_tmp(:)
1795 integer:: array_allsize
1796 integer:: array_shape(1), data_shape(1), array_shape_check(1)
1797 integer:: allcount
1798 logical:: inq_err
1799 type(gt_variable):: var
1800 character(STRING):: file_work, url, actual_url
1801 integer:: rank, alldims, array_rank
1802 integer:: domain
1803 character(STRING):: tname
1804 integer:: stat
1805 character(STRING):: cause_c
1806 character(*), parameter :: subname = "HistoryGetReal1"
1807 interface
1808 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1809 character(*), intent(in):: file
1810 character(*), intent(in):: varname
1811 character(*), intent(out):: url
1812 character(*), intent(in), optional:: range
1813 logical, intent(out), optional:: flag_time_exist
1814 character(*), intent(out), optional:: time_name
1815 logical, intent(out), optional:: err
1816 end subroutine lookup_growable_url
1817 end interface
1818 interface
1819 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1820 use dc_types, only: dp
1821 character(*), intent(in) :: url ! 変数 URL
1822 character(*), intent(out), optional :: actual_url
1823 ! 正確な入出力範囲指定
1824 real(DP), intent(out), optional:: returned_time ! データの時刻
1825 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1826 logical, intent(out), optional :: err ! エラーのフラグ
1827 end subroutine actual_iorange_dump
1828 end interface
1829 interface
1830 function file_rename_mpi( file ) result(result)
1831 use dc_types, only: string
1832 character(*), intent(in):: file
1833 character(STRING):: result
1834 end function file_rename_mpi
1835 end interface
1836 continue
1837 cause_c = ''
1838 stat = dc_noerr
1839 file_work = file
1840 array_shape = shape( array )
1841 array_allsize = size( array )
1842 ! ファイル名の変更 (MPI 用)
1843 ! Change filename (for MPI)
1844 !
1845 if ( present_and_true( flag_mpi_split ) ) &
1846 & file_work = file_rename_mpi( file_work )
1847 ! 最新時刻の URL 取得
1848 ! Get URL of latest time
1849 !
1850 call lookup_growable_url(file_work, varname, url, range, &
1851 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
1852 if ( present_and_true(err) ) then
1853 stat = gt_enoturl
1854 cause_c = url
1855 goto 999
1856 end if
1857 ! ファイルオープン
1858 ! File open
1859 call open( var, url, err = err )
1860 if ( present_and_true(err) ) then
1861 stat = gt_enoturl
1862 cause_c = url
1863 goto 999
1864 end if
1865 !-------------------------------------------------------------------
1866 ! 配列形状のチェック
1867 ! Check array shape
1868 !-------------------------------------------------------------------
1869 ! 入力ファイル中のデータの次元数
1870 ! Get size of dimesions in data of an input file
1871 !
1872 call inquire( var = var, & ! (in)
1873 & rank = rank, alldims = alldims ) ! (out)
1874 ! 引数の次元数のチェック (縮退されている場合には減らす)
1875 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
1876 array_rank = 1
1877 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
1878 ! 次元数の比較
1879 ! Compare sizes of dimensions
1880 !
1881 if ( .not. 1 == rank .and. .not. array_rank == rank ) then
1882 if ( .not. present_and_true(quiet) ) then
1883 call messagenotify('W', subname, &
1884 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
1885 & i = (/rank, 1/), c1 = trim(url) )
1886 end if
1887 stat = gt_erankmismatch
1888 cause_c = 'array'
1889 goto 999
1890 end if
1891 ! 入力ファイル中のデータの配列形状取得
1892 ! Get shape of data in an input file
1893 call inquire( var = var , dimord = 1, & ! (in)
1894 & allcount = allcount, err = inq_err ) ! (out)
1895 if ( .not. inq_err ) then
1896 data_shape(1) = allcount
1897 else
1898 data_shape(1) = 1
1899 end if
1900 ! 引数の配列形状整形
1901 ! Arrange shape of an argument
1902 !
1903 array_shape_check = array_shape
1904 ! 配列形状の比較
1905 ! Compare shapes
1906 !
1907 if ( .not. all( array_shape_check == data_shape ) ) then
1908 if ( .not. present_and_true(quiet) ) then
1909 call messagenotify('W', subname, &
1910 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
1911 & c1 = trim( url ), &
1912 & c2 = trim( tochar( data_shape(1:rank) ) ), &
1913 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
1914 end if
1915 stat = gt_eargsizemismatch
1916 cause_c = 'array'
1917 goto 999
1918 end if
1919 !-------------------------------------
1920 ! データ取得
1921 ! Get data
1922 call inquire( var = var, & ! (in)
1923 & size = domain ) ! (out)
1924 if ( allocated( array_tmp ) ) deallocate( array_tmp )
1925 allocate( array_tmp(array_allsize) )
1926 call get( var, array_tmp, domain )
1927 array = reshape( array_tmp, array_shape )
1928 deallocate( array_tmp )
1929 call close( var )
1930 !-------------------------------------
1931 ! データファイル名と切り出し範囲の印字
1932 ! Print data filename and clipping range
1933 call actual_iorange_dump(url, & ! (in)
1934 & actual_url, returned_time, & ! (out) optional
1935 & time_name = tname, & ! (in) optional
1936 & err = err) ! (out) optional
1937 if ( .not. present_and_true(quiet) ) then
1938 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
1939 end if
1940999 continue
1941 call storeerror(stat, subname, err, cause_c)
1942end subroutine historygetreal1
1943subroutine historygetreal2(file, varname, array, range, &
1944 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
1945 use gtdata_types, only: gt_variable
1946 use gtdata_generic, only: open, inquire, close, get
1947 use dc_string, only: tochar
1949 use dc_regex, only: match
1950 use dc_types, only: string, dp, sp
1951 use dc_message, only: messagenotify
1954 implicit none
1955 character(*), intent(in):: file
1956 character(*), intent(in):: varname
1957 character(*), intent(in), optional:: range
1958 logical, intent(in), optional:: quiet
1959 logical, intent(in), optional:: flag_mpi_split
1960 real(DP), intent(out), optional:: returned_time ! データの時刻
1961 logical, intent(out), optional:: flag_time_exist
1962 logical, intent(out), optional:: err
1963 real(SP), intent(out) :: array(:,:)
1964 real(SP), allocatable :: array_tmp(:)
1965 integer:: array_allsize
1966 integer:: array_shape(2), data_shape(2), array_shape_check(2)
1967 integer:: allcount
1968 integer:: i, sd
1969 logical:: inq_err
1970 type(gt_variable):: var
1971 character(STRING):: file_work, url, actual_url
1972 integer:: rank, alldims, array_rank
1973 integer:: domain
1974 character(STRING):: tname
1975 integer:: stat
1976 character(STRING):: cause_c
1977 character(*), parameter :: subname = "HistoryGetReal2"
1978 interface
1979 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
1980 character(*), intent(in):: file
1981 character(*), intent(in):: varname
1982 character(*), intent(out):: url
1983 character(*), intent(in), optional:: range
1984 logical, intent(out), optional:: flag_time_exist
1985 character(*), intent(out), optional:: time_name
1986 logical, intent(out), optional:: err
1987 end subroutine lookup_growable_url
1988 end interface
1989 interface
1990 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
1991 use dc_types, only: dp
1992 character(*), intent(in) :: url ! 変数 URL
1993 character(*), intent(out), optional :: actual_url
1994 ! 正確な入出力範囲指定
1995 real(DP), intent(out), optional:: returned_time ! データの時刻
1996 character(*), intent(in), optional:: time_name ! 時刻次元の名称
1997 logical, intent(out), optional :: err ! エラーのフラグ
1998 end subroutine actual_iorange_dump
1999 end interface
2000 interface
2001 function file_rename_mpi( file ) result(result)
2002 use dc_types, only: string
2003 character(*), intent(in):: file
2004 character(STRING):: result
2005 end function file_rename_mpi
2006 end interface
2007 continue
2008 cause_c = ''
2009 stat = dc_noerr
2010 file_work = file
2011 array_shape = shape( array )
2012 array_allsize = size( array )
2013 ! ファイル名の変更 (MPI 用)
2014 ! Change filename (for MPI)
2015 !
2016 if ( present_and_true( flag_mpi_split ) ) &
2017 & file_work = file_rename_mpi( file_work )
2018 ! 最新時刻の URL 取得
2019 ! Get URL of latest time
2020 !
2021 call lookup_growable_url(file_work, varname, url, range, &
2022 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
2023 if ( present_and_true(err) ) then
2024 stat = gt_enoturl
2025 cause_c = url
2026 goto 999
2027 end if
2028 ! ファイルオープン
2029 ! File open
2030 call open( var, url, err = err )
2031 if ( present_and_true(err) ) then
2032 stat = gt_enoturl
2033 cause_c = url
2034 goto 999
2035 end if
2036 !-------------------------------------------------------------------
2037 ! 配列形状のチェック
2038 ! Check array shape
2039 !-------------------------------------------------------------------
2040 ! 入力ファイル中のデータの次元数
2041 ! Get size of dimesions in data of an input file
2042 !
2043 call inquire( var = var, & ! (in)
2044 & rank = rank, alldims = alldims ) ! (out)
2045 ! 引数の次元数のチェック (縮退されている場合には減らす)
2046 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
2047 array_rank = 2
2048 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
2049 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
2050 ! 次元数の比較
2051 ! Compare sizes of dimensions
2052 !
2053 if ( .not. 2 == rank .and. .not. array_rank == rank ) then
2054 if ( .not. present_and_true(quiet) ) then
2055 call messagenotify('W', subname, &
2056 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
2057 & i = (/rank, 2/), c1 = trim(url) )
2058 end if
2059 stat = gt_erankmismatch
2060 cause_c = 'array'
2061 goto 999
2062 end if
2063 ! 入力ファイル中のデータの配列形状取得
2064 ! Get shape of data in an input file
2065 call inquire( var = var , dimord = 1, & ! (in)
2066 & allcount = allcount, err = inq_err ) ! (out)
2067 if ( .not. inq_err ) then
2068 data_shape(1) = allcount
2069 else
2070 data_shape(1) = 1
2071 end if
2072 call inquire( var = var , dimord = 2, & ! (in)
2073 & allcount = allcount, err = inq_err ) ! (out)
2074 if ( .not. inq_err ) then
2075 data_shape(2) = allcount
2076 else
2077 data_shape(2) = 1
2078 end if
2079 ! 引数の配列形状整形
2080 ! Arrange shape of an argument
2081 !
2082 array_shape_check = array_shape
2083 sd = 1
2084 do i = 1, 2 - 1
2085 if ( array_shape_check(sd) == 1 ) then
2086 array_shape_check(sd:2) = cshift( array_shape_check(sd:2), 1, 1 )
2087 else
2088 sd = sd + 1
2089 end if
2090 end do
2091 ! 配列形状の比較
2092 ! Compare shapes
2093 !
2094 if ( .not. all( array_shape_check == data_shape ) ) then
2095 if ( .not. present_and_true(quiet) ) then
2096 call messagenotify('W', subname, &
2097 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
2098 & c1 = trim( url ), &
2099 & c2 = trim( tochar( data_shape(1:rank) ) ), &
2100 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
2101 end if
2102 stat = gt_eargsizemismatch
2103 cause_c = 'array'
2104 goto 999
2105 end if
2106 !-------------------------------------
2107 ! データ取得
2108 ! Get data
2109 call inquire( var = var, & ! (in)
2110 & size = domain ) ! (out)
2111 if ( allocated( array_tmp ) ) deallocate( array_tmp )
2112 allocate( array_tmp(array_allsize) )
2113 call get( var, array_tmp, domain )
2114 array = reshape( array_tmp, array_shape )
2115 deallocate( array_tmp )
2116 call close( var )
2117 !-------------------------------------
2118 ! データファイル名と切り出し範囲の印字
2119 ! Print data filename and clipping range
2120 call actual_iorange_dump(url, & ! (in)
2121 & actual_url, returned_time, & ! (out) optional
2122 & time_name = tname, & ! (in) optional
2123 & err = err) ! (out) optional
2124 if ( .not. present_and_true(quiet) ) then
2125 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
2126 end if
2127999 continue
2128 call storeerror(stat, subname, err, cause_c)
2129end subroutine historygetreal2
2130subroutine historygetreal3(file, varname, array, range, &
2131 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
2132 use gtdata_types, only: gt_variable
2133 use gtdata_generic, only: open, inquire, close, get
2134 use dc_string, only: tochar
2136 use dc_regex, only: match
2137 use dc_types, only: string, dp, sp
2138 use dc_message, only: messagenotify
2141 implicit none
2142 character(*), intent(in):: file
2143 character(*), intent(in):: varname
2144 character(*), intent(in), optional:: range
2145 logical, intent(in), optional:: quiet
2146 logical, intent(in), optional:: flag_mpi_split
2147 real(DP), intent(out), optional:: returned_time ! データの時刻
2148 logical, intent(out), optional:: flag_time_exist
2149 logical, intent(out), optional:: err
2150 real(SP), intent(out) :: array(:,:,:)
2151 real(SP), allocatable :: array_tmp(:)
2152 integer:: array_allsize
2153 integer:: array_shape(3), data_shape(3), array_shape_check(3)
2154 integer:: allcount
2155 integer:: i, sd
2156 logical:: inq_err
2157 type(gt_variable):: var
2158 character(STRING):: file_work, url, actual_url
2159 integer:: rank, alldims, array_rank
2160 integer:: domain
2161 character(STRING):: tname
2162 integer:: stat
2163 character(STRING):: cause_c
2164 character(*), parameter :: subname = "HistoryGetReal3"
2165 interface
2166 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
2167 character(*), intent(in):: file
2168 character(*), intent(in):: varname
2169 character(*), intent(out):: url
2170 character(*), intent(in), optional:: range
2171 logical, intent(out), optional:: flag_time_exist
2172 character(*), intent(out), optional:: time_name
2173 logical, intent(out), optional:: err
2174 end subroutine lookup_growable_url
2175 end interface
2176 interface
2177 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
2178 use dc_types, only: dp
2179 character(*), intent(in) :: url ! 変数 URL
2180 character(*), intent(out), optional :: actual_url
2181 ! 正確な入出力範囲指定
2182 real(DP), intent(out), optional:: returned_time ! データの時刻
2183 character(*), intent(in), optional:: time_name ! 時刻次元の名称
2184 logical, intent(out), optional :: err ! エラーのフラグ
2185 end subroutine actual_iorange_dump
2186 end interface
2187 interface
2188 function file_rename_mpi( file ) result(result)
2189 use dc_types, only: string
2190 character(*), intent(in):: file
2191 character(STRING):: result
2192 end function file_rename_mpi
2193 end interface
2194 continue
2195 cause_c = ''
2196 stat = dc_noerr
2197 file_work = file
2198 array_shape = shape( array )
2199 array_allsize = size( array )
2200 ! ファイル名の変更 (MPI 用)
2201 ! Change filename (for MPI)
2202 !
2203 if ( present_and_true( flag_mpi_split ) ) &
2204 & file_work = file_rename_mpi( file_work )
2205 ! 最新時刻の URL 取得
2206 ! Get URL of latest time
2207 !
2208 call lookup_growable_url(file_work, varname, url, range, &
2209 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
2210 if ( present_and_true(err) ) then
2211 stat = gt_enoturl
2212 cause_c = url
2213 goto 999
2214 end if
2215 ! ファイルオープン
2216 ! File open
2217 call open( var, url, err = err )
2218 if ( present_and_true(err) ) then
2219 stat = gt_enoturl
2220 cause_c = url
2221 goto 999
2222 end if
2223 !-------------------------------------------------------------------
2224 ! 配列形状のチェック
2225 ! Check array shape
2226 !-------------------------------------------------------------------
2227 ! 入力ファイル中のデータの次元数
2228 ! Get size of dimesions in data of an input file
2229 !
2230 call inquire( var = var, & ! (in)
2231 & rank = rank, alldims = alldims ) ! (out)
2232 ! 引数の次元数のチェック (縮退されている場合には減らす)
2233 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
2234 array_rank = 3
2235 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
2236 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
2237 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
2238 ! 次元数の比較
2239 ! Compare sizes of dimensions
2240 !
2241 if ( .not. 3 == rank .and. .not. array_rank == rank ) then
2242 if ( .not. present_and_true(quiet) ) then
2243 call messagenotify('W', subname, &
2244 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
2245 & i = (/rank, 3/), c1 = trim(url) )
2246 end if
2247 stat = gt_erankmismatch
2248 cause_c = 'array'
2249 goto 999
2250 end if
2251 ! 入力ファイル中のデータの配列形状取得
2252 ! Get shape of data in an input file
2253 call inquire( var = var , dimord = 1, & ! (in)
2254 & allcount = allcount, err = inq_err ) ! (out)
2255 if ( .not. inq_err ) then
2256 data_shape(1) = allcount
2257 else
2258 data_shape(1) = 1
2259 end if
2260 call inquire( var = var , dimord = 2, & ! (in)
2261 & allcount = allcount, err = inq_err ) ! (out)
2262 if ( .not. inq_err ) then
2263 data_shape(2) = allcount
2264 else
2265 data_shape(2) = 1
2266 end if
2267 call inquire( var = var , dimord = 3, & ! (in)
2268 & allcount = allcount, err = inq_err ) ! (out)
2269 if ( .not. inq_err ) then
2270 data_shape(3) = allcount
2271 else
2272 data_shape(3) = 1
2273 end if
2274 ! 引数の配列形状整形
2275 ! Arrange shape of an argument
2276 !
2277 array_shape_check = array_shape
2278 sd = 1
2279 do i = 1, 3 - 1
2280 if ( array_shape_check(sd) == 1 ) then
2281 array_shape_check(sd:3) = cshift( array_shape_check(sd:3), 1, 1 )
2282 else
2283 sd = sd + 1
2284 end if
2285 end do
2286 ! 配列形状の比較
2287 ! Compare shapes
2288 !
2289 if ( .not. all( array_shape_check == data_shape ) ) then
2290 if ( .not. present_and_true(quiet) ) then
2291 call messagenotify('W', subname, &
2292 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
2293 & c1 = trim( url ), &
2294 & c2 = trim( tochar( data_shape(1:rank) ) ), &
2295 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
2296 end if
2297 stat = gt_eargsizemismatch
2298 cause_c = 'array'
2299 goto 999
2300 end if
2301 !-------------------------------------
2302 ! データ取得
2303 ! Get data
2304 call inquire( var = var, & ! (in)
2305 & size = domain ) ! (out)
2306 if ( allocated( array_tmp ) ) deallocate( array_tmp )
2307 allocate( array_tmp(array_allsize) )
2308 call get( var, array_tmp, domain )
2309 array = reshape( array_tmp, array_shape )
2310 deallocate( array_tmp )
2311 call close( var )
2312 !-------------------------------------
2313 ! データファイル名と切り出し範囲の印字
2314 ! Print data filename and clipping range
2315 call actual_iorange_dump(url, & ! (in)
2316 & actual_url, returned_time, & ! (out) optional
2317 & time_name = tname, & ! (in) optional
2318 & err = err) ! (out) optional
2319 if ( .not. present_and_true(quiet) ) then
2320 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
2321 end if
2322999 continue
2323 call storeerror(stat, subname, err, cause_c)
2324end subroutine historygetreal3
2325subroutine historygetreal4(file, varname, array, range, &
2326 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
2327 use gtdata_types, only: gt_variable
2328 use gtdata_generic, only: open, inquire, close, get
2329 use dc_string, only: tochar
2331 use dc_regex, only: match
2332 use dc_types, only: string, dp, sp
2333 use dc_message, only: messagenotify
2336 implicit none
2337 character(*), intent(in):: file
2338 character(*), intent(in):: varname
2339 character(*), intent(in), optional:: range
2340 logical, intent(in), optional:: quiet
2341 logical, intent(in), optional:: flag_mpi_split
2342 real(DP), intent(out), optional:: returned_time ! データの時刻
2343 logical, intent(out), optional:: flag_time_exist
2344 logical, intent(out), optional:: err
2345 real(SP), intent(out) :: array(:,:,:,:)
2346 real(SP), allocatable :: array_tmp(:)
2347 integer:: array_allsize
2348 integer:: array_shape(4), data_shape(4), array_shape_check(4)
2349 integer:: allcount
2350 integer:: i, sd
2351 logical:: inq_err
2352 type(gt_variable):: var
2353 character(STRING):: file_work, url, actual_url
2354 integer:: rank, alldims, array_rank
2355 integer:: domain
2356 character(STRING):: tname
2357 integer:: stat
2358 character(STRING):: cause_c
2359 character(*), parameter :: subname = "HistoryGetReal4"
2360 interface
2361 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
2362 character(*), intent(in):: file
2363 character(*), intent(in):: varname
2364 character(*), intent(out):: url
2365 character(*), intent(in), optional:: range
2366 logical, intent(out), optional:: flag_time_exist
2367 character(*), intent(out), optional:: time_name
2368 logical, intent(out), optional:: err
2369 end subroutine lookup_growable_url
2370 end interface
2371 interface
2372 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
2373 use dc_types, only: dp
2374 character(*), intent(in) :: url ! 変数 URL
2375 character(*), intent(out), optional :: actual_url
2376 ! 正確な入出力範囲指定
2377 real(DP), intent(out), optional:: returned_time ! データの時刻
2378 character(*), intent(in), optional:: time_name ! 時刻次元の名称
2379 logical, intent(out), optional :: err ! エラーのフラグ
2380 end subroutine actual_iorange_dump
2381 end interface
2382 interface
2383 function file_rename_mpi( file ) result(result)
2384 use dc_types, only: string
2385 character(*), intent(in):: file
2386 character(STRING):: result
2387 end function file_rename_mpi
2388 end interface
2389 continue
2390 cause_c = ''
2391 stat = dc_noerr
2392 file_work = file
2393 array_shape = shape( array )
2394 array_allsize = size( array )
2395 ! ファイル名の変更 (MPI 用)
2396 ! Change filename (for MPI)
2397 !
2398 if ( present_and_true( flag_mpi_split ) ) &
2399 & file_work = file_rename_mpi( file_work )
2400 ! 最新時刻の URL 取得
2401 ! Get URL of latest time
2402 !
2403 call lookup_growable_url(file_work, varname, url, range, &
2404 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
2405 if ( present_and_true(err) ) then
2406 stat = gt_enoturl
2407 cause_c = url
2408 goto 999
2409 end if
2410 ! ファイルオープン
2411 ! File open
2412 call open( var, url, err = err )
2413 if ( present_and_true(err) ) then
2414 stat = gt_enoturl
2415 cause_c = url
2416 goto 999
2417 end if
2418 !-------------------------------------------------------------------
2419 ! 配列形状のチェック
2420 ! Check array shape
2421 !-------------------------------------------------------------------
2422 ! 入力ファイル中のデータの次元数
2423 ! Get size of dimesions in data of an input file
2424 !
2425 call inquire( var = var, & ! (in)
2426 & rank = rank, alldims = alldims ) ! (out)
2427 ! 引数の次元数のチェック (縮退されている場合には減らす)
2428 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
2429 array_rank = 4
2430 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
2431 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
2432 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
2433 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
2434 ! 次元数の比較
2435 ! Compare sizes of dimensions
2436 !
2437 if ( .not. 4 == rank .and. .not. array_rank == rank ) then
2438 if ( .not. present_and_true(quiet) ) then
2439 call messagenotify('W', subname, &
2440 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
2441 & i = (/rank, 4/), c1 = trim(url) )
2442 end if
2443 stat = gt_erankmismatch
2444 cause_c = 'array'
2445 goto 999
2446 end if
2447 ! 入力ファイル中のデータの配列形状取得
2448 ! Get shape of data in an input file
2449 call inquire( var = var , dimord = 1, & ! (in)
2450 & allcount = allcount, err = inq_err ) ! (out)
2451 if ( .not. inq_err ) then
2452 data_shape(1) = allcount
2453 else
2454 data_shape(1) = 1
2455 end if
2456 call inquire( var = var , dimord = 2, & ! (in)
2457 & allcount = allcount, err = inq_err ) ! (out)
2458 if ( .not. inq_err ) then
2459 data_shape(2) = allcount
2460 else
2461 data_shape(2) = 1
2462 end if
2463 call inquire( var = var , dimord = 3, & ! (in)
2464 & allcount = allcount, err = inq_err ) ! (out)
2465 if ( .not. inq_err ) then
2466 data_shape(3) = allcount
2467 else
2468 data_shape(3) = 1
2469 end if
2470 call inquire( var = var , dimord = 4, & ! (in)
2471 & allcount = allcount, err = inq_err ) ! (out)
2472 if ( .not. inq_err ) then
2473 data_shape(4) = allcount
2474 else
2475 data_shape(4) = 1
2476 end if
2477 ! 引数の配列形状整形
2478 ! Arrange shape of an argument
2479 !
2480 array_shape_check = array_shape
2481 sd = 1
2482 do i = 1, 4 - 1
2483 if ( array_shape_check(sd) == 1 ) then
2484 array_shape_check(sd:4) = cshift( array_shape_check(sd:4), 1, 1 )
2485 else
2486 sd = sd + 1
2487 end if
2488 end do
2489 ! 配列形状の比較
2490 ! Compare shapes
2491 !
2492 if ( .not. all( array_shape_check == data_shape ) ) then
2493 if ( .not. present_and_true(quiet) ) then
2494 call messagenotify('W', subname, &
2495 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
2496 & c1 = trim( url ), &
2497 & c2 = trim( tochar( data_shape(1:rank) ) ), &
2498 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
2499 end if
2500 stat = gt_eargsizemismatch
2501 cause_c = 'array'
2502 goto 999
2503 end if
2504 !-------------------------------------
2505 ! データ取得
2506 ! Get data
2507 call inquire( var = var, & ! (in)
2508 & size = domain ) ! (out)
2509 if ( allocated( array_tmp ) ) deallocate( array_tmp )
2510 allocate( array_tmp(array_allsize) )
2511 call get( var, array_tmp, domain )
2512 array = reshape( array_tmp, array_shape )
2513 deallocate( array_tmp )
2514 call close( var )
2515 !-------------------------------------
2516 ! データファイル名と切り出し範囲の印字
2517 ! Print data filename and clipping range
2518 call actual_iorange_dump(url, & ! (in)
2519 & actual_url, returned_time, & ! (out) optional
2520 & time_name = tname, & ! (in) optional
2521 & err = err) ! (out) optional
2522 if ( .not. present_and_true(quiet) ) then
2523 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
2524 end if
2525999 continue
2526 call storeerror(stat, subname, err, cause_c)
2527end subroutine historygetreal4
2528subroutine historygetreal5(file, varname, array, range, &
2529 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
2530 use gtdata_types, only: gt_variable
2531 use gtdata_generic, only: open, inquire, close, get
2532 use dc_string, only: tochar
2534 use dc_regex, only: match
2535 use dc_types, only: string, dp, sp
2536 use dc_message, only: messagenotify
2539 implicit none
2540 character(*), intent(in):: file
2541 character(*), intent(in):: varname
2542 character(*), intent(in), optional:: range
2543 logical, intent(in), optional:: quiet
2544 logical, intent(in), optional:: flag_mpi_split
2545 real(DP), intent(out), optional:: returned_time ! データの時刻
2546 logical, intent(out), optional:: flag_time_exist
2547 logical, intent(out), optional:: err
2548 real(SP), intent(out) :: array(:,:,:,:,:)
2549 real(SP), allocatable :: array_tmp(:)
2550 integer:: array_allsize
2551 integer:: array_shape(5), data_shape(5), array_shape_check(5)
2552 integer:: allcount
2553 integer:: i, sd
2554 logical:: inq_err
2555 type(gt_variable):: var
2556 character(STRING):: file_work, url, actual_url
2557 integer:: rank, alldims, array_rank
2558 integer:: domain
2559 character(STRING):: tname
2560 integer:: stat
2561 character(STRING):: cause_c
2562 character(*), parameter :: subname = "HistoryGetReal5"
2563 interface
2564 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
2565 character(*), intent(in):: file
2566 character(*), intent(in):: varname
2567 character(*), intent(out):: url
2568 character(*), intent(in), optional:: range
2569 logical, intent(out), optional:: flag_time_exist
2570 character(*), intent(out), optional:: time_name
2571 logical, intent(out), optional:: err
2572 end subroutine lookup_growable_url
2573 end interface
2574 interface
2575 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
2576 use dc_types, only: dp
2577 character(*), intent(in) :: url ! 変数 URL
2578 character(*), intent(out), optional :: actual_url
2579 ! 正確な入出力範囲指定
2580 real(DP), intent(out), optional:: returned_time ! データの時刻
2581 character(*), intent(in), optional:: time_name ! 時刻次元の名称
2582 logical, intent(out), optional :: err ! エラーのフラグ
2583 end subroutine actual_iorange_dump
2584 end interface
2585 interface
2586 function file_rename_mpi( file ) result(result)
2587 use dc_types, only: string
2588 character(*), intent(in):: file
2589 character(STRING):: result
2590 end function file_rename_mpi
2591 end interface
2592 continue
2593 cause_c = ''
2594 stat = dc_noerr
2595 file_work = file
2596 array_shape = shape( array )
2597 array_allsize = size( array )
2598 ! ファイル名の変更 (MPI 用)
2599 ! Change filename (for MPI)
2600 !
2601 if ( present_and_true( flag_mpi_split ) ) &
2602 & file_work = file_rename_mpi( file_work )
2603 ! 最新時刻の URL 取得
2604 ! Get URL of latest time
2605 !
2606 call lookup_growable_url(file_work, varname, url, range, &
2607 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
2608 if ( present_and_true(err) ) then
2609 stat = gt_enoturl
2610 cause_c = url
2611 goto 999
2612 end if
2613 ! ファイルオープン
2614 ! File open
2615 call open( var, url, err = err )
2616 if ( present_and_true(err) ) then
2617 stat = gt_enoturl
2618 cause_c = url
2619 goto 999
2620 end if
2621 !-------------------------------------------------------------------
2622 ! 配列形状のチェック
2623 ! Check array shape
2624 !-------------------------------------------------------------------
2625 ! 入力ファイル中のデータの次元数
2626 ! Get size of dimesions in data of an input file
2627 !
2628 call inquire( var = var, & ! (in)
2629 & rank = rank, alldims = alldims ) ! (out)
2630 ! 引数の次元数のチェック (縮退されている場合には減らす)
2631 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
2632 array_rank = 5
2633 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
2634 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
2635 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
2636 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
2637 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
2638 ! 次元数の比較
2639 ! Compare sizes of dimensions
2640 !
2641 if ( .not. 5 == rank .and. .not. array_rank == rank ) then
2642 if ( .not. present_and_true(quiet) ) then
2643 call messagenotify('W', subname, &
2644 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
2645 & i = (/rank, 5/), c1 = trim(url) )
2646 end if
2647 stat = gt_erankmismatch
2648 cause_c = 'array'
2649 goto 999
2650 end if
2651 ! 入力ファイル中のデータの配列形状取得
2652 ! Get shape of data in an input file
2653 call inquire( var = var , dimord = 1, & ! (in)
2654 & allcount = allcount, err = inq_err ) ! (out)
2655 if ( .not. inq_err ) then
2656 data_shape(1) = allcount
2657 else
2658 data_shape(1) = 1
2659 end if
2660 call inquire( var = var , dimord = 2, & ! (in)
2661 & allcount = allcount, err = inq_err ) ! (out)
2662 if ( .not. inq_err ) then
2663 data_shape(2) = allcount
2664 else
2665 data_shape(2) = 1
2666 end if
2667 call inquire( var = var , dimord = 3, & ! (in)
2668 & allcount = allcount, err = inq_err ) ! (out)
2669 if ( .not. inq_err ) then
2670 data_shape(3) = allcount
2671 else
2672 data_shape(3) = 1
2673 end if
2674 call inquire( var = var , dimord = 4, & ! (in)
2675 & allcount = allcount, err = inq_err ) ! (out)
2676 if ( .not. inq_err ) then
2677 data_shape(4) = allcount
2678 else
2679 data_shape(4) = 1
2680 end if
2681 call inquire( var = var , dimord = 5, & ! (in)
2682 & allcount = allcount, err = inq_err ) ! (out)
2683 if ( .not. inq_err ) then
2684 data_shape(5) = allcount
2685 else
2686 data_shape(5) = 1
2687 end if
2688 ! 引数の配列形状整形
2689 ! Arrange shape of an argument
2690 !
2691 array_shape_check = array_shape
2692 sd = 1
2693 do i = 1, 5 - 1
2694 if ( array_shape_check(sd) == 1 ) then
2695 array_shape_check(sd:5) = cshift( array_shape_check(sd:5), 1, 1 )
2696 else
2697 sd = sd + 1
2698 end if
2699 end do
2700 ! 配列形状の比較
2701 ! Compare shapes
2702 !
2703 if ( .not. all( array_shape_check == data_shape ) ) then
2704 if ( .not. present_and_true(quiet) ) then
2705 call messagenotify('W', subname, &
2706 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
2707 & c1 = trim( url ), &
2708 & c2 = trim( tochar( data_shape(1:rank) ) ), &
2709 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
2710 end if
2711 stat = gt_eargsizemismatch
2712 cause_c = 'array'
2713 goto 999
2714 end if
2715 !-------------------------------------
2716 ! データ取得
2717 ! Get data
2718 call inquire( var = var, & ! (in)
2719 & size = domain ) ! (out)
2720 if ( allocated( array_tmp ) ) deallocate( array_tmp )
2721 allocate( array_tmp(array_allsize) )
2722 call get( var, array_tmp, domain )
2723 array = reshape( array_tmp, array_shape )
2724 deallocate( array_tmp )
2725 call close( var )
2726 !-------------------------------------
2727 ! データファイル名と切り出し範囲の印字
2728 ! Print data filename and clipping range
2729 call actual_iorange_dump(url, & ! (in)
2730 & actual_url, returned_time, & ! (out) optional
2731 & time_name = tname, & ! (in) optional
2732 & err = err) ! (out) optional
2733 if ( .not. present_and_true(quiet) ) then
2734 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
2735 end if
2736999 continue
2737 call storeerror(stat, subname, err, cause_c)
2738end subroutine historygetreal5
2739subroutine historygetreal6(file, varname, array, range, &
2740 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
2741 use gtdata_types, only: gt_variable
2742 use gtdata_generic, only: open, inquire, close, get
2743 use dc_string, only: tochar
2745 use dc_regex, only: match
2746 use dc_types, only: string, dp, sp
2747 use dc_message, only: messagenotify
2750 implicit none
2751 character(*), intent(in):: file
2752 character(*), intent(in):: varname
2753 character(*), intent(in), optional:: range
2754 logical, intent(in), optional:: quiet
2755 logical, intent(in), optional:: flag_mpi_split
2756 real(DP), intent(out), optional:: returned_time ! データの時刻
2757 logical, intent(out), optional:: flag_time_exist
2758 logical, intent(out), optional:: err
2759 real(SP), intent(out) :: array(:,:,:,:,:,:)
2760 real(SP), allocatable :: array_tmp(:)
2761 integer:: array_allsize
2762 integer:: array_shape(6), data_shape(6), array_shape_check(6)
2763 integer:: allcount
2764 integer:: i, sd
2765 logical:: inq_err
2766 type(gt_variable):: var
2767 character(STRING):: file_work, url, actual_url
2768 integer:: rank, alldims, array_rank
2769 integer:: domain
2770 character(STRING):: tname
2771 integer:: stat
2772 character(STRING):: cause_c
2773 character(*), parameter :: subname = "HistoryGetReal6"
2774 interface
2775 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
2776 character(*), intent(in):: file
2777 character(*), intent(in):: varname
2778 character(*), intent(out):: url
2779 character(*), intent(in), optional:: range
2780 logical, intent(out), optional:: flag_time_exist
2781 character(*), intent(out), optional:: time_name
2782 logical, intent(out), optional:: err
2783 end subroutine lookup_growable_url
2784 end interface
2785 interface
2786 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
2787 use dc_types, only: dp
2788 character(*), intent(in) :: url ! 変数 URL
2789 character(*), intent(out), optional :: actual_url
2790 ! 正確な入出力範囲指定
2791 real(DP), intent(out), optional:: returned_time ! データの時刻
2792 character(*), intent(in), optional:: time_name ! 時刻次元の名称
2793 logical, intent(out), optional :: err ! エラーのフラグ
2794 end subroutine actual_iorange_dump
2795 end interface
2796 interface
2797 function file_rename_mpi( file ) result(result)
2798 use dc_types, only: string
2799 character(*), intent(in):: file
2800 character(STRING):: result
2801 end function file_rename_mpi
2802 end interface
2803 continue
2804 cause_c = ''
2805 stat = dc_noerr
2806 file_work = file
2807 array_shape = shape( array )
2808 array_allsize = size( array )
2809 ! ファイル名の変更 (MPI 用)
2810 ! Change filename (for MPI)
2811 !
2812 if ( present_and_true( flag_mpi_split ) ) &
2813 & file_work = file_rename_mpi( file_work )
2814 ! 最新時刻の URL 取得
2815 ! Get URL of latest time
2816 !
2817 call lookup_growable_url(file_work, varname, url, range, &
2818 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
2819 if ( present_and_true(err) ) then
2820 stat = gt_enoturl
2821 cause_c = url
2822 goto 999
2823 end if
2824 ! ファイルオープン
2825 ! File open
2826 call open( var, url, err = err )
2827 if ( present_and_true(err) ) then
2828 stat = gt_enoturl
2829 cause_c = url
2830 goto 999
2831 end if
2832 !-------------------------------------------------------------------
2833 ! 配列形状のチェック
2834 ! Check array shape
2835 !-------------------------------------------------------------------
2836 ! 入力ファイル中のデータの次元数
2837 ! Get size of dimesions in data of an input file
2838 !
2839 call inquire( var = var, & ! (in)
2840 & rank = rank, alldims = alldims ) ! (out)
2841 ! 引数の次元数のチェック (縮退されている場合には減らす)
2842 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
2843 array_rank = 6
2844 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
2845 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
2846 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
2847 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
2848 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
2849 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
2850 ! 次元数の比較
2851 ! Compare sizes of dimensions
2852 !
2853 if ( .not. 6 == rank .and. .not. array_rank == rank ) then
2854 if ( .not. present_and_true(quiet) ) then
2855 call messagenotify('W', subname, &
2856 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
2857 & i = (/rank, 6/), c1 = trim(url) )
2858 end if
2859 stat = gt_erankmismatch
2860 cause_c = 'array'
2861 goto 999
2862 end if
2863 ! 入力ファイル中のデータの配列形状取得
2864 ! Get shape of data in an input file
2865 call inquire( var = var , dimord = 1, & ! (in)
2866 & allcount = allcount, err = inq_err ) ! (out)
2867 if ( .not. inq_err ) then
2868 data_shape(1) = allcount
2869 else
2870 data_shape(1) = 1
2871 end if
2872 call inquire( var = var , dimord = 2, & ! (in)
2873 & allcount = allcount, err = inq_err ) ! (out)
2874 if ( .not. inq_err ) then
2875 data_shape(2) = allcount
2876 else
2877 data_shape(2) = 1
2878 end if
2879 call inquire( var = var , dimord = 3, & ! (in)
2880 & allcount = allcount, err = inq_err ) ! (out)
2881 if ( .not. inq_err ) then
2882 data_shape(3) = allcount
2883 else
2884 data_shape(3) = 1
2885 end if
2886 call inquire( var = var , dimord = 4, & ! (in)
2887 & allcount = allcount, err = inq_err ) ! (out)
2888 if ( .not. inq_err ) then
2889 data_shape(4) = allcount
2890 else
2891 data_shape(4) = 1
2892 end if
2893 call inquire( var = var , dimord = 5, & ! (in)
2894 & allcount = allcount, err = inq_err ) ! (out)
2895 if ( .not. inq_err ) then
2896 data_shape(5) = allcount
2897 else
2898 data_shape(5) = 1
2899 end if
2900 call inquire( var = var , dimord = 6, & ! (in)
2901 & allcount = allcount, err = inq_err ) ! (out)
2902 if ( .not. inq_err ) then
2903 data_shape(6) = allcount
2904 else
2905 data_shape(6) = 1
2906 end if
2907 ! 引数の配列形状整形
2908 ! Arrange shape of an argument
2909 !
2910 array_shape_check = array_shape
2911 sd = 1
2912 do i = 1, 6 - 1
2913 if ( array_shape_check(sd) == 1 ) then
2914 array_shape_check(sd:6) = cshift( array_shape_check(sd:6), 1, 1 )
2915 else
2916 sd = sd + 1
2917 end if
2918 end do
2919 ! 配列形状の比較
2920 ! Compare shapes
2921 !
2922 if ( .not. all( array_shape_check == data_shape ) ) then
2923 if ( .not. present_and_true(quiet) ) then
2924 call messagenotify('W', subname, &
2925 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
2926 & c1 = trim( url ), &
2927 & c2 = trim( tochar( data_shape(1:rank) ) ), &
2928 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
2929 end if
2930 stat = gt_eargsizemismatch
2931 cause_c = 'array'
2932 goto 999
2933 end if
2934 !-------------------------------------
2935 ! データ取得
2936 ! Get data
2937 call inquire( var = var, & ! (in)
2938 & size = domain ) ! (out)
2939 if ( allocated( array_tmp ) ) deallocate( array_tmp )
2940 allocate( array_tmp(array_allsize) )
2941 call get( var, array_tmp, domain )
2942 array = reshape( array_tmp, array_shape )
2943 deallocate( array_tmp )
2944 call close( var )
2945 !-------------------------------------
2946 ! データファイル名と切り出し範囲の印字
2947 ! Print data filename and clipping range
2948 call actual_iorange_dump(url, & ! (in)
2949 & actual_url, returned_time, & ! (out) optional
2950 & time_name = tname, & ! (in) optional
2951 & err = err) ! (out) optional
2952 if ( .not. present_and_true(quiet) ) then
2953 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
2954 end if
2955999 continue
2956 call storeerror(stat, subname, err, cause_c)
2957end subroutine historygetreal6
2958subroutine historygetreal7(file, varname, array, range, &
2959 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
2960 use gtdata_types, only: gt_variable
2961 use gtdata_generic, only: open, inquire, close, get
2962 use dc_string, only: tochar
2964 use dc_regex, only: match
2965 use dc_types, only: string, dp, sp
2966 use dc_message, only: messagenotify
2969 implicit none
2970 character(*), intent(in):: file
2971 character(*), intent(in):: varname
2972 character(*), intent(in), optional:: range
2973 logical, intent(in), optional:: quiet
2974 logical, intent(in), optional:: flag_mpi_split
2975 real(DP), intent(out), optional:: returned_time ! データの時刻
2976 logical, intent(out), optional:: flag_time_exist
2977 logical, intent(out), optional:: err
2978 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
2979 real(SP), allocatable :: array_tmp(:)
2980 integer:: array_allsize
2981 integer:: array_shape(7), data_shape(7), array_shape_check(7)
2982 integer:: allcount
2983 integer:: i, sd
2984 logical:: inq_err
2985 type(gt_variable):: var
2986 character(STRING):: file_work, url, actual_url
2987 integer:: rank, alldims, array_rank
2988 integer:: domain
2989 character(STRING):: tname
2990 integer:: stat
2991 character(STRING):: cause_c
2992 character(*), parameter :: subname = "HistoryGetReal7"
2993 interface
2994 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
2995 character(*), intent(in):: file
2996 character(*), intent(in):: varname
2997 character(*), intent(out):: url
2998 character(*), intent(in), optional:: range
2999 logical, intent(out), optional:: flag_time_exist
3000 character(*), intent(out), optional:: time_name
3001 logical, intent(out), optional:: err
3002 end subroutine lookup_growable_url
3003 end interface
3004 interface
3005 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3006 use dc_types, only: dp
3007 character(*), intent(in) :: url ! 変数 URL
3008 character(*), intent(out), optional :: actual_url
3009 ! 正確な入出力範囲指定
3010 real(DP), intent(out), optional:: returned_time ! データの時刻
3011 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3012 logical, intent(out), optional :: err ! エラーのフラグ
3013 end subroutine actual_iorange_dump
3014 end interface
3015 interface
3016 function file_rename_mpi( file ) result(result)
3017 use dc_types, only: string
3018 character(*), intent(in):: file
3019 character(STRING):: result
3020 end function file_rename_mpi
3021 end interface
3022 continue
3023 cause_c = ''
3024 stat = dc_noerr
3025 file_work = file
3026 array_shape = shape( array )
3027 array_allsize = size( array )
3028 ! ファイル名の変更 (MPI 用)
3029 ! Change filename (for MPI)
3030 !
3031 if ( present_and_true( flag_mpi_split ) ) &
3032 & file_work = file_rename_mpi( file_work )
3033 ! 最新時刻の URL 取得
3034 ! Get URL of latest time
3035 !
3036 call lookup_growable_url(file_work, varname, url, range, &
3037 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3038 if ( present_and_true(err) ) then
3039 stat = gt_enoturl
3040 cause_c = url
3041 goto 999
3042 end if
3043 ! ファイルオープン
3044 ! File open
3045 call open( var, url, err = err )
3046 if ( present_and_true(err) ) then
3047 stat = gt_enoturl
3048 cause_c = url
3049 goto 999
3050 end if
3051 !-------------------------------------------------------------------
3052 ! 配列形状のチェック
3053 ! Check array shape
3054 !-------------------------------------------------------------------
3055 ! 入力ファイル中のデータの次元数
3056 ! Get size of dimesions in data of an input file
3057 !
3058 call inquire( var = var, & ! (in)
3059 & rank = rank, alldims = alldims ) ! (out)
3060 ! 引数の次元数のチェック (縮退されている場合には減らす)
3061 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3062 array_rank = 7
3063 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
3064 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
3065 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
3066 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
3067 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
3068 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
3069 if ( size( array, 7 ) == 1 ) array_rank = array_rank - 1
3070 ! 次元数の比較
3071 ! Compare sizes of dimensions
3072 !
3073 if ( .not. 7 == rank .and. .not. array_rank == rank ) then
3074 if ( .not. present_and_true(quiet) ) then
3075 call messagenotify('W', subname, &
3076 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3077 & i = (/rank, 7/), c1 = trim(url) )
3078 end if
3079 stat = gt_erankmismatch
3080 cause_c = 'array'
3081 goto 999
3082 end if
3083 ! 入力ファイル中のデータの配列形状取得
3084 ! Get shape of data in an input file
3085 call inquire( var = var , dimord = 1, & ! (in)
3086 & allcount = allcount, err = inq_err ) ! (out)
3087 if ( .not. inq_err ) then
3088 data_shape(1) = allcount
3089 else
3090 data_shape(1) = 1
3091 end if
3092 call inquire( var = var , dimord = 2, & ! (in)
3093 & allcount = allcount, err = inq_err ) ! (out)
3094 if ( .not. inq_err ) then
3095 data_shape(2) = allcount
3096 else
3097 data_shape(2) = 1
3098 end if
3099 call inquire( var = var , dimord = 3, & ! (in)
3100 & allcount = allcount, err = inq_err ) ! (out)
3101 if ( .not. inq_err ) then
3102 data_shape(3) = allcount
3103 else
3104 data_shape(3) = 1
3105 end if
3106 call inquire( var = var , dimord = 4, & ! (in)
3107 & allcount = allcount, err = inq_err ) ! (out)
3108 if ( .not. inq_err ) then
3109 data_shape(4) = allcount
3110 else
3111 data_shape(4) = 1
3112 end if
3113 call inquire( var = var , dimord = 5, & ! (in)
3114 & allcount = allcount, err = inq_err ) ! (out)
3115 if ( .not. inq_err ) then
3116 data_shape(5) = allcount
3117 else
3118 data_shape(5) = 1
3119 end if
3120 call inquire( var = var , dimord = 6, & ! (in)
3121 & allcount = allcount, err = inq_err ) ! (out)
3122 if ( .not. inq_err ) then
3123 data_shape(6) = allcount
3124 else
3125 data_shape(6) = 1
3126 end if
3127 call inquire( var = var , dimord = 7, & ! (in)
3128 & allcount = allcount, err = inq_err ) ! (out)
3129 if ( .not. inq_err ) then
3130 data_shape(7) = allcount
3131 else
3132 data_shape(7) = 1
3133 end if
3134 ! 引数の配列形状整形
3135 ! Arrange shape of an argument
3136 !
3137 array_shape_check = array_shape
3138 sd = 1
3139 do i = 1, 7 - 1
3140 if ( array_shape_check(sd) == 1 ) then
3141 array_shape_check(sd:7) = cshift( array_shape_check(sd:7), 1, 1 )
3142 else
3143 sd = sd + 1
3144 end if
3145 end do
3146 ! 配列形状の比較
3147 ! Compare shapes
3148 !
3149 if ( .not. all( array_shape_check == data_shape ) ) then
3150 if ( .not. present_and_true(quiet) ) then
3151 call messagenotify('W', subname, &
3152 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
3153 & c1 = trim( url ), &
3154 & c2 = trim( tochar( data_shape(1:rank) ) ), &
3155 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
3156 end if
3157 stat = gt_eargsizemismatch
3158 cause_c = 'array'
3159 goto 999
3160 end if
3161 !-------------------------------------
3162 ! データ取得
3163 ! Get data
3164 call inquire( var = var, & ! (in)
3165 & size = domain ) ! (out)
3166 if ( allocated( array_tmp ) ) deallocate( array_tmp )
3167 allocate( array_tmp(array_allsize) )
3168 call get( var, array_tmp, domain )
3169 array = reshape( array_tmp, array_shape )
3170 deallocate( array_tmp )
3171 call close( var )
3172 !-------------------------------------
3173 ! データファイル名と切り出し範囲の印字
3174 ! Print data filename and clipping range
3175 call actual_iorange_dump(url, & ! (in)
3176 & actual_url, returned_time, & ! (out) optional
3177 & time_name = tname, & ! (in) optional
3178 & err = err) ! (out) optional
3179 if ( .not. present_and_true(quiet) ) then
3180 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
3181 end if
3182999 continue
3183 call storeerror(stat, subname, err, cause_c)
3184end subroutine historygetreal7
3185subroutine historygetint0(file, varname, array, range, &
3186 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
3187 use gtdata_types, only: gt_variable
3188 use gtdata_generic, only: open, inquire, close, get
3189 use dc_string, only: tochar
3191 use dc_regex, only: match
3192 use dc_types, only: string, dp
3193 use dc_message, only: messagenotify
3195 implicit none
3196 character(*), intent(in):: file
3197 character(*), intent(in):: varname
3198 character(*), intent(in), optional:: range
3199 logical, intent(in), optional:: quiet
3200 logical, intent(in), optional:: flag_mpi_split
3201 real(DP), intent(out), optional:: returned_time ! データの時刻
3202 logical, intent(out), optional:: flag_time_exist
3203 logical, intent(out), optional:: err
3204 integer, intent(out) :: array
3205 integer :: array_tmp(1)
3206 type(gt_variable):: var
3207 character(STRING):: file_work, url, actual_url
3208 integer:: rank, alldims, array_rank
3209 integer:: domain
3210 character(STRING):: tname
3211 integer:: stat
3212 character(STRING):: cause_c
3213 character(*), parameter :: subname = "HistoryGetInt0"
3214 interface
3215 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
3216 character(*), intent(in):: file
3217 character(*), intent(in):: varname
3218 character(*), intent(out):: url
3219 character(*), intent(in), optional:: range
3220 logical, intent(out), optional:: flag_time_exist
3221 character(*), intent(out), optional:: time_name
3222 logical, intent(out), optional:: err
3223 end subroutine lookup_growable_url
3224 end interface
3225 interface
3226 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3227 use dc_types, only: dp
3228 character(*), intent(in) :: url ! 変数 URL
3229 character(*), intent(out), optional :: actual_url
3230 ! 正確な入出力範囲指定
3231 real(DP), intent(out), optional:: returned_time ! データの時刻
3232 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3233 logical, intent(out), optional :: err ! エラーのフラグ
3234 end subroutine actual_iorange_dump
3235 end interface
3236 interface
3237 function file_rename_mpi( file ) result(result)
3238 use dc_types, only: string
3239 character(*), intent(in):: file
3240 character(STRING):: result
3241 end function file_rename_mpi
3242 end interface
3243 continue
3244 cause_c = ''
3245 stat = dc_noerr
3246 file_work = file
3247 ! ファイル名の変更 (MPI 用)
3248 ! Change filename (for MPI)
3249 !
3250 if ( present_and_true( flag_mpi_split ) ) &
3251 & file_work = file_rename_mpi( file_work )
3252 ! 最新時刻の URL 取得
3253 ! Get URL of latest time
3254 !
3255 call lookup_growable_url(file_work, varname, url, range, &
3256 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3257 if ( present_and_true(err) ) then
3258 stat = gt_enoturl
3259 cause_c = url
3260 goto 999
3261 end if
3262 ! ファイルオープン
3263 ! File open
3264 call open( var, url, err = err )
3265 if ( present_and_true(err) ) then
3266 stat = gt_enoturl
3267 cause_c = url
3268 goto 999
3269 end if
3270 !-------------------------------------------------------------------
3271 ! 配列形状のチェック
3272 ! Check array shape
3273 !-------------------------------------------------------------------
3274 ! 入力ファイル中のデータの次元数
3275 ! Get size of dimesions in data of an input file
3276 !
3277 call inquire( var = var, & ! (in)
3278 & rank = rank, alldims = alldims ) ! (out)
3279 ! 引数の次元数のチェック (縮退されている場合には減らす)
3280 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3281 array_rank = 0
3282 ! 次元数の比較
3283 ! Compare sizes of dimensions
3284 !
3285 if ( .not. 0 == rank .and. .not. array_rank == rank ) then
3286 if ( .not. present_and_true(quiet) ) then
3287 call messagenotify('W', subname, &
3288 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3289 & i = (/rank, 0/), c1 = trim(url) )
3290 end if
3291 stat = gt_erankmismatch
3292 cause_c = 'array'
3293 goto 999
3294 end if
3295 ! 入力ファイル中のデータの配列形状取得
3296 ! Get shape of data in an input file
3297 !-------------------------------------
3298 ! データ取得
3299 ! Get data
3300 call inquire( var = var, & ! (in)
3301 & size = domain ) ! (out)
3302 call get( var = var, & ! (inout)
3303 & nvalue = domain, & ! (in)
3304 & value = array_tmp) ! (out)
3305 array = array_tmp(1)
3306 call close( var )
3307 !-------------------------------------
3308 ! データファイル名と切り出し範囲の印字
3309 ! Print data filename and clipping range
3310 call actual_iorange_dump(url, & ! (in)
3311 & actual_url, returned_time, & ! (out) optional
3312 & time_name = tname, & ! (in) optional
3313 & err = err) ! (out) optional
3314 if ( .not. present_and_true(quiet) ) then
3315 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
3316 end if
3317999 continue
3318 call storeerror(stat, subname, err, cause_c)
3319end subroutine historygetint0
3320subroutine historygetint1(file, varname, array, range, &
3321 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
3322 use gtdata_types, only: gt_variable
3323 use gtdata_generic, only: open, inquire, close, get
3324 use dc_string, only: tochar
3326 use dc_regex, only: match
3327 use dc_types, only: string, dp
3328 use dc_message, only: messagenotify
3331 implicit none
3332 character(*), intent(in):: file
3333 character(*), intent(in):: varname
3334 character(*), intent(in), optional:: range
3335 logical, intent(in), optional:: quiet
3336 logical, intent(in), optional:: flag_mpi_split
3337 real(DP), intent(out), optional:: returned_time ! データの時刻
3338 logical, intent(out), optional:: flag_time_exist
3339 logical, intent(out), optional:: err
3340 integer, intent(out) :: array(:)
3341 integer, allocatable :: array_tmp(:)
3342 integer:: array_allsize
3343 integer:: array_shape(1), data_shape(1), array_shape_check(1)
3344 integer:: allcount
3345 logical:: inq_err
3346 type(gt_variable):: var
3347 character(STRING):: file_work, url, actual_url
3348 integer:: rank, alldims, array_rank
3349 integer:: domain
3350 character(STRING):: tname
3351 integer:: stat
3352 character(STRING):: cause_c
3353 character(*), parameter :: subname = "HistoryGetInt1"
3354 interface
3355 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
3356 character(*), intent(in):: file
3357 character(*), intent(in):: varname
3358 character(*), intent(out):: url
3359 character(*), intent(in), optional:: range
3360 logical, intent(out), optional:: flag_time_exist
3361 character(*), intent(out), optional:: time_name
3362 logical, intent(out), optional:: err
3363 end subroutine lookup_growable_url
3364 end interface
3365 interface
3366 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3367 use dc_types, only: dp
3368 character(*), intent(in) :: url ! 変数 URL
3369 character(*), intent(out), optional :: actual_url
3370 ! 正確な入出力範囲指定
3371 real(DP), intent(out), optional:: returned_time ! データの時刻
3372 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3373 logical, intent(out), optional :: err ! エラーのフラグ
3374 end subroutine actual_iorange_dump
3375 end interface
3376 interface
3377 function file_rename_mpi( file ) result(result)
3378 use dc_types, only: string
3379 character(*), intent(in):: file
3380 character(STRING):: result
3381 end function file_rename_mpi
3382 end interface
3383 continue
3384 cause_c = ''
3385 stat = dc_noerr
3386 file_work = file
3387 array_shape = shape( array )
3388 array_allsize = size( array )
3389 ! ファイル名の変更 (MPI 用)
3390 ! Change filename (for MPI)
3391 !
3392 if ( present_and_true( flag_mpi_split ) ) &
3393 & file_work = file_rename_mpi( file_work )
3394 ! 最新時刻の URL 取得
3395 ! Get URL of latest time
3396 !
3397 call lookup_growable_url(file_work, varname, url, range, &
3398 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3399 if ( present_and_true(err) ) then
3400 stat = gt_enoturl
3401 cause_c = url
3402 goto 999
3403 end if
3404 ! ファイルオープン
3405 ! File open
3406 call open( var, url, err = err )
3407 if ( present_and_true(err) ) then
3408 stat = gt_enoturl
3409 cause_c = url
3410 goto 999
3411 end if
3412 !-------------------------------------------------------------------
3413 ! 配列形状のチェック
3414 ! Check array shape
3415 !-------------------------------------------------------------------
3416 ! 入力ファイル中のデータの次元数
3417 ! Get size of dimesions in data of an input file
3418 !
3419 call inquire( var = var, & ! (in)
3420 & rank = rank, alldims = alldims ) ! (out)
3421 ! 引数の次元数のチェック (縮退されている場合には減らす)
3422 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3423 array_rank = 1
3424 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
3425 ! 次元数の比較
3426 ! Compare sizes of dimensions
3427 !
3428 if ( .not. 1 == rank .and. .not. array_rank == rank ) then
3429 if ( .not. present_and_true(quiet) ) then
3430 call messagenotify('W', subname, &
3431 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3432 & i = (/rank, 1/), c1 = trim(url) )
3433 end if
3434 stat = gt_erankmismatch
3435 cause_c = 'array'
3436 goto 999
3437 end if
3438 ! 入力ファイル中のデータの配列形状取得
3439 ! Get shape of data in an input file
3440 call inquire( var = var , dimord = 1, & ! (in)
3441 & allcount = allcount, err = inq_err ) ! (out)
3442 if ( .not. inq_err ) then
3443 data_shape(1) = allcount
3444 else
3445 data_shape(1) = 1
3446 end if
3447 ! 引数の配列形状整形
3448 ! Arrange shape of an argument
3449 !
3450 array_shape_check = array_shape
3451 ! 配列形状の比較
3452 ! Compare shapes
3453 !
3454 if ( .not. all( array_shape_check == data_shape ) ) then
3455 if ( .not. present_and_true(quiet) ) then
3456 call messagenotify('W', subname, &
3457 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
3458 & c1 = trim( url ), &
3459 & c2 = trim( tochar( data_shape(1:rank) ) ), &
3460 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
3461 end if
3462 stat = gt_eargsizemismatch
3463 cause_c = 'array'
3464 goto 999
3465 end if
3466 !-------------------------------------
3467 ! データ取得
3468 ! Get data
3469 call inquire( var = var, & ! (in)
3470 & size = domain ) ! (out)
3471 if ( allocated( array_tmp ) ) deallocate( array_tmp )
3472 allocate( array_tmp(array_allsize) )
3473 call get( var, array_tmp, domain )
3474 array = reshape( array_tmp, array_shape )
3475 deallocate( array_tmp )
3476 call close( var )
3477 !-------------------------------------
3478 ! データファイル名と切り出し範囲の印字
3479 ! Print data filename and clipping range
3480 call actual_iorange_dump(url, & ! (in)
3481 & actual_url, returned_time, & ! (out) optional
3482 & time_name = tname, & ! (in) optional
3483 & err = err) ! (out) optional
3484 if ( .not. present_and_true(quiet) ) then
3485 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
3486 end if
3487999 continue
3488 call storeerror(stat, subname, err, cause_c)
3489end subroutine historygetint1
3490subroutine historygetint2(file, varname, array, range, &
3491 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
3492 use gtdata_types, only: gt_variable
3493 use gtdata_generic, only: open, inquire, close, get
3494 use dc_string, only: tochar
3496 use dc_regex, only: match
3497 use dc_types, only: string, dp
3498 use dc_message, only: messagenotify
3501 implicit none
3502 character(*), intent(in):: file
3503 character(*), intent(in):: varname
3504 character(*), intent(in), optional:: range
3505 logical, intent(in), optional:: quiet
3506 logical, intent(in), optional:: flag_mpi_split
3507 real(DP), intent(out), optional:: returned_time ! データの時刻
3508 logical, intent(out), optional:: flag_time_exist
3509 logical, intent(out), optional:: err
3510 integer, intent(out) :: array(:,:)
3511 integer, allocatable :: array_tmp(:)
3512 integer:: array_allsize
3513 integer:: array_shape(2), data_shape(2), array_shape_check(2)
3514 integer:: allcount
3515 integer:: i, sd
3516 logical:: inq_err
3517 type(gt_variable):: var
3518 character(STRING):: file_work, url, actual_url
3519 integer:: rank, alldims, array_rank
3520 integer:: domain
3521 character(STRING):: tname
3522 integer:: stat
3523 character(STRING):: cause_c
3524 character(*), parameter :: subname = "HistoryGetInt2"
3525 interface
3526 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
3527 character(*), intent(in):: file
3528 character(*), intent(in):: varname
3529 character(*), intent(out):: url
3530 character(*), intent(in), optional:: range
3531 logical, intent(out), optional:: flag_time_exist
3532 character(*), intent(out), optional:: time_name
3533 logical, intent(out), optional:: err
3534 end subroutine lookup_growable_url
3535 end interface
3536 interface
3537 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3538 use dc_types, only: dp
3539 character(*), intent(in) :: url ! 変数 URL
3540 character(*), intent(out), optional :: actual_url
3541 ! 正確な入出力範囲指定
3542 real(DP), intent(out), optional:: returned_time ! データの時刻
3543 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3544 logical, intent(out), optional :: err ! エラーのフラグ
3545 end subroutine actual_iorange_dump
3546 end interface
3547 interface
3548 function file_rename_mpi( file ) result(result)
3549 use dc_types, only: string
3550 character(*), intent(in):: file
3551 character(STRING):: result
3552 end function file_rename_mpi
3553 end interface
3554 continue
3555 cause_c = ''
3556 stat = dc_noerr
3557 file_work = file
3558 array_shape = shape( array )
3559 array_allsize = size( array )
3560 ! ファイル名の変更 (MPI 用)
3561 ! Change filename (for MPI)
3562 !
3563 if ( present_and_true( flag_mpi_split ) ) &
3564 & file_work = file_rename_mpi( file_work )
3565 ! 最新時刻の URL 取得
3566 ! Get URL of latest time
3567 !
3568 call lookup_growable_url(file_work, varname, url, range, &
3569 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3570 if ( present_and_true(err) ) then
3571 stat = gt_enoturl
3572 cause_c = url
3573 goto 999
3574 end if
3575 ! ファイルオープン
3576 ! File open
3577 call open( var, url, err = err )
3578 if ( present_and_true(err) ) then
3579 stat = gt_enoturl
3580 cause_c = url
3581 goto 999
3582 end if
3583 !-------------------------------------------------------------------
3584 ! 配列形状のチェック
3585 ! Check array shape
3586 !-------------------------------------------------------------------
3587 ! 入力ファイル中のデータの次元数
3588 ! Get size of dimesions in data of an input file
3589 !
3590 call inquire( var = var, & ! (in)
3591 & rank = rank, alldims = alldims ) ! (out)
3592 ! 引数の次元数のチェック (縮退されている場合には減らす)
3593 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3594 array_rank = 2
3595 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
3596 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
3597 ! 次元数の比較
3598 ! Compare sizes of dimensions
3599 !
3600 if ( .not. 2 == rank .and. .not. array_rank == rank ) then
3601 if ( .not. present_and_true(quiet) ) then
3602 call messagenotify('W', subname, &
3603 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3604 & i = (/rank, 2/), c1 = trim(url) )
3605 end if
3606 stat = gt_erankmismatch
3607 cause_c = 'array'
3608 goto 999
3609 end if
3610 ! 入力ファイル中のデータの配列形状取得
3611 ! Get shape of data in an input file
3612 call inquire( var = var , dimord = 1, & ! (in)
3613 & allcount = allcount, err = inq_err ) ! (out)
3614 if ( .not. inq_err ) then
3615 data_shape(1) = allcount
3616 else
3617 data_shape(1) = 1
3618 end if
3619 call inquire( var = var , dimord = 2, & ! (in)
3620 & allcount = allcount, err = inq_err ) ! (out)
3621 if ( .not. inq_err ) then
3622 data_shape(2) = allcount
3623 else
3624 data_shape(2) = 1
3625 end if
3626 ! 引数の配列形状整形
3627 ! Arrange shape of an argument
3628 !
3629 array_shape_check = array_shape
3630 sd = 1
3631 do i = 1, 2 - 1
3632 if ( array_shape_check(sd) == 1 ) then
3633 array_shape_check(sd:2) = cshift( array_shape_check(sd:2), 1, 1 )
3634 else
3635 sd = sd + 1
3636 end if
3637 end do
3638 ! 配列形状の比較
3639 ! Compare shapes
3640 !
3641 if ( .not. all( array_shape_check == data_shape ) ) then
3642 if ( .not. present_and_true(quiet) ) then
3643 call messagenotify('W', subname, &
3644 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
3645 & c1 = trim( url ), &
3646 & c2 = trim( tochar( data_shape(1:rank) ) ), &
3647 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
3648 end if
3649 stat = gt_eargsizemismatch
3650 cause_c = 'array'
3651 goto 999
3652 end if
3653 !-------------------------------------
3654 ! データ取得
3655 ! Get data
3656 call inquire( var = var, & ! (in)
3657 & size = domain ) ! (out)
3658 if ( allocated( array_tmp ) ) deallocate( array_tmp )
3659 allocate( array_tmp(array_allsize) )
3660 call get( var, array_tmp, domain )
3661 array = reshape( array_tmp, array_shape )
3662 deallocate( array_tmp )
3663 call close( var )
3664 !-------------------------------------
3665 ! データファイル名と切り出し範囲の印字
3666 ! Print data filename and clipping range
3667 call actual_iorange_dump(url, & ! (in)
3668 & actual_url, returned_time, & ! (out) optional
3669 & time_name = tname, & ! (in) optional
3670 & err = err) ! (out) optional
3671 if ( .not. present_and_true(quiet) ) then
3672 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
3673 end if
3674999 continue
3675 call storeerror(stat, subname, err, cause_c)
3676end subroutine historygetint2
3677subroutine historygetint3(file, varname, array, range, &
3678 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
3679 use gtdata_types, only: gt_variable
3680 use gtdata_generic, only: open, inquire, close, get
3681 use dc_string, only: tochar
3683 use dc_regex, only: match
3684 use dc_types, only: string, dp
3685 use dc_message, only: messagenotify
3688 implicit none
3689 character(*), intent(in):: file
3690 character(*), intent(in):: varname
3691 character(*), intent(in), optional:: range
3692 logical, intent(in), optional:: quiet
3693 logical, intent(in), optional:: flag_mpi_split
3694 real(DP), intent(out), optional:: returned_time ! データの時刻
3695 logical, intent(out), optional:: flag_time_exist
3696 logical, intent(out), optional:: err
3697 integer, intent(out) :: array(:,:,:)
3698 integer, allocatable :: array_tmp(:)
3699 integer:: array_allsize
3700 integer:: array_shape(3), data_shape(3), array_shape_check(3)
3701 integer:: allcount
3702 integer:: i, sd
3703 logical:: inq_err
3704 type(gt_variable):: var
3705 character(STRING):: file_work, url, actual_url
3706 integer:: rank, alldims, array_rank
3707 integer:: domain
3708 character(STRING):: tname
3709 integer:: stat
3710 character(STRING):: cause_c
3711 character(*), parameter :: subname = "HistoryGetInt3"
3712 interface
3713 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
3714 character(*), intent(in):: file
3715 character(*), intent(in):: varname
3716 character(*), intent(out):: url
3717 character(*), intent(in), optional:: range
3718 logical, intent(out), optional:: flag_time_exist
3719 character(*), intent(out), optional:: time_name
3720 logical, intent(out), optional:: err
3721 end subroutine lookup_growable_url
3722 end interface
3723 interface
3724 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3725 use dc_types, only: dp
3726 character(*), intent(in) :: url ! 変数 URL
3727 character(*), intent(out), optional :: actual_url
3728 ! 正確な入出力範囲指定
3729 real(DP), intent(out), optional:: returned_time ! データの時刻
3730 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3731 logical, intent(out), optional :: err ! エラーのフラグ
3732 end subroutine actual_iorange_dump
3733 end interface
3734 interface
3735 function file_rename_mpi( file ) result(result)
3736 use dc_types, only: string
3737 character(*), intent(in):: file
3738 character(STRING):: result
3739 end function file_rename_mpi
3740 end interface
3741 continue
3742 cause_c = ''
3743 stat = dc_noerr
3744 file_work = file
3745 array_shape = shape( array )
3746 array_allsize = size( array )
3747 ! ファイル名の変更 (MPI 用)
3748 ! Change filename (for MPI)
3749 !
3750 if ( present_and_true( flag_mpi_split ) ) &
3751 & file_work = file_rename_mpi( file_work )
3752 ! 最新時刻の URL 取得
3753 ! Get URL of latest time
3754 !
3755 call lookup_growable_url(file_work, varname, url, range, &
3756 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3757 if ( present_and_true(err) ) then
3758 stat = gt_enoturl
3759 cause_c = url
3760 goto 999
3761 end if
3762 ! ファイルオープン
3763 ! File open
3764 call open( var, url, err = err )
3765 if ( present_and_true(err) ) then
3766 stat = gt_enoturl
3767 cause_c = url
3768 goto 999
3769 end if
3770 !-------------------------------------------------------------------
3771 ! 配列形状のチェック
3772 ! Check array shape
3773 !-------------------------------------------------------------------
3774 ! 入力ファイル中のデータの次元数
3775 ! Get size of dimesions in data of an input file
3776 !
3777 call inquire( var = var, & ! (in)
3778 & rank = rank, alldims = alldims ) ! (out)
3779 ! 引数の次元数のチェック (縮退されている場合には減らす)
3780 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3781 array_rank = 3
3782 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
3783 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
3784 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
3785 ! 次元数の比較
3786 ! Compare sizes of dimensions
3787 !
3788 if ( .not. 3 == rank .and. .not. array_rank == rank ) then
3789 if ( .not. present_and_true(quiet) ) then
3790 call messagenotify('W', subname, &
3791 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3792 & i = (/rank, 3/), c1 = trim(url) )
3793 end if
3794 stat = gt_erankmismatch
3795 cause_c = 'array'
3796 goto 999
3797 end if
3798 ! 入力ファイル中のデータの配列形状取得
3799 ! Get shape of data in an input file
3800 call inquire( var = var , dimord = 1, & ! (in)
3801 & allcount = allcount, err = inq_err ) ! (out)
3802 if ( .not. inq_err ) then
3803 data_shape(1) = allcount
3804 else
3805 data_shape(1) = 1
3806 end if
3807 call inquire( var = var , dimord = 2, & ! (in)
3808 & allcount = allcount, err = inq_err ) ! (out)
3809 if ( .not. inq_err ) then
3810 data_shape(2) = allcount
3811 else
3812 data_shape(2) = 1
3813 end if
3814 call inquire( var = var , dimord = 3, & ! (in)
3815 & allcount = allcount, err = inq_err ) ! (out)
3816 if ( .not. inq_err ) then
3817 data_shape(3) = allcount
3818 else
3819 data_shape(3) = 1
3820 end if
3821 ! 引数の配列形状整形
3822 ! Arrange shape of an argument
3823 !
3824 array_shape_check = array_shape
3825 sd = 1
3826 do i = 1, 3 - 1
3827 if ( array_shape_check(sd) == 1 ) then
3828 array_shape_check(sd:3) = cshift( array_shape_check(sd:3), 1, 1 )
3829 else
3830 sd = sd + 1
3831 end if
3832 end do
3833 ! 配列形状の比較
3834 ! Compare shapes
3835 !
3836 if ( .not. all( array_shape_check == data_shape ) ) then
3837 if ( .not. present_and_true(quiet) ) then
3838 call messagenotify('W', subname, &
3839 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
3840 & c1 = trim( url ), &
3841 & c2 = trim( tochar( data_shape(1:rank) ) ), &
3842 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
3843 end if
3844 stat = gt_eargsizemismatch
3845 cause_c = 'array'
3846 goto 999
3847 end if
3848 !-------------------------------------
3849 ! データ取得
3850 ! Get data
3851 call inquire( var = var, & ! (in)
3852 & size = domain ) ! (out)
3853 if ( allocated( array_tmp ) ) deallocate( array_tmp )
3854 allocate( array_tmp(array_allsize) )
3855 call get( var, array_tmp, domain )
3856 array = reshape( array_tmp, array_shape )
3857 deallocate( array_tmp )
3858 call close( var )
3859 !-------------------------------------
3860 ! データファイル名と切り出し範囲の印字
3861 ! Print data filename and clipping range
3862 call actual_iorange_dump(url, & ! (in)
3863 & actual_url, returned_time, & ! (out) optional
3864 & time_name = tname, & ! (in) optional
3865 & err = err) ! (out) optional
3866 if ( .not. present_and_true(quiet) ) then
3867 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
3868 end if
3869999 continue
3870 call storeerror(stat, subname, err, cause_c)
3871end subroutine historygetint3
3872subroutine historygetint4(file, varname, array, range, &
3873 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
3874 use gtdata_types, only: gt_variable
3875 use gtdata_generic, only: open, inquire, close, get
3876 use dc_string, only: tochar
3878 use dc_regex, only: match
3879 use dc_types, only: string, dp
3880 use dc_message, only: messagenotify
3883 implicit none
3884 character(*), intent(in):: file
3885 character(*), intent(in):: varname
3886 character(*), intent(in), optional:: range
3887 logical, intent(in), optional:: quiet
3888 logical, intent(in), optional:: flag_mpi_split
3889 real(DP), intent(out), optional:: returned_time ! データの時刻
3890 logical, intent(out), optional:: flag_time_exist
3891 logical, intent(out), optional:: err
3892 integer, intent(out) :: array(:,:,:,:)
3893 integer, allocatable :: array_tmp(:)
3894 integer:: array_allsize
3895 integer:: array_shape(4), data_shape(4), array_shape_check(4)
3896 integer:: allcount
3897 integer:: i, sd
3898 logical:: inq_err
3899 type(gt_variable):: var
3900 character(STRING):: file_work, url, actual_url
3901 integer:: rank, alldims, array_rank
3902 integer:: domain
3903 character(STRING):: tname
3904 integer:: stat
3905 character(STRING):: cause_c
3906 character(*), parameter :: subname = "HistoryGetInt4"
3907 interface
3908 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
3909 character(*), intent(in):: file
3910 character(*), intent(in):: varname
3911 character(*), intent(out):: url
3912 character(*), intent(in), optional:: range
3913 logical, intent(out), optional:: flag_time_exist
3914 character(*), intent(out), optional:: time_name
3915 logical, intent(out), optional:: err
3916 end subroutine lookup_growable_url
3917 end interface
3918 interface
3919 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
3920 use dc_types, only: dp
3921 character(*), intent(in) :: url ! 変数 URL
3922 character(*), intent(out), optional :: actual_url
3923 ! 正確な入出力範囲指定
3924 real(DP), intent(out), optional:: returned_time ! データの時刻
3925 character(*), intent(in), optional:: time_name ! 時刻次元の名称
3926 logical, intent(out), optional :: err ! エラーのフラグ
3927 end subroutine actual_iorange_dump
3928 end interface
3929 interface
3930 function file_rename_mpi( file ) result(result)
3931 use dc_types, only: string
3932 character(*), intent(in):: file
3933 character(STRING):: result
3934 end function file_rename_mpi
3935 end interface
3936 continue
3937 cause_c = ''
3938 stat = dc_noerr
3939 file_work = file
3940 array_shape = shape( array )
3941 array_allsize = size( array )
3942 ! ファイル名の変更 (MPI 用)
3943 ! Change filename (for MPI)
3944 !
3945 if ( present_and_true( flag_mpi_split ) ) &
3946 & file_work = file_rename_mpi( file_work )
3947 ! 最新時刻の URL 取得
3948 ! Get URL of latest time
3949 !
3950 call lookup_growable_url(file_work, varname, url, range, &
3951 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
3952 if ( present_and_true(err) ) then
3953 stat = gt_enoturl
3954 cause_c = url
3955 goto 999
3956 end if
3957 ! ファイルオープン
3958 ! File open
3959 call open( var, url, err = err )
3960 if ( present_and_true(err) ) then
3961 stat = gt_enoturl
3962 cause_c = url
3963 goto 999
3964 end if
3965 !-------------------------------------------------------------------
3966 ! 配列形状のチェック
3967 ! Check array shape
3968 !-------------------------------------------------------------------
3969 ! 入力ファイル中のデータの次元数
3970 ! Get size of dimesions in data of an input file
3971 !
3972 call inquire( var = var, & ! (in)
3973 & rank = rank, alldims = alldims ) ! (out)
3974 ! 引数の次元数のチェック (縮退されている場合には減らす)
3975 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
3976 array_rank = 4
3977 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
3978 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
3979 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
3980 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
3981 ! 次元数の比較
3982 ! Compare sizes of dimensions
3983 !
3984 if ( .not. 4 == rank .and. .not. array_rank == rank ) then
3985 if ( .not. present_and_true(quiet) ) then
3986 call messagenotify('W', subname, &
3987 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
3988 & i = (/rank, 4/), c1 = trim(url) )
3989 end if
3990 stat = gt_erankmismatch
3991 cause_c = 'array'
3992 goto 999
3993 end if
3994 ! 入力ファイル中のデータの配列形状取得
3995 ! Get shape of data in an input file
3996 call inquire( var = var , dimord = 1, & ! (in)
3997 & allcount = allcount, err = inq_err ) ! (out)
3998 if ( .not. inq_err ) then
3999 data_shape(1) = allcount
4000 else
4001 data_shape(1) = 1
4002 end if
4003 call inquire( var = var , dimord = 2, & ! (in)
4004 & allcount = allcount, err = inq_err ) ! (out)
4005 if ( .not. inq_err ) then
4006 data_shape(2) = allcount
4007 else
4008 data_shape(2) = 1
4009 end if
4010 call inquire( var = var , dimord = 3, & ! (in)
4011 & allcount = allcount, err = inq_err ) ! (out)
4012 if ( .not. inq_err ) then
4013 data_shape(3) = allcount
4014 else
4015 data_shape(3) = 1
4016 end if
4017 call inquire( var = var , dimord = 4, & ! (in)
4018 & allcount = allcount, err = inq_err ) ! (out)
4019 if ( .not. inq_err ) then
4020 data_shape(4) = allcount
4021 else
4022 data_shape(4) = 1
4023 end if
4024 ! 引数の配列形状整形
4025 ! Arrange shape of an argument
4026 !
4027 array_shape_check = array_shape
4028 sd = 1
4029 do i = 1, 4 - 1
4030 if ( array_shape_check(sd) == 1 ) then
4031 array_shape_check(sd:4) = cshift( array_shape_check(sd:4), 1, 1 )
4032 else
4033 sd = sd + 1
4034 end if
4035 end do
4036 ! 配列形状の比較
4037 ! Compare shapes
4038 !
4039 if ( .not. all( array_shape_check == data_shape ) ) then
4040 if ( .not. present_and_true(quiet) ) then
4041 call messagenotify('W', subname, &
4042 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
4043 & c1 = trim( url ), &
4044 & c2 = trim( tochar( data_shape(1:rank) ) ), &
4045 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
4046 end if
4047 stat = gt_eargsizemismatch
4048 cause_c = 'array'
4049 goto 999
4050 end if
4051 !-------------------------------------
4052 ! データ取得
4053 ! Get data
4054 call inquire( var = var, & ! (in)
4055 & size = domain ) ! (out)
4056 if ( allocated( array_tmp ) ) deallocate( array_tmp )
4057 allocate( array_tmp(array_allsize) )
4058 call get( var, array_tmp, domain )
4059 array = reshape( array_tmp, array_shape )
4060 deallocate( array_tmp )
4061 call close( var )
4062 !-------------------------------------
4063 ! データファイル名と切り出し範囲の印字
4064 ! Print data filename and clipping range
4065 call actual_iorange_dump(url, & ! (in)
4066 & actual_url, returned_time, & ! (out) optional
4067 & time_name = tname, & ! (in) optional
4068 & err = err) ! (out) optional
4069 if ( .not. present_and_true(quiet) ) then
4070 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
4071 end if
4072999 continue
4073 call storeerror(stat, subname, err, cause_c)
4074end subroutine historygetint4
4075subroutine historygetint5(file, varname, array, range, &
4076 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4077 use gtdata_types, only: gt_variable
4078 use gtdata_generic, only: open, inquire, close, get
4079 use dc_string, only: tochar
4081 use dc_regex, only: match
4082 use dc_types, only: string, dp
4083 use dc_message, only: messagenotify
4086 implicit none
4087 character(*), intent(in):: file
4088 character(*), intent(in):: varname
4089 character(*), intent(in), optional:: range
4090 logical, intent(in), optional:: quiet
4091 logical, intent(in), optional:: flag_mpi_split
4092 real(DP), intent(out), optional:: returned_time ! データの時刻
4093 logical, intent(out), optional:: flag_time_exist
4094 logical, intent(out), optional:: err
4095 integer, intent(out) :: array(:,:,:,:,:)
4096 integer, allocatable :: array_tmp(:)
4097 integer:: array_allsize
4098 integer:: array_shape(5), data_shape(5), array_shape_check(5)
4099 integer:: allcount
4100 integer:: i, sd
4101 logical:: inq_err
4102 type(gt_variable):: var
4103 character(STRING):: file_work, url, actual_url
4104 integer:: rank, alldims, array_rank
4105 integer:: domain
4106 character(STRING):: tname
4107 integer:: stat
4108 character(STRING):: cause_c
4109 character(*), parameter :: subname = "HistoryGetInt5"
4110 interface
4111 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4112 character(*), intent(in):: file
4113 character(*), intent(in):: varname
4114 character(*), intent(out):: url
4115 character(*), intent(in), optional:: range
4116 logical, intent(out), optional:: flag_time_exist
4117 character(*), intent(out), optional:: time_name
4118 logical, intent(out), optional:: err
4119 end subroutine lookup_growable_url
4120 end interface
4121 interface
4122 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4123 use dc_types, only: dp
4124 character(*), intent(in) :: url ! 変数 URL
4125 character(*), intent(out), optional :: actual_url
4126 ! 正確な入出力範囲指定
4127 real(DP), intent(out), optional:: returned_time ! データの時刻
4128 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4129 logical, intent(out), optional :: err ! エラーのフラグ
4130 end subroutine actual_iorange_dump
4131 end interface
4132 interface
4133 function file_rename_mpi( file ) result(result)
4134 use dc_types, only: string
4135 character(*), intent(in):: file
4136 character(STRING):: result
4137 end function file_rename_mpi
4138 end interface
4139 continue
4140 cause_c = ''
4141 stat = dc_noerr
4142 file_work = file
4143 array_shape = shape( array )
4144 array_allsize = size( array )
4145 ! ファイル名の変更 (MPI 用)
4146 ! Change filename (for MPI)
4147 !
4148 if ( present_and_true( flag_mpi_split ) ) &
4149 & file_work = file_rename_mpi( file_work )
4150 ! 最新時刻の URL 取得
4151 ! Get URL of latest time
4152 !
4153 call lookup_growable_url(file_work, varname, url, range, &
4154 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4155 if ( present_and_true(err) ) then
4156 stat = gt_enoturl
4157 cause_c = url
4158 goto 999
4159 end if
4160 ! ファイルオープン
4161 ! File open
4162 call open( var, url, err = err )
4163 if ( present_and_true(err) ) then
4164 stat = gt_enoturl
4165 cause_c = url
4166 goto 999
4167 end if
4168 !-------------------------------------------------------------------
4169 ! 配列形状のチェック
4170 ! Check array shape
4171 !-------------------------------------------------------------------
4172 ! 入力ファイル中のデータの次元数
4173 ! Get size of dimesions in data of an input file
4174 !
4175 call inquire( var = var, & ! (in)
4176 & rank = rank, alldims = alldims ) ! (out)
4177 ! 引数の次元数のチェック (縮退されている場合には減らす)
4178 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
4179 array_rank = 5
4180 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
4181 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
4182 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
4183 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
4184 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
4185 ! 次元数の比較
4186 ! Compare sizes of dimensions
4187 !
4188 if ( .not. 5 == rank .and. .not. array_rank == rank ) then
4189 if ( .not. present_and_true(quiet) ) then
4190 call messagenotify('W', subname, &
4191 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
4192 & i = (/rank, 5/), c1 = trim(url) )
4193 end if
4194 stat = gt_erankmismatch
4195 cause_c = 'array'
4196 goto 999
4197 end if
4198 ! 入力ファイル中のデータの配列形状取得
4199 ! Get shape of data in an input file
4200 call inquire( var = var , dimord = 1, & ! (in)
4201 & allcount = allcount, err = inq_err ) ! (out)
4202 if ( .not. inq_err ) then
4203 data_shape(1) = allcount
4204 else
4205 data_shape(1) = 1
4206 end if
4207 call inquire( var = var , dimord = 2, & ! (in)
4208 & allcount = allcount, err = inq_err ) ! (out)
4209 if ( .not. inq_err ) then
4210 data_shape(2) = allcount
4211 else
4212 data_shape(2) = 1
4213 end if
4214 call inquire( var = var , dimord = 3, & ! (in)
4215 & allcount = allcount, err = inq_err ) ! (out)
4216 if ( .not. inq_err ) then
4217 data_shape(3) = allcount
4218 else
4219 data_shape(3) = 1
4220 end if
4221 call inquire( var = var , dimord = 4, & ! (in)
4222 & allcount = allcount, err = inq_err ) ! (out)
4223 if ( .not. inq_err ) then
4224 data_shape(4) = allcount
4225 else
4226 data_shape(4) = 1
4227 end if
4228 call inquire( var = var , dimord = 5, & ! (in)
4229 & allcount = allcount, err = inq_err ) ! (out)
4230 if ( .not. inq_err ) then
4231 data_shape(5) = allcount
4232 else
4233 data_shape(5) = 1
4234 end if
4235 ! 引数の配列形状整形
4236 ! Arrange shape of an argument
4237 !
4238 array_shape_check = array_shape
4239 sd = 1
4240 do i = 1, 5 - 1
4241 if ( array_shape_check(sd) == 1 ) then
4242 array_shape_check(sd:5) = cshift( array_shape_check(sd:5), 1, 1 )
4243 else
4244 sd = sd + 1
4245 end if
4246 end do
4247 ! 配列形状の比較
4248 ! Compare shapes
4249 !
4250 if ( .not. all( array_shape_check == data_shape ) ) then
4251 if ( .not. present_and_true(quiet) ) then
4252 call messagenotify('W', subname, &
4253 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
4254 & c1 = trim( url ), &
4255 & c2 = trim( tochar( data_shape(1:rank) ) ), &
4256 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
4257 end if
4258 stat = gt_eargsizemismatch
4259 cause_c = 'array'
4260 goto 999
4261 end if
4262 !-------------------------------------
4263 ! データ取得
4264 ! Get data
4265 call inquire( var = var, & ! (in)
4266 & size = domain ) ! (out)
4267 if ( allocated( array_tmp ) ) deallocate( array_tmp )
4268 allocate( array_tmp(array_allsize) )
4269 call get( var, array_tmp, domain )
4270 array = reshape( array_tmp, array_shape )
4271 deallocate( array_tmp )
4272 call close( var )
4273 !-------------------------------------
4274 ! データファイル名と切り出し範囲の印字
4275 ! Print data filename and clipping range
4276 call actual_iorange_dump(url, & ! (in)
4277 & actual_url, returned_time, & ! (out) optional
4278 & time_name = tname, & ! (in) optional
4279 & err = err) ! (out) optional
4280 if ( .not. present_and_true(quiet) ) then
4281 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
4282 end if
4283999 continue
4284 call storeerror(stat, subname, err, cause_c)
4285end subroutine historygetint5
4286subroutine historygetint6(file, varname, array, range, &
4287 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4288 use gtdata_types, only: gt_variable
4289 use gtdata_generic, only: open, inquire, close, get
4290 use dc_string, only: tochar
4292 use dc_regex, only: match
4293 use dc_types, only: string, dp
4294 use dc_message, only: messagenotify
4297 implicit none
4298 character(*), intent(in):: file
4299 character(*), intent(in):: varname
4300 character(*), intent(in), optional:: range
4301 logical, intent(in), optional:: quiet
4302 logical, intent(in), optional:: flag_mpi_split
4303 real(DP), intent(out), optional:: returned_time ! データの時刻
4304 logical, intent(out), optional:: flag_time_exist
4305 logical, intent(out), optional:: err
4306 integer, intent(out) :: array(:,:,:,:,:,:)
4307 integer, allocatable :: array_tmp(:)
4308 integer:: array_allsize
4309 integer:: array_shape(6), data_shape(6), array_shape_check(6)
4310 integer:: allcount
4311 integer:: i, sd
4312 logical:: inq_err
4313 type(gt_variable):: var
4314 character(STRING):: file_work, url, actual_url
4315 integer:: rank, alldims, array_rank
4316 integer:: domain
4317 character(STRING):: tname
4318 integer:: stat
4319 character(STRING):: cause_c
4320 character(*), parameter :: subname = "HistoryGetInt6"
4321 interface
4322 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4323 character(*), intent(in):: file
4324 character(*), intent(in):: varname
4325 character(*), intent(out):: url
4326 character(*), intent(in), optional:: range
4327 logical, intent(out), optional:: flag_time_exist
4328 character(*), intent(out), optional:: time_name
4329 logical, intent(out), optional:: err
4330 end subroutine lookup_growable_url
4331 end interface
4332 interface
4333 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4334 use dc_types, only: dp
4335 character(*), intent(in) :: url ! 変数 URL
4336 character(*), intent(out), optional :: actual_url
4337 ! 正確な入出力範囲指定
4338 real(DP), intent(out), optional:: returned_time ! データの時刻
4339 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4340 logical, intent(out), optional :: err ! エラーのフラグ
4341 end subroutine actual_iorange_dump
4342 end interface
4343 interface
4344 function file_rename_mpi( file ) result(result)
4345 use dc_types, only: string
4346 character(*), intent(in):: file
4347 character(STRING):: result
4348 end function file_rename_mpi
4349 end interface
4350 continue
4351 cause_c = ''
4352 stat = dc_noerr
4353 file_work = file
4354 array_shape = shape( array )
4355 array_allsize = size( array )
4356 ! ファイル名の変更 (MPI 用)
4357 ! Change filename (for MPI)
4358 !
4359 if ( present_and_true( flag_mpi_split ) ) &
4360 & file_work = file_rename_mpi( file_work )
4361 ! 最新時刻の URL 取得
4362 ! Get URL of latest time
4363 !
4364 call lookup_growable_url(file_work, varname, url, range, &
4365 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4366 if ( present_and_true(err) ) then
4367 stat = gt_enoturl
4368 cause_c = url
4369 goto 999
4370 end if
4371 ! ファイルオープン
4372 ! File open
4373 call open( var, url, err = err )
4374 if ( present_and_true(err) ) then
4375 stat = gt_enoturl
4376 cause_c = url
4377 goto 999
4378 end if
4379 !-------------------------------------------------------------------
4380 ! 配列形状のチェック
4381 ! Check array shape
4382 !-------------------------------------------------------------------
4383 ! 入力ファイル中のデータの次元数
4384 ! Get size of dimesions in data of an input file
4385 !
4386 call inquire( var = var, & ! (in)
4387 & rank = rank, alldims = alldims ) ! (out)
4388 ! 引数の次元数のチェック (縮退されている場合には減らす)
4389 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
4390 array_rank = 6
4391 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
4392 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
4393 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
4394 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
4395 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
4396 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
4397 ! 次元数の比較
4398 ! Compare sizes of dimensions
4399 !
4400 if ( .not. 6 == rank .and. .not. array_rank == rank ) then
4401 if ( .not. present_and_true(quiet) ) then
4402 call messagenotify('W', subname, &
4403 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
4404 & i = (/rank, 6/), c1 = trim(url) )
4405 end if
4406 stat = gt_erankmismatch
4407 cause_c = 'array'
4408 goto 999
4409 end if
4410 ! 入力ファイル中のデータの配列形状取得
4411 ! Get shape of data in an input file
4412 call inquire( var = var , dimord = 1, & ! (in)
4413 & allcount = allcount, err = inq_err ) ! (out)
4414 if ( .not. inq_err ) then
4415 data_shape(1) = allcount
4416 else
4417 data_shape(1) = 1
4418 end if
4419 call inquire( var = var , dimord = 2, & ! (in)
4420 & allcount = allcount, err = inq_err ) ! (out)
4421 if ( .not. inq_err ) then
4422 data_shape(2) = allcount
4423 else
4424 data_shape(2) = 1
4425 end if
4426 call inquire( var = var , dimord = 3, & ! (in)
4427 & allcount = allcount, err = inq_err ) ! (out)
4428 if ( .not. inq_err ) then
4429 data_shape(3) = allcount
4430 else
4431 data_shape(3) = 1
4432 end if
4433 call inquire( var = var , dimord = 4, & ! (in)
4434 & allcount = allcount, err = inq_err ) ! (out)
4435 if ( .not. inq_err ) then
4436 data_shape(4) = allcount
4437 else
4438 data_shape(4) = 1
4439 end if
4440 call inquire( var = var , dimord = 5, & ! (in)
4441 & allcount = allcount, err = inq_err ) ! (out)
4442 if ( .not. inq_err ) then
4443 data_shape(5) = allcount
4444 else
4445 data_shape(5) = 1
4446 end if
4447 call inquire( var = var , dimord = 6, & ! (in)
4448 & allcount = allcount, err = inq_err ) ! (out)
4449 if ( .not. inq_err ) then
4450 data_shape(6) = allcount
4451 else
4452 data_shape(6) = 1
4453 end if
4454 ! 引数の配列形状整形
4455 ! Arrange shape of an argument
4456 !
4457 array_shape_check = array_shape
4458 sd = 1
4459 do i = 1, 6 - 1
4460 if ( array_shape_check(sd) == 1 ) then
4461 array_shape_check(sd:6) = cshift( array_shape_check(sd:6), 1, 1 )
4462 else
4463 sd = sd + 1
4464 end if
4465 end do
4466 ! 配列形状の比較
4467 ! Compare shapes
4468 !
4469 if ( .not. all( array_shape_check == data_shape ) ) then
4470 if ( .not. present_and_true(quiet) ) then
4471 call messagenotify('W', subname, &
4472 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
4473 & c1 = trim( url ), &
4474 & c2 = trim( tochar( data_shape(1:rank) ) ), &
4475 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
4476 end if
4477 stat = gt_eargsizemismatch
4478 cause_c = 'array'
4479 goto 999
4480 end if
4481 !-------------------------------------
4482 ! データ取得
4483 ! Get data
4484 call inquire( var = var, & ! (in)
4485 & size = domain ) ! (out)
4486 if ( allocated( array_tmp ) ) deallocate( array_tmp )
4487 allocate( array_tmp(array_allsize) )
4488 call get( var, array_tmp, domain )
4489 array = reshape( array_tmp, array_shape )
4490 deallocate( array_tmp )
4491 call close( var )
4492 !-------------------------------------
4493 ! データファイル名と切り出し範囲の印字
4494 ! Print data filename and clipping range
4495 call actual_iorange_dump(url, & ! (in)
4496 & actual_url, returned_time, & ! (out) optional
4497 & time_name = tname, & ! (in) optional
4498 & err = err) ! (out) optional
4499 if ( .not. present_and_true(quiet) ) then
4500 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
4501 end if
4502999 continue
4503 call storeerror(stat, subname, err, cause_c)
4504end subroutine historygetint6
4505subroutine historygetint7(file, varname, array, range, &
4506 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4507 use gtdata_types, only: gt_variable
4508 use gtdata_generic, only: open, inquire, close, get
4509 use dc_string, only: tochar
4511 use dc_regex, only: match
4512 use dc_types, only: string, dp
4513 use dc_message, only: messagenotify
4516 implicit none
4517 character(*), intent(in):: file
4518 character(*), intent(in):: varname
4519 character(*), intent(in), optional:: range
4520 logical, intent(in), optional:: quiet
4521 logical, intent(in), optional:: flag_mpi_split
4522 real(DP), intent(out), optional:: returned_time ! データの時刻
4523 logical, intent(out), optional:: flag_time_exist
4524 logical, intent(out), optional:: err
4525 integer, intent(out) :: array(:,:,:,:,:,:,:)
4526 integer, allocatable :: array_tmp(:)
4527 integer:: array_allsize
4528 integer:: array_shape(7), data_shape(7), array_shape_check(7)
4529 integer:: allcount
4530 integer:: i, sd
4531 logical:: inq_err
4532 type(gt_variable):: var
4533 character(STRING):: file_work, url, actual_url
4534 integer:: rank, alldims, array_rank
4535 integer:: domain
4536 character(STRING):: tname
4537 integer:: stat
4538 character(STRING):: cause_c
4539 character(*), parameter :: subname = "HistoryGetInt7"
4540 interface
4541 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4542 character(*), intent(in):: file
4543 character(*), intent(in):: varname
4544 character(*), intent(out):: url
4545 character(*), intent(in), optional:: range
4546 logical, intent(out), optional:: flag_time_exist
4547 character(*), intent(out), optional:: time_name
4548 logical, intent(out), optional:: err
4549 end subroutine lookup_growable_url
4550 end interface
4551 interface
4552 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4553 use dc_types, only: dp
4554 character(*), intent(in) :: url ! 変数 URL
4555 character(*), intent(out), optional :: actual_url
4556 ! 正確な入出力範囲指定
4557 real(DP), intent(out), optional:: returned_time ! データの時刻
4558 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4559 logical, intent(out), optional :: err ! エラーのフラグ
4560 end subroutine actual_iorange_dump
4561 end interface
4562 interface
4563 function file_rename_mpi( file ) result(result)
4564 use dc_types, only: string
4565 character(*), intent(in):: file
4566 character(STRING):: result
4567 end function file_rename_mpi
4568 end interface
4569 continue
4570 cause_c = ''
4571 stat = dc_noerr
4572 file_work = file
4573 array_shape = shape( array )
4574 array_allsize = size( array )
4575 ! ファイル名の変更 (MPI 用)
4576 ! Change filename (for MPI)
4577 !
4578 if ( present_and_true( flag_mpi_split ) ) &
4579 & file_work = file_rename_mpi( file_work )
4580 ! 最新時刻の URL 取得
4581 ! Get URL of latest time
4582 !
4583 call lookup_growable_url(file_work, varname, url, range, &
4584 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4585 if ( present_and_true(err) ) then
4586 stat = gt_enoturl
4587 cause_c = url
4588 goto 999
4589 end if
4590 ! ファイルオープン
4591 ! File open
4592 call open( var, url, err = err )
4593 if ( present_and_true(err) ) then
4594 stat = gt_enoturl
4595 cause_c = url
4596 goto 999
4597 end if
4598 !-------------------------------------------------------------------
4599 ! 配列形状のチェック
4600 ! Check array shape
4601 !-------------------------------------------------------------------
4602 ! 入力ファイル中のデータの次元数
4603 ! Get size of dimesions in data of an input file
4604 !
4605 call inquire( var = var, & ! (in)
4606 & rank = rank, alldims = alldims ) ! (out)
4607 ! 引数の次元数のチェック (縮退されている場合には減らす)
4608 ! Check size of dimensions of an argument (If any dimension degenerated, size of dimensions is decreased)
4609 array_rank = 7
4610 if ( size( array, 1 ) == 1 ) array_rank = array_rank - 1
4611 if ( size( array, 2 ) == 1 ) array_rank = array_rank - 1
4612 if ( size( array, 3 ) == 1 ) array_rank = array_rank - 1
4613 if ( size( array, 4 ) == 1 ) array_rank = array_rank - 1
4614 if ( size( array, 5 ) == 1 ) array_rank = array_rank - 1
4615 if ( size( array, 6 ) == 1 ) array_rank = array_rank - 1
4616 if ( size( array, 7 ) == 1 ) array_rank = array_rank - 1
4617 ! 次元数の比較
4618 ! Compare sizes of dimensions
4619 !
4620 if ( .not. 7 == rank .and. .not. array_rank == rank ) then
4621 if ( .not. present_and_true(quiet) ) then
4622 call messagenotify('W', subname, &
4623 & 'Rank of data (%c) is "%d", rank of argument is "%d"', &
4624 & i = (/rank, 7/), c1 = trim(url) )
4625 end if
4626 stat = gt_erankmismatch
4627 cause_c = 'array'
4628 goto 999
4629 end if
4630 ! 入力ファイル中のデータの配列形状取得
4631 ! Get shape of data in an input file
4632 call inquire( var = var , dimord = 1, & ! (in)
4633 & allcount = allcount, err = inq_err ) ! (out)
4634 if ( .not. inq_err ) then
4635 data_shape(1) = allcount
4636 else
4637 data_shape(1) = 1
4638 end if
4639 call inquire( var = var , dimord = 2, & ! (in)
4640 & allcount = allcount, err = inq_err ) ! (out)
4641 if ( .not. inq_err ) then
4642 data_shape(2) = allcount
4643 else
4644 data_shape(2) = 1
4645 end if
4646 call inquire( var = var , dimord = 3, & ! (in)
4647 & allcount = allcount, err = inq_err ) ! (out)
4648 if ( .not. inq_err ) then
4649 data_shape(3) = allcount
4650 else
4651 data_shape(3) = 1
4652 end if
4653 call inquire( var = var , dimord = 4, & ! (in)
4654 & allcount = allcount, err = inq_err ) ! (out)
4655 if ( .not. inq_err ) then
4656 data_shape(4) = allcount
4657 else
4658 data_shape(4) = 1
4659 end if
4660 call inquire( var = var , dimord = 5, & ! (in)
4661 & allcount = allcount, err = inq_err ) ! (out)
4662 if ( .not. inq_err ) then
4663 data_shape(5) = allcount
4664 else
4665 data_shape(5) = 1
4666 end if
4667 call inquire( var = var , dimord = 6, & ! (in)
4668 & allcount = allcount, err = inq_err ) ! (out)
4669 if ( .not. inq_err ) then
4670 data_shape(6) = allcount
4671 else
4672 data_shape(6) = 1
4673 end if
4674 call inquire( var = var , dimord = 7, & ! (in)
4675 & allcount = allcount, err = inq_err ) ! (out)
4676 if ( .not. inq_err ) then
4677 data_shape(7) = allcount
4678 else
4679 data_shape(7) = 1
4680 end if
4681 ! 引数の配列形状整形
4682 ! Arrange shape of an argument
4683 !
4684 array_shape_check = array_shape
4685 sd = 1
4686 do i = 1, 7 - 1
4687 if ( array_shape_check(sd) == 1 ) then
4688 array_shape_check(sd:7) = cshift( array_shape_check(sd:7), 1, 1 )
4689 else
4690 sd = sd + 1
4691 end if
4692 end do
4693 ! 配列形状の比較
4694 ! Compare shapes
4695 !
4696 if ( .not. all( array_shape_check == data_shape ) ) then
4697 if ( .not. present_and_true(quiet) ) then
4698 call messagenotify('W', subname, &
4699 & 'Shape of data (%c) is (%c), shape of argument is (%c)', &
4700 & c1 = trim( url ), &
4701 & c2 = trim( tochar( data_shape(1:rank) ) ), &
4702 & c3 = trim( tochar( array_shape_check(1:rank) ) ) )
4703 end if
4704 stat = gt_eargsizemismatch
4705 cause_c = 'array'
4706 goto 999
4707 end if
4708 !-------------------------------------
4709 ! データ取得
4710 ! Get data
4711 call inquire( var = var, & ! (in)
4712 & size = domain ) ! (out)
4713 if ( allocated( array_tmp ) ) deallocate( array_tmp )
4714 allocate( array_tmp(array_allsize) )
4715 call get( var, array_tmp, domain )
4716 array = reshape( array_tmp, array_shape )
4717 deallocate( array_tmp )
4718 call close( var )
4719 !-------------------------------------
4720 ! データファイル名と切り出し範囲の印字
4721 ! Print data filename and clipping range
4722 call actual_iorange_dump(url, & ! (in)
4723 & actual_url, returned_time, & ! (out) optional
4724 & time_name = tname, & ! (in) optional
4725 & err = err) ! (out) optional
4726 if ( .not. present_and_true(quiet) ) then
4727 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url), rank_mpi = -1)
4728 end if
4729999 continue
4730 call storeerror(stat, subname, err, cause_c)
4731end subroutine historygetint7
4732subroutine historygetdouble0pointer(file, varname, array, range, &
4733 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4734 use gtdata_types, only: gt_variable
4735 use gtdata_generic, only: open, inquire, close, get
4736 use dc_string, only: tochar
4738 use dc_types, only: string, dp
4739 use dc_message, only: messagenotify
4740 use dc_trace, only: dbgmessage
4741 implicit none
4742 character(*), intent(in):: file
4743 character(*), intent(in):: varname
4744 character(*), intent(in), optional:: range
4745 logical, intent(in), optional:: quiet
4746 logical, intent(in), optional:: flag_mpi_split
4747 real(DP), intent(out), optional:: returned_time ! データの時刻
4748 logical, intent(out), optional:: flag_time_exist
4749 logical, intent(out), optional:: err
4750 integer:: domain
4751 real(DP), pointer :: array ! (out)
4752 real(DP), target :: array_tmp(1)
4753 type(gt_variable):: var
4754 character(STRING):: file_work, url, actual_url
4755 character(STRING):: tname
4756 character(*), parameter :: subname = "HistoryGetDouble0Pointer"
4757 interface
4758 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4759 character(*), intent(in):: file
4760 character(*), intent(in):: varname
4761 character(*), intent(out):: url
4762 character(*), intent(in), optional:: range
4763 logical, intent(out), optional:: flag_time_exist
4764 character(*), intent(out), optional:: time_name
4765 logical, intent(out), optional:: err
4766 end subroutine lookup_growable_url
4767 end interface
4768 interface
4769 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4770 use dc_types, only: dp
4771 character(*), intent(in) :: url ! 変数 URL
4772 character(*), intent(out), optional :: actual_url
4773 ! 正確な入出力範囲指定
4774 real(DP), intent(out), optional:: returned_time ! データの時刻
4775 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4776 logical, intent(out), optional :: err ! エラーのフラグ
4777 end subroutine actual_iorange_dump
4778 end interface
4779 interface
4780 function file_rename_mpi( file ) result(result)
4781 use dc_types, only: string
4782 character(*), intent(in):: file
4783 character(STRING):: result
4784 end function file_rename_mpi
4785 end interface
4786 continue
4787 file_work = file
4788 ! ファイル名の変更 (MPI 用)
4789 ! Change filename (for MPI)
4790 !
4791 if ( present_and_true( flag_mpi_split ) ) &
4792 & file_work = file_rename_mpi( file_work )
4793 ! 必要な情報を gtool 変数化
4794 !
4795 call lookup_growable_url(file_work, varname, url, range, &
4796 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4797 allocate(array)
4798 call dbgmessage('@ url =%c', c1=trim(url))
4799 ! いよいよデータ取得
4800 !
4801 call open(var, url, err)
4802 call inquire(var=var, size=domain)
4803 call get(var, array_tmp, domain, err)
4804 array = array_tmp(1)
4805 call close(var, err)
4806 call actual_iorange_dump(url, & ! (in)
4807 & actual_url, returned_time, & ! (out) optional
4808 & time_name = tname, & ! (in) optional
4809 & err = err) ! (out) optional
4810 if ( .not. present_and_true(quiet) ) then
4811 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
4812 end if
4813end subroutine historygetdouble0pointer
4814subroutine historygetdouble1pointer(file, varname, array, range, &
4815 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4816 use gtdata_types, only: gt_variable
4817 use gtdata_generic, only: open, inquire, close, get
4818 use dc_string, only: tochar
4820 use dc_types, only: string, dp
4821 use dc_message, only: messagenotify
4822 use dc_trace, only: dbgmessage
4823 implicit none
4824 character(*), intent(in):: file
4825 character(*), intent(in):: varname
4826 character(*), intent(in), optional:: range
4827 logical, intent(in), optional:: quiet
4828 logical, intent(in), optional:: flag_mpi_split
4829 real(DP), intent(out), optional:: returned_time ! データの時刻
4830 logical, intent(out), optional:: flag_time_exist
4831 logical, intent(out), optional:: err
4832 real(DP), pointer :: array(:) ! (out)
4833 type(gt_variable):: var
4834 character(STRING):: file_work, url, actual_url
4835 character(STRING):: tname
4836 character(*), parameter :: subname = "HistoryGetDouble1Pointer"
4837 interface
4838 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4839 character(*), intent(in):: file
4840 character(*), intent(in):: varname
4841 character(*), intent(out):: url
4842 character(*), intent(in), optional:: range
4843 logical, intent(out), optional:: flag_time_exist
4844 character(*), intent(out), optional:: time_name
4845 logical, intent(out), optional:: err
4846 end subroutine lookup_growable_url
4847 end interface
4848 interface
4849 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4850 use dc_types, only: dp
4851 character(*), intent(in) :: url ! 変数 URL
4852 character(*), intent(out), optional :: actual_url
4853 ! 正確な入出力範囲指定
4854 real(DP), intent(out), optional:: returned_time ! データの時刻
4855 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4856 logical, intent(out), optional :: err ! エラーのフラグ
4857 end subroutine actual_iorange_dump
4858 end interface
4859 interface
4860 function file_rename_mpi( file ) result(result)
4861 use dc_types, only: string
4862 character(*), intent(in):: file
4863 character(STRING):: result
4864 end function file_rename_mpi
4865 end interface
4866 continue
4867 file_work = file
4868 ! ファイル名の変更 (MPI 用)
4869 ! Change filename (for MPI)
4870 !
4871 if ( present_and_true( flag_mpi_split ) ) &
4872 & file_work = file_rename_mpi( file_work )
4873 ! 必要な情報を gtool 変数化
4874 !
4875 call lookup_growable_url(file_work, varname, url, range, &
4876 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4877 call dbgmessage('@ url =%c', c1=trim(url))
4878 ! いよいよデータ取得
4879 !
4880 call open(var, url, err)
4881 call get(var, array, err)
4882 call close(var, err)
4883 call actual_iorange_dump(url, & ! (in)
4884 & actual_url, returned_time, & ! (out) optional
4885 & time_name = tname, & ! (in) optional
4886 & err = err) ! (out) optional
4887 if ( .not. present_and_true(quiet) ) then
4888 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
4889 end if
4890end subroutine historygetdouble1pointer
4891subroutine historygetdouble2pointer(file, varname, array, range, &
4892 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4893 use gtdata_types, only: gt_variable
4894 use gtdata_generic, only: open, inquire, close, get
4895 use dc_string, only: tochar
4897 use dc_types, only: string, dp
4898 use dc_message, only: messagenotify
4899 use dc_trace, only: dbgmessage
4900 implicit none
4901 character(*), intent(in):: file
4902 character(*), intent(in):: varname
4903 character(*), intent(in), optional:: range
4904 logical, intent(in), optional:: quiet
4905 logical, intent(in), optional:: flag_mpi_split
4906 real(DP), intent(out), optional:: returned_time ! データの時刻
4907 logical, intent(out), optional:: flag_time_exist
4908 logical, intent(out), optional:: err
4909 real(DP), pointer :: array(:,:) ! (out)
4910 type(gt_variable):: var
4911 character(STRING):: file_work, url, actual_url
4912 character(STRING):: tname
4913 character(*), parameter :: subname = "HistoryGetDouble2Pointer"
4914 interface
4915 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4916 character(*), intent(in):: file
4917 character(*), intent(in):: varname
4918 character(*), intent(out):: url
4919 character(*), intent(in), optional:: range
4920 logical, intent(out), optional:: flag_time_exist
4921 character(*), intent(out), optional:: time_name
4922 logical, intent(out), optional:: err
4923 end subroutine lookup_growable_url
4924 end interface
4925 interface
4926 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
4927 use dc_types, only: dp
4928 character(*), intent(in) :: url ! 変数 URL
4929 character(*), intent(out), optional :: actual_url
4930 ! 正確な入出力範囲指定
4931 real(DP), intent(out), optional:: returned_time ! データの時刻
4932 character(*), intent(in), optional:: time_name ! 時刻次元の名称
4933 logical, intent(out), optional :: err ! エラーのフラグ
4934 end subroutine actual_iorange_dump
4935 end interface
4936 interface
4937 function file_rename_mpi( file ) result(result)
4938 use dc_types, only: string
4939 character(*), intent(in):: file
4940 character(STRING):: result
4941 end function file_rename_mpi
4942 end interface
4943 continue
4944 file_work = file
4945 ! ファイル名の変更 (MPI 用)
4946 ! Change filename (for MPI)
4947 !
4948 if ( present_and_true( flag_mpi_split ) ) &
4949 & file_work = file_rename_mpi( file_work )
4950 ! 必要な情報を gtool 変数化
4951 !
4952 call lookup_growable_url(file_work, varname, url, range, &
4953 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
4954 call dbgmessage('@ url =%c', c1=trim(url))
4955 ! いよいよデータ取得
4956 !
4957 call open(var, url, err)
4958 call get(var, array, err)
4959 call close(var, err)
4960 call actual_iorange_dump(url, & ! (in)
4961 & actual_url, returned_time, & ! (out) optional
4962 & time_name = tname, & ! (in) optional
4963 & err = err) ! (out) optional
4964 if ( .not. present_and_true(quiet) ) then
4965 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
4966 end if
4967end subroutine historygetdouble2pointer
4968subroutine historygetdouble3pointer(file, varname, array, range, &
4969 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
4970 use gtdata_types, only: gt_variable
4971 use gtdata_generic, only: open, inquire, close, get
4972 use dc_string, only: tochar
4974 use dc_types, only: string, dp
4975 use dc_message, only: messagenotify
4976 use dc_trace, only: dbgmessage
4977 implicit none
4978 character(*), intent(in):: file
4979 character(*), intent(in):: varname
4980 character(*), intent(in), optional:: range
4981 logical, intent(in), optional:: quiet
4982 logical, intent(in), optional:: flag_mpi_split
4983 real(DP), intent(out), optional:: returned_time ! データの時刻
4984 logical, intent(out), optional:: flag_time_exist
4985 logical, intent(out), optional:: err
4986 real(DP), pointer :: array(:,:,:) ! (out)
4987 type(gt_variable):: var
4988 character(STRING):: file_work, url, actual_url
4989 character(STRING):: tname
4990 character(*), parameter :: subname = "HistoryGetDouble3Pointer"
4991 interface
4992 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
4993 character(*), intent(in):: file
4994 character(*), intent(in):: varname
4995 character(*), intent(out):: url
4996 character(*), intent(in), optional:: range
4997 logical, intent(out), optional:: flag_time_exist
4998 character(*), intent(out), optional:: time_name
4999 logical, intent(out), optional:: err
5000 end subroutine lookup_growable_url
5001 end interface
5002 interface
5003 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5004 use dc_types, only: dp
5005 character(*), intent(in) :: url ! 変数 URL
5006 character(*), intent(out), optional :: actual_url
5007 ! 正確な入出力範囲指定
5008 real(DP), intent(out), optional:: returned_time ! データの時刻
5009 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5010 logical, intent(out), optional :: err ! エラーのフラグ
5011 end subroutine actual_iorange_dump
5012 end interface
5013 interface
5014 function file_rename_mpi( file ) result(result)
5015 use dc_types, only: string
5016 character(*), intent(in):: file
5017 character(STRING):: result
5018 end function file_rename_mpi
5019 end interface
5020 continue
5021 file_work = file
5022 ! ファイル名の変更 (MPI 用)
5023 ! Change filename (for MPI)
5024 !
5025 if ( present_and_true( flag_mpi_split ) ) &
5026 & file_work = file_rename_mpi( file_work )
5027 ! 必要な情報を gtool 変数化
5028 !
5029 call lookup_growable_url(file_work, varname, url, range, &
5030 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5031 call dbgmessage('@ url =%c', c1=trim(url))
5032 ! いよいよデータ取得
5033 !
5034 call open(var, url, err)
5035 call get(var, array, err)
5036 call close(var, err)
5037 call actual_iorange_dump(url, & ! (in)
5038 & actual_url, returned_time, & ! (out) optional
5039 & time_name = tname, & ! (in) optional
5040 & err = err) ! (out) optional
5041 if ( .not. present_and_true(quiet) ) then
5042 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5043 end if
5044end subroutine historygetdouble3pointer
5045subroutine historygetdouble4pointer(file, varname, array, range, &
5046 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5047 use gtdata_types, only: gt_variable
5048 use gtdata_generic, only: open, inquire, close, get
5049 use dc_string, only: tochar
5051 use dc_types, only: string, dp
5052 use dc_message, only: messagenotify
5053 use dc_trace, only: dbgmessage
5054 implicit none
5055 character(*), intent(in):: file
5056 character(*), intent(in):: varname
5057 character(*), intent(in), optional:: range
5058 logical, intent(in), optional:: quiet
5059 logical, intent(in), optional:: flag_mpi_split
5060 real(DP), intent(out), optional:: returned_time ! データの時刻
5061 logical, intent(out), optional:: flag_time_exist
5062 logical, intent(out), optional:: err
5063 real(DP), pointer :: array(:,:,:,:) ! (out)
5064 type(gt_variable):: var
5065 character(STRING):: file_work, url, actual_url
5066 character(STRING):: tname
5067 character(*), parameter :: subname = "HistoryGetDouble4Pointer"
5068 interface
5069 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5070 character(*), intent(in):: file
5071 character(*), intent(in):: varname
5072 character(*), intent(out):: url
5073 character(*), intent(in), optional:: range
5074 logical, intent(out), optional:: flag_time_exist
5075 character(*), intent(out), optional:: time_name
5076 logical, intent(out), optional:: err
5077 end subroutine lookup_growable_url
5078 end interface
5079 interface
5080 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5081 use dc_types, only: dp
5082 character(*), intent(in) :: url ! 変数 URL
5083 character(*), intent(out), optional :: actual_url
5084 ! 正確な入出力範囲指定
5085 real(DP), intent(out), optional:: returned_time ! データの時刻
5086 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5087 logical, intent(out), optional :: err ! エラーのフラグ
5088 end subroutine actual_iorange_dump
5089 end interface
5090 interface
5091 function file_rename_mpi( file ) result(result)
5092 use dc_types, only: string
5093 character(*), intent(in):: file
5094 character(STRING):: result
5095 end function file_rename_mpi
5096 end interface
5097 continue
5098 file_work = file
5099 ! ファイル名の変更 (MPI 用)
5100 ! Change filename (for MPI)
5101 !
5102 if ( present_and_true( flag_mpi_split ) ) &
5103 & file_work = file_rename_mpi( file_work )
5104 ! 必要な情報を gtool 変数化
5105 !
5106 call lookup_growable_url(file_work, varname, url, range, &
5107 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5108 call dbgmessage('@ url =%c', c1=trim(url))
5109 ! いよいよデータ取得
5110 !
5111 call open(var, url, err)
5112 call get(var, array, err)
5113 call close(var, err)
5114 call actual_iorange_dump(url, & ! (in)
5115 & actual_url, returned_time, & ! (out) optional
5116 & time_name = tname, & ! (in) optional
5117 & err = err) ! (out) optional
5118 if ( .not. present_and_true(quiet) ) then
5119 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5120 end if
5121end subroutine historygetdouble4pointer
5122subroutine historygetdouble5pointer(file, varname, array, range, &
5123 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5124 use gtdata_types, only: gt_variable
5125 use gtdata_generic, only: open, inquire, close, get
5126 use dc_string, only: tochar
5128 use dc_types, only: string, dp
5129 use dc_message, only: messagenotify
5130 use dc_trace, only: dbgmessage
5131 implicit none
5132 character(*), intent(in):: file
5133 character(*), intent(in):: varname
5134 character(*), intent(in), optional:: range
5135 logical, intent(in), optional:: quiet
5136 logical, intent(in), optional:: flag_mpi_split
5137 real(DP), intent(out), optional:: returned_time ! データの時刻
5138 logical, intent(out), optional:: flag_time_exist
5139 logical, intent(out), optional:: err
5140 real(DP), pointer :: array(:,:,:,:,:) ! (out)
5141 type(gt_variable):: var
5142 character(STRING):: file_work, url, actual_url
5143 character(STRING):: tname
5144 character(*), parameter :: subname = "HistoryGetDouble5Pointer"
5145 interface
5146 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5147 character(*), intent(in):: file
5148 character(*), intent(in):: varname
5149 character(*), intent(out):: url
5150 character(*), intent(in), optional:: range
5151 logical, intent(out), optional:: flag_time_exist
5152 character(*), intent(out), optional:: time_name
5153 logical, intent(out), optional:: err
5154 end subroutine lookup_growable_url
5155 end interface
5156 interface
5157 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5158 use dc_types, only: dp
5159 character(*), intent(in) :: url ! 変数 URL
5160 character(*), intent(out), optional :: actual_url
5161 ! 正確な入出力範囲指定
5162 real(DP), intent(out), optional:: returned_time ! データの時刻
5163 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5164 logical, intent(out), optional :: err ! エラーのフラグ
5165 end subroutine actual_iorange_dump
5166 end interface
5167 interface
5168 function file_rename_mpi( file ) result(result)
5169 use dc_types, only: string
5170 character(*), intent(in):: file
5171 character(STRING):: result
5172 end function file_rename_mpi
5173 end interface
5174 continue
5175 file_work = file
5176 ! ファイル名の変更 (MPI 用)
5177 ! Change filename (for MPI)
5178 !
5179 if ( present_and_true( flag_mpi_split ) ) &
5180 & file_work = file_rename_mpi( file_work )
5181 ! 必要な情報を gtool 変数化
5182 !
5183 call lookup_growable_url(file_work, varname, url, range, &
5184 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5185 call dbgmessage('@ url =%c', c1=trim(url))
5186 ! いよいよデータ取得
5187 !
5188 call open(var, url, err)
5189 call get(var, array, err)
5190 call close(var, err)
5191 call actual_iorange_dump(url, & ! (in)
5192 & actual_url, returned_time, & ! (out) optional
5193 & time_name = tname, & ! (in) optional
5194 & err = err) ! (out) optional
5195 if ( .not. present_and_true(quiet) ) then
5196 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5197 end if
5198end subroutine historygetdouble5pointer
5199subroutine historygetdouble6pointer(file, varname, array, range, &
5200 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5201 use gtdata_types, only: gt_variable
5202 use gtdata_generic, only: open, inquire, close, get
5203 use dc_string, only: tochar
5205 use dc_types, only: string, dp
5206 use dc_message, only: messagenotify
5207 use dc_trace, only: dbgmessage
5208 implicit none
5209 character(*), intent(in):: file
5210 character(*), intent(in):: varname
5211 character(*), intent(in), optional:: range
5212 logical, intent(in), optional:: quiet
5213 logical, intent(in), optional:: flag_mpi_split
5214 real(DP), intent(out), optional:: returned_time ! データの時刻
5215 logical, intent(out), optional:: flag_time_exist
5216 logical, intent(out), optional:: err
5217 real(DP), pointer :: array(:,:,:,:,:,:) ! (out)
5218 type(gt_variable):: var
5219 character(STRING):: file_work, url, actual_url
5220 character(STRING):: tname
5221 character(*), parameter :: subname = "HistoryGetDouble6Pointer"
5222 interface
5223 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5224 character(*), intent(in):: file
5225 character(*), intent(in):: varname
5226 character(*), intent(out):: url
5227 character(*), intent(in), optional:: range
5228 logical, intent(out), optional:: flag_time_exist
5229 character(*), intent(out), optional:: time_name
5230 logical, intent(out), optional:: err
5231 end subroutine lookup_growable_url
5232 end interface
5233 interface
5234 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5235 use dc_types, only: dp
5236 character(*), intent(in) :: url ! 変数 URL
5237 character(*), intent(out), optional :: actual_url
5238 ! 正確な入出力範囲指定
5239 real(DP), intent(out), optional:: returned_time ! データの時刻
5240 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5241 logical, intent(out), optional :: err ! エラーのフラグ
5242 end subroutine actual_iorange_dump
5243 end interface
5244 interface
5245 function file_rename_mpi( file ) result(result)
5246 use dc_types, only: string
5247 character(*), intent(in):: file
5248 character(STRING):: result
5249 end function file_rename_mpi
5250 end interface
5251 continue
5252 file_work = file
5253 ! ファイル名の変更 (MPI 用)
5254 ! Change filename (for MPI)
5255 !
5256 if ( present_and_true( flag_mpi_split ) ) &
5257 & file_work = file_rename_mpi( file_work )
5258 ! 必要な情報を gtool 変数化
5259 !
5260 call lookup_growable_url(file_work, varname, url, range, &
5261 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5262 call dbgmessage('@ url =%c', c1=trim(url))
5263 ! いよいよデータ取得
5264 !
5265 call open(var, url, err)
5266 call get(var, array, err)
5267 call close(var, err)
5268 call actual_iorange_dump(url, & ! (in)
5269 & actual_url, returned_time, & ! (out) optional
5270 & time_name = tname, & ! (in) optional
5271 & err = err) ! (out) optional
5272 if ( .not. present_and_true(quiet) ) then
5273 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5274 end if
5275end subroutine historygetdouble6pointer
5276subroutine historygetdouble7pointer(file, varname, array, range, &
5277 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5278 use gtdata_types, only: gt_variable
5279 use gtdata_generic, only: open, inquire, close, get
5280 use dc_string, only: tochar
5282 use dc_types, only: string, dp
5283 use dc_message, only: messagenotify
5284 use dc_trace, only: dbgmessage
5285 implicit none
5286 character(*), intent(in):: file
5287 character(*), intent(in):: varname
5288 character(*), intent(in), optional:: range
5289 logical, intent(in), optional:: quiet
5290 logical, intent(in), optional:: flag_mpi_split
5291 real(DP), intent(out), optional:: returned_time ! データの時刻
5292 logical, intent(out), optional:: flag_time_exist
5293 logical, intent(out), optional:: err
5294 real(DP), pointer :: array(:,:,:,:,:,:,:) ! (out)
5295 type(gt_variable):: var
5296 character(STRING):: file_work, url, actual_url
5297 character(STRING):: tname
5298 character(*), parameter :: subname = "HistoryGetDouble7Pointer"
5299 interface
5300 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5301 character(*), intent(in):: file
5302 character(*), intent(in):: varname
5303 character(*), intent(out):: url
5304 character(*), intent(in), optional:: range
5305 logical, intent(out), optional:: flag_time_exist
5306 character(*), intent(out), optional:: time_name
5307 logical, intent(out), optional:: err
5308 end subroutine lookup_growable_url
5309 end interface
5310 interface
5311 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5312 use dc_types, only: dp
5313 character(*), intent(in) :: url ! 変数 URL
5314 character(*), intent(out), optional :: actual_url
5315 ! 正確な入出力範囲指定
5316 real(DP), intent(out), optional:: returned_time ! データの時刻
5317 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5318 logical, intent(out), optional :: err ! エラーのフラグ
5319 end subroutine actual_iorange_dump
5320 end interface
5321 interface
5322 function file_rename_mpi( file ) result(result)
5323 use dc_types, only: string
5324 character(*), intent(in):: file
5325 character(STRING):: result
5326 end function file_rename_mpi
5327 end interface
5328 continue
5329 file_work = file
5330 ! ファイル名の変更 (MPI 用)
5331 ! Change filename (for MPI)
5332 !
5333 if ( present_and_true( flag_mpi_split ) ) &
5334 & file_work = file_rename_mpi( file_work )
5335 ! 必要な情報を gtool 変数化
5336 !
5337 call lookup_growable_url(file_work, varname, url, range, &
5338 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5339 call dbgmessage('@ url =%c', c1=trim(url))
5340 ! いよいよデータ取得
5341 !
5342 call open(var, url, err)
5343 call get(var, array, err)
5344 call close(var, err)
5345 call actual_iorange_dump(url, & ! (in)
5346 & actual_url, returned_time, & ! (out) optional
5347 & time_name = tname, & ! (in) optional
5348 & err = err) ! (out) optional
5349 if ( .not. present_and_true(quiet) ) then
5350 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5351 end if
5352end subroutine historygetdouble7pointer
5353subroutine historygetreal0pointer(file, varname, array, range, &
5354 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5355 use gtdata_types, only: gt_variable
5356 use gtdata_generic, only: open, inquire, close, get
5357 use dc_string, only: tochar
5359 use dc_types, only: string, dp, sp
5360 use dc_message, only: messagenotify
5361 use dc_trace, only: dbgmessage
5362 implicit none
5363 character(*), intent(in):: file
5364 character(*), intent(in):: varname
5365 character(*), intent(in), optional:: range
5366 logical, intent(in), optional:: quiet
5367 logical, intent(in), optional:: flag_mpi_split
5368 real(DP), intent(out), optional:: returned_time ! データの時刻
5369 logical, intent(out), optional:: flag_time_exist
5370 logical, intent(out), optional:: err
5371 integer:: domain
5372 real(SP), pointer :: array ! (out)
5373 real(SP), target :: array_tmp(1)
5374 type(gt_variable):: var
5375 character(STRING):: file_work, url, actual_url
5376 character(STRING):: tname
5377 character(*), parameter :: subname = "HistoryGetReal0Pointer"
5378 interface
5379 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5380 character(*), intent(in):: file
5381 character(*), intent(in):: varname
5382 character(*), intent(out):: url
5383 character(*), intent(in), optional:: range
5384 logical, intent(out), optional:: flag_time_exist
5385 character(*), intent(out), optional:: time_name
5386 logical, intent(out), optional:: err
5387 end subroutine lookup_growable_url
5388 end interface
5389 interface
5390 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5391 use dc_types, only: dp
5392 character(*), intent(in) :: url ! 変数 URL
5393 character(*), intent(out), optional :: actual_url
5394 ! 正確な入出力範囲指定
5395 real(DP), intent(out), optional:: returned_time ! データの時刻
5396 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5397 logical, intent(out), optional :: err ! エラーのフラグ
5398 end subroutine actual_iorange_dump
5399 end interface
5400 interface
5401 function file_rename_mpi( file ) result(result)
5402 use dc_types, only: string
5403 character(*), intent(in):: file
5404 character(STRING):: result
5405 end function file_rename_mpi
5406 end interface
5407 continue
5408 file_work = file
5409 ! ファイル名の変更 (MPI 用)
5410 ! Change filename (for MPI)
5411 !
5412 if ( present_and_true( flag_mpi_split ) ) &
5413 & file_work = file_rename_mpi( file_work )
5414 ! 必要な情報を gtool 変数化
5415 !
5416 call lookup_growable_url(file_work, varname, url, range, &
5417 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5418 allocate(array)
5419 call dbgmessage('@ url =%c', c1=trim(url))
5420 ! いよいよデータ取得
5421 !
5422 call open(var, url, err)
5423 call inquire(var=var, size=domain)
5424 call get(var, array_tmp, domain, err)
5425 array = array_tmp(1)
5426 call close(var, err)
5427 call actual_iorange_dump(url, & ! (in)
5428 & actual_url, returned_time, & ! (out) optional
5429 & time_name = tname, & ! (in) optional
5430 & err = err) ! (out) optional
5431 if ( .not. present_and_true(quiet) ) then
5432 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5433 end if
5434end subroutine historygetreal0pointer
5435subroutine historygetreal1pointer(file, varname, array, range, &
5436 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5437 use gtdata_types, only: gt_variable
5438 use gtdata_generic, only: open, inquire, close, get
5439 use dc_string, only: tochar
5441 use dc_types, only: string, dp, sp
5442 use dc_message, only: messagenotify
5443 use dc_trace, only: dbgmessage
5444 implicit none
5445 character(*), intent(in):: file
5446 character(*), intent(in):: varname
5447 character(*), intent(in), optional:: range
5448 logical, intent(in), optional:: quiet
5449 logical, intent(in), optional:: flag_mpi_split
5450 real(DP), intent(out), optional:: returned_time ! データの時刻
5451 logical, intent(out), optional:: flag_time_exist
5452 logical, intent(out), optional:: err
5453 real(SP), pointer :: array(:) ! (out)
5454 type(gt_variable):: var
5455 character(STRING):: file_work, url, actual_url
5456 character(STRING):: tname
5457 character(*), parameter :: subname = "HistoryGetReal1Pointer"
5458 interface
5459 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5460 character(*), intent(in):: file
5461 character(*), intent(in):: varname
5462 character(*), intent(out):: url
5463 character(*), intent(in), optional:: range
5464 logical, intent(out), optional:: flag_time_exist
5465 character(*), intent(out), optional:: time_name
5466 logical, intent(out), optional:: err
5467 end subroutine lookup_growable_url
5468 end interface
5469 interface
5470 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5471 use dc_types, only: dp
5472 character(*), intent(in) :: url ! 変数 URL
5473 character(*), intent(out), optional :: actual_url
5474 ! 正確な入出力範囲指定
5475 real(DP), intent(out), optional:: returned_time ! データの時刻
5476 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5477 logical, intent(out), optional :: err ! エラーのフラグ
5478 end subroutine actual_iorange_dump
5479 end interface
5480 interface
5481 function file_rename_mpi( file ) result(result)
5482 use dc_types, only: string
5483 character(*), intent(in):: file
5484 character(STRING):: result
5485 end function file_rename_mpi
5486 end interface
5487 continue
5488 file_work = file
5489 ! ファイル名の変更 (MPI 用)
5490 ! Change filename (for MPI)
5491 !
5492 if ( present_and_true( flag_mpi_split ) ) &
5493 & file_work = file_rename_mpi( file_work )
5494 ! 必要な情報を gtool 変数化
5495 !
5496 call lookup_growable_url(file_work, varname, url, range, &
5497 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5498 call dbgmessage('@ url =%c', c1=trim(url))
5499 ! いよいよデータ取得
5500 !
5501 call open(var, url, err)
5502 call get(var, array, err)
5503 call close(var, err)
5504 call actual_iorange_dump(url, & ! (in)
5505 & actual_url, returned_time, & ! (out) optional
5506 & time_name = tname, & ! (in) optional
5507 & err = err) ! (out) optional
5508 if ( .not. present_and_true(quiet) ) then
5509 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5510 end if
5511end subroutine historygetreal1pointer
5512subroutine historygetreal2pointer(file, varname, array, range, &
5513 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5514 use gtdata_types, only: gt_variable
5515 use gtdata_generic, only: open, inquire, close, get
5516 use dc_string, only: tochar
5518 use dc_types, only: string, dp, sp
5519 use dc_message, only: messagenotify
5520 use dc_trace, only: dbgmessage
5521 implicit none
5522 character(*), intent(in):: file
5523 character(*), intent(in):: varname
5524 character(*), intent(in), optional:: range
5525 logical, intent(in), optional:: quiet
5526 logical, intent(in), optional:: flag_mpi_split
5527 real(DP), intent(out), optional:: returned_time ! データの時刻
5528 logical, intent(out), optional:: flag_time_exist
5529 logical, intent(out), optional:: err
5530 real(SP), pointer :: array(:,:) ! (out)
5531 type(gt_variable):: var
5532 character(STRING):: file_work, url, actual_url
5533 character(STRING):: tname
5534 character(*), parameter :: subname = "HistoryGetReal2Pointer"
5535 interface
5536 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5537 character(*), intent(in):: file
5538 character(*), intent(in):: varname
5539 character(*), intent(out):: url
5540 character(*), intent(in), optional:: range
5541 logical, intent(out), optional:: flag_time_exist
5542 character(*), intent(out), optional:: time_name
5543 logical, intent(out), optional:: err
5544 end subroutine lookup_growable_url
5545 end interface
5546 interface
5547 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5548 use dc_types, only: dp
5549 character(*), intent(in) :: url ! 変数 URL
5550 character(*), intent(out), optional :: actual_url
5551 ! 正確な入出力範囲指定
5552 real(DP), intent(out), optional:: returned_time ! データの時刻
5553 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5554 logical, intent(out), optional :: err ! エラーのフラグ
5555 end subroutine actual_iorange_dump
5556 end interface
5557 interface
5558 function file_rename_mpi( file ) result(result)
5559 use dc_types, only: string
5560 character(*), intent(in):: file
5561 character(STRING):: result
5562 end function file_rename_mpi
5563 end interface
5564 continue
5565 file_work = file
5566 ! ファイル名の変更 (MPI 用)
5567 ! Change filename (for MPI)
5568 !
5569 if ( present_and_true( flag_mpi_split ) ) &
5570 & file_work = file_rename_mpi( file_work )
5571 ! 必要な情報を gtool 変数化
5572 !
5573 call lookup_growable_url(file_work, varname, url, range, &
5574 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5575 call dbgmessage('@ url =%c', c1=trim(url))
5576 ! いよいよデータ取得
5577 !
5578 call open(var, url, err)
5579 call get(var, array, err)
5580 call close(var, err)
5581 call actual_iorange_dump(url, & ! (in)
5582 & actual_url, returned_time, & ! (out) optional
5583 & time_name = tname, & ! (in) optional
5584 & err = err) ! (out) optional
5585 if ( .not. present_and_true(quiet) ) then
5586 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5587 end if
5588end subroutine historygetreal2pointer
5589subroutine historygetreal3pointer(file, varname, array, range, &
5590 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5591 use gtdata_types, only: gt_variable
5592 use gtdata_generic, only: open, inquire, close, get
5593 use dc_string, only: tochar
5595 use dc_types, only: string, dp, sp
5596 use dc_message, only: messagenotify
5597 use dc_trace, only: dbgmessage
5598 implicit none
5599 character(*), intent(in):: file
5600 character(*), intent(in):: varname
5601 character(*), intent(in), optional:: range
5602 logical, intent(in), optional:: quiet
5603 logical, intent(in), optional:: flag_mpi_split
5604 real(DP), intent(out), optional:: returned_time ! データの時刻
5605 logical, intent(out), optional:: flag_time_exist
5606 logical, intent(out), optional:: err
5607 real(SP), pointer :: array(:,:,:) ! (out)
5608 type(gt_variable):: var
5609 character(STRING):: file_work, url, actual_url
5610 character(STRING):: tname
5611 character(*), parameter :: subname = "HistoryGetReal3Pointer"
5612 interface
5613 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5614 character(*), intent(in):: file
5615 character(*), intent(in):: varname
5616 character(*), intent(out):: url
5617 character(*), intent(in), optional:: range
5618 logical, intent(out), optional:: flag_time_exist
5619 character(*), intent(out), optional:: time_name
5620 logical, intent(out), optional:: err
5621 end subroutine lookup_growable_url
5622 end interface
5623 interface
5624 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5625 use dc_types, only: dp
5626 character(*), intent(in) :: url ! 変数 URL
5627 character(*), intent(out), optional :: actual_url
5628 ! 正確な入出力範囲指定
5629 real(DP), intent(out), optional:: returned_time ! データの時刻
5630 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5631 logical, intent(out), optional :: err ! エラーのフラグ
5632 end subroutine actual_iorange_dump
5633 end interface
5634 interface
5635 function file_rename_mpi( file ) result(result)
5636 use dc_types, only: string
5637 character(*), intent(in):: file
5638 character(STRING):: result
5639 end function file_rename_mpi
5640 end interface
5641 continue
5642 file_work = file
5643 ! ファイル名の変更 (MPI 用)
5644 ! Change filename (for MPI)
5645 !
5646 if ( present_and_true( flag_mpi_split ) ) &
5647 & file_work = file_rename_mpi( file_work )
5648 ! 必要な情報を gtool 変数化
5649 !
5650 call lookup_growable_url(file_work, varname, url, range, &
5651 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5652 call dbgmessage('@ url =%c', c1=trim(url))
5653 ! いよいよデータ取得
5654 !
5655 call open(var, url, err)
5656 call get(var, array, err)
5657 call close(var, err)
5658 call actual_iorange_dump(url, & ! (in)
5659 & actual_url, returned_time, & ! (out) optional
5660 & time_name = tname, & ! (in) optional
5661 & err = err) ! (out) optional
5662 if ( .not. present_and_true(quiet) ) then
5663 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5664 end if
5665end subroutine historygetreal3pointer
5666subroutine historygetreal4pointer(file, varname, array, range, &
5667 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5668 use gtdata_types, only: gt_variable
5669 use gtdata_generic, only: open, inquire, close, get
5670 use dc_string, only: tochar
5672 use dc_types, only: string, dp, sp
5673 use dc_message, only: messagenotify
5674 use dc_trace, only: dbgmessage
5675 implicit none
5676 character(*), intent(in):: file
5677 character(*), intent(in):: varname
5678 character(*), intent(in), optional:: range
5679 logical, intent(in), optional:: quiet
5680 logical, intent(in), optional:: flag_mpi_split
5681 real(DP), intent(out), optional:: returned_time ! データの時刻
5682 logical, intent(out), optional:: flag_time_exist
5683 logical, intent(out), optional:: err
5684 real(SP), pointer :: array(:,:,:,:) ! (out)
5685 type(gt_variable):: var
5686 character(STRING):: file_work, url, actual_url
5687 character(STRING):: tname
5688 character(*), parameter :: subname = "HistoryGetReal4Pointer"
5689 interface
5690 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5691 character(*), intent(in):: file
5692 character(*), intent(in):: varname
5693 character(*), intent(out):: url
5694 character(*), intent(in), optional:: range
5695 logical, intent(out), optional:: flag_time_exist
5696 character(*), intent(out), optional:: time_name
5697 logical, intent(out), optional:: err
5698 end subroutine lookup_growable_url
5699 end interface
5700 interface
5701 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5702 use dc_types, only: dp
5703 character(*), intent(in) :: url ! 変数 URL
5704 character(*), intent(out), optional :: actual_url
5705 ! 正確な入出力範囲指定
5706 real(DP), intent(out), optional:: returned_time ! データの時刻
5707 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5708 logical, intent(out), optional :: err ! エラーのフラグ
5709 end subroutine actual_iorange_dump
5710 end interface
5711 interface
5712 function file_rename_mpi( file ) result(result)
5713 use dc_types, only: string
5714 character(*), intent(in):: file
5715 character(STRING):: result
5716 end function file_rename_mpi
5717 end interface
5718 continue
5719 file_work = file
5720 ! ファイル名の変更 (MPI 用)
5721 ! Change filename (for MPI)
5722 !
5723 if ( present_and_true( flag_mpi_split ) ) &
5724 & file_work = file_rename_mpi( file_work )
5725 ! 必要な情報を gtool 変数化
5726 !
5727 call lookup_growable_url(file_work, varname, url, range, &
5728 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5729 call dbgmessage('@ url =%c', c1=trim(url))
5730 ! いよいよデータ取得
5731 !
5732 call open(var, url, err)
5733 call get(var, array, err)
5734 call close(var, err)
5735 call actual_iorange_dump(url, & ! (in)
5736 & actual_url, returned_time, & ! (out) optional
5737 & time_name = tname, & ! (in) optional
5738 & err = err) ! (out) optional
5739 if ( .not. present_and_true(quiet) ) then
5740 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5741 end if
5742end subroutine historygetreal4pointer
5743subroutine historygetreal5pointer(file, varname, array, range, &
5744 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5745 use gtdata_types, only: gt_variable
5746 use gtdata_generic, only: open, inquire, close, get
5747 use dc_string, only: tochar
5749 use dc_types, only: string, dp, sp
5750 use dc_message, only: messagenotify
5751 use dc_trace, only: dbgmessage
5752 implicit none
5753 character(*), intent(in):: file
5754 character(*), intent(in):: varname
5755 character(*), intent(in), optional:: range
5756 logical, intent(in), optional:: quiet
5757 logical, intent(in), optional:: flag_mpi_split
5758 real(DP), intent(out), optional:: returned_time ! データの時刻
5759 logical, intent(out), optional:: flag_time_exist
5760 logical, intent(out), optional:: err
5761 real(SP), pointer :: array(:,:,:,:,:) ! (out)
5762 type(gt_variable):: var
5763 character(STRING):: file_work, url, actual_url
5764 character(STRING):: tname
5765 character(*), parameter :: subname = "HistoryGetReal5Pointer"
5766 interface
5767 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5768 character(*), intent(in):: file
5769 character(*), intent(in):: varname
5770 character(*), intent(out):: url
5771 character(*), intent(in), optional:: range
5772 logical, intent(out), optional:: flag_time_exist
5773 character(*), intent(out), optional:: time_name
5774 logical, intent(out), optional:: err
5775 end subroutine lookup_growable_url
5776 end interface
5777 interface
5778 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5779 use dc_types, only: dp
5780 character(*), intent(in) :: url ! 変数 URL
5781 character(*), intent(out), optional :: actual_url
5782 ! 正確な入出力範囲指定
5783 real(DP), intent(out), optional:: returned_time ! データの時刻
5784 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5785 logical, intent(out), optional :: err ! エラーのフラグ
5786 end subroutine actual_iorange_dump
5787 end interface
5788 interface
5789 function file_rename_mpi( file ) result(result)
5790 use dc_types, only: string
5791 character(*), intent(in):: file
5792 character(STRING):: result
5793 end function file_rename_mpi
5794 end interface
5795 continue
5796 file_work = file
5797 ! ファイル名の変更 (MPI 用)
5798 ! Change filename (for MPI)
5799 !
5800 if ( present_and_true( flag_mpi_split ) ) &
5801 & file_work = file_rename_mpi( file_work )
5802 ! 必要な情報を gtool 変数化
5803 !
5804 call lookup_growable_url(file_work, varname, url, range, &
5805 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5806 call dbgmessage('@ url =%c', c1=trim(url))
5807 ! いよいよデータ取得
5808 !
5809 call open(var, url, err)
5810 call get(var, array, err)
5811 call close(var, err)
5812 call actual_iorange_dump(url, & ! (in)
5813 & actual_url, returned_time, & ! (out) optional
5814 & time_name = tname, & ! (in) optional
5815 & err = err) ! (out) optional
5816 if ( .not. present_and_true(quiet) ) then
5817 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5818 end if
5819end subroutine historygetreal5pointer
5820subroutine historygetreal6pointer(file, varname, array, range, &
5821 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5822 use gtdata_types, only: gt_variable
5823 use gtdata_generic, only: open, inquire, close, get
5824 use dc_string, only: tochar
5826 use dc_types, only: string, dp, sp
5827 use dc_message, only: messagenotify
5828 use dc_trace, only: dbgmessage
5829 implicit none
5830 character(*), intent(in):: file
5831 character(*), intent(in):: varname
5832 character(*), intent(in), optional:: range
5833 logical, intent(in), optional:: quiet
5834 logical, intent(in), optional:: flag_mpi_split
5835 real(DP), intent(out), optional:: returned_time ! データの時刻
5836 logical, intent(out), optional:: flag_time_exist
5837 logical, intent(out), optional:: err
5838 real(SP), pointer :: array(:,:,:,:,:,:) ! (out)
5839 type(gt_variable):: var
5840 character(STRING):: file_work, url, actual_url
5841 character(STRING):: tname
5842 character(*), parameter :: subname = "HistoryGetReal6Pointer"
5843 interface
5844 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5845 character(*), intent(in):: file
5846 character(*), intent(in):: varname
5847 character(*), intent(out):: url
5848 character(*), intent(in), optional:: range
5849 logical, intent(out), optional:: flag_time_exist
5850 character(*), intent(out), optional:: time_name
5851 logical, intent(out), optional:: err
5852 end subroutine lookup_growable_url
5853 end interface
5854 interface
5855 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5856 use dc_types, only: dp
5857 character(*), intent(in) :: url ! 変数 URL
5858 character(*), intent(out), optional :: actual_url
5859 ! 正確な入出力範囲指定
5860 real(DP), intent(out), optional:: returned_time ! データの時刻
5861 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5862 logical, intent(out), optional :: err ! エラーのフラグ
5863 end subroutine actual_iorange_dump
5864 end interface
5865 interface
5866 function file_rename_mpi( file ) result(result)
5867 use dc_types, only: string
5868 character(*), intent(in):: file
5869 character(STRING):: result
5870 end function file_rename_mpi
5871 end interface
5872 continue
5873 file_work = file
5874 ! ファイル名の変更 (MPI 用)
5875 ! Change filename (for MPI)
5876 !
5877 if ( present_and_true( flag_mpi_split ) ) &
5878 & file_work = file_rename_mpi( file_work )
5879 ! 必要な情報を gtool 変数化
5880 !
5881 call lookup_growable_url(file_work, varname, url, range, &
5882 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5883 call dbgmessage('@ url =%c', c1=trim(url))
5884 ! いよいよデータ取得
5885 !
5886 call open(var, url, err)
5887 call get(var, array, err)
5888 call close(var, err)
5889 call actual_iorange_dump(url, & ! (in)
5890 & actual_url, returned_time, & ! (out) optional
5891 & time_name = tname, & ! (in) optional
5892 & err = err) ! (out) optional
5893 if ( .not. present_and_true(quiet) ) then
5894 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5895 end if
5896end subroutine historygetreal6pointer
5897subroutine historygetreal7pointer(file, varname, array, range, &
5898 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5899 use gtdata_types, only: gt_variable
5900 use gtdata_generic, only: open, inquire, close, get
5901 use dc_string, only: tochar
5903 use dc_types, only: string, dp, sp
5904 use dc_message, only: messagenotify
5905 use dc_trace, only: dbgmessage
5906 implicit none
5907 character(*), intent(in):: file
5908 character(*), intent(in):: varname
5909 character(*), intent(in), optional:: range
5910 logical, intent(in), optional:: quiet
5911 logical, intent(in), optional:: flag_mpi_split
5912 real(DP), intent(out), optional:: returned_time ! データの時刻
5913 logical, intent(out), optional:: flag_time_exist
5914 logical, intent(out), optional:: err
5915 real(SP), pointer :: array(:,:,:,:,:,:,:) ! (out)
5916 type(gt_variable):: var
5917 character(STRING):: file_work, url, actual_url
5918 character(STRING):: tname
5919 character(*), parameter :: subname = "HistoryGetReal7Pointer"
5920 interface
5921 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
5922 character(*), intent(in):: file
5923 character(*), intent(in):: varname
5924 character(*), intent(out):: url
5925 character(*), intent(in), optional:: range
5926 logical, intent(out), optional:: flag_time_exist
5927 character(*), intent(out), optional:: time_name
5928 logical, intent(out), optional:: err
5929 end subroutine lookup_growable_url
5930 end interface
5931 interface
5932 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
5933 use dc_types, only: dp
5934 character(*), intent(in) :: url ! 変数 URL
5935 character(*), intent(out), optional :: actual_url
5936 ! 正確な入出力範囲指定
5937 real(DP), intent(out), optional:: returned_time ! データの時刻
5938 character(*), intent(in), optional:: time_name ! 時刻次元の名称
5939 logical, intent(out), optional :: err ! エラーのフラグ
5940 end subroutine actual_iorange_dump
5941 end interface
5942 interface
5943 function file_rename_mpi( file ) result(result)
5944 use dc_types, only: string
5945 character(*), intent(in):: file
5946 character(STRING):: result
5947 end function file_rename_mpi
5948 end interface
5949 continue
5950 file_work = file
5951 ! ファイル名の変更 (MPI 用)
5952 ! Change filename (for MPI)
5953 !
5954 if ( present_and_true( flag_mpi_split ) ) &
5955 & file_work = file_rename_mpi( file_work )
5956 ! 必要な情報を gtool 変数化
5957 !
5958 call lookup_growable_url(file_work, varname, url, range, &
5959 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
5960 call dbgmessage('@ url =%c', c1=trim(url))
5961 ! いよいよデータ取得
5962 !
5963 call open(var, url, err)
5964 call get(var, array, err)
5965 call close(var, err)
5966 call actual_iorange_dump(url, & ! (in)
5967 & actual_url, returned_time, & ! (out) optional
5968 & time_name = tname, & ! (in) optional
5969 & err = err) ! (out) optional
5970 if ( .not. present_and_true(quiet) ) then
5971 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
5972 end if
5973end subroutine historygetreal7pointer
5974subroutine historygetint0pointer(file, varname, array, range, &
5975 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
5976 use gtdata_types, only: gt_variable
5977 use gtdata_generic, only: open, inquire, close, get
5978 use dc_string, only: tochar
5980 use dc_types, only: string, dp
5981 use dc_message, only: messagenotify
5982 use dc_trace, only: dbgmessage
5983 implicit none
5984 character(*), intent(in):: file
5985 character(*), intent(in):: varname
5986 character(*), intent(in), optional:: range
5987 logical, intent(in), optional:: quiet
5988 logical, intent(in), optional:: flag_mpi_split
5989 real(DP), intent(out), optional:: returned_time ! データの時刻
5990 logical, intent(out), optional:: flag_time_exist
5991 logical, intent(out), optional:: err
5992 integer:: domain
5993 integer, pointer :: array ! (out)
5994 integer, target :: array_tmp(1)
5995 type(gt_variable):: var
5996 character(STRING):: file_work, url, actual_url
5997 character(STRING):: tname
5998 character(*), parameter :: subname = "HistoryGetInt0Pointer"
5999 interface
6000 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6001 character(*), intent(in):: file
6002 character(*), intent(in):: varname
6003 character(*), intent(out):: url
6004 character(*), intent(in), optional:: range
6005 logical, intent(out), optional:: flag_time_exist
6006 character(*), intent(out), optional:: time_name
6007 logical, intent(out), optional:: err
6008 end subroutine lookup_growable_url
6009 end interface
6010 interface
6011 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6012 use dc_types, only: dp
6013 character(*), intent(in) :: url ! 変数 URL
6014 character(*), intent(out), optional :: actual_url
6015 ! 正確な入出力範囲指定
6016 real(DP), intent(out), optional:: returned_time ! データの時刻
6017 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6018 logical, intent(out), optional :: err ! エラーのフラグ
6019 end subroutine actual_iorange_dump
6020 end interface
6021 interface
6022 function file_rename_mpi( file ) result(result)
6023 use dc_types, only: string
6024 character(*), intent(in):: file
6025 character(STRING):: result
6026 end function file_rename_mpi
6027 end interface
6028 continue
6029 file_work = file
6030 ! ファイル名の変更 (MPI 用)
6031 ! Change filename (for MPI)
6032 !
6033 if ( present_and_true( flag_mpi_split ) ) &
6034 & file_work = file_rename_mpi( file_work )
6035 ! 必要な情報を gtool 変数化
6036 !
6037 call lookup_growable_url(file_work, varname, url, range, &
6038 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6039 allocate(array)
6040 call dbgmessage('@ url =%c', c1=trim(url))
6041 ! いよいよデータ取得
6042 !
6043 call open(var, url, err)
6044 call inquire(var=var, size=domain)
6045 call get(var, array_tmp, domain, err)
6046 array = array_tmp(1)
6047 call close(var, err)
6048 call actual_iorange_dump(url, & ! (in)
6049 & actual_url, returned_time, & ! (out) optional
6050 & time_name = tname, & ! (in) optional
6051 & err = err) ! (out) optional
6052 if ( .not. present_and_true(quiet) ) then
6053 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6054 end if
6055end subroutine historygetint0pointer
6056subroutine historygetint1pointer(file, varname, array, range, &
6057 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6058 use gtdata_types, only: gt_variable
6059 use gtdata_generic, only: open, inquire, close, get
6060 use dc_string, only: tochar
6062 use dc_types, only: string, dp
6063 use dc_message, only: messagenotify
6064 use dc_trace, only: dbgmessage
6065 implicit none
6066 character(*), intent(in):: file
6067 character(*), intent(in):: varname
6068 character(*), intent(in), optional:: range
6069 logical, intent(in), optional:: quiet
6070 logical, intent(in), optional:: flag_mpi_split
6071 real(DP), intent(out), optional:: returned_time ! データの時刻
6072 logical, intent(out), optional:: flag_time_exist
6073 logical, intent(out), optional:: err
6074 integer, pointer :: array(:) ! (out)
6075 type(gt_variable):: var
6076 character(STRING):: file_work, url, actual_url
6077 character(STRING):: tname
6078 character(*), parameter :: subname = "HistoryGetInt1Pointer"
6079 interface
6080 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6081 character(*), intent(in):: file
6082 character(*), intent(in):: varname
6083 character(*), intent(out):: url
6084 character(*), intent(in), optional:: range
6085 logical, intent(out), optional:: flag_time_exist
6086 character(*), intent(out), optional:: time_name
6087 logical, intent(out), optional:: err
6088 end subroutine lookup_growable_url
6089 end interface
6090 interface
6091 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6092 use dc_types, only: dp
6093 character(*), intent(in) :: url ! 変数 URL
6094 character(*), intent(out), optional :: actual_url
6095 ! 正確な入出力範囲指定
6096 real(DP), intent(out), optional:: returned_time ! データの時刻
6097 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6098 logical, intent(out), optional :: err ! エラーのフラグ
6099 end subroutine actual_iorange_dump
6100 end interface
6101 interface
6102 function file_rename_mpi( file ) result(result)
6103 use dc_types, only: string
6104 character(*), intent(in):: file
6105 character(STRING):: result
6106 end function file_rename_mpi
6107 end interface
6108 continue
6109 file_work = file
6110 ! ファイル名の変更 (MPI 用)
6111 ! Change filename (for MPI)
6112 !
6113 if ( present_and_true( flag_mpi_split ) ) &
6114 & file_work = file_rename_mpi( file_work )
6115 ! 必要な情報を gtool 変数化
6116 !
6117 call lookup_growable_url(file_work, varname, url, range, &
6118 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6119 call dbgmessage('@ url =%c', c1=trim(url))
6120 ! いよいよデータ取得
6121 !
6122 call open(var, url, err)
6123 call get(var, array, err)
6124 call close(var, err)
6125 call actual_iorange_dump(url, & ! (in)
6126 & actual_url, returned_time, & ! (out) optional
6127 & time_name = tname, & ! (in) optional
6128 & err = err) ! (out) optional
6129 if ( .not. present_and_true(quiet) ) then
6130 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6131 end if
6132end subroutine historygetint1pointer
6133subroutine historygetint2pointer(file, varname, array, range, &
6134 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6135 use gtdata_types, only: gt_variable
6136 use gtdata_generic, only: open, inquire, close, get
6137 use dc_string, only: tochar
6139 use dc_types, only: string, dp
6140 use dc_message, only: messagenotify
6141 use dc_trace, only: dbgmessage
6142 implicit none
6143 character(*), intent(in):: file
6144 character(*), intent(in):: varname
6145 character(*), intent(in), optional:: range
6146 logical, intent(in), optional:: quiet
6147 logical, intent(in), optional:: flag_mpi_split
6148 real(DP), intent(out), optional:: returned_time ! データの時刻
6149 logical, intent(out), optional:: flag_time_exist
6150 logical, intent(out), optional:: err
6151 integer, pointer :: array(:,:) ! (out)
6152 type(gt_variable):: var
6153 character(STRING):: file_work, url, actual_url
6154 character(STRING):: tname
6155 character(*), parameter :: subname = "HistoryGetInt2Pointer"
6156 interface
6157 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6158 character(*), intent(in):: file
6159 character(*), intent(in):: varname
6160 character(*), intent(out):: url
6161 character(*), intent(in), optional:: range
6162 logical, intent(out), optional:: flag_time_exist
6163 character(*), intent(out), optional:: time_name
6164 logical, intent(out), optional:: err
6165 end subroutine lookup_growable_url
6166 end interface
6167 interface
6168 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6169 use dc_types, only: dp
6170 character(*), intent(in) :: url ! 変数 URL
6171 character(*), intent(out), optional :: actual_url
6172 ! 正確な入出力範囲指定
6173 real(DP), intent(out), optional:: returned_time ! データの時刻
6174 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6175 logical, intent(out), optional :: err ! エラーのフラグ
6176 end subroutine actual_iorange_dump
6177 end interface
6178 interface
6179 function file_rename_mpi( file ) result(result)
6180 use dc_types, only: string
6181 character(*), intent(in):: file
6182 character(STRING):: result
6183 end function file_rename_mpi
6184 end interface
6185 continue
6186 file_work = file
6187 ! ファイル名の変更 (MPI 用)
6188 ! Change filename (for MPI)
6189 !
6190 if ( present_and_true( flag_mpi_split ) ) &
6191 & file_work = file_rename_mpi( file_work )
6192 ! 必要な情報を gtool 変数化
6193 !
6194 call lookup_growable_url(file_work, varname, url, range, &
6195 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6196 call dbgmessage('@ url =%c', c1=trim(url))
6197 ! いよいよデータ取得
6198 !
6199 call open(var, url, err)
6200 call get(var, array, err)
6201 call close(var, err)
6202 call actual_iorange_dump(url, & ! (in)
6203 & actual_url, returned_time, & ! (out) optional
6204 & time_name = tname, & ! (in) optional
6205 & err = err) ! (out) optional
6206 if ( .not. present_and_true(quiet) ) then
6207 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6208 end if
6209end subroutine historygetint2pointer
6210subroutine historygetint3pointer(file, varname, array, range, &
6211 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6212 use gtdata_types, only: gt_variable
6213 use gtdata_generic, only: open, inquire, close, get
6214 use dc_string, only: tochar
6216 use dc_types, only: string, dp
6217 use dc_message, only: messagenotify
6218 use dc_trace, only: dbgmessage
6219 implicit none
6220 character(*), intent(in):: file
6221 character(*), intent(in):: varname
6222 character(*), intent(in), optional:: range
6223 logical, intent(in), optional:: quiet
6224 logical, intent(in), optional:: flag_mpi_split
6225 real(DP), intent(out), optional:: returned_time ! データの時刻
6226 logical, intent(out), optional:: flag_time_exist
6227 logical, intent(out), optional:: err
6228 integer, pointer :: array(:,:,:) ! (out)
6229 type(gt_variable):: var
6230 character(STRING):: file_work, url, actual_url
6231 character(STRING):: tname
6232 character(*), parameter :: subname = "HistoryGetInt3Pointer"
6233 interface
6234 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6235 character(*), intent(in):: file
6236 character(*), intent(in):: varname
6237 character(*), intent(out):: url
6238 character(*), intent(in), optional:: range
6239 logical, intent(out), optional:: flag_time_exist
6240 character(*), intent(out), optional:: time_name
6241 logical, intent(out), optional:: err
6242 end subroutine lookup_growable_url
6243 end interface
6244 interface
6245 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6246 use dc_types, only: dp
6247 character(*), intent(in) :: url ! 変数 URL
6248 character(*), intent(out), optional :: actual_url
6249 ! 正確な入出力範囲指定
6250 real(DP), intent(out), optional:: returned_time ! データの時刻
6251 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6252 logical, intent(out), optional :: err ! エラーのフラグ
6253 end subroutine actual_iorange_dump
6254 end interface
6255 interface
6256 function file_rename_mpi( file ) result(result)
6257 use dc_types, only: string
6258 character(*), intent(in):: file
6259 character(STRING):: result
6260 end function file_rename_mpi
6261 end interface
6262 continue
6263 file_work = file
6264 ! ファイル名の変更 (MPI 用)
6265 ! Change filename (for MPI)
6266 !
6267 if ( present_and_true( flag_mpi_split ) ) &
6268 & file_work = file_rename_mpi( file_work )
6269 ! 必要な情報を gtool 変数化
6270 !
6271 call lookup_growable_url(file_work, varname, url, range, &
6272 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6273 call dbgmessage('@ url =%c', c1=trim(url))
6274 ! いよいよデータ取得
6275 !
6276 call open(var, url, err)
6277 call get(var, array, err)
6278 call close(var, err)
6279 call actual_iorange_dump(url, & ! (in)
6280 & actual_url, returned_time, & ! (out) optional
6281 & time_name = tname, & ! (in) optional
6282 & err = err) ! (out) optional
6283 if ( .not. present_and_true(quiet) ) then
6284 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6285 end if
6286end subroutine historygetint3pointer
6287subroutine historygetint4pointer(file, varname, array, range, &
6288 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6289 use gtdata_types, only: gt_variable
6290 use gtdata_generic, only: open, inquire, close, get
6291 use dc_string, only: tochar
6293 use dc_types, only: string, dp
6294 use dc_message, only: messagenotify
6295 use dc_trace, only: dbgmessage
6296 implicit none
6297 character(*), intent(in):: file
6298 character(*), intent(in):: varname
6299 character(*), intent(in), optional:: range
6300 logical, intent(in), optional:: quiet
6301 logical, intent(in), optional:: flag_mpi_split
6302 real(DP), intent(out), optional:: returned_time ! データの時刻
6303 logical, intent(out), optional:: flag_time_exist
6304 logical, intent(out), optional:: err
6305 integer, pointer :: array(:,:,:,:) ! (out)
6306 type(gt_variable):: var
6307 character(STRING):: file_work, url, actual_url
6308 character(STRING):: tname
6309 character(*), parameter :: subname = "HistoryGetInt4Pointer"
6310 interface
6311 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6312 character(*), intent(in):: file
6313 character(*), intent(in):: varname
6314 character(*), intent(out):: url
6315 character(*), intent(in), optional:: range
6316 logical, intent(out), optional:: flag_time_exist
6317 character(*), intent(out), optional:: time_name
6318 logical, intent(out), optional:: err
6319 end subroutine lookup_growable_url
6320 end interface
6321 interface
6322 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6323 use dc_types, only: dp
6324 character(*), intent(in) :: url ! 変数 URL
6325 character(*), intent(out), optional :: actual_url
6326 ! 正確な入出力範囲指定
6327 real(DP), intent(out), optional:: returned_time ! データの時刻
6328 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6329 logical, intent(out), optional :: err ! エラーのフラグ
6330 end subroutine actual_iorange_dump
6331 end interface
6332 interface
6333 function file_rename_mpi( file ) result(result)
6334 use dc_types, only: string
6335 character(*), intent(in):: file
6336 character(STRING):: result
6337 end function file_rename_mpi
6338 end interface
6339 continue
6340 file_work = file
6341 ! ファイル名の変更 (MPI 用)
6342 ! Change filename (for MPI)
6343 !
6344 if ( present_and_true( flag_mpi_split ) ) &
6345 & file_work = file_rename_mpi( file_work )
6346 ! 必要な情報を gtool 変数化
6347 !
6348 call lookup_growable_url(file_work, varname, url, range, &
6349 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6350 call dbgmessage('@ url =%c', c1=trim(url))
6351 ! いよいよデータ取得
6352 !
6353 call open(var, url, err)
6354 call get(var, array, err)
6355 call close(var, err)
6356 call actual_iorange_dump(url, & ! (in)
6357 & actual_url, returned_time, & ! (out) optional
6358 & time_name = tname, & ! (in) optional
6359 & err = err) ! (out) optional
6360 if ( .not. present_and_true(quiet) ) then
6361 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6362 end if
6363end subroutine historygetint4pointer
6364subroutine historygetint5pointer(file, varname, array, range, &
6365 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6366 use gtdata_types, only: gt_variable
6367 use gtdata_generic, only: open, inquire, close, get
6368 use dc_string, only: tochar
6370 use dc_types, only: string, dp
6371 use dc_message, only: messagenotify
6372 use dc_trace, only: dbgmessage
6373 implicit none
6374 character(*), intent(in):: file
6375 character(*), intent(in):: varname
6376 character(*), intent(in), optional:: range
6377 logical, intent(in), optional:: quiet
6378 logical, intent(in), optional:: flag_mpi_split
6379 real(DP), intent(out), optional:: returned_time ! データの時刻
6380 logical, intent(out), optional:: flag_time_exist
6381 logical, intent(out), optional:: err
6382 integer, pointer :: array(:,:,:,:,:) ! (out)
6383 type(gt_variable):: var
6384 character(STRING):: file_work, url, actual_url
6385 character(STRING):: tname
6386 character(*), parameter :: subname = "HistoryGetInt5Pointer"
6387 interface
6388 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6389 character(*), intent(in):: file
6390 character(*), intent(in):: varname
6391 character(*), intent(out):: url
6392 character(*), intent(in), optional:: range
6393 logical, intent(out), optional:: flag_time_exist
6394 character(*), intent(out), optional:: time_name
6395 logical, intent(out), optional:: err
6396 end subroutine lookup_growable_url
6397 end interface
6398 interface
6399 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6400 use dc_types, only: dp
6401 character(*), intent(in) :: url ! 変数 URL
6402 character(*), intent(out), optional :: actual_url
6403 ! 正確な入出力範囲指定
6404 real(DP), intent(out), optional:: returned_time ! データの時刻
6405 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6406 logical, intent(out), optional :: err ! エラーのフラグ
6407 end subroutine actual_iorange_dump
6408 end interface
6409 interface
6410 function file_rename_mpi( file ) result(result)
6411 use dc_types, only: string
6412 character(*), intent(in):: file
6413 character(STRING):: result
6414 end function file_rename_mpi
6415 end interface
6416 continue
6417 file_work = file
6418 ! ファイル名の変更 (MPI 用)
6419 ! Change filename (for MPI)
6420 !
6421 if ( present_and_true( flag_mpi_split ) ) &
6422 & file_work = file_rename_mpi( file_work )
6423 ! 必要な情報を gtool 変数化
6424 !
6425 call lookup_growable_url(file_work, varname, url, range, &
6426 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6427 call dbgmessage('@ url =%c', c1=trim(url))
6428 ! いよいよデータ取得
6429 !
6430 call open(var, url, err)
6431 call get(var, array, err)
6432 call close(var, err)
6433 call actual_iorange_dump(url, & ! (in)
6434 & actual_url, returned_time, & ! (out) optional
6435 & time_name = tname, & ! (in) optional
6436 & err = err) ! (out) optional
6437 if ( .not. present_and_true(quiet) ) then
6438 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6439 end if
6440end subroutine historygetint5pointer
6441subroutine historygetint6pointer(file, varname, array, range, &
6442 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6443 use gtdata_types, only: gt_variable
6444 use gtdata_generic, only: open, inquire, close, get
6445 use dc_string, only: tochar
6447 use dc_types, only: string, dp
6448 use dc_message, only: messagenotify
6449 use dc_trace, only: dbgmessage
6450 implicit none
6451 character(*), intent(in):: file
6452 character(*), intent(in):: varname
6453 character(*), intent(in), optional:: range
6454 logical, intent(in), optional:: quiet
6455 logical, intent(in), optional:: flag_mpi_split
6456 real(DP), intent(out), optional:: returned_time ! データの時刻
6457 logical, intent(out), optional:: flag_time_exist
6458 logical, intent(out), optional:: err
6459 integer, pointer :: array(:,:,:,:,:,:) ! (out)
6460 type(gt_variable):: var
6461 character(STRING):: file_work, url, actual_url
6462 character(STRING):: tname
6463 character(*), parameter :: subname = "HistoryGetInt6Pointer"
6464 interface
6465 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6466 character(*), intent(in):: file
6467 character(*), intent(in):: varname
6468 character(*), intent(out):: url
6469 character(*), intent(in), optional:: range
6470 logical, intent(out), optional:: flag_time_exist
6471 character(*), intent(out), optional:: time_name
6472 logical, intent(out), optional:: err
6473 end subroutine lookup_growable_url
6474 end interface
6475 interface
6476 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6477 use dc_types, only: dp
6478 character(*), intent(in) :: url ! 変数 URL
6479 character(*), intent(out), optional :: actual_url
6480 ! 正確な入出力範囲指定
6481 real(DP), intent(out), optional:: returned_time ! データの時刻
6482 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6483 logical, intent(out), optional :: err ! エラーのフラグ
6484 end subroutine actual_iorange_dump
6485 end interface
6486 interface
6487 function file_rename_mpi( file ) result(result)
6488 use dc_types, only: string
6489 character(*), intent(in):: file
6490 character(STRING):: result
6491 end function file_rename_mpi
6492 end interface
6493 continue
6494 file_work = file
6495 ! ファイル名の変更 (MPI 用)
6496 ! Change filename (for MPI)
6497 !
6498 if ( present_and_true( flag_mpi_split ) ) &
6499 & file_work = file_rename_mpi( file_work )
6500 ! 必要な情報を gtool 変数化
6501 !
6502 call lookup_growable_url(file_work, varname, url, range, &
6503 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6504 call dbgmessage('@ url =%c', c1=trim(url))
6505 ! いよいよデータ取得
6506 !
6507 call open(var, url, err)
6508 call get(var, array, err)
6509 call close(var, err)
6510 call actual_iorange_dump(url, & ! (in)
6511 & actual_url, returned_time, & ! (out) optional
6512 & time_name = tname, & ! (in) optional
6513 & err = err) ! (out) optional
6514 if ( .not. present_and_true(quiet) ) then
6515 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6516 end if
6517end subroutine historygetint6pointer
6518subroutine historygetint7pointer(file, varname, array, range, &
6519 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6520 use gtdata_types, only: gt_variable
6521 use gtdata_generic, only: open, inquire, close, get
6522 use dc_string, only: tochar
6524 use dc_types, only: string, dp
6525 use dc_message, only: messagenotify
6526 use dc_trace, only: dbgmessage
6527 implicit none
6528 character(*), intent(in):: file
6529 character(*), intent(in):: varname
6530 character(*), intent(in), optional:: range
6531 logical, intent(in), optional:: quiet
6532 logical, intent(in), optional:: flag_mpi_split
6533 real(DP), intent(out), optional:: returned_time ! データの時刻
6534 logical, intent(out), optional:: flag_time_exist
6535 logical, intent(out), optional:: err
6536 integer, pointer :: array(:,:,:,:,:,:,:) ! (out)
6537 type(gt_variable):: var
6538 character(STRING):: file_work, url, actual_url
6539 character(STRING):: tname
6540 character(*), parameter :: subname = "HistoryGetInt7Pointer"
6541 interface
6542 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6543 character(*), intent(in):: file
6544 character(*), intent(in):: varname
6545 character(*), intent(out):: url
6546 character(*), intent(in), optional:: range
6547 logical, intent(out), optional:: flag_time_exist
6548 character(*), intent(out), optional:: time_name
6549 logical, intent(out), optional:: err
6550 end subroutine lookup_growable_url
6551 end interface
6552 interface
6553 subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
6554 use dc_types, only: dp
6555 character(*), intent(in) :: url ! 変数 URL
6556 character(*), intent(out), optional :: actual_url
6557 ! 正確な入出力範囲指定
6558 real(DP), intent(out), optional:: returned_time ! データの時刻
6559 character(*), intent(in), optional:: time_name ! 時刻次元の名称
6560 logical, intent(out), optional :: err ! エラーのフラグ
6561 end subroutine actual_iorange_dump
6562 end interface
6563 interface
6564 function file_rename_mpi( file ) result(result)
6565 use dc_types, only: string
6566 character(*), intent(in):: file
6567 character(STRING):: result
6568 end function file_rename_mpi
6569 end interface
6570 continue
6571 file_work = file
6572 ! ファイル名の変更 (MPI 用)
6573 ! Change filename (for MPI)
6574 !
6575 if ( present_and_true( flag_mpi_split ) ) &
6576 & file_work = file_rename_mpi( file_work )
6577 ! 必要な情報を gtool 変数化
6578 !
6579 call lookup_growable_url(file_work, varname, url, range, &
6580 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6581 call dbgmessage('@ url =%c', c1=trim(url))
6582 ! いよいよデータ取得
6583 !
6584 call open(var, url, err)
6585 call get(var, array, err)
6586 call close(var, err)
6587 call actual_iorange_dump(url, & ! (in)
6588 & actual_url, returned_time, & ! (out) optional
6589 & time_name = tname, & ! (in) optional
6590 & err = err) ! (out) optional
6591 if ( .not. present_and_true(quiet) ) then
6592 call messagenotify('M', subname, 'Input %c', c1=trim(actual_url))
6593 end if
6594end subroutine historygetint7pointer
6596 & file, varname, array, time, &
6597 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6598 use dc_string, only: tochar, split
6599 use dc_types, only: string, dp, sp
6600 use dc_trace, only: dbgmessage
6601 use dc_url, only: url_chop_iorange, gt_equal
6602 use dc_present, only: present_and_true
6603 implicit none
6604 character(*), intent(in):: file, varname
6605 real(SP), intent(in):: time
6606 logical, intent(in), optional:: quiet
6607 real(DP), intent(out) :: array
6608 logical, intent(in), optional:: flag_mpi_split
6609 real(DP), intent(out), optional:: returned_time
6610 logical, intent(out), optional:: flag_time_exist
6611 logical, intent(out), optional:: err
6612 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6613 character(STRING), pointer:: carray (:)
6614 character(STRING):: tname
6615 interface
6616 subroutine historygetdouble0(&
6617 & file, varname, array, range, quiet, &
6618 & flag_mpi_split, returned_time, flag_time_exist, err)
6619 use dc_types, only: dp
6620 character(*), intent(in):: file
6621 character(*), intent(in):: varname
6622 character(*), intent(in), optional:: range
6623 logical, intent(in), optional:: quiet
6624 logical, intent(in), optional:: flag_mpi_split
6625 real(DP), intent(out), optional:: returned_time
6626 logical, intent(out), optional:: flag_time_exist
6627 logical, intent(out), optional:: err
6628 real(DP), intent(out) :: array
6629 end subroutine historygetdouble0
6630 end interface
6631 interface
6632 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6633 character(*), intent(in):: file
6634 character(*), intent(in):: varname
6635 character(*), intent(out):: url
6636 character(*), intent(in), optional:: range
6637 logical, intent(out), optional:: flag_time_exist
6638 character(*), intent(out), optional:: time_name
6639 logical, intent(out), optional:: err
6640 end subroutine lookup_growable_url
6641 end interface
6642 interface
6643 function file_rename_mpi( file ) result(result)
6644 use dc_types, only: string
6645 character(*), intent(in):: file
6646 character(STRING):: result
6647 end function file_rename_mpi
6648 end interface
6649 continue
6650 file_work = file
6651 if ( present_and_true( flag_mpi_split ) ) &
6652 & file_work = file_rename_mpi( file_work )
6653 call lookup_growable_url(file = file_work, varname = varname, &
6654 & url = url, &
6655 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6656 call url_chop_iorange( &
6657 & fullname = url, iorange = iorange, remainder = remainder )
6658 call split( str = iorange, carray = carray, sep = gt_equal )
6659 timevar_name = carray(1)
6660 deallocate( carray )
6661 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
6662 call historygetdouble0( file = file, &
6663 & varname = varname, array = array, &
6664 & range = time_range, quiet = quiet, &
6665 & flag_mpi_split = flag_mpi_split, &
6666 & returned_time = returned_time, &
6667 & flag_time_exist = flag_time_exist, &
6668 & err = err )
6669end subroutine historygetdouble0timer
6671 & file, varname, array, time, &
6672 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6673 use dc_string, only: tochar, split
6674 use dc_types, only: string, dp, sp
6675 use dc_trace, only: dbgmessage
6676 use dc_url, only: url_chop_iorange, gt_equal
6677 use dc_present, only: present_and_true
6678 implicit none
6679 character(*), intent(in):: file, varname
6680 real(SP), intent(in):: time
6681 logical, intent(in), optional:: quiet
6682 real(DP), intent(out) :: array(:)
6683 logical, intent(in), optional:: flag_mpi_split
6684 real(DP), intent(out), optional:: returned_time
6685 logical, intent(out), optional:: flag_time_exist
6686 logical, intent(out), optional:: err
6687 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6688 character(STRING), pointer:: carray (:)
6689 character(STRING):: tname
6690 interface
6691 subroutine historygetdouble1(&
6692 & file, varname, array, range, quiet, &
6693 & flag_mpi_split, returned_time, flag_time_exist, err)
6694 use dc_types, only: dp
6695 character(*), intent(in):: file
6696 character(*), intent(in):: varname
6697 character(*), intent(in), optional:: range
6698 logical, intent(in), optional:: quiet
6699 logical, intent(in), optional:: flag_mpi_split
6700 real(DP), intent(out), optional:: returned_time
6701 logical, intent(out), optional:: flag_time_exist
6702 logical, intent(out), optional:: err
6703 real(DP), intent(out) :: array(:)
6704 end subroutine historygetdouble1
6705 end interface
6706 interface
6707 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6708 character(*), intent(in):: file
6709 character(*), intent(in):: varname
6710 character(*), intent(out):: url
6711 character(*), intent(in), optional:: range
6712 logical, intent(out), optional:: flag_time_exist
6713 character(*), intent(out), optional:: time_name
6714 logical, intent(out), optional:: err
6715 end subroutine lookup_growable_url
6716 end interface
6717 interface
6718 function file_rename_mpi( file ) result(result)
6719 use dc_types, only: string
6720 character(*), intent(in):: file
6721 character(STRING):: result
6722 end function file_rename_mpi
6723 end interface
6724 continue
6725 file_work = file
6726 if ( present_and_true( flag_mpi_split ) ) &
6727 & file_work = file_rename_mpi( file_work )
6728 call lookup_growable_url(file = file_work, varname = varname, &
6729 & url = url, &
6730 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6731 call url_chop_iorange( &
6732 & fullname = url, iorange = iorange, remainder = remainder )
6733 call split( str = iorange, carray = carray, sep = gt_equal )
6734 timevar_name = carray(1)
6735 deallocate( carray )
6736 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
6737 call historygetdouble1( file = file, &
6738 & varname = varname, array = array, &
6739 & range = time_range, quiet = quiet, &
6740 & flag_mpi_split = flag_mpi_split, &
6741 & returned_time = returned_time, &
6742 & flag_time_exist = flag_time_exist, &
6743 & err = err )
6744end subroutine historygetdouble1timer
6746 & file, varname, array, time, &
6747 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6748 use dc_string, only: tochar, split
6749 use dc_types, only: string, dp, sp
6750 use dc_trace, only: dbgmessage
6751 use dc_url, only: url_chop_iorange, gt_equal
6752 use dc_present, only: present_and_true
6753 implicit none
6754 character(*), intent(in):: file, varname
6755 real(SP), intent(in):: time
6756 logical, intent(in), optional:: quiet
6757 real(DP), intent(out) :: array(:,:)
6758 logical, intent(in), optional:: flag_mpi_split
6759 real(DP), intent(out), optional:: returned_time
6760 logical, intent(out), optional:: flag_time_exist
6761 logical, intent(out), optional:: err
6762 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6763 character(STRING), pointer:: carray (:)
6764 character(STRING):: tname
6765 interface
6766 subroutine historygetdouble2(&
6767 & file, varname, array, range, quiet, &
6768 & flag_mpi_split, returned_time, flag_time_exist, err)
6769 use dc_types, only: dp
6770 character(*), intent(in):: file
6771 character(*), intent(in):: varname
6772 character(*), intent(in), optional:: range
6773 logical, intent(in), optional:: quiet
6774 logical, intent(in), optional:: flag_mpi_split
6775 real(DP), intent(out), optional:: returned_time
6776 logical, intent(out), optional:: flag_time_exist
6777 logical, intent(out), optional:: err
6778 real(DP), intent(out) :: array(:,:)
6779 end subroutine historygetdouble2
6780 end interface
6781 interface
6782 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6783 character(*), intent(in):: file
6784 character(*), intent(in):: varname
6785 character(*), intent(out):: url
6786 character(*), intent(in), optional:: range
6787 logical, intent(out), optional:: flag_time_exist
6788 character(*), intent(out), optional:: time_name
6789 logical, intent(out), optional:: err
6790 end subroutine lookup_growable_url
6791 end interface
6792 interface
6793 function file_rename_mpi( file ) result(result)
6794 use dc_types, only: string
6795 character(*), intent(in):: file
6796 character(STRING):: result
6797 end function file_rename_mpi
6798 end interface
6799 continue
6800 file_work = file
6801 if ( present_and_true( flag_mpi_split ) ) &
6802 & file_work = file_rename_mpi( file_work )
6803 call lookup_growable_url(file = file_work, varname = varname, &
6804 & url = url, &
6805 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6806 call url_chop_iorange( &
6807 & fullname = url, iorange = iorange, remainder = remainder )
6808 call split( str = iorange, carray = carray, sep = gt_equal )
6809 timevar_name = carray(1)
6810 deallocate( carray )
6811 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
6812 call historygetdouble2( file = file, &
6813 & varname = varname, array = array, &
6814 & range = time_range, quiet = quiet, &
6815 & flag_mpi_split = flag_mpi_split, &
6816 & returned_time = returned_time, &
6817 & flag_time_exist = flag_time_exist, &
6818 & err = err )
6819end subroutine historygetdouble2timer
6821 & file, varname, array, time, &
6822 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6823 use dc_string, only: tochar, split
6824 use dc_types, only: string, dp, sp
6825 use dc_trace, only: dbgmessage
6826 use dc_url, only: url_chop_iorange, gt_equal
6827 use dc_present, only: present_and_true
6828 implicit none
6829 character(*), intent(in):: file, varname
6830 real(SP), intent(in):: time
6831 logical, intent(in), optional:: quiet
6832 real(DP), intent(out) :: array(:,:,:)
6833 logical, intent(in), optional:: flag_mpi_split
6834 real(DP), intent(out), optional:: returned_time
6835 logical, intent(out), optional:: flag_time_exist
6836 logical, intent(out), optional:: err
6837 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6838 character(STRING), pointer:: carray (:)
6839 character(STRING):: tname
6840 interface
6841 subroutine historygetdouble3(&
6842 & file, varname, array, range, quiet, &
6843 & flag_mpi_split, returned_time, flag_time_exist, err)
6844 use dc_types, only: dp
6845 character(*), intent(in):: file
6846 character(*), intent(in):: varname
6847 character(*), intent(in), optional:: range
6848 logical, intent(in), optional:: quiet
6849 logical, intent(in), optional:: flag_mpi_split
6850 real(DP), intent(out), optional:: returned_time
6851 logical, intent(out), optional:: flag_time_exist
6852 logical, intent(out), optional:: err
6853 real(DP), intent(out) :: array(:,:,:)
6854 end subroutine historygetdouble3
6855 end interface
6856 interface
6857 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6858 character(*), intent(in):: file
6859 character(*), intent(in):: varname
6860 character(*), intent(out):: url
6861 character(*), intent(in), optional:: range
6862 logical, intent(out), optional:: flag_time_exist
6863 character(*), intent(out), optional:: time_name
6864 logical, intent(out), optional:: err
6865 end subroutine lookup_growable_url
6866 end interface
6867 interface
6868 function file_rename_mpi( file ) result(result)
6869 use dc_types, only: string
6870 character(*), intent(in):: file
6871 character(STRING):: result
6872 end function file_rename_mpi
6873 end interface
6874 continue
6875 file_work = file
6876 if ( present_and_true( flag_mpi_split ) ) &
6877 & file_work = file_rename_mpi( file_work )
6878 call lookup_growable_url(file = file_work, varname = varname, &
6879 & url = url, &
6880 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6881 call url_chop_iorange( &
6882 & fullname = url, iorange = iorange, remainder = remainder )
6883 call split( str = iorange, carray = carray, sep = gt_equal )
6884 timevar_name = carray(1)
6885 deallocate( carray )
6886 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
6887 call historygetdouble3( file = file, &
6888 & varname = varname, array = array, &
6889 & range = time_range, quiet = quiet, &
6890 & flag_mpi_split = flag_mpi_split, &
6891 & returned_time = returned_time, &
6892 & flag_time_exist = flag_time_exist, &
6893 & err = err )
6894end subroutine historygetdouble3timer
6896 & file, varname, array, time, &
6897 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6898 use dc_string, only: tochar, split
6899 use dc_types, only: string, dp, sp
6900 use dc_trace, only: dbgmessage
6901 use dc_url, only: url_chop_iorange, gt_equal
6902 use dc_present, only: present_and_true
6903 implicit none
6904 character(*), intent(in):: file, varname
6905 real(SP), intent(in):: time
6906 logical, intent(in), optional:: quiet
6907 real(DP), intent(out) :: array(:,:,:,:)
6908 logical, intent(in), optional:: flag_mpi_split
6909 real(DP), intent(out), optional:: returned_time
6910 logical, intent(out), optional:: flag_time_exist
6911 logical, intent(out), optional:: err
6912 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6913 character(STRING), pointer:: carray (:)
6914 character(STRING):: tname
6915 interface
6916 subroutine historygetdouble4(&
6917 & file, varname, array, range, quiet, &
6918 & flag_mpi_split, returned_time, flag_time_exist, err)
6919 use dc_types, only: dp
6920 character(*), intent(in):: file
6921 character(*), intent(in):: varname
6922 character(*), intent(in), optional:: range
6923 logical, intent(in), optional:: quiet
6924 logical, intent(in), optional:: flag_mpi_split
6925 real(DP), intent(out), optional:: returned_time
6926 logical, intent(out), optional:: flag_time_exist
6927 logical, intent(out), optional:: err
6928 real(DP), intent(out) :: array(:,:,:,:)
6929 end subroutine historygetdouble4
6930 end interface
6931 interface
6932 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
6933 character(*), intent(in):: file
6934 character(*), intent(in):: varname
6935 character(*), intent(out):: url
6936 character(*), intent(in), optional:: range
6937 logical, intent(out), optional:: flag_time_exist
6938 character(*), intent(out), optional:: time_name
6939 logical, intent(out), optional:: err
6940 end subroutine lookup_growable_url
6941 end interface
6942 interface
6943 function file_rename_mpi( file ) result(result)
6944 use dc_types, only: string
6945 character(*), intent(in):: file
6946 character(STRING):: result
6947 end function file_rename_mpi
6948 end interface
6949 continue
6950 file_work = file
6951 if ( present_and_true( flag_mpi_split ) ) &
6952 & file_work = file_rename_mpi( file_work )
6953 call lookup_growable_url(file = file_work, varname = varname, &
6954 & url = url, &
6955 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
6956 call url_chop_iorange( &
6957 & fullname = url, iorange = iorange, remainder = remainder )
6958 call split( str = iorange, carray = carray, sep = gt_equal )
6959 timevar_name = carray(1)
6960 deallocate( carray )
6961 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
6962 call historygetdouble4( file = file, &
6963 & varname = varname, array = array, &
6964 & range = time_range, quiet = quiet, &
6965 & flag_mpi_split = flag_mpi_split, &
6966 & returned_time = returned_time, &
6967 & flag_time_exist = flag_time_exist, &
6968 & err = err )
6969end subroutine historygetdouble4timer
6971 & file, varname, array, time, &
6972 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
6973 use dc_string, only: tochar, split
6974 use dc_types, only: string, dp, sp
6975 use dc_trace, only: dbgmessage
6976 use dc_url, only: url_chop_iorange, gt_equal
6977 use dc_present, only: present_and_true
6978 implicit none
6979 character(*), intent(in):: file, varname
6980 real(SP), intent(in):: time
6981 logical, intent(in), optional:: quiet
6982 real(DP), intent(out) :: array(:,:,:,:,:)
6983 logical, intent(in), optional:: flag_mpi_split
6984 real(DP), intent(out), optional:: returned_time
6985 logical, intent(out), optional:: flag_time_exist
6986 logical, intent(out), optional:: err
6987 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
6988 character(STRING), pointer:: carray (:)
6989 character(STRING):: tname
6990 interface
6991 subroutine historygetdouble5(&
6992 & file, varname, array, range, quiet, &
6993 & flag_mpi_split, returned_time, flag_time_exist, err)
6994 use dc_types, only: dp
6995 character(*), intent(in):: file
6996 character(*), intent(in):: varname
6997 character(*), intent(in), optional:: range
6998 logical, intent(in), optional:: quiet
6999 logical, intent(in), optional:: flag_mpi_split
7000 real(DP), intent(out), optional:: returned_time
7001 logical, intent(out), optional:: flag_time_exist
7002 logical, intent(out), optional:: err
7003 real(DP), intent(out) :: array(:,:,:,:,:)
7004 end subroutine historygetdouble5
7005 end interface
7006 interface
7007 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7008 character(*), intent(in):: file
7009 character(*), intent(in):: varname
7010 character(*), intent(out):: url
7011 character(*), intent(in), optional:: range
7012 logical, intent(out), optional:: flag_time_exist
7013 character(*), intent(out), optional:: time_name
7014 logical, intent(out), optional:: err
7015 end subroutine lookup_growable_url
7016 end interface
7017 interface
7018 function file_rename_mpi( file ) result(result)
7019 use dc_types, only: string
7020 character(*), intent(in):: file
7021 character(STRING):: result
7022 end function file_rename_mpi
7023 end interface
7024 continue
7025 file_work = file
7026 if ( present_and_true( flag_mpi_split ) ) &
7027 & file_work = file_rename_mpi( file_work )
7028 call lookup_growable_url(file = file_work, varname = varname, &
7029 & url = url, &
7030 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7031 call url_chop_iorange( &
7032 & fullname = url, iorange = iorange, remainder = remainder )
7033 call split( str = iorange, carray = carray, sep = gt_equal )
7034 timevar_name = carray(1)
7035 deallocate( carray )
7036 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7037 call historygetdouble5( file = file, &
7038 & varname = varname, array = array, &
7039 & range = time_range, quiet = quiet, &
7040 & flag_mpi_split = flag_mpi_split, &
7041 & returned_time = returned_time, &
7042 & flag_time_exist = flag_time_exist, &
7043 & err = err )
7044end subroutine historygetdouble5timer
7046 & file, varname, array, time, &
7047 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7048 use dc_string, only: tochar, split
7049 use dc_types, only: string, dp, sp
7050 use dc_trace, only: dbgmessage
7051 use dc_url, only: url_chop_iorange, gt_equal
7052 use dc_present, only: present_and_true
7053 implicit none
7054 character(*), intent(in):: file, varname
7055 real(SP), intent(in):: time
7056 logical, intent(in), optional:: quiet
7057 real(DP), intent(out) :: array(:,:,:,:,:,:)
7058 logical, intent(in), optional:: flag_mpi_split
7059 real(DP), intent(out), optional:: returned_time
7060 logical, intent(out), optional:: flag_time_exist
7061 logical, intent(out), optional:: err
7062 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7063 character(STRING), pointer:: carray (:)
7064 character(STRING):: tname
7065 interface
7066 subroutine historygetdouble6(&
7067 & file, varname, array, range, quiet, &
7068 & flag_mpi_split, returned_time, flag_time_exist, err)
7069 use dc_types, only: dp
7070 character(*), intent(in):: file
7071 character(*), intent(in):: varname
7072 character(*), intent(in), optional:: range
7073 logical, intent(in), optional:: quiet
7074 logical, intent(in), optional:: flag_mpi_split
7075 real(DP), intent(out), optional:: returned_time
7076 logical, intent(out), optional:: flag_time_exist
7077 logical, intent(out), optional:: err
7078 real(DP), intent(out) :: array(:,:,:,:,:,:)
7079 end subroutine historygetdouble6
7080 end interface
7081 interface
7082 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7083 character(*), intent(in):: file
7084 character(*), intent(in):: varname
7085 character(*), intent(out):: url
7086 character(*), intent(in), optional:: range
7087 logical, intent(out), optional:: flag_time_exist
7088 character(*), intent(out), optional:: time_name
7089 logical, intent(out), optional:: err
7090 end subroutine lookup_growable_url
7091 end interface
7092 interface
7093 function file_rename_mpi( file ) result(result)
7094 use dc_types, only: string
7095 character(*), intent(in):: file
7096 character(STRING):: result
7097 end function file_rename_mpi
7098 end interface
7099 continue
7100 file_work = file
7101 if ( present_and_true( flag_mpi_split ) ) &
7102 & file_work = file_rename_mpi( file_work )
7103 call lookup_growable_url(file = file_work, varname = varname, &
7104 & url = url, &
7105 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7106 call url_chop_iorange( &
7107 & fullname = url, iorange = iorange, remainder = remainder )
7108 call split( str = iorange, carray = carray, sep = gt_equal )
7109 timevar_name = carray(1)
7110 deallocate( carray )
7111 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7112 call historygetdouble6( file = file, &
7113 & varname = varname, array = array, &
7114 & range = time_range, quiet = quiet, &
7115 & flag_mpi_split = flag_mpi_split, &
7116 & returned_time = returned_time, &
7117 & flag_time_exist = flag_time_exist, &
7118 & err = err )
7119end subroutine historygetdouble6timer
7121 & file, varname, array, time, &
7122 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7123 use dc_string, only: tochar, split
7124 use dc_types, only: string, dp, sp
7125 use dc_trace, only: dbgmessage
7126 use dc_url, only: url_chop_iorange, gt_equal
7127 use dc_present, only: present_and_true
7128 implicit none
7129 character(*), intent(in):: file, varname
7130 real(SP), intent(in):: time
7131 logical, intent(in), optional:: quiet
7132 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
7133 logical, intent(in), optional:: flag_mpi_split
7134 real(DP), intent(out), optional:: returned_time
7135 logical, intent(out), optional:: flag_time_exist
7136 logical, intent(out), optional:: err
7137 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7138 character(STRING), pointer:: carray (:)
7139 character(STRING):: tname
7140 interface
7141 subroutine historygetdouble7(&
7142 & file, varname, array, range, quiet, &
7143 & flag_mpi_split, returned_time, flag_time_exist, err)
7144 use dc_types, only: dp
7145 character(*), intent(in):: file
7146 character(*), intent(in):: varname
7147 character(*), intent(in), optional:: range
7148 logical, intent(in), optional:: quiet
7149 logical, intent(in), optional:: flag_mpi_split
7150 real(DP), intent(out), optional:: returned_time
7151 logical, intent(out), optional:: flag_time_exist
7152 logical, intent(out), optional:: err
7153 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
7154 end subroutine historygetdouble7
7155 end interface
7156 interface
7157 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7158 character(*), intent(in):: file
7159 character(*), intent(in):: varname
7160 character(*), intent(out):: url
7161 character(*), intent(in), optional:: range
7162 logical, intent(out), optional:: flag_time_exist
7163 character(*), intent(out), optional:: time_name
7164 logical, intent(out), optional:: err
7165 end subroutine lookup_growable_url
7166 end interface
7167 interface
7168 function file_rename_mpi( file ) result(result)
7169 use dc_types, only: string
7170 character(*), intent(in):: file
7171 character(STRING):: result
7172 end function file_rename_mpi
7173 end interface
7174 continue
7175 file_work = file
7176 if ( present_and_true( flag_mpi_split ) ) &
7177 & file_work = file_rename_mpi( file_work )
7178 call lookup_growable_url(file = file_work, varname = varname, &
7179 & url = url, &
7180 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7181 call url_chop_iorange( &
7182 & fullname = url, iorange = iorange, remainder = remainder )
7183 call split( str = iorange, carray = carray, sep = gt_equal )
7184 timevar_name = carray(1)
7185 deallocate( carray )
7186 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7187 call historygetdouble7( file = file, &
7188 & varname = varname, array = array, &
7189 & range = time_range, quiet = quiet, &
7190 & flag_mpi_split = flag_mpi_split, &
7191 & returned_time = returned_time, &
7192 & flag_time_exist = flag_time_exist, &
7193 & err = err )
7194end subroutine historygetdouble7timer
7196 & file, varname, array, time, &
7197 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7198 use dc_string, only: tochar, split
7199 use dc_types, only: string, dp, sp
7200 use dc_trace, only: dbgmessage
7201 use dc_url, only: url_chop_iorange, gt_equal
7202 use dc_present, only: present_and_true
7203 implicit none
7204 character(*), intent(in):: file, varname
7205 real(SP), intent(in):: time
7206 logical, intent(in), optional:: quiet
7207 real(DP), pointer :: array
7208 logical, intent(in), optional:: flag_mpi_split
7209 real(DP), intent(out), optional:: returned_time
7210 logical, intent(out), optional:: flag_time_exist
7211 logical, intent(out), optional:: err
7212 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7213 character(STRING), pointer:: carray (:)
7214 character(STRING):: tname
7215 interface
7216 subroutine historygetdouble0pointer(&
7217 & file, varname, array, range, quiet, &
7218 & flag_mpi_split, returned_time, flag_time_exist, err)
7219 use dc_types, only: dp
7220 character(*), intent(in):: file
7221 character(*), intent(in):: varname
7222 character(*), intent(in), optional:: range
7223 logical, intent(in), optional:: quiet
7224 logical, intent(in), optional:: flag_mpi_split
7225 real(DP), intent(out), optional:: returned_time
7226 logical, intent(out), optional:: flag_time_exist
7227 logical, intent(out), optional:: err
7228 real(DP), pointer :: array
7229 end subroutine historygetdouble0pointer
7230 end interface
7231 interface
7232 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7233 character(*), intent(in):: file
7234 character(*), intent(in):: varname
7235 character(*), intent(out):: url
7236 character(*), intent(in), optional:: range
7237 logical, intent(out), optional:: flag_time_exist
7238 character(*), intent(out), optional:: time_name
7239 logical, intent(out), optional:: err
7240 end subroutine lookup_growable_url
7241 end interface
7242 interface
7243 function file_rename_mpi( file ) result(result)
7244 use dc_types, only: string
7245 character(*), intent(in):: file
7246 character(STRING):: result
7247 end function file_rename_mpi
7248 end interface
7249 continue
7250 file_work = file
7251 if ( present_and_true( flag_mpi_split ) ) &
7252 & file_work = file_rename_mpi( file_work )
7253 call lookup_growable_url(file = file_work, varname = varname, &
7254 & url = url, &
7255 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7256 call url_chop_iorange( &
7257 & fullname = url, iorange = iorange, remainder = remainder )
7258 call split( str = iorange, carray = carray, sep = gt_equal )
7259 timevar_name = carray(1)
7260 deallocate( carray )
7261 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7262 call historygetdouble0pointer( file = file, &
7263 & varname = varname, array = array, &
7264 & range = time_range, quiet = quiet, &
7265 & flag_mpi_split = flag_mpi_split, &
7266 & returned_time = returned_time, &
7267 & flag_time_exist = flag_time_exist, &
7268 & err = err )
7269end subroutine historygetdouble0pointertimer
7271 & file, varname, array, time, &
7272 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7273 use dc_string, only: tochar, split
7274 use dc_types, only: string, dp, sp
7275 use dc_trace, only: dbgmessage
7276 use dc_url, only: url_chop_iorange, gt_equal
7277 use dc_present, only: present_and_true
7278 implicit none
7279 character(*), intent(in):: file, varname
7280 real(SP), intent(in):: time
7281 logical, intent(in), optional:: quiet
7282 real(DP), pointer :: array(:)
7283 logical, intent(in), optional:: flag_mpi_split
7284 real(DP), intent(out), optional:: returned_time
7285 logical, intent(out), optional:: flag_time_exist
7286 logical, intent(out), optional:: err
7287 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7288 character(STRING), pointer:: carray (:)
7289 character(STRING):: tname
7290 interface
7291 subroutine historygetdouble1pointer(&
7292 & file, varname, array, range, quiet, &
7293 & flag_mpi_split, returned_time, flag_time_exist, err)
7294 use dc_types, only: dp
7295 character(*), intent(in):: file
7296 character(*), intent(in):: varname
7297 character(*), intent(in), optional:: range
7298 logical, intent(in), optional:: quiet
7299 logical, intent(in), optional:: flag_mpi_split
7300 real(DP), intent(out), optional:: returned_time
7301 logical, intent(out), optional:: flag_time_exist
7302 logical, intent(out), optional:: err
7303 real(DP), pointer :: array(:)
7304 end subroutine historygetdouble1pointer
7305 end interface
7306 interface
7307 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7308 character(*), intent(in):: file
7309 character(*), intent(in):: varname
7310 character(*), intent(out):: url
7311 character(*), intent(in), optional:: range
7312 logical, intent(out), optional:: flag_time_exist
7313 character(*), intent(out), optional:: time_name
7314 logical, intent(out), optional:: err
7315 end subroutine lookup_growable_url
7316 end interface
7317 interface
7318 function file_rename_mpi( file ) result(result)
7319 use dc_types, only: string
7320 character(*), intent(in):: file
7321 character(STRING):: result
7322 end function file_rename_mpi
7323 end interface
7324 continue
7325 file_work = file
7326 if ( present_and_true( flag_mpi_split ) ) &
7327 & file_work = file_rename_mpi( file_work )
7328 call lookup_growable_url(file = file_work, varname = varname, &
7329 & url = url, &
7330 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7331 call url_chop_iorange( &
7332 & fullname = url, iorange = iorange, remainder = remainder )
7333 call split( str = iorange, carray = carray, sep = gt_equal )
7334 timevar_name = carray(1)
7335 deallocate( carray )
7336 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7337 call historygetdouble1pointer( file = file, &
7338 & varname = varname, array = array, &
7339 & range = time_range, quiet = quiet, &
7340 & flag_mpi_split = flag_mpi_split, &
7341 & returned_time = returned_time, &
7342 & flag_time_exist = flag_time_exist, &
7343 & err = err )
7344end subroutine historygetdouble1pointertimer
7346 & file, varname, array, time, &
7347 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7348 use dc_string, only: tochar, split
7349 use dc_types, only: string, dp, sp
7350 use dc_trace, only: dbgmessage
7351 use dc_url, only: url_chop_iorange, gt_equal
7352 use dc_present, only: present_and_true
7353 implicit none
7354 character(*), intent(in):: file, varname
7355 real(SP), intent(in):: time
7356 logical, intent(in), optional:: quiet
7357 real(DP), pointer :: array(:,:)
7358 logical, intent(in), optional:: flag_mpi_split
7359 real(DP), intent(out), optional:: returned_time
7360 logical, intent(out), optional:: flag_time_exist
7361 logical, intent(out), optional:: err
7362 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7363 character(STRING), pointer:: carray (:)
7364 character(STRING):: tname
7365 interface
7366 subroutine historygetdouble2pointer(&
7367 & file, varname, array, range, quiet, &
7368 & flag_mpi_split, returned_time, flag_time_exist, err)
7369 use dc_types, only: dp
7370 character(*), intent(in):: file
7371 character(*), intent(in):: varname
7372 character(*), intent(in), optional:: range
7373 logical, intent(in), optional:: quiet
7374 logical, intent(in), optional:: flag_mpi_split
7375 real(DP), intent(out), optional:: returned_time
7376 logical, intent(out), optional:: flag_time_exist
7377 logical, intent(out), optional:: err
7378 real(DP), pointer :: array(:,:)
7379 end subroutine historygetdouble2pointer
7380 end interface
7381 interface
7382 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7383 character(*), intent(in):: file
7384 character(*), intent(in):: varname
7385 character(*), intent(out):: url
7386 character(*), intent(in), optional:: range
7387 logical, intent(out), optional:: flag_time_exist
7388 character(*), intent(out), optional:: time_name
7389 logical, intent(out), optional:: err
7390 end subroutine lookup_growable_url
7391 end interface
7392 interface
7393 function file_rename_mpi( file ) result(result)
7394 use dc_types, only: string
7395 character(*), intent(in):: file
7396 character(STRING):: result
7397 end function file_rename_mpi
7398 end interface
7399 continue
7400 file_work = file
7401 if ( present_and_true( flag_mpi_split ) ) &
7402 & file_work = file_rename_mpi( file_work )
7403 call lookup_growable_url(file = file_work, varname = varname, &
7404 & url = url, &
7405 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7406 call url_chop_iorange( &
7407 & fullname = url, iorange = iorange, remainder = remainder )
7408 call split( str = iorange, carray = carray, sep = gt_equal )
7409 timevar_name = carray(1)
7410 deallocate( carray )
7411 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7412 call historygetdouble2pointer( file = file, &
7413 & varname = varname, array = array, &
7414 & range = time_range, quiet = quiet, &
7415 & flag_mpi_split = flag_mpi_split, &
7416 & returned_time = returned_time, &
7417 & flag_time_exist = flag_time_exist, &
7418 & err = err )
7419end subroutine historygetdouble2pointertimer
7421 & file, varname, array, time, &
7422 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7423 use dc_string, only: tochar, split
7424 use dc_types, only: string, dp, sp
7425 use dc_trace, only: dbgmessage
7426 use dc_url, only: url_chop_iorange, gt_equal
7427 use dc_present, only: present_and_true
7428 implicit none
7429 character(*), intent(in):: file, varname
7430 real(SP), intent(in):: time
7431 logical, intent(in), optional:: quiet
7432 real(DP), pointer :: array(:,:,:)
7433 logical, intent(in), optional:: flag_mpi_split
7434 real(DP), intent(out), optional:: returned_time
7435 logical, intent(out), optional:: flag_time_exist
7436 logical, intent(out), optional:: err
7437 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7438 character(STRING), pointer:: carray (:)
7439 character(STRING):: tname
7440 interface
7441 subroutine historygetdouble3pointer(&
7442 & file, varname, array, range, quiet, &
7443 & flag_mpi_split, returned_time, flag_time_exist, err)
7444 use dc_types, only: dp
7445 character(*), intent(in):: file
7446 character(*), intent(in):: varname
7447 character(*), intent(in), optional:: range
7448 logical, intent(in), optional:: quiet
7449 logical, intent(in), optional:: flag_mpi_split
7450 real(DP), intent(out), optional:: returned_time
7451 logical, intent(out), optional:: flag_time_exist
7452 logical, intent(out), optional:: err
7453 real(DP), pointer :: array(:,:,:)
7454 end subroutine historygetdouble3pointer
7455 end interface
7456 interface
7457 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7458 character(*), intent(in):: file
7459 character(*), intent(in):: varname
7460 character(*), intent(out):: url
7461 character(*), intent(in), optional:: range
7462 logical, intent(out), optional:: flag_time_exist
7463 character(*), intent(out), optional:: time_name
7464 logical, intent(out), optional:: err
7465 end subroutine lookup_growable_url
7466 end interface
7467 interface
7468 function file_rename_mpi( file ) result(result)
7469 use dc_types, only: string
7470 character(*), intent(in):: file
7471 character(STRING):: result
7472 end function file_rename_mpi
7473 end interface
7474 continue
7475 file_work = file
7476 if ( present_and_true( flag_mpi_split ) ) &
7477 & file_work = file_rename_mpi( file_work )
7478 call lookup_growable_url(file = file_work, varname = varname, &
7479 & url = url, &
7480 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7481 call url_chop_iorange( &
7482 & fullname = url, iorange = iorange, remainder = remainder )
7483 call split( str = iorange, carray = carray, sep = gt_equal )
7484 timevar_name = carray(1)
7485 deallocate( carray )
7486 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7487 call historygetdouble3pointer( file = file, &
7488 & varname = varname, array = array, &
7489 & range = time_range, quiet = quiet, &
7490 & flag_mpi_split = flag_mpi_split, &
7491 & returned_time = returned_time, &
7492 & flag_time_exist = flag_time_exist, &
7493 & err = err )
7494end subroutine historygetdouble3pointertimer
7496 & file, varname, array, time, &
7497 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7498 use dc_string, only: tochar, split
7499 use dc_types, only: string, dp, sp
7500 use dc_trace, only: dbgmessage
7501 use dc_url, only: url_chop_iorange, gt_equal
7502 use dc_present, only: present_and_true
7503 implicit none
7504 character(*), intent(in):: file, varname
7505 real(SP), intent(in):: time
7506 logical, intent(in), optional:: quiet
7507 real(DP), pointer :: array(:,:,:,:)
7508 logical, intent(in), optional:: flag_mpi_split
7509 real(DP), intent(out), optional:: returned_time
7510 logical, intent(out), optional:: flag_time_exist
7511 logical, intent(out), optional:: err
7512 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7513 character(STRING), pointer:: carray (:)
7514 character(STRING):: tname
7515 interface
7516 subroutine historygetdouble4pointer(&
7517 & file, varname, array, range, quiet, &
7518 & flag_mpi_split, returned_time, flag_time_exist, err)
7519 use dc_types, only: dp
7520 character(*), intent(in):: file
7521 character(*), intent(in):: varname
7522 character(*), intent(in), optional:: range
7523 logical, intent(in), optional:: quiet
7524 logical, intent(in), optional:: flag_mpi_split
7525 real(DP), intent(out), optional:: returned_time
7526 logical, intent(out), optional:: flag_time_exist
7527 logical, intent(out), optional:: err
7528 real(DP), pointer :: array(:,:,:,:)
7529 end subroutine historygetdouble4pointer
7530 end interface
7531 interface
7532 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7533 character(*), intent(in):: file
7534 character(*), intent(in):: varname
7535 character(*), intent(out):: url
7536 character(*), intent(in), optional:: range
7537 logical, intent(out), optional:: flag_time_exist
7538 character(*), intent(out), optional:: time_name
7539 logical, intent(out), optional:: err
7540 end subroutine lookup_growable_url
7541 end interface
7542 interface
7543 function file_rename_mpi( file ) result(result)
7544 use dc_types, only: string
7545 character(*), intent(in):: file
7546 character(STRING):: result
7547 end function file_rename_mpi
7548 end interface
7549 continue
7550 file_work = file
7551 if ( present_and_true( flag_mpi_split ) ) &
7552 & file_work = file_rename_mpi( file_work )
7553 call lookup_growable_url(file = file_work, varname = varname, &
7554 & url = url, &
7555 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7556 call url_chop_iorange( &
7557 & fullname = url, iorange = iorange, remainder = remainder )
7558 call split( str = iorange, carray = carray, sep = gt_equal )
7559 timevar_name = carray(1)
7560 deallocate( carray )
7561 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7562 call historygetdouble4pointer( file = file, &
7563 & varname = varname, array = array, &
7564 & range = time_range, quiet = quiet, &
7565 & flag_mpi_split = flag_mpi_split, &
7566 & returned_time = returned_time, &
7567 & flag_time_exist = flag_time_exist, &
7568 & err = err )
7569end subroutine historygetdouble4pointertimer
7571 & file, varname, array, time, &
7572 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7573 use dc_string, only: tochar, split
7574 use dc_types, only: string, dp, sp
7575 use dc_trace, only: dbgmessage
7576 use dc_url, only: url_chop_iorange, gt_equal
7577 use dc_present, only: present_and_true
7578 implicit none
7579 character(*), intent(in):: file, varname
7580 real(SP), intent(in):: time
7581 logical, intent(in), optional:: quiet
7582 real(DP), pointer :: array(:,:,:,:,:)
7583 logical, intent(in), optional:: flag_mpi_split
7584 real(DP), intent(out), optional:: returned_time
7585 logical, intent(out), optional:: flag_time_exist
7586 logical, intent(out), optional:: err
7587 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7588 character(STRING), pointer:: carray (:)
7589 character(STRING):: tname
7590 interface
7591 subroutine historygetdouble5pointer(&
7592 & file, varname, array, range, quiet, &
7593 & flag_mpi_split, returned_time, flag_time_exist, err)
7594 use dc_types, only: dp
7595 character(*), intent(in):: file
7596 character(*), intent(in):: varname
7597 character(*), intent(in), optional:: range
7598 logical, intent(in), optional:: quiet
7599 logical, intent(in), optional:: flag_mpi_split
7600 real(DP), intent(out), optional:: returned_time
7601 logical, intent(out), optional:: flag_time_exist
7602 logical, intent(out), optional:: err
7603 real(DP), pointer :: array(:,:,:,:,:)
7604 end subroutine historygetdouble5pointer
7605 end interface
7606 interface
7607 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7608 character(*), intent(in):: file
7609 character(*), intent(in):: varname
7610 character(*), intent(out):: url
7611 character(*), intent(in), optional:: range
7612 logical, intent(out), optional:: flag_time_exist
7613 character(*), intent(out), optional:: time_name
7614 logical, intent(out), optional:: err
7615 end subroutine lookup_growable_url
7616 end interface
7617 interface
7618 function file_rename_mpi( file ) result(result)
7619 use dc_types, only: string
7620 character(*), intent(in):: file
7621 character(STRING):: result
7622 end function file_rename_mpi
7623 end interface
7624 continue
7625 file_work = file
7626 if ( present_and_true( flag_mpi_split ) ) &
7627 & file_work = file_rename_mpi( file_work )
7628 call lookup_growable_url(file = file_work, varname = varname, &
7629 & url = url, &
7630 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7631 call url_chop_iorange( &
7632 & fullname = url, iorange = iorange, remainder = remainder )
7633 call split( str = iorange, carray = carray, sep = gt_equal )
7634 timevar_name = carray(1)
7635 deallocate( carray )
7636 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7637 call historygetdouble5pointer( file = file, &
7638 & varname = varname, array = array, &
7639 & range = time_range, quiet = quiet, &
7640 & flag_mpi_split = flag_mpi_split, &
7641 & returned_time = returned_time, &
7642 & flag_time_exist = flag_time_exist, &
7643 & err = err )
7644end subroutine historygetdouble5pointertimer
7646 & file, varname, array, time, &
7647 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7648 use dc_string, only: tochar, split
7649 use dc_types, only: string, dp, sp
7650 use dc_trace, only: dbgmessage
7651 use dc_url, only: url_chop_iorange, gt_equal
7652 use dc_present, only: present_and_true
7653 implicit none
7654 character(*), intent(in):: file, varname
7655 real(SP), intent(in):: time
7656 logical, intent(in), optional:: quiet
7657 real(DP), pointer :: array(:,:,:,:,:,:)
7658 logical, intent(in), optional:: flag_mpi_split
7659 real(DP), intent(out), optional:: returned_time
7660 logical, intent(out), optional:: flag_time_exist
7661 logical, intent(out), optional:: err
7662 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7663 character(STRING), pointer:: carray (:)
7664 character(STRING):: tname
7665 interface
7666 subroutine historygetdouble6pointer(&
7667 & file, varname, array, range, quiet, &
7668 & flag_mpi_split, returned_time, flag_time_exist, err)
7669 use dc_types, only: dp
7670 character(*), intent(in):: file
7671 character(*), intent(in):: varname
7672 character(*), intent(in), optional:: range
7673 logical, intent(in), optional:: quiet
7674 logical, intent(in), optional:: flag_mpi_split
7675 real(DP), intent(out), optional:: returned_time
7676 logical, intent(out), optional:: flag_time_exist
7677 logical, intent(out), optional:: err
7678 real(DP), pointer :: array(:,:,:,:,:,:)
7679 end subroutine historygetdouble6pointer
7680 end interface
7681 interface
7682 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7683 character(*), intent(in):: file
7684 character(*), intent(in):: varname
7685 character(*), intent(out):: url
7686 character(*), intent(in), optional:: range
7687 logical, intent(out), optional:: flag_time_exist
7688 character(*), intent(out), optional:: time_name
7689 logical, intent(out), optional:: err
7690 end subroutine lookup_growable_url
7691 end interface
7692 interface
7693 function file_rename_mpi( file ) result(result)
7694 use dc_types, only: string
7695 character(*), intent(in):: file
7696 character(STRING):: result
7697 end function file_rename_mpi
7698 end interface
7699 continue
7700 file_work = file
7701 if ( present_and_true( flag_mpi_split ) ) &
7702 & file_work = file_rename_mpi( file_work )
7703 call lookup_growable_url(file = file_work, varname = varname, &
7704 & url = url, &
7705 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7706 call url_chop_iorange( &
7707 & fullname = url, iorange = iorange, remainder = remainder )
7708 call split( str = iorange, carray = carray, sep = gt_equal )
7709 timevar_name = carray(1)
7710 deallocate( carray )
7711 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7712 call historygetdouble6pointer( file = file, &
7713 & varname = varname, array = array, &
7714 & range = time_range, quiet = quiet, &
7715 & flag_mpi_split = flag_mpi_split, &
7716 & returned_time = returned_time, &
7717 & flag_time_exist = flag_time_exist, &
7718 & err = err )
7719end subroutine historygetdouble6pointertimer
7721 & file, varname, array, time, &
7722 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7723 use dc_string, only: tochar, split
7724 use dc_types, only: string, dp, sp
7725 use dc_trace, only: dbgmessage
7726 use dc_url, only: url_chop_iorange, gt_equal
7727 use dc_present, only: present_and_true
7728 implicit none
7729 character(*), intent(in):: file, varname
7730 real(SP), intent(in):: time
7731 logical, intent(in), optional:: quiet
7732 real(DP), pointer :: array(:,:,:,:,:,:,:)
7733 logical, intent(in), optional:: flag_mpi_split
7734 real(DP), intent(out), optional:: returned_time
7735 logical, intent(out), optional:: flag_time_exist
7736 logical, intent(out), optional:: err
7737 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7738 character(STRING), pointer:: carray (:)
7739 character(STRING):: tname
7740 interface
7741 subroutine historygetdouble7pointer(&
7742 & file, varname, array, range, quiet, &
7743 & flag_mpi_split, returned_time, flag_time_exist, err)
7744 use dc_types, only: dp
7745 character(*), intent(in):: file
7746 character(*), intent(in):: varname
7747 character(*), intent(in), optional:: range
7748 logical, intent(in), optional:: quiet
7749 logical, intent(in), optional:: flag_mpi_split
7750 real(DP), intent(out), optional:: returned_time
7751 logical, intent(out), optional:: flag_time_exist
7752 logical, intent(out), optional:: err
7753 real(DP), pointer :: array(:,:,:,:,:,:,:)
7754 end subroutine historygetdouble7pointer
7755 end interface
7756 interface
7757 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7758 character(*), intent(in):: file
7759 character(*), intent(in):: varname
7760 character(*), intent(out):: url
7761 character(*), intent(in), optional:: range
7762 logical, intent(out), optional:: flag_time_exist
7763 character(*), intent(out), optional:: time_name
7764 logical, intent(out), optional:: err
7765 end subroutine lookup_growable_url
7766 end interface
7767 interface
7768 function file_rename_mpi( file ) result(result)
7769 use dc_types, only: string
7770 character(*), intent(in):: file
7771 character(STRING):: result
7772 end function file_rename_mpi
7773 end interface
7774 continue
7775 file_work = file
7776 if ( present_and_true( flag_mpi_split ) ) &
7777 & file_work = file_rename_mpi( file_work )
7778 call lookup_growable_url(file = file_work, varname = varname, &
7779 & url = url, &
7780 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7781 call url_chop_iorange( &
7782 & fullname = url, iorange = iorange, remainder = remainder )
7783 call split( str = iorange, carray = carray, sep = gt_equal )
7784 timevar_name = carray(1)
7785 deallocate( carray )
7786 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7787 call historygetdouble7pointer( file = file, &
7788 & varname = varname, array = array, &
7789 & range = time_range, quiet = quiet, &
7790 & flag_mpi_split = flag_mpi_split, &
7791 & returned_time = returned_time, &
7792 & flag_time_exist = flag_time_exist, &
7793 & err = err )
7794end subroutine historygetdouble7pointertimer
7796 & file, varname, array, time, &
7797 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7798 use dc_string, only: tochar, split
7799 use dc_types, only: string, dp, sp
7800 use dc_trace, only: dbgmessage
7801 use dc_url, only: url_chop_iorange, gt_equal
7802 use dc_present, only: present_and_true
7803 implicit none
7804 character(*), intent(in):: file, varname
7805 real(SP), intent(in):: time
7806 logical, intent(in), optional:: quiet
7807 real(SP), intent(out) :: array
7808 logical, intent(in), optional:: flag_mpi_split
7809 real(DP), intent(out), optional:: returned_time
7810 logical, intent(out), optional:: flag_time_exist
7811 logical, intent(out), optional:: err
7812 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7813 character(STRING), pointer:: carray (:)
7814 character(STRING):: tname
7815 interface
7816 subroutine historygetreal0(&
7817 & file, varname, array, range, quiet, &
7818 & flag_mpi_split, returned_time, flag_time_exist, err)
7819 use dc_types, only: dp, sp
7820 character(*), intent(in):: file
7821 character(*), intent(in):: varname
7822 character(*), intent(in), optional:: range
7823 logical, intent(in), optional:: quiet
7824 logical, intent(in), optional:: flag_mpi_split
7825 real(DP), intent(out), optional:: returned_time
7826 logical, intent(out), optional:: flag_time_exist
7827 logical, intent(out), optional:: err
7828 real(SP), intent(out) :: array
7829 end subroutine historygetreal0
7830 end interface
7831 interface
7832 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7833 character(*), intent(in):: file
7834 character(*), intent(in):: varname
7835 character(*), intent(out):: url
7836 character(*), intent(in), optional:: range
7837 logical, intent(out), optional:: flag_time_exist
7838 character(*), intent(out), optional:: time_name
7839 logical, intent(out), optional:: err
7840 end subroutine lookup_growable_url
7841 end interface
7842 interface
7843 function file_rename_mpi( file ) result(result)
7844 use dc_types, only: string
7845 character(*), intent(in):: file
7846 character(STRING):: result
7847 end function file_rename_mpi
7848 end interface
7849 continue
7850 file_work = file
7851 if ( present_and_true( flag_mpi_split ) ) &
7852 & file_work = file_rename_mpi( file_work )
7853 call lookup_growable_url(file = file_work, varname = varname, &
7854 & url = url, &
7855 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7856 call url_chop_iorange( &
7857 & fullname = url, iorange = iorange, remainder = remainder )
7858 call split( str = iorange, carray = carray, sep = gt_equal )
7859 timevar_name = carray(1)
7860 deallocate( carray )
7861 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7862 call historygetreal0( file = file, &
7863 & varname = varname, array = array, &
7864 & range = time_range, quiet = quiet, &
7865 & flag_mpi_split = flag_mpi_split, &
7866 & returned_time = returned_time, &
7867 & flag_time_exist = flag_time_exist, &
7868 & err = err )
7869end subroutine historygetreal0timer
7871 & file, varname, array, time, &
7872 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7873 use dc_string, only: tochar, split
7874 use dc_types, only: string, dp, sp
7875 use dc_trace, only: dbgmessage
7876 use dc_url, only: url_chop_iorange, gt_equal
7877 use dc_present, only: present_and_true
7878 implicit none
7879 character(*), intent(in):: file, varname
7880 real(SP), intent(in):: time
7881 logical, intent(in), optional:: quiet
7882 real(SP), intent(out) :: array(:)
7883 logical, intent(in), optional:: flag_mpi_split
7884 real(DP), intent(out), optional:: returned_time
7885 logical, intent(out), optional:: flag_time_exist
7886 logical, intent(out), optional:: err
7887 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7888 character(STRING), pointer:: carray (:)
7889 character(STRING):: tname
7890 interface
7891 subroutine historygetreal1(&
7892 & file, varname, array, range, quiet, &
7893 & flag_mpi_split, returned_time, flag_time_exist, err)
7894 use dc_types, only: dp, sp
7895 character(*), intent(in):: file
7896 character(*), intent(in):: varname
7897 character(*), intent(in), optional:: range
7898 logical, intent(in), optional:: quiet
7899 logical, intent(in), optional:: flag_mpi_split
7900 real(DP), intent(out), optional:: returned_time
7901 logical, intent(out), optional:: flag_time_exist
7902 logical, intent(out), optional:: err
7903 real(SP), intent(out) :: array(:)
7904 end subroutine historygetreal1
7905 end interface
7906 interface
7907 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7908 character(*), intent(in):: file
7909 character(*), intent(in):: varname
7910 character(*), intent(out):: url
7911 character(*), intent(in), optional:: range
7912 logical, intent(out), optional:: flag_time_exist
7913 character(*), intent(out), optional:: time_name
7914 logical, intent(out), optional:: err
7915 end subroutine lookup_growable_url
7916 end interface
7917 interface
7918 function file_rename_mpi( file ) result(result)
7919 use dc_types, only: string
7920 character(*), intent(in):: file
7921 character(STRING):: result
7922 end function file_rename_mpi
7923 end interface
7924 continue
7925 file_work = file
7926 if ( present_and_true( flag_mpi_split ) ) &
7927 & file_work = file_rename_mpi( file_work )
7928 call lookup_growable_url(file = file_work, varname = varname, &
7929 & url = url, &
7930 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
7931 call url_chop_iorange( &
7932 & fullname = url, iorange = iorange, remainder = remainder )
7933 call split( str = iorange, carray = carray, sep = gt_equal )
7934 timevar_name = carray(1)
7935 deallocate( carray )
7936 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
7937 call historygetreal1( file = file, &
7938 & varname = varname, array = array, &
7939 & range = time_range, quiet = quiet, &
7940 & flag_mpi_split = flag_mpi_split, &
7941 & returned_time = returned_time, &
7942 & flag_time_exist = flag_time_exist, &
7943 & err = err )
7944end subroutine historygetreal1timer
7946 & file, varname, array, time, &
7947 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
7948 use dc_string, only: tochar, split
7949 use dc_types, only: string, dp, sp
7950 use dc_trace, only: dbgmessage
7951 use dc_url, only: url_chop_iorange, gt_equal
7952 use dc_present, only: present_and_true
7953 implicit none
7954 character(*), intent(in):: file, varname
7955 real(SP), intent(in):: time
7956 logical, intent(in), optional:: quiet
7957 real(SP), intent(out) :: array(:,:)
7958 logical, intent(in), optional:: flag_mpi_split
7959 real(DP), intent(out), optional:: returned_time
7960 logical, intent(out), optional:: flag_time_exist
7961 logical, intent(out), optional:: err
7962 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
7963 character(STRING), pointer:: carray (:)
7964 character(STRING):: tname
7965 interface
7966 subroutine historygetreal2(&
7967 & file, varname, array, range, quiet, &
7968 & flag_mpi_split, returned_time, flag_time_exist, err)
7969 use dc_types, only: dp, sp
7970 character(*), intent(in):: file
7971 character(*), intent(in):: varname
7972 character(*), intent(in), optional:: range
7973 logical, intent(in), optional:: quiet
7974 logical, intent(in), optional:: flag_mpi_split
7975 real(DP), intent(out), optional:: returned_time
7976 logical, intent(out), optional:: flag_time_exist
7977 logical, intent(out), optional:: err
7978 real(SP), intent(out) :: array(:,:)
7979 end subroutine historygetreal2
7980 end interface
7981 interface
7982 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
7983 character(*), intent(in):: file
7984 character(*), intent(in):: varname
7985 character(*), intent(out):: url
7986 character(*), intent(in), optional:: range
7987 logical, intent(out), optional:: flag_time_exist
7988 character(*), intent(out), optional:: time_name
7989 logical, intent(out), optional:: err
7990 end subroutine lookup_growable_url
7991 end interface
7992 interface
7993 function file_rename_mpi( file ) result(result)
7994 use dc_types, only: string
7995 character(*), intent(in):: file
7996 character(STRING):: result
7997 end function file_rename_mpi
7998 end interface
7999 continue
8000 file_work = file
8001 if ( present_and_true( flag_mpi_split ) ) &
8002 & file_work = file_rename_mpi( file_work )
8003 call lookup_growable_url(file = file_work, varname = varname, &
8004 & url = url, &
8005 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8006 call url_chop_iorange( &
8007 & fullname = url, iorange = iorange, remainder = remainder )
8008 call split( str = iorange, carray = carray, sep = gt_equal )
8009 timevar_name = carray(1)
8010 deallocate( carray )
8011 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8012 call historygetreal2( file = file, &
8013 & varname = varname, array = array, &
8014 & range = time_range, quiet = quiet, &
8015 & flag_mpi_split = flag_mpi_split, &
8016 & returned_time = returned_time, &
8017 & flag_time_exist = flag_time_exist, &
8018 & err = err )
8019end subroutine historygetreal2timer
8021 & file, varname, array, time, &
8022 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8023 use dc_string, only: tochar, split
8024 use dc_types, only: string, dp, sp
8025 use dc_trace, only: dbgmessage
8026 use dc_url, only: url_chop_iorange, gt_equal
8027 use dc_present, only: present_and_true
8028 implicit none
8029 character(*), intent(in):: file, varname
8030 real(SP), intent(in):: time
8031 logical, intent(in), optional:: quiet
8032 real(SP), intent(out) :: array(:,:,:)
8033 logical, intent(in), optional:: flag_mpi_split
8034 real(DP), intent(out), optional:: returned_time
8035 logical, intent(out), optional:: flag_time_exist
8036 logical, intent(out), optional:: err
8037 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8038 character(STRING), pointer:: carray (:)
8039 character(STRING):: tname
8040 interface
8041 subroutine historygetreal3(&
8042 & file, varname, array, range, quiet, &
8043 & flag_mpi_split, returned_time, flag_time_exist, err)
8044 use dc_types, only: dp, sp
8045 character(*), intent(in):: file
8046 character(*), intent(in):: varname
8047 character(*), intent(in), optional:: range
8048 logical, intent(in), optional:: quiet
8049 logical, intent(in), optional:: flag_mpi_split
8050 real(DP), intent(out), optional:: returned_time
8051 logical, intent(out), optional:: flag_time_exist
8052 logical, intent(out), optional:: err
8053 real(SP), intent(out) :: array(:,:,:)
8054 end subroutine historygetreal3
8055 end interface
8056 interface
8057 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8058 character(*), intent(in):: file
8059 character(*), intent(in):: varname
8060 character(*), intent(out):: url
8061 character(*), intent(in), optional:: range
8062 logical, intent(out), optional:: flag_time_exist
8063 character(*), intent(out), optional:: time_name
8064 logical, intent(out), optional:: err
8065 end subroutine lookup_growable_url
8066 end interface
8067 interface
8068 function file_rename_mpi( file ) result(result)
8069 use dc_types, only: string
8070 character(*), intent(in):: file
8071 character(STRING):: result
8072 end function file_rename_mpi
8073 end interface
8074 continue
8075 file_work = file
8076 if ( present_and_true( flag_mpi_split ) ) &
8077 & file_work = file_rename_mpi( file_work )
8078 call lookup_growable_url(file = file_work, varname = varname, &
8079 & url = url, &
8080 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8081 call url_chop_iorange( &
8082 & fullname = url, iorange = iorange, remainder = remainder )
8083 call split( str = iorange, carray = carray, sep = gt_equal )
8084 timevar_name = carray(1)
8085 deallocate( carray )
8086 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8087 call historygetreal3( file = file, &
8088 & varname = varname, array = array, &
8089 & range = time_range, quiet = quiet, &
8090 & flag_mpi_split = flag_mpi_split, &
8091 & returned_time = returned_time, &
8092 & flag_time_exist = flag_time_exist, &
8093 & err = err )
8094end subroutine historygetreal3timer
8096 & file, varname, array, time, &
8097 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8098 use dc_string, only: tochar, split
8099 use dc_types, only: string, dp, sp
8100 use dc_trace, only: dbgmessage
8101 use dc_url, only: url_chop_iorange, gt_equal
8102 use dc_present, only: present_and_true
8103 implicit none
8104 character(*), intent(in):: file, varname
8105 real(SP), intent(in):: time
8106 logical, intent(in), optional:: quiet
8107 real(SP), intent(out) :: array(:,:,:,:)
8108 logical, intent(in), optional:: flag_mpi_split
8109 real(DP), intent(out), optional:: returned_time
8110 logical, intent(out), optional:: flag_time_exist
8111 logical, intent(out), optional:: err
8112 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8113 character(STRING), pointer:: carray (:)
8114 character(STRING):: tname
8115 interface
8116 subroutine historygetreal4(&
8117 & file, varname, array, range, quiet, &
8118 & flag_mpi_split, returned_time, flag_time_exist, err)
8119 use dc_types, only: dp, sp
8120 character(*), intent(in):: file
8121 character(*), intent(in):: varname
8122 character(*), intent(in), optional:: range
8123 logical, intent(in), optional:: quiet
8124 logical, intent(in), optional:: flag_mpi_split
8125 real(DP), intent(out), optional:: returned_time
8126 logical, intent(out), optional:: flag_time_exist
8127 logical, intent(out), optional:: err
8128 real(SP), intent(out) :: array(:,:,:,:)
8129 end subroutine historygetreal4
8130 end interface
8131 interface
8132 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8133 character(*), intent(in):: file
8134 character(*), intent(in):: varname
8135 character(*), intent(out):: url
8136 character(*), intent(in), optional:: range
8137 logical, intent(out), optional:: flag_time_exist
8138 character(*), intent(out), optional:: time_name
8139 logical, intent(out), optional:: err
8140 end subroutine lookup_growable_url
8141 end interface
8142 interface
8143 function file_rename_mpi( file ) result(result)
8144 use dc_types, only: string
8145 character(*), intent(in):: file
8146 character(STRING):: result
8147 end function file_rename_mpi
8148 end interface
8149 continue
8150 file_work = file
8151 if ( present_and_true( flag_mpi_split ) ) &
8152 & file_work = file_rename_mpi( file_work )
8153 call lookup_growable_url(file = file_work, varname = varname, &
8154 & url = url, &
8155 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8156 call url_chop_iorange( &
8157 & fullname = url, iorange = iorange, remainder = remainder )
8158 call split( str = iorange, carray = carray, sep = gt_equal )
8159 timevar_name = carray(1)
8160 deallocate( carray )
8161 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8162 call historygetreal4( file = file, &
8163 & varname = varname, array = array, &
8164 & range = time_range, quiet = quiet, &
8165 & flag_mpi_split = flag_mpi_split, &
8166 & returned_time = returned_time, &
8167 & flag_time_exist = flag_time_exist, &
8168 & err = err )
8169end subroutine historygetreal4timer
8171 & file, varname, array, time, &
8172 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8173 use dc_string, only: tochar, split
8174 use dc_types, only: string, dp, sp
8175 use dc_trace, only: dbgmessage
8176 use dc_url, only: url_chop_iorange, gt_equal
8177 use dc_present, only: present_and_true
8178 implicit none
8179 character(*), intent(in):: file, varname
8180 real(SP), intent(in):: time
8181 logical, intent(in), optional:: quiet
8182 real(SP), intent(out) :: array(:,:,:,:,:)
8183 logical, intent(in), optional:: flag_mpi_split
8184 real(DP), intent(out), optional:: returned_time
8185 logical, intent(out), optional:: flag_time_exist
8186 logical, intent(out), optional:: err
8187 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8188 character(STRING), pointer:: carray (:)
8189 character(STRING):: tname
8190 interface
8191 subroutine historygetreal5(&
8192 & file, varname, array, range, quiet, &
8193 & flag_mpi_split, returned_time, flag_time_exist, err)
8194 use dc_types, only: dp, sp
8195 character(*), intent(in):: file
8196 character(*), intent(in):: varname
8197 character(*), intent(in), optional:: range
8198 logical, intent(in), optional:: quiet
8199 logical, intent(in), optional:: flag_mpi_split
8200 real(DP), intent(out), optional:: returned_time
8201 logical, intent(out), optional:: flag_time_exist
8202 logical, intent(out), optional:: err
8203 real(SP), intent(out) :: array(:,:,:,:,:)
8204 end subroutine historygetreal5
8205 end interface
8206 interface
8207 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8208 character(*), intent(in):: file
8209 character(*), intent(in):: varname
8210 character(*), intent(out):: url
8211 character(*), intent(in), optional:: range
8212 logical, intent(out), optional:: flag_time_exist
8213 character(*), intent(out), optional:: time_name
8214 logical, intent(out), optional:: err
8215 end subroutine lookup_growable_url
8216 end interface
8217 interface
8218 function file_rename_mpi( file ) result(result)
8219 use dc_types, only: string
8220 character(*), intent(in):: file
8221 character(STRING):: result
8222 end function file_rename_mpi
8223 end interface
8224 continue
8225 file_work = file
8226 if ( present_and_true( flag_mpi_split ) ) &
8227 & file_work = file_rename_mpi( file_work )
8228 call lookup_growable_url(file = file_work, varname = varname, &
8229 & url = url, &
8230 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8231 call url_chop_iorange( &
8232 & fullname = url, iorange = iorange, remainder = remainder )
8233 call split( str = iorange, carray = carray, sep = gt_equal )
8234 timevar_name = carray(1)
8235 deallocate( carray )
8236 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8237 call historygetreal5( file = file, &
8238 & varname = varname, array = array, &
8239 & range = time_range, quiet = quiet, &
8240 & flag_mpi_split = flag_mpi_split, &
8241 & returned_time = returned_time, &
8242 & flag_time_exist = flag_time_exist, &
8243 & err = err )
8244end subroutine historygetreal5timer
8246 & file, varname, array, time, &
8247 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8248 use dc_string, only: tochar, split
8249 use dc_types, only: string, dp, sp
8250 use dc_trace, only: dbgmessage
8251 use dc_url, only: url_chop_iorange, gt_equal
8252 use dc_present, only: present_and_true
8253 implicit none
8254 character(*), intent(in):: file, varname
8255 real(SP), intent(in):: time
8256 logical, intent(in), optional:: quiet
8257 real(SP), intent(out) :: array(:,:,:,:,:,:)
8258 logical, intent(in), optional:: flag_mpi_split
8259 real(DP), intent(out), optional:: returned_time
8260 logical, intent(out), optional:: flag_time_exist
8261 logical, intent(out), optional:: err
8262 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8263 character(STRING), pointer:: carray (:)
8264 character(STRING):: tname
8265 interface
8266 subroutine historygetreal6(&
8267 & file, varname, array, range, quiet, &
8268 & flag_mpi_split, returned_time, flag_time_exist, err)
8269 use dc_types, only: dp, sp
8270 character(*), intent(in):: file
8271 character(*), intent(in):: varname
8272 character(*), intent(in), optional:: range
8273 logical, intent(in), optional:: quiet
8274 logical, intent(in), optional:: flag_mpi_split
8275 real(DP), intent(out), optional:: returned_time
8276 logical, intent(out), optional:: flag_time_exist
8277 logical, intent(out), optional:: err
8278 real(SP), intent(out) :: array(:,:,:,:,:,:)
8279 end subroutine historygetreal6
8280 end interface
8281 interface
8282 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8283 character(*), intent(in):: file
8284 character(*), intent(in):: varname
8285 character(*), intent(out):: url
8286 character(*), intent(in), optional:: range
8287 logical, intent(out), optional:: flag_time_exist
8288 character(*), intent(out), optional:: time_name
8289 logical, intent(out), optional:: err
8290 end subroutine lookup_growable_url
8291 end interface
8292 interface
8293 function file_rename_mpi( file ) result(result)
8294 use dc_types, only: string
8295 character(*), intent(in):: file
8296 character(STRING):: result
8297 end function file_rename_mpi
8298 end interface
8299 continue
8300 file_work = file
8301 if ( present_and_true( flag_mpi_split ) ) &
8302 & file_work = file_rename_mpi( file_work )
8303 call lookup_growable_url(file = file_work, varname = varname, &
8304 & url = url, &
8305 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8306 call url_chop_iorange( &
8307 & fullname = url, iorange = iorange, remainder = remainder )
8308 call split( str = iorange, carray = carray, sep = gt_equal )
8309 timevar_name = carray(1)
8310 deallocate( carray )
8311 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8312 call historygetreal6( file = file, &
8313 & varname = varname, array = array, &
8314 & range = time_range, quiet = quiet, &
8315 & flag_mpi_split = flag_mpi_split, &
8316 & returned_time = returned_time, &
8317 & flag_time_exist = flag_time_exist, &
8318 & err = err )
8319end subroutine historygetreal6timer
8321 & file, varname, array, time, &
8322 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8323 use dc_string, only: tochar, split
8324 use dc_types, only: string, dp, sp
8325 use dc_trace, only: dbgmessage
8326 use dc_url, only: url_chop_iorange, gt_equal
8327 use dc_present, only: present_and_true
8328 implicit none
8329 character(*), intent(in):: file, varname
8330 real(SP), intent(in):: time
8331 logical, intent(in), optional:: quiet
8332 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
8333 logical, intent(in), optional:: flag_mpi_split
8334 real(DP), intent(out), optional:: returned_time
8335 logical, intent(out), optional:: flag_time_exist
8336 logical, intent(out), optional:: err
8337 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8338 character(STRING), pointer:: carray (:)
8339 character(STRING):: tname
8340 interface
8341 subroutine historygetreal7(&
8342 & file, varname, array, range, quiet, &
8343 & flag_mpi_split, returned_time, flag_time_exist, err)
8344 use dc_types, only: dp, sp
8345 character(*), intent(in):: file
8346 character(*), intent(in):: varname
8347 character(*), intent(in), optional:: range
8348 logical, intent(in), optional:: quiet
8349 logical, intent(in), optional:: flag_mpi_split
8350 real(DP), intent(out), optional:: returned_time
8351 logical, intent(out), optional:: flag_time_exist
8352 logical, intent(out), optional:: err
8353 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
8354 end subroutine historygetreal7
8355 end interface
8356 interface
8357 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8358 character(*), intent(in):: file
8359 character(*), intent(in):: varname
8360 character(*), intent(out):: url
8361 character(*), intent(in), optional:: range
8362 logical, intent(out), optional:: flag_time_exist
8363 character(*), intent(out), optional:: time_name
8364 logical, intent(out), optional:: err
8365 end subroutine lookup_growable_url
8366 end interface
8367 interface
8368 function file_rename_mpi( file ) result(result)
8369 use dc_types, only: string
8370 character(*), intent(in):: file
8371 character(STRING):: result
8372 end function file_rename_mpi
8373 end interface
8374 continue
8375 file_work = file
8376 if ( present_and_true( flag_mpi_split ) ) &
8377 & file_work = file_rename_mpi( file_work )
8378 call lookup_growable_url(file = file_work, varname = varname, &
8379 & url = url, &
8380 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8381 call url_chop_iorange( &
8382 & fullname = url, iorange = iorange, remainder = remainder )
8383 call split( str = iorange, carray = carray, sep = gt_equal )
8384 timevar_name = carray(1)
8385 deallocate( carray )
8386 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8387 call historygetreal7( file = file, &
8388 & varname = varname, array = array, &
8389 & range = time_range, quiet = quiet, &
8390 & flag_mpi_split = flag_mpi_split, &
8391 & returned_time = returned_time, &
8392 & flag_time_exist = flag_time_exist, &
8393 & err = err )
8394end subroutine historygetreal7timer
8396 & file, varname, array, time, &
8397 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8398 use dc_string, only: tochar, split
8399 use dc_types, only: string, dp, sp
8400 use dc_trace, only: dbgmessage
8401 use dc_url, only: url_chop_iorange, gt_equal
8402 use dc_present, only: present_and_true
8403 implicit none
8404 character(*), intent(in):: file, varname
8405 real(SP), intent(in):: time
8406 logical, intent(in), optional:: quiet
8407 real(SP), pointer :: array
8408 logical, intent(in), optional:: flag_mpi_split
8409 real(DP), intent(out), optional:: returned_time
8410 logical, intent(out), optional:: flag_time_exist
8411 logical, intent(out), optional:: err
8412 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8413 character(STRING), pointer:: carray (:)
8414 character(STRING):: tname
8415 interface
8416 subroutine historygetreal0pointer(&
8417 & file, varname, array, range, quiet, &
8418 & flag_mpi_split, returned_time, flag_time_exist, err)
8419 use dc_types, only: dp, sp
8420 character(*), intent(in):: file
8421 character(*), intent(in):: varname
8422 character(*), intent(in), optional:: range
8423 logical, intent(in), optional:: quiet
8424 logical, intent(in), optional:: flag_mpi_split
8425 real(DP), intent(out), optional:: returned_time
8426 logical, intent(out), optional:: flag_time_exist
8427 logical, intent(out), optional:: err
8428 real(SP), pointer :: array
8429 end subroutine historygetreal0pointer
8430 end interface
8431 interface
8432 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8433 character(*), intent(in):: file
8434 character(*), intent(in):: varname
8435 character(*), intent(out):: url
8436 character(*), intent(in), optional:: range
8437 logical, intent(out), optional:: flag_time_exist
8438 character(*), intent(out), optional:: time_name
8439 logical, intent(out), optional:: err
8440 end subroutine lookup_growable_url
8441 end interface
8442 interface
8443 function file_rename_mpi( file ) result(result)
8444 use dc_types, only: string
8445 character(*), intent(in):: file
8446 character(STRING):: result
8447 end function file_rename_mpi
8448 end interface
8449 continue
8450 file_work = file
8451 if ( present_and_true( flag_mpi_split ) ) &
8452 & file_work = file_rename_mpi( file_work )
8453 call lookup_growable_url(file = file_work, varname = varname, &
8454 & url = url, &
8455 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8456 call url_chop_iorange( &
8457 & fullname = url, iorange = iorange, remainder = remainder )
8458 call split( str = iorange, carray = carray, sep = gt_equal )
8459 timevar_name = carray(1)
8460 deallocate( carray )
8461 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8462 call historygetreal0pointer( file = file, &
8463 & varname = varname, array = array, &
8464 & range = time_range, quiet = quiet, &
8465 & flag_mpi_split = flag_mpi_split, &
8466 & returned_time = returned_time, &
8467 & flag_time_exist = flag_time_exist, &
8468 & err = err )
8469end subroutine historygetreal0pointertimer
8471 & file, varname, array, time, &
8472 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8473 use dc_string, only: tochar, split
8474 use dc_types, only: string, dp, sp
8475 use dc_trace, only: dbgmessage
8476 use dc_url, only: url_chop_iorange, gt_equal
8477 use dc_present, only: present_and_true
8478 implicit none
8479 character(*), intent(in):: file, varname
8480 real(SP), intent(in):: time
8481 logical, intent(in), optional:: quiet
8482 real(SP), pointer :: array(:)
8483 logical, intent(in), optional:: flag_mpi_split
8484 real(DP), intent(out), optional:: returned_time
8485 logical, intent(out), optional:: flag_time_exist
8486 logical, intent(out), optional:: err
8487 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8488 character(STRING), pointer:: carray (:)
8489 character(STRING):: tname
8490 interface
8491 subroutine historygetreal1pointer(&
8492 & file, varname, array, range, quiet, &
8493 & flag_mpi_split, returned_time, flag_time_exist, err)
8494 use dc_types, only: dp, sp
8495 character(*), intent(in):: file
8496 character(*), intent(in):: varname
8497 character(*), intent(in), optional:: range
8498 logical, intent(in), optional:: quiet
8499 logical, intent(in), optional:: flag_mpi_split
8500 real(DP), intent(out), optional:: returned_time
8501 logical, intent(out), optional:: flag_time_exist
8502 logical, intent(out), optional:: err
8503 real(SP), pointer :: array(:)
8504 end subroutine historygetreal1pointer
8505 end interface
8506 interface
8507 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8508 character(*), intent(in):: file
8509 character(*), intent(in):: varname
8510 character(*), intent(out):: url
8511 character(*), intent(in), optional:: range
8512 logical, intent(out), optional:: flag_time_exist
8513 character(*), intent(out), optional:: time_name
8514 logical, intent(out), optional:: err
8515 end subroutine lookup_growable_url
8516 end interface
8517 interface
8518 function file_rename_mpi( file ) result(result)
8519 use dc_types, only: string
8520 character(*), intent(in):: file
8521 character(STRING):: result
8522 end function file_rename_mpi
8523 end interface
8524 continue
8525 file_work = file
8526 if ( present_and_true( flag_mpi_split ) ) &
8527 & file_work = file_rename_mpi( file_work )
8528 call lookup_growable_url(file = file_work, varname = varname, &
8529 & url = url, &
8530 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8531 call url_chop_iorange( &
8532 & fullname = url, iorange = iorange, remainder = remainder )
8533 call split( str = iorange, carray = carray, sep = gt_equal )
8534 timevar_name = carray(1)
8535 deallocate( carray )
8536 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8537 call historygetreal1pointer( file = file, &
8538 & varname = varname, array = array, &
8539 & range = time_range, quiet = quiet, &
8540 & flag_mpi_split = flag_mpi_split, &
8541 & returned_time = returned_time, &
8542 & flag_time_exist = flag_time_exist, &
8543 & err = err )
8544end subroutine historygetreal1pointertimer
8546 & file, varname, array, time, &
8547 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8548 use dc_string, only: tochar, split
8549 use dc_types, only: string, dp, sp
8550 use dc_trace, only: dbgmessage
8551 use dc_url, only: url_chop_iorange, gt_equal
8552 use dc_present, only: present_and_true
8553 implicit none
8554 character(*), intent(in):: file, varname
8555 real(SP), intent(in):: time
8556 logical, intent(in), optional:: quiet
8557 real(SP), pointer :: array(:,:)
8558 logical, intent(in), optional:: flag_mpi_split
8559 real(DP), intent(out), optional:: returned_time
8560 logical, intent(out), optional:: flag_time_exist
8561 logical, intent(out), optional:: err
8562 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8563 character(STRING), pointer:: carray (:)
8564 character(STRING):: tname
8565 interface
8566 subroutine historygetreal2pointer(&
8567 & file, varname, array, range, quiet, &
8568 & flag_mpi_split, returned_time, flag_time_exist, err)
8569 use dc_types, only: dp, sp
8570 character(*), intent(in):: file
8571 character(*), intent(in):: varname
8572 character(*), intent(in), optional:: range
8573 logical, intent(in), optional:: quiet
8574 logical, intent(in), optional:: flag_mpi_split
8575 real(DP), intent(out), optional:: returned_time
8576 logical, intent(out), optional:: flag_time_exist
8577 logical, intent(out), optional:: err
8578 real(SP), pointer :: array(:,:)
8579 end subroutine historygetreal2pointer
8580 end interface
8581 interface
8582 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8583 character(*), intent(in):: file
8584 character(*), intent(in):: varname
8585 character(*), intent(out):: url
8586 character(*), intent(in), optional:: range
8587 logical, intent(out), optional:: flag_time_exist
8588 character(*), intent(out), optional:: time_name
8589 logical, intent(out), optional:: err
8590 end subroutine lookup_growable_url
8591 end interface
8592 interface
8593 function file_rename_mpi( file ) result(result)
8594 use dc_types, only: string
8595 character(*), intent(in):: file
8596 character(STRING):: result
8597 end function file_rename_mpi
8598 end interface
8599 continue
8600 file_work = file
8601 if ( present_and_true( flag_mpi_split ) ) &
8602 & file_work = file_rename_mpi( file_work )
8603 call lookup_growable_url(file = file_work, varname = varname, &
8604 & url = url, &
8605 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8606 call url_chop_iorange( &
8607 & fullname = url, iorange = iorange, remainder = remainder )
8608 call split( str = iorange, carray = carray, sep = gt_equal )
8609 timevar_name = carray(1)
8610 deallocate( carray )
8611 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8612 call historygetreal2pointer( file = file, &
8613 & varname = varname, array = array, &
8614 & range = time_range, quiet = quiet, &
8615 & flag_mpi_split = flag_mpi_split, &
8616 & returned_time = returned_time, &
8617 & flag_time_exist = flag_time_exist, &
8618 & err = err )
8619end subroutine historygetreal2pointertimer
8621 & file, varname, array, time, &
8622 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8623 use dc_string, only: tochar, split
8624 use dc_types, only: string, dp, sp
8625 use dc_trace, only: dbgmessage
8626 use dc_url, only: url_chop_iorange, gt_equal
8627 use dc_present, only: present_and_true
8628 implicit none
8629 character(*), intent(in):: file, varname
8630 real(SP), intent(in):: time
8631 logical, intent(in), optional:: quiet
8632 real(SP), pointer :: array(:,:,:)
8633 logical, intent(in), optional:: flag_mpi_split
8634 real(DP), intent(out), optional:: returned_time
8635 logical, intent(out), optional:: flag_time_exist
8636 logical, intent(out), optional:: err
8637 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8638 character(STRING), pointer:: carray (:)
8639 character(STRING):: tname
8640 interface
8641 subroutine historygetreal3pointer(&
8642 & file, varname, array, range, quiet, &
8643 & flag_mpi_split, returned_time, flag_time_exist, err)
8644 use dc_types, only: dp, sp
8645 character(*), intent(in):: file
8646 character(*), intent(in):: varname
8647 character(*), intent(in), optional:: range
8648 logical, intent(in), optional:: quiet
8649 logical, intent(in), optional:: flag_mpi_split
8650 real(DP), intent(out), optional:: returned_time
8651 logical, intent(out), optional:: flag_time_exist
8652 logical, intent(out), optional:: err
8653 real(SP), pointer :: array(:,:,:)
8654 end subroutine historygetreal3pointer
8655 end interface
8656 interface
8657 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8658 character(*), intent(in):: file
8659 character(*), intent(in):: varname
8660 character(*), intent(out):: url
8661 character(*), intent(in), optional:: range
8662 logical, intent(out), optional:: flag_time_exist
8663 character(*), intent(out), optional:: time_name
8664 logical, intent(out), optional:: err
8665 end subroutine lookup_growable_url
8666 end interface
8667 interface
8668 function file_rename_mpi( file ) result(result)
8669 use dc_types, only: string
8670 character(*), intent(in):: file
8671 character(STRING):: result
8672 end function file_rename_mpi
8673 end interface
8674 continue
8675 file_work = file
8676 if ( present_and_true( flag_mpi_split ) ) &
8677 & file_work = file_rename_mpi( file_work )
8678 call lookup_growable_url(file = file_work, varname = varname, &
8679 & url = url, &
8680 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8681 call url_chop_iorange( &
8682 & fullname = url, iorange = iorange, remainder = remainder )
8683 call split( str = iorange, carray = carray, sep = gt_equal )
8684 timevar_name = carray(1)
8685 deallocate( carray )
8686 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8687 call historygetreal3pointer( file = file, &
8688 & varname = varname, array = array, &
8689 & range = time_range, quiet = quiet, &
8690 & flag_mpi_split = flag_mpi_split, &
8691 & returned_time = returned_time, &
8692 & flag_time_exist = flag_time_exist, &
8693 & err = err )
8694end subroutine historygetreal3pointertimer
8696 & file, varname, array, time, &
8697 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8698 use dc_string, only: tochar, split
8699 use dc_types, only: string, dp, sp
8700 use dc_trace, only: dbgmessage
8701 use dc_url, only: url_chop_iorange, gt_equal
8702 use dc_present, only: present_and_true
8703 implicit none
8704 character(*), intent(in):: file, varname
8705 real(SP), intent(in):: time
8706 logical, intent(in), optional:: quiet
8707 real(SP), pointer :: array(:,:,:,:)
8708 logical, intent(in), optional:: flag_mpi_split
8709 real(DP), intent(out), optional:: returned_time
8710 logical, intent(out), optional:: flag_time_exist
8711 logical, intent(out), optional:: err
8712 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8713 character(STRING), pointer:: carray (:)
8714 character(STRING):: tname
8715 interface
8716 subroutine historygetreal4pointer(&
8717 & file, varname, array, range, quiet, &
8718 & flag_mpi_split, returned_time, flag_time_exist, err)
8719 use dc_types, only: dp, sp
8720 character(*), intent(in):: file
8721 character(*), intent(in):: varname
8722 character(*), intent(in), optional:: range
8723 logical, intent(in), optional:: quiet
8724 logical, intent(in), optional:: flag_mpi_split
8725 real(DP), intent(out), optional:: returned_time
8726 logical, intent(out), optional:: flag_time_exist
8727 logical, intent(out), optional:: err
8728 real(SP), pointer :: array(:,:,:,:)
8729 end subroutine historygetreal4pointer
8730 end interface
8731 interface
8732 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8733 character(*), intent(in):: file
8734 character(*), intent(in):: varname
8735 character(*), intent(out):: url
8736 character(*), intent(in), optional:: range
8737 logical, intent(out), optional:: flag_time_exist
8738 character(*), intent(out), optional:: time_name
8739 logical, intent(out), optional:: err
8740 end subroutine lookup_growable_url
8741 end interface
8742 interface
8743 function file_rename_mpi( file ) result(result)
8744 use dc_types, only: string
8745 character(*), intent(in):: file
8746 character(STRING):: result
8747 end function file_rename_mpi
8748 end interface
8749 continue
8750 file_work = file
8751 if ( present_and_true( flag_mpi_split ) ) &
8752 & file_work = file_rename_mpi( file_work )
8753 call lookup_growable_url(file = file_work, varname = varname, &
8754 & url = url, &
8755 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8756 call url_chop_iorange( &
8757 & fullname = url, iorange = iorange, remainder = remainder )
8758 call split( str = iorange, carray = carray, sep = gt_equal )
8759 timevar_name = carray(1)
8760 deallocate( carray )
8761 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8762 call historygetreal4pointer( file = file, &
8763 & varname = varname, array = array, &
8764 & range = time_range, quiet = quiet, &
8765 & flag_mpi_split = flag_mpi_split, &
8766 & returned_time = returned_time, &
8767 & flag_time_exist = flag_time_exist, &
8768 & err = err )
8769end subroutine historygetreal4pointertimer
8771 & file, varname, array, time, &
8772 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8773 use dc_string, only: tochar, split
8774 use dc_types, only: string, dp, sp
8775 use dc_trace, only: dbgmessage
8776 use dc_url, only: url_chop_iorange, gt_equal
8777 use dc_present, only: present_and_true
8778 implicit none
8779 character(*), intent(in):: file, varname
8780 real(SP), intent(in):: time
8781 logical, intent(in), optional:: quiet
8782 real(SP), pointer :: array(:,:,:,:,:)
8783 logical, intent(in), optional:: flag_mpi_split
8784 real(DP), intent(out), optional:: returned_time
8785 logical, intent(out), optional:: flag_time_exist
8786 logical, intent(out), optional:: err
8787 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8788 character(STRING), pointer:: carray (:)
8789 character(STRING):: tname
8790 interface
8791 subroutine historygetreal5pointer(&
8792 & file, varname, array, range, quiet, &
8793 & flag_mpi_split, returned_time, flag_time_exist, err)
8794 use dc_types, only: dp, sp
8795 character(*), intent(in):: file
8796 character(*), intent(in):: varname
8797 character(*), intent(in), optional:: range
8798 logical, intent(in), optional:: quiet
8799 logical, intent(in), optional:: flag_mpi_split
8800 real(DP), intent(out), optional:: returned_time
8801 logical, intent(out), optional:: flag_time_exist
8802 logical, intent(out), optional:: err
8803 real(SP), pointer :: array(:,:,:,:,:)
8804 end subroutine historygetreal5pointer
8805 end interface
8806 interface
8807 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8808 character(*), intent(in):: file
8809 character(*), intent(in):: varname
8810 character(*), intent(out):: url
8811 character(*), intent(in), optional:: range
8812 logical, intent(out), optional:: flag_time_exist
8813 character(*), intent(out), optional:: time_name
8814 logical, intent(out), optional:: err
8815 end subroutine lookup_growable_url
8816 end interface
8817 interface
8818 function file_rename_mpi( file ) result(result)
8819 use dc_types, only: string
8820 character(*), intent(in):: file
8821 character(STRING):: result
8822 end function file_rename_mpi
8823 end interface
8824 continue
8825 file_work = file
8826 if ( present_and_true( flag_mpi_split ) ) &
8827 & file_work = file_rename_mpi( file_work )
8828 call lookup_growable_url(file = file_work, varname = varname, &
8829 & url = url, &
8830 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8831 call url_chop_iorange( &
8832 & fullname = url, iorange = iorange, remainder = remainder )
8833 call split( str = iorange, carray = carray, sep = gt_equal )
8834 timevar_name = carray(1)
8835 deallocate( carray )
8836 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8837 call historygetreal5pointer( file = file, &
8838 & varname = varname, array = array, &
8839 & range = time_range, quiet = quiet, &
8840 & flag_mpi_split = flag_mpi_split, &
8841 & returned_time = returned_time, &
8842 & flag_time_exist = flag_time_exist, &
8843 & err = err )
8844end subroutine historygetreal5pointertimer
8846 & file, varname, array, time, &
8847 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8848 use dc_string, only: tochar, split
8849 use dc_types, only: string, dp, sp
8850 use dc_trace, only: dbgmessage
8851 use dc_url, only: url_chop_iorange, gt_equal
8852 use dc_present, only: present_and_true
8853 implicit none
8854 character(*), intent(in):: file, varname
8855 real(SP), intent(in):: time
8856 logical, intent(in), optional:: quiet
8857 real(SP), pointer :: array(:,:,:,:,:,:)
8858 logical, intent(in), optional:: flag_mpi_split
8859 real(DP), intent(out), optional:: returned_time
8860 logical, intent(out), optional:: flag_time_exist
8861 logical, intent(out), optional:: err
8862 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8863 character(STRING), pointer:: carray (:)
8864 character(STRING):: tname
8865 interface
8866 subroutine historygetreal6pointer(&
8867 & file, varname, array, range, quiet, &
8868 & flag_mpi_split, returned_time, flag_time_exist, err)
8869 use dc_types, only: dp, sp
8870 character(*), intent(in):: file
8871 character(*), intent(in):: varname
8872 character(*), intent(in), optional:: range
8873 logical, intent(in), optional:: quiet
8874 logical, intent(in), optional:: flag_mpi_split
8875 real(DP), intent(out), optional:: returned_time
8876 logical, intent(out), optional:: flag_time_exist
8877 logical, intent(out), optional:: err
8878 real(SP), pointer :: array(:,:,:,:,:,:)
8879 end subroutine historygetreal6pointer
8880 end interface
8881 interface
8882 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8883 character(*), intent(in):: file
8884 character(*), intent(in):: varname
8885 character(*), intent(out):: url
8886 character(*), intent(in), optional:: range
8887 logical, intent(out), optional:: flag_time_exist
8888 character(*), intent(out), optional:: time_name
8889 logical, intent(out), optional:: err
8890 end subroutine lookup_growable_url
8891 end interface
8892 interface
8893 function file_rename_mpi( file ) result(result)
8894 use dc_types, only: string
8895 character(*), intent(in):: file
8896 character(STRING):: result
8897 end function file_rename_mpi
8898 end interface
8899 continue
8900 file_work = file
8901 if ( present_and_true( flag_mpi_split ) ) &
8902 & file_work = file_rename_mpi( file_work )
8903 call lookup_growable_url(file = file_work, varname = varname, &
8904 & url = url, &
8905 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8906 call url_chop_iorange( &
8907 & fullname = url, iorange = iorange, remainder = remainder )
8908 call split( str = iorange, carray = carray, sep = gt_equal )
8909 timevar_name = carray(1)
8910 deallocate( carray )
8911 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8912 call historygetreal6pointer( file = file, &
8913 & varname = varname, array = array, &
8914 & range = time_range, quiet = quiet, &
8915 & flag_mpi_split = flag_mpi_split, &
8916 & returned_time = returned_time, &
8917 & flag_time_exist = flag_time_exist, &
8918 & err = err )
8919end subroutine historygetreal6pointertimer
8921 & file, varname, array, time, &
8922 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8923 use dc_string, only: tochar, split
8924 use dc_types, only: string, dp, sp
8925 use dc_trace, only: dbgmessage
8926 use dc_url, only: url_chop_iorange, gt_equal
8927 use dc_present, only: present_and_true
8928 implicit none
8929 character(*), intent(in):: file, varname
8930 real(SP), intent(in):: time
8931 logical, intent(in), optional:: quiet
8932 real(SP), pointer :: array(:,:,:,:,:,:,:)
8933 logical, intent(in), optional:: flag_mpi_split
8934 real(DP), intent(out), optional:: returned_time
8935 logical, intent(out), optional:: flag_time_exist
8936 logical, intent(out), optional:: err
8937 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
8938 character(STRING), pointer:: carray (:)
8939 character(STRING):: tname
8940 interface
8941 subroutine historygetreal7pointer(&
8942 & file, varname, array, range, quiet, &
8943 & flag_mpi_split, returned_time, flag_time_exist, err)
8944 use dc_types, only: dp, sp
8945 character(*), intent(in):: file
8946 character(*), intent(in):: varname
8947 character(*), intent(in), optional:: range
8948 logical, intent(in), optional:: quiet
8949 logical, intent(in), optional:: flag_mpi_split
8950 real(DP), intent(out), optional:: returned_time
8951 logical, intent(out), optional:: flag_time_exist
8952 logical, intent(out), optional:: err
8953 real(SP), pointer :: array(:,:,:,:,:,:,:)
8954 end subroutine historygetreal7pointer
8955 end interface
8956 interface
8957 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
8958 character(*), intent(in):: file
8959 character(*), intent(in):: varname
8960 character(*), intent(out):: url
8961 character(*), intent(in), optional:: range
8962 logical, intent(out), optional:: flag_time_exist
8963 character(*), intent(out), optional:: time_name
8964 logical, intent(out), optional:: err
8965 end subroutine lookup_growable_url
8966 end interface
8967 interface
8968 function file_rename_mpi( file ) result(result)
8969 use dc_types, only: string
8970 character(*), intent(in):: file
8971 character(STRING):: result
8972 end function file_rename_mpi
8973 end interface
8974 continue
8975 file_work = file
8976 if ( present_and_true( flag_mpi_split ) ) &
8977 & file_work = file_rename_mpi( file_work )
8978 call lookup_growable_url(file = file_work, varname = varname, &
8979 & url = url, &
8980 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
8981 call url_chop_iorange( &
8982 & fullname = url, iorange = iorange, remainder = remainder )
8983 call split( str = iorange, carray = carray, sep = gt_equal )
8984 timevar_name = carray(1)
8985 deallocate( carray )
8986 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
8987 call historygetreal7pointer( file = file, &
8988 & varname = varname, array = array, &
8989 & range = time_range, quiet = quiet, &
8990 & flag_mpi_split = flag_mpi_split, &
8991 & returned_time = returned_time, &
8992 & flag_time_exist = flag_time_exist, &
8993 & err = err )
8994end subroutine historygetreal7pointertimer
8996 & file, varname, array, time, &
8997 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
8998 use dc_string, only: tochar, split
8999 use dc_types, only: string, dp, sp
9000 use dc_trace, only: dbgmessage
9001 use dc_url, only: url_chop_iorange, gt_equal
9002 use dc_present, only: present_and_true
9003 implicit none
9004 character(*), intent(in):: file, varname
9005 real(SP), intent(in):: time
9006 logical, intent(in), optional:: quiet
9007 integer, intent(out) :: array
9008 logical, intent(in), optional:: flag_mpi_split
9009 real(DP), intent(out), optional:: returned_time
9010 logical, intent(out), optional:: flag_time_exist
9011 logical, intent(out), optional:: err
9012 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9013 character(STRING), pointer:: carray (:)
9014 character(STRING):: tname
9015 interface
9016 subroutine historygetint0(&
9017 & file, varname, array, range, quiet, &
9018 & flag_mpi_split, returned_time, flag_time_exist, err)
9019 use dc_types, only: dp
9020 character(*), intent(in):: file
9021 character(*), intent(in):: varname
9022 character(*), intent(in), optional:: range
9023 logical, intent(in), optional:: quiet
9024 logical, intent(in), optional:: flag_mpi_split
9025 real(DP), intent(out), optional:: returned_time
9026 logical, intent(out), optional:: flag_time_exist
9027 logical, intent(out), optional:: err
9028 integer, intent(out) :: array
9029 end subroutine historygetint0
9030 end interface
9031 interface
9032 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9033 character(*), intent(in):: file
9034 character(*), intent(in):: varname
9035 character(*), intent(out):: url
9036 character(*), intent(in), optional:: range
9037 logical, intent(out), optional:: flag_time_exist
9038 character(*), intent(out), optional:: time_name
9039 logical, intent(out), optional:: err
9040 end subroutine lookup_growable_url
9041 end interface
9042 interface
9043 function file_rename_mpi( file ) result(result)
9044 use dc_types, only: string
9045 character(*), intent(in):: file
9046 character(STRING):: result
9047 end function file_rename_mpi
9048 end interface
9049 continue
9050 file_work = file
9051 if ( present_and_true( flag_mpi_split ) ) &
9052 & file_work = file_rename_mpi( file_work )
9053 call lookup_growable_url(file = file_work, varname = varname, &
9054 & url = url, &
9055 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9056 call url_chop_iorange( &
9057 & fullname = url, iorange = iorange, remainder = remainder )
9058 call split( str = iorange, carray = carray, sep = gt_equal )
9059 timevar_name = carray(1)
9060 deallocate( carray )
9061 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9062 call historygetint0( file = file, &
9063 & varname = varname, array = array, &
9064 & range = time_range, quiet = quiet, &
9065 & flag_mpi_split = flag_mpi_split, &
9066 & returned_time = returned_time, &
9067 & flag_time_exist = flag_time_exist, &
9068 & err = err )
9069end subroutine historygetint0timer
9071 & file, varname, array, time, &
9072 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9073 use dc_string, only: tochar, split
9074 use dc_types, only: string, dp, sp
9075 use dc_trace, only: dbgmessage
9076 use dc_url, only: url_chop_iorange, gt_equal
9077 use dc_present, only: present_and_true
9078 implicit none
9079 character(*), intent(in):: file, varname
9080 real(SP), intent(in):: time
9081 logical, intent(in), optional:: quiet
9082 integer, intent(out) :: array(:)
9083 logical, intent(in), optional:: flag_mpi_split
9084 real(DP), intent(out), optional:: returned_time
9085 logical, intent(out), optional:: flag_time_exist
9086 logical, intent(out), optional:: err
9087 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9088 character(STRING), pointer:: carray (:)
9089 character(STRING):: tname
9090 interface
9091 subroutine historygetint1(&
9092 & file, varname, array, range, quiet, &
9093 & flag_mpi_split, returned_time, flag_time_exist, err)
9094 use dc_types, only: dp
9095 character(*), intent(in):: file
9096 character(*), intent(in):: varname
9097 character(*), intent(in), optional:: range
9098 logical, intent(in), optional:: quiet
9099 logical, intent(in), optional:: flag_mpi_split
9100 real(DP), intent(out), optional:: returned_time
9101 logical, intent(out), optional:: flag_time_exist
9102 logical, intent(out), optional:: err
9103 integer, intent(out) :: array(:)
9104 end subroutine historygetint1
9105 end interface
9106 interface
9107 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9108 character(*), intent(in):: file
9109 character(*), intent(in):: varname
9110 character(*), intent(out):: url
9111 character(*), intent(in), optional:: range
9112 logical, intent(out), optional:: flag_time_exist
9113 character(*), intent(out), optional:: time_name
9114 logical, intent(out), optional:: err
9115 end subroutine lookup_growable_url
9116 end interface
9117 interface
9118 function file_rename_mpi( file ) result(result)
9119 use dc_types, only: string
9120 character(*), intent(in):: file
9121 character(STRING):: result
9122 end function file_rename_mpi
9123 end interface
9124 continue
9125 file_work = file
9126 if ( present_and_true( flag_mpi_split ) ) &
9127 & file_work = file_rename_mpi( file_work )
9128 call lookup_growable_url(file = file_work, varname = varname, &
9129 & url = url, &
9130 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9131 call url_chop_iorange( &
9132 & fullname = url, iorange = iorange, remainder = remainder )
9133 call split( str = iorange, carray = carray, sep = gt_equal )
9134 timevar_name = carray(1)
9135 deallocate( carray )
9136 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9137 call historygetint1( file = file, &
9138 & varname = varname, array = array, &
9139 & range = time_range, quiet = quiet, &
9140 & flag_mpi_split = flag_mpi_split, &
9141 & returned_time = returned_time, &
9142 & flag_time_exist = flag_time_exist, &
9143 & err = err )
9144end subroutine historygetint1timer
9146 & file, varname, array, time, &
9147 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9148 use dc_string, only: tochar, split
9149 use dc_types, only: string, dp, sp
9150 use dc_trace, only: dbgmessage
9151 use dc_url, only: url_chop_iorange, gt_equal
9152 use dc_present, only: present_and_true
9153 implicit none
9154 character(*), intent(in):: file, varname
9155 real(SP), intent(in):: time
9156 logical, intent(in), optional:: quiet
9157 integer, intent(out) :: array(:,:)
9158 logical, intent(in), optional:: flag_mpi_split
9159 real(DP), intent(out), optional:: returned_time
9160 logical, intent(out), optional:: flag_time_exist
9161 logical, intent(out), optional:: err
9162 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9163 character(STRING), pointer:: carray (:)
9164 character(STRING):: tname
9165 interface
9166 subroutine historygetint2(&
9167 & file, varname, array, range, quiet, &
9168 & flag_mpi_split, returned_time, flag_time_exist, err)
9169 use dc_types, only: dp
9170 character(*), intent(in):: file
9171 character(*), intent(in):: varname
9172 character(*), intent(in), optional:: range
9173 logical, intent(in), optional:: quiet
9174 logical, intent(in), optional:: flag_mpi_split
9175 real(DP), intent(out), optional:: returned_time
9176 logical, intent(out), optional:: flag_time_exist
9177 logical, intent(out), optional:: err
9178 integer, intent(out) :: array(:,:)
9179 end subroutine historygetint2
9180 end interface
9181 interface
9182 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9183 character(*), intent(in):: file
9184 character(*), intent(in):: varname
9185 character(*), intent(out):: url
9186 character(*), intent(in), optional:: range
9187 logical, intent(out), optional:: flag_time_exist
9188 character(*), intent(out), optional:: time_name
9189 logical, intent(out), optional:: err
9190 end subroutine lookup_growable_url
9191 end interface
9192 interface
9193 function file_rename_mpi( file ) result(result)
9194 use dc_types, only: string
9195 character(*), intent(in):: file
9196 character(STRING):: result
9197 end function file_rename_mpi
9198 end interface
9199 continue
9200 file_work = file
9201 if ( present_and_true( flag_mpi_split ) ) &
9202 & file_work = file_rename_mpi( file_work )
9203 call lookup_growable_url(file = file_work, varname = varname, &
9204 & url = url, &
9205 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9206 call url_chop_iorange( &
9207 & fullname = url, iorange = iorange, remainder = remainder )
9208 call split( str = iorange, carray = carray, sep = gt_equal )
9209 timevar_name = carray(1)
9210 deallocate( carray )
9211 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9212 call historygetint2( file = file, &
9213 & varname = varname, array = array, &
9214 & range = time_range, quiet = quiet, &
9215 & flag_mpi_split = flag_mpi_split, &
9216 & returned_time = returned_time, &
9217 & flag_time_exist = flag_time_exist, &
9218 & err = err )
9219end subroutine historygetint2timer
9221 & file, varname, array, time, &
9222 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9223 use dc_string, only: tochar, split
9224 use dc_types, only: string, dp, sp
9225 use dc_trace, only: dbgmessage
9226 use dc_url, only: url_chop_iorange, gt_equal
9227 use dc_present, only: present_and_true
9228 implicit none
9229 character(*), intent(in):: file, varname
9230 real(SP), intent(in):: time
9231 logical, intent(in), optional:: quiet
9232 integer, intent(out) :: array(:,:,:)
9233 logical, intent(in), optional:: flag_mpi_split
9234 real(DP), intent(out), optional:: returned_time
9235 logical, intent(out), optional:: flag_time_exist
9236 logical, intent(out), optional:: err
9237 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9238 character(STRING), pointer:: carray (:)
9239 character(STRING):: tname
9240 interface
9241 subroutine historygetint3(&
9242 & file, varname, array, range, quiet, &
9243 & flag_mpi_split, returned_time, flag_time_exist, err)
9244 use dc_types, only: dp
9245 character(*), intent(in):: file
9246 character(*), intent(in):: varname
9247 character(*), intent(in), optional:: range
9248 logical, intent(in), optional:: quiet
9249 logical, intent(in), optional:: flag_mpi_split
9250 real(DP), intent(out), optional:: returned_time
9251 logical, intent(out), optional:: flag_time_exist
9252 logical, intent(out), optional:: err
9253 integer, intent(out) :: array(:,:,:)
9254 end subroutine historygetint3
9255 end interface
9256 interface
9257 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9258 character(*), intent(in):: file
9259 character(*), intent(in):: varname
9260 character(*), intent(out):: url
9261 character(*), intent(in), optional:: range
9262 logical, intent(out), optional:: flag_time_exist
9263 character(*), intent(out), optional:: time_name
9264 logical, intent(out), optional:: err
9265 end subroutine lookup_growable_url
9266 end interface
9267 interface
9268 function file_rename_mpi( file ) result(result)
9269 use dc_types, only: string
9270 character(*), intent(in):: file
9271 character(STRING):: result
9272 end function file_rename_mpi
9273 end interface
9274 continue
9275 file_work = file
9276 if ( present_and_true( flag_mpi_split ) ) &
9277 & file_work = file_rename_mpi( file_work )
9278 call lookup_growable_url(file = file_work, varname = varname, &
9279 & url = url, &
9280 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9281 call url_chop_iorange( &
9282 & fullname = url, iorange = iorange, remainder = remainder )
9283 call split( str = iorange, carray = carray, sep = gt_equal )
9284 timevar_name = carray(1)
9285 deallocate( carray )
9286 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9287 call historygetint3( file = file, &
9288 & varname = varname, array = array, &
9289 & range = time_range, quiet = quiet, &
9290 & flag_mpi_split = flag_mpi_split, &
9291 & returned_time = returned_time, &
9292 & flag_time_exist = flag_time_exist, &
9293 & err = err )
9294end subroutine historygetint3timer
9296 & file, varname, array, time, &
9297 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9298 use dc_string, only: tochar, split
9299 use dc_types, only: string, dp, sp
9300 use dc_trace, only: dbgmessage
9301 use dc_url, only: url_chop_iorange, gt_equal
9302 use dc_present, only: present_and_true
9303 implicit none
9304 character(*), intent(in):: file, varname
9305 real(SP), intent(in):: time
9306 logical, intent(in), optional:: quiet
9307 integer, intent(out) :: array(:,:,:,:)
9308 logical, intent(in), optional:: flag_mpi_split
9309 real(DP), intent(out), optional:: returned_time
9310 logical, intent(out), optional:: flag_time_exist
9311 logical, intent(out), optional:: err
9312 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9313 character(STRING), pointer:: carray (:)
9314 character(STRING):: tname
9315 interface
9316 subroutine historygetint4(&
9317 & file, varname, array, range, quiet, &
9318 & flag_mpi_split, returned_time, flag_time_exist, err)
9319 use dc_types, only: dp
9320 character(*), intent(in):: file
9321 character(*), intent(in):: varname
9322 character(*), intent(in), optional:: range
9323 logical, intent(in), optional:: quiet
9324 logical, intent(in), optional:: flag_mpi_split
9325 real(DP), intent(out), optional:: returned_time
9326 logical, intent(out), optional:: flag_time_exist
9327 logical, intent(out), optional:: err
9328 integer, intent(out) :: array(:,:,:,:)
9329 end subroutine historygetint4
9330 end interface
9331 interface
9332 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9333 character(*), intent(in):: file
9334 character(*), intent(in):: varname
9335 character(*), intent(out):: url
9336 character(*), intent(in), optional:: range
9337 logical, intent(out), optional:: flag_time_exist
9338 character(*), intent(out), optional:: time_name
9339 logical, intent(out), optional:: err
9340 end subroutine lookup_growable_url
9341 end interface
9342 interface
9343 function file_rename_mpi( file ) result(result)
9344 use dc_types, only: string
9345 character(*), intent(in):: file
9346 character(STRING):: result
9347 end function file_rename_mpi
9348 end interface
9349 continue
9350 file_work = file
9351 if ( present_and_true( flag_mpi_split ) ) &
9352 & file_work = file_rename_mpi( file_work )
9353 call lookup_growable_url(file = file_work, varname = varname, &
9354 & url = url, &
9355 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9356 call url_chop_iorange( &
9357 & fullname = url, iorange = iorange, remainder = remainder )
9358 call split( str = iorange, carray = carray, sep = gt_equal )
9359 timevar_name = carray(1)
9360 deallocate( carray )
9361 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9362 call historygetint4( file = file, &
9363 & varname = varname, array = array, &
9364 & range = time_range, quiet = quiet, &
9365 & flag_mpi_split = flag_mpi_split, &
9366 & returned_time = returned_time, &
9367 & flag_time_exist = flag_time_exist, &
9368 & err = err )
9369end subroutine historygetint4timer
9371 & file, varname, array, time, &
9372 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9373 use dc_string, only: tochar, split
9374 use dc_types, only: string, dp, sp
9375 use dc_trace, only: dbgmessage
9376 use dc_url, only: url_chop_iorange, gt_equal
9377 use dc_present, only: present_and_true
9378 implicit none
9379 character(*), intent(in):: file, varname
9380 real(SP), intent(in):: time
9381 logical, intent(in), optional:: quiet
9382 integer, intent(out) :: array(:,:,:,:,:)
9383 logical, intent(in), optional:: flag_mpi_split
9384 real(DP), intent(out), optional:: returned_time
9385 logical, intent(out), optional:: flag_time_exist
9386 logical, intent(out), optional:: err
9387 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9388 character(STRING), pointer:: carray (:)
9389 character(STRING):: tname
9390 interface
9391 subroutine historygetint5(&
9392 & file, varname, array, range, quiet, &
9393 & flag_mpi_split, returned_time, flag_time_exist, err)
9394 use dc_types, only: dp
9395 character(*), intent(in):: file
9396 character(*), intent(in):: varname
9397 character(*), intent(in), optional:: range
9398 logical, intent(in), optional:: quiet
9399 logical, intent(in), optional:: flag_mpi_split
9400 real(DP), intent(out), optional:: returned_time
9401 logical, intent(out), optional:: flag_time_exist
9402 logical, intent(out), optional:: err
9403 integer, intent(out) :: array(:,:,:,:,:)
9404 end subroutine historygetint5
9405 end interface
9406 interface
9407 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9408 character(*), intent(in):: file
9409 character(*), intent(in):: varname
9410 character(*), intent(out):: url
9411 character(*), intent(in), optional:: range
9412 logical, intent(out), optional:: flag_time_exist
9413 character(*), intent(out), optional:: time_name
9414 logical, intent(out), optional:: err
9415 end subroutine lookup_growable_url
9416 end interface
9417 interface
9418 function file_rename_mpi( file ) result(result)
9419 use dc_types, only: string
9420 character(*), intent(in):: file
9421 character(STRING):: result
9422 end function file_rename_mpi
9423 end interface
9424 continue
9425 file_work = file
9426 if ( present_and_true( flag_mpi_split ) ) &
9427 & file_work = file_rename_mpi( file_work )
9428 call lookup_growable_url(file = file_work, varname = varname, &
9429 & url = url, &
9430 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9431 call url_chop_iorange( &
9432 & fullname = url, iorange = iorange, remainder = remainder )
9433 call split( str = iorange, carray = carray, sep = gt_equal )
9434 timevar_name = carray(1)
9435 deallocate( carray )
9436 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9437 call historygetint5( file = file, &
9438 & varname = varname, array = array, &
9439 & range = time_range, quiet = quiet, &
9440 & flag_mpi_split = flag_mpi_split, &
9441 & returned_time = returned_time, &
9442 & flag_time_exist = flag_time_exist, &
9443 & err = err )
9444end subroutine historygetint5timer
9446 & file, varname, array, time, &
9447 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9448 use dc_string, only: tochar, split
9449 use dc_types, only: string, dp, sp
9450 use dc_trace, only: dbgmessage
9451 use dc_url, only: url_chop_iorange, gt_equal
9452 use dc_present, only: present_and_true
9453 implicit none
9454 character(*), intent(in):: file, varname
9455 real(SP), intent(in):: time
9456 logical, intent(in), optional:: quiet
9457 integer, intent(out) :: array(:,:,:,:,:,:)
9458 logical, intent(in), optional:: flag_mpi_split
9459 real(DP), intent(out), optional:: returned_time
9460 logical, intent(out), optional:: flag_time_exist
9461 logical, intent(out), optional:: err
9462 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9463 character(STRING), pointer:: carray (:)
9464 character(STRING):: tname
9465 interface
9466 subroutine historygetint6(&
9467 & file, varname, array, range, quiet, &
9468 & flag_mpi_split, returned_time, flag_time_exist, err)
9469 use dc_types, only: dp
9470 character(*), intent(in):: file
9471 character(*), intent(in):: varname
9472 character(*), intent(in), optional:: range
9473 logical, intent(in), optional:: quiet
9474 logical, intent(in), optional:: flag_mpi_split
9475 real(DP), intent(out), optional:: returned_time
9476 logical, intent(out), optional:: flag_time_exist
9477 logical, intent(out), optional:: err
9478 integer, intent(out) :: array(:,:,:,:,:,:)
9479 end subroutine historygetint6
9480 end interface
9481 interface
9482 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9483 character(*), intent(in):: file
9484 character(*), intent(in):: varname
9485 character(*), intent(out):: url
9486 character(*), intent(in), optional:: range
9487 logical, intent(out), optional:: flag_time_exist
9488 character(*), intent(out), optional:: time_name
9489 logical, intent(out), optional:: err
9490 end subroutine lookup_growable_url
9491 end interface
9492 interface
9493 function file_rename_mpi( file ) result(result)
9494 use dc_types, only: string
9495 character(*), intent(in):: file
9496 character(STRING):: result
9497 end function file_rename_mpi
9498 end interface
9499 continue
9500 file_work = file
9501 if ( present_and_true( flag_mpi_split ) ) &
9502 & file_work = file_rename_mpi( file_work )
9503 call lookup_growable_url(file = file_work, varname = varname, &
9504 & url = url, &
9505 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9506 call url_chop_iorange( &
9507 & fullname = url, iorange = iorange, remainder = remainder )
9508 call split( str = iorange, carray = carray, sep = gt_equal )
9509 timevar_name = carray(1)
9510 deallocate( carray )
9511 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9512 call historygetint6( file = file, &
9513 & varname = varname, array = array, &
9514 & range = time_range, quiet = quiet, &
9515 & flag_mpi_split = flag_mpi_split, &
9516 & returned_time = returned_time, &
9517 & flag_time_exist = flag_time_exist, &
9518 & err = err )
9519end subroutine historygetint6timer
9521 & file, varname, array, time, &
9522 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9523 use dc_string, only: tochar, split
9524 use dc_types, only: string, dp, sp
9525 use dc_trace, only: dbgmessage
9526 use dc_url, only: url_chop_iorange, gt_equal
9527 use dc_present, only: present_and_true
9528 implicit none
9529 character(*), intent(in):: file, varname
9530 real(SP), intent(in):: time
9531 logical, intent(in), optional:: quiet
9532 integer, intent(out) :: array(:,:,:,:,:,:,:)
9533 logical, intent(in), optional:: flag_mpi_split
9534 real(DP), intent(out), optional:: returned_time
9535 logical, intent(out), optional:: flag_time_exist
9536 logical, intent(out), optional:: err
9537 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9538 character(STRING), pointer:: carray (:)
9539 character(STRING):: tname
9540 interface
9541 subroutine historygetint7(&
9542 & file, varname, array, range, quiet, &
9543 & flag_mpi_split, returned_time, flag_time_exist, err)
9544 use dc_types, only: dp
9545 character(*), intent(in):: file
9546 character(*), intent(in):: varname
9547 character(*), intent(in), optional:: range
9548 logical, intent(in), optional:: quiet
9549 logical, intent(in), optional:: flag_mpi_split
9550 real(DP), intent(out), optional:: returned_time
9551 logical, intent(out), optional:: flag_time_exist
9552 logical, intent(out), optional:: err
9553 integer, intent(out) :: array(:,:,:,:,:,:,:)
9554 end subroutine historygetint7
9555 end interface
9556 interface
9557 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9558 character(*), intent(in):: file
9559 character(*), intent(in):: varname
9560 character(*), intent(out):: url
9561 character(*), intent(in), optional:: range
9562 logical, intent(out), optional:: flag_time_exist
9563 character(*), intent(out), optional:: time_name
9564 logical, intent(out), optional:: err
9565 end subroutine lookup_growable_url
9566 end interface
9567 interface
9568 function file_rename_mpi( file ) result(result)
9569 use dc_types, only: string
9570 character(*), intent(in):: file
9571 character(STRING):: result
9572 end function file_rename_mpi
9573 end interface
9574 continue
9575 file_work = file
9576 if ( present_and_true( flag_mpi_split ) ) &
9577 & file_work = file_rename_mpi( file_work )
9578 call lookup_growable_url(file = file_work, varname = varname, &
9579 & url = url, &
9580 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9581 call url_chop_iorange( &
9582 & fullname = url, iorange = iorange, remainder = remainder )
9583 call split( str = iorange, carray = carray, sep = gt_equal )
9584 timevar_name = carray(1)
9585 deallocate( carray )
9586 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9587 call historygetint7( file = file, &
9588 & varname = varname, array = array, &
9589 & range = time_range, quiet = quiet, &
9590 & flag_mpi_split = flag_mpi_split, &
9591 & returned_time = returned_time, &
9592 & flag_time_exist = flag_time_exist, &
9593 & err = err )
9594end subroutine historygetint7timer
9596 & file, varname, array, time, &
9597 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9598 use dc_string, only: tochar, split
9599 use dc_types, only: string, dp, sp
9600 use dc_trace, only: dbgmessage
9601 use dc_url, only: url_chop_iorange, gt_equal
9602 use dc_present, only: present_and_true
9603 implicit none
9604 character(*), intent(in):: file, varname
9605 real(SP), intent(in):: time
9606 logical, intent(in), optional:: quiet
9607 integer, pointer :: array
9608 logical, intent(in), optional:: flag_mpi_split
9609 real(DP), intent(out), optional:: returned_time
9610 logical, intent(out), optional:: flag_time_exist
9611 logical, intent(out), optional:: err
9612 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9613 character(STRING), pointer:: carray (:)
9614 character(STRING):: tname
9615 interface
9616 subroutine historygetint0pointer(&
9617 & file, varname, array, range, quiet, &
9618 & flag_mpi_split, returned_time, flag_time_exist, err)
9619 use dc_types, only: dp
9620 character(*), intent(in):: file
9621 character(*), intent(in):: varname
9622 character(*), intent(in), optional:: range
9623 logical, intent(in), optional:: quiet
9624 logical, intent(in), optional:: flag_mpi_split
9625 real(DP), intent(out), optional:: returned_time
9626 logical, intent(out), optional:: flag_time_exist
9627 logical, intent(out), optional:: err
9628 integer, pointer :: array
9629 end subroutine historygetint0pointer
9630 end interface
9631 interface
9632 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9633 character(*), intent(in):: file
9634 character(*), intent(in):: varname
9635 character(*), intent(out):: url
9636 character(*), intent(in), optional:: range
9637 logical, intent(out), optional:: flag_time_exist
9638 character(*), intent(out), optional:: time_name
9639 logical, intent(out), optional:: err
9640 end subroutine lookup_growable_url
9641 end interface
9642 interface
9643 function file_rename_mpi( file ) result(result)
9644 use dc_types, only: string
9645 character(*), intent(in):: file
9646 character(STRING):: result
9647 end function file_rename_mpi
9648 end interface
9649 continue
9650 file_work = file
9651 if ( present_and_true( flag_mpi_split ) ) &
9652 & file_work = file_rename_mpi( file_work )
9653 call lookup_growable_url(file = file_work, varname = varname, &
9654 & url = url, &
9655 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9656 call url_chop_iorange( &
9657 & fullname = url, iorange = iorange, remainder = remainder )
9658 call split( str = iorange, carray = carray, sep = gt_equal )
9659 timevar_name = carray(1)
9660 deallocate( carray )
9661 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9662 call historygetint0pointer( file = file, &
9663 & varname = varname, array = array, &
9664 & range = time_range, quiet = quiet, &
9665 & flag_mpi_split = flag_mpi_split, &
9666 & returned_time = returned_time, &
9667 & flag_time_exist = flag_time_exist, &
9668 & err = err )
9669end subroutine historygetint0pointertimer
9671 & file, varname, array, time, &
9672 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9673 use dc_string, only: tochar, split
9674 use dc_types, only: string, dp, sp
9675 use dc_trace, only: dbgmessage
9676 use dc_url, only: url_chop_iorange, gt_equal
9677 use dc_present, only: present_and_true
9678 implicit none
9679 character(*), intent(in):: file, varname
9680 real(SP), intent(in):: time
9681 logical, intent(in), optional:: quiet
9682 integer, pointer :: array(:)
9683 logical, intent(in), optional:: flag_mpi_split
9684 real(DP), intent(out), optional:: returned_time
9685 logical, intent(out), optional:: flag_time_exist
9686 logical, intent(out), optional:: err
9687 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9688 character(STRING), pointer:: carray (:)
9689 character(STRING):: tname
9690 interface
9691 subroutine historygetint1pointer(&
9692 & file, varname, array, range, quiet, &
9693 & flag_mpi_split, returned_time, flag_time_exist, err)
9694 use dc_types, only: dp
9695 character(*), intent(in):: file
9696 character(*), intent(in):: varname
9697 character(*), intent(in), optional:: range
9698 logical, intent(in), optional:: quiet
9699 logical, intent(in), optional:: flag_mpi_split
9700 real(DP), intent(out), optional:: returned_time
9701 logical, intent(out), optional:: flag_time_exist
9702 logical, intent(out), optional:: err
9703 integer, pointer :: array(:)
9704 end subroutine historygetint1pointer
9705 end interface
9706 interface
9707 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9708 character(*), intent(in):: file
9709 character(*), intent(in):: varname
9710 character(*), intent(out):: url
9711 character(*), intent(in), optional:: range
9712 logical, intent(out), optional:: flag_time_exist
9713 character(*), intent(out), optional:: time_name
9714 logical, intent(out), optional:: err
9715 end subroutine lookup_growable_url
9716 end interface
9717 interface
9718 function file_rename_mpi( file ) result(result)
9719 use dc_types, only: string
9720 character(*), intent(in):: file
9721 character(STRING):: result
9722 end function file_rename_mpi
9723 end interface
9724 continue
9725 file_work = file
9726 if ( present_and_true( flag_mpi_split ) ) &
9727 & file_work = file_rename_mpi( file_work )
9728 call lookup_growable_url(file = file_work, varname = varname, &
9729 & url = url, &
9730 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9731 call url_chop_iorange( &
9732 & fullname = url, iorange = iorange, remainder = remainder )
9733 call split( str = iorange, carray = carray, sep = gt_equal )
9734 timevar_name = carray(1)
9735 deallocate( carray )
9736 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9737 call historygetint1pointer( file = file, &
9738 & varname = varname, array = array, &
9739 & range = time_range, quiet = quiet, &
9740 & flag_mpi_split = flag_mpi_split, &
9741 & returned_time = returned_time, &
9742 & flag_time_exist = flag_time_exist, &
9743 & err = err )
9744end subroutine historygetint1pointertimer
9746 & file, varname, array, time, &
9747 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9748 use dc_string, only: tochar, split
9749 use dc_types, only: string, dp, sp
9750 use dc_trace, only: dbgmessage
9751 use dc_url, only: url_chop_iorange, gt_equal
9752 use dc_present, only: present_and_true
9753 implicit none
9754 character(*), intent(in):: file, varname
9755 real(SP), intent(in):: time
9756 logical, intent(in), optional:: quiet
9757 integer, pointer :: array(:,:)
9758 logical, intent(in), optional:: flag_mpi_split
9759 real(DP), intent(out), optional:: returned_time
9760 logical, intent(out), optional:: flag_time_exist
9761 logical, intent(out), optional:: err
9762 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9763 character(STRING), pointer:: carray (:)
9764 character(STRING):: tname
9765 interface
9766 subroutine historygetint2pointer(&
9767 & file, varname, array, range, quiet, &
9768 & flag_mpi_split, returned_time, flag_time_exist, err)
9769 use dc_types, only: dp
9770 character(*), intent(in):: file
9771 character(*), intent(in):: varname
9772 character(*), intent(in), optional:: range
9773 logical, intent(in), optional:: quiet
9774 logical, intent(in), optional:: flag_mpi_split
9775 real(DP), intent(out), optional:: returned_time
9776 logical, intent(out), optional:: flag_time_exist
9777 logical, intent(out), optional:: err
9778 integer, pointer :: array(:,:)
9779 end subroutine historygetint2pointer
9780 end interface
9781 interface
9782 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9783 character(*), intent(in):: file
9784 character(*), intent(in):: varname
9785 character(*), intent(out):: url
9786 character(*), intent(in), optional:: range
9787 logical, intent(out), optional:: flag_time_exist
9788 character(*), intent(out), optional:: time_name
9789 logical, intent(out), optional:: err
9790 end subroutine lookup_growable_url
9791 end interface
9792 interface
9793 function file_rename_mpi( file ) result(result)
9794 use dc_types, only: string
9795 character(*), intent(in):: file
9796 character(STRING):: result
9797 end function file_rename_mpi
9798 end interface
9799 continue
9800 file_work = file
9801 if ( present_and_true( flag_mpi_split ) ) &
9802 & file_work = file_rename_mpi( file_work )
9803 call lookup_growable_url(file = file_work, varname = varname, &
9804 & url = url, &
9805 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9806 call url_chop_iorange( &
9807 & fullname = url, iorange = iorange, remainder = remainder )
9808 call split( str = iorange, carray = carray, sep = gt_equal )
9809 timevar_name = carray(1)
9810 deallocate( carray )
9811 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9812 call historygetint2pointer( file = file, &
9813 & varname = varname, array = array, &
9814 & range = time_range, quiet = quiet, &
9815 & flag_mpi_split = flag_mpi_split, &
9816 & returned_time = returned_time, &
9817 & flag_time_exist = flag_time_exist, &
9818 & err = err )
9819end subroutine historygetint2pointertimer
9821 & file, varname, array, time, &
9822 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9823 use dc_string, only: tochar, split
9824 use dc_types, only: string, dp, sp
9825 use dc_trace, only: dbgmessage
9826 use dc_url, only: url_chop_iorange, gt_equal
9827 use dc_present, only: present_and_true
9828 implicit none
9829 character(*), intent(in):: file, varname
9830 real(SP), intent(in):: time
9831 logical, intent(in), optional:: quiet
9832 integer, pointer :: array(:,:,:)
9833 logical, intent(in), optional:: flag_mpi_split
9834 real(DP), intent(out), optional:: returned_time
9835 logical, intent(out), optional:: flag_time_exist
9836 logical, intent(out), optional:: err
9837 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9838 character(STRING), pointer:: carray (:)
9839 character(STRING):: tname
9840 interface
9841 subroutine historygetint3pointer(&
9842 & file, varname, array, range, quiet, &
9843 & flag_mpi_split, returned_time, flag_time_exist, err)
9844 use dc_types, only: dp
9845 character(*), intent(in):: file
9846 character(*), intent(in):: varname
9847 character(*), intent(in), optional:: range
9848 logical, intent(in), optional:: quiet
9849 logical, intent(in), optional:: flag_mpi_split
9850 real(DP), intent(out), optional:: returned_time
9851 logical, intent(out), optional:: flag_time_exist
9852 logical, intent(out), optional:: err
9853 integer, pointer :: array(:,:,:)
9854 end subroutine historygetint3pointer
9855 end interface
9856 interface
9857 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9858 character(*), intent(in):: file
9859 character(*), intent(in):: varname
9860 character(*), intent(out):: url
9861 character(*), intent(in), optional:: range
9862 logical, intent(out), optional:: flag_time_exist
9863 character(*), intent(out), optional:: time_name
9864 logical, intent(out), optional:: err
9865 end subroutine lookup_growable_url
9866 end interface
9867 interface
9868 function file_rename_mpi( file ) result(result)
9869 use dc_types, only: string
9870 character(*), intent(in):: file
9871 character(STRING):: result
9872 end function file_rename_mpi
9873 end interface
9874 continue
9875 file_work = file
9876 if ( present_and_true( flag_mpi_split ) ) &
9877 & file_work = file_rename_mpi( file_work )
9878 call lookup_growable_url(file = file_work, varname = varname, &
9879 & url = url, &
9880 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9881 call url_chop_iorange( &
9882 & fullname = url, iorange = iorange, remainder = remainder )
9883 call split( str = iorange, carray = carray, sep = gt_equal )
9884 timevar_name = carray(1)
9885 deallocate( carray )
9886 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9887 call historygetint3pointer( file = file, &
9888 & varname = varname, array = array, &
9889 & range = time_range, quiet = quiet, &
9890 & flag_mpi_split = flag_mpi_split, &
9891 & returned_time = returned_time, &
9892 & flag_time_exist = flag_time_exist, &
9893 & err = err )
9894end subroutine historygetint3pointertimer
9896 & file, varname, array, time, &
9897 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9898 use dc_string, only: tochar, split
9899 use dc_types, only: string, dp, sp
9900 use dc_trace, only: dbgmessage
9901 use dc_url, only: url_chop_iorange, gt_equal
9902 use dc_present, only: present_and_true
9903 implicit none
9904 character(*), intent(in):: file, varname
9905 real(SP), intent(in):: time
9906 logical, intent(in), optional:: quiet
9907 integer, pointer :: array(:,:,:,:)
9908 logical, intent(in), optional:: flag_mpi_split
9909 real(DP), intent(out), optional:: returned_time
9910 logical, intent(out), optional:: flag_time_exist
9911 logical, intent(out), optional:: err
9912 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9913 character(STRING), pointer:: carray (:)
9914 character(STRING):: tname
9915 interface
9916 subroutine historygetint4pointer(&
9917 & file, varname, array, range, quiet, &
9918 & flag_mpi_split, returned_time, flag_time_exist, err)
9919 use dc_types, only: dp
9920 character(*), intent(in):: file
9921 character(*), intent(in):: varname
9922 character(*), intent(in), optional:: range
9923 logical, intent(in), optional:: quiet
9924 logical, intent(in), optional:: flag_mpi_split
9925 real(DP), intent(out), optional:: returned_time
9926 logical, intent(out), optional:: flag_time_exist
9927 logical, intent(out), optional:: err
9928 integer, pointer :: array(:,:,:,:)
9929 end subroutine historygetint4pointer
9930 end interface
9931 interface
9932 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
9933 character(*), intent(in):: file
9934 character(*), intent(in):: varname
9935 character(*), intent(out):: url
9936 character(*), intent(in), optional:: range
9937 logical, intent(out), optional:: flag_time_exist
9938 character(*), intent(out), optional:: time_name
9939 logical, intent(out), optional:: err
9940 end subroutine lookup_growable_url
9941 end interface
9942 interface
9943 function file_rename_mpi( file ) result(result)
9944 use dc_types, only: string
9945 character(*), intent(in):: file
9946 character(STRING):: result
9947 end function file_rename_mpi
9948 end interface
9949 continue
9950 file_work = file
9951 if ( present_and_true( flag_mpi_split ) ) &
9952 & file_work = file_rename_mpi( file_work )
9953 call lookup_growable_url(file = file_work, varname = varname, &
9954 & url = url, &
9955 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
9956 call url_chop_iorange( &
9957 & fullname = url, iorange = iorange, remainder = remainder )
9958 call split( str = iorange, carray = carray, sep = gt_equal )
9959 timevar_name = carray(1)
9960 deallocate( carray )
9961 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
9962 call historygetint4pointer( file = file, &
9963 & varname = varname, array = array, &
9964 & range = time_range, quiet = quiet, &
9965 & flag_mpi_split = flag_mpi_split, &
9966 & returned_time = returned_time, &
9967 & flag_time_exist = flag_time_exist, &
9968 & err = err )
9969end subroutine historygetint4pointertimer
9971 & file, varname, array, time, &
9972 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
9973 use dc_string, only: tochar, split
9974 use dc_types, only: string, dp, sp
9975 use dc_trace, only: dbgmessage
9976 use dc_url, only: url_chop_iorange, gt_equal
9977 use dc_present, only: present_and_true
9978 implicit none
9979 character(*), intent(in):: file, varname
9980 real(SP), intent(in):: time
9981 logical, intent(in), optional:: quiet
9982 integer, pointer :: array(:,:,:,:,:)
9983 logical, intent(in), optional:: flag_mpi_split
9984 real(DP), intent(out), optional:: returned_time
9985 logical, intent(out), optional:: flag_time_exist
9986 logical, intent(out), optional:: err
9987 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
9988 character(STRING), pointer:: carray (:)
9989 character(STRING):: tname
9990 interface
9991 subroutine historygetint5pointer(&
9992 & file, varname, array, range, quiet, &
9993 & flag_mpi_split, returned_time, flag_time_exist, err)
9994 use dc_types, only: dp
9995 character(*), intent(in):: file
9996 character(*), intent(in):: varname
9997 character(*), intent(in), optional:: range
9998 logical, intent(in), optional:: quiet
9999 logical, intent(in), optional:: flag_mpi_split
10000 real(DP), intent(out), optional:: returned_time
10001 logical, intent(out), optional:: flag_time_exist
10002 logical, intent(out), optional:: err
10003 integer, pointer :: array(:,:,:,:,:)
10004 end subroutine historygetint5pointer
10005 end interface
10006 interface
10007 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10008 character(*), intent(in):: file
10009 character(*), intent(in):: varname
10010 character(*), intent(out):: url
10011 character(*), intent(in), optional:: range
10012 logical, intent(out), optional:: flag_time_exist
10013 character(*), intent(out), optional:: time_name
10014 logical, intent(out), optional:: err
10015 end subroutine lookup_growable_url
10016 end interface
10017 interface
10018 function file_rename_mpi( file ) result(result)
10019 use dc_types, only: string
10020 character(*), intent(in):: file
10021 character(STRING):: result
10022 end function file_rename_mpi
10023 end interface
10024 continue
10025 file_work = file
10026 if ( present_and_true( flag_mpi_split ) ) &
10027 & file_work = file_rename_mpi( file_work )
10028 call lookup_growable_url(file = file_work, varname = varname, &
10029 & url = url, &
10030 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10031 call url_chop_iorange( &
10032 & fullname = url, iorange = iorange, remainder = remainder )
10033 call split( str = iorange, carray = carray, sep = gt_equal )
10034 timevar_name = carray(1)
10035 deallocate( carray )
10036 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10037 call historygetint5pointer( file = file, &
10038 & varname = varname, array = array, &
10039 & range = time_range, quiet = quiet, &
10040 & flag_mpi_split = flag_mpi_split, &
10041 & returned_time = returned_time, &
10042 & flag_time_exist = flag_time_exist, &
10043 & err = err )
10044end subroutine historygetint5pointertimer
10046 & file, varname, array, time, &
10047 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10048 use dc_string, only: tochar, split
10049 use dc_types, only: string, dp, sp
10050 use dc_trace, only: dbgmessage
10051 use dc_url, only: url_chop_iorange, gt_equal
10052 use dc_present, only: present_and_true
10053 implicit none
10054 character(*), intent(in):: file, varname
10055 real(SP), intent(in):: time
10056 logical, intent(in), optional:: quiet
10057 integer, pointer :: array(:,:,:,:,:,:)
10058 logical, intent(in), optional:: flag_mpi_split
10059 real(DP), intent(out), optional:: returned_time
10060 logical, intent(out), optional:: flag_time_exist
10061 logical, intent(out), optional:: err
10062 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10063 character(STRING), pointer:: carray (:)
10064 character(STRING):: tname
10065 interface
10066 subroutine historygetint6pointer(&
10067 & file, varname, array, range, quiet, &
10068 & flag_mpi_split, returned_time, flag_time_exist, err)
10069 use dc_types, only: dp
10070 character(*), intent(in):: file
10071 character(*), intent(in):: varname
10072 character(*), intent(in), optional:: range
10073 logical, intent(in), optional:: quiet
10074 logical, intent(in), optional:: flag_mpi_split
10075 real(DP), intent(out), optional:: returned_time
10076 logical, intent(out), optional:: flag_time_exist
10077 logical, intent(out), optional:: err
10078 integer, pointer :: array(:,:,:,:,:,:)
10079 end subroutine historygetint6pointer
10080 end interface
10081 interface
10082 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10083 character(*), intent(in):: file
10084 character(*), intent(in):: varname
10085 character(*), intent(out):: url
10086 character(*), intent(in), optional:: range
10087 logical, intent(out), optional:: flag_time_exist
10088 character(*), intent(out), optional:: time_name
10089 logical, intent(out), optional:: err
10090 end subroutine lookup_growable_url
10091 end interface
10092 interface
10093 function file_rename_mpi( file ) result(result)
10094 use dc_types, only: string
10095 character(*), intent(in):: file
10096 character(STRING):: result
10097 end function file_rename_mpi
10098 end interface
10099 continue
10100 file_work = file
10101 if ( present_and_true( flag_mpi_split ) ) &
10102 & file_work = file_rename_mpi( file_work )
10103 call lookup_growable_url(file = file_work, varname = varname, &
10104 & url = url, &
10105 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10106 call url_chop_iorange( &
10107 & fullname = url, iorange = iorange, remainder = remainder )
10108 call split( str = iorange, carray = carray, sep = gt_equal )
10109 timevar_name = carray(1)
10110 deallocate( carray )
10111 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10112 call historygetint6pointer( file = file, &
10113 & varname = varname, array = array, &
10114 & range = time_range, quiet = quiet, &
10115 & flag_mpi_split = flag_mpi_split, &
10116 & returned_time = returned_time, &
10117 & flag_time_exist = flag_time_exist, &
10118 & err = err )
10119end subroutine historygetint6pointertimer
10121 & file, varname, array, time, &
10122 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10123 use dc_string, only: tochar, split
10124 use dc_types, only: string, dp, sp
10125 use dc_trace, only: dbgmessage
10126 use dc_url, only: url_chop_iorange, gt_equal
10127 use dc_present, only: present_and_true
10128 implicit none
10129 character(*), intent(in):: file, varname
10130 real(SP), intent(in):: time
10131 logical, intent(in), optional:: quiet
10132 integer, pointer :: array(:,:,:,:,:,:,:)
10133 logical, intent(in), optional:: flag_mpi_split
10134 real(DP), intent(out), optional:: returned_time
10135 logical, intent(out), optional:: flag_time_exist
10136 logical, intent(out), optional:: err
10137 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10138 character(STRING), pointer:: carray (:)
10139 character(STRING):: tname
10140 interface
10141 subroutine historygetint7pointer(&
10142 & file, varname, array, range, quiet, &
10143 & flag_mpi_split, returned_time, flag_time_exist, err)
10144 use dc_types, only: dp
10145 character(*), intent(in):: file
10146 character(*), intent(in):: varname
10147 character(*), intent(in), optional:: range
10148 logical, intent(in), optional:: quiet
10149 logical, intent(in), optional:: flag_mpi_split
10150 real(DP), intent(out), optional:: returned_time
10151 logical, intent(out), optional:: flag_time_exist
10152 logical, intent(out), optional:: err
10153 integer, pointer :: array(:,:,:,:,:,:,:)
10154 end subroutine historygetint7pointer
10155 end interface
10156 interface
10157 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10158 character(*), intent(in):: file
10159 character(*), intent(in):: varname
10160 character(*), intent(out):: url
10161 character(*), intent(in), optional:: range
10162 logical, intent(out), optional:: flag_time_exist
10163 character(*), intent(out), optional:: time_name
10164 logical, intent(out), optional:: err
10165 end subroutine lookup_growable_url
10166 end interface
10167 interface
10168 function file_rename_mpi( file ) result(result)
10169 use dc_types, only: string
10170 character(*), intent(in):: file
10171 character(STRING):: result
10172 end function file_rename_mpi
10173 end interface
10174 continue
10175 file_work = file
10176 if ( present_and_true( flag_mpi_split ) ) &
10177 & file_work = file_rename_mpi( file_work )
10178 call lookup_growable_url(file = file_work, varname = varname, &
10179 & url = url, &
10180 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10181 call url_chop_iorange( &
10182 & fullname = url, iorange = iorange, remainder = remainder )
10183 call split( str = iorange, carray = carray, sep = gt_equal )
10184 timevar_name = carray(1)
10185 deallocate( carray )
10186 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10187 call historygetint7pointer( file = file, &
10188 & varname = varname, array = array, &
10189 & range = time_range, quiet = quiet, &
10190 & flag_mpi_split = flag_mpi_split, &
10191 & returned_time = returned_time, &
10192 & flag_time_exist = flag_time_exist, &
10193 & err = err )
10194end subroutine historygetint7pointertimer
10196 & file, varname, array, time, &
10197 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10198 use dc_string, only: tochar, split
10199 use dc_types, only: string, dp
10200 use dc_trace, only: dbgmessage
10201 use dc_url, only: url_chop_iorange, gt_equal
10202 use dc_present, only: present_and_true
10203 implicit none
10204 character(*), intent(in):: file, varname
10205 real(DP), intent(in):: time
10206 logical, intent(in), optional:: quiet
10207 real(DP), intent(out) :: array
10208 logical, intent(in), optional:: flag_mpi_split
10209 real(DP), intent(out), optional:: returned_time
10210 logical, intent(out), optional:: flag_time_exist
10211 logical, intent(out), optional:: err
10212 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10213 character(STRING), pointer:: carray (:)
10214 character(STRING):: tname
10215 interface
10216 subroutine historygetdouble0(&
10217 & file, varname, array, range, quiet, &
10218 & flag_mpi_split, returned_time, flag_time_exist, err)
10219 use dc_types, only: dp
10220 character(*), intent(in):: file
10221 character(*), intent(in):: varname
10222 character(*), intent(in), optional:: range
10223 logical, intent(in), optional:: quiet
10224 logical, intent(in), optional:: flag_mpi_split
10225 real(DP), intent(out), optional:: returned_time
10226 logical, intent(out), optional:: flag_time_exist
10227 logical, intent(out), optional:: err
10228 real(DP), intent(out) :: array
10229 end subroutine historygetdouble0
10230 end interface
10231 interface
10232 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10233 character(*), intent(in):: file
10234 character(*), intent(in):: varname
10235 character(*), intent(out):: url
10236 character(*), intent(in), optional:: range
10237 logical, intent(out), optional:: flag_time_exist
10238 character(*), intent(out), optional:: time_name
10239 logical, intent(out), optional:: err
10240 end subroutine lookup_growable_url
10241 end interface
10242 interface
10243 function file_rename_mpi( file ) result(result)
10244 use dc_types, only: string
10245 character(*), intent(in):: file
10246 character(STRING):: result
10247 end function file_rename_mpi
10248 end interface
10249 continue
10250 file_work = file
10251 if ( present_and_true( flag_mpi_split ) ) &
10252 & file_work = file_rename_mpi( file_work )
10253 call lookup_growable_url(file = file_work, varname = varname, &
10254 & url = url, &
10255 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10256 call url_chop_iorange( &
10257 & fullname = url, iorange = iorange, remainder = remainder )
10258 call split( str = iorange, carray = carray, sep = gt_equal )
10259 timevar_name = carray(1)
10260 deallocate( carray )
10261 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10262 call historygetdouble0( file = file, &
10263 & varname = varname, array = array, &
10264 & range = time_range, quiet = quiet, &
10265 & flag_mpi_split = flag_mpi_split, &
10266 & returned_time = returned_time, &
10267 & flag_time_exist = flag_time_exist, &
10268 & err = err )
10269end subroutine historygetdouble0timed
10271 & file, varname, array, time, &
10272 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10273 use dc_string, only: tochar, split
10274 use dc_types, only: string, dp
10275 use dc_trace, only: dbgmessage
10276 use dc_url, only: url_chop_iorange, gt_equal
10277 use dc_present, only: present_and_true
10278 implicit none
10279 character(*), intent(in):: file, varname
10280 real(DP), intent(in):: time
10281 logical, intent(in), optional:: quiet
10282 real(DP), intent(out) :: array(:)
10283 logical, intent(in), optional:: flag_mpi_split
10284 real(DP), intent(out), optional:: returned_time
10285 logical, intent(out), optional:: flag_time_exist
10286 logical, intent(out), optional:: err
10287 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10288 character(STRING), pointer:: carray (:)
10289 character(STRING):: tname
10290 interface
10291 subroutine historygetdouble1(&
10292 & file, varname, array, range, quiet, &
10293 & flag_mpi_split, returned_time, flag_time_exist, err)
10294 use dc_types, only: dp
10295 character(*), intent(in):: file
10296 character(*), intent(in):: varname
10297 character(*), intent(in), optional:: range
10298 logical, intent(in), optional:: quiet
10299 logical, intent(in), optional:: flag_mpi_split
10300 real(DP), intent(out), optional:: returned_time
10301 logical, intent(out), optional:: flag_time_exist
10302 logical, intent(out), optional:: err
10303 real(DP), intent(out) :: array(:)
10304 end subroutine historygetdouble1
10305 end interface
10306 interface
10307 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10308 character(*), intent(in):: file
10309 character(*), intent(in):: varname
10310 character(*), intent(out):: url
10311 character(*), intent(in), optional:: range
10312 logical, intent(out), optional:: flag_time_exist
10313 character(*), intent(out), optional:: time_name
10314 logical, intent(out), optional:: err
10315 end subroutine lookup_growable_url
10316 end interface
10317 interface
10318 function file_rename_mpi( file ) result(result)
10319 use dc_types, only: string
10320 character(*), intent(in):: file
10321 character(STRING):: result
10322 end function file_rename_mpi
10323 end interface
10324 continue
10325 file_work = file
10326 if ( present_and_true( flag_mpi_split ) ) &
10327 & file_work = file_rename_mpi( file_work )
10328 call lookup_growable_url(file = file_work, varname = varname, &
10329 & url = url, &
10330 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10331 call url_chop_iorange( &
10332 & fullname = url, iorange = iorange, remainder = remainder )
10333 call split( str = iorange, carray = carray, sep = gt_equal )
10334 timevar_name = carray(1)
10335 deallocate( carray )
10336 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10337 call historygetdouble1( file = file, &
10338 & varname = varname, array = array, &
10339 & range = time_range, quiet = quiet, &
10340 & flag_mpi_split = flag_mpi_split, &
10341 & returned_time = returned_time, &
10342 & flag_time_exist = flag_time_exist, &
10343 & err = err )
10344end subroutine historygetdouble1timed
10346 & file, varname, array, time, &
10347 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10348 use dc_string, only: tochar, split
10349 use dc_types, only: string, dp
10350 use dc_trace, only: dbgmessage
10351 use dc_url, only: url_chop_iorange, gt_equal
10352 use dc_present, only: present_and_true
10353 implicit none
10354 character(*), intent(in):: file, varname
10355 real(DP), intent(in):: time
10356 logical, intent(in), optional:: quiet
10357 real(DP), intent(out) :: array(:,:)
10358 logical, intent(in), optional:: flag_mpi_split
10359 real(DP), intent(out), optional:: returned_time
10360 logical, intent(out), optional:: flag_time_exist
10361 logical, intent(out), optional:: err
10362 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10363 character(STRING), pointer:: carray (:)
10364 character(STRING):: tname
10365 interface
10366 subroutine historygetdouble2(&
10367 & file, varname, array, range, quiet, &
10368 & flag_mpi_split, returned_time, flag_time_exist, err)
10369 use dc_types, only: dp
10370 character(*), intent(in):: file
10371 character(*), intent(in):: varname
10372 character(*), intent(in), optional:: range
10373 logical, intent(in), optional:: quiet
10374 logical, intent(in), optional:: flag_mpi_split
10375 real(DP), intent(out), optional:: returned_time
10376 logical, intent(out), optional:: flag_time_exist
10377 logical, intent(out), optional:: err
10378 real(DP), intent(out) :: array(:,:)
10379 end subroutine historygetdouble2
10380 end interface
10381 interface
10382 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10383 character(*), intent(in):: file
10384 character(*), intent(in):: varname
10385 character(*), intent(out):: url
10386 character(*), intent(in), optional:: range
10387 logical, intent(out), optional:: flag_time_exist
10388 character(*), intent(out), optional:: time_name
10389 logical, intent(out), optional:: err
10390 end subroutine lookup_growable_url
10391 end interface
10392 interface
10393 function file_rename_mpi( file ) result(result)
10394 use dc_types, only: string
10395 character(*), intent(in):: file
10396 character(STRING):: result
10397 end function file_rename_mpi
10398 end interface
10399 continue
10400 file_work = file
10401 if ( present_and_true( flag_mpi_split ) ) &
10402 & file_work = file_rename_mpi( file_work )
10403 call lookup_growable_url(file = file_work, varname = varname, &
10404 & url = url, &
10405 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10406 call url_chop_iorange( &
10407 & fullname = url, iorange = iorange, remainder = remainder )
10408 call split( str = iorange, carray = carray, sep = gt_equal )
10409 timevar_name = carray(1)
10410 deallocate( carray )
10411 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10412 call historygetdouble2( file = file, &
10413 & varname = varname, array = array, &
10414 & range = time_range, quiet = quiet, &
10415 & flag_mpi_split = flag_mpi_split, &
10416 & returned_time = returned_time, &
10417 & flag_time_exist = flag_time_exist, &
10418 & err = err )
10419end subroutine historygetdouble2timed
10421 & file, varname, array, time, &
10422 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10423 use dc_string, only: tochar, split
10424 use dc_types, only: string, dp
10425 use dc_trace, only: dbgmessage
10426 use dc_url, only: url_chop_iorange, gt_equal
10427 use dc_present, only: present_and_true
10428 implicit none
10429 character(*), intent(in):: file, varname
10430 real(DP), intent(in):: time
10431 logical, intent(in), optional:: quiet
10432 real(DP), intent(out) :: array(:,:,:)
10433 logical, intent(in), optional:: flag_mpi_split
10434 real(DP), intent(out), optional:: returned_time
10435 logical, intent(out), optional:: flag_time_exist
10436 logical, intent(out), optional:: err
10437 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10438 character(STRING), pointer:: carray (:)
10439 character(STRING):: tname
10440 interface
10441 subroutine historygetdouble3(&
10442 & file, varname, array, range, quiet, &
10443 & flag_mpi_split, returned_time, flag_time_exist, err)
10444 use dc_types, only: dp
10445 character(*), intent(in):: file
10446 character(*), intent(in):: varname
10447 character(*), intent(in), optional:: range
10448 logical, intent(in), optional:: quiet
10449 logical, intent(in), optional:: flag_mpi_split
10450 real(DP), intent(out), optional:: returned_time
10451 logical, intent(out), optional:: flag_time_exist
10452 logical, intent(out), optional:: err
10453 real(DP), intent(out) :: array(:,:,:)
10454 end subroutine historygetdouble3
10455 end interface
10456 interface
10457 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10458 character(*), intent(in):: file
10459 character(*), intent(in):: varname
10460 character(*), intent(out):: url
10461 character(*), intent(in), optional:: range
10462 logical, intent(out), optional:: flag_time_exist
10463 character(*), intent(out), optional:: time_name
10464 logical, intent(out), optional:: err
10465 end subroutine lookup_growable_url
10466 end interface
10467 interface
10468 function file_rename_mpi( file ) result(result)
10469 use dc_types, only: string
10470 character(*), intent(in):: file
10471 character(STRING):: result
10472 end function file_rename_mpi
10473 end interface
10474 continue
10475 file_work = file
10476 if ( present_and_true( flag_mpi_split ) ) &
10477 & file_work = file_rename_mpi( file_work )
10478 call lookup_growable_url(file = file_work, varname = varname, &
10479 & url = url, &
10480 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10481 call url_chop_iorange( &
10482 & fullname = url, iorange = iorange, remainder = remainder )
10483 call split( str = iorange, carray = carray, sep = gt_equal )
10484 timevar_name = carray(1)
10485 deallocate( carray )
10486 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10487 call historygetdouble3( file = file, &
10488 & varname = varname, array = array, &
10489 & range = time_range, quiet = quiet, &
10490 & flag_mpi_split = flag_mpi_split, &
10491 & returned_time = returned_time, &
10492 & flag_time_exist = flag_time_exist, &
10493 & err = err )
10494end subroutine historygetdouble3timed
10496 & file, varname, array, time, &
10497 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10498 use dc_string, only: tochar, split
10499 use dc_types, only: string, dp
10500 use dc_trace, only: dbgmessage
10501 use dc_url, only: url_chop_iorange, gt_equal
10502 use dc_present, only: present_and_true
10503 implicit none
10504 character(*), intent(in):: file, varname
10505 real(DP), intent(in):: time
10506 logical, intent(in), optional:: quiet
10507 real(DP), intent(out) :: array(:,:,:,:)
10508 logical, intent(in), optional:: flag_mpi_split
10509 real(DP), intent(out), optional:: returned_time
10510 logical, intent(out), optional:: flag_time_exist
10511 logical, intent(out), optional:: err
10512 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10513 character(STRING), pointer:: carray (:)
10514 character(STRING):: tname
10515 interface
10516 subroutine historygetdouble4(&
10517 & file, varname, array, range, quiet, &
10518 & flag_mpi_split, returned_time, flag_time_exist, err)
10519 use dc_types, only: dp
10520 character(*), intent(in):: file
10521 character(*), intent(in):: varname
10522 character(*), intent(in), optional:: range
10523 logical, intent(in), optional:: quiet
10524 logical, intent(in), optional:: flag_mpi_split
10525 real(DP), intent(out), optional:: returned_time
10526 logical, intent(out), optional:: flag_time_exist
10527 logical, intent(out), optional:: err
10528 real(DP), intent(out) :: array(:,:,:,:)
10529 end subroutine historygetdouble4
10530 end interface
10531 interface
10532 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10533 character(*), intent(in):: file
10534 character(*), intent(in):: varname
10535 character(*), intent(out):: url
10536 character(*), intent(in), optional:: range
10537 logical, intent(out), optional:: flag_time_exist
10538 character(*), intent(out), optional:: time_name
10539 logical, intent(out), optional:: err
10540 end subroutine lookup_growable_url
10541 end interface
10542 interface
10543 function file_rename_mpi( file ) result(result)
10544 use dc_types, only: string
10545 character(*), intent(in):: file
10546 character(STRING):: result
10547 end function file_rename_mpi
10548 end interface
10549 continue
10550 file_work = file
10551 if ( present_and_true( flag_mpi_split ) ) &
10552 & file_work = file_rename_mpi( file_work )
10553 call lookup_growable_url(file = file_work, varname = varname, &
10554 & url = url, &
10555 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10556 call url_chop_iorange( &
10557 & fullname = url, iorange = iorange, remainder = remainder )
10558 call split( str = iorange, carray = carray, sep = gt_equal )
10559 timevar_name = carray(1)
10560 deallocate( carray )
10561 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10562 call historygetdouble4( file = file, &
10563 & varname = varname, array = array, &
10564 & range = time_range, quiet = quiet, &
10565 & flag_mpi_split = flag_mpi_split, &
10566 & returned_time = returned_time, &
10567 & flag_time_exist = flag_time_exist, &
10568 & err = err )
10569end subroutine historygetdouble4timed
10571 & file, varname, array, time, &
10572 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10573 use dc_string, only: tochar, split
10574 use dc_types, only: string, dp
10575 use dc_trace, only: dbgmessage
10576 use dc_url, only: url_chop_iorange, gt_equal
10577 use dc_present, only: present_and_true
10578 implicit none
10579 character(*), intent(in):: file, varname
10580 real(DP), intent(in):: time
10581 logical, intent(in), optional:: quiet
10582 real(DP), intent(out) :: array(:,:,:,:,:)
10583 logical, intent(in), optional:: flag_mpi_split
10584 real(DP), intent(out), optional:: returned_time
10585 logical, intent(out), optional:: flag_time_exist
10586 logical, intent(out), optional:: err
10587 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10588 character(STRING), pointer:: carray (:)
10589 character(STRING):: tname
10590 interface
10591 subroutine historygetdouble5(&
10592 & file, varname, array, range, quiet, &
10593 & flag_mpi_split, returned_time, flag_time_exist, err)
10594 use dc_types, only: dp
10595 character(*), intent(in):: file
10596 character(*), intent(in):: varname
10597 character(*), intent(in), optional:: range
10598 logical, intent(in), optional:: quiet
10599 logical, intent(in), optional:: flag_mpi_split
10600 real(DP), intent(out), optional:: returned_time
10601 logical, intent(out), optional:: flag_time_exist
10602 logical, intent(out), optional:: err
10603 real(DP), intent(out) :: array(:,:,:,:,:)
10604 end subroutine historygetdouble5
10605 end interface
10606 interface
10607 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10608 character(*), intent(in):: file
10609 character(*), intent(in):: varname
10610 character(*), intent(out):: url
10611 character(*), intent(in), optional:: range
10612 logical, intent(out), optional:: flag_time_exist
10613 character(*), intent(out), optional:: time_name
10614 logical, intent(out), optional:: err
10615 end subroutine lookup_growable_url
10616 end interface
10617 interface
10618 function file_rename_mpi( file ) result(result)
10619 use dc_types, only: string
10620 character(*), intent(in):: file
10621 character(STRING):: result
10622 end function file_rename_mpi
10623 end interface
10624 continue
10625 file_work = file
10626 if ( present_and_true( flag_mpi_split ) ) &
10627 & file_work = file_rename_mpi( file_work )
10628 call lookup_growable_url(file = file_work, varname = varname, &
10629 & url = url, &
10630 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10631 call url_chop_iorange( &
10632 & fullname = url, iorange = iorange, remainder = remainder )
10633 call split( str = iorange, carray = carray, sep = gt_equal )
10634 timevar_name = carray(1)
10635 deallocate( carray )
10636 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10637 call historygetdouble5( file = file, &
10638 & varname = varname, array = array, &
10639 & range = time_range, quiet = quiet, &
10640 & flag_mpi_split = flag_mpi_split, &
10641 & returned_time = returned_time, &
10642 & flag_time_exist = flag_time_exist, &
10643 & err = err )
10644end subroutine historygetdouble5timed
10646 & file, varname, array, time, &
10647 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10648 use dc_string, only: tochar, split
10649 use dc_types, only: string, dp
10650 use dc_trace, only: dbgmessage
10651 use dc_url, only: url_chop_iorange, gt_equal
10652 use dc_present, only: present_and_true
10653 implicit none
10654 character(*), intent(in):: file, varname
10655 real(DP), intent(in):: time
10656 logical, intent(in), optional:: quiet
10657 real(DP), intent(out) :: array(:,:,:,:,:,:)
10658 logical, intent(in), optional:: flag_mpi_split
10659 real(DP), intent(out), optional:: returned_time
10660 logical, intent(out), optional:: flag_time_exist
10661 logical, intent(out), optional:: err
10662 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10663 character(STRING), pointer:: carray (:)
10664 character(STRING):: tname
10665 interface
10666 subroutine historygetdouble6(&
10667 & file, varname, array, range, quiet, &
10668 & flag_mpi_split, returned_time, flag_time_exist, err)
10669 use dc_types, only: dp
10670 character(*), intent(in):: file
10671 character(*), intent(in):: varname
10672 character(*), intent(in), optional:: range
10673 logical, intent(in), optional:: quiet
10674 logical, intent(in), optional:: flag_mpi_split
10675 real(DP), intent(out), optional:: returned_time
10676 logical, intent(out), optional:: flag_time_exist
10677 logical, intent(out), optional:: err
10678 real(DP), intent(out) :: array(:,:,:,:,:,:)
10679 end subroutine historygetdouble6
10680 end interface
10681 interface
10682 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10683 character(*), intent(in):: file
10684 character(*), intent(in):: varname
10685 character(*), intent(out):: url
10686 character(*), intent(in), optional:: range
10687 logical, intent(out), optional:: flag_time_exist
10688 character(*), intent(out), optional:: time_name
10689 logical, intent(out), optional:: err
10690 end subroutine lookup_growable_url
10691 end interface
10692 interface
10693 function file_rename_mpi( file ) result(result)
10694 use dc_types, only: string
10695 character(*), intent(in):: file
10696 character(STRING):: result
10697 end function file_rename_mpi
10698 end interface
10699 continue
10700 file_work = file
10701 if ( present_and_true( flag_mpi_split ) ) &
10702 & file_work = file_rename_mpi( file_work )
10703 call lookup_growable_url(file = file_work, varname = varname, &
10704 & url = url, &
10705 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10706 call url_chop_iorange( &
10707 & fullname = url, iorange = iorange, remainder = remainder )
10708 call split( str = iorange, carray = carray, sep = gt_equal )
10709 timevar_name = carray(1)
10710 deallocate( carray )
10711 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10712 call historygetdouble6( file = file, &
10713 & varname = varname, array = array, &
10714 & range = time_range, quiet = quiet, &
10715 & flag_mpi_split = flag_mpi_split, &
10716 & returned_time = returned_time, &
10717 & flag_time_exist = flag_time_exist, &
10718 & err = err )
10719end subroutine historygetdouble6timed
10721 & file, varname, array, time, &
10722 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10723 use dc_string, only: tochar, split
10724 use dc_types, only: string, dp
10725 use dc_trace, only: dbgmessage
10726 use dc_url, only: url_chop_iorange, gt_equal
10727 use dc_present, only: present_and_true
10728 implicit none
10729 character(*), intent(in):: file, varname
10730 real(DP), intent(in):: time
10731 logical, intent(in), optional:: quiet
10732 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
10733 logical, intent(in), optional:: flag_mpi_split
10734 real(DP), intent(out), optional:: returned_time
10735 logical, intent(out), optional:: flag_time_exist
10736 logical, intent(out), optional:: err
10737 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10738 character(STRING), pointer:: carray (:)
10739 character(STRING):: tname
10740 interface
10741 subroutine historygetdouble7(&
10742 & file, varname, array, range, quiet, &
10743 & flag_mpi_split, returned_time, flag_time_exist, err)
10744 use dc_types, only: dp
10745 character(*), intent(in):: file
10746 character(*), intent(in):: varname
10747 character(*), intent(in), optional:: range
10748 logical, intent(in), optional:: quiet
10749 logical, intent(in), optional:: flag_mpi_split
10750 real(DP), intent(out), optional:: returned_time
10751 logical, intent(out), optional:: flag_time_exist
10752 logical, intent(out), optional:: err
10753 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
10754 end subroutine historygetdouble7
10755 end interface
10756 interface
10757 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10758 character(*), intent(in):: file
10759 character(*), intent(in):: varname
10760 character(*), intent(out):: url
10761 character(*), intent(in), optional:: range
10762 logical, intent(out), optional:: flag_time_exist
10763 character(*), intent(out), optional:: time_name
10764 logical, intent(out), optional:: err
10765 end subroutine lookup_growable_url
10766 end interface
10767 interface
10768 function file_rename_mpi( file ) result(result)
10769 use dc_types, only: string
10770 character(*), intent(in):: file
10771 character(STRING):: result
10772 end function file_rename_mpi
10773 end interface
10774 continue
10775 file_work = file
10776 if ( present_and_true( flag_mpi_split ) ) &
10777 & file_work = file_rename_mpi( file_work )
10778 call lookup_growable_url(file = file_work, varname = varname, &
10779 & url = url, &
10780 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10781 call url_chop_iorange( &
10782 & fullname = url, iorange = iorange, remainder = remainder )
10783 call split( str = iorange, carray = carray, sep = gt_equal )
10784 timevar_name = carray(1)
10785 deallocate( carray )
10786 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10787 call historygetdouble7( file = file, &
10788 & varname = varname, array = array, &
10789 & range = time_range, quiet = quiet, &
10790 & flag_mpi_split = flag_mpi_split, &
10791 & returned_time = returned_time, &
10792 & flag_time_exist = flag_time_exist, &
10793 & err = err )
10794end subroutine historygetdouble7timed
10796 & file, varname, array, time, &
10797 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10798 use dc_string, only: tochar, split
10799 use dc_types, only: string, dp
10800 use dc_trace, only: dbgmessage
10801 use dc_url, only: url_chop_iorange, gt_equal
10802 use dc_present, only: present_and_true
10803 implicit none
10804 character(*), intent(in):: file, varname
10805 real(DP), intent(in):: time
10806 logical, intent(in), optional:: quiet
10807 real(DP), pointer :: array
10808 logical, intent(in), optional:: flag_mpi_split
10809 real(DP), intent(out), optional:: returned_time
10810 logical, intent(out), optional:: flag_time_exist
10811 logical, intent(out), optional:: err
10812 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10813 character(STRING), pointer:: carray (:)
10814 character(STRING):: tname
10815 interface
10816 subroutine historygetdouble0pointer(&
10817 & file, varname, array, range, quiet, &
10818 & flag_mpi_split, returned_time, flag_time_exist, err)
10819 use dc_types, only: dp
10820 character(*), intent(in):: file
10821 character(*), intent(in):: varname
10822 character(*), intent(in), optional:: range
10823 logical, intent(in), optional:: quiet
10824 logical, intent(in), optional:: flag_mpi_split
10825 real(DP), intent(out), optional:: returned_time
10826 logical, intent(out), optional:: flag_time_exist
10827 logical, intent(out), optional:: err
10828 real(DP), pointer :: array
10829 end subroutine historygetdouble0pointer
10830 end interface
10831 interface
10832 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10833 character(*), intent(in):: file
10834 character(*), intent(in):: varname
10835 character(*), intent(out):: url
10836 character(*), intent(in), optional:: range
10837 logical, intent(out), optional:: flag_time_exist
10838 character(*), intent(out), optional:: time_name
10839 logical, intent(out), optional:: err
10840 end subroutine lookup_growable_url
10841 end interface
10842 interface
10843 function file_rename_mpi( file ) result(result)
10844 use dc_types, only: string
10845 character(*), intent(in):: file
10846 character(STRING):: result
10847 end function file_rename_mpi
10848 end interface
10849 continue
10850 file_work = file
10851 if ( present_and_true( flag_mpi_split ) ) &
10852 & file_work = file_rename_mpi( file_work )
10853 call lookup_growable_url(file = file_work, varname = varname, &
10854 & url = url, &
10855 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10856 call url_chop_iorange( &
10857 & fullname = url, iorange = iorange, remainder = remainder )
10858 call split( str = iorange, carray = carray, sep = gt_equal )
10859 timevar_name = carray(1)
10860 deallocate( carray )
10861 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10862 call historygetdouble0pointer( file = file, &
10863 & varname = varname, array = array, &
10864 & range = time_range, quiet = quiet, &
10865 & flag_mpi_split = flag_mpi_split, &
10866 & returned_time = returned_time, &
10867 & flag_time_exist = flag_time_exist, &
10868 & err = err )
10869end subroutine historygetdouble0pointertimed
10871 & file, varname, array, time, &
10872 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10873 use dc_string, only: tochar, split
10874 use dc_types, only: string, dp
10875 use dc_trace, only: dbgmessage
10876 use dc_url, only: url_chop_iorange, gt_equal
10877 use dc_present, only: present_and_true
10878 implicit none
10879 character(*), intent(in):: file, varname
10880 real(DP), intent(in):: time
10881 logical, intent(in), optional:: quiet
10882 real(DP), pointer :: array(:)
10883 logical, intent(in), optional:: flag_mpi_split
10884 real(DP), intent(out), optional:: returned_time
10885 logical, intent(out), optional:: flag_time_exist
10886 logical, intent(out), optional:: err
10887 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10888 character(STRING), pointer:: carray (:)
10889 character(STRING):: tname
10890 interface
10891 subroutine historygetdouble1pointer(&
10892 & file, varname, array, range, quiet, &
10893 & flag_mpi_split, returned_time, flag_time_exist, err)
10894 use dc_types, only: dp
10895 character(*), intent(in):: file
10896 character(*), intent(in):: varname
10897 character(*), intent(in), optional:: range
10898 logical, intent(in), optional:: quiet
10899 logical, intent(in), optional:: flag_mpi_split
10900 real(DP), intent(out), optional:: returned_time
10901 logical, intent(out), optional:: flag_time_exist
10902 logical, intent(out), optional:: err
10903 real(DP), pointer :: array(:)
10904 end subroutine historygetdouble1pointer
10905 end interface
10906 interface
10907 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10908 character(*), intent(in):: file
10909 character(*), intent(in):: varname
10910 character(*), intent(out):: url
10911 character(*), intent(in), optional:: range
10912 logical, intent(out), optional:: flag_time_exist
10913 character(*), intent(out), optional:: time_name
10914 logical, intent(out), optional:: err
10915 end subroutine lookup_growable_url
10916 end interface
10917 interface
10918 function file_rename_mpi( file ) result(result)
10919 use dc_types, only: string
10920 character(*), intent(in):: file
10921 character(STRING):: result
10922 end function file_rename_mpi
10923 end interface
10924 continue
10925 file_work = file
10926 if ( present_and_true( flag_mpi_split ) ) &
10927 & file_work = file_rename_mpi( file_work )
10928 call lookup_growable_url(file = file_work, varname = varname, &
10929 & url = url, &
10930 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
10931 call url_chop_iorange( &
10932 & fullname = url, iorange = iorange, remainder = remainder )
10933 call split( str = iorange, carray = carray, sep = gt_equal )
10934 timevar_name = carray(1)
10935 deallocate( carray )
10936 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
10937 call historygetdouble1pointer( file = file, &
10938 & varname = varname, array = array, &
10939 & range = time_range, quiet = quiet, &
10940 & flag_mpi_split = flag_mpi_split, &
10941 & returned_time = returned_time, &
10942 & flag_time_exist = flag_time_exist, &
10943 & err = err )
10944end subroutine historygetdouble1pointertimed
10946 & file, varname, array, time, &
10947 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
10948 use dc_string, only: tochar, split
10949 use dc_types, only: string, dp
10950 use dc_trace, only: dbgmessage
10951 use dc_url, only: url_chop_iorange, gt_equal
10952 use dc_present, only: present_and_true
10953 implicit none
10954 character(*), intent(in):: file, varname
10955 real(DP), intent(in):: time
10956 logical, intent(in), optional:: quiet
10957 real(DP), pointer :: array(:,:)
10958 logical, intent(in), optional:: flag_mpi_split
10959 real(DP), intent(out), optional:: returned_time
10960 logical, intent(out), optional:: flag_time_exist
10961 logical, intent(out), optional:: err
10962 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
10963 character(STRING), pointer:: carray (:)
10964 character(STRING):: tname
10965 interface
10966 subroutine historygetdouble2pointer(&
10967 & file, varname, array, range, quiet, &
10968 & flag_mpi_split, returned_time, flag_time_exist, err)
10969 use dc_types, only: dp
10970 character(*), intent(in):: file
10971 character(*), intent(in):: varname
10972 character(*), intent(in), optional:: range
10973 logical, intent(in), optional:: quiet
10974 logical, intent(in), optional:: flag_mpi_split
10975 real(DP), intent(out), optional:: returned_time
10976 logical, intent(out), optional:: flag_time_exist
10977 logical, intent(out), optional:: err
10978 real(DP), pointer :: array(:,:)
10979 end subroutine historygetdouble2pointer
10980 end interface
10981 interface
10982 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
10983 character(*), intent(in):: file
10984 character(*), intent(in):: varname
10985 character(*), intent(out):: url
10986 character(*), intent(in), optional:: range
10987 logical, intent(out), optional:: flag_time_exist
10988 character(*), intent(out), optional:: time_name
10989 logical, intent(out), optional:: err
10990 end subroutine lookup_growable_url
10991 end interface
10992 interface
10993 function file_rename_mpi( file ) result(result)
10994 use dc_types, only: string
10995 character(*), intent(in):: file
10996 character(STRING):: result
10997 end function file_rename_mpi
10998 end interface
10999 continue
11000 file_work = file
11001 if ( present_and_true( flag_mpi_split ) ) &
11002 & file_work = file_rename_mpi( file_work )
11003 call lookup_growable_url(file = file_work, varname = varname, &
11004 & url = url, &
11005 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11006 call url_chop_iorange( &
11007 & fullname = url, iorange = iorange, remainder = remainder )
11008 call split( str = iorange, carray = carray, sep = gt_equal )
11009 timevar_name = carray(1)
11010 deallocate( carray )
11011 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11012 call historygetdouble2pointer( file = file, &
11013 & varname = varname, array = array, &
11014 & range = time_range, quiet = quiet, &
11015 & flag_mpi_split = flag_mpi_split, &
11016 & returned_time = returned_time, &
11017 & flag_time_exist = flag_time_exist, &
11018 & err = err )
11019end subroutine historygetdouble2pointertimed
11021 & file, varname, array, time, &
11022 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11023 use dc_string, only: tochar, split
11024 use dc_types, only: string, dp
11025 use dc_trace, only: dbgmessage
11026 use dc_url, only: url_chop_iorange, gt_equal
11027 use dc_present, only: present_and_true
11028 implicit none
11029 character(*), intent(in):: file, varname
11030 real(DP), intent(in):: time
11031 logical, intent(in), optional:: quiet
11032 real(DP), pointer :: array(:,:,:)
11033 logical, intent(in), optional:: flag_mpi_split
11034 real(DP), intent(out), optional:: returned_time
11035 logical, intent(out), optional:: flag_time_exist
11036 logical, intent(out), optional:: err
11037 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11038 character(STRING), pointer:: carray (:)
11039 character(STRING):: tname
11040 interface
11041 subroutine historygetdouble3pointer(&
11042 & file, varname, array, range, quiet, &
11043 & flag_mpi_split, returned_time, flag_time_exist, err)
11044 use dc_types, only: dp
11045 character(*), intent(in):: file
11046 character(*), intent(in):: varname
11047 character(*), intent(in), optional:: range
11048 logical, intent(in), optional:: quiet
11049 logical, intent(in), optional:: flag_mpi_split
11050 real(DP), intent(out), optional:: returned_time
11051 logical, intent(out), optional:: flag_time_exist
11052 logical, intent(out), optional:: err
11053 real(DP), pointer :: array(:,:,:)
11054 end subroutine historygetdouble3pointer
11055 end interface
11056 interface
11057 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11058 character(*), intent(in):: file
11059 character(*), intent(in):: varname
11060 character(*), intent(out):: url
11061 character(*), intent(in), optional:: range
11062 logical, intent(out), optional:: flag_time_exist
11063 character(*), intent(out), optional:: time_name
11064 logical, intent(out), optional:: err
11065 end subroutine lookup_growable_url
11066 end interface
11067 interface
11068 function file_rename_mpi( file ) result(result)
11069 use dc_types, only: string
11070 character(*), intent(in):: file
11071 character(STRING):: result
11072 end function file_rename_mpi
11073 end interface
11074 continue
11075 file_work = file
11076 if ( present_and_true( flag_mpi_split ) ) &
11077 & file_work = file_rename_mpi( file_work )
11078 call lookup_growable_url(file = file_work, varname = varname, &
11079 & url = url, &
11080 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11081 call url_chop_iorange( &
11082 & fullname = url, iorange = iorange, remainder = remainder )
11083 call split( str = iorange, carray = carray, sep = gt_equal )
11084 timevar_name = carray(1)
11085 deallocate( carray )
11086 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11087 call historygetdouble3pointer( file = file, &
11088 & varname = varname, array = array, &
11089 & range = time_range, quiet = quiet, &
11090 & flag_mpi_split = flag_mpi_split, &
11091 & returned_time = returned_time, &
11092 & flag_time_exist = flag_time_exist, &
11093 & err = err )
11094end subroutine historygetdouble3pointertimed
11096 & file, varname, array, time, &
11097 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11098 use dc_string, only: tochar, split
11099 use dc_types, only: string, dp
11100 use dc_trace, only: dbgmessage
11101 use dc_url, only: url_chop_iorange, gt_equal
11102 use dc_present, only: present_and_true
11103 implicit none
11104 character(*), intent(in):: file, varname
11105 real(DP), intent(in):: time
11106 logical, intent(in), optional:: quiet
11107 real(DP), pointer :: array(:,:,:,:)
11108 logical, intent(in), optional:: flag_mpi_split
11109 real(DP), intent(out), optional:: returned_time
11110 logical, intent(out), optional:: flag_time_exist
11111 logical, intent(out), optional:: err
11112 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11113 character(STRING), pointer:: carray (:)
11114 character(STRING):: tname
11115 interface
11116 subroutine historygetdouble4pointer(&
11117 & file, varname, array, range, quiet, &
11118 & flag_mpi_split, returned_time, flag_time_exist, err)
11119 use dc_types, only: dp
11120 character(*), intent(in):: file
11121 character(*), intent(in):: varname
11122 character(*), intent(in), optional:: range
11123 logical, intent(in), optional:: quiet
11124 logical, intent(in), optional:: flag_mpi_split
11125 real(DP), intent(out), optional:: returned_time
11126 logical, intent(out), optional:: flag_time_exist
11127 logical, intent(out), optional:: err
11128 real(DP), pointer :: array(:,:,:,:)
11129 end subroutine historygetdouble4pointer
11130 end interface
11131 interface
11132 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11133 character(*), intent(in):: file
11134 character(*), intent(in):: varname
11135 character(*), intent(out):: url
11136 character(*), intent(in), optional:: range
11137 logical, intent(out), optional:: flag_time_exist
11138 character(*), intent(out), optional:: time_name
11139 logical, intent(out), optional:: err
11140 end subroutine lookup_growable_url
11141 end interface
11142 interface
11143 function file_rename_mpi( file ) result(result)
11144 use dc_types, only: string
11145 character(*), intent(in):: file
11146 character(STRING):: result
11147 end function file_rename_mpi
11148 end interface
11149 continue
11150 file_work = file
11151 if ( present_and_true( flag_mpi_split ) ) &
11152 & file_work = file_rename_mpi( file_work )
11153 call lookup_growable_url(file = file_work, varname = varname, &
11154 & url = url, &
11155 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11156 call url_chop_iorange( &
11157 & fullname = url, iorange = iorange, remainder = remainder )
11158 call split( str = iorange, carray = carray, sep = gt_equal )
11159 timevar_name = carray(1)
11160 deallocate( carray )
11161 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11162 call historygetdouble4pointer( file = file, &
11163 & varname = varname, array = array, &
11164 & range = time_range, quiet = quiet, &
11165 & flag_mpi_split = flag_mpi_split, &
11166 & returned_time = returned_time, &
11167 & flag_time_exist = flag_time_exist, &
11168 & err = err )
11169end subroutine historygetdouble4pointertimed
11171 & file, varname, array, time, &
11172 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11173 use dc_string, only: tochar, split
11174 use dc_types, only: string, dp
11175 use dc_trace, only: dbgmessage
11176 use dc_url, only: url_chop_iorange, gt_equal
11177 use dc_present, only: present_and_true
11178 implicit none
11179 character(*), intent(in):: file, varname
11180 real(DP), intent(in):: time
11181 logical, intent(in), optional:: quiet
11182 real(DP), pointer :: array(:,:,:,:,:)
11183 logical, intent(in), optional:: flag_mpi_split
11184 real(DP), intent(out), optional:: returned_time
11185 logical, intent(out), optional:: flag_time_exist
11186 logical, intent(out), optional:: err
11187 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11188 character(STRING), pointer:: carray (:)
11189 character(STRING):: tname
11190 interface
11191 subroutine historygetdouble5pointer(&
11192 & file, varname, array, range, quiet, &
11193 & flag_mpi_split, returned_time, flag_time_exist, err)
11194 use dc_types, only: dp
11195 character(*), intent(in):: file
11196 character(*), intent(in):: varname
11197 character(*), intent(in), optional:: range
11198 logical, intent(in), optional:: quiet
11199 logical, intent(in), optional:: flag_mpi_split
11200 real(DP), intent(out), optional:: returned_time
11201 logical, intent(out), optional:: flag_time_exist
11202 logical, intent(out), optional:: err
11203 real(DP), pointer :: array(:,:,:,:,:)
11204 end subroutine historygetdouble5pointer
11205 end interface
11206 interface
11207 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11208 character(*), intent(in):: file
11209 character(*), intent(in):: varname
11210 character(*), intent(out):: url
11211 character(*), intent(in), optional:: range
11212 logical, intent(out), optional:: flag_time_exist
11213 character(*), intent(out), optional:: time_name
11214 logical, intent(out), optional:: err
11215 end subroutine lookup_growable_url
11216 end interface
11217 interface
11218 function file_rename_mpi( file ) result(result)
11219 use dc_types, only: string
11220 character(*), intent(in):: file
11221 character(STRING):: result
11222 end function file_rename_mpi
11223 end interface
11224 continue
11225 file_work = file
11226 if ( present_and_true( flag_mpi_split ) ) &
11227 & file_work = file_rename_mpi( file_work )
11228 call lookup_growable_url(file = file_work, varname = varname, &
11229 & url = url, &
11230 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11231 call url_chop_iorange( &
11232 & fullname = url, iorange = iorange, remainder = remainder )
11233 call split( str = iorange, carray = carray, sep = gt_equal )
11234 timevar_name = carray(1)
11235 deallocate( carray )
11236 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11237 call historygetdouble5pointer( file = file, &
11238 & varname = varname, array = array, &
11239 & range = time_range, quiet = quiet, &
11240 & flag_mpi_split = flag_mpi_split, &
11241 & returned_time = returned_time, &
11242 & flag_time_exist = flag_time_exist, &
11243 & err = err )
11244end subroutine historygetdouble5pointertimed
11246 & file, varname, array, time, &
11247 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11248 use dc_string, only: tochar, split
11249 use dc_types, only: string, dp
11250 use dc_trace, only: dbgmessage
11251 use dc_url, only: url_chop_iorange, gt_equal
11252 use dc_present, only: present_and_true
11253 implicit none
11254 character(*), intent(in):: file, varname
11255 real(DP), intent(in):: time
11256 logical, intent(in), optional:: quiet
11257 real(DP), pointer :: array(:,:,:,:,:,:)
11258 logical, intent(in), optional:: flag_mpi_split
11259 real(DP), intent(out), optional:: returned_time
11260 logical, intent(out), optional:: flag_time_exist
11261 logical, intent(out), optional:: err
11262 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11263 character(STRING), pointer:: carray (:)
11264 character(STRING):: tname
11265 interface
11266 subroutine historygetdouble6pointer(&
11267 & file, varname, array, range, quiet, &
11268 & flag_mpi_split, returned_time, flag_time_exist, err)
11269 use dc_types, only: dp
11270 character(*), intent(in):: file
11271 character(*), intent(in):: varname
11272 character(*), intent(in), optional:: range
11273 logical, intent(in), optional:: quiet
11274 logical, intent(in), optional:: flag_mpi_split
11275 real(DP), intent(out), optional:: returned_time
11276 logical, intent(out), optional:: flag_time_exist
11277 logical, intent(out), optional:: err
11278 real(DP), pointer :: array(:,:,:,:,:,:)
11279 end subroutine historygetdouble6pointer
11280 end interface
11281 interface
11282 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11283 character(*), intent(in):: file
11284 character(*), intent(in):: varname
11285 character(*), intent(out):: url
11286 character(*), intent(in), optional:: range
11287 logical, intent(out), optional:: flag_time_exist
11288 character(*), intent(out), optional:: time_name
11289 logical, intent(out), optional:: err
11290 end subroutine lookup_growable_url
11291 end interface
11292 interface
11293 function file_rename_mpi( file ) result(result)
11294 use dc_types, only: string
11295 character(*), intent(in):: file
11296 character(STRING):: result
11297 end function file_rename_mpi
11298 end interface
11299 continue
11300 file_work = file
11301 if ( present_and_true( flag_mpi_split ) ) &
11302 & file_work = file_rename_mpi( file_work )
11303 call lookup_growable_url(file = file_work, varname = varname, &
11304 & url = url, &
11305 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11306 call url_chop_iorange( &
11307 & fullname = url, iorange = iorange, remainder = remainder )
11308 call split( str = iorange, carray = carray, sep = gt_equal )
11309 timevar_name = carray(1)
11310 deallocate( carray )
11311 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11312 call historygetdouble6pointer( file = file, &
11313 & varname = varname, array = array, &
11314 & range = time_range, quiet = quiet, &
11315 & flag_mpi_split = flag_mpi_split, &
11316 & returned_time = returned_time, &
11317 & flag_time_exist = flag_time_exist, &
11318 & err = err )
11319end subroutine historygetdouble6pointertimed
11321 & file, varname, array, time, &
11322 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11323 use dc_string, only: tochar, split
11324 use dc_types, only: string, dp
11325 use dc_trace, only: dbgmessage
11326 use dc_url, only: url_chop_iorange, gt_equal
11327 use dc_present, only: present_and_true
11328 implicit none
11329 character(*), intent(in):: file, varname
11330 real(DP), intent(in):: time
11331 logical, intent(in), optional:: quiet
11332 real(DP), pointer :: array(:,:,:,:,:,:,:)
11333 logical, intent(in), optional:: flag_mpi_split
11334 real(DP), intent(out), optional:: returned_time
11335 logical, intent(out), optional:: flag_time_exist
11336 logical, intent(out), optional:: err
11337 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11338 character(STRING), pointer:: carray (:)
11339 character(STRING):: tname
11340 interface
11341 subroutine historygetdouble7pointer(&
11342 & file, varname, array, range, quiet, &
11343 & flag_mpi_split, returned_time, flag_time_exist, err)
11344 use dc_types, only: dp
11345 character(*), intent(in):: file
11346 character(*), intent(in):: varname
11347 character(*), intent(in), optional:: range
11348 logical, intent(in), optional:: quiet
11349 logical, intent(in), optional:: flag_mpi_split
11350 real(DP), intent(out), optional:: returned_time
11351 logical, intent(out), optional:: flag_time_exist
11352 logical, intent(out), optional:: err
11353 real(DP), pointer :: array(:,:,:,:,:,:,:)
11354 end subroutine historygetdouble7pointer
11355 end interface
11356 interface
11357 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11358 character(*), intent(in):: file
11359 character(*), intent(in):: varname
11360 character(*), intent(out):: url
11361 character(*), intent(in), optional:: range
11362 logical, intent(out), optional:: flag_time_exist
11363 character(*), intent(out), optional:: time_name
11364 logical, intent(out), optional:: err
11365 end subroutine lookup_growable_url
11366 end interface
11367 interface
11368 function file_rename_mpi( file ) result(result)
11369 use dc_types, only: string
11370 character(*), intent(in):: file
11371 character(STRING):: result
11372 end function file_rename_mpi
11373 end interface
11374 continue
11375 file_work = file
11376 if ( present_and_true( flag_mpi_split ) ) &
11377 & file_work = file_rename_mpi( file_work )
11378 call lookup_growable_url(file = file_work, varname = varname, &
11379 & url = url, &
11380 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11381 call url_chop_iorange( &
11382 & fullname = url, iorange = iorange, remainder = remainder )
11383 call split( str = iorange, carray = carray, sep = gt_equal )
11384 timevar_name = carray(1)
11385 deallocate( carray )
11386 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11387 call historygetdouble7pointer( file = file, &
11388 & varname = varname, array = array, &
11389 & range = time_range, quiet = quiet, &
11390 & flag_mpi_split = flag_mpi_split, &
11391 & returned_time = returned_time, &
11392 & flag_time_exist = flag_time_exist, &
11393 & err = err )
11394end subroutine historygetdouble7pointertimed
11396 & file, varname, array, time, &
11397 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11398 use dc_string, only: tochar, split
11399 use dc_types, only: string, dp, sp
11400 use dc_trace, only: dbgmessage
11401 use dc_url, only: url_chop_iorange, gt_equal
11402 use dc_present, only: present_and_true
11403 implicit none
11404 character(*), intent(in):: file, varname
11405 real(DP), intent(in):: time
11406 logical, intent(in), optional:: quiet
11407 real(SP), intent(out) :: array
11408 logical, intent(in), optional:: flag_mpi_split
11409 real(DP), intent(out), optional:: returned_time
11410 logical, intent(out), optional:: flag_time_exist
11411 logical, intent(out), optional:: err
11412 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11413 character(STRING), pointer:: carray (:)
11414 character(STRING):: tname
11415 interface
11416 subroutine historygetreal0(&
11417 & file, varname, array, range, quiet, &
11418 & flag_mpi_split, returned_time, flag_time_exist, err)
11419 use dc_types, only: dp, sp
11420 character(*), intent(in):: file
11421 character(*), intent(in):: varname
11422 character(*), intent(in), optional:: range
11423 logical, intent(in), optional:: quiet
11424 logical, intent(in), optional:: flag_mpi_split
11425 real(DP), intent(out), optional:: returned_time
11426 logical, intent(out), optional:: flag_time_exist
11427 logical, intent(out), optional:: err
11428 real(SP), intent(out) :: array
11429 end subroutine historygetreal0
11430 end interface
11431 interface
11432 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11433 character(*), intent(in):: file
11434 character(*), intent(in):: varname
11435 character(*), intent(out):: url
11436 character(*), intent(in), optional:: range
11437 logical, intent(out), optional:: flag_time_exist
11438 character(*), intent(out), optional:: time_name
11439 logical, intent(out), optional:: err
11440 end subroutine lookup_growable_url
11441 end interface
11442 interface
11443 function file_rename_mpi( file ) result(result)
11444 use dc_types, only: string
11445 character(*), intent(in):: file
11446 character(STRING):: result
11447 end function file_rename_mpi
11448 end interface
11449 continue
11450 file_work = file
11451 if ( present_and_true( flag_mpi_split ) ) &
11452 & file_work = file_rename_mpi( file_work )
11453 call lookup_growable_url(file = file_work, varname = varname, &
11454 & url = url, &
11455 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11456 call url_chop_iorange( &
11457 & fullname = url, iorange = iorange, remainder = remainder )
11458 call split( str = iorange, carray = carray, sep = gt_equal )
11459 timevar_name = carray(1)
11460 deallocate( carray )
11461 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11462 call historygetreal0( file = file, &
11463 & varname = varname, array = array, &
11464 & range = time_range, quiet = quiet, &
11465 & flag_mpi_split = flag_mpi_split, &
11466 & returned_time = returned_time, &
11467 & flag_time_exist = flag_time_exist, &
11468 & err = err )
11469end subroutine historygetreal0timed
11471 & file, varname, array, time, &
11472 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11473 use dc_string, only: tochar, split
11474 use dc_types, only: string, dp, sp
11475 use dc_trace, only: dbgmessage
11476 use dc_url, only: url_chop_iorange, gt_equal
11477 use dc_present, only: present_and_true
11478 implicit none
11479 character(*), intent(in):: file, varname
11480 real(DP), intent(in):: time
11481 logical, intent(in), optional:: quiet
11482 real(SP), intent(out) :: array(:)
11483 logical, intent(in), optional:: flag_mpi_split
11484 real(DP), intent(out), optional:: returned_time
11485 logical, intent(out), optional:: flag_time_exist
11486 logical, intent(out), optional:: err
11487 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11488 character(STRING), pointer:: carray (:)
11489 character(STRING):: tname
11490 interface
11491 subroutine historygetreal1(&
11492 & file, varname, array, range, quiet, &
11493 & flag_mpi_split, returned_time, flag_time_exist, err)
11494 use dc_types, only: dp, sp
11495 character(*), intent(in):: file
11496 character(*), intent(in):: varname
11497 character(*), intent(in), optional:: range
11498 logical, intent(in), optional:: quiet
11499 logical, intent(in), optional:: flag_mpi_split
11500 real(DP), intent(out), optional:: returned_time
11501 logical, intent(out), optional:: flag_time_exist
11502 logical, intent(out), optional:: err
11503 real(SP), intent(out) :: array(:)
11504 end subroutine historygetreal1
11505 end interface
11506 interface
11507 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11508 character(*), intent(in):: file
11509 character(*), intent(in):: varname
11510 character(*), intent(out):: url
11511 character(*), intent(in), optional:: range
11512 logical, intent(out), optional:: flag_time_exist
11513 character(*), intent(out), optional:: time_name
11514 logical, intent(out), optional:: err
11515 end subroutine lookup_growable_url
11516 end interface
11517 interface
11518 function file_rename_mpi( file ) result(result)
11519 use dc_types, only: string
11520 character(*), intent(in):: file
11521 character(STRING):: result
11522 end function file_rename_mpi
11523 end interface
11524 continue
11525 file_work = file
11526 if ( present_and_true( flag_mpi_split ) ) &
11527 & file_work = file_rename_mpi( file_work )
11528 call lookup_growable_url(file = file_work, varname = varname, &
11529 & url = url, &
11530 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11531 call url_chop_iorange( &
11532 & fullname = url, iorange = iorange, remainder = remainder )
11533 call split( str = iorange, carray = carray, sep = gt_equal )
11534 timevar_name = carray(1)
11535 deallocate( carray )
11536 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11537 call historygetreal1( file = file, &
11538 & varname = varname, array = array, &
11539 & range = time_range, quiet = quiet, &
11540 & flag_mpi_split = flag_mpi_split, &
11541 & returned_time = returned_time, &
11542 & flag_time_exist = flag_time_exist, &
11543 & err = err )
11544end subroutine historygetreal1timed
11546 & file, varname, array, time, &
11547 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11548 use dc_string, only: tochar, split
11549 use dc_types, only: string, dp, sp
11550 use dc_trace, only: dbgmessage
11551 use dc_url, only: url_chop_iorange, gt_equal
11552 use dc_present, only: present_and_true
11553 implicit none
11554 character(*), intent(in):: file, varname
11555 real(DP), intent(in):: time
11556 logical, intent(in), optional:: quiet
11557 real(SP), intent(out) :: array(:,:)
11558 logical, intent(in), optional:: flag_mpi_split
11559 real(DP), intent(out), optional:: returned_time
11560 logical, intent(out), optional:: flag_time_exist
11561 logical, intent(out), optional:: err
11562 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11563 character(STRING), pointer:: carray (:)
11564 character(STRING):: tname
11565 interface
11566 subroutine historygetreal2(&
11567 & file, varname, array, range, quiet, &
11568 & flag_mpi_split, returned_time, flag_time_exist, err)
11569 use dc_types, only: dp, sp
11570 character(*), intent(in):: file
11571 character(*), intent(in):: varname
11572 character(*), intent(in), optional:: range
11573 logical, intent(in), optional:: quiet
11574 logical, intent(in), optional:: flag_mpi_split
11575 real(DP), intent(out), optional:: returned_time
11576 logical, intent(out), optional:: flag_time_exist
11577 logical, intent(out), optional:: err
11578 real(SP), intent(out) :: array(:,:)
11579 end subroutine historygetreal2
11580 end interface
11581 interface
11582 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11583 character(*), intent(in):: file
11584 character(*), intent(in):: varname
11585 character(*), intent(out):: url
11586 character(*), intent(in), optional:: range
11587 logical, intent(out), optional:: flag_time_exist
11588 character(*), intent(out), optional:: time_name
11589 logical, intent(out), optional:: err
11590 end subroutine lookup_growable_url
11591 end interface
11592 interface
11593 function file_rename_mpi( file ) result(result)
11594 use dc_types, only: string
11595 character(*), intent(in):: file
11596 character(STRING):: result
11597 end function file_rename_mpi
11598 end interface
11599 continue
11600 file_work = file
11601 if ( present_and_true( flag_mpi_split ) ) &
11602 & file_work = file_rename_mpi( file_work )
11603 call lookup_growable_url(file = file_work, varname = varname, &
11604 & url = url, &
11605 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11606 call url_chop_iorange( &
11607 & fullname = url, iorange = iorange, remainder = remainder )
11608 call split( str = iorange, carray = carray, sep = gt_equal )
11609 timevar_name = carray(1)
11610 deallocate( carray )
11611 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11612 call historygetreal2( file = file, &
11613 & varname = varname, array = array, &
11614 & range = time_range, quiet = quiet, &
11615 & flag_mpi_split = flag_mpi_split, &
11616 & returned_time = returned_time, &
11617 & flag_time_exist = flag_time_exist, &
11618 & err = err )
11619end subroutine historygetreal2timed
11621 & file, varname, array, time, &
11622 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11623 use dc_string, only: tochar, split
11624 use dc_types, only: string, dp, sp
11625 use dc_trace, only: dbgmessage
11626 use dc_url, only: url_chop_iorange, gt_equal
11627 use dc_present, only: present_and_true
11628 implicit none
11629 character(*), intent(in):: file, varname
11630 real(DP), intent(in):: time
11631 logical, intent(in), optional:: quiet
11632 real(SP), intent(out) :: array(:,:,:)
11633 logical, intent(in), optional:: flag_mpi_split
11634 real(DP), intent(out), optional:: returned_time
11635 logical, intent(out), optional:: flag_time_exist
11636 logical, intent(out), optional:: err
11637 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11638 character(STRING), pointer:: carray (:)
11639 character(STRING):: tname
11640 interface
11641 subroutine historygetreal3(&
11642 & file, varname, array, range, quiet, &
11643 & flag_mpi_split, returned_time, flag_time_exist, err)
11644 use dc_types, only: dp, sp
11645 character(*), intent(in):: file
11646 character(*), intent(in):: varname
11647 character(*), intent(in), optional:: range
11648 logical, intent(in), optional:: quiet
11649 logical, intent(in), optional:: flag_mpi_split
11650 real(DP), intent(out), optional:: returned_time
11651 logical, intent(out), optional:: flag_time_exist
11652 logical, intent(out), optional:: err
11653 real(SP), intent(out) :: array(:,:,:)
11654 end subroutine historygetreal3
11655 end interface
11656 interface
11657 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11658 character(*), intent(in):: file
11659 character(*), intent(in):: varname
11660 character(*), intent(out):: url
11661 character(*), intent(in), optional:: range
11662 logical, intent(out), optional:: flag_time_exist
11663 character(*), intent(out), optional:: time_name
11664 logical, intent(out), optional:: err
11665 end subroutine lookup_growable_url
11666 end interface
11667 interface
11668 function file_rename_mpi( file ) result(result)
11669 use dc_types, only: string
11670 character(*), intent(in):: file
11671 character(STRING):: result
11672 end function file_rename_mpi
11673 end interface
11674 continue
11675 file_work = file
11676 if ( present_and_true( flag_mpi_split ) ) &
11677 & file_work = file_rename_mpi( file_work )
11678 call lookup_growable_url(file = file_work, varname = varname, &
11679 & url = url, &
11680 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11681 call url_chop_iorange( &
11682 & fullname = url, iorange = iorange, remainder = remainder )
11683 call split( str = iorange, carray = carray, sep = gt_equal )
11684 timevar_name = carray(1)
11685 deallocate( carray )
11686 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11687 call historygetreal3( file = file, &
11688 & varname = varname, array = array, &
11689 & range = time_range, quiet = quiet, &
11690 & flag_mpi_split = flag_mpi_split, &
11691 & returned_time = returned_time, &
11692 & flag_time_exist = flag_time_exist, &
11693 & err = err )
11694end subroutine historygetreal3timed
11696 & file, varname, array, time, &
11697 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11698 use dc_string, only: tochar, split
11699 use dc_types, only: string, dp, sp
11700 use dc_trace, only: dbgmessage
11701 use dc_url, only: url_chop_iorange, gt_equal
11702 use dc_present, only: present_and_true
11703 implicit none
11704 character(*), intent(in):: file, varname
11705 real(DP), intent(in):: time
11706 logical, intent(in), optional:: quiet
11707 real(SP), intent(out) :: array(:,:,:,:)
11708 logical, intent(in), optional:: flag_mpi_split
11709 real(DP), intent(out), optional:: returned_time
11710 logical, intent(out), optional:: flag_time_exist
11711 logical, intent(out), optional:: err
11712 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11713 character(STRING), pointer:: carray (:)
11714 character(STRING):: tname
11715 interface
11716 subroutine historygetreal4(&
11717 & file, varname, array, range, quiet, &
11718 & flag_mpi_split, returned_time, flag_time_exist, err)
11719 use dc_types, only: dp, sp
11720 character(*), intent(in):: file
11721 character(*), intent(in):: varname
11722 character(*), intent(in), optional:: range
11723 logical, intent(in), optional:: quiet
11724 logical, intent(in), optional:: flag_mpi_split
11725 real(DP), intent(out), optional:: returned_time
11726 logical, intent(out), optional:: flag_time_exist
11727 logical, intent(out), optional:: err
11728 real(SP), intent(out) :: array(:,:,:,:)
11729 end subroutine historygetreal4
11730 end interface
11731 interface
11732 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11733 character(*), intent(in):: file
11734 character(*), intent(in):: varname
11735 character(*), intent(out):: url
11736 character(*), intent(in), optional:: range
11737 logical, intent(out), optional:: flag_time_exist
11738 character(*), intent(out), optional:: time_name
11739 logical, intent(out), optional:: err
11740 end subroutine lookup_growable_url
11741 end interface
11742 interface
11743 function file_rename_mpi( file ) result(result)
11744 use dc_types, only: string
11745 character(*), intent(in):: file
11746 character(STRING):: result
11747 end function file_rename_mpi
11748 end interface
11749 continue
11750 file_work = file
11751 if ( present_and_true( flag_mpi_split ) ) &
11752 & file_work = file_rename_mpi( file_work )
11753 call lookup_growable_url(file = file_work, varname = varname, &
11754 & url = url, &
11755 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11756 call url_chop_iorange( &
11757 & fullname = url, iorange = iorange, remainder = remainder )
11758 call split( str = iorange, carray = carray, sep = gt_equal )
11759 timevar_name = carray(1)
11760 deallocate( carray )
11761 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11762 call historygetreal4( file = file, &
11763 & varname = varname, array = array, &
11764 & range = time_range, quiet = quiet, &
11765 & flag_mpi_split = flag_mpi_split, &
11766 & returned_time = returned_time, &
11767 & flag_time_exist = flag_time_exist, &
11768 & err = err )
11769end subroutine historygetreal4timed
11771 & file, varname, array, time, &
11772 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11773 use dc_string, only: tochar, split
11774 use dc_types, only: string, dp, sp
11775 use dc_trace, only: dbgmessage
11776 use dc_url, only: url_chop_iorange, gt_equal
11777 use dc_present, only: present_and_true
11778 implicit none
11779 character(*), intent(in):: file, varname
11780 real(DP), intent(in):: time
11781 logical, intent(in), optional:: quiet
11782 real(SP), intent(out) :: array(:,:,:,:,:)
11783 logical, intent(in), optional:: flag_mpi_split
11784 real(DP), intent(out), optional:: returned_time
11785 logical, intent(out), optional:: flag_time_exist
11786 logical, intent(out), optional:: err
11787 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11788 character(STRING), pointer:: carray (:)
11789 character(STRING):: tname
11790 interface
11791 subroutine historygetreal5(&
11792 & file, varname, array, range, quiet, &
11793 & flag_mpi_split, returned_time, flag_time_exist, err)
11794 use dc_types, only: dp, sp
11795 character(*), intent(in):: file
11796 character(*), intent(in):: varname
11797 character(*), intent(in), optional:: range
11798 logical, intent(in), optional:: quiet
11799 logical, intent(in), optional:: flag_mpi_split
11800 real(DP), intent(out), optional:: returned_time
11801 logical, intent(out), optional:: flag_time_exist
11802 logical, intent(out), optional:: err
11803 real(SP), intent(out) :: array(:,:,:,:,:)
11804 end subroutine historygetreal5
11805 end interface
11806 interface
11807 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11808 character(*), intent(in):: file
11809 character(*), intent(in):: varname
11810 character(*), intent(out):: url
11811 character(*), intent(in), optional:: range
11812 logical, intent(out), optional:: flag_time_exist
11813 character(*), intent(out), optional:: time_name
11814 logical, intent(out), optional:: err
11815 end subroutine lookup_growable_url
11816 end interface
11817 interface
11818 function file_rename_mpi( file ) result(result)
11819 use dc_types, only: string
11820 character(*), intent(in):: file
11821 character(STRING):: result
11822 end function file_rename_mpi
11823 end interface
11824 continue
11825 file_work = file
11826 if ( present_and_true( flag_mpi_split ) ) &
11827 & file_work = file_rename_mpi( file_work )
11828 call lookup_growable_url(file = file_work, varname = varname, &
11829 & url = url, &
11830 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11831 call url_chop_iorange( &
11832 & fullname = url, iorange = iorange, remainder = remainder )
11833 call split( str = iorange, carray = carray, sep = gt_equal )
11834 timevar_name = carray(1)
11835 deallocate( carray )
11836 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11837 call historygetreal5( file = file, &
11838 & varname = varname, array = array, &
11839 & range = time_range, quiet = quiet, &
11840 & flag_mpi_split = flag_mpi_split, &
11841 & returned_time = returned_time, &
11842 & flag_time_exist = flag_time_exist, &
11843 & err = err )
11844end subroutine historygetreal5timed
11846 & file, varname, array, time, &
11847 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11848 use dc_string, only: tochar, split
11849 use dc_types, only: string, dp, sp
11850 use dc_trace, only: dbgmessage
11851 use dc_url, only: url_chop_iorange, gt_equal
11852 use dc_present, only: present_and_true
11853 implicit none
11854 character(*), intent(in):: file, varname
11855 real(DP), intent(in):: time
11856 logical, intent(in), optional:: quiet
11857 real(SP), intent(out) :: array(:,:,:,:,:,:)
11858 logical, intent(in), optional:: flag_mpi_split
11859 real(DP), intent(out), optional:: returned_time
11860 logical, intent(out), optional:: flag_time_exist
11861 logical, intent(out), optional:: err
11862 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11863 character(STRING), pointer:: carray (:)
11864 character(STRING):: tname
11865 interface
11866 subroutine historygetreal6(&
11867 & file, varname, array, range, quiet, &
11868 & flag_mpi_split, returned_time, flag_time_exist, err)
11869 use dc_types, only: dp, sp
11870 character(*), intent(in):: file
11871 character(*), intent(in):: varname
11872 character(*), intent(in), optional:: range
11873 logical, intent(in), optional:: quiet
11874 logical, intent(in), optional:: flag_mpi_split
11875 real(DP), intent(out), optional:: returned_time
11876 logical, intent(out), optional:: flag_time_exist
11877 logical, intent(out), optional:: err
11878 real(SP), intent(out) :: array(:,:,:,:,:,:)
11879 end subroutine historygetreal6
11880 end interface
11881 interface
11882 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11883 character(*), intent(in):: file
11884 character(*), intent(in):: varname
11885 character(*), intent(out):: url
11886 character(*), intent(in), optional:: range
11887 logical, intent(out), optional:: flag_time_exist
11888 character(*), intent(out), optional:: time_name
11889 logical, intent(out), optional:: err
11890 end subroutine lookup_growable_url
11891 end interface
11892 interface
11893 function file_rename_mpi( file ) result(result)
11894 use dc_types, only: string
11895 character(*), intent(in):: file
11896 character(STRING):: result
11897 end function file_rename_mpi
11898 end interface
11899 continue
11900 file_work = file
11901 if ( present_and_true( flag_mpi_split ) ) &
11902 & file_work = file_rename_mpi( file_work )
11903 call lookup_growable_url(file = file_work, varname = varname, &
11904 & url = url, &
11905 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11906 call url_chop_iorange( &
11907 & fullname = url, iorange = iorange, remainder = remainder )
11908 call split( str = iorange, carray = carray, sep = gt_equal )
11909 timevar_name = carray(1)
11910 deallocate( carray )
11911 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11912 call historygetreal6( file = file, &
11913 & varname = varname, array = array, &
11914 & range = time_range, quiet = quiet, &
11915 & flag_mpi_split = flag_mpi_split, &
11916 & returned_time = returned_time, &
11917 & flag_time_exist = flag_time_exist, &
11918 & err = err )
11919end subroutine historygetreal6timed
11921 & file, varname, array, time, &
11922 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11923 use dc_string, only: tochar, split
11924 use dc_types, only: string, dp, sp
11925 use dc_trace, only: dbgmessage
11926 use dc_url, only: url_chop_iorange, gt_equal
11927 use dc_present, only: present_and_true
11928 implicit none
11929 character(*), intent(in):: file, varname
11930 real(DP), intent(in):: time
11931 logical, intent(in), optional:: quiet
11932 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
11933 logical, intent(in), optional:: flag_mpi_split
11934 real(DP), intent(out), optional:: returned_time
11935 logical, intent(out), optional:: flag_time_exist
11936 logical, intent(out), optional:: err
11937 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
11938 character(STRING), pointer:: carray (:)
11939 character(STRING):: tname
11940 interface
11941 subroutine historygetreal7(&
11942 & file, varname, array, range, quiet, &
11943 & flag_mpi_split, returned_time, flag_time_exist, err)
11944 use dc_types, only: dp, sp
11945 character(*), intent(in):: file
11946 character(*), intent(in):: varname
11947 character(*), intent(in), optional:: range
11948 logical, intent(in), optional:: quiet
11949 logical, intent(in), optional:: flag_mpi_split
11950 real(DP), intent(out), optional:: returned_time
11951 logical, intent(out), optional:: flag_time_exist
11952 logical, intent(out), optional:: err
11953 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
11954 end subroutine historygetreal7
11955 end interface
11956 interface
11957 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
11958 character(*), intent(in):: file
11959 character(*), intent(in):: varname
11960 character(*), intent(out):: url
11961 character(*), intent(in), optional:: range
11962 logical, intent(out), optional:: flag_time_exist
11963 character(*), intent(out), optional:: time_name
11964 logical, intent(out), optional:: err
11965 end subroutine lookup_growable_url
11966 end interface
11967 interface
11968 function file_rename_mpi( file ) result(result)
11969 use dc_types, only: string
11970 character(*), intent(in):: file
11971 character(STRING):: result
11972 end function file_rename_mpi
11973 end interface
11974 continue
11975 file_work = file
11976 if ( present_and_true( flag_mpi_split ) ) &
11977 & file_work = file_rename_mpi( file_work )
11978 call lookup_growable_url(file = file_work, varname = varname, &
11979 & url = url, &
11980 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
11981 call url_chop_iorange( &
11982 & fullname = url, iorange = iorange, remainder = remainder )
11983 call split( str = iorange, carray = carray, sep = gt_equal )
11984 timevar_name = carray(1)
11985 deallocate( carray )
11986 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
11987 call historygetreal7( file = file, &
11988 & varname = varname, array = array, &
11989 & range = time_range, quiet = quiet, &
11990 & flag_mpi_split = flag_mpi_split, &
11991 & returned_time = returned_time, &
11992 & flag_time_exist = flag_time_exist, &
11993 & err = err )
11994end subroutine historygetreal7timed
11996 & file, varname, array, time, &
11997 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
11998 use dc_string, only: tochar, split
11999 use dc_types, only: string, dp, sp
12000 use dc_trace, only: dbgmessage
12001 use dc_url, only: url_chop_iorange, gt_equal
12002 use dc_present, only: present_and_true
12003 implicit none
12004 character(*), intent(in):: file, varname
12005 real(DP), intent(in):: time
12006 logical, intent(in), optional:: quiet
12007 real(SP), pointer :: array
12008 logical, intent(in), optional:: flag_mpi_split
12009 real(DP), intent(out), optional:: returned_time
12010 logical, intent(out), optional:: flag_time_exist
12011 logical, intent(out), optional:: err
12012 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12013 character(STRING), pointer:: carray (:)
12014 character(STRING):: tname
12015 interface
12016 subroutine historygetreal0pointer(&
12017 & file, varname, array, range, quiet, &
12018 & flag_mpi_split, returned_time, flag_time_exist, err)
12019 use dc_types, only: dp, sp
12020 character(*), intent(in):: file
12021 character(*), intent(in):: varname
12022 character(*), intent(in), optional:: range
12023 logical, intent(in), optional:: quiet
12024 logical, intent(in), optional:: flag_mpi_split
12025 real(DP), intent(out), optional:: returned_time
12026 logical, intent(out), optional:: flag_time_exist
12027 logical, intent(out), optional:: err
12028 real(SP), pointer :: array
12029 end subroutine historygetreal0pointer
12030 end interface
12031 interface
12032 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12033 character(*), intent(in):: file
12034 character(*), intent(in):: varname
12035 character(*), intent(out):: url
12036 character(*), intent(in), optional:: range
12037 logical, intent(out), optional:: flag_time_exist
12038 character(*), intent(out), optional:: time_name
12039 logical, intent(out), optional:: err
12040 end subroutine lookup_growable_url
12041 end interface
12042 interface
12043 function file_rename_mpi( file ) result(result)
12044 use dc_types, only: string
12045 character(*), intent(in):: file
12046 character(STRING):: result
12047 end function file_rename_mpi
12048 end interface
12049 continue
12050 file_work = file
12051 if ( present_and_true( flag_mpi_split ) ) &
12052 & file_work = file_rename_mpi( file_work )
12053 call lookup_growable_url(file = file_work, varname = varname, &
12054 & url = url, &
12055 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12056 call url_chop_iorange( &
12057 & fullname = url, iorange = iorange, remainder = remainder )
12058 call split( str = iorange, carray = carray, sep = gt_equal )
12059 timevar_name = carray(1)
12060 deallocate( carray )
12061 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12062 call historygetreal0pointer( file = file, &
12063 & varname = varname, array = array, &
12064 & range = time_range, quiet = quiet, &
12065 & flag_mpi_split = flag_mpi_split, &
12066 & returned_time = returned_time, &
12067 & flag_time_exist = flag_time_exist, &
12068 & err = err )
12069end subroutine historygetreal0pointertimed
12071 & file, varname, array, time, &
12072 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12073 use dc_string, only: tochar, split
12074 use dc_types, only: string, dp, sp
12075 use dc_trace, only: dbgmessage
12076 use dc_url, only: url_chop_iorange, gt_equal
12077 use dc_present, only: present_and_true
12078 implicit none
12079 character(*), intent(in):: file, varname
12080 real(DP), intent(in):: time
12081 logical, intent(in), optional:: quiet
12082 real(SP), pointer :: array(:)
12083 logical, intent(in), optional:: flag_mpi_split
12084 real(DP), intent(out), optional:: returned_time
12085 logical, intent(out), optional:: flag_time_exist
12086 logical, intent(out), optional:: err
12087 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12088 character(STRING), pointer:: carray (:)
12089 character(STRING):: tname
12090 interface
12091 subroutine historygetreal1pointer(&
12092 & file, varname, array, range, quiet, &
12093 & flag_mpi_split, returned_time, flag_time_exist, err)
12094 use dc_types, only: dp, sp
12095 character(*), intent(in):: file
12096 character(*), intent(in):: varname
12097 character(*), intent(in), optional:: range
12098 logical, intent(in), optional:: quiet
12099 logical, intent(in), optional:: flag_mpi_split
12100 real(DP), intent(out), optional:: returned_time
12101 logical, intent(out), optional:: flag_time_exist
12102 logical, intent(out), optional:: err
12103 real(SP), pointer :: array(:)
12104 end subroutine historygetreal1pointer
12105 end interface
12106 interface
12107 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12108 character(*), intent(in):: file
12109 character(*), intent(in):: varname
12110 character(*), intent(out):: url
12111 character(*), intent(in), optional:: range
12112 logical, intent(out), optional:: flag_time_exist
12113 character(*), intent(out), optional:: time_name
12114 logical, intent(out), optional:: err
12115 end subroutine lookup_growable_url
12116 end interface
12117 interface
12118 function file_rename_mpi( file ) result(result)
12119 use dc_types, only: string
12120 character(*), intent(in):: file
12121 character(STRING):: result
12122 end function file_rename_mpi
12123 end interface
12124 continue
12125 file_work = file
12126 if ( present_and_true( flag_mpi_split ) ) &
12127 & file_work = file_rename_mpi( file_work )
12128 call lookup_growable_url(file = file_work, varname = varname, &
12129 & url = url, &
12130 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12131 call url_chop_iorange( &
12132 & fullname = url, iorange = iorange, remainder = remainder )
12133 call split( str = iorange, carray = carray, sep = gt_equal )
12134 timevar_name = carray(1)
12135 deallocate( carray )
12136 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12137 call historygetreal1pointer( file = file, &
12138 & varname = varname, array = array, &
12139 & range = time_range, quiet = quiet, &
12140 & flag_mpi_split = flag_mpi_split, &
12141 & returned_time = returned_time, &
12142 & flag_time_exist = flag_time_exist, &
12143 & err = err )
12144end subroutine historygetreal1pointertimed
12146 & file, varname, array, time, &
12147 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12148 use dc_string, only: tochar, split
12149 use dc_types, only: string, dp, sp
12150 use dc_trace, only: dbgmessage
12151 use dc_url, only: url_chop_iorange, gt_equal
12152 use dc_present, only: present_and_true
12153 implicit none
12154 character(*), intent(in):: file, varname
12155 real(DP), intent(in):: time
12156 logical, intent(in), optional:: quiet
12157 real(SP), pointer :: array(:,:)
12158 logical, intent(in), optional:: flag_mpi_split
12159 real(DP), intent(out), optional:: returned_time
12160 logical, intent(out), optional:: flag_time_exist
12161 logical, intent(out), optional:: err
12162 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12163 character(STRING), pointer:: carray (:)
12164 character(STRING):: tname
12165 interface
12166 subroutine historygetreal2pointer(&
12167 & file, varname, array, range, quiet, &
12168 & flag_mpi_split, returned_time, flag_time_exist, err)
12169 use dc_types, only: dp, sp
12170 character(*), intent(in):: file
12171 character(*), intent(in):: varname
12172 character(*), intent(in), optional:: range
12173 logical, intent(in), optional:: quiet
12174 logical, intent(in), optional:: flag_mpi_split
12175 real(DP), intent(out), optional:: returned_time
12176 logical, intent(out), optional:: flag_time_exist
12177 logical, intent(out), optional:: err
12178 real(SP), pointer :: array(:,:)
12179 end subroutine historygetreal2pointer
12180 end interface
12181 interface
12182 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12183 character(*), intent(in):: file
12184 character(*), intent(in):: varname
12185 character(*), intent(out):: url
12186 character(*), intent(in), optional:: range
12187 logical, intent(out), optional:: flag_time_exist
12188 character(*), intent(out), optional:: time_name
12189 logical, intent(out), optional:: err
12190 end subroutine lookup_growable_url
12191 end interface
12192 interface
12193 function file_rename_mpi( file ) result(result)
12194 use dc_types, only: string
12195 character(*), intent(in):: file
12196 character(STRING):: result
12197 end function file_rename_mpi
12198 end interface
12199 continue
12200 file_work = file
12201 if ( present_and_true( flag_mpi_split ) ) &
12202 & file_work = file_rename_mpi( file_work )
12203 call lookup_growable_url(file = file_work, varname = varname, &
12204 & url = url, &
12205 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12206 call url_chop_iorange( &
12207 & fullname = url, iorange = iorange, remainder = remainder )
12208 call split( str = iorange, carray = carray, sep = gt_equal )
12209 timevar_name = carray(1)
12210 deallocate( carray )
12211 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12212 call historygetreal2pointer( file = file, &
12213 & varname = varname, array = array, &
12214 & range = time_range, quiet = quiet, &
12215 & flag_mpi_split = flag_mpi_split, &
12216 & returned_time = returned_time, &
12217 & flag_time_exist = flag_time_exist, &
12218 & err = err )
12219end subroutine historygetreal2pointertimed
12221 & file, varname, array, time, &
12222 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12223 use dc_string, only: tochar, split
12224 use dc_types, only: string, dp, sp
12225 use dc_trace, only: dbgmessage
12226 use dc_url, only: url_chop_iorange, gt_equal
12227 use dc_present, only: present_and_true
12228 implicit none
12229 character(*), intent(in):: file, varname
12230 real(DP), intent(in):: time
12231 logical, intent(in), optional:: quiet
12232 real(SP), pointer :: array(:,:,:)
12233 logical, intent(in), optional:: flag_mpi_split
12234 real(DP), intent(out), optional:: returned_time
12235 logical, intent(out), optional:: flag_time_exist
12236 logical, intent(out), optional:: err
12237 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12238 character(STRING), pointer:: carray (:)
12239 character(STRING):: tname
12240 interface
12241 subroutine historygetreal3pointer(&
12242 & file, varname, array, range, quiet, &
12243 & flag_mpi_split, returned_time, flag_time_exist, err)
12244 use dc_types, only: dp, sp
12245 character(*), intent(in):: file
12246 character(*), intent(in):: varname
12247 character(*), intent(in), optional:: range
12248 logical, intent(in), optional:: quiet
12249 logical, intent(in), optional:: flag_mpi_split
12250 real(DP), intent(out), optional:: returned_time
12251 logical, intent(out), optional:: flag_time_exist
12252 logical, intent(out), optional:: err
12253 real(SP), pointer :: array(:,:,:)
12254 end subroutine historygetreal3pointer
12255 end interface
12256 interface
12257 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12258 character(*), intent(in):: file
12259 character(*), intent(in):: varname
12260 character(*), intent(out):: url
12261 character(*), intent(in), optional:: range
12262 logical, intent(out), optional:: flag_time_exist
12263 character(*), intent(out), optional:: time_name
12264 logical, intent(out), optional:: err
12265 end subroutine lookup_growable_url
12266 end interface
12267 interface
12268 function file_rename_mpi( file ) result(result)
12269 use dc_types, only: string
12270 character(*), intent(in):: file
12271 character(STRING):: result
12272 end function file_rename_mpi
12273 end interface
12274 continue
12275 file_work = file
12276 if ( present_and_true( flag_mpi_split ) ) &
12277 & file_work = file_rename_mpi( file_work )
12278 call lookup_growable_url(file = file_work, varname = varname, &
12279 & url = url, &
12280 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12281 call url_chop_iorange( &
12282 & fullname = url, iorange = iorange, remainder = remainder )
12283 call split( str = iorange, carray = carray, sep = gt_equal )
12284 timevar_name = carray(1)
12285 deallocate( carray )
12286 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12287 call historygetreal3pointer( file = file, &
12288 & varname = varname, array = array, &
12289 & range = time_range, quiet = quiet, &
12290 & flag_mpi_split = flag_mpi_split, &
12291 & returned_time = returned_time, &
12292 & flag_time_exist = flag_time_exist, &
12293 & err = err )
12294end subroutine historygetreal3pointertimed
12296 & file, varname, array, time, &
12297 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12298 use dc_string, only: tochar, split
12299 use dc_types, only: string, dp, sp
12300 use dc_trace, only: dbgmessage
12301 use dc_url, only: url_chop_iorange, gt_equal
12302 use dc_present, only: present_and_true
12303 implicit none
12304 character(*), intent(in):: file, varname
12305 real(DP), intent(in):: time
12306 logical, intent(in), optional:: quiet
12307 real(SP), pointer :: array(:,:,:,:)
12308 logical, intent(in), optional:: flag_mpi_split
12309 real(DP), intent(out), optional:: returned_time
12310 logical, intent(out), optional:: flag_time_exist
12311 logical, intent(out), optional:: err
12312 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12313 character(STRING), pointer:: carray (:)
12314 character(STRING):: tname
12315 interface
12316 subroutine historygetreal4pointer(&
12317 & file, varname, array, range, quiet, &
12318 & flag_mpi_split, returned_time, flag_time_exist, err)
12319 use dc_types, only: dp, sp
12320 character(*), intent(in):: file
12321 character(*), intent(in):: varname
12322 character(*), intent(in), optional:: range
12323 logical, intent(in), optional:: quiet
12324 logical, intent(in), optional:: flag_mpi_split
12325 real(DP), intent(out), optional:: returned_time
12326 logical, intent(out), optional:: flag_time_exist
12327 logical, intent(out), optional:: err
12328 real(SP), pointer :: array(:,:,:,:)
12329 end subroutine historygetreal4pointer
12330 end interface
12331 interface
12332 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12333 character(*), intent(in):: file
12334 character(*), intent(in):: varname
12335 character(*), intent(out):: url
12336 character(*), intent(in), optional:: range
12337 logical, intent(out), optional:: flag_time_exist
12338 character(*), intent(out), optional:: time_name
12339 logical, intent(out), optional:: err
12340 end subroutine lookup_growable_url
12341 end interface
12342 interface
12343 function file_rename_mpi( file ) result(result)
12344 use dc_types, only: string
12345 character(*), intent(in):: file
12346 character(STRING):: result
12347 end function file_rename_mpi
12348 end interface
12349 continue
12350 file_work = file
12351 if ( present_and_true( flag_mpi_split ) ) &
12352 & file_work = file_rename_mpi( file_work )
12353 call lookup_growable_url(file = file_work, varname = varname, &
12354 & url = url, &
12355 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12356 call url_chop_iorange( &
12357 & fullname = url, iorange = iorange, remainder = remainder )
12358 call split( str = iorange, carray = carray, sep = gt_equal )
12359 timevar_name = carray(1)
12360 deallocate( carray )
12361 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12362 call historygetreal4pointer( file = file, &
12363 & varname = varname, array = array, &
12364 & range = time_range, quiet = quiet, &
12365 & flag_mpi_split = flag_mpi_split, &
12366 & returned_time = returned_time, &
12367 & flag_time_exist = flag_time_exist, &
12368 & err = err )
12369end subroutine historygetreal4pointertimed
12371 & file, varname, array, time, &
12372 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12373 use dc_string, only: tochar, split
12374 use dc_types, only: string, dp, sp
12375 use dc_trace, only: dbgmessage
12376 use dc_url, only: url_chop_iorange, gt_equal
12377 use dc_present, only: present_and_true
12378 implicit none
12379 character(*), intent(in):: file, varname
12380 real(DP), intent(in):: time
12381 logical, intent(in), optional:: quiet
12382 real(SP), pointer :: array(:,:,:,:,:)
12383 logical, intent(in), optional:: flag_mpi_split
12384 real(DP), intent(out), optional:: returned_time
12385 logical, intent(out), optional:: flag_time_exist
12386 logical, intent(out), optional:: err
12387 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12388 character(STRING), pointer:: carray (:)
12389 character(STRING):: tname
12390 interface
12391 subroutine historygetreal5pointer(&
12392 & file, varname, array, range, quiet, &
12393 & flag_mpi_split, returned_time, flag_time_exist, err)
12394 use dc_types, only: dp, sp
12395 character(*), intent(in):: file
12396 character(*), intent(in):: varname
12397 character(*), intent(in), optional:: range
12398 logical, intent(in), optional:: quiet
12399 logical, intent(in), optional:: flag_mpi_split
12400 real(DP), intent(out), optional:: returned_time
12401 logical, intent(out), optional:: flag_time_exist
12402 logical, intent(out), optional:: err
12403 real(SP), pointer :: array(:,:,:,:,:)
12404 end subroutine historygetreal5pointer
12405 end interface
12406 interface
12407 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12408 character(*), intent(in):: file
12409 character(*), intent(in):: varname
12410 character(*), intent(out):: url
12411 character(*), intent(in), optional:: range
12412 logical, intent(out), optional:: flag_time_exist
12413 character(*), intent(out), optional:: time_name
12414 logical, intent(out), optional:: err
12415 end subroutine lookup_growable_url
12416 end interface
12417 interface
12418 function file_rename_mpi( file ) result(result)
12419 use dc_types, only: string
12420 character(*), intent(in):: file
12421 character(STRING):: result
12422 end function file_rename_mpi
12423 end interface
12424 continue
12425 file_work = file
12426 if ( present_and_true( flag_mpi_split ) ) &
12427 & file_work = file_rename_mpi( file_work )
12428 call lookup_growable_url(file = file_work, varname = varname, &
12429 & url = url, &
12430 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12431 call url_chop_iorange( &
12432 & fullname = url, iorange = iorange, remainder = remainder )
12433 call split( str = iorange, carray = carray, sep = gt_equal )
12434 timevar_name = carray(1)
12435 deallocate( carray )
12436 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12437 call historygetreal5pointer( file = file, &
12438 & varname = varname, array = array, &
12439 & range = time_range, quiet = quiet, &
12440 & flag_mpi_split = flag_mpi_split, &
12441 & returned_time = returned_time, &
12442 & flag_time_exist = flag_time_exist, &
12443 & err = err )
12444end subroutine historygetreal5pointertimed
12446 & file, varname, array, time, &
12447 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12448 use dc_string, only: tochar, split
12449 use dc_types, only: string, dp, sp
12450 use dc_trace, only: dbgmessage
12451 use dc_url, only: url_chop_iorange, gt_equal
12452 use dc_present, only: present_and_true
12453 implicit none
12454 character(*), intent(in):: file, varname
12455 real(DP), intent(in):: time
12456 logical, intent(in), optional:: quiet
12457 real(SP), pointer :: array(:,:,:,:,:,:)
12458 logical, intent(in), optional:: flag_mpi_split
12459 real(DP), intent(out), optional:: returned_time
12460 logical, intent(out), optional:: flag_time_exist
12461 logical, intent(out), optional:: err
12462 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12463 character(STRING), pointer:: carray (:)
12464 character(STRING):: tname
12465 interface
12466 subroutine historygetreal6pointer(&
12467 & file, varname, array, range, quiet, &
12468 & flag_mpi_split, returned_time, flag_time_exist, err)
12469 use dc_types, only: dp, sp
12470 character(*), intent(in):: file
12471 character(*), intent(in):: varname
12472 character(*), intent(in), optional:: range
12473 logical, intent(in), optional:: quiet
12474 logical, intent(in), optional:: flag_mpi_split
12475 real(DP), intent(out), optional:: returned_time
12476 logical, intent(out), optional:: flag_time_exist
12477 logical, intent(out), optional:: err
12478 real(SP), pointer :: array(:,:,:,:,:,:)
12479 end subroutine historygetreal6pointer
12480 end interface
12481 interface
12482 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12483 character(*), intent(in):: file
12484 character(*), intent(in):: varname
12485 character(*), intent(out):: url
12486 character(*), intent(in), optional:: range
12487 logical, intent(out), optional:: flag_time_exist
12488 character(*), intent(out), optional:: time_name
12489 logical, intent(out), optional:: err
12490 end subroutine lookup_growable_url
12491 end interface
12492 interface
12493 function file_rename_mpi( file ) result(result)
12494 use dc_types, only: string
12495 character(*), intent(in):: file
12496 character(STRING):: result
12497 end function file_rename_mpi
12498 end interface
12499 continue
12500 file_work = file
12501 if ( present_and_true( flag_mpi_split ) ) &
12502 & file_work = file_rename_mpi( file_work )
12503 call lookup_growable_url(file = file_work, varname = varname, &
12504 & url = url, &
12505 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12506 call url_chop_iorange( &
12507 & fullname = url, iorange = iorange, remainder = remainder )
12508 call split( str = iorange, carray = carray, sep = gt_equal )
12509 timevar_name = carray(1)
12510 deallocate( carray )
12511 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12512 call historygetreal6pointer( file = file, &
12513 & varname = varname, array = array, &
12514 & range = time_range, quiet = quiet, &
12515 & flag_mpi_split = flag_mpi_split, &
12516 & returned_time = returned_time, &
12517 & flag_time_exist = flag_time_exist, &
12518 & err = err )
12519end subroutine historygetreal6pointertimed
12521 & file, varname, array, time, &
12522 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12523 use dc_string, only: tochar, split
12524 use dc_types, only: string, dp, sp
12525 use dc_trace, only: dbgmessage
12526 use dc_url, only: url_chop_iorange, gt_equal
12527 use dc_present, only: present_and_true
12528 implicit none
12529 character(*), intent(in):: file, varname
12530 real(DP), intent(in):: time
12531 logical, intent(in), optional:: quiet
12532 real(SP), pointer :: array(:,:,:,:,:,:,:)
12533 logical, intent(in), optional:: flag_mpi_split
12534 real(DP), intent(out), optional:: returned_time
12535 logical, intent(out), optional:: flag_time_exist
12536 logical, intent(out), optional:: err
12537 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12538 character(STRING), pointer:: carray (:)
12539 character(STRING):: tname
12540 interface
12541 subroutine historygetreal7pointer(&
12542 & file, varname, array, range, quiet, &
12543 & flag_mpi_split, returned_time, flag_time_exist, err)
12544 use dc_types, only: dp, sp
12545 character(*), intent(in):: file
12546 character(*), intent(in):: varname
12547 character(*), intent(in), optional:: range
12548 logical, intent(in), optional:: quiet
12549 logical, intent(in), optional:: flag_mpi_split
12550 real(DP), intent(out), optional:: returned_time
12551 logical, intent(out), optional:: flag_time_exist
12552 logical, intent(out), optional:: err
12553 real(SP), pointer :: array(:,:,:,:,:,:,:)
12554 end subroutine historygetreal7pointer
12555 end interface
12556 interface
12557 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12558 character(*), intent(in):: file
12559 character(*), intent(in):: varname
12560 character(*), intent(out):: url
12561 character(*), intent(in), optional:: range
12562 logical, intent(out), optional:: flag_time_exist
12563 character(*), intent(out), optional:: time_name
12564 logical, intent(out), optional:: err
12565 end subroutine lookup_growable_url
12566 end interface
12567 interface
12568 function file_rename_mpi( file ) result(result)
12569 use dc_types, only: string
12570 character(*), intent(in):: file
12571 character(STRING):: result
12572 end function file_rename_mpi
12573 end interface
12574 continue
12575 file_work = file
12576 if ( present_and_true( flag_mpi_split ) ) &
12577 & file_work = file_rename_mpi( file_work )
12578 call lookup_growable_url(file = file_work, varname = varname, &
12579 & url = url, &
12580 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12581 call url_chop_iorange( &
12582 & fullname = url, iorange = iorange, remainder = remainder )
12583 call split( str = iorange, carray = carray, sep = gt_equal )
12584 timevar_name = carray(1)
12585 deallocate( carray )
12586 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12587 call historygetreal7pointer( file = file, &
12588 & varname = varname, array = array, &
12589 & range = time_range, quiet = quiet, &
12590 & flag_mpi_split = flag_mpi_split, &
12591 & returned_time = returned_time, &
12592 & flag_time_exist = flag_time_exist, &
12593 & err = err )
12594end subroutine historygetreal7pointertimed
12596 & file, varname, array, time, &
12597 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12598 use dc_string, only: tochar, split
12599 use dc_types, only: string, dp
12600 use dc_trace, only: dbgmessage
12601 use dc_url, only: url_chop_iorange, gt_equal
12602 use dc_present, only: present_and_true
12603 implicit none
12604 character(*), intent(in):: file, varname
12605 real(DP), intent(in):: time
12606 logical, intent(in), optional:: quiet
12607 integer, intent(out) :: array
12608 logical, intent(in), optional:: flag_mpi_split
12609 real(DP), intent(out), optional:: returned_time
12610 logical, intent(out), optional:: flag_time_exist
12611 logical, intent(out), optional:: err
12612 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12613 character(STRING), pointer:: carray (:)
12614 character(STRING):: tname
12615 interface
12616 subroutine historygetint0(&
12617 & file, varname, array, range, quiet, &
12618 & flag_mpi_split, returned_time, flag_time_exist, err)
12619 use dc_types, only: dp
12620 character(*), intent(in):: file
12621 character(*), intent(in):: varname
12622 character(*), intent(in), optional:: range
12623 logical, intent(in), optional:: quiet
12624 logical, intent(in), optional:: flag_mpi_split
12625 real(DP), intent(out), optional:: returned_time
12626 logical, intent(out), optional:: flag_time_exist
12627 logical, intent(out), optional:: err
12628 integer, intent(out) :: array
12629 end subroutine historygetint0
12630 end interface
12631 interface
12632 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12633 character(*), intent(in):: file
12634 character(*), intent(in):: varname
12635 character(*), intent(out):: url
12636 character(*), intent(in), optional:: range
12637 logical, intent(out), optional:: flag_time_exist
12638 character(*), intent(out), optional:: time_name
12639 logical, intent(out), optional:: err
12640 end subroutine lookup_growable_url
12641 end interface
12642 interface
12643 function file_rename_mpi( file ) result(result)
12644 use dc_types, only: string
12645 character(*), intent(in):: file
12646 character(STRING):: result
12647 end function file_rename_mpi
12648 end interface
12649 continue
12650 file_work = file
12651 if ( present_and_true( flag_mpi_split ) ) &
12652 & file_work = file_rename_mpi( file_work )
12653 call lookup_growable_url(file = file_work, varname = varname, &
12654 & url = url, &
12655 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12656 call url_chop_iorange( &
12657 & fullname = url, iorange = iorange, remainder = remainder )
12658 call split( str = iorange, carray = carray, sep = gt_equal )
12659 timevar_name = carray(1)
12660 deallocate( carray )
12661 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12662 call historygetint0( file = file, &
12663 & varname = varname, array = array, &
12664 & range = time_range, quiet = quiet, &
12665 & flag_mpi_split = flag_mpi_split, &
12666 & returned_time = returned_time, &
12667 & flag_time_exist = flag_time_exist, &
12668 & err = err )
12669end subroutine historygetint0timed
12671 & file, varname, array, time, &
12672 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12673 use dc_string, only: tochar, split
12674 use dc_types, only: string, dp
12675 use dc_trace, only: dbgmessage
12676 use dc_url, only: url_chop_iorange, gt_equal
12677 use dc_present, only: present_and_true
12678 implicit none
12679 character(*), intent(in):: file, varname
12680 real(DP), intent(in):: time
12681 logical, intent(in), optional:: quiet
12682 integer, intent(out) :: array(:)
12683 logical, intent(in), optional:: flag_mpi_split
12684 real(DP), intent(out), optional:: returned_time
12685 logical, intent(out), optional:: flag_time_exist
12686 logical, intent(out), optional:: err
12687 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12688 character(STRING), pointer:: carray (:)
12689 character(STRING):: tname
12690 interface
12691 subroutine historygetint1(&
12692 & file, varname, array, range, quiet, &
12693 & flag_mpi_split, returned_time, flag_time_exist, err)
12694 use dc_types, only: dp
12695 character(*), intent(in):: file
12696 character(*), intent(in):: varname
12697 character(*), intent(in), optional:: range
12698 logical, intent(in), optional:: quiet
12699 logical, intent(in), optional:: flag_mpi_split
12700 real(DP), intent(out), optional:: returned_time
12701 logical, intent(out), optional:: flag_time_exist
12702 logical, intent(out), optional:: err
12703 integer, intent(out) :: array(:)
12704 end subroutine historygetint1
12705 end interface
12706 interface
12707 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12708 character(*), intent(in):: file
12709 character(*), intent(in):: varname
12710 character(*), intent(out):: url
12711 character(*), intent(in), optional:: range
12712 logical, intent(out), optional:: flag_time_exist
12713 character(*), intent(out), optional:: time_name
12714 logical, intent(out), optional:: err
12715 end subroutine lookup_growable_url
12716 end interface
12717 interface
12718 function file_rename_mpi( file ) result(result)
12719 use dc_types, only: string
12720 character(*), intent(in):: file
12721 character(STRING):: result
12722 end function file_rename_mpi
12723 end interface
12724 continue
12725 file_work = file
12726 if ( present_and_true( flag_mpi_split ) ) &
12727 & file_work = file_rename_mpi( file_work )
12728 call lookup_growable_url(file = file_work, varname = varname, &
12729 & url = url, &
12730 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12731 call url_chop_iorange( &
12732 & fullname = url, iorange = iorange, remainder = remainder )
12733 call split( str = iorange, carray = carray, sep = gt_equal )
12734 timevar_name = carray(1)
12735 deallocate( carray )
12736 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12737 call historygetint1( file = file, &
12738 & varname = varname, array = array, &
12739 & range = time_range, quiet = quiet, &
12740 & flag_mpi_split = flag_mpi_split, &
12741 & returned_time = returned_time, &
12742 & flag_time_exist = flag_time_exist, &
12743 & err = err )
12744end subroutine historygetint1timed
12746 & file, varname, array, time, &
12747 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12748 use dc_string, only: tochar, split
12749 use dc_types, only: string, dp
12750 use dc_trace, only: dbgmessage
12751 use dc_url, only: url_chop_iorange, gt_equal
12752 use dc_present, only: present_and_true
12753 implicit none
12754 character(*), intent(in):: file, varname
12755 real(DP), intent(in):: time
12756 logical, intent(in), optional:: quiet
12757 integer, intent(out) :: array(:,:)
12758 logical, intent(in), optional:: flag_mpi_split
12759 real(DP), intent(out), optional:: returned_time
12760 logical, intent(out), optional:: flag_time_exist
12761 logical, intent(out), optional:: err
12762 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12763 character(STRING), pointer:: carray (:)
12764 character(STRING):: tname
12765 interface
12766 subroutine historygetint2(&
12767 & file, varname, array, range, quiet, &
12768 & flag_mpi_split, returned_time, flag_time_exist, err)
12769 use dc_types, only: dp
12770 character(*), intent(in):: file
12771 character(*), intent(in):: varname
12772 character(*), intent(in), optional:: range
12773 logical, intent(in), optional:: quiet
12774 logical, intent(in), optional:: flag_mpi_split
12775 real(DP), intent(out), optional:: returned_time
12776 logical, intent(out), optional:: flag_time_exist
12777 logical, intent(out), optional:: err
12778 integer, intent(out) :: array(:,:)
12779 end subroutine historygetint2
12780 end interface
12781 interface
12782 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12783 character(*), intent(in):: file
12784 character(*), intent(in):: varname
12785 character(*), intent(out):: url
12786 character(*), intent(in), optional:: range
12787 logical, intent(out), optional:: flag_time_exist
12788 character(*), intent(out), optional:: time_name
12789 logical, intent(out), optional:: err
12790 end subroutine lookup_growable_url
12791 end interface
12792 interface
12793 function file_rename_mpi( file ) result(result)
12794 use dc_types, only: string
12795 character(*), intent(in):: file
12796 character(STRING):: result
12797 end function file_rename_mpi
12798 end interface
12799 continue
12800 file_work = file
12801 if ( present_and_true( flag_mpi_split ) ) &
12802 & file_work = file_rename_mpi( file_work )
12803 call lookup_growable_url(file = file_work, varname = varname, &
12804 & url = url, &
12805 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12806 call url_chop_iorange( &
12807 & fullname = url, iorange = iorange, remainder = remainder )
12808 call split( str = iorange, carray = carray, sep = gt_equal )
12809 timevar_name = carray(1)
12810 deallocate( carray )
12811 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12812 call historygetint2( file = file, &
12813 & varname = varname, array = array, &
12814 & range = time_range, quiet = quiet, &
12815 & flag_mpi_split = flag_mpi_split, &
12816 & returned_time = returned_time, &
12817 & flag_time_exist = flag_time_exist, &
12818 & err = err )
12819end subroutine historygetint2timed
12821 & file, varname, array, time, &
12822 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12823 use dc_string, only: tochar, split
12824 use dc_types, only: string, dp
12825 use dc_trace, only: dbgmessage
12826 use dc_url, only: url_chop_iorange, gt_equal
12827 use dc_present, only: present_and_true
12828 implicit none
12829 character(*), intent(in):: file, varname
12830 real(DP), intent(in):: time
12831 logical, intent(in), optional:: quiet
12832 integer, intent(out) :: array(:,:,:)
12833 logical, intent(in), optional:: flag_mpi_split
12834 real(DP), intent(out), optional:: returned_time
12835 logical, intent(out), optional:: flag_time_exist
12836 logical, intent(out), optional:: err
12837 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12838 character(STRING), pointer:: carray (:)
12839 character(STRING):: tname
12840 interface
12841 subroutine historygetint3(&
12842 & file, varname, array, range, quiet, &
12843 & flag_mpi_split, returned_time, flag_time_exist, err)
12844 use dc_types, only: dp
12845 character(*), intent(in):: file
12846 character(*), intent(in):: varname
12847 character(*), intent(in), optional:: range
12848 logical, intent(in), optional:: quiet
12849 logical, intent(in), optional:: flag_mpi_split
12850 real(DP), intent(out), optional:: returned_time
12851 logical, intent(out), optional:: flag_time_exist
12852 logical, intent(out), optional:: err
12853 integer, intent(out) :: array(:,:,:)
12854 end subroutine historygetint3
12855 end interface
12856 interface
12857 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12858 character(*), intent(in):: file
12859 character(*), intent(in):: varname
12860 character(*), intent(out):: url
12861 character(*), intent(in), optional:: range
12862 logical, intent(out), optional:: flag_time_exist
12863 character(*), intent(out), optional:: time_name
12864 logical, intent(out), optional:: err
12865 end subroutine lookup_growable_url
12866 end interface
12867 interface
12868 function file_rename_mpi( file ) result(result)
12869 use dc_types, only: string
12870 character(*), intent(in):: file
12871 character(STRING):: result
12872 end function file_rename_mpi
12873 end interface
12874 continue
12875 file_work = file
12876 if ( present_and_true( flag_mpi_split ) ) &
12877 & file_work = file_rename_mpi( file_work )
12878 call lookup_growable_url(file = file_work, varname = varname, &
12879 & url = url, &
12880 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12881 call url_chop_iorange( &
12882 & fullname = url, iorange = iorange, remainder = remainder )
12883 call split( str = iorange, carray = carray, sep = gt_equal )
12884 timevar_name = carray(1)
12885 deallocate( carray )
12886 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12887 call historygetint3( file = file, &
12888 & varname = varname, array = array, &
12889 & range = time_range, quiet = quiet, &
12890 & flag_mpi_split = flag_mpi_split, &
12891 & returned_time = returned_time, &
12892 & flag_time_exist = flag_time_exist, &
12893 & err = err )
12894end subroutine historygetint3timed
12896 & file, varname, array, time, &
12897 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12898 use dc_string, only: tochar, split
12899 use dc_types, only: string, dp
12900 use dc_trace, only: dbgmessage
12901 use dc_url, only: url_chop_iorange, gt_equal
12902 use dc_present, only: present_and_true
12903 implicit none
12904 character(*), intent(in):: file, varname
12905 real(DP), intent(in):: time
12906 logical, intent(in), optional:: quiet
12907 integer, intent(out) :: array(:,:,:,:)
12908 logical, intent(in), optional:: flag_mpi_split
12909 real(DP), intent(out), optional:: returned_time
12910 logical, intent(out), optional:: flag_time_exist
12911 logical, intent(out), optional:: err
12912 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12913 character(STRING), pointer:: carray (:)
12914 character(STRING):: tname
12915 interface
12916 subroutine historygetint4(&
12917 & file, varname, array, range, quiet, &
12918 & flag_mpi_split, returned_time, flag_time_exist, err)
12919 use dc_types, only: dp
12920 character(*), intent(in):: file
12921 character(*), intent(in):: varname
12922 character(*), intent(in), optional:: range
12923 logical, intent(in), optional:: quiet
12924 logical, intent(in), optional:: flag_mpi_split
12925 real(DP), intent(out), optional:: returned_time
12926 logical, intent(out), optional:: flag_time_exist
12927 logical, intent(out), optional:: err
12928 integer, intent(out) :: array(:,:,:,:)
12929 end subroutine historygetint4
12930 end interface
12931 interface
12932 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
12933 character(*), intent(in):: file
12934 character(*), intent(in):: varname
12935 character(*), intent(out):: url
12936 character(*), intent(in), optional:: range
12937 logical, intent(out), optional:: flag_time_exist
12938 character(*), intent(out), optional:: time_name
12939 logical, intent(out), optional:: err
12940 end subroutine lookup_growable_url
12941 end interface
12942 interface
12943 function file_rename_mpi( file ) result(result)
12944 use dc_types, only: string
12945 character(*), intent(in):: file
12946 character(STRING):: result
12947 end function file_rename_mpi
12948 end interface
12949 continue
12950 file_work = file
12951 if ( present_and_true( flag_mpi_split ) ) &
12952 & file_work = file_rename_mpi( file_work )
12953 call lookup_growable_url(file = file_work, varname = varname, &
12954 & url = url, &
12955 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
12956 call url_chop_iorange( &
12957 & fullname = url, iorange = iorange, remainder = remainder )
12958 call split( str = iorange, carray = carray, sep = gt_equal )
12959 timevar_name = carray(1)
12960 deallocate( carray )
12961 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
12962 call historygetint4( file = file, &
12963 & varname = varname, array = array, &
12964 & range = time_range, quiet = quiet, &
12965 & flag_mpi_split = flag_mpi_split, &
12966 & returned_time = returned_time, &
12967 & flag_time_exist = flag_time_exist, &
12968 & err = err )
12969end subroutine historygetint4timed
12971 & file, varname, array, time, &
12972 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
12973 use dc_string, only: tochar, split
12974 use dc_types, only: string, dp
12975 use dc_trace, only: dbgmessage
12976 use dc_url, only: url_chop_iorange, gt_equal
12977 use dc_present, only: present_and_true
12978 implicit none
12979 character(*), intent(in):: file, varname
12980 real(DP), intent(in):: time
12981 logical, intent(in), optional:: quiet
12982 integer, intent(out) :: array(:,:,:,:,:)
12983 logical, intent(in), optional:: flag_mpi_split
12984 real(DP), intent(out), optional:: returned_time
12985 logical, intent(out), optional:: flag_time_exist
12986 logical, intent(out), optional:: err
12987 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
12988 character(STRING), pointer:: carray (:)
12989 character(STRING):: tname
12990 interface
12991 subroutine historygetint5(&
12992 & file, varname, array, range, quiet, &
12993 & flag_mpi_split, returned_time, flag_time_exist, err)
12994 use dc_types, only: dp
12995 character(*), intent(in):: file
12996 character(*), intent(in):: varname
12997 character(*), intent(in), optional:: range
12998 logical, intent(in), optional:: quiet
12999 logical, intent(in), optional:: flag_mpi_split
13000 real(DP), intent(out), optional:: returned_time
13001 logical, intent(out), optional:: flag_time_exist
13002 logical, intent(out), optional:: err
13003 integer, intent(out) :: array(:,:,:,:,:)
13004 end subroutine historygetint5
13005 end interface
13006 interface
13007 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13008 character(*), intent(in):: file
13009 character(*), intent(in):: varname
13010 character(*), intent(out):: url
13011 character(*), intent(in), optional:: range
13012 logical, intent(out), optional:: flag_time_exist
13013 character(*), intent(out), optional:: time_name
13014 logical, intent(out), optional:: err
13015 end subroutine lookup_growable_url
13016 end interface
13017 interface
13018 function file_rename_mpi( file ) result(result)
13019 use dc_types, only: string
13020 character(*), intent(in):: file
13021 character(STRING):: result
13022 end function file_rename_mpi
13023 end interface
13024 continue
13025 file_work = file
13026 if ( present_and_true( flag_mpi_split ) ) &
13027 & file_work = file_rename_mpi( file_work )
13028 call lookup_growable_url(file = file_work, varname = varname, &
13029 & url = url, &
13030 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13031 call url_chop_iorange( &
13032 & fullname = url, iorange = iorange, remainder = remainder )
13033 call split( str = iorange, carray = carray, sep = gt_equal )
13034 timevar_name = carray(1)
13035 deallocate( carray )
13036 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13037 call historygetint5( file = file, &
13038 & varname = varname, array = array, &
13039 & range = time_range, quiet = quiet, &
13040 & flag_mpi_split = flag_mpi_split, &
13041 & returned_time = returned_time, &
13042 & flag_time_exist = flag_time_exist, &
13043 & err = err )
13044end subroutine historygetint5timed
13046 & file, varname, array, time, &
13047 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13048 use dc_string, only: tochar, split
13049 use dc_types, only: string, dp
13050 use dc_trace, only: dbgmessage
13051 use dc_url, only: url_chop_iorange, gt_equal
13052 use dc_present, only: present_and_true
13053 implicit none
13054 character(*), intent(in):: file, varname
13055 real(DP), intent(in):: time
13056 logical, intent(in), optional:: quiet
13057 integer, intent(out) :: array(:,:,:,:,:,:)
13058 logical, intent(in), optional:: flag_mpi_split
13059 real(DP), intent(out), optional:: returned_time
13060 logical, intent(out), optional:: flag_time_exist
13061 logical, intent(out), optional:: err
13062 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13063 character(STRING), pointer:: carray (:)
13064 character(STRING):: tname
13065 interface
13066 subroutine historygetint6(&
13067 & file, varname, array, range, quiet, &
13068 & flag_mpi_split, returned_time, flag_time_exist, err)
13069 use dc_types, only: dp
13070 character(*), intent(in):: file
13071 character(*), intent(in):: varname
13072 character(*), intent(in), optional:: range
13073 logical, intent(in), optional:: quiet
13074 logical, intent(in), optional:: flag_mpi_split
13075 real(DP), intent(out), optional:: returned_time
13076 logical, intent(out), optional:: flag_time_exist
13077 logical, intent(out), optional:: err
13078 integer, intent(out) :: array(:,:,:,:,:,:)
13079 end subroutine historygetint6
13080 end interface
13081 interface
13082 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13083 character(*), intent(in):: file
13084 character(*), intent(in):: varname
13085 character(*), intent(out):: url
13086 character(*), intent(in), optional:: range
13087 logical, intent(out), optional:: flag_time_exist
13088 character(*), intent(out), optional:: time_name
13089 logical, intent(out), optional:: err
13090 end subroutine lookup_growable_url
13091 end interface
13092 interface
13093 function file_rename_mpi( file ) result(result)
13094 use dc_types, only: string
13095 character(*), intent(in):: file
13096 character(STRING):: result
13097 end function file_rename_mpi
13098 end interface
13099 continue
13100 file_work = file
13101 if ( present_and_true( flag_mpi_split ) ) &
13102 & file_work = file_rename_mpi( file_work )
13103 call lookup_growable_url(file = file_work, varname = varname, &
13104 & url = url, &
13105 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13106 call url_chop_iorange( &
13107 & fullname = url, iorange = iorange, remainder = remainder )
13108 call split( str = iorange, carray = carray, sep = gt_equal )
13109 timevar_name = carray(1)
13110 deallocate( carray )
13111 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13112 call historygetint6( file = file, &
13113 & varname = varname, array = array, &
13114 & range = time_range, quiet = quiet, &
13115 & flag_mpi_split = flag_mpi_split, &
13116 & returned_time = returned_time, &
13117 & flag_time_exist = flag_time_exist, &
13118 & err = err )
13119end subroutine historygetint6timed
13121 & file, varname, array, time, &
13122 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13123 use dc_string, only: tochar, split
13124 use dc_types, only: string, dp
13125 use dc_trace, only: dbgmessage
13126 use dc_url, only: url_chop_iorange, gt_equal
13127 use dc_present, only: present_and_true
13128 implicit none
13129 character(*), intent(in):: file, varname
13130 real(DP), intent(in):: time
13131 logical, intent(in), optional:: quiet
13132 integer, intent(out) :: array(:,:,:,:,:,:,:)
13133 logical, intent(in), optional:: flag_mpi_split
13134 real(DP), intent(out), optional:: returned_time
13135 logical, intent(out), optional:: flag_time_exist
13136 logical, intent(out), optional:: err
13137 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13138 character(STRING), pointer:: carray (:)
13139 character(STRING):: tname
13140 interface
13141 subroutine historygetint7(&
13142 & file, varname, array, range, quiet, &
13143 & flag_mpi_split, returned_time, flag_time_exist, err)
13144 use dc_types, only: dp
13145 character(*), intent(in):: file
13146 character(*), intent(in):: varname
13147 character(*), intent(in), optional:: range
13148 logical, intent(in), optional:: quiet
13149 logical, intent(in), optional:: flag_mpi_split
13150 real(DP), intent(out), optional:: returned_time
13151 logical, intent(out), optional:: flag_time_exist
13152 logical, intent(out), optional:: err
13153 integer, intent(out) :: array(:,:,:,:,:,:,:)
13154 end subroutine historygetint7
13155 end interface
13156 interface
13157 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13158 character(*), intent(in):: file
13159 character(*), intent(in):: varname
13160 character(*), intent(out):: url
13161 character(*), intent(in), optional:: range
13162 logical, intent(out), optional:: flag_time_exist
13163 character(*), intent(out), optional:: time_name
13164 logical, intent(out), optional:: err
13165 end subroutine lookup_growable_url
13166 end interface
13167 interface
13168 function file_rename_mpi( file ) result(result)
13169 use dc_types, only: string
13170 character(*), intent(in):: file
13171 character(STRING):: result
13172 end function file_rename_mpi
13173 end interface
13174 continue
13175 file_work = file
13176 if ( present_and_true( flag_mpi_split ) ) &
13177 & file_work = file_rename_mpi( file_work )
13178 call lookup_growable_url(file = file_work, varname = varname, &
13179 & url = url, &
13180 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13181 call url_chop_iorange( &
13182 & fullname = url, iorange = iorange, remainder = remainder )
13183 call split( str = iorange, carray = carray, sep = gt_equal )
13184 timevar_name = carray(1)
13185 deallocate( carray )
13186 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13187 call historygetint7( file = file, &
13188 & varname = varname, array = array, &
13189 & range = time_range, quiet = quiet, &
13190 & flag_mpi_split = flag_mpi_split, &
13191 & returned_time = returned_time, &
13192 & flag_time_exist = flag_time_exist, &
13193 & err = err )
13194end subroutine historygetint7timed
13196 & file, varname, array, time, &
13197 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13198 use dc_string, only: tochar, split
13199 use dc_types, only: string, dp
13200 use dc_trace, only: dbgmessage
13201 use dc_url, only: url_chop_iorange, gt_equal
13202 use dc_present, only: present_and_true
13203 implicit none
13204 character(*), intent(in):: file, varname
13205 real(DP), intent(in):: time
13206 logical, intent(in), optional:: quiet
13207 integer, pointer :: array
13208 logical, intent(in), optional:: flag_mpi_split
13209 real(DP), intent(out), optional:: returned_time
13210 logical, intent(out), optional:: flag_time_exist
13211 logical, intent(out), optional:: err
13212 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13213 character(STRING), pointer:: carray (:)
13214 character(STRING):: tname
13215 interface
13216 subroutine historygetint0pointer(&
13217 & file, varname, array, range, quiet, &
13218 & flag_mpi_split, returned_time, flag_time_exist, err)
13219 use dc_types, only: dp
13220 character(*), intent(in):: file
13221 character(*), intent(in):: varname
13222 character(*), intent(in), optional:: range
13223 logical, intent(in), optional:: quiet
13224 logical, intent(in), optional:: flag_mpi_split
13225 real(DP), intent(out), optional:: returned_time
13226 logical, intent(out), optional:: flag_time_exist
13227 logical, intent(out), optional:: err
13228 integer, pointer :: array
13229 end subroutine historygetint0pointer
13230 end interface
13231 interface
13232 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13233 character(*), intent(in):: file
13234 character(*), intent(in):: varname
13235 character(*), intent(out):: url
13236 character(*), intent(in), optional:: range
13237 logical, intent(out), optional:: flag_time_exist
13238 character(*), intent(out), optional:: time_name
13239 logical, intent(out), optional:: err
13240 end subroutine lookup_growable_url
13241 end interface
13242 interface
13243 function file_rename_mpi( file ) result(result)
13244 use dc_types, only: string
13245 character(*), intent(in):: file
13246 character(STRING):: result
13247 end function file_rename_mpi
13248 end interface
13249 continue
13250 file_work = file
13251 if ( present_and_true( flag_mpi_split ) ) &
13252 & file_work = file_rename_mpi( file_work )
13253 call lookup_growable_url(file = file_work, varname = varname, &
13254 & url = url, &
13255 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13256 call url_chop_iorange( &
13257 & fullname = url, iorange = iorange, remainder = remainder )
13258 call split( str = iorange, carray = carray, sep = gt_equal )
13259 timevar_name = carray(1)
13260 deallocate( carray )
13261 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13262 call historygetint0pointer( file = file, &
13263 & varname = varname, array = array, &
13264 & range = time_range, quiet = quiet, &
13265 & flag_mpi_split = flag_mpi_split, &
13266 & returned_time = returned_time, &
13267 & flag_time_exist = flag_time_exist, &
13268 & err = err )
13269end subroutine historygetint0pointertimed
13271 & file, varname, array, time, &
13272 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13273 use dc_string, only: tochar, split
13274 use dc_types, only: string, dp
13275 use dc_trace, only: dbgmessage
13276 use dc_url, only: url_chop_iorange, gt_equal
13277 use dc_present, only: present_and_true
13278 implicit none
13279 character(*), intent(in):: file, varname
13280 real(DP), intent(in):: time
13281 logical, intent(in), optional:: quiet
13282 integer, pointer :: array(:)
13283 logical, intent(in), optional:: flag_mpi_split
13284 real(DP), intent(out), optional:: returned_time
13285 logical, intent(out), optional:: flag_time_exist
13286 logical, intent(out), optional:: err
13287 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13288 character(STRING), pointer:: carray (:)
13289 character(STRING):: tname
13290 interface
13291 subroutine historygetint1pointer(&
13292 & file, varname, array, range, quiet, &
13293 & flag_mpi_split, returned_time, flag_time_exist, err)
13294 use dc_types, only: dp
13295 character(*), intent(in):: file
13296 character(*), intent(in):: varname
13297 character(*), intent(in), optional:: range
13298 logical, intent(in), optional:: quiet
13299 logical, intent(in), optional:: flag_mpi_split
13300 real(DP), intent(out), optional:: returned_time
13301 logical, intent(out), optional:: flag_time_exist
13302 logical, intent(out), optional:: err
13303 integer, pointer :: array(:)
13304 end subroutine historygetint1pointer
13305 end interface
13306 interface
13307 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13308 character(*), intent(in):: file
13309 character(*), intent(in):: varname
13310 character(*), intent(out):: url
13311 character(*), intent(in), optional:: range
13312 logical, intent(out), optional:: flag_time_exist
13313 character(*), intent(out), optional:: time_name
13314 logical, intent(out), optional:: err
13315 end subroutine lookup_growable_url
13316 end interface
13317 interface
13318 function file_rename_mpi( file ) result(result)
13319 use dc_types, only: string
13320 character(*), intent(in):: file
13321 character(STRING):: result
13322 end function file_rename_mpi
13323 end interface
13324 continue
13325 file_work = file
13326 if ( present_and_true( flag_mpi_split ) ) &
13327 & file_work = file_rename_mpi( file_work )
13328 call lookup_growable_url(file = file_work, varname = varname, &
13329 & url = url, &
13330 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13331 call url_chop_iorange( &
13332 & fullname = url, iorange = iorange, remainder = remainder )
13333 call split( str = iorange, carray = carray, sep = gt_equal )
13334 timevar_name = carray(1)
13335 deallocate( carray )
13336 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13337 call historygetint1pointer( file = file, &
13338 & varname = varname, array = array, &
13339 & range = time_range, quiet = quiet, &
13340 & flag_mpi_split = flag_mpi_split, &
13341 & returned_time = returned_time, &
13342 & flag_time_exist = flag_time_exist, &
13343 & err = err )
13344end subroutine historygetint1pointertimed
13346 & file, varname, array, time, &
13347 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13348 use dc_string, only: tochar, split
13349 use dc_types, only: string, dp
13350 use dc_trace, only: dbgmessage
13351 use dc_url, only: url_chop_iorange, gt_equal
13352 use dc_present, only: present_and_true
13353 implicit none
13354 character(*), intent(in):: file, varname
13355 real(DP), intent(in):: time
13356 logical, intent(in), optional:: quiet
13357 integer, pointer :: array(:,:)
13358 logical, intent(in), optional:: flag_mpi_split
13359 real(DP), intent(out), optional:: returned_time
13360 logical, intent(out), optional:: flag_time_exist
13361 logical, intent(out), optional:: err
13362 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13363 character(STRING), pointer:: carray (:)
13364 character(STRING):: tname
13365 interface
13366 subroutine historygetint2pointer(&
13367 & file, varname, array, range, quiet, &
13368 & flag_mpi_split, returned_time, flag_time_exist, err)
13369 use dc_types, only: dp
13370 character(*), intent(in):: file
13371 character(*), intent(in):: varname
13372 character(*), intent(in), optional:: range
13373 logical, intent(in), optional:: quiet
13374 logical, intent(in), optional:: flag_mpi_split
13375 real(DP), intent(out), optional:: returned_time
13376 logical, intent(out), optional:: flag_time_exist
13377 logical, intent(out), optional:: err
13378 integer, pointer :: array(:,:)
13379 end subroutine historygetint2pointer
13380 end interface
13381 interface
13382 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13383 character(*), intent(in):: file
13384 character(*), intent(in):: varname
13385 character(*), intent(out):: url
13386 character(*), intent(in), optional:: range
13387 logical, intent(out), optional:: flag_time_exist
13388 character(*), intent(out), optional:: time_name
13389 logical, intent(out), optional:: err
13390 end subroutine lookup_growable_url
13391 end interface
13392 interface
13393 function file_rename_mpi( file ) result(result)
13394 use dc_types, only: string
13395 character(*), intent(in):: file
13396 character(STRING):: result
13397 end function file_rename_mpi
13398 end interface
13399 continue
13400 file_work = file
13401 if ( present_and_true( flag_mpi_split ) ) &
13402 & file_work = file_rename_mpi( file_work )
13403 call lookup_growable_url(file = file_work, varname = varname, &
13404 & url = url, &
13405 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13406 call url_chop_iorange( &
13407 & fullname = url, iorange = iorange, remainder = remainder )
13408 call split( str = iorange, carray = carray, sep = gt_equal )
13409 timevar_name = carray(1)
13410 deallocate( carray )
13411 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13412 call historygetint2pointer( file = file, &
13413 & varname = varname, array = array, &
13414 & range = time_range, quiet = quiet, &
13415 & flag_mpi_split = flag_mpi_split, &
13416 & returned_time = returned_time, &
13417 & flag_time_exist = flag_time_exist, &
13418 & err = err )
13419end subroutine historygetint2pointertimed
13421 & file, varname, array, time, &
13422 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13423 use dc_string, only: tochar, split
13424 use dc_types, only: string, dp
13425 use dc_trace, only: dbgmessage
13426 use dc_url, only: url_chop_iorange, gt_equal
13427 use dc_present, only: present_and_true
13428 implicit none
13429 character(*), intent(in):: file, varname
13430 real(DP), intent(in):: time
13431 logical, intent(in), optional:: quiet
13432 integer, pointer :: array(:,:,:)
13433 logical, intent(in), optional:: flag_mpi_split
13434 real(DP), intent(out), optional:: returned_time
13435 logical, intent(out), optional:: flag_time_exist
13436 logical, intent(out), optional:: err
13437 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13438 character(STRING), pointer:: carray (:)
13439 character(STRING):: tname
13440 interface
13441 subroutine historygetint3pointer(&
13442 & file, varname, array, range, quiet, &
13443 & flag_mpi_split, returned_time, flag_time_exist, err)
13444 use dc_types, only: dp
13445 character(*), intent(in):: file
13446 character(*), intent(in):: varname
13447 character(*), intent(in), optional:: range
13448 logical, intent(in), optional:: quiet
13449 logical, intent(in), optional:: flag_mpi_split
13450 real(DP), intent(out), optional:: returned_time
13451 logical, intent(out), optional:: flag_time_exist
13452 logical, intent(out), optional:: err
13453 integer, pointer :: array(:,:,:)
13454 end subroutine historygetint3pointer
13455 end interface
13456 interface
13457 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13458 character(*), intent(in):: file
13459 character(*), intent(in):: varname
13460 character(*), intent(out):: url
13461 character(*), intent(in), optional:: range
13462 logical, intent(out), optional:: flag_time_exist
13463 character(*), intent(out), optional:: time_name
13464 logical, intent(out), optional:: err
13465 end subroutine lookup_growable_url
13466 end interface
13467 interface
13468 function file_rename_mpi( file ) result(result)
13469 use dc_types, only: string
13470 character(*), intent(in):: file
13471 character(STRING):: result
13472 end function file_rename_mpi
13473 end interface
13474 continue
13475 file_work = file
13476 if ( present_and_true( flag_mpi_split ) ) &
13477 & file_work = file_rename_mpi( file_work )
13478 call lookup_growable_url(file = file_work, varname = varname, &
13479 & url = url, &
13480 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13481 call url_chop_iorange( &
13482 & fullname = url, iorange = iorange, remainder = remainder )
13483 call split( str = iorange, carray = carray, sep = gt_equal )
13484 timevar_name = carray(1)
13485 deallocate( carray )
13486 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13487 call historygetint3pointer( file = file, &
13488 & varname = varname, array = array, &
13489 & range = time_range, quiet = quiet, &
13490 & flag_mpi_split = flag_mpi_split, &
13491 & returned_time = returned_time, &
13492 & flag_time_exist = flag_time_exist, &
13493 & err = err )
13494end subroutine historygetint3pointertimed
13496 & file, varname, array, time, &
13497 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13498 use dc_string, only: tochar, split
13499 use dc_types, only: string, dp
13500 use dc_trace, only: dbgmessage
13501 use dc_url, only: url_chop_iorange, gt_equal
13502 use dc_present, only: present_and_true
13503 implicit none
13504 character(*), intent(in):: file, varname
13505 real(DP), intent(in):: time
13506 logical, intent(in), optional:: quiet
13507 integer, pointer :: array(:,:,:,:)
13508 logical, intent(in), optional:: flag_mpi_split
13509 real(DP), intent(out), optional:: returned_time
13510 logical, intent(out), optional:: flag_time_exist
13511 logical, intent(out), optional:: err
13512 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13513 character(STRING), pointer:: carray (:)
13514 character(STRING):: tname
13515 interface
13516 subroutine historygetint4pointer(&
13517 & file, varname, array, range, quiet, &
13518 & flag_mpi_split, returned_time, flag_time_exist, err)
13519 use dc_types, only: dp
13520 character(*), intent(in):: file
13521 character(*), intent(in):: varname
13522 character(*), intent(in), optional:: range
13523 logical, intent(in), optional:: quiet
13524 logical, intent(in), optional:: flag_mpi_split
13525 real(DP), intent(out), optional:: returned_time
13526 logical, intent(out), optional:: flag_time_exist
13527 logical, intent(out), optional:: err
13528 integer, pointer :: array(:,:,:,:)
13529 end subroutine historygetint4pointer
13530 end interface
13531 interface
13532 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13533 character(*), intent(in):: file
13534 character(*), intent(in):: varname
13535 character(*), intent(out):: url
13536 character(*), intent(in), optional:: range
13537 logical, intent(out), optional:: flag_time_exist
13538 character(*), intent(out), optional:: time_name
13539 logical, intent(out), optional:: err
13540 end subroutine lookup_growable_url
13541 end interface
13542 interface
13543 function file_rename_mpi( file ) result(result)
13544 use dc_types, only: string
13545 character(*), intent(in):: file
13546 character(STRING):: result
13547 end function file_rename_mpi
13548 end interface
13549 continue
13550 file_work = file
13551 if ( present_and_true( flag_mpi_split ) ) &
13552 & file_work = file_rename_mpi( file_work )
13553 call lookup_growable_url(file = file_work, varname = varname, &
13554 & url = url, &
13555 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13556 call url_chop_iorange( &
13557 & fullname = url, iorange = iorange, remainder = remainder )
13558 call split( str = iorange, carray = carray, sep = gt_equal )
13559 timevar_name = carray(1)
13560 deallocate( carray )
13561 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13562 call historygetint4pointer( file = file, &
13563 & varname = varname, array = array, &
13564 & range = time_range, quiet = quiet, &
13565 & flag_mpi_split = flag_mpi_split, &
13566 & returned_time = returned_time, &
13567 & flag_time_exist = flag_time_exist, &
13568 & err = err )
13569end subroutine historygetint4pointertimed
13571 & file, varname, array, time, &
13572 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13573 use dc_string, only: tochar, split
13574 use dc_types, only: string, dp
13575 use dc_trace, only: dbgmessage
13576 use dc_url, only: url_chop_iorange, gt_equal
13577 use dc_present, only: present_and_true
13578 implicit none
13579 character(*), intent(in):: file, varname
13580 real(DP), intent(in):: time
13581 logical, intent(in), optional:: quiet
13582 integer, pointer :: array(:,:,:,:,:)
13583 logical, intent(in), optional:: flag_mpi_split
13584 real(DP), intent(out), optional:: returned_time
13585 logical, intent(out), optional:: flag_time_exist
13586 logical, intent(out), optional:: err
13587 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13588 character(STRING), pointer:: carray (:)
13589 character(STRING):: tname
13590 interface
13591 subroutine historygetint5pointer(&
13592 & file, varname, array, range, quiet, &
13593 & flag_mpi_split, returned_time, flag_time_exist, err)
13594 use dc_types, only: dp
13595 character(*), intent(in):: file
13596 character(*), intent(in):: varname
13597 character(*), intent(in), optional:: range
13598 logical, intent(in), optional:: quiet
13599 logical, intent(in), optional:: flag_mpi_split
13600 real(DP), intent(out), optional:: returned_time
13601 logical, intent(out), optional:: flag_time_exist
13602 logical, intent(out), optional:: err
13603 integer, pointer :: array(:,:,:,:,:)
13604 end subroutine historygetint5pointer
13605 end interface
13606 interface
13607 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13608 character(*), intent(in):: file
13609 character(*), intent(in):: varname
13610 character(*), intent(out):: url
13611 character(*), intent(in), optional:: range
13612 logical, intent(out), optional:: flag_time_exist
13613 character(*), intent(out), optional:: time_name
13614 logical, intent(out), optional:: err
13615 end subroutine lookup_growable_url
13616 end interface
13617 interface
13618 function file_rename_mpi( file ) result(result)
13619 use dc_types, only: string
13620 character(*), intent(in):: file
13621 character(STRING):: result
13622 end function file_rename_mpi
13623 end interface
13624 continue
13625 file_work = file
13626 if ( present_and_true( flag_mpi_split ) ) &
13627 & file_work = file_rename_mpi( file_work )
13628 call lookup_growable_url(file = file_work, varname = varname, &
13629 & url = url, &
13630 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13631 call url_chop_iorange( &
13632 & fullname = url, iorange = iorange, remainder = remainder )
13633 call split( str = iorange, carray = carray, sep = gt_equal )
13634 timevar_name = carray(1)
13635 deallocate( carray )
13636 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13637 call historygetint5pointer( file = file, &
13638 & varname = varname, array = array, &
13639 & range = time_range, quiet = quiet, &
13640 & flag_mpi_split = flag_mpi_split, &
13641 & returned_time = returned_time, &
13642 & flag_time_exist = flag_time_exist, &
13643 & err = err )
13644end subroutine historygetint5pointertimed
13646 & file, varname, array, time, &
13647 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13648 use dc_string, only: tochar, split
13649 use dc_types, only: string, dp
13650 use dc_trace, only: dbgmessage
13651 use dc_url, only: url_chop_iorange, gt_equal
13652 use dc_present, only: present_and_true
13653 implicit none
13654 character(*), intent(in):: file, varname
13655 real(DP), intent(in):: time
13656 logical, intent(in), optional:: quiet
13657 integer, pointer :: array(:,:,:,:,:,:)
13658 logical, intent(in), optional:: flag_mpi_split
13659 real(DP), intent(out), optional:: returned_time
13660 logical, intent(out), optional:: flag_time_exist
13661 logical, intent(out), optional:: err
13662 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13663 character(STRING), pointer:: carray (:)
13664 character(STRING):: tname
13665 interface
13666 subroutine historygetint6pointer(&
13667 & file, varname, array, range, quiet, &
13668 & flag_mpi_split, returned_time, flag_time_exist, err)
13669 use dc_types, only: dp
13670 character(*), intent(in):: file
13671 character(*), intent(in):: varname
13672 character(*), intent(in), optional:: range
13673 logical, intent(in), optional:: quiet
13674 logical, intent(in), optional:: flag_mpi_split
13675 real(DP), intent(out), optional:: returned_time
13676 logical, intent(out), optional:: flag_time_exist
13677 logical, intent(out), optional:: err
13678 integer, pointer :: array(:,:,:,:,:,:)
13679 end subroutine historygetint6pointer
13680 end interface
13681 interface
13682 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13683 character(*), intent(in):: file
13684 character(*), intent(in):: varname
13685 character(*), intent(out):: url
13686 character(*), intent(in), optional:: range
13687 logical, intent(out), optional:: flag_time_exist
13688 character(*), intent(out), optional:: time_name
13689 logical, intent(out), optional:: err
13690 end subroutine lookup_growable_url
13691 end interface
13692 interface
13693 function file_rename_mpi( file ) result(result)
13694 use dc_types, only: string
13695 character(*), intent(in):: file
13696 character(STRING):: result
13697 end function file_rename_mpi
13698 end interface
13699 continue
13700 file_work = file
13701 if ( present_and_true( flag_mpi_split ) ) &
13702 & file_work = file_rename_mpi( file_work )
13703 call lookup_growable_url(file = file_work, varname = varname, &
13704 & url = url, &
13705 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13706 call url_chop_iorange( &
13707 & fullname = url, iorange = iorange, remainder = remainder )
13708 call split( str = iorange, carray = carray, sep = gt_equal )
13709 timevar_name = carray(1)
13710 deallocate( carray )
13711 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13712 call historygetint6pointer( file = file, &
13713 & varname = varname, array = array, &
13714 & range = time_range, quiet = quiet, &
13715 & flag_mpi_split = flag_mpi_split, &
13716 & returned_time = returned_time, &
13717 & flag_time_exist = flag_time_exist, &
13718 & err = err )
13719end subroutine historygetint6pointertimed
13721 & file, varname, array, time, &
13722 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13723 use dc_string, only: tochar, split
13724 use dc_types, only: string, dp
13725 use dc_trace, only: dbgmessage
13726 use dc_url, only: url_chop_iorange, gt_equal
13727 use dc_present, only: present_and_true
13728 implicit none
13729 character(*), intent(in):: file, varname
13730 real(DP), intent(in):: time
13731 logical, intent(in), optional:: quiet
13732 integer, pointer :: array(:,:,:,:,:,:,:)
13733 logical, intent(in), optional:: flag_mpi_split
13734 real(DP), intent(out), optional:: returned_time
13735 logical, intent(out), optional:: flag_time_exist
13736 logical, intent(out), optional:: err
13737 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13738 character(STRING), pointer:: carray (:)
13739 character(STRING):: tname
13740 interface
13741 subroutine historygetint7pointer(&
13742 & file, varname, array, range, quiet, &
13743 & flag_mpi_split, returned_time, flag_time_exist, err)
13744 use dc_types, only: dp
13745 character(*), intent(in):: file
13746 character(*), intent(in):: varname
13747 character(*), intent(in), optional:: range
13748 logical, intent(in), optional:: quiet
13749 logical, intent(in), optional:: flag_mpi_split
13750 real(DP), intent(out), optional:: returned_time
13751 logical, intent(out), optional:: flag_time_exist
13752 logical, intent(out), optional:: err
13753 integer, pointer :: array(:,:,:,:,:,:,:)
13754 end subroutine historygetint7pointer
13755 end interface
13756 interface
13757 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13758 character(*), intent(in):: file
13759 character(*), intent(in):: varname
13760 character(*), intent(out):: url
13761 character(*), intent(in), optional:: range
13762 logical, intent(out), optional:: flag_time_exist
13763 character(*), intent(out), optional:: time_name
13764 logical, intent(out), optional:: err
13765 end subroutine lookup_growable_url
13766 end interface
13767 interface
13768 function file_rename_mpi( file ) result(result)
13769 use dc_types, only: string
13770 character(*), intent(in):: file
13771 character(STRING):: result
13772 end function file_rename_mpi
13773 end interface
13774 continue
13775 file_work = file
13776 if ( present_and_true( flag_mpi_split ) ) &
13777 & file_work = file_rename_mpi( file_work )
13778 call lookup_growable_url(file = file_work, varname = varname, &
13779 & url = url, &
13780 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13781 call url_chop_iorange( &
13782 & fullname = url, iorange = iorange, remainder = remainder )
13783 call split( str = iorange, carray = carray, sep = gt_equal )
13784 timevar_name = carray(1)
13785 deallocate( carray )
13786 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13787 call historygetint7pointer( file = file, &
13788 & varname = varname, array = array, &
13789 & range = time_range, quiet = quiet, &
13790 & flag_mpi_split = flag_mpi_split, &
13791 & returned_time = returned_time, &
13792 & flag_time_exist = flag_time_exist, &
13793 & err = err )
13794end subroutine historygetint7pointertimed
13796 & file, varname, array, time, &
13797 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13798 use dc_string, only: tochar, split
13799 use dc_types, only: string, dp
13800 use dc_trace, only: dbgmessage
13801 use dc_url, only: url_chop_iorange, gt_equal
13802 use dc_present, only: present_and_true
13803 implicit none
13804 character(*), intent(in):: file, varname
13805 integer, intent(in):: time
13806 logical, intent(in), optional:: quiet
13807 real(DP), intent(out) :: array
13808 logical, intent(in), optional:: flag_mpi_split
13809 real(DP), intent(out), optional:: returned_time
13810 logical, intent(out), optional:: flag_time_exist
13811 logical, intent(out), optional:: err
13812 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13813 character(STRING), pointer:: carray (:)
13814 character(STRING):: tname
13815 interface
13816 subroutine historygetdouble0(&
13817 & file, varname, array, range, quiet, &
13818 & flag_mpi_split, returned_time, flag_time_exist, err)
13819 use dc_types, only: dp
13820 character(*), intent(in):: file
13821 character(*), intent(in):: varname
13822 character(*), intent(in), optional:: range
13823 logical, intent(in), optional:: quiet
13824 logical, intent(in), optional:: flag_mpi_split
13825 real(DP), intent(out), optional:: returned_time
13826 logical, intent(out), optional:: flag_time_exist
13827 logical, intent(out), optional:: err
13828 real(DP), intent(out) :: array
13829 end subroutine historygetdouble0
13830 end interface
13831 interface
13832 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13833 character(*), intent(in):: file
13834 character(*), intent(in):: varname
13835 character(*), intent(out):: url
13836 character(*), intent(in), optional:: range
13837 logical, intent(out), optional:: flag_time_exist
13838 character(*), intent(out), optional:: time_name
13839 logical, intent(out), optional:: err
13840 end subroutine lookup_growable_url
13841 end interface
13842 interface
13843 function file_rename_mpi( file ) result(result)
13844 use dc_types, only: string
13845 character(*), intent(in):: file
13846 character(STRING):: result
13847 end function file_rename_mpi
13848 end interface
13849 continue
13850 file_work = file
13851 if ( present_and_true( flag_mpi_split ) ) &
13852 & file_work = file_rename_mpi( file_work )
13853 call lookup_growable_url(file = file_work, varname = varname, &
13854 & url = url, &
13855 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13856 call url_chop_iorange( &
13857 & fullname = url, iorange = iorange, remainder = remainder )
13858 call split( str = iorange, carray = carray, sep = gt_equal )
13859 timevar_name = carray(1)
13860 deallocate( carray )
13861 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13862 call historygetdouble0( file = file, &
13863 & varname = varname, array = array, &
13864 & range = time_range, quiet = quiet, &
13865 & flag_mpi_split = flag_mpi_split, &
13866 & returned_time = returned_time, &
13867 & flag_time_exist = flag_time_exist, &
13868 & err = err )
13869end subroutine historygetdouble0timei
13871 & file, varname, array, time, &
13872 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13873 use dc_string, only: tochar, split
13874 use dc_types, only: string, dp
13875 use dc_trace, only: dbgmessage
13876 use dc_url, only: url_chop_iorange, gt_equal
13877 use dc_present, only: present_and_true
13878 implicit none
13879 character(*), intent(in):: file, varname
13880 integer, intent(in):: time
13881 logical, intent(in), optional:: quiet
13882 real(DP), intent(out) :: array(:)
13883 logical, intent(in), optional:: flag_mpi_split
13884 real(DP), intent(out), optional:: returned_time
13885 logical, intent(out), optional:: flag_time_exist
13886 logical, intent(out), optional:: err
13887 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13888 character(STRING), pointer:: carray (:)
13889 character(STRING):: tname
13890 interface
13891 subroutine historygetdouble1(&
13892 & file, varname, array, range, quiet, &
13893 & flag_mpi_split, returned_time, flag_time_exist, err)
13894 use dc_types, only: dp
13895 character(*), intent(in):: file
13896 character(*), intent(in):: varname
13897 character(*), intent(in), optional:: range
13898 logical, intent(in), optional:: quiet
13899 logical, intent(in), optional:: flag_mpi_split
13900 real(DP), intent(out), optional:: returned_time
13901 logical, intent(out), optional:: flag_time_exist
13902 logical, intent(out), optional:: err
13903 real(DP), intent(out) :: array(:)
13904 end subroutine historygetdouble1
13905 end interface
13906 interface
13907 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13908 character(*), intent(in):: file
13909 character(*), intent(in):: varname
13910 character(*), intent(out):: url
13911 character(*), intent(in), optional:: range
13912 logical, intent(out), optional:: flag_time_exist
13913 character(*), intent(out), optional:: time_name
13914 logical, intent(out), optional:: err
13915 end subroutine lookup_growable_url
13916 end interface
13917 interface
13918 function file_rename_mpi( file ) result(result)
13919 use dc_types, only: string
13920 character(*), intent(in):: file
13921 character(STRING):: result
13922 end function file_rename_mpi
13923 end interface
13924 continue
13925 file_work = file
13926 if ( present_and_true( flag_mpi_split ) ) &
13927 & file_work = file_rename_mpi( file_work )
13928 call lookup_growable_url(file = file_work, varname = varname, &
13929 & url = url, &
13930 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
13931 call url_chop_iorange( &
13932 & fullname = url, iorange = iorange, remainder = remainder )
13933 call split( str = iorange, carray = carray, sep = gt_equal )
13934 timevar_name = carray(1)
13935 deallocate( carray )
13936 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
13937 call historygetdouble1( file = file, &
13938 & varname = varname, array = array, &
13939 & range = time_range, quiet = quiet, &
13940 & flag_mpi_split = flag_mpi_split, &
13941 & returned_time = returned_time, &
13942 & flag_time_exist = flag_time_exist, &
13943 & err = err )
13944end subroutine historygetdouble1timei
13946 & file, varname, array, time, &
13947 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
13948 use dc_string, only: tochar, split
13949 use dc_types, only: string, dp
13950 use dc_trace, only: dbgmessage
13951 use dc_url, only: url_chop_iorange, gt_equal
13952 use dc_present, only: present_and_true
13953 implicit none
13954 character(*), intent(in):: file, varname
13955 integer, intent(in):: time
13956 logical, intent(in), optional:: quiet
13957 real(DP), intent(out) :: array(:,:)
13958 logical, intent(in), optional:: flag_mpi_split
13959 real(DP), intent(out), optional:: returned_time
13960 logical, intent(out), optional:: flag_time_exist
13961 logical, intent(out), optional:: err
13962 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
13963 character(STRING), pointer:: carray (:)
13964 character(STRING):: tname
13965 interface
13966 subroutine historygetdouble2(&
13967 & file, varname, array, range, quiet, &
13968 & flag_mpi_split, returned_time, flag_time_exist, err)
13969 use dc_types, only: dp
13970 character(*), intent(in):: file
13971 character(*), intent(in):: varname
13972 character(*), intent(in), optional:: range
13973 logical, intent(in), optional:: quiet
13974 logical, intent(in), optional:: flag_mpi_split
13975 real(DP), intent(out), optional:: returned_time
13976 logical, intent(out), optional:: flag_time_exist
13977 logical, intent(out), optional:: err
13978 real(DP), intent(out) :: array(:,:)
13979 end subroutine historygetdouble2
13980 end interface
13981 interface
13982 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
13983 character(*), intent(in):: file
13984 character(*), intent(in):: varname
13985 character(*), intent(out):: url
13986 character(*), intent(in), optional:: range
13987 logical, intent(out), optional:: flag_time_exist
13988 character(*), intent(out), optional:: time_name
13989 logical, intent(out), optional:: err
13990 end subroutine lookup_growable_url
13991 end interface
13992 interface
13993 function file_rename_mpi( file ) result(result)
13994 use dc_types, only: string
13995 character(*), intent(in):: file
13996 character(STRING):: result
13997 end function file_rename_mpi
13998 end interface
13999 continue
14000 file_work = file
14001 if ( present_and_true( flag_mpi_split ) ) &
14002 & file_work = file_rename_mpi( file_work )
14003 call lookup_growable_url(file = file_work, varname = varname, &
14004 & url = url, &
14005 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14006 call url_chop_iorange( &
14007 & fullname = url, iorange = iorange, remainder = remainder )
14008 call split( str = iorange, carray = carray, sep = gt_equal )
14009 timevar_name = carray(1)
14010 deallocate( carray )
14011 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14012 call historygetdouble2( file = file, &
14013 & varname = varname, array = array, &
14014 & range = time_range, quiet = quiet, &
14015 & flag_mpi_split = flag_mpi_split, &
14016 & returned_time = returned_time, &
14017 & flag_time_exist = flag_time_exist, &
14018 & err = err )
14019end subroutine historygetdouble2timei
14021 & file, varname, array, time, &
14022 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14023 use dc_string, only: tochar, split
14024 use dc_types, only: string, dp
14025 use dc_trace, only: dbgmessage
14026 use dc_url, only: url_chop_iorange, gt_equal
14027 use dc_present, only: present_and_true
14028 implicit none
14029 character(*), intent(in):: file, varname
14030 integer, intent(in):: time
14031 logical, intent(in), optional:: quiet
14032 real(DP), intent(out) :: array(:,:,:)
14033 logical, intent(in), optional:: flag_mpi_split
14034 real(DP), intent(out), optional:: returned_time
14035 logical, intent(out), optional:: flag_time_exist
14036 logical, intent(out), optional:: err
14037 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14038 character(STRING), pointer:: carray (:)
14039 character(STRING):: tname
14040 interface
14041 subroutine historygetdouble3(&
14042 & file, varname, array, range, quiet, &
14043 & flag_mpi_split, returned_time, flag_time_exist, err)
14044 use dc_types, only: dp
14045 character(*), intent(in):: file
14046 character(*), intent(in):: varname
14047 character(*), intent(in), optional:: range
14048 logical, intent(in), optional:: quiet
14049 logical, intent(in), optional:: flag_mpi_split
14050 real(DP), intent(out), optional:: returned_time
14051 logical, intent(out), optional:: flag_time_exist
14052 logical, intent(out), optional:: err
14053 real(DP), intent(out) :: array(:,:,:)
14054 end subroutine historygetdouble3
14055 end interface
14056 interface
14057 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14058 character(*), intent(in):: file
14059 character(*), intent(in):: varname
14060 character(*), intent(out):: url
14061 character(*), intent(in), optional:: range
14062 logical, intent(out), optional:: flag_time_exist
14063 character(*), intent(out), optional:: time_name
14064 logical, intent(out), optional:: err
14065 end subroutine lookup_growable_url
14066 end interface
14067 interface
14068 function file_rename_mpi( file ) result(result)
14069 use dc_types, only: string
14070 character(*), intent(in):: file
14071 character(STRING):: result
14072 end function file_rename_mpi
14073 end interface
14074 continue
14075 file_work = file
14076 if ( present_and_true( flag_mpi_split ) ) &
14077 & file_work = file_rename_mpi( file_work )
14078 call lookup_growable_url(file = file_work, varname = varname, &
14079 & url = url, &
14080 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14081 call url_chop_iorange( &
14082 & fullname = url, iorange = iorange, remainder = remainder )
14083 call split( str = iorange, carray = carray, sep = gt_equal )
14084 timevar_name = carray(1)
14085 deallocate( carray )
14086 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14087 call historygetdouble3( file = file, &
14088 & varname = varname, array = array, &
14089 & range = time_range, quiet = quiet, &
14090 & flag_mpi_split = flag_mpi_split, &
14091 & returned_time = returned_time, &
14092 & flag_time_exist = flag_time_exist, &
14093 & err = err )
14094end subroutine historygetdouble3timei
14096 & file, varname, array, time, &
14097 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14098 use dc_string, only: tochar, split
14099 use dc_types, only: string, dp
14100 use dc_trace, only: dbgmessage
14101 use dc_url, only: url_chop_iorange, gt_equal
14102 use dc_present, only: present_and_true
14103 implicit none
14104 character(*), intent(in):: file, varname
14105 integer, intent(in):: time
14106 logical, intent(in), optional:: quiet
14107 real(DP), intent(out) :: array(:,:,:,:)
14108 logical, intent(in), optional:: flag_mpi_split
14109 real(DP), intent(out), optional:: returned_time
14110 logical, intent(out), optional:: flag_time_exist
14111 logical, intent(out), optional:: err
14112 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14113 character(STRING), pointer:: carray (:)
14114 character(STRING):: tname
14115 interface
14116 subroutine historygetdouble4(&
14117 & file, varname, array, range, quiet, &
14118 & flag_mpi_split, returned_time, flag_time_exist, err)
14119 use dc_types, only: dp
14120 character(*), intent(in):: file
14121 character(*), intent(in):: varname
14122 character(*), intent(in), optional:: range
14123 logical, intent(in), optional:: quiet
14124 logical, intent(in), optional:: flag_mpi_split
14125 real(DP), intent(out), optional:: returned_time
14126 logical, intent(out), optional:: flag_time_exist
14127 logical, intent(out), optional:: err
14128 real(DP), intent(out) :: array(:,:,:,:)
14129 end subroutine historygetdouble4
14130 end interface
14131 interface
14132 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14133 character(*), intent(in):: file
14134 character(*), intent(in):: varname
14135 character(*), intent(out):: url
14136 character(*), intent(in), optional:: range
14137 logical, intent(out), optional:: flag_time_exist
14138 character(*), intent(out), optional:: time_name
14139 logical, intent(out), optional:: err
14140 end subroutine lookup_growable_url
14141 end interface
14142 interface
14143 function file_rename_mpi( file ) result(result)
14144 use dc_types, only: string
14145 character(*), intent(in):: file
14146 character(STRING):: result
14147 end function file_rename_mpi
14148 end interface
14149 continue
14150 file_work = file
14151 if ( present_and_true( flag_mpi_split ) ) &
14152 & file_work = file_rename_mpi( file_work )
14153 call lookup_growable_url(file = file_work, varname = varname, &
14154 & url = url, &
14155 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14156 call url_chop_iorange( &
14157 & fullname = url, iorange = iorange, remainder = remainder )
14158 call split( str = iorange, carray = carray, sep = gt_equal )
14159 timevar_name = carray(1)
14160 deallocate( carray )
14161 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14162 call historygetdouble4( file = file, &
14163 & varname = varname, array = array, &
14164 & range = time_range, quiet = quiet, &
14165 & flag_mpi_split = flag_mpi_split, &
14166 & returned_time = returned_time, &
14167 & flag_time_exist = flag_time_exist, &
14168 & err = err )
14169end subroutine historygetdouble4timei
14171 & file, varname, array, time, &
14172 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14173 use dc_string, only: tochar, split
14174 use dc_types, only: string, dp
14175 use dc_trace, only: dbgmessage
14176 use dc_url, only: url_chop_iorange, gt_equal
14177 use dc_present, only: present_and_true
14178 implicit none
14179 character(*), intent(in):: file, varname
14180 integer, intent(in):: time
14181 logical, intent(in), optional:: quiet
14182 real(DP), intent(out) :: array(:,:,:,:,:)
14183 logical, intent(in), optional:: flag_mpi_split
14184 real(DP), intent(out), optional:: returned_time
14185 logical, intent(out), optional:: flag_time_exist
14186 logical, intent(out), optional:: err
14187 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14188 character(STRING), pointer:: carray (:)
14189 character(STRING):: tname
14190 interface
14191 subroutine historygetdouble5(&
14192 & file, varname, array, range, quiet, &
14193 & flag_mpi_split, returned_time, flag_time_exist, err)
14194 use dc_types, only: dp
14195 character(*), intent(in):: file
14196 character(*), intent(in):: varname
14197 character(*), intent(in), optional:: range
14198 logical, intent(in), optional:: quiet
14199 logical, intent(in), optional:: flag_mpi_split
14200 real(DP), intent(out), optional:: returned_time
14201 logical, intent(out), optional:: flag_time_exist
14202 logical, intent(out), optional:: err
14203 real(DP), intent(out) :: array(:,:,:,:,:)
14204 end subroutine historygetdouble5
14205 end interface
14206 interface
14207 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14208 character(*), intent(in):: file
14209 character(*), intent(in):: varname
14210 character(*), intent(out):: url
14211 character(*), intent(in), optional:: range
14212 logical, intent(out), optional:: flag_time_exist
14213 character(*), intent(out), optional:: time_name
14214 logical, intent(out), optional:: err
14215 end subroutine lookup_growable_url
14216 end interface
14217 interface
14218 function file_rename_mpi( file ) result(result)
14219 use dc_types, only: string
14220 character(*), intent(in):: file
14221 character(STRING):: result
14222 end function file_rename_mpi
14223 end interface
14224 continue
14225 file_work = file
14226 if ( present_and_true( flag_mpi_split ) ) &
14227 & file_work = file_rename_mpi( file_work )
14228 call lookup_growable_url(file = file_work, varname = varname, &
14229 & url = url, &
14230 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14231 call url_chop_iorange( &
14232 & fullname = url, iorange = iorange, remainder = remainder )
14233 call split( str = iorange, carray = carray, sep = gt_equal )
14234 timevar_name = carray(1)
14235 deallocate( carray )
14236 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14237 call historygetdouble5( file = file, &
14238 & varname = varname, array = array, &
14239 & range = time_range, quiet = quiet, &
14240 & flag_mpi_split = flag_mpi_split, &
14241 & returned_time = returned_time, &
14242 & flag_time_exist = flag_time_exist, &
14243 & err = err )
14244end subroutine historygetdouble5timei
14246 & file, varname, array, time, &
14247 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14248 use dc_string, only: tochar, split
14249 use dc_types, only: string, dp
14250 use dc_trace, only: dbgmessage
14251 use dc_url, only: url_chop_iorange, gt_equal
14252 use dc_present, only: present_and_true
14253 implicit none
14254 character(*), intent(in):: file, varname
14255 integer, intent(in):: time
14256 logical, intent(in), optional:: quiet
14257 real(DP), intent(out) :: array(:,:,:,:,:,:)
14258 logical, intent(in), optional:: flag_mpi_split
14259 real(DP), intent(out), optional:: returned_time
14260 logical, intent(out), optional:: flag_time_exist
14261 logical, intent(out), optional:: err
14262 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14263 character(STRING), pointer:: carray (:)
14264 character(STRING):: tname
14265 interface
14266 subroutine historygetdouble6(&
14267 & file, varname, array, range, quiet, &
14268 & flag_mpi_split, returned_time, flag_time_exist, err)
14269 use dc_types, only: dp
14270 character(*), intent(in):: file
14271 character(*), intent(in):: varname
14272 character(*), intent(in), optional:: range
14273 logical, intent(in), optional:: quiet
14274 logical, intent(in), optional:: flag_mpi_split
14275 real(DP), intent(out), optional:: returned_time
14276 logical, intent(out), optional:: flag_time_exist
14277 logical, intent(out), optional:: err
14278 real(DP), intent(out) :: array(:,:,:,:,:,:)
14279 end subroutine historygetdouble6
14280 end interface
14281 interface
14282 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14283 character(*), intent(in):: file
14284 character(*), intent(in):: varname
14285 character(*), intent(out):: url
14286 character(*), intent(in), optional:: range
14287 logical, intent(out), optional:: flag_time_exist
14288 character(*), intent(out), optional:: time_name
14289 logical, intent(out), optional:: err
14290 end subroutine lookup_growable_url
14291 end interface
14292 interface
14293 function file_rename_mpi( file ) result(result)
14294 use dc_types, only: string
14295 character(*), intent(in):: file
14296 character(STRING):: result
14297 end function file_rename_mpi
14298 end interface
14299 continue
14300 file_work = file
14301 if ( present_and_true( flag_mpi_split ) ) &
14302 & file_work = file_rename_mpi( file_work )
14303 call lookup_growable_url(file = file_work, varname = varname, &
14304 & url = url, &
14305 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14306 call url_chop_iorange( &
14307 & fullname = url, iorange = iorange, remainder = remainder )
14308 call split( str = iorange, carray = carray, sep = gt_equal )
14309 timevar_name = carray(1)
14310 deallocate( carray )
14311 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14312 call historygetdouble6( file = file, &
14313 & varname = varname, array = array, &
14314 & range = time_range, quiet = quiet, &
14315 & flag_mpi_split = flag_mpi_split, &
14316 & returned_time = returned_time, &
14317 & flag_time_exist = flag_time_exist, &
14318 & err = err )
14319end subroutine historygetdouble6timei
14321 & file, varname, array, time, &
14322 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14323 use dc_string, only: tochar, split
14324 use dc_types, only: string, dp
14325 use dc_trace, only: dbgmessage
14326 use dc_url, only: url_chop_iorange, gt_equal
14327 use dc_present, only: present_and_true
14328 implicit none
14329 character(*), intent(in):: file, varname
14330 integer, intent(in):: time
14331 logical, intent(in), optional:: quiet
14332 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
14333 logical, intent(in), optional:: flag_mpi_split
14334 real(DP), intent(out), optional:: returned_time
14335 logical, intent(out), optional:: flag_time_exist
14336 logical, intent(out), optional:: err
14337 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14338 character(STRING), pointer:: carray (:)
14339 character(STRING):: tname
14340 interface
14341 subroutine historygetdouble7(&
14342 & file, varname, array, range, quiet, &
14343 & flag_mpi_split, returned_time, flag_time_exist, err)
14344 use dc_types, only: dp
14345 character(*), intent(in):: file
14346 character(*), intent(in):: varname
14347 character(*), intent(in), optional:: range
14348 logical, intent(in), optional:: quiet
14349 logical, intent(in), optional:: flag_mpi_split
14350 real(DP), intent(out), optional:: returned_time
14351 logical, intent(out), optional:: flag_time_exist
14352 logical, intent(out), optional:: err
14353 real(DP), intent(out) :: array(:,:,:,:,:,:,:)
14354 end subroutine historygetdouble7
14355 end interface
14356 interface
14357 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14358 character(*), intent(in):: file
14359 character(*), intent(in):: varname
14360 character(*), intent(out):: url
14361 character(*), intent(in), optional:: range
14362 logical, intent(out), optional:: flag_time_exist
14363 character(*), intent(out), optional:: time_name
14364 logical, intent(out), optional:: err
14365 end subroutine lookup_growable_url
14366 end interface
14367 interface
14368 function file_rename_mpi( file ) result(result)
14369 use dc_types, only: string
14370 character(*), intent(in):: file
14371 character(STRING):: result
14372 end function file_rename_mpi
14373 end interface
14374 continue
14375 file_work = file
14376 if ( present_and_true( flag_mpi_split ) ) &
14377 & file_work = file_rename_mpi( file_work )
14378 call lookup_growable_url(file = file_work, varname = varname, &
14379 & url = url, &
14380 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14381 call url_chop_iorange( &
14382 & fullname = url, iorange = iorange, remainder = remainder )
14383 call split( str = iorange, carray = carray, sep = gt_equal )
14384 timevar_name = carray(1)
14385 deallocate( carray )
14386 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14387 call historygetdouble7( file = file, &
14388 & varname = varname, array = array, &
14389 & range = time_range, quiet = quiet, &
14390 & flag_mpi_split = flag_mpi_split, &
14391 & returned_time = returned_time, &
14392 & flag_time_exist = flag_time_exist, &
14393 & err = err )
14394end subroutine historygetdouble7timei
14396 & file, varname, array, time, &
14397 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14398 use dc_string, only: tochar, split
14399 use dc_types, only: string, dp
14400 use dc_trace, only: dbgmessage
14401 use dc_url, only: url_chop_iorange, gt_equal
14402 use dc_present, only: present_and_true
14403 implicit none
14404 character(*), intent(in):: file, varname
14405 integer, intent(in):: time
14406 logical, intent(in), optional:: quiet
14407 real(DP), pointer :: array
14408 logical, intent(in), optional:: flag_mpi_split
14409 real(DP), intent(out), optional:: returned_time
14410 logical, intent(out), optional:: flag_time_exist
14411 logical, intent(out), optional:: err
14412 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14413 character(STRING), pointer:: carray (:)
14414 character(STRING):: tname
14415 interface
14416 subroutine historygetdouble0pointer(&
14417 & file, varname, array, range, quiet, &
14418 & flag_mpi_split, returned_time, flag_time_exist, err)
14419 use dc_types, only: dp
14420 character(*), intent(in):: file
14421 character(*), intent(in):: varname
14422 character(*), intent(in), optional:: range
14423 logical, intent(in), optional:: quiet
14424 logical, intent(in), optional:: flag_mpi_split
14425 real(DP), intent(out), optional:: returned_time
14426 logical, intent(out), optional:: flag_time_exist
14427 logical, intent(out), optional:: err
14428 real(DP), pointer :: array
14429 end subroutine historygetdouble0pointer
14430 end interface
14431 interface
14432 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14433 character(*), intent(in):: file
14434 character(*), intent(in):: varname
14435 character(*), intent(out):: url
14436 character(*), intent(in), optional:: range
14437 logical, intent(out), optional:: flag_time_exist
14438 character(*), intent(out), optional:: time_name
14439 logical, intent(out), optional:: err
14440 end subroutine lookup_growable_url
14441 end interface
14442 interface
14443 function file_rename_mpi( file ) result(result)
14444 use dc_types, only: string
14445 character(*), intent(in):: file
14446 character(STRING):: result
14447 end function file_rename_mpi
14448 end interface
14449 continue
14450 file_work = file
14451 if ( present_and_true( flag_mpi_split ) ) &
14452 & file_work = file_rename_mpi( file_work )
14453 call lookup_growable_url(file = file_work, varname = varname, &
14454 & url = url, &
14455 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14456 call url_chop_iorange( &
14457 & fullname = url, iorange = iorange, remainder = remainder )
14458 call split( str = iorange, carray = carray, sep = gt_equal )
14459 timevar_name = carray(1)
14460 deallocate( carray )
14461 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14462 call historygetdouble0pointer( file = file, &
14463 & varname = varname, array = array, &
14464 & range = time_range, quiet = quiet, &
14465 & flag_mpi_split = flag_mpi_split, &
14466 & returned_time = returned_time, &
14467 & flag_time_exist = flag_time_exist, &
14468 & err = err )
14469end subroutine historygetdouble0pointertimei
14471 & file, varname, array, time, &
14472 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14473 use dc_string, only: tochar, split
14474 use dc_types, only: string, dp
14475 use dc_trace, only: dbgmessage
14476 use dc_url, only: url_chop_iorange, gt_equal
14477 use dc_present, only: present_and_true
14478 implicit none
14479 character(*), intent(in):: file, varname
14480 integer, intent(in):: time
14481 logical, intent(in), optional:: quiet
14482 real(DP), pointer :: array(:)
14483 logical, intent(in), optional:: flag_mpi_split
14484 real(DP), intent(out), optional:: returned_time
14485 logical, intent(out), optional:: flag_time_exist
14486 logical, intent(out), optional:: err
14487 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14488 character(STRING), pointer:: carray (:)
14489 character(STRING):: tname
14490 interface
14491 subroutine historygetdouble1pointer(&
14492 & file, varname, array, range, quiet, &
14493 & flag_mpi_split, returned_time, flag_time_exist, err)
14494 use dc_types, only: dp
14495 character(*), intent(in):: file
14496 character(*), intent(in):: varname
14497 character(*), intent(in), optional:: range
14498 logical, intent(in), optional:: quiet
14499 logical, intent(in), optional:: flag_mpi_split
14500 real(DP), intent(out), optional:: returned_time
14501 logical, intent(out), optional:: flag_time_exist
14502 logical, intent(out), optional:: err
14503 real(DP), pointer :: array(:)
14504 end subroutine historygetdouble1pointer
14505 end interface
14506 interface
14507 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14508 character(*), intent(in):: file
14509 character(*), intent(in):: varname
14510 character(*), intent(out):: url
14511 character(*), intent(in), optional:: range
14512 logical, intent(out), optional:: flag_time_exist
14513 character(*), intent(out), optional:: time_name
14514 logical, intent(out), optional:: err
14515 end subroutine lookup_growable_url
14516 end interface
14517 interface
14518 function file_rename_mpi( file ) result(result)
14519 use dc_types, only: string
14520 character(*), intent(in):: file
14521 character(STRING):: result
14522 end function file_rename_mpi
14523 end interface
14524 continue
14525 file_work = file
14526 if ( present_and_true( flag_mpi_split ) ) &
14527 & file_work = file_rename_mpi( file_work )
14528 call lookup_growable_url(file = file_work, varname = varname, &
14529 & url = url, &
14530 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14531 call url_chop_iorange( &
14532 & fullname = url, iorange = iorange, remainder = remainder )
14533 call split( str = iorange, carray = carray, sep = gt_equal )
14534 timevar_name = carray(1)
14535 deallocate( carray )
14536 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14537 call historygetdouble1pointer( file = file, &
14538 & varname = varname, array = array, &
14539 & range = time_range, quiet = quiet, &
14540 & flag_mpi_split = flag_mpi_split, &
14541 & returned_time = returned_time, &
14542 & flag_time_exist = flag_time_exist, &
14543 & err = err )
14544end subroutine historygetdouble1pointertimei
14546 & file, varname, array, time, &
14547 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14548 use dc_string, only: tochar, split
14549 use dc_types, only: string, dp
14550 use dc_trace, only: dbgmessage
14551 use dc_url, only: url_chop_iorange, gt_equal
14552 use dc_present, only: present_and_true
14553 implicit none
14554 character(*), intent(in):: file, varname
14555 integer, intent(in):: time
14556 logical, intent(in), optional:: quiet
14557 real(DP), pointer :: array(:,:)
14558 logical, intent(in), optional:: flag_mpi_split
14559 real(DP), intent(out), optional:: returned_time
14560 logical, intent(out), optional:: flag_time_exist
14561 logical, intent(out), optional:: err
14562 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14563 character(STRING), pointer:: carray (:)
14564 character(STRING):: tname
14565 interface
14566 subroutine historygetdouble2pointer(&
14567 & file, varname, array, range, quiet, &
14568 & flag_mpi_split, returned_time, flag_time_exist, err)
14569 use dc_types, only: dp
14570 character(*), intent(in):: file
14571 character(*), intent(in):: varname
14572 character(*), intent(in), optional:: range
14573 logical, intent(in), optional:: quiet
14574 logical, intent(in), optional:: flag_mpi_split
14575 real(DP), intent(out), optional:: returned_time
14576 logical, intent(out), optional:: flag_time_exist
14577 logical, intent(out), optional:: err
14578 real(DP), pointer :: array(:,:)
14579 end subroutine historygetdouble2pointer
14580 end interface
14581 interface
14582 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14583 character(*), intent(in):: file
14584 character(*), intent(in):: varname
14585 character(*), intent(out):: url
14586 character(*), intent(in), optional:: range
14587 logical, intent(out), optional:: flag_time_exist
14588 character(*), intent(out), optional:: time_name
14589 logical, intent(out), optional:: err
14590 end subroutine lookup_growable_url
14591 end interface
14592 interface
14593 function file_rename_mpi( file ) result(result)
14594 use dc_types, only: string
14595 character(*), intent(in):: file
14596 character(STRING):: result
14597 end function file_rename_mpi
14598 end interface
14599 continue
14600 file_work = file
14601 if ( present_and_true( flag_mpi_split ) ) &
14602 & file_work = file_rename_mpi( file_work )
14603 call lookup_growable_url(file = file_work, varname = varname, &
14604 & url = url, &
14605 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14606 call url_chop_iorange( &
14607 & fullname = url, iorange = iorange, remainder = remainder )
14608 call split( str = iorange, carray = carray, sep = gt_equal )
14609 timevar_name = carray(1)
14610 deallocate( carray )
14611 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14612 call historygetdouble2pointer( file = file, &
14613 & varname = varname, array = array, &
14614 & range = time_range, quiet = quiet, &
14615 & flag_mpi_split = flag_mpi_split, &
14616 & returned_time = returned_time, &
14617 & flag_time_exist = flag_time_exist, &
14618 & err = err )
14619end subroutine historygetdouble2pointertimei
14621 & file, varname, array, time, &
14622 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14623 use dc_string, only: tochar, split
14624 use dc_types, only: string, dp
14625 use dc_trace, only: dbgmessage
14626 use dc_url, only: url_chop_iorange, gt_equal
14627 use dc_present, only: present_and_true
14628 implicit none
14629 character(*), intent(in):: file, varname
14630 integer, intent(in):: time
14631 logical, intent(in), optional:: quiet
14632 real(DP), pointer :: array(:,:,:)
14633 logical, intent(in), optional:: flag_mpi_split
14634 real(DP), intent(out), optional:: returned_time
14635 logical, intent(out), optional:: flag_time_exist
14636 logical, intent(out), optional:: err
14637 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14638 character(STRING), pointer:: carray (:)
14639 character(STRING):: tname
14640 interface
14641 subroutine historygetdouble3pointer(&
14642 & file, varname, array, range, quiet, &
14643 & flag_mpi_split, returned_time, flag_time_exist, err)
14644 use dc_types, only: dp
14645 character(*), intent(in):: file
14646 character(*), intent(in):: varname
14647 character(*), intent(in), optional:: range
14648 logical, intent(in), optional:: quiet
14649 logical, intent(in), optional:: flag_mpi_split
14650 real(DP), intent(out), optional:: returned_time
14651 logical, intent(out), optional:: flag_time_exist
14652 logical, intent(out), optional:: err
14653 real(DP), pointer :: array(:,:,:)
14654 end subroutine historygetdouble3pointer
14655 end interface
14656 interface
14657 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14658 character(*), intent(in):: file
14659 character(*), intent(in):: varname
14660 character(*), intent(out):: url
14661 character(*), intent(in), optional:: range
14662 logical, intent(out), optional:: flag_time_exist
14663 character(*), intent(out), optional:: time_name
14664 logical, intent(out), optional:: err
14665 end subroutine lookup_growable_url
14666 end interface
14667 interface
14668 function file_rename_mpi( file ) result(result)
14669 use dc_types, only: string
14670 character(*), intent(in):: file
14671 character(STRING):: result
14672 end function file_rename_mpi
14673 end interface
14674 continue
14675 file_work = file
14676 if ( present_and_true( flag_mpi_split ) ) &
14677 & file_work = file_rename_mpi( file_work )
14678 call lookup_growable_url(file = file_work, varname = varname, &
14679 & url = url, &
14680 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14681 call url_chop_iorange( &
14682 & fullname = url, iorange = iorange, remainder = remainder )
14683 call split( str = iorange, carray = carray, sep = gt_equal )
14684 timevar_name = carray(1)
14685 deallocate( carray )
14686 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14687 call historygetdouble3pointer( file = file, &
14688 & varname = varname, array = array, &
14689 & range = time_range, quiet = quiet, &
14690 & flag_mpi_split = flag_mpi_split, &
14691 & returned_time = returned_time, &
14692 & flag_time_exist = flag_time_exist, &
14693 & err = err )
14694end subroutine historygetdouble3pointertimei
14696 & file, varname, array, time, &
14697 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14698 use dc_string, only: tochar, split
14699 use dc_types, only: string, dp
14700 use dc_trace, only: dbgmessage
14701 use dc_url, only: url_chop_iorange, gt_equal
14702 use dc_present, only: present_and_true
14703 implicit none
14704 character(*), intent(in):: file, varname
14705 integer, intent(in):: time
14706 logical, intent(in), optional:: quiet
14707 real(DP), pointer :: array(:,:,:,:)
14708 logical, intent(in), optional:: flag_mpi_split
14709 real(DP), intent(out), optional:: returned_time
14710 logical, intent(out), optional:: flag_time_exist
14711 logical, intent(out), optional:: err
14712 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14713 character(STRING), pointer:: carray (:)
14714 character(STRING):: tname
14715 interface
14716 subroutine historygetdouble4pointer(&
14717 & file, varname, array, range, quiet, &
14718 & flag_mpi_split, returned_time, flag_time_exist, err)
14719 use dc_types, only: dp
14720 character(*), intent(in):: file
14721 character(*), intent(in):: varname
14722 character(*), intent(in), optional:: range
14723 logical, intent(in), optional:: quiet
14724 logical, intent(in), optional:: flag_mpi_split
14725 real(DP), intent(out), optional:: returned_time
14726 logical, intent(out), optional:: flag_time_exist
14727 logical, intent(out), optional:: err
14728 real(DP), pointer :: array(:,:,:,:)
14729 end subroutine historygetdouble4pointer
14730 end interface
14731 interface
14732 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14733 character(*), intent(in):: file
14734 character(*), intent(in):: varname
14735 character(*), intent(out):: url
14736 character(*), intent(in), optional:: range
14737 logical, intent(out), optional:: flag_time_exist
14738 character(*), intent(out), optional:: time_name
14739 logical, intent(out), optional:: err
14740 end subroutine lookup_growable_url
14741 end interface
14742 interface
14743 function file_rename_mpi( file ) result(result)
14744 use dc_types, only: string
14745 character(*), intent(in):: file
14746 character(STRING):: result
14747 end function file_rename_mpi
14748 end interface
14749 continue
14750 file_work = file
14751 if ( present_and_true( flag_mpi_split ) ) &
14752 & file_work = file_rename_mpi( file_work )
14753 call lookup_growable_url(file = file_work, varname = varname, &
14754 & url = url, &
14755 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14756 call url_chop_iorange( &
14757 & fullname = url, iorange = iorange, remainder = remainder )
14758 call split( str = iorange, carray = carray, sep = gt_equal )
14759 timevar_name = carray(1)
14760 deallocate( carray )
14761 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14762 call historygetdouble4pointer( file = file, &
14763 & varname = varname, array = array, &
14764 & range = time_range, quiet = quiet, &
14765 & flag_mpi_split = flag_mpi_split, &
14766 & returned_time = returned_time, &
14767 & flag_time_exist = flag_time_exist, &
14768 & err = err )
14769end subroutine historygetdouble4pointertimei
14771 & file, varname, array, time, &
14772 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14773 use dc_string, only: tochar, split
14774 use dc_types, only: string, dp
14775 use dc_trace, only: dbgmessage
14776 use dc_url, only: url_chop_iorange, gt_equal
14777 use dc_present, only: present_and_true
14778 implicit none
14779 character(*), intent(in):: file, varname
14780 integer, intent(in):: time
14781 logical, intent(in), optional:: quiet
14782 real(DP), pointer :: array(:,:,:,:,:)
14783 logical, intent(in), optional:: flag_mpi_split
14784 real(DP), intent(out), optional:: returned_time
14785 logical, intent(out), optional:: flag_time_exist
14786 logical, intent(out), optional:: err
14787 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14788 character(STRING), pointer:: carray (:)
14789 character(STRING):: tname
14790 interface
14791 subroutine historygetdouble5pointer(&
14792 & file, varname, array, range, quiet, &
14793 & flag_mpi_split, returned_time, flag_time_exist, err)
14794 use dc_types, only: dp
14795 character(*), intent(in):: file
14796 character(*), intent(in):: varname
14797 character(*), intent(in), optional:: range
14798 logical, intent(in), optional:: quiet
14799 logical, intent(in), optional:: flag_mpi_split
14800 real(DP), intent(out), optional:: returned_time
14801 logical, intent(out), optional:: flag_time_exist
14802 logical, intent(out), optional:: err
14803 real(DP), pointer :: array(:,:,:,:,:)
14804 end subroutine historygetdouble5pointer
14805 end interface
14806 interface
14807 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14808 character(*), intent(in):: file
14809 character(*), intent(in):: varname
14810 character(*), intent(out):: url
14811 character(*), intent(in), optional:: range
14812 logical, intent(out), optional:: flag_time_exist
14813 character(*), intent(out), optional:: time_name
14814 logical, intent(out), optional:: err
14815 end subroutine lookup_growable_url
14816 end interface
14817 interface
14818 function file_rename_mpi( file ) result(result)
14819 use dc_types, only: string
14820 character(*), intent(in):: file
14821 character(STRING):: result
14822 end function file_rename_mpi
14823 end interface
14824 continue
14825 file_work = file
14826 if ( present_and_true( flag_mpi_split ) ) &
14827 & file_work = file_rename_mpi( file_work )
14828 call lookup_growable_url(file = file_work, varname = varname, &
14829 & url = url, &
14830 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14831 call url_chop_iorange( &
14832 & fullname = url, iorange = iorange, remainder = remainder )
14833 call split( str = iorange, carray = carray, sep = gt_equal )
14834 timevar_name = carray(1)
14835 deallocate( carray )
14836 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14837 call historygetdouble5pointer( file = file, &
14838 & varname = varname, array = array, &
14839 & range = time_range, quiet = quiet, &
14840 & flag_mpi_split = flag_mpi_split, &
14841 & returned_time = returned_time, &
14842 & flag_time_exist = flag_time_exist, &
14843 & err = err )
14844end subroutine historygetdouble5pointertimei
14846 & file, varname, array, time, &
14847 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14848 use dc_string, only: tochar, split
14849 use dc_types, only: string, dp
14850 use dc_trace, only: dbgmessage
14851 use dc_url, only: url_chop_iorange, gt_equal
14852 use dc_present, only: present_and_true
14853 implicit none
14854 character(*), intent(in):: file, varname
14855 integer, intent(in):: time
14856 logical, intent(in), optional:: quiet
14857 real(DP), pointer :: array(:,:,:,:,:,:)
14858 logical, intent(in), optional:: flag_mpi_split
14859 real(DP), intent(out), optional:: returned_time
14860 logical, intent(out), optional:: flag_time_exist
14861 logical, intent(out), optional:: err
14862 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14863 character(STRING), pointer:: carray (:)
14864 character(STRING):: tname
14865 interface
14866 subroutine historygetdouble6pointer(&
14867 & file, varname, array, range, quiet, &
14868 & flag_mpi_split, returned_time, flag_time_exist, err)
14869 use dc_types, only: dp
14870 character(*), intent(in):: file
14871 character(*), intent(in):: varname
14872 character(*), intent(in), optional:: range
14873 logical, intent(in), optional:: quiet
14874 logical, intent(in), optional:: flag_mpi_split
14875 real(DP), intent(out), optional:: returned_time
14876 logical, intent(out), optional:: flag_time_exist
14877 logical, intent(out), optional:: err
14878 real(DP), pointer :: array(:,:,:,:,:,:)
14879 end subroutine historygetdouble6pointer
14880 end interface
14881 interface
14882 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14883 character(*), intent(in):: file
14884 character(*), intent(in):: varname
14885 character(*), intent(out):: url
14886 character(*), intent(in), optional:: range
14887 logical, intent(out), optional:: flag_time_exist
14888 character(*), intent(out), optional:: time_name
14889 logical, intent(out), optional:: err
14890 end subroutine lookup_growable_url
14891 end interface
14892 interface
14893 function file_rename_mpi( file ) result(result)
14894 use dc_types, only: string
14895 character(*), intent(in):: file
14896 character(STRING):: result
14897 end function file_rename_mpi
14898 end interface
14899 continue
14900 file_work = file
14901 if ( present_and_true( flag_mpi_split ) ) &
14902 & file_work = file_rename_mpi( file_work )
14903 call lookup_growable_url(file = file_work, varname = varname, &
14904 & url = url, &
14905 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14906 call url_chop_iorange( &
14907 & fullname = url, iorange = iorange, remainder = remainder )
14908 call split( str = iorange, carray = carray, sep = gt_equal )
14909 timevar_name = carray(1)
14910 deallocate( carray )
14911 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14912 call historygetdouble6pointer( file = file, &
14913 & varname = varname, array = array, &
14914 & range = time_range, quiet = quiet, &
14915 & flag_mpi_split = flag_mpi_split, &
14916 & returned_time = returned_time, &
14917 & flag_time_exist = flag_time_exist, &
14918 & err = err )
14919end subroutine historygetdouble6pointertimei
14921 & file, varname, array, time, &
14922 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14923 use dc_string, only: tochar, split
14924 use dc_types, only: string, dp
14925 use dc_trace, only: dbgmessage
14926 use dc_url, only: url_chop_iorange, gt_equal
14927 use dc_present, only: present_and_true
14928 implicit none
14929 character(*), intent(in):: file, varname
14930 integer, intent(in):: time
14931 logical, intent(in), optional:: quiet
14932 real(DP), pointer :: array(:,:,:,:,:,:,:)
14933 logical, intent(in), optional:: flag_mpi_split
14934 real(DP), intent(out), optional:: returned_time
14935 logical, intent(out), optional:: flag_time_exist
14936 logical, intent(out), optional:: err
14937 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
14938 character(STRING), pointer:: carray (:)
14939 character(STRING):: tname
14940 interface
14941 subroutine historygetdouble7pointer(&
14942 & file, varname, array, range, quiet, &
14943 & flag_mpi_split, returned_time, flag_time_exist, err)
14944 use dc_types, only: dp
14945 character(*), intent(in):: file
14946 character(*), intent(in):: varname
14947 character(*), intent(in), optional:: range
14948 logical, intent(in), optional:: quiet
14949 logical, intent(in), optional:: flag_mpi_split
14950 real(DP), intent(out), optional:: returned_time
14951 logical, intent(out), optional:: flag_time_exist
14952 logical, intent(out), optional:: err
14953 real(DP), pointer :: array(:,:,:,:,:,:,:)
14954 end subroutine historygetdouble7pointer
14955 end interface
14956 interface
14957 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
14958 character(*), intent(in):: file
14959 character(*), intent(in):: varname
14960 character(*), intent(out):: url
14961 character(*), intent(in), optional:: range
14962 logical, intent(out), optional:: flag_time_exist
14963 character(*), intent(out), optional:: time_name
14964 logical, intent(out), optional:: err
14965 end subroutine lookup_growable_url
14966 end interface
14967 interface
14968 function file_rename_mpi( file ) result(result)
14969 use dc_types, only: string
14970 character(*), intent(in):: file
14971 character(STRING):: result
14972 end function file_rename_mpi
14973 end interface
14974 continue
14975 file_work = file
14976 if ( present_and_true( flag_mpi_split ) ) &
14977 & file_work = file_rename_mpi( file_work )
14978 call lookup_growable_url(file = file_work, varname = varname, &
14979 & url = url, &
14980 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
14981 call url_chop_iorange( &
14982 & fullname = url, iorange = iorange, remainder = remainder )
14983 call split( str = iorange, carray = carray, sep = gt_equal )
14984 timevar_name = carray(1)
14985 deallocate( carray )
14986 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
14987 call historygetdouble7pointer( file = file, &
14988 & varname = varname, array = array, &
14989 & range = time_range, quiet = quiet, &
14990 & flag_mpi_split = flag_mpi_split, &
14991 & returned_time = returned_time, &
14992 & flag_time_exist = flag_time_exist, &
14993 & err = err )
14994end subroutine historygetdouble7pointertimei
14996 & file, varname, array, time, &
14997 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
14998 use dc_string, only: tochar, split
14999 use dc_types, only: string, dp, sp
15000 use dc_trace, only: dbgmessage
15001 use dc_url, only: url_chop_iorange, gt_equal
15002 use dc_present, only: present_and_true
15003 implicit none
15004 character(*), intent(in):: file, varname
15005 integer, intent(in):: time
15006 logical, intent(in), optional:: quiet
15007 real(SP), intent(out) :: array
15008 logical, intent(in), optional:: flag_mpi_split
15009 real(DP), intent(out), optional:: returned_time
15010 logical, intent(out), optional:: flag_time_exist
15011 logical, intent(out), optional:: err
15012 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15013 character(STRING), pointer:: carray (:)
15014 character(STRING):: tname
15015 interface
15016 subroutine historygetreal0(&
15017 & file, varname, array, range, quiet, &
15018 & flag_mpi_split, returned_time, flag_time_exist, err)
15019 use dc_types, only: dp, sp
15020 character(*), intent(in):: file
15021 character(*), intent(in):: varname
15022 character(*), intent(in), optional:: range
15023 logical, intent(in), optional:: quiet
15024 logical, intent(in), optional:: flag_mpi_split
15025 real(DP), intent(out), optional:: returned_time
15026 logical, intent(out), optional:: flag_time_exist
15027 logical, intent(out), optional:: err
15028 real(SP), intent(out) :: array
15029 end subroutine historygetreal0
15030 end interface
15031 interface
15032 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15033 character(*), intent(in):: file
15034 character(*), intent(in):: varname
15035 character(*), intent(out):: url
15036 character(*), intent(in), optional:: range
15037 logical, intent(out), optional:: flag_time_exist
15038 character(*), intent(out), optional:: time_name
15039 logical, intent(out), optional:: err
15040 end subroutine lookup_growable_url
15041 end interface
15042 interface
15043 function file_rename_mpi( file ) result(result)
15044 use dc_types, only: string
15045 character(*), intent(in):: file
15046 character(STRING):: result
15047 end function file_rename_mpi
15048 end interface
15049 continue
15050 file_work = file
15051 if ( present_and_true( flag_mpi_split ) ) &
15052 & file_work = file_rename_mpi( file_work )
15053 call lookup_growable_url(file = file_work, varname = varname, &
15054 & url = url, &
15055 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15056 call url_chop_iorange( &
15057 & fullname = url, iorange = iorange, remainder = remainder )
15058 call split( str = iorange, carray = carray, sep = gt_equal )
15059 timevar_name = carray(1)
15060 deallocate( carray )
15061 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15062 call historygetreal0( file = file, &
15063 & varname = varname, array = array, &
15064 & range = time_range, quiet = quiet, &
15065 & flag_mpi_split = flag_mpi_split, &
15066 & returned_time = returned_time, &
15067 & flag_time_exist = flag_time_exist, &
15068 & err = err )
15069end subroutine historygetreal0timei
15071 & file, varname, array, time, &
15072 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15073 use dc_string, only: tochar, split
15074 use dc_types, only: string, dp, sp
15075 use dc_trace, only: dbgmessage
15076 use dc_url, only: url_chop_iorange, gt_equal
15077 use dc_present, only: present_and_true
15078 implicit none
15079 character(*), intent(in):: file, varname
15080 integer, intent(in):: time
15081 logical, intent(in), optional:: quiet
15082 real(SP), intent(out) :: array(:)
15083 logical, intent(in), optional:: flag_mpi_split
15084 real(DP), intent(out), optional:: returned_time
15085 logical, intent(out), optional:: flag_time_exist
15086 logical, intent(out), optional:: err
15087 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15088 character(STRING), pointer:: carray (:)
15089 character(STRING):: tname
15090 interface
15091 subroutine historygetreal1(&
15092 & file, varname, array, range, quiet, &
15093 & flag_mpi_split, returned_time, flag_time_exist, err)
15094 use dc_types, only: dp, sp
15095 character(*), intent(in):: file
15096 character(*), intent(in):: varname
15097 character(*), intent(in), optional:: range
15098 logical, intent(in), optional:: quiet
15099 logical, intent(in), optional:: flag_mpi_split
15100 real(DP), intent(out), optional:: returned_time
15101 logical, intent(out), optional:: flag_time_exist
15102 logical, intent(out), optional:: err
15103 real(SP), intent(out) :: array(:)
15104 end subroutine historygetreal1
15105 end interface
15106 interface
15107 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15108 character(*), intent(in):: file
15109 character(*), intent(in):: varname
15110 character(*), intent(out):: url
15111 character(*), intent(in), optional:: range
15112 logical, intent(out), optional:: flag_time_exist
15113 character(*), intent(out), optional:: time_name
15114 logical, intent(out), optional:: err
15115 end subroutine lookup_growable_url
15116 end interface
15117 interface
15118 function file_rename_mpi( file ) result(result)
15119 use dc_types, only: string
15120 character(*), intent(in):: file
15121 character(STRING):: result
15122 end function file_rename_mpi
15123 end interface
15124 continue
15125 file_work = file
15126 if ( present_and_true( flag_mpi_split ) ) &
15127 & file_work = file_rename_mpi( file_work )
15128 call lookup_growable_url(file = file_work, varname = varname, &
15129 & url = url, &
15130 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15131 call url_chop_iorange( &
15132 & fullname = url, iorange = iorange, remainder = remainder )
15133 call split( str = iorange, carray = carray, sep = gt_equal )
15134 timevar_name = carray(1)
15135 deallocate( carray )
15136 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15137 call historygetreal1( file = file, &
15138 & varname = varname, array = array, &
15139 & range = time_range, quiet = quiet, &
15140 & flag_mpi_split = flag_mpi_split, &
15141 & returned_time = returned_time, &
15142 & flag_time_exist = flag_time_exist, &
15143 & err = err )
15144end subroutine historygetreal1timei
15146 & file, varname, array, time, &
15147 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15148 use dc_string, only: tochar, split
15149 use dc_types, only: string, dp, sp
15150 use dc_trace, only: dbgmessage
15151 use dc_url, only: url_chop_iorange, gt_equal
15152 use dc_present, only: present_and_true
15153 implicit none
15154 character(*), intent(in):: file, varname
15155 integer, intent(in):: time
15156 logical, intent(in), optional:: quiet
15157 real(SP), intent(out) :: array(:,:)
15158 logical, intent(in), optional:: flag_mpi_split
15159 real(DP), intent(out), optional:: returned_time
15160 logical, intent(out), optional:: flag_time_exist
15161 logical, intent(out), optional:: err
15162 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15163 character(STRING), pointer:: carray (:)
15164 character(STRING):: tname
15165 interface
15166 subroutine historygetreal2(&
15167 & file, varname, array, range, quiet, &
15168 & flag_mpi_split, returned_time, flag_time_exist, err)
15169 use dc_types, only: dp, sp
15170 character(*), intent(in):: file
15171 character(*), intent(in):: varname
15172 character(*), intent(in), optional:: range
15173 logical, intent(in), optional:: quiet
15174 logical, intent(in), optional:: flag_mpi_split
15175 real(DP), intent(out), optional:: returned_time
15176 logical, intent(out), optional:: flag_time_exist
15177 logical, intent(out), optional:: err
15178 real(SP), intent(out) :: array(:,:)
15179 end subroutine historygetreal2
15180 end interface
15181 interface
15182 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15183 character(*), intent(in):: file
15184 character(*), intent(in):: varname
15185 character(*), intent(out):: url
15186 character(*), intent(in), optional:: range
15187 logical, intent(out), optional:: flag_time_exist
15188 character(*), intent(out), optional:: time_name
15189 logical, intent(out), optional:: err
15190 end subroutine lookup_growable_url
15191 end interface
15192 interface
15193 function file_rename_mpi( file ) result(result)
15194 use dc_types, only: string
15195 character(*), intent(in):: file
15196 character(STRING):: result
15197 end function file_rename_mpi
15198 end interface
15199 continue
15200 file_work = file
15201 if ( present_and_true( flag_mpi_split ) ) &
15202 & file_work = file_rename_mpi( file_work )
15203 call lookup_growable_url(file = file_work, varname = varname, &
15204 & url = url, &
15205 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15206 call url_chop_iorange( &
15207 & fullname = url, iorange = iorange, remainder = remainder )
15208 call split( str = iorange, carray = carray, sep = gt_equal )
15209 timevar_name = carray(1)
15210 deallocate( carray )
15211 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15212 call historygetreal2( file = file, &
15213 & varname = varname, array = array, &
15214 & range = time_range, quiet = quiet, &
15215 & flag_mpi_split = flag_mpi_split, &
15216 & returned_time = returned_time, &
15217 & flag_time_exist = flag_time_exist, &
15218 & err = err )
15219end subroutine historygetreal2timei
15221 & file, varname, array, time, &
15222 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15223 use dc_string, only: tochar, split
15224 use dc_types, only: string, dp, sp
15225 use dc_trace, only: dbgmessage
15226 use dc_url, only: url_chop_iorange, gt_equal
15227 use dc_present, only: present_and_true
15228 implicit none
15229 character(*), intent(in):: file, varname
15230 integer, intent(in):: time
15231 logical, intent(in), optional:: quiet
15232 real(SP), intent(out) :: array(:,:,:)
15233 logical, intent(in), optional:: flag_mpi_split
15234 real(DP), intent(out), optional:: returned_time
15235 logical, intent(out), optional:: flag_time_exist
15236 logical, intent(out), optional:: err
15237 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15238 character(STRING), pointer:: carray (:)
15239 character(STRING):: tname
15240 interface
15241 subroutine historygetreal3(&
15242 & file, varname, array, range, quiet, &
15243 & flag_mpi_split, returned_time, flag_time_exist, err)
15244 use dc_types, only: dp, sp
15245 character(*), intent(in):: file
15246 character(*), intent(in):: varname
15247 character(*), intent(in), optional:: range
15248 logical, intent(in), optional:: quiet
15249 logical, intent(in), optional:: flag_mpi_split
15250 real(DP), intent(out), optional:: returned_time
15251 logical, intent(out), optional:: flag_time_exist
15252 logical, intent(out), optional:: err
15253 real(SP), intent(out) :: array(:,:,:)
15254 end subroutine historygetreal3
15255 end interface
15256 interface
15257 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15258 character(*), intent(in):: file
15259 character(*), intent(in):: varname
15260 character(*), intent(out):: url
15261 character(*), intent(in), optional:: range
15262 logical, intent(out), optional:: flag_time_exist
15263 character(*), intent(out), optional:: time_name
15264 logical, intent(out), optional:: err
15265 end subroutine lookup_growable_url
15266 end interface
15267 interface
15268 function file_rename_mpi( file ) result(result)
15269 use dc_types, only: string
15270 character(*), intent(in):: file
15271 character(STRING):: result
15272 end function file_rename_mpi
15273 end interface
15274 continue
15275 file_work = file
15276 if ( present_and_true( flag_mpi_split ) ) &
15277 & file_work = file_rename_mpi( file_work )
15278 call lookup_growable_url(file = file_work, varname = varname, &
15279 & url = url, &
15280 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15281 call url_chop_iorange( &
15282 & fullname = url, iorange = iorange, remainder = remainder )
15283 call split( str = iorange, carray = carray, sep = gt_equal )
15284 timevar_name = carray(1)
15285 deallocate( carray )
15286 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15287 call historygetreal3( file = file, &
15288 & varname = varname, array = array, &
15289 & range = time_range, quiet = quiet, &
15290 & flag_mpi_split = flag_mpi_split, &
15291 & returned_time = returned_time, &
15292 & flag_time_exist = flag_time_exist, &
15293 & err = err )
15294end subroutine historygetreal3timei
15296 & file, varname, array, time, &
15297 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15298 use dc_string, only: tochar, split
15299 use dc_types, only: string, dp, sp
15300 use dc_trace, only: dbgmessage
15301 use dc_url, only: url_chop_iorange, gt_equal
15302 use dc_present, only: present_and_true
15303 implicit none
15304 character(*), intent(in):: file, varname
15305 integer, intent(in):: time
15306 logical, intent(in), optional:: quiet
15307 real(SP), intent(out) :: array(:,:,:,:)
15308 logical, intent(in), optional:: flag_mpi_split
15309 real(DP), intent(out), optional:: returned_time
15310 logical, intent(out), optional:: flag_time_exist
15311 logical, intent(out), optional:: err
15312 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15313 character(STRING), pointer:: carray (:)
15314 character(STRING):: tname
15315 interface
15316 subroutine historygetreal4(&
15317 & file, varname, array, range, quiet, &
15318 & flag_mpi_split, returned_time, flag_time_exist, err)
15319 use dc_types, only: dp, sp
15320 character(*), intent(in):: file
15321 character(*), intent(in):: varname
15322 character(*), intent(in), optional:: range
15323 logical, intent(in), optional:: quiet
15324 logical, intent(in), optional:: flag_mpi_split
15325 real(DP), intent(out), optional:: returned_time
15326 logical, intent(out), optional:: flag_time_exist
15327 logical, intent(out), optional:: err
15328 real(SP), intent(out) :: array(:,:,:,:)
15329 end subroutine historygetreal4
15330 end interface
15331 interface
15332 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15333 character(*), intent(in):: file
15334 character(*), intent(in):: varname
15335 character(*), intent(out):: url
15336 character(*), intent(in), optional:: range
15337 logical, intent(out), optional:: flag_time_exist
15338 character(*), intent(out), optional:: time_name
15339 logical, intent(out), optional:: err
15340 end subroutine lookup_growable_url
15341 end interface
15342 interface
15343 function file_rename_mpi( file ) result(result)
15344 use dc_types, only: string
15345 character(*), intent(in):: file
15346 character(STRING):: result
15347 end function file_rename_mpi
15348 end interface
15349 continue
15350 file_work = file
15351 if ( present_and_true( flag_mpi_split ) ) &
15352 & file_work = file_rename_mpi( file_work )
15353 call lookup_growable_url(file = file_work, varname = varname, &
15354 & url = url, &
15355 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15356 call url_chop_iorange( &
15357 & fullname = url, iorange = iorange, remainder = remainder )
15358 call split( str = iorange, carray = carray, sep = gt_equal )
15359 timevar_name = carray(1)
15360 deallocate( carray )
15361 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15362 call historygetreal4( file = file, &
15363 & varname = varname, array = array, &
15364 & range = time_range, quiet = quiet, &
15365 & flag_mpi_split = flag_mpi_split, &
15366 & returned_time = returned_time, &
15367 & flag_time_exist = flag_time_exist, &
15368 & err = err )
15369end subroutine historygetreal4timei
15371 & file, varname, array, time, &
15372 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15373 use dc_string, only: tochar, split
15374 use dc_types, only: string, dp, sp
15375 use dc_trace, only: dbgmessage
15376 use dc_url, only: url_chop_iorange, gt_equal
15377 use dc_present, only: present_and_true
15378 implicit none
15379 character(*), intent(in):: file, varname
15380 integer, intent(in):: time
15381 logical, intent(in), optional:: quiet
15382 real(SP), intent(out) :: array(:,:,:,:,:)
15383 logical, intent(in), optional:: flag_mpi_split
15384 real(DP), intent(out), optional:: returned_time
15385 logical, intent(out), optional:: flag_time_exist
15386 logical, intent(out), optional:: err
15387 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15388 character(STRING), pointer:: carray (:)
15389 character(STRING):: tname
15390 interface
15391 subroutine historygetreal5(&
15392 & file, varname, array, range, quiet, &
15393 & flag_mpi_split, returned_time, flag_time_exist, err)
15394 use dc_types, only: dp, sp
15395 character(*), intent(in):: file
15396 character(*), intent(in):: varname
15397 character(*), intent(in), optional:: range
15398 logical, intent(in), optional:: quiet
15399 logical, intent(in), optional:: flag_mpi_split
15400 real(DP), intent(out), optional:: returned_time
15401 logical, intent(out), optional:: flag_time_exist
15402 logical, intent(out), optional:: err
15403 real(SP), intent(out) :: array(:,:,:,:,:)
15404 end subroutine historygetreal5
15405 end interface
15406 interface
15407 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15408 character(*), intent(in):: file
15409 character(*), intent(in):: varname
15410 character(*), intent(out):: url
15411 character(*), intent(in), optional:: range
15412 logical, intent(out), optional:: flag_time_exist
15413 character(*), intent(out), optional:: time_name
15414 logical, intent(out), optional:: err
15415 end subroutine lookup_growable_url
15416 end interface
15417 interface
15418 function file_rename_mpi( file ) result(result)
15419 use dc_types, only: string
15420 character(*), intent(in):: file
15421 character(STRING):: result
15422 end function file_rename_mpi
15423 end interface
15424 continue
15425 file_work = file
15426 if ( present_and_true( flag_mpi_split ) ) &
15427 & file_work = file_rename_mpi( file_work )
15428 call lookup_growable_url(file = file_work, varname = varname, &
15429 & url = url, &
15430 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15431 call url_chop_iorange( &
15432 & fullname = url, iorange = iorange, remainder = remainder )
15433 call split( str = iorange, carray = carray, sep = gt_equal )
15434 timevar_name = carray(1)
15435 deallocate( carray )
15436 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15437 call historygetreal5( file = file, &
15438 & varname = varname, array = array, &
15439 & range = time_range, quiet = quiet, &
15440 & flag_mpi_split = flag_mpi_split, &
15441 & returned_time = returned_time, &
15442 & flag_time_exist = flag_time_exist, &
15443 & err = err )
15444end subroutine historygetreal5timei
15446 & file, varname, array, time, &
15447 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15448 use dc_string, only: tochar, split
15449 use dc_types, only: string, dp, sp
15450 use dc_trace, only: dbgmessage
15451 use dc_url, only: url_chop_iorange, gt_equal
15452 use dc_present, only: present_and_true
15453 implicit none
15454 character(*), intent(in):: file, varname
15455 integer, intent(in):: time
15456 logical, intent(in), optional:: quiet
15457 real(SP), intent(out) :: array(:,:,:,:,:,:)
15458 logical, intent(in), optional:: flag_mpi_split
15459 real(DP), intent(out), optional:: returned_time
15460 logical, intent(out), optional:: flag_time_exist
15461 logical, intent(out), optional:: err
15462 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15463 character(STRING), pointer:: carray (:)
15464 character(STRING):: tname
15465 interface
15466 subroutine historygetreal6(&
15467 & file, varname, array, range, quiet, &
15468 & flag_mpi_split, returned_time, flag_time_exist, err)
15469 use dc_types, only: dp, sp
15470 character(*), intent(in):: file
15471 character(*), intent(in):: varname
15472 character(*), intent(in), optional:: range
15473 logical, intent(in), optional:: quiet
15474 logical, intent(in), optional:: flag_mpi_split
15475 real(DP), intent(out), optional:: returned_time
15476 logical, intent(out), optional:: flag_time_exist
15477 logical, intent(out), optional:: err
15478 real(SP), intent(out) :: array(:,:,:,:,:,:)
15479 end subroutine historygetreal6
15480 end interface
15481 interface
15482 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15483 character(*), intent(in):: file
15484 character(*), intent(in):: varname
15485 character(*), intent(out):: url
15486 character(*), intent(in), optional:: range
15487 logical, intent(out), optional:: flag_time_exist
15488 character(*), intent(out), optional:: time_name
15489 logical, intent(out), optional:: err
15490 end subroutine lookup_growable_url
15491 end interface
15492 interface
15493 function file_rename_mpi( file ) result(result)
15494 use dc_types, only: string
15495 character(*), intent(in):: file
15496 character(STRING):: result
15497 end function file_rename_mpi
15498 end interface
15499 continue
15500 file_work = file
15501 if ( present_and_true( flag_mpi_split ) ) &
15502 & file_work = file_rename_mpi( file_work )
15503 call lookup_growable_url(file = file_work, varname = varname, &
15504 & url = url, &
15505 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15506 call url_chop_iorange( &
15507 & fullname = url, iorange = iorange, remainder = remainder )
15508 call split( str = iorange, carray = carray, sep = gt_equal )
15509 timevar_name = carray(1)
15510 deallocate( carray )
15511 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15512 call historygetreal6( file = file, &
15513 & varname = varname, array = array, &
15514 & range = time_range, quiet = quiet, &
15515 & flag_mpi_split = flag_mpi_split, &
15516 & returned_time = returned_time, &
15517 & flag_time_exist = flag_time_exist, &
15518 & err = err )
15519end subroutine historygetreal6timei
15521 & file, varname, array, time, &
15522 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15523 use dc_string, only: tochar, split
15524 use dc_types, only: string, dp, sp
15525 use dc_trace, only: dbgmessage
15526 use dc_url, only: url_chop_iorange, gt_equal
15527 use dc_present, only: present_and_true
15528 implicit none
15529 character(*), intent(in):: file, varname
15530 integer, intent(in):: time
15531 logical, intent(in), optional:: quiet
15532 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
15533 logical, intent(in), optional:: flag_mpi_split
15534 real(DP), intent(out), optional:: returned_time
15535 logical, intent(out), optional:: flag_time_exist
15536 logical, intent(out), optional:: err
15537 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15538 character(STRING), pointer:: carray (:)
15539 character(STRING):: tname
15540 interface
15541 subroutine historygetreal7(&
15542 & file, varname, array, range, quiet, &
15543 & flag_mpi_split, returned_time, flag_time_exist, err)
15544 use dc_types, only: dp, sp
15545 character(*), intent(in):: file
15546 character(*), intent(in):: varname
15547 character(*), intent(in), optional:: range
15548 logical, intent(in), optional:: quiet
15549 logical, intent(in), optional:: flag_mpi_split
15550 real(DP), intent(out), optional:: returned_time
15551 logical, intent(out), optional:: flag_time_exist
15552 logical, intent(out), optional:: err
15553 real(SP), intent(out) :: array(:,:,:,:,:,:,:)
15554 end subroutine historygetreal7
15555 end interface
15556 interface
15557 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15558 character(*), intent(in):: file
15559 character(*), intent(in):: varname
15560 character(*), intent(out):: url
15561 character(*), intent(in), optional:: range
15562 logical, intent(out), optional:: flag_time_exist
15563 character(*), intent(out), optional:: time_name
15564 logical, intent(out), optional:: err
15565 end subroutine lookup_growable_url
15566 end interface
15567 interface
15568 function file_rename_mpi( file ) result(result)
15569 use dc_types, only: string
15570 character(*), intent(in):: file
15571 character(STRING):: result
15572 end function file_rename_mpi
15573 end interface
15574 continue
15575 file_work = file
15576 if ( present_and_true( flag_mpi_split ) ) &
15577 & file_work = file_rename_mpi( file_work )
15578 call lookup_growable_url(file = file_work, varname = varname, &
15579 & url = url, &
15580 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15581 call url_chop_iorange( &
15582 & fullname = url, iorange = iorange, remainder = remainder )
15583 call split( str = iorange, carray = carray, sep = gt_equal )
15584 timevar_name = carray(1)
15585 deallocate( carray )
15586 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15587 call historygetreal7( file = file, &
15588 & varname = varname, array = array, &
15589 & range = time_range, quiet = quiet, &
15590 & flag_mpi_split = flag_mpi_split, &
15591 & returned_time = returned_time, &
15592 & flag_time_exist = flag_time_exist, &
15593 & err = err )
15594end subroutine historygetreal7timei
15596 & file, varname, array, time, &
15597 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15598 use dc_string, only: tochar, split
15599 use dc_types, only: string, dp, sp
15600 use dc_trace, only: dbgmessage
15601 use dc_url, only: url_chop_iorange, gt_equal
15602 use dc_present, only: present_and_true
15603 implicit none
15604 character(*), intent(in):: file, varname
15605 integer, intent(in):: time
15606 logical, intent(in), optional:: quiet
15607 real(SP), pointer :: array
15608 logical, intent(in), optional:: flag_mpi_split
15609 real(DP), intent(out), optional:: returned_time
15610 logical, intent(out), optional:: flag_time_exist
15611 logical, intent(out), optional:: err
15612 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15613 character(STRING), pointer:: carray (:)
15614 character(STRING):: tname
15615 interface
15616 subroutine historygetreal0pointer(&
15617 & file, varname, array, range, quiet, &
15618 & flag_mpi_split, returned_time, flag_time_exist, err)
15619 use dc_types, only: dp, sp
15620 character(*), intent(in):: file
15621 character(*), intent(in):: varname
15622 character(*), intent(in), optional:: range
15623 logical, intent(in), optional:: quiet
15624 logical, intent(in), optional:: flag_mpi_split
15625 real(DP), intent(out), optional:: returned_time
15626 logical, intent(out), optional:: flag_time_exist
15627 logical, intent(out), optional:: err
15628 real(SP), pointer :: array
15629 end subroutine historygetreal0pointer
15630 end interface
15631 interface
15632 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15633 character(*), intent(in):: file
15634 character(*), intent(in):: varname
15635 character(*), intent(out):: url
15636 character(*), intent(in), optional:: range
15637 logical, intent(out), optional:: flag_time_exist
15638 character(*), intent(out), optional:: time_name
15639 logical, intent(out), optional:: err
15640 end subroutine lookup_growable_url
15641 end interface
15642 interface
15643 function file_rename_mpi( file ) result(result)
15644 use dc_types, only: string
15645 character(*), intent(in):: file
15646 character(STRING):: result
15647 end function file_rename_mpi
15648 end interface
15649 continue
15650 file_work = file
15651 if ( present_and_true( flag_mpi_split ) ) &
15652 & file_work = file_rename_mpi( file_work )
15653 call lookup_growable_url(file = file_work, varname = varname, &
15654 & url = url, &
15655 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15656 call url_chop_iorange( &
15657 & fullname = url, iorange = iorange, remainder = remainder )
15658 call split( str = iorange, carray = carray, sep = gt_equal )
15659 timevar_name = carray(1)
15660 deallocate( carray )
15661 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15662 call historygetreal0pointer( file = file, &
15663 & varname = varname, array = array, &
15664 & range = time_range, quiet = quiet, &
15665 & flag_mpi_split = flag_mpi_split, &
15666 & returned_time = returned_time, &
15667 & flag_time_exist = flag_time_exist, &
15668 & err = err )
15669end subroutine historygetreal0pointertimei
15671 & file, varname, array, time, &
15672 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15673 use dc_string, only: tochar, split
15674 use dc_types, only: string, dp, sp
15675 use dc_trace, only: dbgmessage
15676 use dc_url, only: url_chop_iorange, gt_equal
15677 use dc_present, only: present_and_true
15678 implicit none
15679 character(*), intent(in):: file, varname
15680 integer, intent(in):: time
15681 logical, intent(in), optional:: quiet
15682 real(SP), pointer :: array(:)
15683 logical, intent(in), optional:: flag_mpi_split
15684 real(DP), intent(out), optional:: returned_time
15685 logical, intent(out), optional:: flag_time_exist
15686 logical, intent(out), optional:: err
15687 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15688 character(STRING), pointer:: carray (:)
15689 character(STRING):: tname
15690 interface
15691 subroutine historygetreal1pointer(&
15692 & file, varname, array, range, quiet, &
15693 & flag_mpi_split, returned_time, flag_time_exist, err)
15694 use dc_types, only: dp, sp
15695 character(*), intent(in):: file
15696 character(*), intent(in):: varname
15697 character(*), intent(in), optional:: range
15698 logical, intent(in), optional:: quiet
15699 logical, intent(in), optional:: flag_mpi_split
15700 real(DP), intent(out), optional:: returned_time
15701 logical, intent(out), optional:: flag_time_exist
15702 logical, intent(out), optional:: err
15703 real(SP), pointer :: array(:)
15704 end subroutine historygetreal1pointer
15705 end interface
15706 interface
15707 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15708 character(*), intent(in):: file
15709 character(*), intent(in):: varname
15710 character(*), intent(out):: url
15711 character(*), intent(in), optional:: range
15712 logical, intent(out), optional:: flag_time_exist
15713 character(*), intent(out), optional:: time_name
15714 logical, intent(out), optional:: err
15715 end subroutine lookup_growable_url
15716 end interface
15717 interface
15718 function file_rename_mpi( file ) result(result)
15719 use dc_types, only: string
15720 character(*), intent(in):: file
15721 character(STRING):: result
15722 end function file_rename_mpi
15723 end interface
15724 continue
15725 file_work = file
15726 if ( present_and_true( flag_mpi_split ) ) &
15727 & file_work = file_rename_mpi( file_work )
15728 call lookup_growable_url(file = file_work, varname = varname, &
15729 & url = url, &
15730 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15731 call url_chop_iorange( &
15732 & fullname = url, iorange = iorange, remainder = remainder )
15733 call split( str = iorange, carray = carray, sep = gt_equal )
15734 timevar_name = carray(1)
15735 deallocate( carray )
15736 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15737 call historygetreal1pointer( file = file, &
15738 & varname = varname, array = array, &
15739 & range = time_range, quiet = quiet, &
15740 & flag_mpi_split = flag_mpi_split, &
15741 & returned_time = returned_time, &
15742 & flag_time_exist = flag_time_exist, &
15743 & err = err )
15744end subroutine historygetreal1pointertimei
15746 & file, varname, array, time, &
15747 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15748 use dc_string, only: tochar, split
15749 use dc_types, only: string, dp, sp
15750 use dc_trace, only: dbgmessage
15751 use dc_url, only: url_chop_iorange, gt_equal
15752 use dc_present, only: present_and_true
15753 implicit none
15754 character(*), intent(in):: file, varname
15755 integer, intent(in):: time
15756 logical, intent(in), optional:: quiet
15757 real(SP), pointer :: array(:,:)
15758 logical, intent(in), optional:: flag_mpi_split
15759 real(DP), intent(out), optional:: returned_time
15760 logical, intent(out), optional:: flag_time_exist
15761 logical, intent(out), optional:: err
15762 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15763 character(STRING), pointer:: carray (:)
15764 character(STRING):: tname
15765 interface
15766 subroutine historygetreal2pointer(&
15767 & file, varname, array, range, quiet, &
15768 & flag_mpi_split, returned_time, flag_time_exist, err)
15769 use dc_types, only: dp, sp
15770 character(*), intent(in):: file
15771 character(*), intent(in):: varname
15772 character(*), intent(in), optional:: range
15773 logical, intent(in), optional:: quiet
15774 logical, intent(in), optional:: flag_mpi_split
15775 real(DP), intent(out), optional:: returned_time
15776 logical, intent(out), optional:: flag_time_exist
15777 logical, intent(out), optional:: err
15778 real(SP), pointer :: array(:,:)
15779 end subroutine historygetreal2pointer
15780 end interface
15781 interface
15782 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15783 character(*), intent(in):: file
15784 character(*), intent(in):: varname
15785 character(*), intent(out):: url
15786 character(*), intent(in), optional:: range
15787 logical, intent(out), optional:: flag_time_exist
15788 character(*), intent(out), optional:: time_name
15789 logical, intent(out), optional:: err
15790 end subroutine lookup_growable_url
15791 end interface
15792 interface
15793 function file_rename_mpi( file ) result(result)
15794 use dc_types, only: string
15795 character(*), intent(in):: file
15796 character(STRING):: result
15797 end function file_rename_mpi
15798 end interface
15799 continue
15800 file_work = file
15801 if ( present_and_true( flag_mpi_split ) ) &
15802 & file_work = file_rename_mpi( file_work )
15803 call lookup_growable_url(file = file_work, varname = varname, &
15804 & url = url, &
15805 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15806 call url_chop_iorange( &
15807 & fullname = url, iorange = iorange, remainder = remainder )
15808 call split( str = iorange, carray = carray, sep = gt_equal )
15809 timevar_name = carray(1)
15810 deallocate( carray )
15811 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15812 call historygetreal2pointer( file = file, &
15813 & varname = varname, array = array, &
15814 & range = time_range, quiet = quiet, &
15815 & flag_mpi_split = flag_mpi_split, &
15816 & returned_time = returned_time, &
15817 & flag_time_exist = flag_time_exist, &
15818 & err = err )
15819end subroutine historygetreal2pointertimei
15821 & file, varname, array, time, &
15822 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15823 use dc_string, only: tochar, split
15824 use dc_types, only: string, dp, sp
15825 use dc_trace, only: dbgmessage
15826 use dc_url, only: url_chop_iorange, gt_equal
15827 use dc_present, only: present_and_true
15828 implicit none
15829 character(*), intent(in):: file, varname
15830 integer, intent(in):: time
15831 logical, intent(in), optional:: quiet
15832 real(SP), pointer :: array(:,:,:)
15833 logical, intent(in), optional:: flag_mpi_split
15834 real(DP), intent(out), optional:: returned_time
15835 logical, intent(out), optional:: flag_time_exist
15836 logical, intent(out), optional:: err
15837 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15838 character(STRING), pointer:: carray (:)
15839 character(STRING):: tname
15840 interface
15841 subroutine historygetreal3pointer(&
15842 & file, varname, array, range, quiet, &
15843 & flag_mpi_split, returned_time, flag_time_exist, err)
15844 use dc_types, only: dp, sp
15845 character(*), intent(in):: file
15846 character(*), intent(in):: varname
15847 character(*), intent(in), optional:: range
15848 logical, intent(in), optional:: quiet
15849 logical, intent(in), optional:: flag_mpi_split
15850 real(DP), intent(out), optional:: returned_time
15851 logical, intent(out), optional:: flag_time_exist
15852 logical, intent(out), optional:: err
15853 real(SP), pointer :: array(:,:,:)
15854 end subroutine historygetreal3pointer
15855 end interface
15856 interface
15857 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15858 character(*), intent(in):: file
15859 character(*), intent(in):: varname
15860 character(*), intent(out):: url
15861 character(*), intent(in), optional:: range
15862 logical, intent(out), optional:: flag_time_exist
15863 character(*), intent(out), optional:: time_name
15864 logical, intent(out), optional:: err
15865 end subroutine lookup_growable_url
15866 end interface
15867 interface
15868 function file_rename_mpi( file ) result(result)
15869 use dc_types, only: string
15870 character(*), intent(in):: file
15871 character(STRING):: result
15872 end function file_rename_mpi
15873 end interface
15874 continue
15875 file_work = file
15876 if ( present_and_true( flag_mpi_split ) ) &
15877 & file_work = file_rename_mpi( file_work )
15878 call lookup_growable_url(file = file_work, varname = varname, &
15879 & url = url, &
15880 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15881 call url_chop_iorange( &
15882 & fullname = url, iorange = iorange, remainder = remainder )
15883 call split( str = iorange, carray = carray, sep = gt_equal )
15884 timevar_name = carray(1)
15885 deallocate( carray )
15886 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15887 call historygetreal3pointer( file = file, &
15888 & varname = varname, array = array, &
15889 & range = time_range, quiet = quiet, &
15890 & flag_mpi_split = flag_mpi_split, &
15891 & returned_time = returned_time, &
15892 & flag_time_exist = flag_time_exist, &
15893 & err = err )
15894end subroutine historygetreal3pointertimei
15896 & file, varname, array, time, &
15897 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15898 use dc_string, only: tochar, split
15899 use dc_types, only: string, dp, sp
15900 use dc_trace, only: dbgmessage
15901 use dc_url, only: url_chop_iorange, gt_equal
15902 use dc_present, only: present_and_true
15903 implicit none
15904 character(*), intent(in):: file, varname
15905 integer, intent(in):: time
15906 logical, intent(in), optional:: quiet
15907 real(SP), pointer :: array(:,:,:,:)
15908 logical, intent(in), optional:: flag_mpi_split
15909 real(DP), intent(out), optional:: returned_time
15910 logical, intent(out), optional:: flag_time_exist
15911 logical, intent(out), optional:: err
15912 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15913 character(STRING), pointer:: carray (:)
15914 character(STRING):: tname
15915 interface
15916 subroutine historygetreal4pointer(&
15917 & file, varname, array, range, quiet, &
15918 & flag_mpi_split, returned_time, flag_time_exist, err)
15919 use dc_types, only: dp, sp
15920 character(*), intent(in):: file
15921 character(*), intent(in):: varname
15922 character(*), intent(in), optional:: range
15923 logical, intent(in), optional:: quiet
15924 logical, intent(in), optional:: flag_mpi_split
15925 real(DP), intent(out), optional:: returned_time
15926 logical, intent(out), optional:: flag_time_exist
15927 logical, intent(out), optional:: err
15928 real(SP), pointer :: array(:,:,:,:)
15929 end subroutine historygetreal4pointer
15930 end interface
15931 interface
15932 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
15933 character(*), intent(in):: file
15934 character(*), intent(in):: varname
15935 character(*), intent(out):: url
15936 character(*), intent(in), optional:: range
15937 logical, intent(out), optional:: flag_time_exist
15938 character(*), intent(out), optional:: time_name
15939 logical, intent(out), optional:: err
15940 end subroutine lookup_growable_url
15941 end interface
15942 interface
15943 function file_rename_mpi( file ) result(result)
15944 use dc_types, only: string
15945 character(*), intent(in):: file
15946 character(STRING):: result
15947 end function file_rename_mpi
15948 end interface
15949 continue
15950 file_work = file
15951 if ( present_and_true( flag_mpi_split ) ) &
15952 & file_work = file_rename_mpi( file_work )
15953 call lookup_growable_url(file = file_work, varname = varname, &
15954 & url = url, &
15955 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
15956 call url_chop_iorange( &
15957 & fullname = url, iorange = iorange, remainder = remainder )
15958 call split( str = iorange, carray = carray, sep = gt_equal )
15959 timevar_name = carray(1)
15960 deallocate( carray )
15961 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
15962 call historygetreal4pointer( file = file, &
15963 & varname = varname, array = array, &
15964 & range = time_range, quiet = quiet, &
15965 & flag_mpi_split = flag_mpi_split, &
15966 & returned_time = returned_time, &
15967 & flag_time_exist = flag_time_exist, &
15968 & err = err )
15969end subroutine historygetreal4pointertimei
15971 & file, varname, array, time, &
15972 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
15973 use dc_string, only: tochar, split
15974 use dc_types, only: string, dp, sp
15975 use dc_trace, only: dbgmessage
15976 use dc_url, only: url_chop_iorange, gt_equal
15977 use dc_present, only: present_and_true
15978 implicit none
15979 character(*), intent(in):: file, varname
15980 integer, intent(in):: time
15981 logical, intent(in), optional:: quiet
15982 real(SP), pointer :: array(:,:,:,:,:)
15983 logical, intent(in), optional:: flag_mpi_split
15984 real(DP), intent(out), optional:: returned_time
15985 logical, intent(out), optional:: flag_time_exist
15986 logical, intent(out), optional:: err
15987 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
15988 character(STRING), pointer:: carray (:)
15989 character(STRING):: tname
15990 interface
15991 subroutine historygetreal5pointer(&
15992 & file, varname, array, range, quiet, &
15993 & flag_mpi_split, returned_time, flag_time_exist, err)
15994 use dc_types, only: dp, sp
15995 character(*), intent(in):: file
15996 character(*), intent(in):: varname
15997 character(*), intent(in), optional:: range
15998 logical, intent(in), optional:: quiet
15999 logical, intent(in), optional:: flag_mpi_split
16000 real(DP), intent(out), optional:: returned_time
16001 logical, intent(out), optional:: flag_time_exist
16002 logical, intent(out), optional:: err
16003 real(SP), pointer :: array(:,:,:,:,:)
16004 end subroutine historygetreal5pointer
16005 end interface
16006 interface
16007 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16008 character(*), intent(in):: file
16009 character(*), intent(in):: varname
16010 character(*), intent(out):: url
16011 character(*), intent(in), optional:: range
16012 logical, intent(out), optional:: flag_time_exist
16013 character(*), intent(out), optional:: time_name
16014 logical, intent(out), optional:: err
16015 end subroutine lookup_growable_url
16016 end interface
16017 interface
16018 function file_rename_mpi( file ) result(result)
16019 use dc_types, only: string
16020 character(*), intent(in):: file
16021 character(STRING):: result
16022 end function file_rename_mpi
16023 end interface
16024 continue
16025 file_work = file
16026 if ( present_and_true( flag_mpi_split ) ) &
16027 & file_work = file_rename_mpi( file_work )
16028 call lookup_growable_url(file = file_work, varname = varname, &
16029 & url = url, &
16030 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16031 call url_chop_iorange( &
16032 & fullname = url, iorange = iorange, remainder = remainder )
16033 call split( str = iorange, carray = carray, sep = gt_equal )
16034 timevar_name = carray(1)
16035 deallocate( carray )
16036 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16037 call historygetreal5pointer( file = file, &
16038 & varname = varname, array = array, &
16039 & range = time_range, quiet = quiet, &
16040 & flag_mpi_split = flag_mpi_split, &
16041 & returned_time = returned_time, &
16042 & flag_time_exist = flag_time_exist, &
16043 & err = err )
16044end subroutine historygetreal5pointertimei
16046 & file, varname, array, time, &
16047 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16048 use dc_string, only: tochar, split
16049 use dc_types, only: string, dp, sp
16050 use dc_trace, only: dbgmessage
16051 use dc_url, only: url_chop_iorange, gt_equal
16052 use dc_present, only: present_and_true
16053 implicit none
16054 character(*), intent(in):: file, varname
16055 integer, intent(in):: time
16056 logical, intent(in), optional:: quiet
16057 real(SP), pointer :: array(:,:,:,:,:,:)
16058 logical, intent(in), optional:: flag_mpi_split
16059 real(DP), intent(out), optional:: returned_time
16060 logical, intent(out), optional:: flag_time_exist
16061 logical, intent(out), optional:: err
16062 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16063 character(STRING), pointer:: carray (:)
16064 character(STRING):: tname
16065 interface
16066 subroutine historygetreal6pointer(&
16067 & file, varname, array, range, quiet, &
16068 & flag_mpi_split, returned_time, flag_time_exist, err)
16069 use dc_types, only: dp, sp
16070 character(*), intent(in):: file
16071 character(*), intent(in):: varname
16072 character(*), intent(in), optional:: range
16073 logical, intent(in), optional:: quiet
16074 logical, intent(in), optional:: flag_mpi_split
16075 real(DP), intent(out), optional:: returned_time
16076 logical, intent(out), optional:: flag_time_exist
16077 logical, intent(out), optional:: err
16078 real(SP), pointer :: array(:,:,:,:,:,:)
16079 end subroutine historygetreal6pointer
16080 end interface
16081 interface
16082 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16083 character(*), intent(in):: file
16084 character(*), intent(in):: varname
16085 character(*), intent(out):: url
16086 character(*), intent(in), optional:: range
16087 logical, intent(out), optional:: flag_time_exist
16088 character(*), intent(out), optional:: time_name
16089 logical, intent(out), optional:: err
16090 end subroutine lookup_growable_url
16091 end interface
16092 interface
16093 function file_rename_mpi( file ) result(result)
16094 use dc_types, only: string
16095 character(*), intent(in):: file
16096 character(STRING):: result
16097 end function file_rename_mpi
16098 end interface
16099 continue
16100 file_work = file
16101 if ( present_and_true( flag_mpi_split ) ) &
16102 & file_work = file_rename_mpi( file_work )
16103 call lookup_growable_url(file = file_work, varname = varname, &
16104 & url = url, &
16105 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16106 call url_chop_iorange( &
16107 & fullname = url, iorange = iorange, remainder = remainder )
16108 call split( str = iorange, carray = carray, sep = gt_equal )
16109 timevar_name = carray(1)
16110 deallocate( carray )
16111 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16112 call historygetreal6pointer( file = file, &
16113 & varname = varname, array = array, &
16114 & range = time_range, quiet = quiet, &
16115 & flag_mpi_split = flag_mpi_split, &
16116 & returned_time = returned_time, &
16117 & flag_time_exist = flag_time_exist, &
16118 & err = err )
16119end subroutine historygetreal6pointertimei
16121 & file, varname, array, time, &
16122 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16123 use dc_string, only: tochar, split
16124 use dc_types, only: string, dp, sp
16125 use dc_trace, only: dbgmessage
16126 use dc_url, only: url_chop_iorange, gt_equal
16127 use dc_present, only: present_and_true
16128 implicit none
16129 character(*), intent(in):: file, varname
16130 integer, intent(in):: time
16131 logical, intent(in), optional:: quiet
16132 real(SP), pointer :: array(:,:,:,:,:,:,:)
16133 logical, intent(in), optional:: flag_mpi_split
16134 real(DP), intent(out), optional:: returned_time
16135 logical, intent(out), optional:: flag_time_exist
16136 logical, intent(out), optional:: err
16137 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16138 character(STRING), pointer:: carray (:)
16139 character(STRING):: tname
16140 interface
16141 subroutine historygetreal7pointer(&
16142 & file, varname, array, range, quiet, &
16143 & flag_mpi_split, returned_time, flag_time_exist, err)
16144 use dc_types, only: dp, sp
16145 character(*), intent(in):: file
16146 character(*), intent(in):: varname
16147 character(*), intent(in), optional:: range
16148 logical, intent(in), optional:: quiet
16149 logical, intent(in), optional:: flag_mpi_split
16150 real(DP), intent(out), optional:: returned_time
16151 logical, intent(out), optional:: flag_time_exist
16152 logical, intent(out), optional:: err
16153 real(SP), pointer :: array(:,:,:,:,:,:,:)
16154 end subroutine historygetreal7pointer
16155 end interface
16156 interface
16157 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16158 character(*), intent(in):: file
16159 character(*), intent(in):: varname
16160 character(*), intent(out):: url
16161 character(*), intent(in), optional:: range
16162 logical, intent(out), optional:: flag_time_exist
16163 character(*), intent(out), optional:: time_name
16164 logical, intent(out), optional:: err
16165 end subroutine lookup_growable_url
16166 end interface
16167 interface
16168 function file_rename_mpi( file ) result(result)
16169 use dc_types, only: string
16170 character(*), intent(in):: file
16171 character(STRING):: result
16172 end function file_rename_mpi
16173 end interface
16174 continue
16175 file_work = file
16176 if ( present_and_true( flag_mpi_split ) ) &
16177 & file_work = file_rename_mpi( file_work )
16178 call lookup_growable_url(file = file_work, varname = varname, &
16179 & url = url, &
16180 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16181 call url_chop_iorange( &
16182 & fullname = url, iorange = iorange, remainder = remainder )
16183 call split( str = iorange, carray = carray, sep = gt_equal )
16184 timevar_name = carray(1)
16185 deallocate( carray )
16186 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16187 call historygetreal7pointer( file = file, &
16188 & varname = varname, array = array, &
16189 & range = time_range, quiet = quiet, &
16190 & flag_mpi_split = flag_mpi_split, &
16191 & returned_time = returned_time, &
16192 & flag_time_exist = flag_time_exist, &
16193 & err = err )
16194end subroutine historygetreal7pointertimei
16196 & file, varname, array, time, &
16197 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16198 use dc_string, only: tochar, split
16199 use dc_types, only: string, dp
16200 use dc_trace, only: dbgmessage
16201 use dc_url, only: url_chop_iorange, gt_equal
16202 use dc_present, only: present_and_true
16203 implicit none
16204 character(*), intent(in):: file, varname
16205 integer, intent(in):: time
16206 logical, intent(in), optional:: quiet
16207 integer, intent(out) :: array
16208 logical, intent(in), optional:: flag_mpi_split
16209 real(DP), intent(out), optional:: returned_time
16210 logical, intent(out), optional:: flag_time_exist
16211 logical, intent(out), optional:: err
16212 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16213 character(STRING), pointer:: carray (:)
16214 character(STRING):: tname
16215 interface
16216 subroutine historygetint0(&
16217 & file, varname, array, range, quiet, &
16218 & flag_mpi_split, returned_time, flag_time_exist, err)
16219 use dc_types, only: dp
16220 character(*), intent(in):: file
16221 character(*), intent(in):: varname
16222 character(*), intent(in), optional:: range
16223 logical, intent(in), optional:: quiet
16224 logical, intent(in), optional:: flag_mpi_split
16225 real(DP), intent(out), optional:: returned_time
16226 logical, intent(out), optional:: flag_time_exist
16227 logical, intent(out), optional:: err
16228 integer, intent(out) :: array
16229 end subroutine historygetint0
16230 end interface
16231 interface
16232 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16233 character(*), intent(in):: file
16234 character(*), intent(in):: varname
16235 character(*), intent(out):: url
16236 character(*), intent(in), optional:: range
16237 logical, intent(out), optional:: flag_time_exist
16238 character(*), intent(out), optional:: time_name
16239 logical, intent(out), optional:: err
16240 end subroutine lookup_growable_url
16241 end interface
16242 interface
16243 function file_rename_mpi( file ) result(result)
16244 use dc_types, only: string
16245 character(*), intent(in):: file
16246 character(STRING):: result
16247 end function file_rename_mpi
16248 end interface
16249 continue
16250 file_work = file
16251 if ( present_and_true( flag_mpi_split ) ) &
16252 & file_work = file_rename_mpi( file_work )
16253 call lookup_growable_url(file = file_work, varname = varname, &
16254 & url = url, &
16255 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16256 call url_chop_iorange( &
16257 & fullname = url, iorange = iorange, remainder = remainder )
16258 call split( str = iorange, carray = carray, sep = gt_equal )
16259 timevar_name = carray(1)
16260 deallocate( carray )
16261 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16262 call historygetint0( file = file, &
16263 & varname = varname, array = array, &
16264 & range = time_range, quiet = quiet, &
16265 & flag_mpi_split = flag_mpi_split, &
16266 & returned_time = returned_time, &
16267 & flag_time_exist = flag_time_exist, &
16268 & err = err )
16269end subroutine historygetint0timei
16271 & file, varname, array, time, &
16272 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16273 use dc_string, only: tochar, split
16274 use dc_types, only: string, dp
16275 use dc_trace, only: dbgmessage
16276 use dc_url, only: url_chop_iorange, gt_equal
16277 use dc_present, only: present_and_true
16278 implicit none
16279 character(*), intent(in):: file, varname
16280 integer, intent(in):: time
16281 logical, intent(in), optional:: quiet
16282 integer, intent(out) :: array(:)
16283 logical, intent(in), optional:: flag_mpi_split
16284 real(DP), intent(out), optional:: returned_time
16285 logical, intent(out), optional:: flag_time_exist
16286 logical, intent(out), optional:: err
16287 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16288 character(STRING), pointer:: carray (:)
16289 character(STRING):: tname
16290 interface
16291 subroutine historygetint1(&
16292 & file, varname, array, range, quiet, &
16293 & flag_mpi_split, returned_time, flag_time_exist, err)
16294 use dc_types, only: dp
16295 character(*), intent(in):: file
16296 character(*), intent(in):: varname
16297 character(*), intent(in), optional:: range
16298 logical, intent(in), optional:: quiet
16299 logical, intent(in), optional:: flag_mpi_split
16300 real(DP), intent(out), optional:: returned_time
16301 logical, intent(out), optional:: flag_time_exist
16302 logical, intent(out), optional:: err
16303 integer, intent(out) :: array(:)
16304 end subroutine historygetint1
16305 end interface
16306 interface
16307 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16308 character(*), intent(in):: file
16309 character(*), intent(in):: varname
16310 character(*), intent(out):: url
16311 character(*), intent(in), optional:: range
16312 logical, intent(out), optional:: flag_time_exist
16313 character(*), intent(out), optional:: time_name
16314 logical, intent(out), optional:: err
16315 end subroutine lookup_growable_url
16316 end interface
16317 interface
16318 function file_rename_mpi( file ) result(result)
16319 use dc_types, only: string
16320 character(*), intent(in):: file
16321 character(STRING):: result
16322 end function file_rename_mpi
16323 end interface
16324 continue
16325 file_work = file
16326 if ( present_and_true( flag_mpi_split ) ) &
16327 & file_work = file_rename_mpi( file_work )
16328 call lookup_growable_url(file = file_work, varname = varname, &
16329 & url = url, &
16330 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16331 call url_chop_iorange( &
16332 & fullname = url, iorange = iorange, remainder = remainder )
16333 call split( str = iorange, carray = carray, sep = gt_equal )
16334 timevar_name = carray(1)
16335 deallocate( carray )
16336 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16337 call historygetint1( file = file, &
16338 & varname = varname, array = array, &
16339 & range = time_range, quiet = quiet, &
16340 & flag_mpi_split = flag_mpi_split, &
16341 & returned_time = returned_time, &
16342 & flag_time_exist = flag_time_exist, &
16343 & err = err )
16344end subroutine historygetint1timei
16346 & file, varname, array, time, &
16347 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16348 use dc_string, only: tochar, split
16349 use dc_types, only: string, dp
16350 use dc_trace, only: dbgmessage
16351 use dc_url, only: url_chop_iorange, gt_equal
16352 use dc_present, only: present_and_true
16353 implicit none
16354 character(*), intent(in):: file, varname
16355 integer, intent(in):: time
16356 logical, intent(in), optional:: quiet
16357 integer, intent(out) :: array(:,:)
16358 logical, intent(in), optional:: flag_mpi_split
16359 real(DP), intent(out), optional:: returned_time
16360 logical, intent(out), optional:: flag_time_exist
16361 logical, intent(out), optional:: err
16362 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16363 character(STRING), pointer:: carray (:)
16364 character(STRING):: tname
16365 interface
16366 subroutine historygetint2(&
16367 & file, varname, array, range, quiet, &
16368 & flag_mpi_split, returned_time, flag_time_exist, err)
16369 use dc_types, only: dp
16370 character(*), intent(in):: file
16371 character(*), intent(in):: varname
16372 character(*), intent(in), optional:: range
16373 logical, intent(in), optional:: quiet
16374 logical, intent(in), optional:: flag_mpi_split
16375 real(DP), intent(out), optional:: returned_time
16376 logical, intent(out), optional:: flag_time_exist
16377 logical, intent(out), optional:: err
16378 integer, intent(out) :: array(:,:)
16379 end subroutine historygetint2
16380 end interface
16381 interface
16382 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16383 character(*), intent(in):: file
16384 character(*), intent(in):: varname
16385 character(*), intent(out):: url
16386 character(*), intent(in), optional:: range
16387 logical, intent(out), optional:: flag_time_exist
16388 character(*), intent(out), optional:: time_name
16389 logical, intent(out), optional:: err
16390 end subroutine lookup_growable_url
16391 end interface
16392 interface
16393 function file_rename_mpi( file ) result(result)
16394 use dc_types, only: string
16395 character(*), intent(in):: file
16396 character(STRING):: result
16397 end function file_rename_mpi
16398 end interface
16399 continue
16400 file_work = file
16401 if ( present_and_true( flag_mpi_split ) ) &
16402 & file_work = file_rename_mpi( file_work )
16403 call lookup_growable_url(file = file_work, varname = varname, &
16404 & url = url, &
16405 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16406 call url_chop_iorange( &
16407 & fullname = url, iorange = iorange, remainder = remainder )
16408 call split( str = iorange, carray = carray, sep = gt_equal )
16409 timevar_name = carray(1)
16410 deallocate( carray )
16411 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16412 call historygetint2( file = file, &
16413 & varname = varname, array = array, &
16414 & range = time_range, quiet = quiet, &
16415 & flag_mpi_split = flag_mpi_split, &
16416 & returned_time = returned_time, &
16417 & flag_time_exist = flag_time_exist, &
16418 & err = err )
16419end subroutine historygetint2timei
16421 & file, varname, array, time, &
16422 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16423 use dc_string, only: tochar, split
16424 use dc_types, only: string, dp
16425 use dc_trace, only: dbgmessage
16426 use dc_url, only: url_chop_iorange, gt_equal
16427 use dc_present, only: present_and_true
16428 implicit none
16429 character(*), intent(in):: file, varname
16430 integer, intent(in):: time
16431 logical, intent(in), optional:: quiet
16432 integer, intent(out) :: array(:,:,:)
16433 logical, intent(in), optional:: flag_mpi_split
16434 real(DP), intent(out), optional:: returned_time
16435 logical, intent(out), optional:: flag_time_exist
16436 logical, intent(out), optional:: err
16437 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16438 character(STRING), pointer:: carray (:)
16439 character(STRING):: tname
16440 interface
16441 subroutine historygetint3(&
16442 & file, varname, array, range, quiet, &
16443 & flag_mpi_split, returned_time, flag_time_exist, err)
16444 use dc_types, only: dp
16445 character(*), intent(in):: file
16446 character(*), intent(in):: varname
16447 character(*), intent(in), optional:: range
16448 logical, intent(in), optional:: quiet
16449 logical, intent(in), optional:: flag_mpi_split
16450 real(DP), intent(out), optional:: returned_time
16451 logical, intent(out), optional:: flag_time_exist
16452 logical, intent(out), optional:: err
16453 integer, intent(out) :: array(:,:,:)
16454 end subroutine historygetint3
16455 end interface
16456 interface
16457 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16458 character(*), intent(in):: file
16459 character(*), intent(in):: varname
16460 character(*), intent(out):: url
16461 character(*), intent(in), optional:: range
16462 logical, intent(out), optional:: flag_time_exist
16463 character(*), intent(out), optional:: time_name
16464 logical, intent(out), optional:: err
16465 end subroutine lookup_growable_url
16466 end interface
16467 interface
16468 function file_rename_mpi( file ) result(result)
16469 use dc_types, only: string
16470 character(*), intent(in):: file
16471 character(STRING):: result
16472 end function file_rename_mpi
16473 end interface
16474 continue
16475 file_work = file
16476 if ( present_and_true( flag_mpi_split ) ) &
16477 & file_work = file_rename_mpi( file_work )
16478 call lookup_growable_url(file = file_work, varname = varname, &
16479 & url = url, &
16480 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16481 call url_chop_iorange( &
16482 & fullname = url, iorange = iorange, remainder = remainder )
16483 call split( str = iorange, carray = carray, sep = gt_equal )
16484 timevar_name = carray(1)
16485 deallocate( carray )
16486 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16487 call historygetint3( file = file, &
16488 & varname = varname, array = array, &
16489 & range = time_range, quiet = quiet, &
16490 & flag_mpi_split = flag_mpi_split, &
16491 & returned_time = returned_time, &
16492 & flag_time_exist = flag_time_exist, &
16493 & err = err )
16494end subroutine historygetint3timei
16496 & file, varname, array, time, &
16497 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16498 use dc_string, only: tochar, split
16499 use dc_types, only: string, dp
16500 use dc_trace, only: dbgmessage
16501 use dc_url, only: url_chop_iorange, gt_equal
16502 use dc_present, only: present_and_true
16503 implicit none
16504 character(*), intent(in):: file, varname
16505 integer, intent(in):: time
16506 logical, intent(in), optional:: quiet
16507 integer, intent(out) :: array(:,:,:,:)
16508 logical, intent(in), optional:: flag_mpi_split
16509 real(DP), intent(out), optional:: returned_time
16510 logical, intent(out), optional:: flag_time_exist
16511 logical, intent(out), optional:: err
16512 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16513 character(STRING), pointer:: carray (:)
16514 character(STRING):: tname
16515 interface
16516 subroutine historygetint4(&
16517 & file, varname, array, range, quiet, &
16518 & flag_mpi_split, returned_time, flag_time_exist, err)
16519 use dc_types, only: dp
16520 character(*), intent(in):: file
16521 character(*), intent(in):: varname
16522 character(*), intent(in), optional:: range
16523 logical, intent(in), optional:: quiet
16524 logical, intent(in), optional:: flag_mpi_split
16525 real(DP), intent(out), optional:: returned_time
16526 logical, intent(out), optional:: flag_time_exist
16527 logical, intent(out), optional:: err
16528 integer, intent(out) :: array(:,:,:,:)
16529 end subroutine historygetint4
16530 end interface
16531 interface
16532 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16533 character(*), intent(in):: file
16534 character(*), intent(in):: varname
16535 character(*), intent(out):: url
16536 character(*), intent(in), optional:: range
16537 logical, intent(out), optional:: flag_time_exist
16538 character(*), intent(out), optional:: time_name
16539 logical, intent(out), optional:: err
16540 end subroutine lookup_growable_url
16541 end interface
16542 interface
16543 function file_rename_mpi( file ) result(result)
16544 use dc_types, only: string
16545 character(*), intent(in):: file
16546 character(STRING):: result
16547 end function file_rename_mpi
16548 end interface
16549 continue
16550 file_work = file
16551 if ( present_and_true( flag_mpi_split ) ) &
16552 & file_work = file_rename_mpi( file_work )
16553 call lookup_growable_url(file = file_work, varname = varname, &
16554 & url = url, &
16555 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16556 call url_chop_iorange( &
16557 & fullname = url, iorange = iorange, remainder = remainder )
16558 call split( str = iorange, carray = carray, sep = gt_equal )
16559 timevar_name = carray(1)
16560 deallocate( carray )
16561 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16562 call historygetint4( file = file, &
16563 & varname = varname, array = array, &
16564 & range = time_range, quiet = quiet, &
16565 & flag_mpi_split = flag_mpi_split, &
16566 & returned_time = returned_time, &
16567 & flag_time_exist = flag_time_exist, &
16568 & err = err )
16569end subroutine historygetint4timei
16571 & file, varname, array, time, &
16572 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16573 use dc_string, only: tochar, split
16574 use dc_types, only: string, dp
16575 use dc_trace, only: dbgmessage
16576 use dc_url, only: url_chop_iorange, gt_equal
16577 use dc_present, only: present_and_true
16578 implicit none
16579 character(*), intent(in):: file, varname
16580 integer, intent(in):: time
16581 logical, intent(in), optional:: quiet
16582 integer, intent(out) :: array(:,:,:,:,:)
16583 logical, intent(in), optional:: flag_mpi_split
16584 real(DP), intent(out), optional:: returned_time
16585 logical, intent(out), optional:: flag_time_exist
16586 logical, intent(out), optional:: err
16587 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16588 character(STRING), pointer:: carray (:)
16589 character(STRING):: tname
16590 interface
16591 subroutine historygetint5(&
16592 & file, varname, array, range, quiet, &
16593 & flag_mpi_split, returned_time, flag_time_exist, err)
16594 use dc_types, only: dp
16595 character(*), intent(in):: file
16596 character(*), intent(in):: varname
16597 character(*), intent(in), optional:: range
16598 logical, intent(in), optional:: quiet
16599 logical, intent(in), optional:: flag_mpi_split
16600 real(DP), intent(out), optional:: returned_time
16601 logical, intent(out), optional:: flag_time_exist
16602 logical, intent(out), optional:: err
16603 integer, intent(out) :: array(:,:,:,:,:)
16604 end subroutine historygetint5
16605 end interface
16606 interface
16607 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16608 character(*), intent(in):: file
16609 character(*), intent(in):: varname
16610 character(*), intent(out):: url
16611 character(*), intent(in), optional:: range
16612 logical, intent(out), optional:: flag_time_exist
16613 character(*), intent(out), optional:: time_name
16614 logical, intent(out), optional:: err
16615 end subroutine lookup_growable_url
16616 end interface
16617 interface
16618 function file_rename_mpi( file ) result(result)
16619 use dc_types, only: string
16620 character(*), intent(in):: file
16621 character(STRING):: result
16622 end function file_rename_mpi
16623 end interface
16624 continue
16625 file_work = file
16626 if ( present_and_true( flag_mpi_split ) ) &
16627 & file_work = file_rename_mpi( file_work )
16628 call lookup_growable_url(file = file_work, varname = varname, &
16629 & url = url, &
16630 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16631 call url_chop_iorange( &
16632 & fullname = url, iorange = iorange, remainder = remainder )
16633 call split( str = iorange, carray = carray, sep = gt_equal )
16634 timevar_name = carray(1)
16635 deallocate( carray )
16636 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16637 call historygetint5( file = file, &
16638 & varname = varname, array = array, &
16639 & range = time_range, quiet = quiet, &
16640 & flag_mpi_split = flag_mpi_split, &
16641 & returned_time = returned_time, &
16642 & flag_time_exist = flag_time_exist, &
16643 & err = err )
16644end subroutine historygetint5timei
16646 & file, varname, array, time, &
16647 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16648 use dc_string, only: tochar, split
16649 use dc_types, only: string, dp
16650 use dc_trace, only: dbgmessage
16651 use dc_url, only: url_chop_iorange, gt_equal
16652 use dc_present, only: present_and_true
16653 implicit none
16654 character(*), intent(in):: file, varname
16655 integer, intent(in):: time
16656 logical, intent(in), optional:: quiet
16657 integer, intent(out) :: array(:,:,:,:,:,:)
16658 logical, intent(in), optional:: flag_mpi_split
16659 real(DP), intent(out), optional:: returned_time
16660 logical, intent(out), optional:: flag_time_exist
16661 logical, intent(out), optional:: err
16662 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16663 character(STRING), pointer:: carray (:)
16664 character(STRING):: tname
16665 interface
16666 subroutine historygetint6(&
16667 & file, varname, array, range, quiet, &
16668 & flag_mpi_split, returned_time, flag_time_exist, err)
16669 use dc_types, only: dp
16670 character(*), intent(in):: file
16671 character(*), intent(in):: varname
16672 character(*), intent(in), optional:: range
16673 logical, intent(in), optional:: quiet
16674 logical, intent(in), optional:: flag_mpi_split
16675 real(DP), intent(out), optional:: returned_time
16676 logical, intent(out), optional:: flag_time_exist
16677 logical, intent(out), optional:: err
16678 integer, intent(out) :: array(:,:,:,:,:,:)
16679 end subroutine historygetint6
16680 end interface
16681 interface
16682 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16683 character(*), intent(in):: file
16684 character(*), intent(in):: varname
16685 character(*), intent(out):: url
16686 character(*), intent(in), optional:: range
16687 logical, intent(out), optional:: flag_time_exist
16688 character(*), intent(out), optional:: time_name
16689 logical, intent(out), optional:: err
16690 end subroutine lookup_growable_url
16691 end interface
16692 interface
16693 function file_rename_mpi( file ) result(result)
16694 use dc_types, only: string
16695 character(*), intent(in):: file
16696 character(STRING):: result
16697 end function file_rename_mpi
16698 end interface
16699 continue
16700 file_work = file
16701 if ( present_and_true( flag_mpi_split ) ) &
16702 & file_work = file_rename_mpi( file_work )
16703 call lookup_growable_url(file = file_work, varname = varname, &
16704 & url = url, &
16705 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16706 call url_chop_iorange( &
16707 & fullname = url, iorange = iorange, remainder = remainder )
16708 call split( str = iorange, carray = carray, sep = gt_equal )
16709 timevar_name = carray(1)
16710 deallocate( carray )
16711 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16712 call historygetint6( file = file, &
16713 & varname = varname, array = array, &
16714 & range = time_range, quiet = quiet, &
16715 & flag_mpi_split = flag_mpi_split, &
16716 & returned_time = returned_time, &
16717 & flag_time_exist = flag_time_exist, &
16718 & err = err )
16719end subroutine historygetint6timei
16721 & file, varname, array, time, &
16722 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16723 use dc_string, only: tochar, split
16724 use dc_types, only: string, dp
16725 use dc_trace, only: dbgmessage
16726 use dc_url, only: url_chop_iorange, gt_equal
16727 use dc_present, only: present_and_true
16728 implicit none
16729 character(*), intent(in):: file, varname
16730 integer, intent(in):: time
16731 logical, intent(in), optional:: quiet
16732 integer, intent(out) :: array(:,:,:,:,:,:,:)
16733 logical, intent(in), optional:: flag_mpi_split
16734 real(DP), intent(out), optional:: returned_time
16735 logical, intent(out), optional:: flag_time_exist
16736 logical, intent(out), optional:: err
16737 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16738 character(STRING), pointer:: carray (:)
16739 character(STRING):: tname
16740 interface
16741 subroutine historygetint7(&
16742 & file, varname, array, range, quiet, &
16743 & flag_mpi_split, returned_time, flag_time_exist, err)
16744 use dc_types, only: dp
16745 character(*), intent(in):: file
16746 character(*), intent(in):: varname
16747 character(*), intent(in), optional:: range
16748 logical, intent(in), optional:: quiet
16749 logical, intent(in), optional:: flag_mpi_split
16750 real(DP), intent(out), optional:: returned_time
16751 logical, intent(out), optional:: flag_time_exist
16752 logical, intent(out), optional:: err
16753 integer, intent(out) :: array(:,:,:,:,:,:,:)
16754 end subroutine historygetint7
16755 end interface
16756 interface
16757 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16758 character(*), intent(in):: file
16759 character(*), intent(in):: varname
16760 character(*), intent(out):: url
16761 character(*), intent(in), optional:: range
16762 logical, intent(out), optional:: flag_time_exist
16763 character(*), intent(out), optional:: time_name
16764 logical, intent(out), optional:: err
16765 end subroutine lookup_growable_url
16766 end interface
16767 interface
16768 function file_rename_mpi( file ) result(result)
16769 use dc_types, only: string
16770 character(*), intent(in):: file
16771 character(STRING):: result
16772 end function file_rename_mpi
16773 end interface
16774 continue
16775 file_work = file
16776 if ( present_and_true( flag_mpi_split ) ) &
16777 & file_work = file_rename_mpi( file_work )
16778 call lookup_growable_url(file = file_work, varname = varname, &
16779 & url = url, &
16780 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16781 call url_chop_iorange( &
16782 & fullname = url, iorange = iorange, remainder = remainder )
16783 call split( str = iorange, carray = carray, sep = gt_equal )
16784 timevar_name = carray(1)
16785 deallocate( carray )
16786 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16787 call historygetint7( file = file, &
16788 & varname = varname, array = array, &
16789 & range = time_range, quiet = quiet, &
16790 & flag_mpi_split = flag_mpi_split, &
16791 & returned_time = returned_time, &
16792 & flag_time_exist = flag_time_exist, &
16793 & err = err )
16794end subroutine historygetint7timei
16796 & file, varname, array, time, &
16797 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16798 use dc_string, only: tochar, split
16799 use dc_types, only: string, dp
16800 use dc_trace, only: dbgmessage
16801 use dc_url, only: url_chop_iorange, gt_equal
16802 use dc_present, only: present_and_true
16803 implicit none
16804 character(*), intent(in):: file, varname
16805 integer, intent(in):: time
16806 logical, intent(in), optional:: quiet
16807 integer, pointer :: array
16808 logical, intent(in), optional:: flag_mpi_split
16809 real(DP), intent(out), optional:: returned_time
16810 logical, intent(out), optional:: flag_time_exist
16811 logical, intent(out), optional:: err
16812 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16813 character(STRING), pointer:: carray (:)
16814 character(STRING):: tname
16815 interface
16816 subroutine historygetint0pointer(&
16817 & file, varname, array, range, quiet, &
16818 & flag_mpi_split, returned_time, flag_time_exist, err)
16819 use dc_types, only: dp
16820 character(*), intent(in):: file
16821 character(*), intent(in):: varname
16822 character(*), intent(in), optional:: range
16823 logical, intent(in), optional:: quiet
16824 logical, intent(in), optional:: flag_mpi_split
16825 real(DP), intent(out), optional:: returned_time
16826 logical, intent(out), optional:: flag_time_exist
16827 logical, intent(out), optional:: err
16828 integer, pointer :: array
16829 end subroutine historygetint0pointer
16830 end interface
16831 interface
16832 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16833 character(*), intent(in):: file
16834 character(*), intent(in):: varname
16835 character(*), intent(out):: url
16836 character(*), intent(in), optional:: range
16837 logical, intent(out), optional:: flag_time_exist
16838 character(*), intent(out), optional:: time_name
16839 logical, intent(out), optional:: err
16840 end subroutine lookup_growable_url
16841 end interface
16842 interface
16843 function file_rename_mpi( file ) result(result)
16844 use dc_types, only: string
16845 character(*), intent(in):: file
16846 character(STRING):: result
16847 end function file_rename_mpi
16848 end interface
16849 continue
16850 file_work = file
16851 if ( present_and_true( flag_mpi_split ) ) &
16852 & file_work = file_rename_mpi( file_work )
16853 call lookup_growable_url(file = file_work, varname = varname, &
16854 & url = url, &
16855 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16856 call url_chop_iorange( &
16857 & fullname = url, iorange = iorange, remainder = remainder )
16858 call split( str = iorange, carray = carray, sep = gt_equal )
16859 timevar_name = carray(1)
16860 deallocate( carray )
16861 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16862 call historygetint0pointer( file = file, &
16863 & varname = varname, array = array, &
16864 & range = time_range, quiet = quiet, &
16865 & flag_mpi_split = flag_mpi_split, &
16866 & returned_time = returned_time, &
16867 & flag_time_exist = flag_time_exist, &
16868 & err = err )
16869end subroutine historygetint0pointertimei
16871 & file, varname, array, time, &
16872 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16873 use dc_string, only: tochar, split
16874 use dc_types, only: string, dp
16875 use dc_trace, only: dbgmessage
16876 use dc_url, only: url_chop_iorange, gt_equal
16877 use dc_present, only: present_and_true
16878 implicit none
16879 character(*), intent(in):: file, varname
16880 integer, intent(in):: time
16881 logical, intent(in), optional:: quiet
16882 integer, pointer :: array(:)
16883 logical, intent(in), optional:: flag_mpi_split
16884 real(DP), intent(out), optional:: returned_time
16885 logical, intent(out), optional:: flag_time_exist
16886 logical, intent(out), optional:: err
16887 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16888 character(STRING), pointer:: carray (:)
16889 character(STRING):: tname
16890 interface
16891 subroutine historygetint1pointer(&
16892 & file, varname, array, range, quiet, &
16893 & flag_mpi_split, returned_time, flag_time_exist, err)
16894 use dc_types, only: dp
16895 character(*), intent(in):: file
16896 character(*), intent(in):: varname
16897 character(*), intent(in), optional:: range
16898 logical, intent(in), optional:: quiet
16899 logical, intent(in), optional:: flag_mpi_split
16900 real(DP), intent(out), optional:: returned_time
16901 logical, intent(out), optional:: flag_time_exist
16902 logical, intent(out), optional:: err
16903 integer, pointer :: array(:)
16904 end subroutine historygetint1pointer
16905 end interface
16906 interface
16907 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16908 character(*), intent(in):: file
16909 character(*), intent(in):: varname
16910 character(*), intent(out):: url
16911 character(*), intent(in), optional:: range
16912 logical, intent(out), optional:: flag_time_exist
16913 character(*), intent(out), optional:: time_name
16914 logical, intent(out), optional:: err
16915 end subroutine lookup_growable_url
16916 end interface
16917 interface
16918 function file_rename_mpi( file ) result(result)
16919 use dc_types, only: string
16920 character(*), intent(in):: file
16921 character(STRING):: result
16922 end function file_rename_mpi
16923 end interface
16924 continue
16925 file_work = file
16926 if ( present_and_true( flag_mpi_split ) ) &
16927 & file_work = file_rename_mpi( file_work )
16928 call lookup_growable_url(file = file_work, varname = varname, &
16929 & url = url, &
16930 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
16931 call url_chop_iorange( &
16932 & fullname = url, iorange = iorange, remainder = remainder )
16933 call split( str = iorange, carray = carray, sep = gt_equal )
16934 timevar_name = carray(1)
16935 deallocate( carray )
16936 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
16937 call historygetint1pointer( file = file, &
16938 & varname = varname, array = array, &
16939 & range = time_range, quiet = quiet, &
16940 & flag_mpi_split = flag_mpi_split, &
16941 & returned_time = returned_time, &
16942 & flag_time_exist = flag_time_exist, &
16943 & err = err )
16944end subroutine historygetint1pointertimei
16946 & file, varname, array, time, &
16947 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
16948 use dc_string, only: tochar, split
16949 use dc_types, only: string, dp
16950 use dc_trace, only: dbgmessage
16951 use dc_url, only: url_chop_iorange, gt_equal
16952 use dc_present, only: present_and_true
16953 implicit none
16954 character(*), intent(in):: file, varname
16955 integer, intent(in):: time
16956 logical, intent(in), optional:: quiet
16957 integer, pointer :: array(:,:)
16958 logical, intent(in), optional:: flag_mpi_split
16959 real(DP), intent(out), optional:: returned_time
16960 logical, intent(out), optional:: flag_time_exist
16961 logical, intent(out), optional:: err
16962 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
16963 character(STRING), pointer:: carray (:)
16964 character(STRING):: tname
16965 interface
16966 subroutine historygetint2pointer(&
16967 & file, varname, array, range, quiet, &
16968 & flag_mpi_split, returned_time, flag_time_exist, err)
16969 use dc_types, only: dp
16970 character(*), intent(in):: file
16971 character(*), intent(in):: varname
16972 character(*), intent(in), optional:: range
16973 logical, intent(in), optional:: quiet
16974 logical, intent(in), optional:: flag_mpi_split
16975 real(DP), intent(out), optional:: returned_time
16976 logical, intent(out), optional:: flag_time_exist
16977 logical, intent(out), optional:: err
16978 integer, pointer :: array(:,:)
16979 end subroutine historygetint2pointer
16980 end interface
16981 interface
16982 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
16983 character(*), intent(in):: file
16984 character(*), intent(in):: varname
16985 character(*), intent(out):: url
16986 character(*), intent(in), optional:: range
16987 logical, intent(out), optional:: flag_time_exist
16988 character(*), intent(out), optional:: time_name
16989 logical, intent(out), optional:: err
16990 end subroutine lookup_growable_url
16991 end interface
16992 interface
16993 function file_rename_mpi( file ) result(result)
16994 use dc_types, only: string
16995 character(*), intent(in):: file
16996 character(STRING):: result
16997 end function file_rename_mpi
16998 end interface
16999 continue
17000 file_work = file
17001 if ( present_and_true( flag_mpi_split ) ) &
17002 & file_work = file_rename_mpi( file_work )
17003 call lookup_growable_url(file = file_work, varname = varname, &
17004 & url = url, &
17005 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17006 call url_chop_iorange( &
17007 & fullname = url, iorange = iorange, remainder = remainder )
17008 call split( str = iorange, carray = carray, sep = gt_equal )
17009 timevar_name = carray(1)
17010 deallocate( carray )
17011 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17012 call historygetint2pointer( file = file, &
17013 & varname = varname, array = array, &
17014 & range = time_range, quiet = quiet, &
17015 & flag_mpi_split = flag_mpi_split, &
17016 & returned_time = returned_time, &
17017 & flag_time_exist = flag_time_exist, &
17018 & err = err )
17019end subroutine historygetint2pointertimei
17021 & file, varname, array, time, &
17022 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
17023 use dc_string, only: tochar, split
17024 use dc_types, only: string, dp
17025 use dc_trace, only: dbgmessage
17026 use dc_url, only: url_chop_iorange, gt_equal
17027 use dc_present, only: present_and_true
17028 implicit none
17029 character(*), intent(in):: file, varname
17030 integer, intent(in):: time
17031 logical, intent(in), optional:: quiet
17032 integer, pointer :: array(:,:,:)
17033 logical, intent(in), optional:: flag_mpi_split
17034 real(DP), intent(out), optional:: returned_time
17035 logical, intent(out), optional:: flag_time_exist
17036 logical, intent(out), optional:: err
17037 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
17038 character(STRING), pointer:: carray (:)
17039 character(STRING):: tname
17040 interface
17041 subroutine historygetint3pointer(&
17042 & file, varname, array, range, quiet, &
17043 & flag_mpi_split, returned_time, flag_time_exist, err)
17044 use dc_types, only: dp
17045 character(*), intent(in):: file
17046 character(*), intent(in):: varname
17047 character(*), intent(in), optional:: range
17048 logical, intent(in), optional:: quiet
17049 logical, intent(in), optional:: flag_mpi_split
17050 real(DP), intent(out), optional:: returned_time
17051 logical, intent(out), optional:: flag_time_exist
17052 logical, intent(out), optional:: err
17053 integer, pointer :: array(:,:,:)
17054 end subroutine historygetint3pointer
17055 end interface
17056 interface
17057 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
17058 character(*), intent(in):: file
17059 character(*), intent(in):: varname
17060 character(*), intent(out):: url
17061 character(*), intent(in), optional:: range
17062 logical, intent(out), optional:: flag_time_exist
17063 character(*), intent(out), optional:: time_name
17064 logical, intent(out), optional:: err
17065 end subroutine lookup_growable_url
17066 end interface
17067 interface
17068 function file_rename_mpi( file ) result(result)
17069 use dc_types, only: string
17070 character(*), intent(in):: file
17071 character(STRING):: result
17072 end function file_rename_mpi
17073 end interface
17074 continue
17075 file_work = file
17076 if ( present_and_true( flag_mpi_split ) ) &
17077 & file_work = file_rename_mpi( file_work )
17078 call lookup_growable_url(file = file_work, varname = varname, &
17079 & url = url, &
17080 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17081 call url_chop_iorange( &
17082 & fullname = url, iorange = iorange, remainder = remainder )
17083 call split( str = iorange, carray = carray, sep = gt_equal )
17084 timevar_name = carray(1)
17085 deallocate( carray )
17086 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17087 call historygetint3pointer( file = file, &
17088 & varname = varname, array = array, &
17089 & range = time_range, quiet = quiet, &
17090 & flag_mpi_split = flag_mpi_split, &
17091 & returned_time = returned_time, &
17092 & flag_time_exist = flag_time_exist, &
17093 & err = err )
17094end subroutine historygetint3pointertimei
17096 & file, varname, array, time, &
17097 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
17098 use dc_string, only: tochar, split
17099 use dc_types, only: string, dp
17100 use dc_trace, only: dbgmessage
17101 use dc_url, only: url_chop_iorange, gt_equal
17102 use dc_present, only: present_and_true
17103 implicit none
17104 character(*), intent(in):: file, varname
17105 integer, intent(in):: time
17106 logical, intent(in), optional:: quiet
17107 integer, pointer :: array(:,:,:,:)
17108 logical, intent(in), optional:: flag_mpi_split
17109 real(DP), intent(out), optional:: returned_time
17110 logical, intent(out), optional:: flag_time_exist
17111 logical, intent(out), optional:: err
17112 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
17113 character(STRING), pointer:: carray (:)
17114 character(STRING):: tname
17115 interface
17116 subroutine historygetint4pointer(&
17117 & file, varname, array, range, quiet, &
17118 & flag_mpi_split, returned_time, flag_time_exist, err)
17119 use dc_types, only: dp
17120 character(*), intent(in):: file
17121 character(*), intent(in):: varname
17122 character(*), intent(in), optional:: range
17123 logical, intent(in), optional:: quiet
17124 logical, intent(in), optional:: flag_mpi_split
17125 real(DP), intent(out), optional:: returned_time
17126 logical, intent(out), optional:: flag_time_exist
17127 logical, intent(out), optional:: err
17128 integer, pointer :: array(:,:,:,:)
17129 end subroutine historygetint4pointer
17130 end interface
17131 interface
17132 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
17133 character(*), intent(in):: file
17134 character(*), intent(in):: varname
17135 character(*), intent(out):: url
17136 character(*), intent(in), optional:: range
17137 logical, intent(out), optional:: flag_time_exist
17138 character(*), intent(out), optional:: time_name
17139 logical, intent(out), optional:: err
17140 end subroutine lookup_growable_url
17141 end interface
17142 interface
17143 function file_rename_mpi( file ) result(result)
17144 use dc_types, only: string
17145 character(*), intent(in):: file
17146 character(STRING):: result
17147 end function file_rename_mpi
17148 end interface
17149 continue
17150 file_work = file
17151 if ( present_and_true( flag_mpi_split ) ) &
17152 & file_work = file_rename_mpi( file_work )
17153 call lookup_growable_url(file = file_work, varname = varname, &
17154 & url = url, &
17155 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17156 call url_chop_iorange( &
17157 & fullname = url, iorange = iorange, remainder = remainder )
17158 call split( str = iorange, carray = carray, sep = gt_equal )
17159 timevar_name = carray(1)
17160 deallocate( carray )
17161 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17162 call historygetint4pointer( file = file, &
17163 & varname = varname, array = array, &
17164 & range = time_range, quiet = quiet, &
17165 & flag_mpi_split = flag_mpi_split, &
17166 & returned_time = returned_time, &
17167 & flag_time_exist = flag_time_exist, &
17168 & err = err )
17169end subroutine historygetint4pointertimei
17171 & file, varname, array, time, &
17172 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
17173 use dc_string, only: tochar, split
17174 use dc_types, only: string, dp
17175 use dc_trace, only: dbgmessage
17176 use dc_url, only: url_chop_iorange, gt_equal
17177 use dc_present, only: present_and_true
17178 implicit none
17179 character(*), intent(in):: file, varname
17180 integer, intent(in):: time
17181 logical, intent(in), optional:: quiet
17182 integer, pointer :: array(:,:,:,:,:)
17183 logical, intent(in), optional:: flag_mpi_split
17184 real(DP), intent(out), optional:: returned_time
17185 logical, intent(out), optional:: flag_time_exist
17186 logical, intent(out), optional:: err
17187 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
17188 character(STRING), pointer:: carray (:)
17189 character(STRING):: tname
17190 interface
17191 subroutine historygetint5pointer(&
17192 & file, varname, array, range, quiet, &
17193 & flag_mpi_split, returned_time, flag_time_exist, err)
17194 use dc_types, only: dp
17195 character(*), intent(in):: file
17196 character(*), intent(in):: varname
17197 character(*), intent(in), optional:: range
17198 logical, intent(in), optional:: quiet
17199 logical, intent(in), optional:: flag_mpi_split
17200 real(DP), intent(out), optional:: returned_time
17201 logical, intent(out), optional:: flag_time_exist
17202 logical, intent(out), optional:: err
17203 integer, pointer :: array(:,:,:,:,:)
17204 end subroutine historygetint5pointer
17205 end interface
17206 interface
17207 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
17208 character(*), intent(in):: file
17209 character(*), intent(in):: varname
17210 character(*), intent(out):: url
17211 character(*), intent(in), optional:: range
17212 logical, intent(out), optional:: flag_time_exist
17213 character(*), intent(out), optional:: time_name
17214 logical, intent(out), optional:: err
17215 end subroutine lookup_growable_url
17216 end interface
17217 interface
17218 function file_rename_mpi( file ) result(result)
17219 use dc_types, only: string
17220 character(*), intent(in):: file
17221 character(STRING):: result
17222 end function file_rename_mpi
17223 end interface
17224 continue
17225 file_work = file
17226 if ( present_and_true( flag_mpi_split ) ) &
17227 & file_work = file_rename_mpi( file_work )
17228 call lookup_growable_url(file = file_work, varname = varname, &
17229 & url = url, &
17230 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17231 call url_chop_iorange( &
17232 & fullname = url, iorange = iorange, remainder = remainder )
17233 call split( str = iorange, carray = carray, sep = gt_equal )
17234 timevar_name = carray(1)
17235 deallocate( carray )
17236 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17237 call historygetint5pointer( file = file, &
17238 & varname = varname, array = array, &
17239 & range = time_range, quiet = quiet, &
17240 & flag_mpi_split = flag_mpi_split, &
17241 & returned_time = returned_time, &
17242 & flag_time_exist = flag_time_exist, &
17243 & err = err )
17244end subroutine historygetint5pointertimei
17246 & file, varname, array, time, &
17247 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
17248 use dc_string, only: tochar, split
17249 use dc_types, only: string, dp
17250 use dc_trace, only: dbgmessage
17251 use dc_url, only: url_chop_iorange, gt_equal
17252 use dc_present, only: present_and_true
17253 implicit none
17254 character(*), intent(in):: file, varname
17255 integer, intent(in):: time
17256 logical, intent(in), optional:: quiet
17257 integer, pointer :: array(:,:,:,:,:,:)
17258 logical, intent(in), optional:: flag_mpi_split
17259 real(DP), intent(out), optional:: returned_time
17260 logical, intent(out), optional:: flag_time_exist
17261 logical, intent(out), optional:: err
17262 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
17263 character(STRING), pointer:: carray (:)
17264 character(STRING):: tname
17265 interface
17266 subroutine historygetint6pointer(&
17267 & file, varname, array, range, quiet, &
17268 & flag_mpi_split, returned_time, flag_time_exist, err)
17269 use dc_types, only: dp
17270 character(*), intent(in):: file
17271 character(*), intent(in):: varname
17272 character(*), intent(in), optional:: range
17273 logical, intent(in), optional:: quiet
17274 logical, intent(in), optional:: flag_mpi_split
17275 real(DP), intent(out), optional:: returned_time
17276 logical, intent(out), optional:: flag_time_exist
17277 logical, intent(out), optional:: err
17278 integer, pointer :: array(:,:,:,:,:,:)
17279 end subroutine historygetint6pointer
17280 end interface
17281 interface
17282 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
17283 character(*), intent(in):: file
17284 character(*), intent(in):: varname
17285 character(*), intent(out):: url
17286 character(*), intent(in), optional:: range
17287 logical, intent(out), optional:: flag_time_exist
17288 character(*), intent(out), optional:: time_name
17289 logical, intent(out), optional:: err
17290 end subroutine lookup_growable_url
17291 end interface
17292 interface
17293 function file_rename_mpi( file ) result(result)
17294 use dc_types, only: string
17295 character(*), intent(in):: file
17296 character(STRING):: result
17297 end function file_rename_mpi
17298 end interface
17299 continue
17300 file_work = file
17301 if ( present_and_true( flag_mpi_split ) ) &
17302 & file_work = file_rename_mpi( file_work )
17303 call lookup_growable_url(file = file_work, varname = varname, &
17304 & url = url, &
17305 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17306 call url_chop_iorange( &
17307 & fullname = url, iorange = iorange, remainder = remainder )
17308 call split( str = iorange, carray = carray, sep = gt_equal )
17309 timevar_name = carray(1)
17310 deallocate( carray )
17311 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17312 call historygetint6pointer( file = file, &
17313 & varname = varname, array = array, &
17314 & range = time_range, quiet = quiet, &
17315 & flag_mpi_split = flag_mpi_split, &
17316 & returned_time = returned_time, &
17317 & flag_time_exist = flag_time_exist, &
17318 & err = err )
17319end subroutine historygetint6pointertimei
17321 & file, varname, array, time, &
17322 & quiet, flag_mpi_split, returned_time, flag_time_exist, err)
17323 use dc_string, only: tochar, split
17324 use dc_types, only: string, dp
17325 use dc_trace, only: dbgmessage
17326 use dc_url, only: url_chop_iorange, gt_equal
17327 use dc_present, only: present_and_true
17328 implicit none
17329 character(*), intent(in):: file, varname
17330 integer, intent(in):: time
17331 logical, intent(in), optional:: quiet
17332 integer, pointer :: array(:,:,:,:,:,:,:)
17333 logical, intent(in), optional:: flag_mpi_split
17334 real(DP), intent(out), optional:: returned_time
17335 logical, intent(out), optional:: flag_time_exist
17336 logical, intent(out), optional:: err
17337 character(STRING):: file_work, url, iorange, remainder, timevar_name, time_range
17338 character(STRING), pointer:: carray (:)
17339 character(STRING):: tname
17340 interface
17341 subroutine historygetint7pointer(&
17342 & file, varname, array, range, quiet, &
17343 & flag_mpi_split, returned_time, flag_time_exist, err)
17344 use dc_types, only: dp
17345 character(*), intent(in):: file
17346 character(*), intent(in):: varname
17347 character(*), intent(in), optional:: range
17348 logical, intent(in), optional:: quiet
17349 logical, intent(in), optional:: flag_mpi_split
17350 real(DP), intent(out), optional:: returned_time
17351 logical, intent(out), optional:: flag_time_exist
17352 logical, intent(out), optional:: err
17353 integer, pointer :: array(:,:,:,:,:,:,:)
17354 end subroutine historygetint7pointer
17355 end interface
17356 interface
17357 subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
17358 character(*), intent(in):: file
17359 character(*), intent(in):: varname
17360 character(*), intent(out):: url
17361 character(*), intent(in), optional:: range
17362 logical, intent(out), optional:: flag_time_exist
17363 character(*), intent(out), optional:: time_name
17364 logical, intent(out), optional:: err
17365 end subroutine lookup_growable_url
17366 end interface
17367 interface
17368 function file_rename_mpi( file ) result(result)
17369 use dc_types, only: string
17370 character(*), intent(in):: file
17371 character(STRING):: result
17372 end function file_rename_mpi
17373 end interface
17374 continue
17375 file_work = file
17376 if ( present_and_true( flag_mpi_split ) ) &
17377 & file_work = file_rename_mpi( file_work )
17378 call lookup_growable_url(file = file_work, varname = varname, &
17379 & url = url, &
17380 & flag_time_exist = flag_time_exist, time_name = tname, err = err)
17381 call url_chop_iorange( &
17382 & fullname = url, iorange = iorange, remainder = remainder )
17383 call split( str = iorange, carray = carray, sep = gt_equal )
17384 timevar_name = carray(1)
17385 deallocate( carray )
17386 time_range = trim(timevar_name) // gt_equal // trim(tochar(time))
17387 call historygetint7pointer( file = file, &
17388 & varname = varname, array = array, &
17389 & range = time_range, quiet = quiet, &
17390 & flag_mpi_split = flag_mpi_split, &
17391 & returned_time = returned_time, &
17392 & flag_time_exist = flag_time_exist, &
17393 & err = err )
17394end subroutine historygetint7pointertimei
17396 & file, varname, & ! (in)
17397 & url, & ! (out)
17398 & range, & ! (in) optional
17399 & flag_time_exist, time_name, err) ! (out) optional
17400 !
17401 ! file の変数 varname が依存する次元の内, 時間の次元
17402 ! (growable == .TRUE. のもの, つまり無制限次元) の変数名,
17403 ! およびその最後の値を取得し, gtool 変数化
17404 ! ("file@varname,time=10.5" みたいな) して返す.
17405 !
17406 ! * もしも varname が次元変数である場合は「time=」を付けずに返す.
17407 ! * range を与えた場合, 以下のチェックを行った後, それを gtool4
17408 ! 変数の iorange 部分に付加する.
17409 ! * range に空文字が与えられた場合, range が与えられない場合と
17410 ! 同じ動作をする.
17411 ! * range 内に時間次元が設定されていない場合は, 自動的に
17412 ! 時間次元に関する iorange ("time=0.5") が指定される.
17413 ! * 数値のみの文字列 (例: "20", "10.354") が与えられる場合,
17414 ! エラーを生じる.
17415 !
17416 ! *flag_time_exist* が与えられる場合には, 得られるデータに
17417 ! 時刻次元が含まれる場合には .true. を, 含まれない場合は
17418 ! .false. を返す.
17419 ! *time_name* が与えられる場合には, 得られるデータに
17420 ! 時刻次元が含まれる場合にはその時刻次元変数名を,
17421 ! 含まれない場合には空文字を返す.
17422 !
17423 use gtdata_types, only: gt_variable
17424 use gtdata_generic, only: open, close, inquire
17426 use dc_string, only: tochar
17427 use dc_error, only: storeerror, dc_noerr, &
17428 & nf90_einval, gt_enotvar, gt_ebadgt4commagraphy
17431 use dc_regex, only: match
17432 use dc_types, only: string
17433 use dc_trace, only: beginsub, endsub, dbgmessage
17434 character(*), intent(in) :: file ! ファイル名
17435 character(*), intent(in) :: varname ! 変数名
17436 character(*), intent(out) :: url ! gtool変数化した文字列
17437 character(*), intent(in), optional:: range ! 範囲限定や一点切り出し指定
17438 logical, intent(out), optional:: flag_time_exist ! 時刻次元の存在の有無
17439 character(*), intent(out), optional:: time_name ! 時刻次元の名称
17440 logical, intent(out), optional :: err ! エラーのフラグ
17441 !
17442 type(gt_variable) :: var
17443 type(gt_variable), allocatable :: dimvar(:)
17444 character(STRING) :: time_url, tname, time_iorange
17445 character(STRING) :: iorange, cause_c
17446 logical:: growable, nounlimited
17447 integer:: allcount, timecount, nd, i, stat
17448 integer:: regex_stat, regex_len
17449 character(*), parameter :: subname = "lookup_growable_url"
17450continue
17451 call beginsub(subname, '<file=%c varname=%c range=%c>', &
17452 & c1=trim(file), c2=trim(varname), &
17453 & c3=trim(present_select('', 'no-range', range)))
17454 stat = dc_noerr
17455 cause_c = ""
17456 url = ""
17457 ! 引数の正当性をチェック
17458 if (.not. present_and_not_empty(file)) then
17459 stat = nf90_einval
17460 cause_c = '"file" is not specified'
17461 goto 999
17462 elseif (.not. present_and_not_empty(varname)) then
17463 stat = nf90_einval
17464 cause_c = '"varname" is not specified'
17465 goto 999
17466 end if
17467 ! 時刻次元の変数名, およびその最終時刻の
17468 ! 探査のために file@varname を open (まだデータを取得しない)
17469 call open(var, urlmerge(file, varname), err = err)
17470 if ( present_and_true(err) ) then
17471 stat = gt_enotvar
17472 goto 999
17473 end if
17474 ! 次元の数を取得
17475 call inquire(var=var, alldims=nd)
17476 call dbgmessage('@ alldims = %d', i=(/nd/))
17477 if (allocated(dimvar)) then
17478 deallocate(dimvar)
17479 end if
17480 allocate(dimvar(nd))
17481 !
17482 ! 変数が無制限変数を持たない場合, もしくは変数自体が
17483 ! 無制限次元変数である場合には, それに関する iorange を
17484 ! 付けないで返すよう, フラグを立てる.
17485 ! それ以外は .false. にする.
17486 nounlimited = .true.
17487 !
17488 ! 各次元毎に情報を取得し, growable == .TRUE. のもの (つまりは時間)
17489 ! の変数名 (tname) を取得する.
17490 call dbgmessage('[%c: growable-dim-search]', c1=trim(subname))
17491 tname = ''
17492 do, i = 1, nd
17493 call open(var = dimvar(i), & ! (out)
17494 & source_var = var, dimord = i, & ! (in)
17495 & count_compact = .true., & ! (in)
17496 & err = err) ! (out) optional
17497 ! まずは変数入り gtool4 変数を time_url に取得
17498 call inquire(var = dimvar(i), & ! (in)
17499 & growable = growable, & ! (out)
17500 & allcount = allcount, url = time_url) ! (out)
17501 call dbgmessage(' [dim=d>: growable=<%y>: url=<%c>]', &
17502 & i = (/i/), l = (/growable/), c1 = trim(time_url))
17503 ! 変数部分だけ分離
17504 call urlsplit( fullname = time_url, & ! (in)
17505 & var = tname) ! (out)
17506 ! 無制限次元で, かつ開こうとする変数自体が無制限次元でない場合
17507 !
17508 if ( growable .and. trim(tname) /= trim(varname) ) then
17509 ! 総数 = 最後の数を timecount に
17510 !
17511 timecount = allcount
17512 nounlimited = .false.
17513 endif
17514 call close(dimvar(i))
17515 ! 時刻次元が見つかった場合にはループを抜ける
17516 !
17517 if ( .not. nounlimited ) then
17518 exit
17519 ! 時刻次元ではない場合, tname を空に
17520 !
17521 else
17522 tname = ''
17523 end if
17524 end do
17525 ! 探査を終了したので閉じる
17526 call close(var)
17527 if (stat /= dc_noerr) then
17528 goto 999
17529 end if
17530 ! 時刻次元名を返す
17531 !
17532 if ( present(time_name) ) time_name = tname
17533 ! 時刻部分の iorange を作成しておく.
17534 ! 格子点情報で取得されているので, 頭に "^" を付加する.
17535 if (nounlimited) then
17536 time_iorange = ''
17537 if ( present(flag_time_exist) ) flag_time_exist = .false.
17538!!$ if ( present(returned_time) ) returned_time = 0.
17539 else
17540 time_iorange = trim(tname) // gt_equal // &
17541 & gt_circumflex // adjustl(tochar(timecount))
17542 if ( present(flag_time_exist) ) flag_time_exist = .true.
17543!!$ if ( present(returned_time) ) then
17544!!$ returned_time =
17545!!$ end if
17546 end if
17547 ! iorange を指定する.
17548 ! 時刻に関しては, range が存在しない場合には
17549 ! 自動取得した最後の時刻を付加する.
17550 ! range が存在する場合, "=" が含まれなければ, gtool4 のコンマ記法
17551 ! として不適切としてエラーを生じる.
17552 ! "=" が含まれる場合, iorange としてそのまま iorange になる.
17553 ! ただし, その iorange に時刻次元が含まれない場合,
17554 ! やはり先ほど自動取得した値が付加される.
17555 ! 当然, 時刻次元が存在しない場合には付加しない.
17556 if (.not. present_and_not_empty(range)) then
17557 iorange = time_iorange
17558 else
17559 ! range がコンマ記法になっているか, "=" があるかどうかで調べる
17560 call match(gt_equal, range, regex_len, regex_stat)
17561 ! コンマ記法になってない場合は無制限次元の値と判定
17562 if (regex_stat < 0) then
17563 cause_c = range
17565 goto 999
17566!!$ iorange = trim(tname) // GT_EQUAL // adjustl(range)
17567 else
17568 ! コンマ記法になっている場合, まずその中に無制限次元が
17569 ! 存在しているか調べ, 存在してない場合のみ time_iorange を
17570 ! 付加する.
17571 if (trim(urlsearchiorange(range, tname)) /= "") then
17572 iorange = range
17573 else
17574 if (trim(time_iorange) /= "") then
17575 iorange = range // gt_comma // time_iorange
17576 else
17577 iorange = range
17578 end if
17579 end if
17580 end if
17581 endif
17582 call dbgmessage('@ iorange=%c', c1=trim(iorange))
17583 ! file, varname, iorange を gtool変数化
17584 ! (「file@varname,time=10.5」のように)
17585 url = urlmerge(file, varname, '', iorange)
17586999 continue
17587 call storeerror(stat, subname, err, cause_c)
17588 call endsub(subname, '<url=%c>', c1=trim(url))
17589end subroutine lookup_growable_url
17590subroutine actual_iorange_dump( url, & ! (in)
17591 & actual_url, returned_time, & ! (out) optional
17592 & time_name, & ! (in) optional
17593 & err ) ! (out) optional
17594 !
17595 ! 変数 URL *url* に対応するファイル, 変数からデータを取り出す際,
17596 ! 入出力範囲指定によって切り出される値の本当の位置を
17597 ! 標準出力に出力する. *actual_url* が与えられる場合には
17598 ! その引数に値を返し, 標準出力には出力しない.
17599 !
17600 ! HistoryGet, HistoryGetPointer が下層で呼び出している
17601 ! gtdata_generic::Get は, 入出力範囲が次元データに正確に一致しない
17602 ! 場合, 最も近い値を自動的に選択して切り出す. しかしその結果,
17603 ! 「本当はどこのデータを入力したか」がわからない場合があるため,
17604 ! このサブルーチンによって正確な位置をユーザに知らせる.
17605 !
17606 ! *time_name* と *returned_time* が与えられる場合には,
17607 ! *returned_time* に時刻の数値を返す.
17608 ! *returned_time* のみ与えられる場合には 0 を返す.
17609 !
17610 use dc_types, only: dp, string
17611 use dc_string, only: split, joinchar, tochar, roundnum
17613 use dc_url, only: gt_comma, gt_equal, gt_colon
17614 use dc_message, only: messagenotify
17615 use dc_trace, only: dbgmessage
17616 use dc_regex, only: match
17617 use gtdata_types, only: gt_variable
17618 use gtdata_generic, only: open, close, get
17619 use dc_error, only: storeerror, dc_noerr
17620 character(*), intent(in):: url ! 変数 URL
17621 character(*), intent(out), optional:: actual_url
17622 ! 正確な入出力範囲指定に修正
17623 ! された変数 URL
17624 real(DP), intent(out), optional:: returned_time ! データの時刻
17625 character(*), intent(in), optional:: time_name ! 時刻次元の名称
17626 logical, intent(out), optional:: err ! エラーのフラグ
17627 character(STRING), pointer :: iorange_each(:) =>null()
17628 character(STRING), pointer :: range_values(:) =>null()
17629 character(STRING), pointer :: new_iorange_each(:) =>null()
17630 character(STRING), pointer :: new_range_values(:) =>null()
17631 character(STRING):: new_url, new_iorange, url_tmp, dimname
17632 character(STRING):: file, varname, range, cause_c
17633 type(gt_variable):: var
17634 real :: iorange_value(1)
17635 integer :: i, j, regex_len, regex_stat, stat
17636 character(*), parameter :: subname = "actual_iorange_dump"
17637 continue
17638 new_iorange = ''
17639 cause_c = ''
17640 stat = dc_noerr
17641 if ( present(returned_time) ) then
17642 returned_time = 0.
17643 end if
17644 call urlsplit(url, file, varname, iorange=range)
17645 call split(range, iorange_each, gt_comma)
17646 allocate(new_iorange_each(size(iorange_each)))
17647 do i = 1, size(iorange_each)
17648 call match(gt_equal, iorange_each(i), regex_len, regex_stat)
17649 if (regex_stat < 0 .or. regex_len < 2) then
17650 new_iorange_each(i) = trim(iorange_each(i))
17651 else
17652 dimname = iorange_each(i)(:regex_len-1)
17653 call split(iorange_each(i)(regex_len+1:), range_values, gt_colon)
17654 allocate(new_range_values(size(range_values)))
17655 do j = 1, size(range_values)
17656 url_tmp = urlmerge(file, dimname, '', &
17657 & iorange=trim(dimname) // gt_equal // trim(range_values(j)))
17658 call open(var, url_tmp)
17659 call get(var, iorange_value, 1)
17660 call close(var)
17661 if ( present(time_name) .and. present(returned_time) ) then
17662 if ( trim(time_name) == trim(dimname) ) then
17663 returned_time = iorange_value(1)
17664 end if
17665 end if
17666 new_range_values(j) = roundnum( tochar(iorange_value) )
17667 end do
17668 new_iorange_each(i) = &
17669 & trim(dimname) // gt_equal // joinchar(new_range_values, gt_colon)
17670 deallocate(new_range_values)
17671 deallocate(range_values)
17672 end if
17673 end do
17674 new_iorange = joinchar(new_iorange_each, gt_comma)
17675 deallocate(new_iorange_each)
17676 deallocate(iorange_each)
17677 new_url = urlmerge(file, varname, '', new_iorange)
17678 if (present(actual_url)) then
17679 actual_url = new_url
17680 else
17681 call messagenotify('M', subname, 'Input %c', c1=trim(new_url))
17682 end if
17683 call storeerror(stat, subname, err, cause_c)
17684end subroutine actual_iorange_dump
17685function file_rename_mpi( file ) result(result)
17686 use dc_types, only: string, token
17687 use dc_string, only: cprintft, lchar
17688 implicit none
17689 character(*), intent(in):: file
17690 character(STRING):: result
17691 continue
17692 result = file
17693 return
17694end function file_rename_mpi
subroutine historygetint1timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine lookup_growable_url(file, varname, url, range, flag_time_exist, time_name, err)
subroutine historygetdouble2timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine actual_iorange_dump(url, actual_url, returned_time, time_name, err)
subroutine historygetint6timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint5timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal3(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble6timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
character(string) function file_rename_mpi(file)
subroutine historygetint3pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint3pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint4pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble1timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint7pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble4(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble3timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint0pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal0pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal1pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint6pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint1(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble2pointer(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
netCDF データを入力します. gtool4 netCDF 規約に基づくデータを想定 していますが, 大抵の netCDF データの入力は可能であると期待されます.
subroutine historygetdouble0timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble7timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal2timer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal5timei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble5(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal6pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal7(file, varname, array, range, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2timed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetdouble0pointertimer(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetint2pointertimed(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
subroutine historygetreal4pointertimei(file, varname, array, time, quiet, flag_mpi_split, returned_time, flag_time_exist, err)
エラー処理用モジュール
Definition dc_error.f90:454
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition dc_error.f90:891
integer, parameter, public dc_noerr
エラー等を保持
Definition dc_error.f90:468
integer, parameter, public gt_erankmismatch
Definition dc_error.f90:524
integer, parameter, public gt_ebadgt4commagraphy
Definition dc_error.f90:526
integer, parameter, public gt_eargsizemismatch
Definition dc_error.f90:515
integer, parameter, public gt_enotvar
Definition dc_error.f90:512
integer, parameter, public gt_enoturl
Definition dc_error.f90:525
メッセージの出力
省略可能な制御パラメータの判定
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
シンプルな正規表現関数 'match' を提供します.
Definition dc_regex.f90:62
subroutine, public match(pattern, text, start, length)
Definition dc_regex.f90:469
文字型変数の操作
Definition dc_string.f90:83
character(string) function, public joinchar(carray, expr)
デバッグ時の追跡用モジュール
Definition dc_trace.f90:150
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:661
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
Definition dc_trace.f90:457
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Definition dc_trace.f90:580
種別型パラメタを提供します。
Definition dc_types.f90:55
integer, parameter, public sp
単精度実数型変数
Definition dc_types.f90:82
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
Definition dc_types.f90:128
integer, parameter, public dp
倍精度実数型変数
Definition dc_types.f90:92
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition dc_types.f90:137
変数 URL の文字列解析
Definition dc_url.f90:61
character, parameter, public gt_comma
Definition dc_url.f90:102
subroutine, public url_chop_iorange(fullname, iorange, remainder)
Definition dc_url.f90:301
character, parameter, public gt_equal
Definition dc_url.f90:104
character, parameter, public gt_colon
Definition dc_url.f90:100
character, parameter, public gt_circumflex
Definition dc_url.f90:106