12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
52 use dc_trace, only: beginsub, endsub
53 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
56 implicit none
57 type(GTHST_NMLINFO), intent(in):: gthstnml
58 character(*), intent(in):: name
59
60
61
62
63
64 type(GT_HISTORY), pointer:: history
65
66
67
68
69 logical, intent(out), optional:: err
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
88 integer:: stat
89 character(STRING):: cause_c
90 character(*), parameter:: subname = 'HstNmlInfoAssocGtHist'
91 continue
92 call beginsub( subname )
94 cause_c = ''
95
96
97
98
99
100 if ( .not. gthstnml % initialized ) then
102 cause_c = 'GTHST_NMLINFO'
103 goto 999
104 end if
105
106 if ( trim( name ) == '' ) then
108 cause_c = ''
109 goto 999
110 end if
111
112 if ( gthstnml % define_mode ) then
114 cause_c = 'AssocGtHist'
115 goto 999
116 end if
117
118
119
120
121
122 hptr => gthstnml % gthstnml_list
124 & name = name )
125
126 if ( .not. associated( hptr ) ) then
128 cause_c = adjustl( name )
129 goto 999
130 end if
131
132 nullify( history )
133 history => hptr % history
134
135 nullify( hptr )
136
137
138
139
140
141999 continue
142 call storeerror( stat, subname, err, cause_c )
143 call endsub( subname )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
integer, parameter, public dc_noerr
integer, parameter, public hst_eindefine
integer, parameter, public hst_ebadname
integer, parameter, public dc_enoentry
Provides kind type parameter values.
integer, parameter, public token
Character length for word, token
integer, parameter, public string
Character length for string
integer, parameter, public stdout
Unit number for Standard OUTPUT
integer, parameter, public dp
Double Precision Real number