Context Navigation

source: XIOS/branchs/xios-1.0/src/generate_interface_impl.hpp @ 1612

Last change on this file since 1612 was 581, checked in by rlacroix, 9 years ago
Fix the Fortran interface generation to avoid generating dead code that caused a timer not to be stopped.
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: 44.7 KB

Line
1	#ifndef __XIOS_GENERATE_INTERFACE_IMPL_HPP__
2	#define __XIOS_GENERATE_INTERFACE_IMPL_HPP__
3
4	#include "xmlioserver_spl.hpp"
5	#include "generate_interface.hpp"
6	#include "type_util.hpp"
7	#include "indent.hpp"
8	#include "enum.hpp"
9	#include "array_new.hpp"
10
11	namespace xios
12	{
13	template<> string CInterface::getStrFortranType<int>(void) {return string("INTEGER") ;}
14	template<> string CInterface::getStrFortranType<bool>(void) {return string("LOGICAL") ;}
15	template<> string CInterface::getStrFortranType<double>(void) {return string("REAL") ;}
16	template<> string CInterface::getStrFortranType<float>(void) {return string("REAL") ;}
17
18	template<> string CInterface::getStrFortranKind<int>(void) {return string("") ;}
19	template<> string CInterface::getStrFortranKind<bool>(void) {return string("") ;}
20	template<> string CInterface::getStrFortranKind<double>(void) {return string("(KIND=8)") ;}
21	template<> string CInterface::getStrFortranKind<float>(void) {return string("(KIND=4)") ;}
22
23	template<> string CInterface::getStrFortranKindC<int>(void) {return string("(KIND=C_INT)") ;}
24	template<> string CInterface::getStrFortranKindC<bool>(void) {return string("(KIND=C_BOOL)") ;}
25	template<> string CInterface::getStrFortranKindC<double>(void) {return string("(KIND=C_DOUBLE)") ;}
26	template<> string CInterface::getStrFortranKindC<float>(void) {return string("(KIND=C_FLOAT)") ;}
27
28	template<> bool CInterface::matchingTypeCFortran<int>(void) { return true ; }
29	template<> bool CInterface::matchingTypeCFortran<bool>(void) { return false ;}
30	template<> bool CInterface::matchingTypeCFortran<double>(void) { return true; }
31	template<> bool CInterface::matchingTypeCFortran<float>(void) { return true; }
32
33
34	// /////////////////////////////////////////////////
35	// // C Interface //
36	// /////////////////////////////////////////////////
37
38
39	void CInterface::AttributeIsDefinedCInterface(ostream& oss, const string& className,const string& name)
40	{
41	oss<<"bool cxios_is_defined_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl )"<<iendl ;
42	oss<<"{"<<iendl ;
43	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
44	oss<<" bool isDefined = "<<className<<"_hdl->"<<name<<".hasInheritedValue();"<<iendl ;
45	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
46	oss<<" return isDefined;"<<iendl ;
47	oss<<"}"<<iendl ;
48	oss<<iendl ;
49	}
50
51	template <class T>
52	void CInterface::AttributeCInterface(ostream& oss, const string& className,const string& name)
53	{
54	string typeName=getStrType<T>() ;
55
56	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<" "<<name<<")"<<iendl ;
57	oss<<"{"<<iendl ;
58	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
59	oss<<" "<<className<<"_hdl->"<<name<<".setValue("<<name<<");"<<iendl ;
60	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;
61	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
62	oss<<"}"<<iendl ;
63
64	oss<<iendl ;
65	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<")"<<iendl ;
66	oss<<"{"<<iendl;
67	oss<<" *"<<name<<" = "<<className<<"_hdl->"<<name<<".getInheritedValue();"<<iendl ;
68	oss<<"}"<<iendl ;
69	oss<<iendl ;
70	}
71
72
73	template<>
74	void CInterface::AttributeCInterface<string>(ostream& oss, const string& className,const string& name)
75	{
76	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, const char * "<<name<<", int "<<name<<"_size)"<<iendl ;
77	oss<<"{"<<iendl ;
78	oss<<" std::string "<<name<<"_str;"<<iendl;
79	oss<<" if(!cstr2string("<<name<<", "<<name<<"_size, "<<name<<"_str)) return;"<<iendl ;
80	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
81	oss<<" "<<className<<"_hdl->"<<name<<".setValue("<<name<<"_str);"<<iendl ;
82	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;
83	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
84	oss<<"}"<<iendl ;
85
86	oss<<iendl ;
87
88	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "<<name<<"_size)"<<iendl ;
89	oss<<"{"<<iendl ;
90	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
91	oss<<" if(!string_copy("<<className<<"_hdl->"<<name<<".getInheritedValue(),"<<name<<" , "<<name<<"_size))"<<iendl ;
92	oss<<" ERROR(\"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "
93	<<name<<"_size)\", <<\"Input string is to short\");"<<iendl ;
94	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
95	oss<<"}"<<iendl ;
96	oss<<iendl ;
97
98	}
99
100	template<>
101	void CInterface::AttributeCInterface<CEnumBase>(ostream& oss, const string& className,const string& name)
102	{
103	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, const char * "<<name<<", int "<<name<<"_size)"<<iendl ;
104	oss<<"{"<<iendl ;
105	oss<<" std::string "<<name<<"_str;"<<iendl;
106	oss<<" if(!cstr2string("<<name<<", "<<name<<"_size, "<<name<<"_str)) return;"<<iendl ;
107	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
108	oss<<" "<<className<<"_hdl->"<<name<<".fromString("<<name<<"_str);"<<iendl ;
109	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;
110	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
111	oss<<"}"<<iendl ;
112
113	oss<<iendl ;
114
115	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "<<name<<"_size)"<<iendl ;
116	oss<<"{"<<iendl ;
117	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ;
118	oss<<" if(!string_copy("<<className<<"_hdl->"<<name<<".getInheritedStringValue(),"<<name<<" , "<<name<<"_size))"<<iendl ;
119	oss<<" ERROR(\"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "
120	<<name<<"_size)\", <<\"Input string is to short\");"<<iendl ;
121	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;
122	oss<<"}"<<iendl ;
123	oss<<iendl ;
124
125	}
126	// if (!array_copy(domain_hdl->mask.getValue(), mask, extent1, extent2))
127	// ERROR("cxios_get_domain_mask(XDomainPtr domain_hdl, bool * mask, int extent1, int extent2)",<<"Output array size is not conform to array size attribut") ;
128
129	/*
130	#define macro(T) \
131	template <>\
132	void CInterface::AttributeCInterface<ARRAY(T,1)>(ostream& oss, const string& className,const string& name)\
133	{\
134	string typeName=getStrType<T>() ;\
135	\
136	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
137	oss<<"{"<<iendl ;\
138	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
139	oss<<" ARRAY("<<typeName<<",1) array_tmp(new CArray<"<<typeName<<",1>(boost::extents[extent1]));"<<iendl ;\
140	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
141	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
142	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
143	oss<<"}"<<iendl ;\
144	oss<<iendl; \
145	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
146	oss<<"{"<<iendl; \
147	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1))"<<iendl ; \
148	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)\",<<" \
149	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
150	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
151	oss<<"}"<<iendl ;\
152	}\
153	\
154	template <> \
155	void CInterface::AttributeCInterface<ARRAY(T,2)>(ostream& oss, const string& className,const string& name)\
156	{\
157	string typeName=getStrType<T>() ;\
158	\
159	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
160	oss<<"{"<<iendl ;\
161	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
162	oss<<" ARRAY("<<typeName<<",2) array_tmp(new CArray<"<<typeName<<",2>(boost::extents[extent1][extent2]));"<<iendl ;\
163	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
164	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
165	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
166	oss<<"}"<<iendl ;\
167	oss<<iendl; \
168	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
169	oss<<"{"<<iendl; \
170	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1, extent2))"<<iendl ; \
171	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)\",<<" \
172	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
173	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
174	oss<<"}"<<iendl ;\
175	}\
176	\
177	template <>\
178	void CInterface::AttributeCInterface<ARRAY(T,3)>(ostream& oss, const string& className,const string& name)\
179	{\
180	string typeName=getStrType<T>() ;\
181	\
182	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
183	oss<<"{"<<iendl ;\
184	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
185	oss<<" ARRAY("<<typeName<<",3) array_tmp(new CArray<"<<typeName<<",3>(boost::extents[extent1][extent2][extent3]));"<<iendl ;\
186	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
187	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
188	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
189	oss<<"}"<<iendl ;\
190	oss<<iendl; \
191	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
192	oss<<"{"<<iendl; \
193	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1))"<<iendl ; \
194	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)\",<<" \
195	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
196	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
197	oss<<"}"<<iendl ;\
198	}
199
200	macro(bool)
201	macro(double)
202	macro(int)
203	*/
204
205	#undef macro
206
207	// /////////////////////////////////////////////////
208	// // Fortran 2003 Interface //
209	// /////////////////////////////////////////////////
210	void CInterface::AttributeIsDefinedFortran2003Interface(ostream& oss,const string& className,const string& name)
211	{
212	oss<<"FUNCTION cxios_is_defined_"<<className<<"_"<<name<<"("<<className<<"_hdl ) BIND(C)"<<iendl ;
213	oss<<" USE ISO_C_BINDING"<<iendl ;
214	oss<<" LOGICAL(kind=C_BOOL) :: cxios_is_defined_"<<className<<"_"<<name<<iendl;
215	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
216	oss<<"END FUNCTION cxios_is_defined_"<<className<<"_"<<name<<iendl ;
217	}
218
219	template <class T>
220	void CInterface::AttributeFortran2003Interface(ostream& oss,const string& className,const string& name)
221	{
222	string fortranType=getStrFortranType<T>() ;
223	string fortranKindC=getStrFortranKindC<T>() ;
224
225	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<") BIND(C)"<<iendl ;
226	oss<<" USE ISO_C_BINDING"<<iendl ;
227	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
228	oss<<" "<<fortranType<<" "<<fortranKindC<<" , VALUE :: "<<name<<iendl ;
229	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ;
230	oss<<iendl ;
231	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<") BIND(C)"<<iendl ;
232	oss<<" USE ISO_C_BINDING"<<iendl ;
233	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
234	oss<<" "<<fortranType<<" "<<fortranKindC<<" :: "<<name<<iendl ;
235	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ;
236	oss<<iendl ;
237	}
238
239
240	template <>
241	void CInterface::AttributeFortran2003Interface<string>(ostream& oss,const string& className,const string& name)
242	{
243
244	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", "<<name<<"_size) BIND(C)"<<iendl ;
245	oss<<" USE ISO_C_BINDING"<<iendl ;
246	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
247	oss<<" CHARACTER(kind = C_CHAR) , DIMENSION(*) :: "<<name<<iendl ;
248	oss<<" INTEGER (kind = C_INT) , VALUE :: "<<name<<"_size"<<iendl ;
249	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ;
250	oss<<iendl ;
251	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", "<<name<<"_size) BIND(C)"<<iendl ;
252	oss<<" USE ISO_C_BINDING"<<iendl ;
253	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
254	oss<<" CHARACTER(kind = C_CHAR) , DIMENSION(*) :: "<<name<<iendl ;
255	oss<<" INTEGER (kind = C_INT) , VALUE :: "<<name<<"_size"<<iendl ;
256	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ;
257	oss<<iendl ;
258	}
259
260	/*
261	#define macro(T)\
262	template <>\
263	void CInterface::AttributeFortran2003Interface<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
264	{ \
265	string fortranType=getStrFortranType<T>() ; \
266	string fortranKindC=getStrFortranKindC<T>() ; \
267	\
268	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
269	oss<<" USE ISO_C_BINDING"<<iendl ; \
270	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
271	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
272	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
273	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
274	oss<<iendl; \
275	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
276	oss<<" USE ISO_C_BINDING"<<iendl ; \
277	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
278	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
279	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
280	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
281	} \
282	\
283	template <> \
284	void CInterface::AttributeFortran2003Interface<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
285	{ \
286	string fortranType=getStrFortranType<T>() ; \
287	string fortranKindC=getStrFortranKindC<T>() ; \
288	\
289	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
290	oss<<" USE ISO_C_BINDING"<<iendl ; \
291	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
292	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
293	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
294	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
295	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
296	oss<<iendl ; \
297	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
298	oss<<" USE ISO_C_BINDING"<<iendl ; \
299	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
300	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
301	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
302	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
303	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
304	} \
305	\
306	template <> \
307	void CInterface::AttributeFortran2003Interface<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
308	{ \
309	string fortranType=getStrFortranType<T>() ; \
310	string fortranKindC=getStrFortranKindC<T>() ; \
311	\
312	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
313	oss<<" USE ISO_C_BINDING"<<iendl ; \
314	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
315	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
316	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
317	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
318	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
319	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
320	oss<<iendl ;\
321	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
322	oss<<" USE ISO_C_BINDING"<<iendl ; \
323	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
324	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
325	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
326	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
327	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
328	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
329	}
330
331	macro(bool)
332	macro(double)
333	macro(int)
334
335	#undef macro
336	*/
337	template <class T>
338	void CInterface::AttributeFortranInterfaceDeclaration(ostream& oss,const string& className,const string& name)
339	{
340	oss<<getStrFortranType<T>()<<" "<< getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<iendl ;
341	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>()<<" :: "<<name<<"_tmp"<<iendl ;
342	}
343
344	template <class T>
345	void CInterface::AttributeFortranInterfaceGetDeclaration(ostream& oss,const string& className,const string& name)
346	{
347	oss<<getStrFortranType<T>()<<" "<< getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<iendl ;
348	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>()<<" :: "<<name<<"_tmp"<<iendl ;
349	}
350
351	void CInterface::AttributeFortranInterfaceIsDefinedDeclaration(ostream& oss,const string& className,const string& name)
352	{
353	oss<<"LOGICAL, OPTIONAL, INTENT(OUT) :: "<<name<<iendl ;
354	oss<<"LOGICAL(KIND=C_BOOL) :: "<<name<<"_tmp"<<iendl ;
355	}
356
357	template <>
358	void CInterface::AttributeFortranInterfaceDeclaration<string>(ostream& oss,const string& className,const string& name)
359	{
360	oss<<"CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: "<<name<<iendl ;
361	}
362
363	template <>
364	void CInterface::AttributeFortranInterfaceGetDeclaration<string>(ostream& oss,const string& className,const string& name)
365	{
366	oss<<"CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: "<<name<<iendl ;
367	}
368
369	/*
370	#define macro(T)\
371	template <> \
372	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
373	{ \
374	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:)"<<iendl ; \
375	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
376	} \
377	template <> \
378	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
379	{ \
380	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:)"<<iendl ; \
381	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
382	} \
383	\
384	template <> \
385	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
386	{ \
387	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:)"<<iendl ; \
388	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
389	} \
390	\
391	template <> \
392	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
393	{ \
394	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:)"<<iendl ; \
395	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
396	} \
397	\
398	template <> \
399	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
400	{ \
401	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:,:)"<<iendl ; \
402	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
403	}\
404	\
405	template <> \
406	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
407	{ \
408	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:,:)"<<iendl ; \
409	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
410	}
411
412	macro(bool)
413	macro(double)
414	macro(int)
415
416	#undef macro
417	*/
418
419	template <class T>
420	void CInterface::AttributeFortranInterfaceBody(ostream& oss,const string& className,const string& name)
421	{
422	string name_tmp=name+"__tmp" ;
423
424	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
425	if (!matchingTypeCFortran<T>())
426	{
427	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ;
428	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<")"<<iendl ;
429	}
430	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_)"<<iendl ;
431	oss<<"ENDIF"<<iendl ;
432	}
433
434	template <class T>
435	void CInterface::AttributeFortranInterfaceGetBody(ostream& oss,const string& className,const string& name)
436	{
437	string name_tmp=name+"__tmp" ;
438
439	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
440	if (!matchingTypeCFortran<T>())
441	{
442	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<")"<<iendl ;
443	oss<<" "<<name<<"_="<<name_tmp<<iendl ;
444	}
445	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_)"<<iendl ;
446	oss<<"ENDIF"<<iendl ;
447	}
448
449	void CInterface::AttributeFortranInterfaceIsDefinedBody(ostream& oss,const string& className,const string& name)
450	{
451	string name_tmp=name+"__tmp" ;
452
453	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
454	oss<<" "<<name<<"__tmp=cxios_is_defined_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr)"<<iendl ;
455	oss<<" "<<name<<"_="<<name_tmp<<iendl ;
456	oss<<"ENDIF"<<iendl ;
457	}
458
459	template <>
460	void CInterface::AttributeFortranInterfaceBody<string>(ostream& oss,const string& className,const string& name)
461	{
462	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
463	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_, len("<<name<<"_))"<<iendl ;
464	oss<<"ENDIF"<<iendl ;
465	}
466
467	template <>
468	void CInterface::AttributeFortranInterfaceGetBody<string>(ostream& oss,const string& className,const string& name)
469	{
470	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
471	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_, len("<<name<<"_))"<<iendl ;
472	oss<<"ENDIF"<<iendl ;
473	}
474
475	/*
476	#define macro(T) \
477	template <> \
478	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,1) >(ostream& oss,const string& className,const string& name) \
479	{ \
480	string name_tmp=name+"__tmp" ; \
481	\
482	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
483	if (!matchingTypeCFortran<T>()) \
484	{ \
485	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
486	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
487	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
488	} \
489	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
490	oss<<"ENDIF"<<iendl ; \
491	} \
492	\
493	template <> \
494	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,2) >(ostream& oss,const string& className,const string& name) \
495	{ \
496	string name_tmp=name+"__tmp" ; \
497	\
498	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
499	if (!matchingTypeCFortran<T>()) \
500	{ \
501	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
502	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
503	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
504	} \
505	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
506	oss<<"ENDIF"<<iendl ; \
507	} \
508	\
509	template <> \
510	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,3) >(ostream& oss,const string& className,const string& name) \
511	{ \
512	string name_tmp=name+"__tmp" ; \
513	\
514	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
515	if (!matchingTypeCFortran<T>()) \
516	{ \
517	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
518	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
519	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
520	} \
521	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
522	oss<<"ENDIF"<<iendl ; \
523	}
524
525	macro(bool)
526	macro(double)
527	macro(int)
528
529	#undef macro
530	*/
531
532	/*
533	#define macro(T) \
534	template <> \
535	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,1) >(ostream& oss,const string& className,const string& name) \
536	{ \
537	string name_tmp=name+"__tmp" ; \
538	\
539	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
540	if (!matchingTypeCFortran<T>()) \
541	{ \
542	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
543	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
544	oss<<" "<<name<<"_="<<name_tmp<<"_"<<iendl ; \
545	} \
546	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
547	oss<<"ENDIF"<<iendl ; \
548	} \
549	\
550	template <> \
551	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,2) >(ostream& oss,const string& className,const string& name) \
552	{ \
553	string name_tmp=name+"__tmp" ; \
554	\
555	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
556	if (!matchingTypeCFortran<T>()) \
557	{ \
558	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
559	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
560	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
561	} \
562	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
563	oss<<"ENDIF"<<iendl ; \
564	} \
565	\
566	template <> \
567	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,3) >(ostream& oss,const string& className,const string& name) \
568	{ \
569	string name_tmp=name+"__tmp" ; \
570	\
571	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
572	if (!matchingTypeCFortran<T>()) \
573	{ \
574	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
575	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
576	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
577	} \
578	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
579	oss<<"ENDIF"<<iendl ; \
580	}
581
582	macro(bool)
583	macro(double)
584	macro(int)
585
586	#undef macro
587	*/
588
589	// declaration for CArray
590
591
592
593
594	#define macro(T) \
595	template <>\
596	void CInterface::AttributeCInterface<CArray<T,1> >(ostream& oss, const string& className,const string& name)\
597	{\
598	string typeName=getStrType<T>() ;\
599	\
600	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
601	oss<<"{"<<iendl ;\
602	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
603	oss<<" CArray<"<<typeName<<",1> tmp("<<name<<",shape(extent1),neverDeleteData) ;"<<iendl ;\
604	oss<<" "<<className<<"_hdl->"<<name<<".reference(tmp.copy());"<<iendl ;\
605	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
606	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
607	oss<<"}"<<iendl ;\
608	oss<<iendl; \
609	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
610	oss<<"{"<<iendl; \
611	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
612	oss<<" CArray<"<<typeName<<",1> tmp("<<name<<",shape(extent1),neverDeleteData) ;"<<iendl ;\
613	oss<<" tmp="<<className<<"_hdl->"<<name<<".getInheritedValue() ;"<<iendl ;\
614	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
615	oss<<"}"<<iendl ;\
616	oss<<iendl ;\
617	}\
618	\
619	template <> \
620	void CInterface::AttributeCInterface<CArray<T,2> >(ostream& oss, const string& className,const string& name)\
621	{\
622	string typeName=getStrType<T>() ;\
623	\
624	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
625	oss<<"{"<<iendl ;\
626	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
627	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2),neverDeleteData) ;"<<iendl ;\
628	oss<<" "<<className<<"_hdl->"<<name<<".reference(tmp.copy());"<<iendl ;\
629	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
630	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
631	oss<<"}"<<iendl ;\
632	oss<<iendl; \
633	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
634	oss<<"{"<<iendl; \
635	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
636	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2),neverDeleteData) ;"<<iendl ;\
637	oss<<" tmp="<<className<<"_hdl->"<<name<<".getInheritedValue() ;"<<iendl ;\
638	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
639	oss<<"}"<<iendl ;\
640	oss<<iendl ;\
641	}\
642	\
643	template <>\
644	void CInterface::AttributeCInterface<CArray<T,3> >(ostream& oss, const string& className,const string& name)\
645	{\
646	string typeName=getStrType<T>() ;\
647	\
648	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
649	oss<<"{"<<iendl ;\
650	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
651	oss<<" CArray<"<<typeName<<",3> tmp("<<name<<",shape(extent1,extent2,extent3),neverDeleteData) ;"<<iendl ;\
652	oss<<" "<<className<<"_hdl->"<<name<<".reference(tmp.copy());"<<iendl ;\
653	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
654	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
655	oss<<"}"<<iendl ;\
656	oss<<iendl; \
657	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
658	oss<<"{"<<iendl; \
659	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
660	oss<<" CArray<"<<typeName<<",3> tmp("<<name<<",shape(extent1,extent2,extent3),neverDeleteData) ;"<<iendl ;\
661	oss<<" tmp="<<className<<"_hdl->"<<name<<".getInheritedValue() ;"<<iendl ;\
662	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
663	oss<<"}"<<iendl ;\
664	oss<<iendl ;\
665	}
666
667	macro(bool)
668	macro(double)
669	macro(int)
670
671	#undef macro
672
673	// /////////////////////////////////////////////////
674	// // Fortran 2003 Interface //
675	// /////////////////////////////////////////////////
676
677
678
679	#define macro(T)\
680	template <>\
681	void CInterface::AttributeFortran2003Interface<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
682	{ \
683	string fortranType=getStrFortranType<T>() ; \
684	string fortranKindC=getStrFortranKindC<T>() ; \
685	\
686	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
687	oss<<" USE ISO_C_BINDING"<<iendl ; \
688	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
689	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
690	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
691	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
692	oss<<iendl; \
693	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
694	oss<<" USE ISO_C_BINDING"<<iendl ; \
695	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
696	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
697	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
698	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
699	oss<<iendl ;\
700	} \
701	\
702	template <> \
703	void CInterface::AttributeFortran2003Interface<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
704	{ \
705	string fortranType=getStrFortranType<T>() ; \
706	string fortranKindC=getStrFortranKindC<T>() ; \
707	\
708	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
709	oss<<" USE ISO_C_BINDING"<<iendl ; \
710	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
711	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
712	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
713	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
714	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
715	oss<<iendl ; \
716	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
717	oss<<" USE ISO_C_BINDING"<<iendl ; \
718	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
719	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
720	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
721	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
722	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
723	oss<<iendl ;\
724	} \
725	\
726	template <> \
727	void CInterface::AttributeFortran2003Interface<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
728	{ \
729	string fortranType=getStrFortranType<T>() ; \
730	string fortranKindC=getStrFortranKindC<T>() ; \
731	\
732	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
733	oss<<" USE ISO_C_BINDING"<<iendl ; \
734	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
735	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
736	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
737	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
738	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
739	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
740	oss<<iendl ;\
741	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
742	oss<<" USE ISO_C_BINDING"<<iendl ; \
743	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
744	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
745	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
746	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
747	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
748	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
749	oss<<iendl ;\
750	}
751
752	macro(bool)
753	macro(double)
754	macro(int)
755
756	#undef macro
757
758
759	#define macro(T)\
760	template <> \
761	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
762	{ \
763	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:)"<<iendl ; \
764	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
765	} \
766	template <> \
767	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
768	{ \
769	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:)"<<iendl ; \
770	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
771	} \
772	\
773	template <> \
774	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
775	{ \
776	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:)"<<iendl ; \
777	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
778	} \
779	\
780	template <> \
781	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
782	{ \
783	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:)"<<iendl ; \
784	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
785	} \
786	\
787	template <> \
788	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
789	{ \
790	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:,:)"<<iendl ; \
791	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
792	}\
793	\
794	template <> \
795	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
796	{ \
797	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:,:)"<<iendl ; \
798	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
799	}
800
801	macro(bool)
802	macro(double)
803	macro(int)
804
805	#undef macro
806
807
808
809	#define macro(T) \
810	template <> \
811	void CInterface::AttributeFortranInterfaceBody< CArray<T,1> >(ostream& oss,const string& className,const string& name) \
812	{ \
813	string name_tmp=name+"__tmp" ; \
814	\
815	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
816	if (!matchingTypeCFortran<T>()) \
817	{ \
818	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
819	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
820	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
821	} \
822	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
823	oss<<"ENDIF"<<iendl ; \
824	} \
825	\
826	template <> \
827	void CInterface::AttributeFortranInterfaceBody< CArray<T,2> >(ostream& oss,const string& className,const string& name) \
828	{ \
829	string name_tmp=name+"__tmp" ; \
830	\
831	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
832	if (!matchingTypeCFortran<T>()) \
833	{ \
834	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
835	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
836	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
837	} \
838	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
839	oss<<"ENDIF"<<iendl ; \
840	} \
841	\
842	template <> \
843	void CInterface::AttributeFortranInterfaceBody< CArray<T,3> >(ostream& oss,const string& className,const string& name) \
844	{ \
845	string name_tmp=name+"__tmp" ; \
846	\
847	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
848	if (!matchingTypeCFortran<T>()) \
849	{ \
850	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
851	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
852	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
853	} \
854	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
855	oss<<"ENDIF"<<iendl ; \
856	}
857
858	macro(bool)
859	macro(double)
860	macro(int)
861
862	#undef macro
863
864	#define macro(T) \
865	template <> \
866	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,1> >(ostream& oss,const string& className,const string& name) \
867	{ \
868	string name_tmp=name+"__tmp" ; \
869	\
870	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
871	if (!matchingTypeCFortran<T>()) \
872	{ \
873	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
874	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
875	oss<<" "<<name<<"_="<<name_tmp<<"_"<<iendl ; \
876	} \
877	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
878	oss<<"ENDIF"<<iendl ; \
879	} \
880	\
881	template <> \
882	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,2> >(ostream& oss,const string& className,const string& name) \
883	{ \
884	string name_tmp=name+"__tmp" ; \
885	\
886	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
887	if (!matchingTypeCFortran<T>()) \
888	{ \
889	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
890	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
891	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
892	} \
893	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
894	oss<<"ENDIF"<<iendl ; \
895	} \
896	\
897	template <> \
898	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,3> >(ostream& oss,const string& className,const string& name) \
899	{ \
900	string name_tmp=name+"__tmp" ; \
901	\
902	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
903	if (!matchingTypeCFortran<T>()) \
904	{ \
905	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
906	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
907	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
908	} \
909	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
910	oss<<"ENDIF"<<iendl ; \
911	}
912
913	macro(bool)
914	macro(double)
915	macro(int)
916
917	#undef macro
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953	}
954
955	#endif

Note: See TracBrowser for help on using the repository browser.

Download in other formats: