source: XMLIO_V2/dev/common/src/fortran/idata.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: 11.7 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_close_definition() BIND(C)
28         USE ISO_C_BINDING
29      END SUBROUTINE cxios_context_close_definition
30     
31
32       SUBROUTINE  cxios_context_finalize() BIND(C)
33         USE ISO_C_BINDING
34      END SUBROUTINE cxios_context_finalize
35     
36      SUBROUTINE  cxios_init_ioserver(comm_client,comm_parent) BIND(C)
37         USE ISO_C_BINDING
38         INTEGER  (kind = C_INT) :: comm_client
39         INTEGER  (kind = C_INT) :: comm_parent
40      END SUBROUTINE cxios_init_ioserver
41
42      SUBROUTINE  cxios_finalize_ioserver BIND(C)
43      END SUBROUTINE cxios_finalize_ioserver
44 
45      SUBROUTINE  cxios_finalize BIND(C)
46      END SUBROUTINE cxios_finalize
47
48      SUBROUTINE cxios_dtreatment_start() BIND(C)
49         USE ISO_C_BINDING
50      END SUBROUTINE cxios_dtreatment_start
51
52      SUBROUTINE cxios_dtreatment_end() BIND(C)
53         ! Sans argument
54      END SUBROUTINE cxios_dtreatment_end
55
56      SUBROUTINE cxios_write_data_k81(fieldid, fieldid_size, data_k8, data_Xsize) BIND(C)
57         USE ISO_C_BINDING
58         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
59         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
60         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
61         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize
62      END SUBROUTINE cxios_write_data_k81
63     
64      SUBROUTINE cxios_write_data_k82(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize) BIND(C)
65         USE ISO_C_BINDING
66         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
67         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
68         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
69         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize
70      END SUBROUTINE cxios_write_data_k82
71     
72      SUBROUTINE cxios_write_data_k83(fieldid, fieldid_size, data_k8, data_Xsize, data_Ysize, data_Zsize) BIND(C)
73         USE ISO_C_BINDING
74         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
75         REAL     (kind = C_DOUBLE), DIMENSION(*) :: data_k8
76         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
77         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize
78      END SUBROUTINE cxios_write_data_k83
79     
80      SUBROUTINE cxios_write_data_k41(fieldid, fieldid_size, data_k4, data_Xsize) BIND(C)
81         USE ISO_C_BINDING
82         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
83         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
84         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
85         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize
86      END SUBROUTINE cxios_write_data_k41
87     
88      SUBROUTINE cxios_write_data_k42(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize) BIND(C)
89         USE ISO_C_BINDING
90         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
91         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
92         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
93         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize
94      END SUBROUTINE cxios_write_data_k42
95     
96      SUBROUTINE cxios_write_data_k43(fieldid, fieldid_size, data_k4, data_Xsize, data_Ysize, data_Zsize) BIND(C)
97         USE ISO_C_BINDING
98         CHARACTER(kind = C_CHAR)  , DIMENSION(*) :: fieldid
99         REAL     (kind = C_FLOAT) , DIMENSION(*) :: data_k4
100         INTEGER  (kind = C_INT)   , VALUE        :: fieldid_size
101         INTEGER  (kind = C_INT)   , VALUE        :: data_Xsize, data_Ysize, data_Zsize
102      END SUBROUTINE cxios_write_data_k43
103     
104   END INTERFACE
105   
106   INTERFACE write_data
107      MODULE PROCEDURE write_data_k81,write_data_k82,write_data_k83,write_data_k41,write_data_k42,write_data_k43
108   END INTERFACE
109   
110   CONTAINS ! Fonctions disponibles pour les utilisateurs.
111
112   SUBROUTINE  xios(init_server)()
113   IMPLICIT NONE
114     CALL cxios_init_server()
115   END SUBROUTINE xios(init_server)
116   
117   SUBROUTINE  xios(initialize)(client_id, local_comm, return_comm)
118   IMPLICIT NONE
119   INCLUDE 'mpif.h'
120   CHARACTER(LEN=*),INTENT(IN) :: client_id
121   INTEGER,INTENT(IN),OPTIONAL         :: local_comm 
122   INTEGER,INTENT(OUT),OPTIONAL        :: return_comm
123   INTEGER :: f_local_comm
124   INTEGER :: f_return_comm
125   
126      IF (PRESENT(local_comm)) THEN
127        f_local_comm=local_comm 
128      ELSE
129        f_local_comm = MPI_COMM_NULL 
130      ENDIF
131     
132      CALL cxios_init_client(client_id,LEN(client_id),f_local_comm,f_return_comm)
133 
134      IF (PRESENT(return_comm)) return_comm=f_return_comm
135
136   END SUBROUTINE  xios(initialize)
137
138
139   SUBROUTINE  xios(context_initialize)(context_id,comm)
140   IMPLICIT NONE
141   CHARACTER(LEN=*),INTENT(IN)  :: context_id
142   INTEGER, INTENT(IN)          :: comm
143     
144      CALL cxios_context_initialize(context_id,LEN(context_id),comm)
145 
146    END SUBROUTINE  xios(context_initialize)
147   
148   
149   SUBROUTINE  xios(finalize)
150   IMPLICIT NONE
151
152      CALL cxios_finalize
153
154    END SUBROUTINE  xios(finalize)
155
156   
157   SUBROUTINE xios(close_context_definition)()
158   IMPLICIT NONE
159      CALL cxios_context_close_definition()
160   END SUBROUTINE xios(close_context_definition)
161
162   
163   SUBROUTINE xios(context_finalize)()
164   IMPLICIT NONE
165      CALL cxios_context_finalize()
166   END SUBROUTINE xios(context_finalize)
167   
168
169   
170   SUBROUTINE xios(send_field_r8_1d)(fieldid, data1d_k8)
171   IMPLICIT NONE
172      CHARACTER(len = *)               , INTENT(IN) :: fieldid
173      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data1d_k8(:)
174      CALL cxios_write_data_k81(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1))
175   END SUBROUTINE xios(send_field_r8_1d)
176   
177   SUBROUTINE  xios(send_field_r8_2d)(fieldid, data2d_k8)
178   IMPLICIT NONE
179      CHARACTER(len = *)               , INTENT(IN) :: fieldid
180      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data2d_k8(:,:)
181      CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2))
182   END SUBROUTINE  xios(send_field_r8_2d)
183   
184   SUBROUTINE  xios(send_field_r8_3d)(fieldid, data3d_k8)
185   IMPLICIT NONE
186      CHARACTER(len = *)               , INTENT(IN) :: fieldid
187      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data3d_k8(:,:,:)
188      CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
189   END SUBROUTINE  xios(send_field_r8_3d)
190   
191   SUBROUTINE xios(send_field_r4_1d)(fieldid, data1d_k4)
192   IMPLICIT NONE
193      CHARACTER(len = *)               , INTENT(IN) :: fieldid
194      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data1d_k4(:)
195      CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1))
196   END SUBROUTINE xios(send_field_r4_1d)
197   
198   SUBROUTINE xios(send_field_r4_2d)(fieldid, data2d_k4)
199   IMPLICIT NONE
200      CHARACTER(len = *)               , INTENT(IN) :: fieldid
201      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data2d_k4(:,:)
202      CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2))
203   END SUBROUTINE xios(send_field_r4_2d)
204   
205   SUBROUTINE xios(send_field_r4_3d)(fieldid, data3d_k4)
206   IMPLICIT NONE
207      CHARACTER(len = *)               , INTENT(IN) :: fieldid
208      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data3d_k4(:,:,:)
209      CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3))
210   END SUBROUTINE xios(send_field_r4_3d)
211   
212
213
214
215!!!!!!!!!!!!!! anciennes Interfaces !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
216!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
217
218   SUBROUTINE  init_ioserver(local_comm,return_comm )
219   IMPLICIT NONE
220   INCLUDE 'mpif.h'
221      INTEGER, INTENT(OUT),OPTIONAL :: return_comm
222      INTEGER, INTENT(IN),OPTIONAL :: local_comm
223
224      INTEGER  :: comm_client
225      INTEGER  :: comm_parent
226     
227      IF (PRESENT(local_comm)) THEN
228        comm_parent=local_comm
229      ELSE
230        comm_parent=MPI_COMM_WORLD
231      ENDIF
232     
233      CALL cxios_init_ioserver(comm_client,comm_parent)
234      IF (PRESENT(return_comm)) return_comm=comm_client ;
235
236    END SUBROUTINE  init_ioserver
237
238   SUBROUTINE  finalize_ioserver
239   IMPLICIT NONE
240
241      CALL cxios_finalize_ioserver
242
243    END SUBROUTINE  finalize_ioserver
244
245   
246   SUBROUTINE dtreatment_start(context_hdl, filetype)
247      TYPE(XContextHandle), INTENT(IN)           :: context_hdl
248      INTEGER             , INTENT(IN), OPTIONAL :: filetype 
249      INTEGER                                    :: filetype_
250      IF (PRESENT(filetype)) THEN
251         filetype_ = filetype
252      ELSE
253         filetype_ = NETCDF4
254      END IF
255      CALL context_set_current(context_hdl)
256      CALL cxios_dtreatment_start()
257   END SUBROUTINE dtreatment_start
258   
259   SUBROUTINE dtreatment_end(context_hdl)
260      TYPE(XContextHandle), INTENT(IN), OPTIONAL :: context_hdl
261      CALL cxios_dtreatment_end()
262   END SUBROUTINE dtreatment_end
263   
264   SUBROUTINE write_data_k81(fieldid, data1d_k8)
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 write_data_k81
269   
270   SUBROUTINE write_data_k82(fieldid, data2d_k8)
271      CHARACTER(len = *)               , INTENT(IN) :: fieldid
272      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data2d_k8(:,:)
273      CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2))
274   END SUBROUTINE write_data_k82
275   
276   SUBROUTINE write_data_k83(fieldid, data3d_k8)
277      CHARACTER(len = *)               , INTENT(IN) :: fieldid
278      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data3d_k8(:,:,:)
279      CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
280   END SUBROUTINE write_data_k83
281   
282   SUBROUTINE write_data_k41(fieldid, data1d_k4)
283      CHARACTER(len = *)               , INTENT(IN) :: fieldid
284      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data1d_k4(:)
285      CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1))
286   END SUBROUTINE write_data_k41
287   
288   SUBROUTINE write_data_k42(fieldid, data2d_k4)
289      CHARACTER(len = *)               , INTENT(IN) :: fieldid
290      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data2d_k4(:,:)
291      CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2))
292   END SUBROUTINE write_data_k42
293   
294   SUBROUTINE write_data_k43(fieldid, data3d_k4)
295      CHARACTER(len = *)               , INTENT(IN) :: fieldid
296      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data3d_k4(:,:,:)
297      CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3))
298   END SUBROUTINE write_data_k43
299   
300END MODULE IDATA
Note: See TracBrowser for help on using the repository browser.