Context Navigation

source: XIOS/trunk/src/generate_interface_impl.hpp @ 417

Last change on this file since 417 was 417, checked in by ymipsl, 11 years ago

correct tracing resume/suspend in generated fortran interface.

YM

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

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

Download in other formats: