1 | MODULE mod_attribut |
---|
2 | USE mod_xmlio_parameters |
---|
3 | USE mod_attribut_list |
---|
4 | USE mod_stdtype |
---|
5 | USE string_function |
---|
6 | |
---|
7 | TYPE, PUBLIC :: attribut |
---|
8 | INTEGER :: object |
---|
9 | INTEGER :: name |
---|
10 | INTEGER :: type |
---|
11 | INTEGER :: dim(7) |
---|
12 | INTEGER :: ndim |
---|
13 | INTEGER,POINTER :: integer0_ptr |
---|
14 | INTEGER,POINTER :: integer1_ptr(:) |
---|
15 | INTEGER,POINTER :: integer2_ptr(:,:) |
---|
16 | REAL,POINTER :: real0_ptr |
---|
17 | REAL,POINTER :: real1_ptr(:) |
---|
18 | REAL,POINTER :: real2_ptr(:,:) |
---|
19 | LOGICAL,POINTER :: logical0_ptr |
---|
20 | LOGICAL,POINTER :: logical1_ptr(:) |
---|
21 | LOGICAL,POINTER :: logical2_ptr(:,:) |
---|
22 | |
---|
23 | CHARACTER(LEN=str_len),POINTER :: string0_ptr |
---|
24 | CHARACTER(LEN=str_len),POINTER :: string1_ptr(:) |
---|
25 | CHARACTER(LEN=str_len),POINTER :: string2_ptr(:,:) |
---|
26 | INTEGER :: string_len |
---|
27 | |
---|
28 | END TYPE attribut |
---|
29 | |
---|
30 | INTERFACE attr |
---|
31 | MODULE PROCEDURE attr_int0,attr_int1,attr_int2, & |
---|
32 | attr_real0,attr_real1,attr_real2, & |
---|
33 | attr_logical0,attr_logical1,attr_logical2, & |
---|
34 | attr_string0,attr_string1,attr_string2 |
---|
35 | END INTERFACE |
---|
36 | |
---|
37 | CONTAINS |
---|
38 | |
---|
39 | FUNCTION attr_get_object(attr_name) |
---|
40 | USE mod_attribut_list |
---|
41 | USE mod_object |
---|
42 | USE error_msg |
---|
43 | IMPLICIT NONE |
---|
44 | INTEGER, INTENT(IN) :: attr_name |
---|
45 | INTEGER :: attr_get_object |
---|
46 | |
---|
47 | IF (attr_name > field__begin .AND. attr_name < field__end) THEN |
---|
48 | attr_get_object=field_object |
---|
49 | RETURN |
---|
50 | ENDIF |
---|
51 | |
---|
52 | IF (attr_name > file__begin .AND. attr_name < file__end) THEN |
---|
53 | attr_get_object=file_object |
---|
54 | RETURN |
---|
55 | ENDIF |
---|
56 | |
---|
57 | IF (attr_name > grid__begin .AND. attr_name < grid__end) THEN |
---|
58 | attr_get_object=grid_object |
---|
59 | RETURN |
---|
60 | ENDIF |
---|
61 | |
---|
62 | IF (attr_name > axis__begin .AND. attr_name < axis__end) THEN |
---|
63 | attr_get_object=axis_object |
---|
64 | RETURN |
---|
65 | ENDIF |
---|
66 | |
---|
67 | IF (attr_name > zoom__begin .AND. attr_name < zoom__end) THEN |
---|
68 | attr_get_object=zoom_object |
---|
69 | RETURN |
---|
70 | ENDIF |
---|
71 | |
---|
72 | WRITE (message,*) 'Attribut name value :',attr_name,'is undefined' |
---|
73 | CALL error("mod_attributd::attr_get_object") |
---|
74 | |
---|
75 | END FUNCTION attr_get_object |
---|
76 | |
---|
77 | SUBROUTINE attr_deallocate(attrib) |
---|
78 | IMPLICIT NONE |
---|
79 | TYPE(attribut) :: attrib |
---|
80 | |
---|
81 | SELECT CASE(attrib%type) |
---|
82 | CASE (integer0) |
---|
83 | DEALLOCATE(attrib%integer0_ptr) |
---|
84 | CASE (integer1) |
---|
85 | DEALLOCATE(attrib%integer1_ptr) |
---|
86 | CASE (integer2) |
---|
87 | DEALLOCATE(attrib%integer2_ptr) |
---|
88 | CASE (real0) |
---|
89 | DEALLOCATE(attrib%real0_ptr) |
---|
90 | CASE (real1) |
---|
91 | DEALLOCATE(attrib%real1_ptr) |
---|
92 | CASE (real2) |
---|
93 | DEALLOCATE(attrib%real2_ptr) |
---|
94 | CASE (logical0) |
---|
95 | DEALLOCATE(attrib%logical0_ptr) |
---|
96 | CASE (logical1) |
---|
97 | DEALLOCATE(attrib%logical1_ptr) |
---|
98 | CASE (logical2) |
---|
99 | DEALLOCATE(attrib%logical2_ptr) |
---|
100 | CASE (string0) |
---|
101 | DEALLOCATE(attrib%string0_ptr) |
---|
102 | CASE (string1) |
---|
103 | DEALLOCATE(attrib%string1_ptr) |
---|
104 | CASE (string2) |
---|
105 | DEALLOCATE(attrib%string2_ptr) |
---|
106 | END SELECT |
---|
107 | |
---|
108 | END SUBROUTINE attr_deallocate |
---|
109 | |
---|
110 | FUNCTION attr_int0(attr_name,value) |
---|
111 | USE mod_stdtype |
---|
112 | IMPLICIT NONE |
---|
113 | INTEGER :: attr_name |
---|
114 | INTEGER,TARGET :: value |
---|
115 | |
---|
116 | TYPE(attribut) :: attr_int0 |
---|
117 | attr_int0%object=attr_get_object(attr_name) |
---|
118 | attr_int0%name=attr_name |
---|
119 | attr_int0%type=integer0 |
---|
120 | attr_int0%integer0_ptr=>value |
---|
121 | |
---|
122 | END FUNCTION attr_int0 |
---|
123 | |
---|
124 | FUNCTION attr_int1(attr_name,value) |
---|
125 | USE mod_stdtype |
---|
126 | IMPLICIT NONE |
---|
127 | INTEGER :: attr_name |
---|
128 | INTEGER,TARGET :: value(:) |
---|
129 | |
---|
130 | TYPE(attribut) :: attr_int1 |
---|
131 | attr_int1%object=attr_get_object(attr_name) |
---|
132 | attr_int1%name=attr_name |
---|
133 | attr_int1%type=integer1 |
---|
134 | attr_int1%integer1_ptr=>value |
---|
135 | |
---|
136 | END FUNCTION attr_int1 |
---|
137 | |
---|
138 | FUNCTION attr_int2(attr_name,value) |
---|
139 | USE mod_stdtype |
---|
140 | IMPLICIT NONE |
---|
141 | INTEGER :: attr_name |
---|
142 | INTEGER,TARGET :: value(:,:) |
---|
143 | |
---|
144 | TYPE(attribut) :: attr_int2 |
---|
145 | attr_int2%object=attr_get_object(attr_name) |
---|
146 | attr_int2%name=attr_name |
---|
147 | attr_int2%type=integer2 |
---|
148 | attr_int2%integer2_ptr=>value |
---|
149 | |
---|
150 | END FUNCTION attr_int2 |
---|
151 | |
---|
152 | |
---|
153 | FUNCTION attr_real0(attr_name,value) |
---|
154 | USE mod_stdtype |
---|
155 | IMPLICIT NONE |
---|
156 | INTEGER :: attr_name |
---|
157 | REAL,TARGET :: value |
---|
158 | |
---|
159 | TYPE(attribut) :: attr_real0 |
---|
160 | attr_real0%object=attr_get_object(attr_name) |
---|
161 | attr_real0%name=attr_name |
---|
162 | attr_real0%type=real0 |
---|
163 | attr_real0%real0_ptr=>value |
---|
164 | |
---|
165 | END FUNCTION attr_real0 |
---|
166 | |
---|
167 | FUNCTION attr_real1(attr_name,value) |
---|
168 | USE mod_stdtype |
---|
169 | IMPLICIT NONE |
---|
170 | INTEGER :: attr_name |
---|
171 | REAL,TARGET :: value(:) |
---|
172 | |
---|
173 | TYPE(attribut) :: attr_real1 |
---|
174 | attr_real1%object=attr_get_object(attr_name) |
---|
175 | attr_real1%name=attr_name |
---|
176 | attr_real1%type=real1 |
---|
177 | attr_real1%real1_ptr=>value |
---|
178 | |
---|
179 | END FUNCTION attr_real1 |
---|
180 | |
---|
181 | FUNCTION attr_real2(attr_name,value) |
---|
182 | USE mod_stdtype |
---|
183 | IMPLICIT NONE |
---|
184 | INTEGER :: attr_name |
---|
185 | REAL,TARGET :: value(:,:) |
---|
186 | |
---|
187 | TYPE(attribut) :: attr_real2 |
---|
188 | attr_real2%object=attr_get_object(attr_name) |
---|
189 | attr_real2%name=attr_name |
---|
190 | attr_real2%type=REAL2 |
---|
191 | attr_real2%real2_ptr=>value |
---|
192 | |
---|
193 | END FUNCTION attr_real2 |
---|
194 | |
---|
195 | FUNCTION attr_logical0(attr_name,value) |
---|
196 | USE mod_stdtype |
---|
197 | IMPLICIT NONE |
---|
198 | INTEGER :: attr_name |
---|
199 | LOGICAL,TARGET :: value |
---|
200 | |
---|
201 | TYPE(attribut) :: attr_logical0 |
---|
202 | attr_logical0%object=attr_get_object(attr_name) |
---|
203 | attr_logical0%name=attr_name |
---|
204 | attr_logical0%type=logical0 |
---|
205 | attr_logical0%logical0_ptr=>value |
---|
206 | |
---|
207 | END FUNCTION attr_logical0 |
---|
208 | |
---|
209 | FUNCTION attr_logical1(attr_name,value) |
---|
210 | USE mod_stdtype |
---|
211 | IMPLICIT NONE |
---|
212 | INTEGER :: attr_name |
---|
213 | LOGICAL,TARGET :: value(:) |
---|
214 | |
---|
215 | TYPE(attribut) :: attr_logical1 |
---|
216 | attr_logical1%object=attr_get_object(attr_name) |
---|
217 | attr_logical1%name=attr_name |
---|
218 | attr_logical1%type=logical1 |
---|
219 | attr_logical1%logical1_ptr=>value |
---|
220 | |
---|
221 | END FUNCTION attr_logical1 |
---|
222 | |
---|
223 | FUNCTION attr_logical2(attr_name,value) |
---|
224 | USE mod_stdtype |
---|
225 | IMPLICIT NONE |
---|
226 | INTEGER :: attr_name |
---|
227 | LOGICAL,TARGET :: value(:,:) |
---|
228 | |
---|
229 | TYPE(attribut) :: attr_logical2 |
---|
230 | attr_logical2%object=attr_get_object(attr_name) |
---|
231 | attr_logical2%name=attr_name |
---|
232 | attr_logical2%type=logical2 |
---|
233 | attr_logical2%logical2_ptr=>value |
---|
234 | |
---|
235 | END FUNCTION attr_logical2 |
---|
236 | |
---|
237 | |
---|
238 | FUNCTION attr_string0(attr_name,value) |
---|
239 | USE mod_stdtype |
---|
240 | IMPLICIT NONE |
---|
241 | INTEGER :: attr_name |
---|
242 | CHARACTER(LEN=*),TARGET :: value |
---|
243 | TYPE(attribut) :: attr_string0 |
---|
244 | |
---|
245 | attr_string0%object=attr_get_object(attr_name) |
---|
246 | attr_string0%name=attr_name |
---|
247 | attr_string0%type=string0 |
---|
248 | attr_string0%string_len=LEN(value) |
---|
249 | attr_string0%string0_ptr=>value |
---|
250 | |
---|
251 | END FUNCTION attr_string0 |
---|
252 | |
---|
253 | FUNCTION attr_string1(attr_name,value) |
---|
254 | USE mod_stdtype |
---|
255 | IMPLICIT NONE |
---|
256 | INTEGER :: attr_name |
---|
257 | CHARACTER(LEN=*),TARGET :: value(:) |
---|
258 | |
---|
259 | TYPE(attribut) :: attr_string1 |
---|
260 | attr_string1%object=attr_get_object(attr_name) |
---|
261 | attr_string1%name=attr_name |
---|
262 | attr_string1%type=string1 |
---|
263 | attr_string1%string_len=LEN(value) |
---|
264 | attr_string1%string1_ptr=>value |
---|
265 | |
---|
266 | END FUNCTION attr_string1 |
---|
267 | |
---|
268 | FUNCTION attr_string2(attr_name,value) |
---|
269 | USE mod_stdtype |
---|
270 | IMPLICIT NONE |
---|
271 | INTEGER :: attr_name |
---|
272 | CHARACTER(LEN=*),TARGET :: value(:,:) |
---|
273 | |
---|
274 | TYPE(attribut) :: attr_string2 |
---|
275 | attr_string2%object=attr_get_object(attr_name) |
---|
276 | attr_string2%name=attr_name |
---|
277 | attr_string2%type=string2 |
---|
278 | attr_string2%string_len=LEN(value) |
---|
279 | attr_string2%string2_ptr=>value |
---|
280 | |
---|
281 | END FUNCTION attr_string2 |
---|
282 | |
---|
283 | END MODULE mod_attribut |
---|