32 & varinfo, attrname, value, err )
54 character(*),
intent(in):: attrname
55 character(*),
intent(in):: value
63 logical,
intent(out),
optional:: err
79 integer:: attrs_num, stat
80 character(STRING) :: name, cause_c
81 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrChar0"
84 &
'attrname=<%c>, value=<%c>', &
85 & c1=trim(attrname), c2=trim(
value))
89 if ( .not. varinfo % initialized )
then
91 cause_c =
'GT_HISTORY_VARINFO'
96 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
99 if ( .not.
associated(varinfo % attrs) )
then
100 allocate( varinfo % attrs(1) )
103 attrs_num =
size( varinfo % attrs ) + 1
105 allocate( attrs_tmp(attrs_num - 1) )
106 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
107 & to = attrs_tmp(1:attrs_num - 1))
108 deallocate( varinfo % attrs )
109 allocate( varinfo % attrs(attrs_num) )
110 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
111 & to = varinfo % attrs(1:attrs_num - 1))
112 deallocate( attrs_tmp )
115 varinfo % attrs(attrs_num) % attrname = attrname
116 varinfo % attrs(attrs_num) % attrtype =
'Char'
117 varinfo % attrs(attrs_num) % array = .false.
118 varinfo % attrs(attrs_num) % Charvalue =
value
122 call storeerror( stat, subname, err, cause_c )
129 & varinfo, attrname, value, err )
148 character(*),
intent(in):: attrname
149 character(*),
intent(in):: value
150 logical,
intent(out),
optional:: err
151 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Char0"
155 & varinfo, attrname,
value, err )
161 & varinfo, attrname, value, err )
174 character(*),
intent(in):: attrname
175 logical,
intent(in):: value
177 logical,
intent(out),
optional:: err
193 integer:: attrs_num, stat
194 character(STRING) :: name, cause_c
195 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrLogical0"
198 &
'attrname=<%c>, value=<%c>', &
199 & c1=trim(attrname), c2=trim(
tochar(
value)))
203 if ( .not. varinfo % initialized )
then
205 cause_c =
'GT_HISTORY_VARINFO'
210 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
213 if ( .not.
associated(varinfo % attrs) )
then
214 allocate( varinfo % attrs(1) )
217 attrs_num =
size( varinfo % attrs ) + 1
219 allocate( attrs_tmp(attrs_num - 1) )
220 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
221 & to = attrs_tmp(1:attrs_num - 1))
222 deallocate( varinfo % attrs )
223 allocate( varinfo % attrs(attrs_num) )
224 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
225 & to = varinfo % attrs(1:attrs_num - 1))
226 deallocate( attrs_tmp )
229 varinfo % attrs(attrs_num) % attrname = attrname
230 varinfo % attrs(attrs_num) % attrtype =
'Logical'
231 varinfo % attrs(attrs_num) % array = .false.
232 varinfo % attrs(attrs_num) % Logicalvalue =
value
236 call storeerror( stat, subname, err, cause_c )
243 & varinfo, attrname, value, err )
253 character(*),
intent(in):: attrname
254 logical,
intent(in):: value
255 logical,
intent(out),
optional:: err
256 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Logical0"
260 & varinfo, attrname,
value, err )
266 & varinfo, attrname, value, err )
279 character(*),
intent(in):: attrname
280 integer,
intent(in):: value
282 logical,
intent(out),
optional:: err
298 integer:: attrs_num, stat
299 character(STRING) :: name, cause_c
300 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrInt0"
303 &
'attrname=<%c>, value=<%c>', &
304 & c1=trim(attrname), c2=trim(
tochar(
value)))
308 if ( .not. varinfo % initialized )
then
310 cause_c =
'GT_HISTORY_VARINFO'
315 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
318 if ( .not.
associated(varinfo % attrs) )
then
319 allocate( varinfo % attrs(1) )
322 attrs_num =
size( varinfo % attrs ) + 1
324 allocate( attrs_tmp(attrs_num - 1) )
325 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
326 & to = attrs_tmp(1:attrs_num - 1))
327 deallocate( varinfo % attrs )
328 allocate( varinfo % attrs(attrs_num) )
329 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
330 & to = varinfo % attrs(1:attrs_num - 1))
331 deallocate( attrs_tmp )
334 varinfo % attrs(attrs_num) % attrname = attrname
335 varinfo % attrs(attrs_num) % attrtype =
'Int'
336 varinfo % attrs(attrs_num) % array = .false.
337 varinfo % attrs(attrs_num) % Intvalue =
value
341 call storeerror( stat, subname, err, cause_c )
348 & varinfo, attrname, value, err )
358 character(*),
intent(in):: attrname
359 integer,
intent(in):: value
360 logical,
intent(out),
optional:: err
361 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Int0"
365 & varinfo, attrname,
value, err )
371 & varinfo, attrname, value, err )
384 character(*),
intent(in):: attrname
385 integer,
intent(in)::
value(:)
387 logical,
intent(out),
optional:: err
403 integer:: attrs_num, stat
404 character(STRING) :: name, cause_c
405 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrInt1"
408 &
'attrname=<%c>, value=<%c>', &
409 & c1=trim(attrname), c2=trim(
tochar(
value)))
413 if ( .not. varinfo % initialized )
then
415 cause_c =
'GT_HISTORY_VARINFO'
420 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
423 if ( .not.
associated(varinfo % attrs) )
then
424 allocate( varinfo % attrs(1) )
427 attrs_num =
size( varinfo % attrs ) + 1
429 allocate( attrs_tmp(attrs_num - 1) )
430 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
431 & to = attrs_tmp(1:attrs_num - 1))
432 deallocate( varinfo % attrs )
433 allocate( varinfo % attrs(attrs_num) )
434 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
435 & to = varinfo % attrs(1:attrs_num - 1))
436 deallocate( attrs_tmp )
439 varinfo % attrs(attrs_num) % attrname = attrname
440 varinfo % attrs(attrs_num) % attrtype =
'Int'
441 varinfo % attrs(attrs_num) % array = .true.
442 allocate( varinfo % attrs(attrs_num) % Intarray(
size(
value) ) )
443 varinfo % attrs(attrs_num) % Intarray =
value
447 call storeerror( stat, subname, err, cause_c )
454 & varinfo, attrname, value, err )
464 character(*),
intent(in):: attrname
465 integer,
intent(in)::
value(:)
466 logical,
intent(out),
optional:: err
467 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Int1"
471 & varinfo, attrname,
value, err )
477 & varinfo, attrname, value, err )
490 character(*),
intent(in):: attrname
491 real,
intent(in):: value
493 logical,
intent(out),
optional:: err
509 integer:: attrs_num, stat
510 character(STRING) :: name, cause_c
511 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrReal0"
514 &
'attrname=<%c>, value=<%c>', &
515 & c1=trim(attrname), c2=trim(
tochar(
value)))
519 if ( .not. varinfo % initialized )
then
521 cause_c =
'GT_HISTORY_VARINFO'
526 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
529 if ( .not.
associated(varinfo % attrs) )
then
530 allocate( varinfo % attrs(1) )
533 attrs_num =
size( varinfo % attrs ) + 1
535 allocate( attrs_tmp(attrs_num - 1) )
536 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
537 & to = attrs_tmp(1:attrs_num - 1))
538 deallocate( varinfo % attrs )
539 allocate( varinfo % attrs(attrs_num) )
540 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
541 & to = varinfo % attrs(1:attrs_num - 1))
542 deallocate( attrs_tmp )
545 varinfo % attrs(attrs_num) % attrname = attrname
546 varinfo % attrs(attrs_num) % attrtype =
'Real'
547 varinfo % attrs(attrs_num) % array = .false.
548 varinfo % attrs(attrs_num) % Realvalue =
value
552 call storeerror( stat, subname, err, cause_c )
559 & varinfo, attrname, value, err )
569 character(*),
intent(in):: attrname
570 real,
intent(in):: value
571 logical,
intent(out),
optional:: err
572 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Real0"
576 & varinfo, attrname,
value, err )
582 & varinfo, attrname, value, err )
595 character(*),
intent(in):: attrname
596 real,
intent(in)::
value(:)
598 logical,
intent(out),
optional:: err
614 integer:: attrs_num, stat
615 character(STRING) :: name, cause_c
616 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrReal1"
619 &
'attrname=<%c>, value=<%c>', &
620 & c1=trim(attrname), c2=trim(
tochar(
value)))
624 if ( .not. varinfo % initialized )
then
626 cause_c =
'GT_HISTORY_VARINFO'
631 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
634 if ( .not.
associated(varinfo % attrs) )
then
635 allocate( varinfo % attrs(1) )
638 attrs_num =
size( varinfo % attrs ) + 1
640 allocate( attrs_tmp(attrs_num - 1) )
641 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
642 & to = attrs_tmp(1:attrs_num - 1))
643 deallocate( varinfo % attrs )
644 allocate( varinfo % attrs(attrs_num) )
645 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
646 & to = varinfo % attrs(1:attrs_num - 1))
647 deallocate( attrs_tmp )
650 varinfo % attrs(attrs_num) % attrname = attrname
651 varinfo % attrs(attrs_num) % attrtype =
'Real'
652 varinfo % attrs(attrs_num) % array = .true.
653 allocate( varinfo % attrs(attrs_num) % Realarray(
size(
value) ) )
654 varinfo % attrs(attrs_num) % Realarray =
value
658 call storeerror( stat, subname, err, cause_c )
665 & varinfo, attrname, value, err )
675 character(*),
intent(in):: attrname
676 real,
intent(in)::
value(:)
677 logical,
intent(out),
optional:: err
678 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Real1"
682 & varinfo, attrname,
value, err )
688 & varinfo, attrname, value, err )
701 character(*),
intent(in):: attrname
702 real(DP),
intent(in):: value
704 logical,
intent(out),
optional:: err
720 integer:: attrs_num, stat
721 character(STRING) :: name, cause_c
722 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrDouble0"
725 &
'attrname=<%c>, value=<%c>', &
726 & c1=trim(attrname), c2=trim(
tochar(
value)))
730 if ( .not. varinfo % initialized )
then
732 cause_c =
'GT_HISTORY_VARINFO'
737 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
740 if ( .not.
associated(varinfo % attrs) )
then
741 allocate( varinfo % attrs(1) )
744 attrs_num =
size( varinfo % attrs ) + 1
746 allocate( attrs_tmp(attrs_num - 1) )
747 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
748 & to = attrs_tmp(1:attrs_num - 1))
749 deallocate( varinfo % attrs )
750 allocate( varinfo % attrs(attrs_num) )
751 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
752 & to = varinfo % attrs(1:attrs_num - 1))
753 deallocate( attrs_tmp )
756 varinfo % attrs(attrs_num) % attrname = attrname
757 varinfo % attrs(attrs_num) % attrtype =
'Double'
758 varinfo % attrs(attrs_num) % array = .false.
759 varinfo % attrs(attrs_num) % Doublevalue =
value
763 call storeerror( stat, subname, err, cause_c )
770 & varinfo, attrname, value, err )
781 character(*),
intent(in):: attrname
782 real(DP),
intent(in):: value
783 logical,
intent(out),
optional:: err
784 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Double0"
788 & varinfo, attrname,
value, err )
794 & varinfo, attrname, value, err )
807 character(*),
intent(in):: attrname
808 real(DP),
intent(in)::
value(:)
810 logical,
intent(out),
optional:: err
826 integer:: attrs_num, stat
827 character(STRING) :: name, cause_c
828 character(*),
parameter:: subname =
"HistoryVarinfoAddAttrDouble1"
831 &
'attrname=<%c>, value=<%c>', &
832 & c1=trim(attrname), c2=trim(
tochar(
value)))
836 if ( .not. varinfo % initialized )
then
838 cause_c =
'GT_HISTORY_VARINFO'
843 call dbgmessage(
'varinfo name=<%c>', c1=trim(name))
846 if ( .not.
associated(varinfo % attrs) )
then
847 allocate( varinfo % attrs(1) )
850 attrs_num =
size( varinfo % attrs ) + 1
852 allocate( attrs_tmp(attrs_num - 1) )
853 call copy_attrs( from = varinfo % attrs(1:attrs_num - 1), &
854 & to = attrs_tmp(1:attrs_num - 1))
855 deallocate( varinfo % attrs )
856 allocate( varinfo % attrs(attrs_num) )
857 call copy_attrs( from = attrs_tmp(1:attrs_num - 1), &
858 & to = varinfo % attrs(1:attrs_num - 1))
859 deallocate( attrs_tmp )
862 varinfo % attrs(attrs_num) % attrname = attrname
863 varinfo % attrs(attrs_num) % attrtype =
'Double'
864 varinfo % attrs(attrs_num) % array = .true.
865 allocate( varinfo % attrs(attrs_num) % Doublearray(
size(
value) ) )
866 varinfo % attrs(attrs_num) % Doublearray =
value
870 call storeerror( stat, subname, err, cause_c )
877 & varinfo, attrname, value, err )
888 character(*),
intent(in):: attrname
889 real(DP),
intent(in)::
value(:)
890 logical,
intent(out),
optional:: err
891 character(*),
parameter:: subname =
"HistoryVarinfoAddAttr2Double1"
895 & varinfo, attrname,
value, err )
subroutine historyvarinfoaddattrlogical0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2logical0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2double0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrreal0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrdouble0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2real1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2real0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2int1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrchar0(varinfo, attrname, value, err)
GT_HISTORY_VARINFO 型変数への属性付加
subroutine historyvarinfoaddattr2char0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2int0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrdouble1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrint0(varinfo, attrname, value, err)
subroutine historyvarinfoaddattr2double1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrreal1(varinfo, attrname, value, err)
subroutine historyvarinfoaddattrint1(varinfo, attrname, value, err)
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_noerr
Error storage variables
integer, parameter, public dc_enotinit
-400 or less: DC utilities errors
Handling character types.
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
Provides kind type parameter values.
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string