source: XMLIO_V2/dev/common/src/xmlio/fortran/igrid.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: 11.4 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IGRID
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE GRID_INTERFACE
6   USE GRIDGROUP_INTERFACE
7   
8   TYPE XGridHandle
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE XGridHandle
11   
12   TYPE XGridGroupHandle
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE XGridGroupHandle
15
16   TYPE txios(grid)
17      INTEGER(kind = C_INTPTR_T) :: daddr
18   END TYPE txios(grid)
19   
20   TYPE txios(gridgroup)
21      INTEGER(kind = C_INTPTR_T) :: daddr
22   END TYPE txios(gridgroup)
23   
24   !----------------------------------------------------------------------------
25   INTERFACE set_grid_attributes
26      MODULE PROCEDURE set_grid_attributes_id,set_grid_attributes_hdl
27   END INTERFACE 
28   
29   INTERFACE set_grid_group_attributes
30      MODULE PROCEDURE set_gridgroup_attributes_id,set_gridgroup_attributes_hdl
31   END INTERFACE 
32   !----------------------------------------------------------------------------
33   
34   CONTAINS ! Fonctions disponibles pour les utilisateurs.
35
36
37
38   SUBROUTINE xios(set_grid_attr)(grid_id, name, description, domain_ref, axis_ref)
39      IMPLICIT NONE
40      TYPE(txios(grid))                             :: grid_hdl
41      CHARACTER(len = *)               , INTENT(IN) :: grid_id
42      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
43      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description
44      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
45      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
46     
47      CALL xios(get_grid_handle)(grid_id,grid_hdl)
48      CALL xios(set_grid_attr_hdl_)(grid_hdl, name, description, domain_ref, axis_ref)
49
50   END SUBROUTINE xios(set_grid_attr)
51   
52   SUBROUTINE xios(set_grid_attr_hdl)(grid_hdl, name, description, domain_ref, axis_ref)
53      IMPLICIT NONE
54      TYPE      (txios(grid))                      :: grid_hdl
55      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
56      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description
57      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
58      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
59     
60      CALL xios(set_grid_attr_hdl_)(grid_hdl, name, description, domain_ref, axis_ref)
61
62   END SUBROUTINE xios(set_grid_attr_hdl)   
63
64
65   SUBROUTINE xios(set_grid_attr_hdl_)(grid_hdl, name_, description_, domain_ref_, axis_ref_)
66      IMPLICIT NONE
67      TYPE      (txios(grid))                      :: grid_hdl
68      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
69      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
70      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
71      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
72     
73      IF (PRESENT(name_))        THEN
74       CALL cxios_set_grid_name(grid_hdl%daddr, name_, len(name_))
75      END IF
76      IF (PRESENT(description_)) THEN
77       CALL cxios_set_grid_description(grid_hdl%daddr, description_, len(description_))
78      END IF
79      IF (PRESENT(domain_ref_))  THEN
80       CALL cxios_set_grid_domain_ref(grid_hdl%daddr, domain_ref_, len(domain_ref_))
81      END IF
82      IF (PRESENT(axis_ref_))    THEN
83       CALL cxios_set_grid_axis_ref(grid_hdl%daddr, axis_ref_, len(axis_ref_))
84      END IF
85   END SUBROUTINE xios(set_grid_attr_hdl_)
86
87
88   
89   SUBROUTINE xios(set_gridgroup_attr)(gridgroup_id, name, description, domain_ref, axis_ref)
90      IMPLICIT NONE
91      TYPE(txios(gridgroup))                       :: gridgroup_hdl
92      CHARACTER(len = *)               , INTENT(IN) :: gridgroup_id
93      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
94      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description
95      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
96      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
97     
98      CALL xios(get_gridgroup_handle)(gridgroup_id, gridgroup_hdl)
99      CALL xios(set_gridgroup_attr_hdl_)(gridgroup_hdl, name, description, domain_ref, axis_ref)
100
101   END SUBROUTINE xios(set_gridgroup_attr)
102   
103   SUBROUTINE xios(set_gridgroup_attr_hdl)(gridgroup_hdl, name, description, domain_ref, axis_ref)
104      IMPLICIT NONE
105      TYPE      (txios(gridgroup))                 :: gridgroup_hdl
106      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name
107      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description
108      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref
109      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref
110
111      CALL xios(set_gridgroup_attr_hdl_)(gridgroup_hdl, name, description, domain_ref, axis_ref)
112
113   END SUBROUTINE xios(set_gridgroup_attr_hdl)
114   
115   SUBROUTINE xios(set_gridgroup_attr_hdl_)(gridgroup_hdl, name_, description_, domain_ref_, axis_ref_)
116      IMPLICIT NONE
117      TYPE      (txios(gridgroup))                 :: gridgroup_hdl
118      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
119      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
120      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
121      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
122     
123      IF (PRESENT(name_))        THEN
124       CALL cxios_set_gridgroup_name(gridgroup_hdl%daddr, name_, len(name_))
125      END IF
126      IF (PRESENT(description_)) THEN
127       CALL cxios_set_gridgroup_description(gridgroup_hdl%daddr, description_, len(description_))
128      END IF
129      IF (PRESENT(domain_ref_))  THEN
130       CALL cxios_set_gridgroup_domain_ref(gridgroup_hdl%daddr, domain_ref_, len(domain_ref_))
131      END IF
132      IF (PRESENT(axis_ref_))    THEN
133       CALL cxios_set_gridgroup_axis_ref(gridgroup_hdl%daddr, axis_ref_, len(axis_ref_))
134      END IF
135   END SUBROUTINE xios(set_gridgroup_attr_hdl_)
136   
137   
138
139   SUBROUTINE xios(get_grid_handle)(idt,ret)
140      IMPLICIT NONE
141      CHARACTER(len = *), INTENT(IN) :: idt     
142      TYPE(txios(grid)), INTENT(OUT):: ret
143
144      CALL cxios_grid_handle_create(ret%daddr, idt, len(idt))           
145
146   END SUBROUTINE xios(get_grid_handle)
147   
148   SUBROUTINE xios(get_gridgroup_handle)(idt,ret)
149      IMPLICIT NONE
150      CHARACTER(len = *)     , INTENT(IN) :: idt     
151      TYPE(txios(gridgroup))     , INTENT(OUT):: ret
152
153      CALL cxios_gridgroup_handle_create(ret%daddr, idt, len(idt))           
154
155   END SUBROUTINE xios(get_gridgroup_handle)
156
157   LOGICAL FUNCTION xios(is_valid_grid)(idt)
158      IMPLICIT NONE
159      CHARACTER(len  = *)    , INTENT(IN) :: idt
160      LOGICAL  (kind = 1)                 :: val
161
162      CALL cxios_grid_valid_id(val, idt, len(idt));
163      xios(is_valid_grid) = val
164
165   END FUNCTION  xios(is_valid_grid)
166
167   LOGICAL FUNCTION xios(is_valid_gridgroup)(idt)
168      IMPLICIT NONE
169      CHARACTER(len  = *)    , INTENT(IN) :: idt
170      LOGICAL  (kind = 1)                 :: val
171
172      CALL cxios_gridgroup_valid_id(val, idt, len(idt));
173      xios(is_valid_gridgroup) = val
174
175   END FUNCTION  xios(is_valid_gridgroup)
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197!!!!!!!!!!!!!!!!!!!!  Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!
198!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
199   
200   SUBROUTINE set_grid_attributes_id(grid_id, name_, description_, domain_ref_, axis_ref_)
201      IMPLICIT NONE
202      TYPE(XGridHandle)                             :: grid_hdl
203      CHARACTER(len = *)               , INTENT(IN) :: grid_id
204      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
205      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
206      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
207      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
208     
209      CALL grid_handle_create(grid_hdl, grid_id)
210      CALL set_grid_attributes_hdl(grid_hdl, name_, description_, domain_ref_, axis_ref_)
211
212   END SUBROUTINE set_grid_attributes_id
213
214   SUBROUTINE set_grid_attributes_hdl(grid_hdl, name_, description_, domain_ref_, axis_ref_)
215      IMPLICIT NONE
216      TYPE      (XGridHandle)                       :: grid_hdl
217      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
218      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
219      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
220      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
221     
222      IF (PRESENT(name_))        THEN
223       CALL cxios_set_grid_name(grid_hdl%daddr, name_, len(name_))
224      END IF
225      IF (PRESENT(description_)) THEN
226       CALL cxios_set_grid_description(grid_hdl%daddr, description_, len(description_))
227      END IF
228      IF (PRESENT(domain_ref_))  THEN
229       CALL cxios_set_grid_domain_ref(grid_hdl%daddr, domain_ref_, len(domain_ref_))
230      END IF
231      IF (PRESENT(axis_ref_))    THEN
232       CALL cxios_set_grid_axis_ref(grid_hdl%daddr, axis_ref_, len(axis_ref_))
233      END IF
234   END SUBROUTINE set_grid_attributes_hdl
235   
236   SUBROUTINE set_gridgroup_attributes_id(gridgroup_id, name_, description_, domain_ref_, axis_ref_)
237      IMPLICIT NONE
238      TYPE(XGridGroupHandle)                        :: gridgroup_hdl
239      CHARACTER(len = *)               , INTENT(IN) :: gridgroup_id
240      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
241      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
242      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
243      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
244     
245      CALL gridgroup_handle_create(gridgroup_hdl, gridgroup_id)
246      CALL set_gridgroup_attributes_hdl(gridgroup_hdl, name_, description_, domain_ref_, axis_ref_)
247
248   END SUBROUTINE set_gridgroup_attributes_id
249
250   SUBROUTINE set_gridgroup_attributes_hdl(gridgroup_hdl, name_, description_, domain_ref_, axis_ref_)
251      IMPLICIT NONE
252      TYPE      (XGridGroupHandle)                  :: gridgroup_hdl
253      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: name_
254      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: description_
255      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: domain_ref_
256      CHARACTER(len = *)     , OPTIONAL, INTENT(IN) :: axis_ref_
257     
258      IF (PRESENT(name_))        THEN
259       CALL cxios_set_gridgroup_name(gridgroup_hdl%daddr, name_, len(name_))
260      END IF
261      IF (PRESENT(description_)) THEN
262       CALL cxios_set_gridgroup_description(gridgroup_hdl%daddr, description_, len(description_))
263      END IF
264      IF (PRESENT(domain_ref_))  THEN
265       CALL cxios_set_gridgroup_domain_ref(gridgroup_hdl%daddr, domain_ref_, len(domain_ref_))
266      END IF
267      IF (PRESENT(axis_ref_))    THEN
268       CALL cxios_set_gridgroup_axis_ref(gridgroup_hdl%daddr, axis_ref_, len(axis_ref_))
269      END IF
270   END SUBROUTINE set_gridgroup_attributes_hdl
271
272   SUBROUTINE grid_handle_create(ret, idt)
273      IMPLICIT NONE
274      TYPE(XGridHandle), INTENT(OUT):: ret
275      CHARACTER(len = *), INTENT(IN) :: idt     
276      CALL cxios_grid_handle_create(ret%daddr, idt, len(idt))           
277   END SUBROUTINE grid_handle_create
278   
279   SUBROUTINE gridgroup_handle_create(ret, idt)
280      IMPLICIT NONE
281      TYPE(XGridGroupHandle), INTENT(OUT):: ret
282      CHARACTER(len = *)     , INTENT(IN) :: idt     
283      CALL cxios_gridgroup_handle_create(ret%daddr, idt, len(idt))           
284   END SUBROUTINE gridgroup_handle_create
285
286   LOGICAL FUNCTION grid_valid_id(idt)
287      IMPLICIT NONE
288      CHARACTER(len  = *)    , INTENT(IN) :: idt
289      LOGICAL  (kind = 1)                 :: val
290      CALL cxios_grid_valid_id(val, idt, len(idt));
291      grid_valid_id = val
292   END FUNCTION  grid_valid_id
293
294   LOGICAL FUNCTION gridgroup_valid_id(idt)
295      IMPLICIT NONE
296      CHARACTER(len  = *)    , INTENT(IN) :: idt
297      LOGICAL  (kind = 1)                 :: val
298      CALL cxios_gridgroup_valid_id(val, idt, len(idt));
299      gridgroup_valid_id = val
300   END FUNCTION  gridgroup_valid_id
301   
302END MODULE IGRID
Note: See TracBrowser for help on using the repository browser.