Context Navigation

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

Last change on this file since 369 was 369, checked in by ymipsl, 12 years ago

Major Update

redesign Type and attribute manipulation
add enumerate type and attribute
use blitz class array instead of boost class array

YM

File size: 42.4 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<<"}"<<iendl ;\
567	oss<<iendl; \
568	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
569	oss<<"{"<<iendl; \
570	oss<<" CArray<"<<typeName<<",1> tmp("<<name<<",shape(extent1),neverDeleteData) ;"<<iendl ;\
571	oss<<" tmp="<<className<<"_hdl->"<<name<<" ;"<<iendl ;\
572	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
573	oss<<"}"<<iendl ;\
574	}\
575	\
576	template <> \
577	void CInterface::AttributeCInterface<CArray<T,2> >(ostream& oss, const string& className,const string& name)\
578	{\
579	string typeName=getStrType<T>() ;\
580	\
581	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
582	oss<<"{"<<iendl ;\
583	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
584	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2),neverDeleteData) ;"<<iendl ;\
585	oss<<" "<<className<<"_hdl->"<<name<<".reference(tmp.copy());"<<iendl ;\
586	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
587	oss<<"}"<<iendl ;\
588	oss<<iendl; \
589	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
590	oss<<"{"<<iendl; \
591	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2),neverDeleteData) ;"<<iendl ;\
592	oss<<" tmp="<<className<<"_hdl->"<<name<<" ;"<<iendl ;\
593	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
594	oss<<"}"<<iendl ;\
595	}\
596	\
597	template <>\
598	void CInterface::AttributeCInterface<CArray<T,3> >(ostream& oss, const string& className,const string& name)\
599	{\
600	string typeName=getStrType<T>() ;\
601	\
602	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
603	oss<<"{"<<iendl ;\
604	oss<<" CTimer::get(\"XIOS\").resume();"<<iendl ; \
605	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2,extent3),neverDeleteData) ;"<<iendl ;\
606	oss<<" "<<className<<"_hdl->"<<name<<".reference(tmp.copy());"<<iendl ;\
607	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
608	oss<<"}"<<iendl ;\
609	oss<<iendl; \
610	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
611	oss<<"{"<<iendl; \
612	oss<<" CArray<"<<typeName<<",2> tmp("<<name<<",shape(extent1,extent2,extent3),neverDeleteData) ;"<<iendl ;\
613	oss<<" tmp="<<className<<"_hdl->"<<name<<" ;"<<iendl ;\
614	oss<<" CTimer::get(\"XIOS\").suspend();"<<iendl ;\
615	oss<<"}"<<iendl ;\
616	}
617
618	macro(bool)
619	macro(double)
620	macro(int)
621
622	#undef macro
623
624	// /////////////////////////////////////////////////
625	// // Fortran 2003 Interface //
626	// /////////////////////////////////////////////////
627
628
629
630	#define macro(T)\
631	template <>\
632	void CInterface::AttributeFortran2003Interface<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
633	{ \
634	string fortranType=getStrFortranType<T>() ; \
635	string fortranKindC=getStrFortranKindC<T>() ; \
636	\
637	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
638	oss<<" USE ISO_C_BINDING"<<iendl ; \
639	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
640	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
641	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
642	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
643	oss<<iendl; \
644	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
645	oss<<" USE ISO_C_BINDING"<<iendl ; \
646	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
647	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
648	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
649	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
650	} \
651	\
652	template <> \
653	void CInterface::AttributeFortran2003Interface<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
654	{ \
655	string fortranType=getStrFortranType<T>() ; \
656	string fortranKindC=getStrFortranKindC<T>() ; \
657	\
658	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
659	oss<<" USE ISO_C_BINDING"<<iendl ; \
660	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
661	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
662	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
663	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
664	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
665	oss<<iendl ; \
666	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
667	oss<<" USE ISO_C_BINDING"<<iendl ; \
668	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
669	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
670	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
671	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
672	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
673	} \
674	\
675	template <> \
676	void CInterface::AttributeFortran2003Interface<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
677	{ \
678	string fortranType=getStrFortranType<T>() ; \
679	string fortranKindC=getStrFortranKindC<T>() ; \
680	\
681	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
682	oss<<" USE ISO_C_BINDING"<<iendl ; \
683	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
684	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
685	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
686	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
687	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
688	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
689	oss<<iendl ;\
690	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
691	oss<<" USE ISO_C_BINDING"<<iendl ; \
692	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
693	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
694	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
695	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
696	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
697	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
698	}
699
700	macro(bool)
701	macro(double)
702	macro(int)
703
704	#undef macro
705
706
707	#define macro(T)\
708	template <> \
709	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
710	{ \
711	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:)"<<iendl ; \
712	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
713	} \
714	template <> \
715	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,1> >(ostream& oss,const string& className,const string& name) \
716	{ \
717	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:)"<<iendl ; \
718	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
719	} \
720	\
721	template <> \
722	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
723	{ \
724	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:)"<<iendl ; \
725	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
726	} \
727	\
728	template <> \
729	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,2> >(ostream& oss,const string& className,const string& name) \
730	{ \
731	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:)"<<iendl ; \
732	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
733	} \
734	\
735	template <> \
736	void CInterface::AttributeFortranInterfaceDeclaration<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
737	{ \
738	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:,:)"<<iendl ; \
739	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
740	}\
741	\
742	template <> \
743	void CInterface::AttributeFortranInterfaceGetDeclaration<CArray<T,3> >(ostream& oss,const string& className,const string& name) \
744	{ \
745	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:,:)"<<iendl ; \
746	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
747	}
748
749	macro(bool)
750	macro(double)
751	macro(int)
752
753	#undef macro
754
755
756
757	#define macro(T) \
758	template <> \
759	void CInterface::AttributeFortranInterfaceBody< CArray<T,1> >(ostream& oss,const string& className,const string& name) \
760	{ \
761	string name_tmp=name+"__tmp" ; \
762	\
763	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
764	if (!matchingTypeCFortran<T>()) \
765	{ \
766	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
767	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
768	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
769	} \
770	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
771	oss<<"ENDIF"<<iendl ; \
772	} \
773	\
774	template <> \
775	void CInterface::AttributeFortranInterfaceBody< CArray<T,2> >(ostream& oss,const string& className,const string& name) \
776	{ \
777	string name_tmp=name+"__tmp" ; \
778	\
779	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
780	if (!matchingTypeCFortran<T>()) \
781	{ \
782	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
783	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
784	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
785	} \
786	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
787	oss<<"ENDIF"<<iendl ; \
788	} \
789	\
790	template <> \
791	void CInterface::AttributeFortranInterfaceBody< CArray<T,3> >(ostream& oss,const string& className,const string& name) \
792	{ \
793	string name_tmp=name+"__tmp" ; \
794	\
795	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
796	if (!matchingTypeCFortran<T>()) \
797	{ \
798	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
799	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
800	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
801	} \
802	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
803	oss<<"ENDIF"<<iendl ; \
804	}
805
806	macro(bool)
807	macro(double)
808	macro(int)
809
810	#undef macro
811
812	#define macro(T) \
813	template <> \
814	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,1> >(ostream& oss,const string& className,const string& name) \
815	{ \
816	string name_tmp=name+"__tmp" ; \
817	\
818	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
819	if (!matchingTypeCFortran<T>()) \
820	{ \
821	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
822	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
823	oss<<" "<<name<<"_="<<name_tmp<<"_"<<iendl ; \
824	} \
825	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
826	oss<<"ENDIF"<<iendl ; \
827	} \
828	\
829	template <> \
830	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,2> >(ostream& oss,const string& className,const string& name) \
831	{ \
832	string name_tmp=name+"__tmp" ; \
833	\
834	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
835	if (!matchingTypeCFortran<T>()) \
836	{ \
837	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
838	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
839	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
840	} \
841	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
842	oss<<"ENDIF"<<iendl ; \
843	} \
844	\
845	template <> \
846	void CInterface::AttributeFortranInterfaceGetBody< CArray<T,3> >(ostream& oss,const string& className,const string& name) \
847	{ \
848	string name_tmp=name+"__tmp" ; \
849	\
850	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
851	if (!matchingTypeCFortran<T>()) \
852	{ \
853	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
854	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
855	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
856	} \
857	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
858	oss<<"ENDIF"<<iendl ; \
859	}
860
861	macro(bool)
862	macro(double)
863	macro(int)
864
865	#undef macro
866
867
868
869
870
871
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	#endif

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

Download in other formats: