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

Last change on this file since 286 was 286, checked in by ymipsl, 13 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: 14.4 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IAXIS
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE AXIS_INTERFACE
6   USE AXISGROUP_INTERFACE
7   
8   TYPE XAxisHandle
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE XAxisHandle
11   
12   TYPE XAxisGroupHandle
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE XAxisGroupHandle
15
16   TYPE txios(axis)
17      INTEGER(kind = C_INTPTR_T) :: daddr
18   END TYPE txios(axis)
19   
20   TYPE txios(axisgroup)
21      INTEGER(kind = C_INTPTR_T) :: daddr
22   END TYPE txios(axisgroup)
23   
24   !----------------------------------------------------------------------------
25   INTERFACE set_axis_attributes
26      MODULE PROCEDURE set_axis_attributes_id,set_axis_attributes_hdl
27   END INTERFACE 
28   
29   INTERFACE set_axis_group_attributes
30      MODULE PROCEDURE set_axisgroup_attributes_id,set_axisgroup_attributes_hdl
31   END INTERFACE 
32   !----------------------------------------------------------------------------
33
34         
35   CONTAINS ! Fonctions disponibles pour les utilisateurs.
36
37
38
39   SUBROUTINE xios(set_axis_attr)(axis_id, name, standard_name, long_name, unit, size, value)
40      IMPLICIT NONE
41      TYPE(txios(axis))                                     :: axis_hdl
42      CHARACTER(len = *)                        , INTENT(IN) :: axis_id
43      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
44      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
45      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
46      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
47      INTEGER                         , OPTIONAL, INTENT(IN) :: size
48      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
49     
50      CALL xios(get_axis_handle)(axis_id,axis_hdl)
51      CALL xios(set_axis_attr_hdl_)(axis_hdl, name, standard_name, long_name, unit, size, value)
52
53   END SUBROUTINE xios(set_axis_attr)
54   
55
56   SUBROUTINE xios(set_axis_attr_hdl)(axis_hdl, name, standard_name, long_name, unit, size, value)
57      IMPLICIT NONE
58      TYPE(txios(axis))                        , INTENT(IN) :: axis_hdl
59      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
60      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
61      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
62      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
63      INTEGER                         , OPTIONAL, INTENT(IN) :: size
64      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
65
66      CALL xios(set_axis_attr_hdl_)(axis_hdl, name, standard_name, long_name, unit, size, value)
67
68   END SUBROUTINE xios(set_axis_attr_hdl)
69   
70   
71   SUBROUTINE xios(set_axis_attr_hdl_)(axis_hdl, name_, standard_name_, long_name_, unit_, size_, value_)
72      IMPLICIT NONE
73      TYPE(txios(axis))                        , INTENT(IN) :: axis_hdl
74      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
75      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
76      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
77      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
78      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
79      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value_(:)
80     
81      IF (PRESENT(name_))           THEN
82         CALL cxios_set_axis_name(axis_hdl%daddr, name_, len(name_))
83      END IF
84      IF (PRESENT(standard_name_))  THEN
85         CALL cxios_set_axis_standard_name(axis_hdl%daddr, standard_name_, len(standard_name_))
86      END IF
87      IF (PRESENT(long_name_))      THEN
88         CALL cxios_set_axis_long_name(axis_hdl%daddr, long_name_, len(long_name_))
89      END IF
90      IF (PRESENT(unit_))           THEN
91         CALL cxios_set_axis_unit(axis_hdl%daddr, unit_, len(unit_))
92      END IF
93      IF (PRESENT(size_))           THEN
94         CALL cxios_set_axis_size(axis_hdl%daddr, size_)
95      END IF
96      IF (PRESENT(value_))         THEN
97         CALL cxios_set_axis_zvalue(axis_hdl%daddr, value_, size(value_, 1))
98      END IF
99     
100   END SUBROUTINE xios(set_axis_attr_hdl_)
101
102   
103   SUBROUTINE xios(set_axisgroup_attr)(axisgroup_id, name, standard_name, long_name, unit, size, value)
104      IMPLICIT NONE
105      TYPE(txios(axisgroup))                                :: axisgroup_hdl
106      CHARACTER(len = *)                        , INTENT(IN) :: axisgroup_id
107      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
108      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
109      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
110      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
111      INTEGER                         , OPTIONAL, INTENT(IN) :: size
112      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
113
114      CALL xios(get_axisgroup_handle)(axisgroup_id,axisgroup_hdl)
115      CALL xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)
116
117   END SUBROUTINE xios(set_axisgroup_attr)
118   
119
120   SUBROUTINE xios(set_axisgroup_attr_hdl)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)
121      IMPLICIT NONE
122      TYPE(txios(axisgroup))                   , INTENT(IN) :: axisgroup_hdl
123      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name
124      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name
125      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name
126      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit
127      INTEGER                         , OPTIONAL, INTENT(IN) :: size
128      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value(:)
129
130      CALL xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name, standard_name, long_name, unit, size, value)     
131
132   END SUBROUTINE xios(set_axisgroup_attr_hdl)
133
134     
135   SUBROUTINE xios(set_axisgroup_attr_hdl_)(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, value_)
136      IMPLICIT NONE
137      TYPE(txios(axisgroup))                   , INTENT(IN) :: axisgroup_hdl
138      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
139      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
140      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
141      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
142      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
143      REAL(kind=8), dimension(*), OPTIONAL, INTENT(IN) :: value_(:)
144     
145      IF (PRESENT(name_))           THEN
146         CALL cxios_set_axisgroup_name(axisgroup_hdl%daddr, name_, len(name_))
147      END IF
148      IF (PRESENT(standard_name_))  THEN
149         CALL cxios_set_axisgroup_standard_name(axisgroup_hdl%daddr, standard_name_, len(standard_name_))
150      END IF
151      IF (PRESENT(long_name_))      THEN
152         CALL cxios_set_axisgroup_long_name(axisgroup_hdl%daddr, long_name_, len(long_name_))
153      END IF
154      IF (PRESENT(unit_))           THEN
155         CALL cxios_set_axisgroup_unit(axisgroup_hdl%daddr, unit_, len(unit_))
156      END IF
157      IF (PRESENT(size_))           THEN
158         CALL cxios_set_axisgroup_size(axisgroup_hdl%daddr, size_)
159      END IF
160      IF (PRESENT(value_))         THEN
161         CALL cxios_set_axisgroup_zvalue(axisgroup_hdl%daddr, value_, size(value_, 1))
162      END IF
163   END SUBROUTINE xios(set_axisgroup_attr_hdl_)
164   
165
166   SUBROUTINE xios(get_axis_handle)(idt,ret)
167      IMPLICIT NONE
168      CHARACTER(len = *), INTENT(IN) :: idt     
169      TYPE(txios(axis)) , INTENT(OUT):: ret
170      CALL cxios_axis_handle_create(ret%daddr, idt, len(idt))           
171   END SUBROUTINE xios(get_axis_handle)
172   
173   SUBROUTINE xios(get_axisgroup_handle)(idt,ret)
174      IMPLICIT NONE
175      CHARACTER(len = *)    , INTENT(IN) :: idt     
176      TYPE(txios(axisgroup)), INTENT(OUT):: ret
177
178      CALL cxios_axisgroup_handle_create(ret%daddr, idt, len(idt))           
179
180   END SUBROUTINE xios(get_axisgroup_handle)
181
182   LOGICAL FUNCTION xios(is_valid_axis)(idt)
183      IMPLICIT NONE
184      CHARACTER(len  = *)    , INTENT(IN) :: idt
185      LOGICAL  (kind = 1)                 :: val
186     
187      CALL cxios_axis_valid_id(val, idt, len(idt))
188      xios(is_valid_axis) = val
189
190   END FUNCTION  xios(is_valid_axis)
191
192   LOGICAL FUNCTION xios(is_valid_axisgroup)(idt)
193      IMPLICIT NONE
194      CHARACTER(len  = *)    , INTENT(IN) :: idt
195      LOGICAL  (kind = 1)                 :: val
196
197      CALL cxios_axisgroup_valid_id(val, idt, len(idt))
198      xios(is_valid_axisgroup) = val
199
200   END FUNCTION  xios(is_valid_axisgroup)
201   
202
203
204
205!!!!!!!!!!!!! anciennes interfaces  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
206!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
207
208   SUBROUTINE set_axis_attributes_id(axis_id, name_, standard_name_, long_name_, unit_, size_, zvalue_)
209      IMPLICIT NONE
210      TYPE(XAxisHandle)                                      :: axis_hdl
211      CHARACTER(len = *)                        , INTENT(IN) :: axis_id
212      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
213      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
214      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
215      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
216      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
217      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
218     
219      CALL axis_handle_create(axis_hdl, axis_id)
220      CALL set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
221
222   END SUBROUTINE set_axis_attributes_id
223
224   SUBROUTINE set_axis_attributes_hdl(axis_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
225      IMPLICIT NONE
226      TYPE(XAxisHandle)                         , INTENT(IN) :: axis_hdl
227      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
228      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
229      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
230      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
231      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
232      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
233     
234      IF (PRESENT(name_))           THEN
235         CALL cxios_set_axis_name(axis_hdl%daddr, name_, len(name_))
236      END IF
237      IF (PRESENT(standard_name_))  THEN
238         CALL cxios_set_axis_standard_name(axis_hdl%daddr, standard_name_, len(standard_name_))
239      END IF
240      IF (PRESENT(long_name_))      THEN
241         CALL cxios_set_axis_long_name(axis_hdl%daddr, long_name_, len(long_name_))
242      END IF
243      IF (PRESENT(unit_))           THEN
244         CALL cxios_set_axis_unit(axis_hdl%daddr, unit_, len(unit_))
245      END IF
246      IF (PRESENT(size_))           THEN
247         CALL cxios_set_axis_size(axis_hdl%daddr, size_)
248      END IF
249      IF (PRESENT(zvalue_))         THEN
250         CALL cxios_set_axis_zvalue(axis_hdl%daddr, zvalue_, size(zvalue_, 1))
251      END IF
252   END SUBROUTINE set_axis_attributes_hdl
253   
254   SUBROUTINE set_axisgroup_attributes_id(axisgroup_id, name_, standard_name_, long_name_, unit_, size_, zvalue_)
255      IMPLICIT NONE
256      TYPE(XAxisGroupHandle)                                 :: axisgroup_hdl
257      CHARACTER(len = *)                        , INTENT(IN) :: axisgroup_id
258      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
259      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
260      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
261      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
262      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
263      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
264     
265      CALL axisgroup_handle_create(axisgroup_hdl, axisgroup_id)
266      CALL set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
267
268   END SUBROUTINE set_axisgroup_attributes_id
269   
270   SUBROUTINE set_axisgroup_attributes_hdl(axisgroup_hdl, name_, standard_name_, long_name_, unit_, size_, zvalue_)
271      IMPLICIT NONE
272      TYPE(XAxisGroupHandle)                    , INTENT(IN) :: axisgroup_hdl
273      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: name_
274      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: standard_name_
275      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: long_name_
276      CHARACTER(len = *)              , OPTIONAL, INTENT(IN) :: unit_
277      INTEGER                         , OPTIONAL, INTENT(IN) :: size_
278      REAL    (kind = 8), dimension(*), OPTIONAL, INTENT(IN) :: zvalue_(:)
279     
280      IF (PRESENT(name_))           THEN
281         CALL cxios_set_axisgroup_name(axisgroup_hdl%daddr, name_, len(name_))
282      END IF
283      IF (PRESENT(standard_name_))  THEN
284         CALL cxios_set_axisgroup_standard_name(axisgroup_hdl%daddr, standard_name_, len(standard_name_))
285      END IF
286      IF (PRESENT(long_name_))      THEN
287         CALL cxios_set_axisgroup_long_name(axisgroup_hdl%daddr, long_name_, len(long_name_))
288      END IF
289      IF (PRESENT(unit_))           THEN
290         CALL cxios_set_axisgroup_unit(axisgroup_hdl%daddr, unit_, len(unit_))
291      END IF
292      IF (PRESENT(size_))           THEN
293         CALL cxios_set_axisgroup_size(axisgroup_hdl%daddr, size_)
294      END IF
295      IF (PRESENT(zvalue_))         THEN
296         CALL cxios_set_axisgroup_zvalue(axisgroup_hdl%daddr, zvalue_, size(zvalue_, 1))
297      END IF
298   END SUBROUTINE set_axisgroup_attributes_hdl
299
300   SUBROUTINE axis_handle_create(ret, idt)
301      IMPLICIT NONE
302      TYPE(XAxisHandle) , INTENT(OUT):: ret
303      CHARACTER(len = *), INTENT(IN) :: idt     
304      CALL cxios_axis_handle_create(ret%daddr, idt, len(idt))           
305   END SUBROUTINE axis_handle_create
306   
307   SUBROUTINE axisgroup_handle_create(ret, idt)
308      IMPLICIT NONE
309      TYPE(XAxisGroupHandle), INTENT(OUT):: ret
310      CHARACTER(len = *)    , INTENT(IN) :: idt     
311      CALL cxios_axisgroup_handle_create(ret%daddr, idt, len(idt))           
312   END SUBROUTINE axisgroup_handle_create
313
314   LOGICAL FUNCTION axis_valid_id(idt)
315      IMPLICIT NONE
316      CHARACTER(len  = *)    , INTENT(IN) :: idt
317      LOGICAL  (kind = 1)                 :: val
318      CALL cxios_axis_valid_id(val, idt, len(idt));
319      axis_valid_id = val
320   END FUNCTION  axis_valid_id
321
322   LOGICAL FUNCTION axisgroup_valid_id(idt)
323      IMPLICIT NONE
324      CHARACTER(len  = *)    , INTENT(IN) :: idt
325      LOGICAL  (kind = 1)                 :: val
326      CALL cxios_axisgroup_valid_id(val, idt, len(idt));
327      axisgroup_valid_id = val
328   END FUNCTION  axisgroup_valid_id
329
330END MODULE IAXIS
Note: See TracBrowser for help on using the repository browser.