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

Last change on this file since 285 was 285, checked in by hozdoba, 13 years ago
File size: 6.6 KB
Line 
1MODULE IFILE
2   USE, INTRINSIC :: ISO_C_BINDING
3   USE FILE_INTERFACE
4   USE FILEGROUP_INTERFACE
5   
6   TYPE XFileHandle
7      INTEGER(kind = C_INTPTR_T) :: daddr
8   END TYPE XFileHandle
9   
10   TYPE XFileGroupHandle
11      INTEGER(kind = C_INTPTR_T) :: daddr
12   END TYPE XFileGroupHandle
13   
14   !----------------------------------------------------------------------------
15   INTERFACE set_file_attributes
16      MODULE PROCEDURE set_file_attributes_id,set_file_attributes_hdl
17   END INTERFACE 
18   
19   INTERFACE set_file_group_attributes
20      MODULE PROCEDURE set_filegroup_attributes_id,set_filegroup_attributes_hdl
21   END INTERFACE 
22   !----------------------------------------------------------------------------
23 
24   CONTAINS ! Fonctions disponibles pour les utilisateurs.
25   
26   SUBROUTINE set_file_attributes_id(file_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
27      IMPLICIT NONE
28      TYPE(XFileHandle)                        :: file_hdl
29      CHARACTER(len = *)          , INTENT(IN) :: file_id
30      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
31      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
32      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
33      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
34      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
35      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
36     
37      CALL file_handle_create(file_hdl, file_id)
38      CALL set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
39     
40   END SUBROUTINE set_file_attributes_id
41   
42   SUBROUTINE set_file_attributes_hdl(file_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
43      TYPE(XFileHandle)           , INTENT(IN) :: file_hdl
44      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
45      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
46      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
47      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
48      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
49      LOGICAL(kind = 1)                        :: enabled__
50      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
51     
52      enabled__ = enabled_       
53      IF (PRESENT(name_))         THEN
54         CALL xios_set_file_name(file_hdl%daddr, name_, len(name_))
55      END IF
56      IF (PRESENT(description_))  THEN
57         CALL xios_set_file_description(file_hdl%daddr, description_, len(description_))
58      END IF
59      IF (PRESENT(name_suffix_))  THEN
60         CALL xios_set_file_name_suffix(file_hdl%daddr, name_suffix_, len(name_suffix_))
61      END IF
62      IF (PRESENT(output_freq_))  THEN
63         CALL xios_set_file_output_freq(file_hdl%daddr, output_freq_, len(output_freq_))
64      END IF
65      IF (PRESENT(output_level_)) THEN
66         CALL xios_set_file_output_level(file_hdl%daddr, output_level_)
67      END IF
68      IF (PRESENT(enabled_))      THEN
69         CALL xios_set_file_enabled(file_hdl%daddr, enabled__)
70      END IF
71
72   END SUBROUTINE set_file_attributes_hdl
73   
74   SUBROUTINE set_filegroup_attributes_id(filegroup_id, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
75      IMPLICIT NONE
76      TYPE(XFileGroupHandle)                   :: filegroup_hdl
77      CHARACTER(len = *)          , INTENT(IN) :: filegroup_id
78      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
79      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
80      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
81      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
82      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
83      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
84     
85      CALL filegroup_handle_create(filegroup_hdl, filegroup_id)
86      CALL set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
87     
88   END SUBROUTINE set_filegroup_attributes_id
89   
90   SUBROUTINE set_filegroup_attributes_hdl(filegroup_hdl, name_ , description_, name_suffix_, output_freq_, output_level_, enabled_)
91      IMPLICIT NONE
92      TYPE(XFileGroupHandle)      , INTENT(IN) :: filegroup_hdl
93      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_
94      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: description_
95      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: name_suffix_
96      CHARACTER(len = *), OPTIONAL, INTENT(IN) :: output_freq_
97      INTEGER           , OPTIONAL, INTENT(IN) :: output_level_
98      LOGICAL(kind = 1)                        :: enabled__
99      LOGICAL           , OPTIONAL, INTENT(IN) :: enabled_
100     
101      enabled__ = enabled_         
102      IF (PRESENT(name_))         THEN
103         CALL xios_set_filegroup_name(filegroup_hdl%daddr, name_, len(name_))
104      END IF
105      IF (PRESENT(description_))  THEN
106         CALL xios_set_filegroup_description(filegroup_hdl%daddr, description_, len(description_))
107      END IF
108      IF (PRESENT(name_suffix_))  THEN
109         CALL xios_set_filegroup_name_suffix(filegroup_hdl%daddr, name_suffix_, len(name_suffix_))
110      END IF
111      IF (PRESENT(output_freq_))  THEN
112         CALL xios_set_filegroup_output_freq(filegroup_hdl%daddr, output_freq_, len(output_freq_))
113      END IF
114      IF (PRESENT(output_level_)) THEN
115         CALL xios_set_filegroup_output_level(filegroup_hdl%daddr, output_level_)
116      END IF
117      IF (PRESENT(enabled_))      THEN
118         CALL xios_set_filegroup_enabled(filegroup_hdl%daddr, enabled__)
119      END IF
120
121   END SUBROUTINE set_filegroup_attributes_hdl
122   
123   SUBROUTINE file_handle_create(ret, idt)
124      IMPLICIT NONE
125      TYPE(XFileHandle) , INTENT(OUT):: ret
126      CHARACTER(len = *), INTENT(IN) :: idt     
127      CALL xios_file_handle_create(ret%daddr, idt, len(idt))           
128   END SUBROUTINE file_handle_create
129   
130   SUBROUTINE filegroup_handle_create(ret, idt)
131      IMPLICIT NONE
132      TYPE(XFileGroupHandle), INTENT(OUT):: ret
133      CHARACTER(len = *)    , INTENT(IN) :: idt     
134      CALL xios_filegroup_handle_create(ret%daddr, idt, len(idt))           
135   END SUBROUTINE filegroup_handle_create
136
137   LOGICAL FUNCTION file_valid_id(idt)
138      IMPLICIT NONE
139      CHARACTER(len  = *)    , INTENT(IN) :: idt
140      LOGICAL  (kind = 1)                 :: val
141      CALL xios_file_valid_id(val, idt, len(idt));
142      file_valid_id = val
143   END FUNCTION  file_valid_id
144
145   LOGICAL FUNCTION filegroup_valid_id(idt)
146      IMPLICIT NONE
147      CHARACTER(len  = *)    , INTENT(IN) :: idt
148      LOGICAL  (kind = 1)                 :: val
149      CALL xios_filegroup_valid_id(val, idt, len(idt));
150      filegroup_valid_id = val
151   END FUNCTION  filegroup_valid_id
152   
153END MODULE IFILE
Note: See TracBrowser for help on using the repository browser.