source: XMLIO_V2/dev/dev_rv/src/xmlio/fortran/ifield.f90 @ 285

Last change on this file since 285 was 285, checked in by hozdoba, 13 years ago
File size: 11.8 KB
Line 
1MODULE IFIELD
2   USE, INTRINSIC :: ISO_C_BINDING
3   USE FIELD_INTERFACE
4   USE FIELDGROUP_INTERFACE
5   
6   TYPE XFieldHandle
7      INTEGER(kind = C_INTPTR_T) :: daddr
8   END TYPE XFieldHandle
9   
10   TYPE XFieldGroupHandle
11      INTEGER(kind = C_INTPTR_T) :: daddr
12   END TYPE XFieldGroupHandle
13   
14   !----------------------------------------------------------------------------
15   INTERFACE set_field_attributes
16      MODULE PROCEDURE set_field_attributes_id,set_field_attributes_hdl
17   END INTERFACE 
18   
19   INTERFACE set_field_group_attributes
20      MODULE PROCEDURE set_fieldgroup_attributes_id,set_fieldgroup_attributes_hdl
21   END INTERFACE 
22   !----------------------------------------------------------------------------
23   
24   CONTAINS ! Fonctions disponibles pour les utilisateurs.
25   
26   SUBROUTINE set_fieldgroup_attributes_id                                                 &
27   (fieldgroup_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
28    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
29   
30      IMPLICIT NONE
31      TYPE(XFieldGroupHandle)                       :: fieldgroup_hdl
32      CHARACTER(len = *)               , INTENT(IN) :: fieldgroup_id
33      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
34      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
35      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
36      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
37      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
38      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
39      INTEGER                , OPTIONAL, INTENT(IN) :: level_
40      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
41      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
42      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
43      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
44      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
45      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
46      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
47       
48      CALL fieldgroup_handle_create(fieldgroup_hdl, fieldgroup_id)
49      CALL set_fieldgroup_attributes_hdl                                                          &
50         (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
51          prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
52
53   END SUBROUTINE set_fieldgroup_attributes_id
54
55   SUBROUTINE set_fieldgroup_attributes_hdl                                                 &
56   (fieldgroup_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
57    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
58      IMPLICIT NONE
59      TYPE(XFieldgroupHandle)          , INTENT(IN) :: fieldgroup_hdl
60      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
61      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
62      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
63      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
64      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
65      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
66      INTEGER                , OPTIONAL, INTENT(IN) :: level_
67      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
68      LOGICAL(kind = 1)                             :: enabled__
69      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
70      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
71      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
72      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
73      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
74      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
75     
76      enabled__ = enabled_ 
77      IF (PRESENT(name_))           THEN
78         CALL xios_set_fieldgroup_name(fieldgroup_hdl%daddr, name_, len(name_))
79      END IF
80      IF (PRESENT(standard_name_))  THEN
81         CALL xios_set_fieldgroup_standard_name(fieldgroup_hdl%daddr, standard_name_, len(standard_name_))
82      END IF
83      IF (PRESENT(long_name_))      THEN
84         CALL xios_set_fieldgroup_long_name(fieldgroup_hdl%daddr, long_name_, len(long_name_))
85      END IF
86      IF (PRESENT(unit_))           THEN
87         CALL xios_set_fieldgroup_unit(fieldgroup_hdl%daddr, unit_, len(unit_))
88      END IF
89      IF (PRESENT(operation_))      THEN
90         CALL xios_set_fieldgroup_operation(fieldgroup_hdl%daddr, operation_, len(operation_))
91      END IF
92      IF (PRESENT(freq_op_))        THEN
93         CALL xios_set_fieldgroup_freq_op(fieldgroup_hdl%daddr, freq_op_, len(freq_op_))
94      END IF
95      IF (PRESENT(level_))          THEN
96         CALL xios_set_fieldgroup_level(fieldgroup_hdl%daddr, level_)
97      END IF
98      IF (PRESENT(prec_))           THEN
99         CALL xios_set_fieldgroup_prec(fieldgroup_hdl%daddr, prec_)
100      END IF
101      IF (PRESENT(enabled_))        THEN
102         CALL xios_set_fieldgroup_enabled(fieldgroup_hdl%daddr, enabled__)
103      END IF
104      IF (PRESENT(domain_ref_))     THEN
105         CALL xios_set_fieldgroup_domain_ref(fieldgroup_hdl%daddr, domain_ref_, len(domain_ref_))
106      END IF
107      IF (PRESENT(axis_ref_))       THEN
108         CALL xios_set_fieldgroup_axis_ref(fieldgroup_hdl%daddr, axis_ref_, len(axis_ref_))
109      END IF
110      IF (PRESENT(grid_ref_))       THEN
111         CALL xios_set_fieldgroup_grid_ref(fieldgroup_hdl%daddr, grid_ref_, len(grid_ref_))
112      END IF
113      IF (PRESENT(field_ref_))      THEN
114         CALL xios_set_fieldgroup_field_ref(fieldgroup_hdl%daddr, field_ref_, len(field_ref_))
115      END IF
116      IF (PRESENT(default_value_))  THEN
117         CALL xios_set_fieldgroup_default_value(fieldgroup_hdl%daddr, default_value_)
118      END IF
119
120   END SUBROUTINE set_fieldgroup_attributes_hdl
121   
122   SUBROUTINE set_field_attributes_id                                                 &
123   (field_id, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
124    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
125   
126      IMPLICIT NONE
127      TYPE(XFieldHandle)                            :: field_hdl
128      CHARACTER(len = *)               , INTENT(IN) :: field_id
129      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
130      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
131      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
132      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
133      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
134      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
135      INTEGER                , OPTIONAL, INTENT(IN) :: level_
136      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
137      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
138      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
139      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
140      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
141      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
142      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
143     
144      CALL field_handle_create(field_hdl, field_id)
145      CALL set_field_attributes_hdl                                                          &
146         (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
147          prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
148
149   END SUBROUTINE set_field_attributes_id
150
151   SUBROUTINE set_field_attributes_hdl                                                 &
152   (field_hdl, name_, standard_name_, long_name_, unit_, operation_, freq_op_, level_, &
153    prec_, enabled_, domain_ref_, axis_ref_, grid_ref_, field_ref_, default_value_)
154      IMPLICIT NONE
155      TYPE(XFieldHandle)               , INTENT(IN) :: field_hdl
156      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
157      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: standard_name_
158      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: long_name_
159      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: unit_
160      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: operation_
161      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: freq_op_
162      INTEGER                , OPTIONAL, INTENT(IN) :: level_
163      INTEGER                , OPTIONAL, INTENT(IN) :: prec_
164      LOGICAL(kind = 1)                             :: enabled__
165      LOGICAL                , OPTIONAL, INTENT(IN) :: enabled_
166      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
167      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
168      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: grid_ref_
169      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: field_ref_
170      REAL(kind=8)           , OPTIONAL, INTENT(IN) :: default_value_
171     
172      enabled__ = enabled_ 
173      IF (PRESENT(name_))           THEN
174         CALL xios_set_field_name(field_hdl%daddr, name_, len(name_))
175      END IF
176      IF (PRESENT(standard_name_))  THEN
177         CALL xios_set_field_standard_name(field_hdl%daddr, standard_name_, len(standard_name_))
178      END IF
179      IF (PRESENT(long_name_))      THEN
180         CALL xios_set_field_long_name(field_hdl%daddr, long_name_, len(long_name_))
181      END IF
182      IF (PRESENT(unit_))           THEN
183         CALL xios_set_field_unit(field_hdl%daddr, unit_, len(unit_))
184      END IF
185      IF (PRESENT(operation_))      THEN
186         CALL xios_set_field_operation(field_hdl%daddr, operation_, len(operation_))
187      END IF
188      IF (PRESENT(freq_op_))        THEN
189         CALL xios_set_field_freq_op(field_hdl%daddr, freq_op_, len(freq_op_))
190      END IF
191      IF (PRESENT(level_))          THEN
192         CALL xios_set_field_level(field_hdl%daddr, level_)
193      END IF
194      IF (PRESENT(prec_))           THEN
195         CALL xios_set_field_prec(field_hdl%daddr, prec_)
196      END IF
197      IF (PRESENT(enabled_))        THEN
198         CALL xios_set_field_enabled(field_hdl%daddr, enabled__)
199      END IF
200      IF (PRESENT(domain_ref_))     THEN
201         CALL xios_set_field_domain_ref(field_hdl%daddr, domain_ref_, len(domain_ref_))
202      END IF
203      IF (PRESENT(axis_ref_))       THEN
204         CALL xios_set_field_axis_ref(field_hdl%daddr, axis_ref_, len(axis_ref_))
205      END IF
206      IF (PRESENT(grid_ref_))       THEN
207         CALL xios_set_field_grid_ref(field_hdl%daddr, grid_ref_, len(grid_ref_))
208      END IF
209      IF (PRESENT(field_ref_))      THEN
210         CALL xios_set_field_field_ref(field_hdl%daddr, field_ref_, len(field_ref_))
211      END IF
212      IF (PRESENT(default_value_))  THEN
213         CALL xios_set_field_default_value(field_hdl%daddr, default_value_)
214      END IF
215
216   END SUBROUTINE set_field_attributes_hdl
217
218   SUBROUTINE field_handle_create(ret, idt)
219      IMPLICIT NONE
220      TYPE(XFieldHandle), INTENT(OUT):: ret
221      CHARACTER(len = *), INTENT(IN) :: idt     
222      CALL xios_field_handle_create(ret%daddr, idt, len(idt))           
223   END SUBROUTINE field_handle_create
224   
225   SUBROUTINE fieldgroup_handle_create(ret, idt)
226      IMPLICIT NONE
227      TYPE(XFieldGroupHandle), INTENT(OUT):: ret
228      CHARACTER(len = *)     , INTENT(IN) :: idt     
229      CALL xios_fieldgroup_handle_create(ret%daddr, idt, len(idt))           
230   END SUBROUTINE fieldgroup_handle_create
231
232   LOGICAL FUNCTION field_valid_id(idt)
233      IMPLICIT NONE
234      CHARACTER(len  = *)    , INTENT(IN) :: idt
235      LOGICAL  (kind = 1)                 :: val
236      CALL xios_field_valid_id(val, idt, len(idt));
237      field_valid_id = val
238   END FUNCTION  field_valid_id
239
240   LOGICAL FUNCTION fieldgroup_valid_id(idt)
241      IMPLICIT NONE
242      CHARACTER(len  = *)    , INTENT(IN) :: idt
243      LOGICAL  (kind = 1)                 :: val
244      CALL xios_fieldgroup_valid_id(val, idt, len(idt));
245      fieldgroup_valid_id = val
246   END FUNCTION  fieldgroup_valid_id
247
248END MODULE IFIELD
Note: See TracBrowser for help on using the repository browser.