source: XMLIO_V2/dev/common/src/xmlio/fortran/icontext.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: 8.4 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE ICONTEXT
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE CONTEXT_INTERFACE
6   USE IDATE
7
8   TYPE XContextHandle
9      INTEGER(kind = C_INTPTR_T) :: daddr
10   END TYPE XContextHandle
11   
12   TYPE txios(context)
13      INTEGER(kind = C_INTPTR_T) :: daddr
14   END TYPE txios(context)
15     
16   !----------------------------------------------------------------------------
17   INTERFACE set_context_attributes
18      MODULE PROCEDURE set_context_attributes_id,set_context_attributes_hdl
19   END INTERFACE 
20   !----------------------------------------------------------------------------
21   
22   CONTAINS ! Fonctions disponibles pour les utilisateurs.
23   
24   SUBROUTINE xios(set_context_attr)( context_id, calendar_type, start_date, output_dir)
25      IMPLICIT NONE
26      CHARACTER(len = *)            , INTENT(IN) :: context_id
27      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type
28      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date
29      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir
30         
31      CALL xios(set_context_attr_)( context_id, calendar_type, start_date, output_dir)
32   END SUBROUTINE xios(set_context_attr)
33
34
35   SUBROUTINE xios(set_context_attr_)( context_id, calendar_type_, start_date_, output_dir_)
36      IMPLICIT NONE
37      CHARACTER(len = *)            , INTENT(IN) :: context_id
38      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_
39      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_
40      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_
41      TYPE(txios(context))                      :: context_hdl
42         
43      CALL xios(get_context_handle)(context_id,context_hdl)
44      CALL xios(set_context_attr_hdl_)( context_hdl, calendar_type_, start_date_, output_dir_)
45   END SUBROUTINE xios(set_context_attr_)
46
47
48   SUBROUTINE xios(set_context_attr_hdl)( context_hdl, calendar_type, start_date, output_dir)
49      IMPLICIT NONE
50      TYPE(txios(context))          , INTENT(IN) :: context_hdl
51      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type
52      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date
53      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir   
54       
55      CALL  xios(set_context_attr_hdl_)( context_hdl, calendar_type, start_date, output_dir) 
56
57   END SUBROUTINE xios(set_context_attr_hdl)
58
59   SUBROUTINE xios(set_context_attr_hdl_)( context_hdl, calendar_type_, start_date_, output_dir_)
60      IMPLICIT NONE
61      TYPE(txios(context))          , INTENT(IN) :: context_hdl
62      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_
63      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_
64      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_   
65         
66      IF (PRESENT(calendar_type_)) THEN
67         CALL cxios_set_context_calendar_type(context_hdl%daddr, calendar_type_, len(calendar_type_))
68      END IF
69      IF (PRESENT(start_date_))    THEN
70         CALL cxios_set_context_start_date(context_hdl%daddr, start_date_, len(start_date_))
71      END IF
72      IF (PRESENT(output_dir_))    THEN
73         CALL cxios_set_context_output_dir(context_hdl%daddr, output_dir_, len(output_dir_))
74      END IF
75   END SUBROUTINE xios(set_context_attr_hdl_)
76
77
78
79   SUBROUTINE xios(get_context_handle)(idt,ret)
80      IMPLICIT NONE
81      CHARACTER(len = *)  , INTENT(IN)  :: idt     
82      TYPE(txios(context)), INTENT(OUT):: ret
83
84      CALL cxios_context_handle_create(ret%daddr, idt, len(idt))           
85   END SUBROUTINE xios(get_context_handle)
86   
87   SUBROUTINE xios(set_current_context)(context, withswap)
88      IMPLICIT NONE
89
90      TYPE(txios(context))          , INTENT(IN) :: context
91      LOGICAL             , OPTIONAL, INTENT(IN) :: withswap
92      LOGICAL (kind = 1)                       :: wswap
93
94      IF (PRESENT(withswap)) THEN
95         wswap = withswap
96      ELSE
97         wswap = .FALSE.
98      END IF
99      CALL cxios_context_set_current(context%daddr, wswap)
100
101   END SUBROUTINE xios(set_current_context)
102   
103   
104!   SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date)
105!      TYPE(XContextHandle)          , INTENT(OUT) :: context_hdl
106!      CHARACTER(len = *)            , INTENT(IN)  :: context_id
107!      INTEGER                       , INTENT(IN)  :: calendar_type
108!      TYPE(XDate)         , OPTIONAL, INTENT(IN)  :: init_date
109!     IF (PRESENT(init_date)) THEN
110!         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
111!                                  init_date%year, init_date%month, init_date%day, &
112!                                  init_date%hour, init_date%minute, init_date%second)
113!      ELSE
114!         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
115!                                 0, 1, 1, 0, 0, 0)
116!      END IF
117!   END SUBROUTINE context_create
118
119   LOGICAL FUNCTION xios(is_valid_context)(idt)
120      IMPLICIT NONE
121      CHARACTER(len  = *)    , INTENT(IN) :: idt
122      LOGICAL  (kind = 1)                 :: val
123
124      CALL cxios_context_valid_id(val, idt, len(idt));
125      xios(is_valid_context) = val
126
127   END FUNCTION  xios(is_valid_context)
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148!!!!!!!! ancienne interface
149
150   SUBROUTINE set_context_attributes_id( context_id, calendar_type_, start_date_, output_dir_)
151      IMPLICIT NONE
152      TYPE(XContextHandle)                       :: context_hdl
153      CHARACTER(len = *)            , INTENT(IN) :: context_id
154      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_
155      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_
156      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_
157         
158      CALL context_handle_create(context_hdl, context_id)
159      CALL set_context_attributes_hdl( context_hdl, calendar_type_, start_date_, output_dir_)
160   END SUBROUTINE set_context_attributes_id
161
162   SUBROUTINE set_context_attributes_hdl( context_hdl, calendar_type_, start_date_, output_dir_)
163      IMPLICIT NONE
164      TYPE(XContextHandle)          , INTENT(IN) :: context_hdl
165      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: calendar_type_
166      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: start_date_
167      CHARACTER(len = *)  , OPTIONAL, INTENT(IN) :: output_dir_   
168         
169      IF (PRESENT(calendar_type_)) THEN
170         CALL cxios_set_context_calendar_type(context_hdl%daddr, calendar_type_, len(calendar_type_))
171      END IF
172      IF (PRESENT(start_date_))    THEN
173         CALL cxios_set_context_start_date(context_hdl%daddr, start_date_, len(start_date_))
174      END IF
175      IF (PRESENT(output_dir_))    THEN
176         CALL cxios_set_context_output_dir(context_hdl%daddr, output_dir_, len(output_dir_))
177      END IF
178   END SUBROUTINE set_context_attributes_hdl
179
180   SUBROUTINE context_handle_create(ret, idt)
181      IMPLICIT NONE
182      TYPE(XContextHandle), INTENT(OUT):: ret
183      CHARACTER(len = *)  , INTENT(IN) :: idt     
184      CALL cxios_context_handle_create(ret%daddr, idt, len(idt))           
185   END SUBROUTINE context_handle_create
186   
187   SUBROUTINE context_set_current(context, withswap)
188      TYPE(XContextHandle)          , INTENT(IN) :: context
189      LOGICAL             , OPTIONAL, INTENT(IN) :: withswap
190      LOGICAL (kind = 1)                       :: wswap
191      IF (PRESENT(withswap)) THEN
192         wswap = withswap
193      ELSE
194         wswap = .FALSE.
195      END IF
196      CALL cxios_context_set_current(context%daddr, wswap)
197   END SUBROUTINE context_set_current
198   
199   SUBROUTINE context_create(context_hdl, context_id, calendar_type, init_date)
200      TYPE(XContextHandle)          , INTENT(OUT) :: context_hdl
201      CHARACTER(len = *)            , INTENT(IN)  :: context_id
202      INTEGER                       , INTENT(IN)  :: calendar_type
203      TYPE(XDate)         , OPTIONAL, INTENT(IN)  :: init_date
204      IF (PRESENT(init_date)) THEN
205         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
206                                  init_date%year, init_date%month, init_date%day, &
207                                  init_date%hour, init_date%minute, init_date%second)
208      ELSE
209         CALL cxios_context_create(context_hdl%daddr, context_id, len(context_id), calendar_type, &
210                                 0, 1, 1, 0, 0, 0)
211      END IF
212   END SUBROUTINE context_create
213
214   LOGICAL FUNCTION context_valid_id(idt)
215      IMPLICIT NONE
216      CHARACTER(len  = *)    , INTENT(IN) :: idt
217      LOGICAL  (kind = 1)                 :: val
218      CALL cxios_context_valid_id(val, idt, len(idt));
219      context_valid_id = val
220   END FUNCTION  context_valid_id
221
222
223   
224END MODULE ICONTEXT
Note: See TracBrowser for help on using the repository browser.