24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
45 use dc_trace, only: beginsub, endsub
46 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
47 use dc_present, only: present_and_not_empty, present_and_true
50 implicit none
51 type(GTHST_NMLINFO), intent(in):: gthstnml
52 character(*), intent(in), optional:: name
53
54
55
56
57
58 character(*), intent(out), optional:: file
59
60
61 real(DP), intent(out), optional:: interval_value
62
63
64
65
66
67 character(*), intent(out), optional:: interval_unit
68
69
70 character(*), intent(out), optional:: precision
71
72
73 logical, intent(out), optional:: time_average
74
75
76 logical, intent(out), optional:: average
77
78
79 character(*), intent(out), optional:: fileprefix
80
81
82 real(DP), intent(out), optional:: origin_value
83
84
85 character(*), intent(out), optional:: origin_unit
86
87
88 real(DP), intent(out), optional:: terminus_value
89
90
91 character(*), intent(out), optional:: terminus_unit
92
93
94 integer, intent(out), optional:: slice_start(:)
95
96
97 integer, intent(out), optional:: slice_end(:)
98
99
100 integer, intent(out), optional:: slice_stride(:)
101
102
103 logical, intent(out), optional:: space_average(:)
104
105
106 integer, intent(out), optional:: newfile_intvalue
107
108
109 character(*), intent(out), optional:: newfile_intunit
110
111
112
113 logical, intent(out), optional:: err
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
132 character(STRING):: name_work
133 integer:: stat, ary_size
134 character(STRING):: cause_c
135 character(*), parameter:: subname = 'HstNmlInfoInquire'
136 continue
137 call beginsub( subname )
139 cause_c = ''
140
141
142
143
144
145 if ( .not. gthstnml % initialized ) then
147 cause_c = 'GTHST_NMLINFO'
148 goto 999
149 end if
150
151
152
153
154
155 if ( present(name) ) then
156 name_work = name
157 else
158 name_work = ''
159 end if
160 hptr => gthstnml % gthstnml_list
162 & name = name_work )
163
164 if ( .not. associated( hptr ) ) then
166 cause_c = adjustl( name_work )
167 goto 999
168 end if
169
170 if ( hptr % name == '' ) then
171 if ( present(file) ) file = ''
172 else
173 if ( present(file) ) file = trim( hptr % fileprefix ) // hptr % file
174 end if
175 if ( present(interval_value) ) interval_value = hptr % interval_value
176 if ( present(interval_unit) ) interval_unit = hptr % interval_unit
177 if ( present(precision) ) precision = hptr % precision
178 if ( present(average) ) average = hptr % time_average
179 if ( present(time_average) ) time_average = hptr % time_average
180 if ( present(fileprefix) ) fileprefix = hptr % fileprefix
181
182 if ( present(origin_value ) ) origin_value = hptr % origin_value
183 if ( present(origin_unit ) ) origin_unit = hptr % origin_unit
184 if ( present(terminus_value ) ) terminus_value = hptr % terminus_value
185 if ( present(terminus_unit ) ) terminus_unit = hptr % terminus_unit
186 if ( present(slice_start ) ) then
187 ary_size = size(slice_start)
188 slice_start = hptr % slice_start(1:ary_size)
189 end if
190 if ( present(slice_end ) ) then
191 ary_size = size(slice_end)
192 slice_end = hptr % slice_end(1:ary_size)
193 end if
194 if ( present(slice_stride ) ) then
195 ary_size = size(slice_stride)
196 slice_stride = hptr % slice_stride(1:ary_size)
197 end if
198 if ( present(space_average ) ) then
199 ary_size = size(space_average)
200 space_average = hptr % space_average(1:ary_size)
201 end if
202 if ( present(newfile_intvalue) ) newfile_intvalue = hptr % newfile_intvalue
203 if ( present(newfile_intunit ) ) newfile_intunit = hptr % newfile_intunit
204
205 nullify( hptr )
206
207
208
209
210
211999 continue
212 call storeerror( stat, subname, err, cause_c )
213 call endsub( subname )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
integer, parameter, public dc_earglack
integer, parameter, public dc_noerr
integer, parameter, public dc_enoentry
Provides kind type parameter values.
integer, parameter, public stdout
Unit number for Standard OUTPUT
integer, parameter, public token
Character length for word, token
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string