source: XMLIO_V2/dev/common/src/fortran/ifile.F90 @ 300

Last change on this file since 300 was 300, checked in by ymipsl, 12 years ago

nouvelle version de developpement de xios

  • nouvelle interface fortran
  • recodage complet de la couche de communication
  • et bien d'autres choses...

YM
File size: 14.9 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, type)
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      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type
48           
49      CALL xios(get_file_handle)(file_id,file_hdl)
50      CALL xios(set_file_attr_hdl_)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled, type)
51     
52   END SUBROUTINE xios(set_file_attr)
53   
54
55   SUBROUTINE xios(set_file_attr_hdl)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled,type)
56      TYPE(txios(file))          , INTENT(IN) :: file_hdl
57      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
58      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
59      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
60      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
61      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
62      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
63      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type
64
65      CALL xios(set_file_attr_hdl_)(file_hdl, name , description, name_suffix, output_freq, output_level, enabled, type)
66     
67   END SUBROUTINE xios(set_file_attr_hdl)
68
69   SUBROUTINE xios(set_file_attr_hdl_)(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_, type_)
70      TYPE(txios(file))          , INTENT(IN) :: file_hdl
71      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
72      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
73      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
74      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
75      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
76      LOGICAL(kind = 1)                        :: enabled__
77      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
78      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type_
79           
80      IF (PRESENT(name_))         THEN
81         CALL cxios_set_file_name(file_hdl%daddr, name_, len(name_))
82      END IF
83      IF (PRESENT(description_))  THEN
84         CALL cxios_set_file_description(file_hdl%daddr, description_, len(description_))
85      END IF
86      IF (PRESENT(name_suffix_))  THEN
87         CALL cxios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_))
88      END IF
89      IF (PRESENT(output_freq_))  THEN
90         CALL cxios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_))
91      END IF
92      IF (PRESENT(output_level_)) THEN
93         CALL cxios_set_file_output_level(file_hdl%daddr, output_level_)
94      END IF
95      IF (PRESENT(enabled_))      THEN
96         enabled__ = enabled_       
97         CALL cxios_set_file_enabled(file_hdl%daddr, enabled__)
98      END IF
99     
100      IF (PRESENT(type_))         THEN
101         CALL cxios_set_file_type(file_hdl%daddr, type_, len(type_))
102      END IF
103     
104   END SUBROUTINE xios(set_file_attr_hdl_)
105
106
107   
108   SUBROUTINE xios(set_filegroup_attr)(filegroup_id, name , description, name_suffix, output_freq, output_level, enabled, type)
109      IMPLICIT NONE
110      TYPE(txios(filegroup))                  :: filegroup_hdl
111      CHARACTER(len = *)          , INTENT(IN) :: filegroup_id
112      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
113      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
114      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
115      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
116      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
117      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
118      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type
119     
120      CALL xios(get_filegroup_handle)(filegroup_id,filegroup_hdl)
121      CALL xios(set_filegroup_attr_hdl_)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled, type)
122     
123   END SUBROUTINE xios(set_filegroup_attr)
124
125
126   SUBROUTINE xios(set_filegroup_attr_hdl)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled, type)
127      IMPLICIT NONE
128      TYPE(txios(filegroup))     , INTENT(IN) :: filegroup_hdl
129      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name
130      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description
131      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix
132      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq
133      INTEGER           , OPTIONAL, INTENT(IN) :: output_level
134      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled
135      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type
136     
137     CALL xios(set_filegroup_attr_hdl_)(filegroup_hdl, name , description, name_suffix, output_freq, output_level, enabled, type)
138
139   END SUBROUTINE xios(set_filegroup_attr_hdl)
140     
141   
142   SUBROUTINE xios(set_filegroup_attr_hdl_)(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_,     &
143                   enabled_,type_)
144      IMPLICIT NONE
145      TYPE(txios(filegroup))     , INTENT(IN) :: filegroup_hdl
146      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
147      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
148      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
149      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
150      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
151      LOGICAL(kind = 1)                        :: enabled__
152      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
153      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: type_
154     
155      IF (PRESENT(name_))         THEN
156         CALL cxios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_))
157      END IF
158      IF (PRESENT(description_))  THEN
159         CALL cxios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_))
160      END IF
161      IF (PRESENT(name_suffix_))  THEN
162         CALL cxios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_))
163      END IF
164      IF (PRESENT(output_freq_))  THEN
165         CALL cxios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_))
166      END IF
167      IF (PRESENT(output_level_)) THEN
168         CALL cxios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_)
169      END IF
170      IF (PRESENT(enabled_))      THEN
171        enabled__ = enabled_ 
172        CALL cxios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__)
173      END IF
174     
175      IF (PRESENT(type_))         THEN
176         CALL cxios_set_filegroup_type(filegroup_hdl%daddr, type_, len(type_))
177      END IF
178
179   END SUBROUTINE xios(set_filegroup_attr_hdl_)
180
181
182
183   SUBROUTINE xios(get_file_handle)( idt, ret)
184      IMPLICIT NONE
185      CHARACTER(len = *),   INTENT(IN) :: idt     
186      TYPE(txios(file)) , INTENT(OUT):: ret
187
188      CALL cxios_file_handle_create(ret%daddr, idt, len(idt))           
189
190   END SUBROUTINE xios(get_file_handle)
191   
192   SUBROUTINE xios(get_filegroup_handle)(idt,ret)
193      IMPLICIT NONE
194      CHARACTER(len = *)    ,   INTENT(IN) :: idt     
195      TYPE(txios(filegroup)), INTENT(OUT):: ret
196
197      CALL cxios_filegroup_handle_create(ret%daddr, idt, len(idt))           
198
199   END SUBROUTINE xios(get_filegroup_handle)
200
201   LOGICAL FUNCTION xios(is_valid_file)(idt)
202      IMPLICIT NONE
203      CHARACTER(len  = *)    , INTENT(IN) :: idt
204      LOGICAL  (kind = 1)                 :: val
205
206      CALL cxios_file_valid_id(val, idt, len(idt));
207      xios(is_valid_file) = val
208
209   END FUNCTION  xios(is_valid_file)
210
211   LOGICAL FUNCTION xios(is_valid_filegroup)(idt)
212      IMPLICIT NONE
213      CHARACTER(len  = *)    , INTENT(IN) :: idt
214      LOGICAL  (kind = 1)                 :: val
215
216      CALL cxios_filegroup_valid_id(val, idt, len(idt));
217      xios(is_valid_filegroup) = val
218
219   END FUNCTION  xios(is_valid_filegroup)
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236!!!!!!!!!!!!!! Anciennes interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
237!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
238   
239   SUBROUTINE set_file_attributes_id(file_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
240      IMPLICIT NONE
241      TYPE(XFileHandle)                        :: file_hdl
242      CHARACTER(len = *)          , INTENT(IN) :: file_id
243      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
244      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
245      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
246      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
247      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
248      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
249     
250      CALL file_handle_create(file_hdl, file_id)
251      CALL set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
252     
253   END SUBROUTINE set_file_attributes_id
254   
255   SUBROUTINE set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
256      TYPE(XFileHandle)           , INTENT(IN) :: file_hdl
257      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
258      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
259      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
260      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
261      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
262      LOGICAL(kind = 1)                        :: enabled__
263      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
264     
265      IF (PRESENT(name_))         THEN
266         CALL cxios_set_file_name(file_hdl%daddr, name_, len(name_))
267      END IF
268      IF (PRESENT(description_))  THEN
269         CALL cxios_set_file_description(file_hdl%daddr, description_, len(description_))
270      END IF
271      IF (PRESENT(name_suffix_))  THEN
272         CALL cxios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_))
273      END IF
274      IF (PRESENT(output_freq_))  THEN
275         CALL cxios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_))
276      END IF
277      IF (PRESENT(output_level_)) THEN
278         CALL cxios_set_file_output_level(file_hdl%daddr, output_level_)
279      END IF
280      IF (PRESENT(enabled_))      THEN
281         enabled__ = enabled_       
282         CALL cxios_set_file_enabled(file_hdl%daddr, enabled__)
283      END IF
284
285   END SUBROUTINE set_file_attributes_hdl
286   
287   SUBROUTINE set_filegroup_attributes_id(filegroup_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
288      IMPLICIT NONE
289      TYPE(XFileGroupHandle)                   :: filegroup_hdl
290      CHARACTER(len = *)          , INTENT(IN) :: filegroup_id
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           , OPTIONAL, INTENT(IN) :: enabled_
297     
298      CALL filegroup_handle_create(filegroup_hdl, filegroup_id)
299      CALL set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
300     
301   END SUBROUTINE set_filegroup_attributes_id
302   
303   SUBROUTINE set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
304      IMPLICIT NONE
305      TYPE(XFileGroupHandle)      , INTENT(IN) :: filegroup_hdl
306      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
307      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
308      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
309      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
310      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
311      LOGICAL(kind = 1)                        :: enabled__
312      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
313     
314      IF (PRESENT(name_))         THEN
315         CALL cxios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_))
316      END IF
317      IF (PRESENT(description_))  THEN
318         CALL cxios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_))
319      END IF
320      IF (PRESENT(name_suffix_))  THEN
321         CALL cxios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_))
322      END IF
323      IF (PRESENT(output_freq_))  THEN
324         CALL cxios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_))
325      END IF
326      IF (PRESENT(output_level_)) THEN
327         CALL cxios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_)
328      END IF
329      IF (PRESENT(enabled_))      THEN
330        enabled__ = enabled_ 
331        CALL cxios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__)
332      END IF
333
334   END SUBROUTINE set_filegroup_attributes_hdl
335   
336   SUBROUTINE file_handle_create(ret, idt)
337      IMPLICIT NONE
338      TYPE(XFileHandle) , INTENT(OUT):: ret
339      CHARACTER(len = *), INTENT(IN) :: idt     
340      CALL cxios_file_handle_create(ret%daddr, idt, len(idt))           
341   END SUBROUTINE file_handle_create
342   
343   SUBROUTINE filegroup_handle_create(ret, idt)
344      IMPLICIT NONE
345      TYPE(XFileGroupHandle), INTENT(OUT):: ret
346      CHARACTER(len = *)    , INTENT(IN) :: idt     
347      CALL cxios_filegroup_handle_create(ret%daddr, idt, len(idt))           
348   END SUBROUTINE filegroup_handle_create
349
350   LOGICAL FUNCTION file_valid_id(idt)
351      IMPLICIT NONE
352      CHARACTER(len  = *)    , INTENT(IN) :: idt
353      LOGICAL  (kind = 1)                 :: val
354      CALL cxios_file_valid_id(val, idt, len(idt));
355      file_valid_id = val
356   END FUNCTION  file_valid_id
357
358   LOGICAL FUNCTION filegroup_valid_id(idt)
359      IMPLICIT NONE
360      CHARACTER(len  = *)    , INTENT(IN) :: idt
361      LOGICAL  (kind = 1)                 :: val
362      CALL cxios_filegroup_valid_id(val, idt, len(idt));
363      filegroup_valid_id = val
364   END FUNCTION  filegroup_valid_id
365   
366END MODULE IFILE
Note: See TracBrowser for help on using the repository browser.