source: XIOS/trunk/src/interface/fortran/idata.F90 @ 532

Last change on this file since 532 was 501, checked in by ymipsl, 10 years ago

Add licence copyright to all file ond directory src using the command :
svn propset -R copyright -F header_licence src

XIOS is now officialy under CeCILL licence

YM
  • Property copyright set to
    Software name : XIOS (Xml I/O Server)
    http://forge.ipsl.jussieu.fr/ioserver
    Creation date : January 2009
    Licence : CeCCIL version2
    see license file in root directory : Licence_CeCILL_V2-en.txt
    or http://www.cecill.info/licences/Licence_CeCILL_V2-en.html
    Holder : CEA/LSCE (Laboratoire des Sciences du CLimat et de l'Environnement)
    CNRS/IPSL (Institut Pierre Simon Laplace)
    Project Manager : Yann Meurdesoif
    yann.meurdesoif@cea.fr
File size: 16.9 KB
Line 
1#include "xios_fortran_prefix.hpp"
2
3MODULE IDATA
4   USE, INTRINSIC :: ISO_C_BINDING
5   USE ICONTEXT
6
7   INTERFACE ! Ne pas appeler directement/Interface FORTRAN 2003 <-> C99
8
9      SUBROUTINE  cxios_init_server() BIND(C)
10      END SUBROUTINE cxios_init_server
11
12     SUBROUTINE cxios_init_client(client_id, len_client_id, f_local_comm, f_return_comm) BIND(C)
13         USE ISO_C_BINDING
14         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: client_id
15         INTEGER  (kind = C_INT)     , VALUE        :: len_client_id
16         INTEGER  (kind = C_INT)                    :: f_local_comm
17         INTEGER  (kind = C_INT)                    :: f_return_comm
18      END SUBROUTINE cxios_init_client
19
20      SUBROUTINE  cxios_context_initialize(context_id,len_context_id,f_comm) BIND(C)
21         USE ISO_C_BINDING
22         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: context_id
23         INTEGER  (kind = C_INT)     , VALUE        :: len_context_id
24         INTEGER  (kind = C_INT)                    :: f_comm
25      END SUBROUTINE cxios_context_initialize
26
27      SUBROUTINE cxios_context_is_initialized(context_id,len_context_id,initialized) BIND(C)
28         USE ISO_C_BINDING
29         CHARACTER(kind = C_CHAR)    , DIMENSION(*) :: context_id
30         INTEGER  (kind = C_INT)     , VALUE        :: len_context_id
31         LOGICAL  (kind = C_BOOL)                   :: initialized
32      END SUBROUTINE cxios_context_is_initialized
33
34
35       SUBROUTINE  cxios_context_close_definition() BIND(C)
36         USE ISO_C_BINDING
37      END SUBROUTINE cxios_context_close_definition
38
39
40       SUBROUTINE  cxios_context_finalize() BIND(C)
41         USE ISO_C_BINDING
42      END SUBROUTINE cxios_context_finalize
43
44
45      SUBROUTINE  cxios_finalize() BIND(C)
46      END SUBROUTINE cxios_finalize
47
48      SUBROUTINE  cxios_solve_inheritance() BIND(C)
49      END SUBROUTINE cxios_solve_inheritance
50
51
52      SUBROUTINE cxios_write_data_k81(fieldid, fieldid_size, data_k8, data_Xsize) BIND(C)
53         USE ISO_C_BINDING
54         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
55         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
56         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
57         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize
58      END SUBROUTINE cxios_write_data_k81
59
60      SUBROUTINE cxios_write_data_k82(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize) BIND(C)
61         USE ISO_C_BINDING
62         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
63         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
64         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
65         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize
66      END SUBROUTINE cxios_write_data_k82
67
68      SUBROUTINE cxios_write_data_k83(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C)
69         USE ISO_C_BINDING
70         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
71         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
72         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
73         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize
74      END SUBROUTINE cxios_write_data_k83
75
76      SUBROUTINE cxios_write_data_k41(fieldid, fieldid_size, data_k4, data_Xsize) BIND(C)
77         USE ISO_C_BINDING
78         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
79         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
80         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
81         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize
82      END SUBROUTINE cxios_write_data_k41
83
84      SUBROUTINE cxios_write_data_k42(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize) BIND(C)
85         USE ISO_C_BINDING
86         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
87         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
88         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
89         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize
90      END SUBROUTINE cxios_write_data_k42
91
92      SUBROUTINE cxios_write_data_k43(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize, data_Zsize) BIND(C)
93         USE ISO_C_BINDING
94         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
95         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
96         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
97         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize
98      END SUBROUTINE cxios_write_data_k43
99
100      ! Binding C and Fortran interface of get_variable (icdata.cpp)
101      SUBROUTINE cxios_get_variable_data_k8(vardid, varid_size, data_k8, is_var_existed) BIND(C)
102         USE ISO_C_BINDING
103         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
104         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
105         REAL     (kind = C_DOUBLE)               :: data_k8
106         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
107      END SUBROUTINE cxios_get_variable_data_k8
108
109      SUBROUTINE cxios_get_variable_data_k4(vardid, varid_size, data_k4, is_var_existed) BIND(C)
110         USE ISO_C_BINDING
111         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
112         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
113         REAL     (kind = C_FLOAT)                :: data_k4
114         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
115      END SUBROUTINE cxios_get_variable_data_k4
116
117      SUBROUTINE cxios_get_variable_data_int(vardid, varid_size, data_int, is_var_existed) BIND(C)
118         USE ISO_C_BINDING
119         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
120         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
121         INTEGER  (kind = C_INT)                  :: data_int
122         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
123      END SUBROUTINE cxios_get_variable_data_int
124
125      SUBROUTINE cxios_get_variable_data_logic(vardid, varid_size, data_logic, is_var_existed) BIND(C)
126         USE ISO_C_BINDING
127         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
128         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
129         LOGICAL  (kind = 4)                      :: data_logic
130         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
131      END SUBROUTINE cxios_get_variable_data_logic
132
133      SUBROUTINE cxios_get_variable_data_char(vardid, varid_size, data_char, data_size_in, is_var_existed) BIND(C)
134         USE ISO_C_BINDING
135         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
136         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
137         INTEGER  (kind = C_INT)   , VALUE        :: data_size_in
138         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: data_char
139         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
140      END SUBROUTINE cxios_get_variable_data_char
141
142      ! Binding C and Fortran interface of set_variable (icdata.cpp)
143      SUBROUTINE cxios_set_variable_data_k8(vardid, varid_size, data_k8, is_var_existed) BIND(C)
144         USE ISO_C_BINDING
145         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
146         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
147         REAL     (kind = C_DOUBLE), VALUE        :: data_k8
148         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
149      END SUBROUTINE cxios_set_variable_data_k8
150
151      SUBROUTINE cxios_set_variable_data_k4(vardid, varid_size, data_k4, is_var_existed) BIND(C)
152         USE ISO_C_BINDING
153         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
154         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
155         REAL     (kind = C_FLOAT) , VALUE        :: data_k4
156         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
157      END SUBROUTINE cxios_set_variable_data_k4
158
159      SUBROUTINE cxios_set_variable_data_int(vardid, varid_size, data_int, is_var_existed) BIND(C)
160         USE ISO_C_BINDING
161         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
162         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
163         INTEGER  (kind = C_INT)   , VALUE        :: data_int
164         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
165      END SUBROUTINE cxios_set_variable_data_int
166
167      SUBROUTINE cxios_set_variable_data_logic(vardid, varid_size, data_logic, is_var_existed) BIND(C)
168         USE ISO_C_BINDING
169         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
170         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
171         LOGICAL  (kind = 4)       , VALUE        :: data_logic
172         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
173      END SUBROUTINE cxios_set_variable_data_logic
174
175      SUBROUTINE cxios_set_variable_data_char(vardid, varid_size, data_char, data_size_in, is_var_existed) BIND(C)
176         USE ISO_C_BINDING
177         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: vardid
178         INTEGER  (kind = C_INT)   , VALUE        :: varid_size
179         INTEGER  (kind = C_INT)   , VALUE        :: data_size_in
180         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: data_char
181         LOGICAL  (kind = C_BOOL)                 :: is_var_existed
182      END SUBROUTINE cxios_set_variable_data_char
183
184   END INTERFACE
185
186
187   CONTAINS ! Fonctions disponibles pour les utilisateurs.
188
189   SUBROUTINE  xios(init_server)()
190   IMPLICIT NONE
191     CALL cxios_init_server()
192   END SUBROUTINE xios(init_server)
193
194   SUBROUTINE  xios(initialize)(client_id, local_comm, return_comm)
195   IMPLICIT NONE
196   INCLUDE 'mpif.h'
197   CHARACTER(LEN=*),INTENT(IN) :: client_id
198   INTEGER,INTENT(IN),OPTIONAL         :: local_comm
199   INTEGER,INTENT(OUT),OPTIONAL        :: return_comm
200   INTEGER :: f_local_comm
201   INTEGER :: f_return_comm
202
203      IF (PRESENT(local_comm)) THEN
204        f_local_comm=local_comm
205      ELSE
206        f_local_comm = MPI_COMM_NULL
207      ENDIF
208
209      CALL cxios_init_client(client_id,LEN(client_id),f_local_comm,f_return_comm)
210
211      IF (PRESENT(return_comm)) return_comm=f_return_comm
212
213   END SUBROUTINE  xios(initialize)
214
215
216   SUBROUTINE  xios(context_initialize)(context_id,comm)
217   IMPLICIT NONE
218   CHARACTER(LEN=*),INTENT(IN)  :: context_id
219   INTEGER, INTENT(IN)          :: comm
220
221      CALL cxios_context_initialize(context_id,LEN(context_id),comm)
222
223    END SUBROUTINE  xios(context_initialize)
224
225
226   LOGICAL FUNCTION  xios(context_is_initialized)(context_id)
227   USE ISO_C_BINDING
228   IMPLICIT NONE
229   CHARACTER(LEN=*),INTENT(IN)  :: context_id
230   LOGICAL(KIND=C_BOOL) :: is_init
231
232      CALL cxios_context_is_initialized(context_id, LEN(context_id), is_init)
233      xios(context_is_initialized) = is_init
234
235    END FUNCTION xios(context_is_initialized)
236
237
238   SUBROUTINE  xios(finalize)
239   IMPLICIT NONE
240
241      CALL cxios_finalize
242
243    END SUBROUTINE  xios(finalize)
244
245
246   SUBROUTINE xios(close_context_definition)()
247   IMPLICIT NONE
248      CALL cxios_context_close_definition()
249   END SUBROUTINE xios(close_context_definition)
250
251
252   SUBROUTINE xios(context_finalize)()
253   IMPLICIT NONE
254      CALL cxios_context_finalize()
255   END SUBROUTINE xios(context_finalize)
256
257   SUBROUTINE xios(solve_inheritance)()
258   IMPLICIT NONE
259      CALL cxios_solve_inheritance()
260   END SUBROUTINE xios(solve_inheritance)
261
262
263   SUBROUTINE xios(send_field_r8_1d)(fieldid, data1d_k8)
264   IMPLICIT NONE
265      CHARACTER(len = *)               , INTENT(IN) :: fieldid
266      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data1d_k8(:)
267      CALL cxios_write_data_k81(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1))
268   END SUBROUTINE xios(send_field_r8_1d)
269
270   SUBROUTINE  xios(send_field_r8_2d)(fieldid, data2d_k8)
271   IMPLICIT NONE
272      CHARACTER(len = *)               , INTENT(IN) :: fieldid
273      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data2d_k8(:,:)
274      CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2))
275   END SUBROUTINE  xios(send_field_r8_2d)
276
277   SUBROUTINE  xios(send_field_r8_3d)(fieldid, data3d_k8)
278   IMPLICIT NONE
279      CHARACTER(len = *)               , INTENT(IN) :: fieldid
280      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data3d_k8(:,:,:)
281      CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
282   END SUBROUTINE  xios(send_field_r8_3d)
283
284   SUBROUTINE xios(send_field_r4_1d)(fieldid, data1d_k4)
285   IMPLICIT NONE
286      CHARACTER(len = *)               , INTENT(IN) :: fieldid
287      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data1d_k4(:)
288      CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1))
289   END SUBROUTINE xios(send_field_r4_1d)
290
291   SUBROUTINE xios(send_field_r4_2d)(fieldid, data2d_k4)
292   IMPLICIT NONE
293      CHARACTER(len = *)               , INTENT(IN) :: fieldid
294      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data2d_k4(:,:)
295      CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2))
296   END SUBROUTINE xios(send_field_r4_2d)
297
298   SUBROUTINE xios(send_field_r4_3d)(fieldid, data3d_k4)
299   IMPLICIT NONE
300      CHARACTER(len = *)               , INTENT(IN) :: fieldid
301      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data3d_k4(:,:,:)
302      CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3))
303   END SUBROUTINE xios(send_field_r4_3d)
304
305   ! Get variable functions
306   LOGICAL FUNCTION xios(getVar_k8)(varId, data_k8)
307   IMPLICIT NONE
308      LOGICAL  (kind = 1)                           :: val
309      CHARACTER(len = *)               , INTENT(IN) :: varId
310      REAL     (kind = 8)              , INTENT(OUT):: data_k8
311
312      CALL cxios_get_variable_data_k8(varId, len(varId), data_k8, val)
313
314      xios(getVar_k8) = val
315   END FUNCTION xios(getVar_k8)
316
317   LOGICAL FUNCTION xios(getVar_k4)(varId, data_k4)
318   IMPLICIT NONE
319      LOGICAL  (kind = 1)                           :: val
320      CHARACTER(len = *)               , INTENT(IN) :: varId
321      REAL     (kind = 4)              , INTENT(OUT):: data_k4
322
323      CALL cxios_get_variable_data_k4(varId, len(varId), data_k4, val)
324
325      xios(getVar_k4) = val
326   END FUNCTION xios(getVar_k4)
327
328   LOGICAL FUNCTION xios(getVar_int)(varId, data_int)
329   IMPLICIT NONE
330      LOGICAL  (kind = 1)                           :: val
331      CHARACTER(len = *)               , INTENT(IN) :: varId
332      INTEGER                          , INTENT(OUT):: data_int
333
334      CALL cxios_get_variable_data_int(varId, len(varId), data_int, val)
335
336      xios(getVar_int) = val
337   END FUNCTION xios(getVar_int)
338
339   LOGICAL FUNCTION xios(getVar_logic)(varId, data_logic)
340   IMPLICIT NONE
341      LOGICAL  (kind = 1)                           :: val
342      CHARACTER(len  = *)              , INTENT(IN) :: varId
343      LOGICAL  (kind = 4)              , INTENT(OUT):: data_logic
344
345      CALL cxios_get_variable_data_logic(varId, len(varId), data_logic, val)
346
347      xios(getVar_logic) = val
348   END FUNCTION xios(getVar_logic)
349
350   LOGICAL FUNCTION xios(getVar_char)(varId, data_char)
351   IMPLICIT NONE
352      LOGICAL  (kind = 1)                           :: val
353      CHARACTER(len  = *)              , INTENT(IN) :: varId
354      CHARACTER(len  = *)              , INTENT(OUT):: data_char
355
356      CALL cxios_get_variable_data_char(varId, len(varId), data_char, len(data_char), val)
357
358      xios(getVar_char) = val
359   END FUNCTION xios(getVar_char)
360
361   ! Set variable functions
362   LOGICAL FUNCTION xios(setVar_k8)(varId, data_k8)
363   IMPLICIT NONE
364      LOGICAL  (kind = 1)                           :: val
365      CHARACTER(len = *)               , INTENT(IN) :: varId
366      REAL     (kind = 8)              , INTENT(IN) :: data_k8
367
368      CALL cxios_set_variable_data_k8(varId, len(varId), data_k8, val)
369
370      xios(setVar_k8) = val
371   END FUNCTION xios(setVar_k8)
372
373   LOGICAL FUNCTION xios(setVar_k4)(varId, data_k4)
374   IMPLICIT NONE
375      LOGICAL  (kind = 1)                           :: val
376      CHARACTER(len = *)               , INTENT(IN) :: varId
377      REAL     (kind = 4)              , INTENT(IN) :: data_k4
378
379      CALL cxios_set_variable_data_k4(varId, len(varId), data_k4, val)
380
381      xios(setVar_k4) = val
382   END FUNCTION xios(setVar_k4)
383
384   LOGICAL FUNCTION xios(setVar_int)(varId, data_int)
385   IMPLICIT NONE
386      LOGICAL  (kind = 1)                           :: val
387      CHARACTER(len = *)               , INTENT(IN) :: varId
388      INTEGER                          , INTENT(IN) :: data_int
389
390      CALL cxios_set_variable_data_int(varId, len(varId), data_int, val)
391
392      xios(setVar_int) = val
393   END FUNCTION xios(setVar_int)
394
395   LOGICAL FUNCTION xios(setVar_logic)(varId, data_logic)
396   IMPLICIT NONE
397      LOGICAL  (kind = 1)                           :: val
398      CHARACTER(len  = *)              , INTENT(IN) :: varId
399      LOGICAL  (kind = 4)              , INTENT(IN) :: data_logic
400
401      CALL cxios_set_variable_data_logic(varId, len(varId), data_logic, val)
402
403      xios(setVar_logic) = val
404   END FUNCTION xios(setVar_logic)
405
406   LOGICAL FUNCTION xios(setVar_char)(varId, data_char)
407   IMPLICIT NONE
408      LOGICAL  (kind = 1)                           :: val
409      CHARACTER(len  = *)              , INTENT(IN) :: varId
410      CHARACTER(len  = *)              , INTENT(IN) :: data_char
411
412      CALL cxios_set_variable_data_char(varId, len(varId), data_char, len(data_char), val)
413
414      xios(setVar_char) = val
415   END FUNCTION xios(setVar_char)
416
417END MODULE IDATA
Note: See TracBrowser for help on using the repository browser.