source: XMLIO_V2/dev/common/src/xmlio/fortran/ifield.F90 @ 286

Last change on this file since 286 was 286, checked in by ymipsl, 10 years ago

reprise en main de la version de H. Ozdoba. Correction de différentes erreurs de conception et bug.
Version NEMO operationnel en client/server, interoperabilita avec OASIS, reconstition de fichiers via netcdf4/HDF5

YM

File size: 26.2 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IFIELD
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE FIELD_INTERFACE
6   USE FIELDGROUP_INTERFACE
7   
8   TYPE XFieldHandle
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE XFieldHandle
11   
12   TYPE XFieldGroupHandle
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE XFieldGroupHandle
15
16   TYPE txios(field)
17      INTEGER(kind = C_INTPTR_T) :: daddr
18   END TYPE txios(field)
19   
20   TYPE txios(fieldgroup)
21      INTEGER(kind = C_INTPTR_T) :: daddr
22   END TYPE txios(fieldgroup)
23   
24   !----------------------------------------------------------------------------
25   INTERFACE set_field_attributes
26      MODULE PROCEDURE set_field_attributes_id,set_field_attributes_hdl
27   END INTERFACE 
28   
29   INTERFACE set_field_group_attributes
30      MODULE PROCEDURE set_fieldgroup_attributes_id,set_fieldgroup_attributes_hdl
31   END INTERFACE 
32   !----------------------------------------------------------------------------
33   
34   CONTAINS ! Fonctions disponibles pour les utilisateurs.
35
36
37   SUBROUTINE xios(set_fieldgroup_attr)                                             &
38   (fieldgroup_id, name, standard_name, long_name, unit, operation, freq_op, level, &
39    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
40   
41      IMPLICIT NONE
42      TYPE(txios(fieldgroup))                      :: fieldgroup_hdl
43      CHARACTER(len = *)               , INTENT(IN) :: fieldgroup_id
44      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
45      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name
46      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name
47      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit
48      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation
49      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op
50      INTEGER                , OPTIONAL, INTENT(IN) :: level
51      INTEGER                , OPTIONAL, INTENT(IN) :: prec
52      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled
53      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
54      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
55      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref
56      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref
57      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value
58       
59      CALL xios(get_fieldgroup_handle)(fieldgroup_id,fieldgroup_hdl)
60      CALL xios(set_fieldgroup_attr_hdl_)                                                  &
61         (fieldgroup_hdl, name, standard_name, long_name, unit, operation, freq_op, level, &
62          prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
63
64   END SUBROUTINE xios(set_fieldgroup_attr)
65
66   SUBROUTINE xios(set_fieldgroup_attr_hdl)                                           &
67   (fieldgroup_hdl, name, standard_name, long_name, unit, operation, freq_op, level , &
68    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
69      IMPLICIT NONE
70      TYPE(txios(fieldgroup))         , INTENT(IN) :: fieldgroup_hdl
71      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
72      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name
73      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name
74      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit
75      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation
76      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op
77      INTEGER                , OPTIONAL, INTENT(IN) :: level
78      INTEGER                , OPTIONAL, INTENT(IN) :: prec
79      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled
80      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
81      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
82      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref
83      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref
84      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value
85     
86      CALL  xios(set_fieldgroup_attr_hdl_)                                            &
87   (fieldgroup_hdl, name, standard_name, long_name, unit, operation, freq_op, level , &
88    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value) 
89       
90   END SUBROUTINE xios(set_fieldgroup_attr_hdl)
91
92
93   SUBROUTINE xios(set_fieldgroup_attr_hdl_)                                                &
94   (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
95    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
96      IMPLICIT NONE
97      TYPE(txios(fieldgroup))         , INTENT(IN) :: fieldgroup_hdl
98      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
99      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
100      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
101      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
102      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
103      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
104      INTEGER                , OPTIONAL, INTENT(IN) :: level_
105      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
106      LOGICAL(kind = 1)                             :: enabled__
107      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
108      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
109      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
110      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
111      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
112      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
113     
114      IF (PRESENT(name_))           THEN
115         CALL cxios_set_fieldgroup_name(fieldgroup_hdl%daddr, name_, len(name_))
116      END IF
117      IF (PRESENT(standard_name_))  THEN
118         CALL cxios_set_fieldgroup_standard_name(fieldgroup_hdl%daddr, standard_name_, len(standard_name_))
119      END IF
120      IF (PRESENT(long_name_))      THEN
121         CALL cxios_set_fieldgroup_long_name(fieldgroup_hdl%daddr, long_name_, len(long_name_))
122      END IF
123      IF (PRESENT(unit_))           THEN
124         CALL cxios_set_fieldgroup_unit(fieldgroup_hdl%daddr, unit_, len(unit_))
125      END IF
126      IF (PRESENT(operation_))      THEN
127         CALL cxios_set_fieldgroup_operation(fieldgroup_hdl%daddr, operation_, len(operation_))
128      END IF
129      IF (PRESENT(freq_op_))        THEN
130         CALL cxios_set_fieldgroup_freq_op(fieldgroup_hdl%daddr, freq_op_, len(freq_op_))
131      END IF
132      IF (PRESENT(level_))          THEN
133         CALL cxios_set_fieldgroup_level(fieldgroup_hdl%daddr, level_)
134      END IF
135      IF (PRESENT(prec_))           THEN
136         CALL cxios_set_fieldgroup_prec(fieldgroup_hdl%daddr, prec_)
137      END IF
138      IF (PRESENT(enabled_))        THEN
139         enabled__ = enabled_ 
140         CALL cxios_set_fieldgroup_enabled(fieldgroup_hdl%daddr, enabled__)
141      END IF
142      IF (PRESENT(domain_ref_))     THEN
143         CALL cxios_set_fieldgroup_domain_ref(fieldgroup_hdl%daddr, domain_ref_, len(domain_ref_))
144      END IF
145      IF (PRESENT(axis_ref_))       THEN
146         CALL cxios_set_fieldgroup_axis_ref(fieldgroup_hdl%daddr, axis_ref_, len(axis_ref_))
147      END IF
148      IF (PRESENT(grid_ref_))       THEN
149         CALL cxios_set_fieldgroup_grid_ref(fieldgroup_hdl%daddr, grid_ref_, len(grid_ref_))
150      END IF
151      IF (PRESENT(field_ref_))      THEN
152         CALL cxios_set_fieldgroup_field_ref(fieldgroup_hdl%daddr, field_ref_, len(field_ref_))
153      END IF
154      IF (PRESENT(default_value_))  THEN
155         CALL cxios_set_fieldgroup_default_value(fieldgroup_hdl%daddr, default_value_)
156      END IF
157
158   END SUBROUTINE xios(set_fieldgroup_attr_hdl_)
159
160   
161   SUBROUTINE xios(set_field_attr)                                             &
162   (field_id, name, standard_name, long_name, unit, operation, freq_op, level, &
163    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
164   
165      IMPLICIT NONE
166      TYPE(txios(field))                            :: field_hdl
167      CHARACTER(len = *)               , INTENT(IN) :: field_id
168      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
169      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name
170      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name
171      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit
172      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation
173      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op
174      INTEGER                , OPTIONAL, INTENT(IN) :: level
175      INTEGER                , OPTIONAL, INTENT(IN) :: prec
176      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled
177      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
178      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
179      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref
180      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref
181      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value
182     
183      CALL xios(get_field_handle)(field_id,field_hdl)
184      CALL xios(set_field_attr_hdl_)                                                          &
185         (field_hdl, name, standard_name, long_name, unit, operation, freq_op, level,  &
186          prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
187   END SUBROUTINE xios(set_field_attr)
188
189
190   SUBROUTINE xios(set_field_attr_hdl)                                          &
191   (field_hdl, name, standard_name, long_name, unit, operation, freq_op, level, &
192    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value)
193      IMPLICIT NONE
194      TYPE(txios(field))               , INTENT(IN):: field_hdl
195      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
196      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name
197      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name
198      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit
199      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation
200      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op
201      INTEGER                , OPTIONAL, INTENT(IN) :: level
202      INTEGER                , OPTIONAL, INTENT(IN) :: prec
203      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled
204      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
205      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
206      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref
207      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref
208      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value
209
210      CALL xios(set_field_attr_hdl_)                                            &
211   (field_hdl, name, standard_name, long_name, unit, operation, freq_op, level, &
212    prec, enabled, domain_ref, axis_ref, grid_ref, field_ref, default_value) 
213       
214   END SUBROUTINE xios(set_field_attr_hdl)
215
216   SUBROUTINE xios(set_field_attr_hdl_)                                                &
217   (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
218    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
219      IMPLICIT NONE
220      TYPE(txios(field))               , INTENT(IN):: field_hdl
221      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
222      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
223      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
224      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
225      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
226      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
227      INTEGER                , OPTIONAL, INTENT(IN) :: level_
228      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
229      LOGICAL(kind = 1)                             :: enabled__
230      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
231      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
232      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
233      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
234      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
235      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
236     
237      IF (PRESENT(name_))           THEN
238         CALL cxios_set_field_name(field_hdl%daddr, name_, len(name_))
239      END IF
240      IF (PRESENT(standard_name_))  THEN
241         CALL cxios_set_field_standard_name(field_hdl%daddr, standard_name_, len(standard_name_))
242      END IF
243      IF (PRESENT(long_name_))      THEN
244         CALL cxios_set_field_long_name(field_hdl%daddr, long_name_, len(long_name_))
245      END IF
246      IF (PRESENT(unit_))           THEN
247         CALL cxios_set_field_unit(field_hdl%daddr, unit_, len(unit_))
248      END IF
249      IF (PRESENT(operation_))      THEN
250         CALL cxios_set_field_operation(field_hdl%daddr, operation_, len(operation_))
251      END IF
252      IF (PRESENT(freq_op_))        THEN
253         CALL cxios_set_field_freq_op(field_hdl%daddr, freq_op_, len(freq_op_))
254      END IF
255      IF (PRESENT(level_))          THEN
256         CALL cxios_set_field_level(field_hdl%daddr, level_)
257      END IF
258      IF (PRESENT(prec_))           THEN
259         CALL cxios_set_field_prec(field_hdl%daddr, prec_)
260      END IF
261      IF (PRESENT(enabled_))        THEN
262         enabled__ = enabled_ 
263         CALL cxios_set_field_enabled(field_hdl%daddr, enabled__)
264      END IF
265      IF (PRESENT(domain_ref_))     THEN
266         CALL cxios_set_field_domain_ref(field_hdl%daddr, domain_ref_, len(domain_ref_))
267      END IF
268      IF (PRESENT(axis_ref_))       THEN
269         CALL cxios_set_field_axis_ref(field_hdl%daddr, axis_ref_, len(axis_ref_))
270      END IF
271      IF (PRESENT(grid_ref_))       THEN
272         CALL cxios_set_field_grid_ref(field_hdl%daddr, grid_ref_, len(grid_ref_))
273      END IF
274      IF (PRESENT(field_ref_))      THEN
275         CALL cxios_set_field_field_ref(field_hdl%daddr, field_ref_, len(field_ref_))
276      END IF
277      IF (PRESENT(default_value_))  THEN
278         CALL cxios_set_field_default_value(field_hdl%daddr, default_value_)
279      END IF
280
281   END SUBROUTINE xios(set_field_attr_hdl_)
282   
283
284   SUBROUTINE xios(get_field_handle)(idt, ret)
285      IMPLICIT NONE
286      CHARACTER(len = *), INTENT(IN)   :: idt     
287      TYPE(txios(field)), INTENT(OUT) :: ret
288      CALL cxios_field_handle_create(ret%daddr, idt, len(idt))           
289   END SUBROUTINE xios(get_field_handle)
290   
291   SUBROUTINE xios(get_fieldgroup_handle)(idt,ret)
292      IMPLICIT NONE
293      CHARACTER(len = *)     , INTENT(IN) :: idt     
294      TYPE(txios(fieldgroup)), INTENT(OUT):: ret
295
296      CALL cxios_fieldgroup_handle_create(ret%daddr, idt, len(idt))           
297
298   END SUBROUTINE xios(get_fieldgroup_handle)
299   
300
301   LOGICAL FUNCTION xios(is_valid_field)(idt)
302      IMPLICIT NONE
303      CHARACTER(len  = *)    , INTENT(IN) :: idt
304      LOGICAL  (kind = 1)                 :: val
305     
306      CALL cxios_field_valid_id(val, idt, len(idt));
307      xios(is_valid_field) = val
308
309   END FUNCTION  xios(is_valid_field)
310
311   LOGICAL FUNCTION xios(is_valid_fieldgroup)(idt)
312      IMPLICIT NONE
313      CHARACTER(len  = *)    , INTENT(IN) :: idt
314      LOGICAL  (kind = 1)                 :: val
315      CALL cxios_fieldgroup_valid_id(val, idt, len(idt));
316      xios(is_valid_fieldgroup) = val
317
318   END FUNCTION  xios(is_valid_fieldgroup)
319   
320   
321 
322   
323   
324   
325   
326   
327   
328   
329
330
331!!!!!!!!!!!!!!!!!!!!!!!!!! Ancienne interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
332!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!   
333   SUBROUTINE set_fieldgroup_attributes_id                                                 &
334   (fieldgroup_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
335    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
336   
337      IMPLICIT NONE
338      TYPE(XFieldGroupHandle)                       :: fieldgroup_hdl
339      CHARACTER(len = *)               , INTENT(IN) :: fieldgroup_id
340      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
341      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
342      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
343      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
344      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
345      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
346      INTEGER                , OPTIONAL, INTENT(IN) :: level_
347      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
348      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
349      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
350      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
351      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
352      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
353      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
354       
355      CALL fieldgroup_handle_create(fieldgroup_hdl, fieldgroup_id)
356      CALL set_fieldgroup_attributes_hdl                                                          &
357         (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
358          prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
359
360   END SUBROUTINE set_fieldgroup_attributes_id
361
362   SUBROUTINE set_fieldgroup_attributes_hdl                                                 &
363   (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
364    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
365      IMPLICIT NONE
366      TYPE(XFieldgroupHandle)          , INTENT(IN) :: fieldgroup_hdl
367      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
368      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
369      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
370      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
371      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
372      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
373      INTEGER                , OPTIONAL, INTENT(IN) :: level_
374      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
375      LOGICAL(kind = 1)                             :: enabled__
376      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
377      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
378      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
379      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
380      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
381      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
382     
383      IF (PRESENT(name_))           THEN
384         CALL cxios_set_fieldgroup_name(fieldgroup_hdl%daddr, name_, len(name_))
385      END IF
386      IF (PRESENT(standard_name_))  THEN
387         CALL cxios_set_fieldgroup_standard_name(fieldgroup_hdl%daddr, standard_name_, len(standard_name_))
388      END IF
389      IF (PRESENT(long_name_))      THEN
390         CALL cxios_set_fieldgroup_long_name(fieldgroup_hdl%daddr, long_name_, len(long_name_))
391      END IF
392      IF (PRESENT(unit_))           THEN
393         CALL cxios_set_fieldgroup_unit(fieldgroup_hdl%daddr, unit_, len(unit_))
394      END IF
395      IF (PRESENT(operation_))      THEN
396         CALL cxios_set_fieldgroup_operation(fieldgroup_hdl%daddr, operation_, len(operation_))
397      END IF
398      IF (PRESENT(freq_op_))        THEN
399         CALL cxios_set_fieldgroup_freq_op(fieldgroup_hdl%daddr, freq_op_, len(freq_op_))
400      END IF
401      IF (PRESENT(level_))          THEN
402         CALL cxios_set_fieldgroup_level(fieldgroup_hdl%daddr, level_)
403      END IF
404      IF (PRESENT(prec_))           THEN
405         CALL cxios_set_fieldgroup_prec(fieldgroup_hdl%daddr, prec_)
406      END IF
407      IF (PRESENT(enabled_))        THEN
408         enabled__ = enabled_ 
409         CALL cxios_set_fieldgroup_enabled(fieldgroup_hdl%daddr, enabled__)
410      END IF
411      IF (PRESENT(domain_ref_))     THEN
412         CALL cxios_set_fieldgroup_domain_ref(fieldgroup_hdl%daddr, domain_ref_, len(domain_ref_))
413      END IF
414      IF (PRESENT(axis_ref_))       THEN
415         CALL cxios_set_fieldgroup_axis_ref(fieldgroup_hdl%daddr, axis_ref_, len(axis_ref_))
416      END IF
417      IF (PRESENT(grid_ref_))       THEN
418         CALL cxios_set_fieldgroup_grid_ref(fieldgroup_hdl%daddr, grid_ref_, len(grid_ref_))
419      END IF
420      IF (PRESENT(field_ref_))      THEN
421         CALL cxios_set_fieldgroup_field_ref(fieldgroup_hdl%daddr, field_ref_, len(field_ref_))
422      END IF
423      IF (PRESENT(default_value_))  THEN
424         CALL cxios_set_fieldgroup_default_value(fieldgroup_hdl%daddr, default_value_)
425      END IF
426
427   END SUBROUTINE set_fieldgroup_attributes_hdl
428   
429   SUBROUTINE set_field_attributes_id                                                 &
430   (field_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
431    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
432   
433      IMPLICIT NONE
434      TYPE(XFieldHandle)                            :: field_hdl
435      CHARACTER(len = *)               , INTENT(IN) :: field_id
436      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
437      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
438      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
439      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
440      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
441      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
442      INTEGER                , OPTIONAL, INTENT(IN) :: level_
443      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
444      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
445      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
446      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
447      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
448      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
449      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
450     
451      CALL field_handle_create(field_hdl, field_id)
452      CALL set_field_attributes_hdl                                                          &
453         (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
454          prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
455
456   END SUBROUTINE set_field_attributes_id
457
458   SUBROUTINE set_field_attributes_hdl                                                 &
459   (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
460    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
461      IMPLICIT NONE
462      TYPE(XFieldHandle)               , INTENT(IN) :: field_hdl
463      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
464      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
465      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
466      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
467      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
468      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
469      INTEGER                , OPTIONAL, INTENT(IN) :: level_
470      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
471      LOGICAL(kind = 1)                             :: enabled__
472      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
473      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
474      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
475      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
476      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
477      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
478     
479      IF (PRESENT(name_))           THEN
480         CALL cxios_set_field_name(field_hdl%daddr, name_, len(name_))
481      END IF
482      IF (PRESENT(standard_name_))  THEN
483         CALL cxios_set_field_standard_name(field_hdl%daddr, standard_name_, len(standard_name_))
484      END IF
485      IF (PRESENT(long_name_))      THEN
486         CALL cxios_set_field_long_name(field_hdl%daddr, long_name_, len(long_name_))
487      END IF
488      IF (PRESENT(unit_))           THEN
489         CALL cxios_set_field_unit(field_hdl%daddr, unit_, len(unit_))
490      END IF
491      IF (PRESENT(operation_))      THEN
492         CALL cxios_set_field_operation(field_hdl%daddr, operation_, len(operation_))
493      END IF
494      IF (PRESENT(freq_op_))        THEN
495         CALL cxios_set_field_freq_op(field_hdl%daddr, freq_op_, len(freq_op_))
496      END IF
497      IF (PRESENT(level_))          THEN
498         CALL cxios_set_field_level(field_hdl%daddr, level_)
499      END IF
500      IF (PRESENT(prec_))           THEN
501         CALL cxios_set_field_prec(field_hdl%daddr, prec_)
502      END IF
503      IF (PRESENT(enabled_))        THEN
504         enabled__ = enabled_ 
505         CALL cxios_set_field_enabled(field_hdl%daddr, enabled__)
506      END IF
507      IF (PRESENT(domain_ref_))     THEN
508         CALL cxios_set_field_domain_ref(field_hdl%daddr, domain_ref_, len(domain_ref_))
509      END IF
510      IF (PRESENT(axis_ref_))       THEN
511         CALL cxios_set_field_axis_ref(field_hdl%daddr, axis_ref_, len(axis_ref_))
512      END IF
513      IF (PRESENT(grid_ref_))       THEN
514         CALL cxios_set_field_grid_ref(field_hdl%daddr, grid_ref_, len(grid_ref_))
515      END IF
516      IF (PRESENT(field_ref_))      THEN
517         CALL cxios_set_field_field_ref(field_hdl%daddr, field_ref_, len(field_ref_))
518      END IF
519      IF (PRESENT(default_value_))  THEN
520         CALL cxios_set_field_default_value(field_hdl%daddr, default_value_)
521      END IF
522
523   END SUBROUTINE set_field_attributes_hdl
524
525   SUBROUTINE field_handle_create(ret, idt)
526      IMPLICIT NONE
527      TYPE(XFieldHandle), INTENT(OUT):: ret
528      CHARACTER(len = *), INTENT(IN) :: idt     
529      CALL cxios_field_handle_create(ret%daddr, idt, len(idt))           
530   END SUBROUTINE field_handle_create
531   
532   SUBROUTINE fieldgroup_handle_create(ret, idt)
533      IMPLICIT NONE
534      TYPE(XFieldGroupHandle), INTENT(OUT):: ret
535      CHARACTER(len = *)     , INTENT(IN) :: idt     
536      CALL cxios_fieldgroup_handle_create(ret%daddr, idt, len(idt))           
537   END SUBROUTINE fieldgroup_handle_create
538
539   LOGICAL FUNCTION field_valid_id(idt)
540      IMPLICIT NONE
541      CHARACTER(len  = *)    , INTENT(IN) :: idt
542      LOGICAL  (kind = 1)                 :: val
543      CALL cxios_field_valid_id(val, idt, len(idt));
544      field_valid_id = val
545   END FUNCTION  field_valid_id
546
547   LOGICAL FUNCTION fieldgroup_valid_id(idt)
548      IMPLICIT NONE
549      CHARACTER(len  = *)    , INTENT(IN) :: idt
550      LOGICAL  (kind = 1)                 :: val
551      CALL cxios_fieldgroup_valid_id(val, idt, len(idt));
552      fieldgroup_valid_id = val
553   END FUNCTION  fieldgroup_valid_id
554
555END MODULE IFIELD
Note: See TracBrowser for help on using the repository browser.