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

Last change on this file since 464 was 461, checked in by ymipsl, 10 years ago

New function available form fortran interface : LOGICAL xios_context_is_initialized("context_id")
Return .true. if the context "context_id" has been initialized before.

YM
File size: 8.6 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   END INTERFACE
101   
102   
103   CONTAINS ! Fonctions disponibles pour les utilisateurs.
104
105   SUBROUTINE  xios(init_server)()
106   IMPLICIT NONE
107     CALL cxios_init_server()
108   END SUBROUTINE xios(init_server)
109   
110   SUBROUTINE  xios(initialize)(client_id, local_comm, return_comm)
111   IMPLICIT NONE
112   INCLUDE 'mpif.h'
113   CHARACTER(LEN=*),INTENT(IN) :: client_id
114   INTEGER,INTENT(IN),OPTIONAL         :: local_comm 
115   INTEGER,INTENT(OUT),OPTIONAL        :: return_comm
116   INTEGER :: f_local_comm
117   INTEGER :: f_return_comm
118   
119      IF (PRESENT(local_comm)) THEN
120        f_local_comm=local_comm 
121      ELSE
122        f_local_comm = MPI_COMM_NULL 
123      ENDIF
124     
125      CALL cxios_init_client(client_id,LEN(client_id),f_local_comm,f_return_comm)
126 
127      IF (PRESENT(return_comm)) return_comm=f_return_comm
128
129   END SUBROUTINE  xios(initialize)
130
131
132   SUBROUTINE  xios(context_initialize)(context_id,comm)
133   IMPLICIT NONE
134   CHARACTER(LEN=*),INTENT(IN)  :: context_id
135   INTEGER, INTENT(IN)          :: comm
136     
137      CALL cxios_context_initialize(context_id,LEN(context_id),comm)
138 
139    END SUBROUTINE  xios(context_initialize)
140
141
142   LOGICAL FUNCTION  xios(context_is_initialized)(context_id)
143   USE ISO_C_BINDING
144   IMPLICIT NONE
145   CHARACTER(LEN=*),INTENT(IN)  :: context_id
146   LOGICAL(KIND=C_BOOL) :: is_init
147         
148      CALL cxios_context_is_initialized(context_id, LEN(context_id), is_init)
149      xios(context_is_initialized) = is_init
150 
151    END FUNCTION xios(context_is_initialized)   
152
153   
154   SUBROUTINE  xios(finalize)
155   IMPLICIT NONE
156
157      CALL cxios_finalize
158
159    END SUBROUTINE  xios(finalize)
160
161   
162   SUBROUTINE xios(close_context_definition)()
163   IMPLICIT NONE
164      CALL cxios_context_close_definition()
165   END SUBROUTINE xios(close_context_definition)
166
167   
168   SUBROUTINE xios(context_finalize)()
169   IMPLICIT NONE
170      CALL cxios_context_finalize()
171   END SUBROUTINE xios(context_finalize)
172   
173   SUBROUTINE xios(solve_inheritance)()
174   IMPLICIT NONE
175      CALL cxios_solve_inheritance()
176   END SUBROUTINE xios(solve_inheritance)
177 
178   
179   SUBROUTINE xios(send_field_r8_1d)(fieldid, data1d_k8)
180   IMPLICIT NONE
181      CHARACTER(len = *)               , INTENT(IN) :: fieldid
182      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data1d_k8(:)
183      CALL cxios_write_data_k81(fieldid, len(fieldid), data1d_k8, size(data1d_k8, 1))
184   END SUBROUTINE xios(send_field_r8_1d)
185   
186   SUBROUTINE  xios(send_field_r8_2d)(fieldid, data2d_k8)
187   IMPLICIT NONE
188      CHARACTER(len = *)               , INTENT(IN) :: fieldid
189      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data2d_k8(:,:)
190      CALL cxios_write_data_k82(fieldid, len(fieldid), data2d_k8, size(data2d_k8, 1), size(data2d_k8, 2))
191   END SUBROUTINE  xios(send_field_r8_2d)
192   
193   SUBROUTINE  xios(send_field_r8_3d)(fieldid, data3d_k8)
194   IMPLICIT NONE
195      CHARACTER(len = *)               , INTENT(IN) :: fieldid
196      REAL     (kind = 8), DIMENSION(*), INTENT(IN) :: data3d_k8(:,:,:)
197      CALL cxios_write_data_k83(fieldid, len(fieldid), data3d_k8, size(data3d_k8, 1), size(data3d_k8, 2), size(data3d_k8, 3))
198   END SUBROUTINE  xios(send_field_r8_3d)
199   
200   SUBROUTINE xios(send_field_r4_1d)(fieldid, data1d_k4)
201   IMPLICIT NONE
202      CHARACTER(len = *)               , INTENT(IN) :: fieldid
203      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data1d_k4(:)
204      CALL cxios_write_data_k41(fieldid, len(fieldid), data1d_k4, size(data1d_k4, 1))
205   END SUBROUTINE xios(send_field_r4_1d)
206   
207   SUBROUTINE xios(send_field_r4_2d)(fieldid, data2d_k4)
208   IMPLICIT NONE
209      CHARACTER(len = *)               , INTENT(IN) :: fieldid
210      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data2d_k4(:,:)
211      CALL cxios_write_data_k42(fieldid, len(fieldid), data2d_k4, size(data2d_k4, 1), size(data2d_k4, 2))
212   END SUBROUTINE xios(send_field_r4_2d)
213   
214   SUBROUTINE xios(send_field_r4_3d)(fieldid, data3d_k4)
215   IMPLICIT NONE
216      CHARACTER(len = *)               , INTENT(IN) :: fieldid
217      REAL     (kind = 4), DIMENSION(*), INTENT(IN) :: data3d_k4(:,:,:)
218      CALL cxios_write_data_k43(fieldid, len(fieldid), data3d_k4, size(data3d_k4, 1), size(data3d_k4, 2), size(data3d_k4, 3))
219   END SUBROUTINE xios(send_field_r4_3d)
220   
221   
222END MODULE IDATA
Note: See TracBrowser for help on using the repository browser.