69 real(DP),
pointer ::
value(:)
70 real(DP),
allocatable :: array1dim_tmp(:)
71 logical,
intent(out),
optional :: err
72 integer :: stat, n(1), cause_i, data_rank
73 logical :: invalid_check(1)
74 character(STRING) :: cause_c
75 character(*),
parameter :: subname =
'GTVarGetPointerDouble1' 83 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
88 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
90 if (.not. all(invalid_check))
then 92 data_rank = count(invalid_check)
93 cause_c = trim(
tochar(data_rank)) //
' and 1' 100 if (
associated(
value) )
then 102 & .not.
size(
value,1) == n(1) .or. &
107 call dbgmessage(
'@ value is already allocated')
115 if (
allocated(array1dim_tmp))
then 116 deallocate(array1dim_tmp)
118 allocate(array1dim_tmp(product(n)))
121 value = array1dim_tmp
123 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
139 real(DP),
pointer ::
value(:,:)
140 real(DP),
allocatable :: array1dim_tmp(:)
141 logical,
intent(out),
optional :: err
142 integer :: stat, n(2), cause_i, data_rank
143 logical :: invalid_check(2)
144 character(STRING) :: cause_c
145 character(*),
parameter :: subname =
'GTVarGetPointerDouble2' 153 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
154 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
155 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
156 invalid_check = n > 0
157 if (.not. all(invalid_check))
then 159 data_rank = count(invalid_check)
160 cause_c = trim(
tochar(data_rank)) //
' and 2' 167 if (
associated(
value) )
then 169 & .not.
size(
value,1) == n(1) .or. &
170 & .not.
size(
value,2) == n(2) .or. &
175 call dbgmessage(
'@ value is already allocated')
184 if (
allocated(array1dim_tmp))
then 185 deallocate(array1dim_tmp)
187 allocate(array1dim_tmp(product(n)))
190 value = reshape(array1dim_tmp, n)
192 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
208 real(DP),
pointer ::
value(:,:,:)
209 real(DP),
allocatable :: array1dim_tmp(:)
210 logical,
intent(out),
optional :: err
211 integer :: stat, n(3), cause_i, data_rank
212 logical :: invalid_check(3)
213 character(STRING) :: cause_c
214 character(*),
parameter :: subname =
'GTVarGetPointerDouble3' 222 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
223 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
224 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
225 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
226 invalid_check = n > 0
227 if (.not. all(invalid_check))
then 229 data_rank = count(invalid_check)
230 cause_c = trim(
tochar(data_rank)) //
' and 3' 237 if (
associated(
value) )
then 239 & .not.
size(
value,1) == n(1) .or. &
240 & .not.
size(
value,2) == n(2) .or. &
241 & .not.
size(
value,3) == n(3) .or. &
246 call dbgmessage(
'@ value is already allocated')
256 if (
allocated(array1dim_tmp))
then 257 deallocate(array1dim_tmp)
259 allocate(array1dim_tmp(product(n)))
262 value = reshape(array1dim_tmp, n)
264 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
280 real(DP),
pointer ::
value(:,:,:,:)
281 real(DP),
allocatable :: array1dim_tmp(:)
282 logical,
intent(out),
optional :: err
283 integer :: stat, n(4), cause_i, data_rank
284 logical :: invalid_check(4)
285 character(STRING) :: cause_c
286 character(*),
parameter :: subname =
'GTVarGetPointerDouble4' 294 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
295 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
296 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
297 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
298 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
299 invalid_check = n > 0
300 if (.not. all(invalid_check))
then 302 data_rank = count(invalid_check)
303 cause_c = trim(
tochar(data_rank)) //
' and 4' 310 if (
associated(
value) )
then 312 & .not.
size(
value,1) == n(1) .or. &
313 & .not.
size(
value,2) == n(2) .or. &
314 & .not.
size(
value,3) == n(3) .or. &
315 & .not.
size(
value,4) == n(4) .or. &
320 call dbgmessage(
'@ value is already allocated')
331 if (
allocated(array1dim_tmp))
then 332 deallocate(array1dim_tmp)
334 allocate(array1dim_tmp(product(n)))
337 value = reshape(array1dim_tmp, n)
339 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
355 real(DP),
pointer ::
value(:,:,:,:,:)
356 real(DP),
allocatable :: array1dim_tmp(:)
357 logical,
intent(out),
optional :: err
358 integer :: stat, n(5), cause_i, data_rank
359 logical :: invalid_check(5)
360 character(STRING) :: cause_c
361 character(*),
parameter :: subname =
'GTVarGetPointerDouble5' 369 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
370 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
371 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
372 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
373 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
374 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
375 invalid_check = n > 0
376 if (.not. all(invalid_check))
then 378 data_rank = count(invalid_check)
379 cause_c = trim(
tochar(data_rank)) //
' and 5' 386 if (
associated(
value) )
then 388 & .not.
size(
value,1) == n(1) .or. &
389 & .not.
size(
value,2) == n(2) .or. &
390 & .not.
size(
value,3) == n(3) .or. &
391 & .not.
size(
value,4) == n(4) .or. &
392 & .not.
size(
value,5) == n(5) .or. &
397 call dbgmessage(
'@ value is already allocated')
409 if (
allocated(array1dim_tmp))
then 410 deallocate(array1dim_tmp)
412 allocate(array1dim_tmp(product(n)))
415 value = reshape(array1dim_tmp, n)
417 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
433 real(DP),
pointer ::
value(:,:,:,:,:,:)
434 real(DP),
allocatable :: array1dim_tmp(:)
435 logical,
intent(out),
optional :: err
436 integer :: stat, n(6), cause_i, data_rank
437 logical :: invalid_check(6)
438 character(STRING) :: cause_c
439 character(*),
parameter :: subname =
'GTVarGetPointerDouble6' 447 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
448 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
449 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
450 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
451 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
452 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
453 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
454 invalid_check = n > 0
455 if (.not. all(invalid_check))
then 457 data_rank = count(invalid_check)
458 cause_c = trim(
tochar(data_rank)) //
' and 6' 465 if (
associated(
value) )
then 467 & .not.
size(
value,1) == n(1) .or. &
468 & .not.
size(
value,2) == n(2) .or. &
469 & .not.
size(
value,3) == n(3) .or. &
470 & .not.
size(
value,4) == n(4) .or. &
471 & .not.
size(
value,5) == n(5) .or. &
472 & .not.
size(
value,6) == n(6) .or. &
477 call dbgmessage(
'@ value is already allocated')
490 if (
allocated(array1dim_tmp))
then 491 deallocate(array1dim_tmp)
493 allocate(array1dim_tmp(product(n)))
496 value = reshape(array1dim_tmp, n)
498 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
514 real(DP),
pointer ::
value(:,:,:,:,:,:,:)
515 real(DP),
allocatable :: array1dim_tmp(:)
516 logical,
intent(out),
optional :: err
517 integer :: stat, n(7), cause_i, data_rank
518 logical :: invalid_check(7)
519 character(STRING) :: cause_c
520 character(*),
parameter :: subname =
'GTVarGetPointerDouble7' 528 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
529 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
530 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
531 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
532 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
533 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
534 call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
535 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
536 invalid_check = n > 0
537 if (.not. all(invalid_check))
then 539 data_rank = count(invalid_check)
540 cause_c = trim(
tochar(data_rank)) //
' and 7' 547 if (
associated(
value) )
then 549 & .not.
size(
value,1) == n(1) .or. &
550 & .not.
size(
value,2) == n(2) .or. &
551 & .not.
size(
value,3) == n(3) .or. &
552 & .not.
size(
value,4) == n(4) .or. &
553 & .not.
size(
value,5) == n(5) .or. &
554 & .not.
size(
value,6) == n(6) .or. &
555 & .not.
size(
value,7) == n(7) .or. &
560 call dbgmessage(
'@ value is already allocated')
574 if (
allocated(array1dim_tmp))
then 575 deallocate(array1dim_tmp)
577 allocate(array1dim_tmp(product(n)))
580 value = reshape(array1dim_tmp, n)
582 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
598 real(SP),
pointer ::
value(:)
599 real(SP),
allocatable :: array1dim_tmp(:)
600 logical,
intent(out),
optional :: err
601 integer :: stat, n(1), cause_i, data_rank
602 logical :: invalid_check(1)
603 character(STRING) :: cause_c
604 character(*),
parameter :: subname =
'GTVarGetPointerReal1' 612 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
617 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
618 invalid_check = n > 0
619 if (.not. all(invalid_check))
then 621 data_rank = count(invalid_check)
622 cause_c = trim(
tochar(data_rank)) //
' and 1' 629 if (
associated(
value) )
then 631 & .not.
size(
value,1) == n(1) .or. &
636 call dbgmessage(
'@ value is already allocated')
644 if (
allocated(array1dim_tmp))
then 645 deallocate(array1dim_tmp)
647 allocate(array1dim_tmp(product(n)))
650 value = array1dim_tmp
652 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
668 real(SP),
pointer ::
value(:,:)
669 real(SP),
allocatable :: array1dim_tmp(:)
670 logical,
intent(out),
optional :: err
671 integer :: stat, n(2), cause_i, data_rank
672 logical :: invalid_check(2)
673 character(STRING) :: cause_c
674 character(*),
parameter :: subname =
'GTVarGetPointerReal2' 682 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
683 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
684 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
685 invalid_check = n > 0
686 if (.not. all(invalid_check))
then 688 data_rank = count(invalid_check)
689 cause_c = trim(
tochar(data_rank)) //
' and 2' 696 if (
associated(
value) )
then 698 & .not.
size(
value,1) == n(1) .or. &
699 & .not.
size(
value,2) == n(2) .or. &
704 call dbgmessage(
'@ value is already allocated')
713 if (
allocated(array1dim_tmp))
then 714 deallocate(array1dim_tmp)
716 allocate(array1dim_tmp(product(n)))
719 value = reshape(array1dim_tmp, n)
721 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
737 real(SP),
pointer ::
value(:,:,:)
738 real(SP),
allocatable :: array1dim_tmp(:)
739 logical,
intent(out),
optional :: err
740 integer :: stat, n(3), cause_i, data_rank
741 logical :: invalid_check(3)
742 character(STRING) :: cause_c
743 character(*),
parameter :: subname =
'GTVarGetPointerReal3' 751 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
752 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
753 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
754 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
755 invalid_check = n > 0
756 if (.not. all(invalid_check))
then 758 data_rank = count(invalid_check)
759 cause_c = trim(
tochar(data_rank)) //
' and 3' 766 if (
associated(
value) )
then 768 & .not.
size(
value,1) == n(1) .or. &
769 & .not.
size(
value,2) == n(2) .or. &
770 & .not.
size(
value,3) == n(3) .or. &
775 call dbgmessage(
'@ value is already allocated')
785 if (
allocated(array1dim_tmp))
then 786 deallocate(array1dim_tmp)
788 allocate(array1dim_tmp(product(n)))
791 value = reshape(array1dim_tmp, n)
793 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
809 real(SP),
pointer ::
value(:,:,:,:)
810 real(SP),
allocatable :: array1dim_tmp(:)
811 logical,
intent(out),
optional :: err
812 integer :: stat, n(4), cause_i, data_rank
813 logical :: invalid_check(4)
814 character(STRING) :: cause_c
815 character(*),
parameter :: subname =
'GTVarGetPointerReal4' 823 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
824 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
825 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
826 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
827 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
828 invalid_check = n > 0
829 if (.not. all(invalid_check))
then 831 data_rank = count(invalid_check)
832 cause_c = trim(
tochar(data_rank)) //
' and 4' 839 if (
associated(
value) )
then 841 & .not.
size(
value,1) == n(1) .or. &
842 & .not.
size(
value,2) == n(2) .or. &
843 & .not.
size(
value,3) == n(3) .or. &
844 & .not.
size(
value,4) == n(4) .or. &
849 call dbgmessage(
'@ value is already allocated')
860 if (
allocated(array1dim_tmp))
then 861 deallocate(array1dim_tmp)
863 allocate(array1dim_tmp(product(n)))
866 value = reshape(array1dim_tmp, n)
868 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
884 real(SP),
pointer ::
value(:,:,:,:,:)
885 real(SP),
allocatable :: array1dim_tmp(:)
886 logical,
intent(out),
optional :: err
887 integer :: stat, n(5), cause_i, data_rank
888 logical :: invalid_check(5)
889 character(STRING) :: cause_c
890 character(*),
parameter :: subname =
'GTVarGetPointerReal5' 898 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
899 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
900 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
901 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
902 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
903 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
904 invalid_check = n > 0
905 if (.not. all(invalid_check))
then 907 data_rank = count(invalid_check)
908 cause_c = trim(
tochar(data_rank)) //
' and 5' 915 if (
associated(
value) )
then 917 & .not.
size(
value,1) == n(1) .or. &
918 & .not.
size(
value,2) == n(2) .or. &
919 & .not.
size(
value,3) == n(3) .or. &
920 & .not.
size(
value,4) == n(4) .or. &
921 & .not.
size(
value,5) == n(5) .or. &
926 call dbgmessage(
'@ value is already allocated')
938 if (
allocated(array1dim_tmp))
then 939 deallocate(array1dim_tmp)
941 allocate(array1dim_tmp(product(n)))
944 value = reshape(array1dim_tmp, n)
946 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
962 real(SP),
pointer ::
value(:,:,:,:,:,:)
963 real(SP),
allocatable :: array1dim_tmp(:)
964 logical,
intent(out),
optional :: err
965 integer :: stat, n(6), cause_i, data_rank
966 logical :: invalid_check(6)
967 character(STRING) :: cause_c
968 character(*),
parameter :: subname =
'GTVarGetPointerReal6' 976 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
977 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
978 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
979 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
980 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
981 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
982 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
983 invalid_check = n > 0
984 if (.not. all(invalid_check))
then 986 data_rank = count(invalid_check)
987 cause_c = trim(
tochar(data_rank)) //
' and 6' 994 if (
associated(
value) )
then 996 & .not.
size(
value,1) == n(1) .or. &
997 & .not.
size(
value,2) == n(2) .or. &
998 & .not.
size(
value,3) == n(3) .or. &
999 & .not.
size(
value,4) == n(4) .or. &
1000 & .not.
size(
value,5) == n(5) .or. &
1001 & .not.
size(
value,6) == n(6) .or. &
1006 call dbgmessage(
'@ value is already allocated')
1019 if (
allocated(array1dim_tmp))
then 1020 deallocate(array1dim_tmp)
1022 allocate(array1dim_tmp(product(n)))
1025 value = reshape(array1dim_tmp, n)
1027 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1043 real(SP),
pointer ::
value(:,:,:,:,:,:,:)
1044 real(SP),
allocatable :: array1dim_tmp(:)
1045 logical,
intent(out),
optional :: err
1046 integer :: stat, n(7), cause_i, data_rank
1047 logical :: invalid_check(7)
1048 character(STRING) :: cause_c
1049 character(*),
parameter :: subname =
'GTVarGetPointerReal7' 1057 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1058 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1059 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1060 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
1061 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
1062 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
1063 call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
1064 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1065 invalid_check = n > 0
1066 if (.not. all(invalid_check))
then 1068 data_rank = count(invalid_check)
1069 cause_c = trim(
tochar(data_rank)) //
' and 7' 1076 if (
associated(
value) )
then 1078 & .not.
size(
value,1) == n(1) .or. &
1079 & .not.
size(
value,2) == n(2) .or. &
1080 & .not.
size(
value,3) == n(3) .or. &
1081 & .not.
size(
value,4) == n(4) .or. &
1082 & .not.
size(
value,5) == n(5) .or. &
1083 & .not.
size(
value,6) == n(6) .or. &
1084 & .not.
size(
value,7) == n(7) .or. &
1089 call dbgmessage(
'@ value is already allocated')
1103 if (
allocated(array1dim_tmp))
then 1104 deallocate(array1dim_tmp)
1106 allocate(array1dim_tmp(product(n)))
1109 value = reshape(array1dim_tmp, n)
1111 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1127 integer,
pointer ::
value(:)
1128 integer,
allocatable :: array1dim_tmp(:)
1129 logical,
intent(out),
optional :: err
1130 integer :: stat, n(1), cause_i, data_rank
1131 logical :: invalid_check(1)
1132 character(STRING) :: cause_c
1133 character(*),
parameter :: subname =
'GTVarGetPointerInt1' 1141 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1146 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1147 invalid_check = n > 0
1148 if (.not. all(invalid_check))
then 1150 data_rank = count(invalid_check)
1151 cause_c = trim(
tochar(data_rank)) //
' and 1' 1158 if (
associated(
value) )
then 1160 & .not.
size(
value,1) == n(1) .or. &
1165 call dbgmessage(
'@ value is already allocated')
1173 if (
allocated(array1dim_tmp))
then 1174 deallocate(array1dim_tmp)
1176 allocate(array1dim_tmp(product(n)))
1177 call gtvargetint(var, array1dim_tmp, product(n), err)
1179 value = array1dim_tmp
1181 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1197 integer,
pointer ::
value(:,:)
1198 integer,
allocatable :: array1dim_tmp(:)
1199 logical,
intent(out),
optional :: err
1200 integer :: stat, n(2), cause_i, data_rank
1201 logical :: invalid_check(2)
1202 character(STRING) :: cause_c
1203 character(*),
parameter :: subname =
'GTVarGetPointerInt2' 1211 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1212 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1213 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1214 invalid_check = n > 0
1215 if (.not. all(invalid_check))
then 1217 data_rank = count(invalid_check)
1218 cause_c = trim(
tochar(data_rank)) //
' and 2' 1225 if (
associated(
value) )
then 1227 & .not.
size(
value,1) == n(1) .or. &
1228 & .not.
size(
value,2) == n(2) .or. &
1233 call dbgmessage(
'@ value is already allocated')
1242 if (
allocated(array1dim_tmp))
then 1243 deallocate(array1dim_tmp)
1245 allocate(array1dim_tmp(product(n)))
1246 call gtvargetint(var, array1dim_tmp, product(n), err)
1248 value = reshape(array1dim_tmp, n)
1250 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1266 integer,
pointer ::
value(:,:,:)
1267 integer,
allocatable :: array1dim_tmp(:)
1268 logical,
intent(out),
optional :: err
1269 integer :: stat, n(3), cause_i, data_rank
1270 logical :: invalid_check(3)
1271 character(STRING) :: cause_c
1272 character(*),
parameter :: subname =
'GTVarGetPointerInt3' 1280 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1281 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1282 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1283 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1284 invalid_check = n > 0
1285 if (.not. all(invalid_check))
then 1287 data_rank = count(invalid_check)
1288 cause_c = trim(
tochar(data_rank)) //
' and 3' 1295 if (
associated(
value) )
then 1297 & .not.
size(
value,1) == n(1) .or. &
1298 & .not.
size(
value,2) == n(2) .or. &
1299 & .not.
size(
value,3) == n(3) .or. &
1304 call dbgmessage(
'@ value is already allocated')
1314 if (
allocated(array1dim_tmp))
then 1315 deallocate(array1dim_tmp)
1317 allocate(array1dim_tmp(product(n)))
1318 call gtvargetint(var, array1dim_tmp, product(n), err)
1320 value = reshape(array1dim_tmp, n)
1322 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1338 integer,
pointer ::
value(:,:,:,:)
1339 integer,
allocatable :: array1dim_tmp(:)
1340 logical,
intent(out),
optional :: err
1341 integer :: stat, n(4), cause_i, data_rank
1342 logical :: invalid_check(4)
1343 character(STRING) :: cause_c
1344 character(*),
parameter :: subname =
'GTVarGetPointerInt4' 1352 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1353 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1354 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1355 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
1356 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1357 invalid_check = n > 0
1358 if (.not. all(invalid_check))
then 1360 data_rank = count(invalid_check)
1361 cause_c = trim(
tochar(data_rank)) //
' and 4' 1368 if (
associated(
value) )
then 1370 & .not.
size(
value,1) == n(1) .or. &
1371 & .not.
size(
value,2) == n(2) .or. &
1372 & .not.
size(
value,3) == n(3) .or. &
1373 & .not.
size(
value,4) == n(4) .or. &
1378 call dbgmessage(
'@ value is already allocated')
1389 if (
allocated(array1dim_tmp))
then 1390 deallocate(array1dim_tmp)
1392 allocate(array1dim_tmp(product(n)))
1393 call gtvargetint(var, array1dim_tmp, product(n), err)
1395 value = reshape(array1dim_tmp, n)
1397 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1413 integer,
pointer ::
value(:,:,:,:,:)
1414 integer,
allocatable :: array1dim_tmp(:)
1415 logical,
intent(out),
optional :: err
1416 integer :: stat, n(5), cause_i, data_rank
1417 logical :: invalid_check(5)
1418 character(STRING) :: cause_c
1419 character(*),
parameter :: subname =
'GTVarGetPointerInt5' 1427 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1428 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1429 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1430 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
1431 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
1432 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1433 invalid_check = n > 0
1434 if (.not. all(invalid_check))
then 1436 data_rank = count(invalid_check)
1437 cause_c = trim(
tochar(data_rank)) //
' and 5' 1444 if (
associated(
value) )
then 1446 & .not.
size(
value,1) == n(1) .or. &
1447 & .not.
size(
value,2) == n(2) .or. &
1448 & .not.
size(
value,3) == n(3) .or. &
1449 & .not.
size(
value,4) == n(4) .or. &
1450 & .not.
size(
value,5) == n(5) .or. &
1455 call dbgmessage(
'@ value is already allocated')
1467 if (
allocated(array1dim_tmp))
then 1468 deallocate(array1dim_tmp)
1470 allocate(array1dim_tmp(product(n)))
1471 call gtvargetint(var, array1dim_tmp, product(n), err)
1473 value = reshape(array1dim_tmp, n)
1475 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1491 integer,
pointer ::
value(:,:,:,:,:,:)
1492 integer,
allocatable :: array1dim_tmp(:)
1493 logical,
intent(out),
optional :: err
1494 integer :: stat, n(6), cause_i, data_rank
1495 logical :: invalid_check(6)
1496 character(STRING) :: cause_c
1497 character(*),
parameter :: subname =
'GTVarGetPointerInt6' 1505 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1506 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1507 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1508 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
1509 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
1510 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
1511 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1512 invalid_check = n > 0
1513 if (.not. all(invalid_check))
then 1515 data_rank = count(invalid_check)
1516 cause_c = trim(
tochar(data_rank)) //
' and 6' 1523 if (
associated(
value) )
then 1525 & .not.
size(
value,1) == n(1) .or. &
1526 & .not.
size(
value,2) == n(2) .or. &
1527 & .not.
size(
value,3) == n(3) .or. &
1528 & .not.
size(
value,4) == n(4) .or. &
1529 & .not.
size(
value,5) == n(5) .or. &
1530 & .not.
size(
value,6) == n(6) .or. &
1535 call dbgmessage(
'@ value is already allocated')
1548 if (
allocated(array1dim_tmp))
then 1549 deallocate(array1dim_tmp)
1551 allocate(array1dim_tmp(product(n)))
1552 call gtvargetint(var, array1dim_tmp, product(n), err)
1554 value = reshape(array1dim_tmp, n)
1556 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
1572 integer,
pointer ::
value(:,:,:,:,:,:,:)
1573 integer,
allocatable :: array1dim_tmp(:)
1574 logical,
intent(out),
optional :: err
1575 integer :: stat, n(7), cause_i, data_rank
1576 logical :: invalid_check(7)
1577 character(STRING) :: cause_c
1578 character(*),
parameter :: subname =
'GTVarGetPointerInt7' 1586 call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
1587 call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
1588 call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
1589 call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
1590 call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
1591 call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
1592 call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
1593 call dbgmessage(
'n(:)=%*d', i=n, n=(/
size(n)/))
1594 invalid_check = n > 0
1595 if (.not. all(invalid_check))
then 1597 data_rank = count(invalid_check)
1598 cause_c = trim(
tochar(data_rank)) //
' and 7' 1605 if (
associated(
value) )
then 1607 & .not.
size(
value,1) == n(1) .or. &
1608 & .not.
size(
value,2) == n(2) .or. &
1609 & .not.
size(
value,3) == n(3) .or. &
1610 & .not.
size(
value,4) == n(4) .or. &
1611 & .not.
size(
value,5) == n(5) .or. &
1612 & .not.
size(
value,6) == n(6) .or. &
1613 & .not.
size(
value,7) == n(7) .or. &
1618 call dbgmessage(
'@ value is already allocated')
1632 if (
allocated(array1dim_tmp))
then 1633 deallocate(array1dim_tmp)
1635 allocate(array1dim_tmp(product(n)))
1636 call gtvargetint(var, array1dim_tmp, product(n), err)
1638 value = reshape(array1dim_tmp, n)
1640 call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)
subroutine gtvargetpointerdouble1(var, value, err)
subroutine gtvargetpointerdouble3(var, value, err)
subroutine gtvargetpointerdouble7(var, value, err)
integer, parameter, public gt_erankmismatch
subroutine gtvargetpointerint2(var, value, err)
subroutine gtvargetpointerreal7(var, value, err)
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
subroutine gtvargetdouble(var, value, nvalue, err)
subroutine gtvargetpointerreal5(var, value, err)
subroutine gtvargetpointerint3(var, value, err)
subroutine gtvargetpointerreal1(var, value, err)
subroutine map_set_rank(var, rank, stat)
integer, parameter, public dp
倍精度実数型変数
subroutine gtvargetpointerreal3(var, value, err)
subroutine gtvargetint(var, value, nvalue, err)
subroutine, public dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
subroutine gtvargetpointerint6(var, value, err)
subroutine gtvargetpointerreal2(var, value, err)
integer, parameter, public gt_ebadallocatesize
subroutine gtvargetpointerint5(var, value, err)
subroutine gtvargetpointerint7(var, value, err)
subroutine gtvargetpointerdouble5(var, value, err)
integer, parameter, public sp
単精度実数型変数
subroutine gtvargetpointerdouble2(var, value, err)
subroutine gtvargetpointerdouble6(var, value, err)
subroutine gtvargetpointerreal6(var, value, err)
subroutine gtvargetpointerdouble4(var, value, err)
subroutine gtvargetpointerint1(var, value, err)
integer, parameter, public gt_enomoredims
subroutine gtvargetpointerreal4(var, value, err)
subroutine gtvargetreal(var, value, nvalue, err)
subroutine gtvargetpointerint4(var, value, err)
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ