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
integer, parameter, public stdout
標準出力の装置番号
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
integer, parameter, public dp
倍精度実数型変数
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ