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