source: XIOS/trunk/src/fortran/ifield.F90 @ 310

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

Add xios_field_is_active functionnality

YM

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