source: XMLIO_V2/dev/common/src/xmlio/fortran/ifile.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.2 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IFILE
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE FILE_INTERFACE
6   USE FILEGROUP_INTERFACE
7   
8   TYPE XFileHandle
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE XFileHandle
11   
12   TYPE XFileGroupHandle
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE XFileGroupHandle
15
16   TYPE txios(file)
17      INTEGER(kind = C_INTPTR_T) :: daddr
18   END TYPE txios(file)
19   
20   TYPE txios(filegroup)
21      INTEGER(kind = C_INTPTR_T) :: daddr
22   END TYPE txios(filegroup)
23   
24   !----------------------------------------------------------------------------
25   INTERFACE set_file_attributes
26      MODULE PROCEDURE set_file_attributes_id,set_file_attributes_hdl
27   END INTERFACE 
28   
29   INTERFACE set_file_group_attributes
30      MODULE PROCEDURE set_filegroup_attributes_id,set_filegroup_attributes_hdl
31   END INTERFACE 
32   !----------------------------------------------------------------------------
33 
34   CONTAINS ! Fonctions disponibles pour les utilisateurs.
35
36
37   SUBROUTINE xios(set_file_attr)(file_id, name , description, name_suffix, output_freq, output_level, enabled)
38      IMPLICIT NONE
39      TYPE(txios(file))                       :: file_hdl
40      CHARACTER(len = *)          , INTENT(IN) :: file_id
41      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
42      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
43      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
44      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
45      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
46      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
47     
48      CALL xios(get_file_handle)(file_id,file_hdl)
49      CALL xios(set_file_attr_hdl_)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled)
50     
51   END SUBROUTINE xios(set_file_attr)
52   
53
54   SUBROUTINE xios(set_file_attr_hdl)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled)
55      TYPE(txios(file))          , INTENT(IN) :: file_hdl
56      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
57      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
58      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
59      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
60      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
61      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
62
63      CALL xios(set_file_attr_hdl_)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled)
64     
65   END SUBROUTINE xios(set_file_attr_hdl)
66
67   SUBROUTINE xios(set_file_attr_hdl_)(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
68      TYPE(txios(file))          , INTENT(IN) :: file_hdl
69      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
70      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
71      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
72      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
73      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
74      LOGICAL(kind = 1)                        :: enabled__
75      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
76     
77      IF (PRESENT(name_))         THEN
78         CALL cxios_set_file_name(file_hdl%daddr, name_, len(name_))
79      END IF
80      IF (PRESENT(description_))  THEN
81         CALL cxios_set_file_description(file_hdl%daddr, description_, len(description_))
82      END IF
83      IF (PRESENT(name_suffix_))  THEN
84         CALL cxios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_))
85      END IF
86      IF (PRESENT(output_freq_))  THEN
87         CALL cxios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_))
88      END IF
89      IF (PRESENT(output_level_)) THEN
90         CALL cxios_set_file_output_level(file_hdl%daddr, output_level_)
91      END IF
92      IF (PRESENT(enabled_))      THEN
93         enabled__ = enabled_       
94         CALL cxios_set_file_enabled(file_hdl%daddr, enabled__)
95      END IF
96
97   END SUBROUTINE xios(set_file_attr_hdl_)
98
99
100   
101   SUBROUTINE xios(set_filegroup_attr)(filegroup_id, name , description, name_suffix, output_freq, output_level, enabled)
102      IMPLICIT NONE
103      TYPE(txios(filegroup))                  :: filegroup_hdl
104      CHARACTER(len = *)          , INTENT(IN) :: filegroup_id
105      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
106      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
107      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
108      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
109      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
110      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
111     
112      CALL xios(get_filegroup_handle)(filegroup_id,filegroup_hdl)
113      CALL xios(set_filegroup_attr_hdl_)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled)
114     
115   END SUBROUTINE xios(set_filegroup_attr)
116
117
118   SUBROUTINE xios(set_filegroup_attr_hdl)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled)
119      IMPLICIT NONE
120      TYPE(txios(filegroup))     , INTENT(IN) :: filegroup_hdl
121      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
122      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
123      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
124      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
125      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
126      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
127     
128     CALL xios(set_filegroup_attr_hdl_)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled)
129
130   END SUBROUTINE xios(set_filegroup_attr_hdl)
131     
132   
133   SUBROUTINE xios(set_filegroup_attr_hdl_)(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
134      IMPLICIT NONE
135      TYPE(txios(filegroup))     , INTENT(IN) :: filegroup_hdl
136      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
137      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
138      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
139      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
140      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
141      LOGICAL(kind = 1)                        :: enabled__
142      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
143     
144      IF (PRESENT(name_))         THEN
145         CALL cxios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_))
146      END IF
147      IF (PRESENT(description_))  THEN
148         CALL cxios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_))
149      END IF
150      IF (PRESENT(name_suffix_))  THEN
151         CALL cxios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_))
152      END IF
153      IF (PRESENT(output_freq_))  THEN
154         CALL cxios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_))
155      END IF
156      IF (PRESENT(output_level_)) THEN
157         CALL cxios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_)
158      END IF
159      IF (PRESENT(enabled_))      THEN
160        enabled__ = enabled_ 
161        CALL cxios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__)
162      END IF
163
164   END SUBROUTINE xios(set_filegroup_attr_hdl_)
165
166
167
168   SUBROUTINE xios(get_file_handle)( idt, ret)
169      IMPLICIT NONE
170      CHARACTER(len = *),   INTENT(IN) :: idt     
171      TYPE(txios(file)) , INTENT(OUT):: ret
172
173      CALL cxios_file_handle_create(ret%daddr, idt, len(idt))           
174
175   END SUBROUTINE xios(get_file_handle)
176   
177   SUBROUTINE xios(get_filegroup_handle)(idt,ret)
178      IMPLICIT NONE
179      CHARACTER(len = *)    ,   INTENT(IN) :: idt     
180      TYPE(txios(filegroup)), INTENT(OUT):: ret
181
182      CALL cxios_filegroup_handle_create(ret%daddr, idt, len(idt))           
183
184   END SUBROUTINE xios(get_filegroup_handle)
185
186   LOGICAL FUNCTION xios(is_valid_file)(idt)
187      IMPLICIT NONE
188      CHARACTER(len  = *)    , INTENT(IN) :: idt
189      LOGICAL  (kind = 1)                 :: val
190
191      CALL cxios_file_valid_id(val, idt, len(idt));
192      xios(is_valid_file) = val
193
194   END FUNCTION  xios(is_valid_file)
195
196   LOGICAL FUNCTION xios(is_valid_filegroup)(idt)
197      IMPLICIT NONE
198      CHARACTER(len  = *)    , INTENT(IN) :: idt
199      LOGICAL  (kind = 1)                 :: val
200
201      CALL cxios_filegroup_valid_id(val, idt, len(idt));
202      xios(is_valid_filegroup) = val
203
204   END FUNCTION  xios(is_valid_filegroup)
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221!!!!!!!!!!!!!! Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
222!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
223   
224   SUBROUTINE set_file_attributes_id(file_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
225      IMPLICIT NONE
226      TYPE(XFileHandle)                        :: file_hdl
227      CHARACTER(len = *)          , INTENT(IN) :: file_id
228      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
229      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
230      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
231      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
232      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
233      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
234     
235      CALL file_handle_create(file_hdl, file_id)
236      CALL set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
237     
238   END SUBROUTINE set_file_attributes_id
239   
240   SUBROUTINE set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
241      TYPE(XFileHandle)           , INTENT(IN) :: file_hdl
242      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
243      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
244      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
245      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
246      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
247      LOGICAL(kind = 1)                        :: enabled__
248      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
249     
250      IF (PRESENT(name_))         THEN
251         CALL cxios_set_file_name(file_hdl%daddr, name_, len(name_))
252      END IF
253      IF (PRESENT(description_))  THEN
254         CALL cxios_set_file_description(file_hdl%daddr, description_, len(description_))
255      END IF
256      IF (PRESENT(name_suffix_))  THEN
257         CALL cxios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_))
258      END IF
259      IF (PRESENT(output_freq_))  THEN
260         CALL cxios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_))
261      END IF
262      IF (PRESENT(output_level_)) THEN
263         CALL cxios_set_file_output_level(file_hdl%daddr, output_level_)
264      END IF
265      IF (PRESENT(enabled_))      THEN
266         enabled__ = enabled_       
267         CALL cxios_set_file_enabled(file_hdl%daddr, enabled__)
268      END IF
269
270   END SUBROUTINE set_file_attributes_hdl
271   
272   SUBROUTINE set_filegroup_attributes_id(filegroup_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
273      IMPLICIT NONE
274      TYPE(XFileGroupHandle)                   :: filegroup_hdl
275      CHARACTER(len = *)          , INTENT(IN) :: filegroup_id
276      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
277      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
278      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
279      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
280      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
281      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
282     
283      CALL filegroup_handle_create(filegroup_hdl, filegroup_id)
284      CALL set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
285     
286   END SUBROUTINE set_filegroup_attributes_id
287   
288   SUBROUTINE set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
289      IMPLICIT NONE
290      TYPE(XFileGroupHandle)      , INTENT(IN) :: filegroup_hdl
291      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
292      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
293      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
294      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
295      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
296      LOGICAL(kind = 1)                        :: enabled__
297      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
298     
299      IF (PRESENT(name_))         THEN
300         CALL cxios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_))
301      END IF
302      IF (PRESENT(description_))  THEN
303         CALL cxios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_))
304      END IF
305      IF (PRESENT(name_suffix_))  THEN
306         CALL cxios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_))
307      END IF
308      IF (PRESENT(output_freq_))  THEN
309         CALL cxios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_))
310      END IF
311      IF (PRESENT(output_level_)) THEN
312         CALL cxios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_)
313      END IF
314      IF (PRESENT(enabled_))      THEN
315        enabled__ = enabled_ 
316        CALL cxios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__)
317      END IF
318
319   END SUBROUTINE set_filegroup_attributes_hdl
320   
321   SUBROUTINE file_handle_create(ret, idt)
322      IMPLICIT NONE
323      TYPE(XFileHandle) , INTENT(OUT):: ret
324      CHARACTER(len = *), INTENT(IN) :: idt     
325      CALL cxios_file_handle_create(ret%daddr, idt, len(idt))           
326   END SUBROUTINE file_handle_create
327   
328   SUBROUTINE filegroup_handle_create(ret, idt)
329      IMPLICIT NONE
330      TYPE(XFileGroupHandle), INTENT(OUT):: ret
331      CHARACTER(len = *)    , INTENT(IN) :: idt     
332      CALL cxios_filegroup_handle_create(ret%daddr, idt, len(idt))           
333   END SUBROUTINE filegroup_handle_create
334
335   LOGICAL FUNCTION file_valid_id(idt)
336      IMPLICIT NONE
337      CHARACTER(len  = *)    , INTENT(IN) :: idt
338      LOGICAL  (kind = 1)                 :: val
339      CALL cxios_file_valid_id(val, idt, len(idt));
340      file_valid_id = val
341   END FUNCTION  file_valid_id
342
343   LOGICAL FUNCTION filegroup_valid_id(idt)
344      IMPLICIT NONE
345      CHARACTER(len  = *)    , INTENT(IN) :: idt
346      LOGICAL  (kind = 1)                 :: val
347      CALL cxios_filegroup_valid_id(val, idt, len(idt));
348      filegroup_valid_id = val
349   END FUNCTION  filegroup_valid_id
350   
351END MODULE IFILE
Note: See TracBrowser for help on using the repository browser.