Context Navigation

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

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

Fortran attribut interface are now automaticaly generated.
Add get attribut fonctionnality from fortran.

YM

File size: 23.6 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
9	namespace xmlioserver
10	{
11
12
13	// /////////////////////////////////////////////////
14	// // C Interface //
15	// /////////////////////////////////////////////////
16
17	template <class T>
18	void CInterface::AttributeCInterface(ostream& oss, const string& className,const string& name)
19	{
20	string typeName=getStrType<T>() ;
21
22	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<" "<<name<<")"<<iendl ;
23	oss<<"{"<<iendl ;
24	oss<<" "<<className<<"_hdl->"<<name<<".setValue("<<name<<");"<<iendl ;
25	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;
26	oss<<"}"<<iendl ;
27
28	oss<<iendl ;
29	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<")"<<iendl ;
30	oss<<"{"<<iendl;
31	oss<<" *"<<name<<" = "<<className<<"_hdl->"<<name<<".getValue();"<<iendl ;
32	oss<<"}"<<iendl ;
33	}
34
35
36	template<>
37	void CInterface::AttributeCInterface<string>(ostream& oss, const string& className,const string& name)
38	{
39	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, const char * "<<name<<", int "<<name<<"_size)"<<iendl ;
40	oss<<"{"<<iendl ;
41	oss<<" std::string "<<name<<"_str;"<<iendl;
42	oss<<" if(!cstr2string("<<name<<", "<<name<<"_size, "<<name<<"_str)) return;"<<iendl ;
43	oss<<" "<<className<<"_hdl->"<<name<<".setValue("<<name<<"_str);"<<iendl ;
44	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;
45	oss<<"}"<<iendl ;
46
47	oss<<iendl ;
48
49	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "<<name<<"_size)"<<iendl ;
50	oss<<"{"<<iendl ;
51	oss<<" if(!string_copy("<<className<<"_hdl->"<<name<<".getValue(),"<<name<<" , "<<name<<"_size))"<<iendl ;
52	oss<<" ERROR(\"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, char * "<<name<<", int "
53	<<name<<"_size)\", <<\"Input string is to short\");"<<iendl ;
54
55	oss<<"}"<<iendl ;
56
57	}
58
59	// if (!array_copy(domain_hdl->mask.getValue(), mask, extent1, extent2))
60	// ERROR("cxios_get_domain_mask(XDomainPtr domain_hdl, bool * mask, int extent1, int extent2)",<<"Output array size is not conform to array size attribut") ;
61
62
63	#define macro(T) \
64	template <>\
65	void CInterface::AttributeCInterface<ARRAY(T,1)>(ostream& oss, const string& className,const string& name)\
66	{\
67	string typeName=getStrType<T>() ;\
68	\
69	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
70	oss<<"{"<<iendl ;\
71	oss<<" ARRAY("<<typeName<<",1) array_tmp(new CArray<"<<typeName<<",1>(boost::extents[extent1]));"<<iendl ;\
72	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
73	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
74	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
75	oss<<"}"<<iendl ;\
76	oss<<iendl; \
77	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)"<<iendl ;\
78	oss<<"{"<<iendl; \
79	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1))"<<iendl ; \
80	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1)\",<<" \
81	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
82	oss<<"}"<<iendl ;\
83	}\
84	\
85	template <> \
86	void CInterface::AttributeCInterface<ARRAY(T,2)>(ostream& oss, const string& className,const string& name)\
87	{\
88	string typeName=getStrType<T>() ;\
89	\
90	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
91	oss<<"{"<<iendl ;\
92	oss<<" ARRAY("<<typeName<<",2) array_tmp(new CArray<"<<typeName<<",2>(boost::extents[extent1][extent2]));"<<iendl ;\
93	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
94	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
95	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
96	oss<<"}"<<iendl ;\
97	oss<<iendl; \
98	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)"<<iendl ;\
99	oss<<"{"<<iendl; \
100	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1, extent2))"<<iendl ; \
101	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2)\",<<" \
102	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
103	oss<<"}"<<iendl ;\
104	}\
105	\
106	template <>\
107	void CInterface::AttributeCInterface<ARRAY(T,3)>(ostream& oss, const string& className,const string& name)\
108	{\
109	string typeName=getStrType<T>() ;\
110	\
111	oss<<"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
112	oss<<"{"<<iendl ;\
113	oss<<" ARRAY("<<typeName<<",3) array_tmp(new CArray<"<<typeName<<",3>(boost::extents[extent1][extent2][extent3]));"<<iendl ;\
114	oss<<" std::copy("<<name<<", &("<<name<<"[array_tmp->num_elements()]), array_tmp->data());"<<iendl ;\
115	oss<<" "<<className<<"_hdl->"<<name<<".setValue(array_tmp);"<<iendl ;\
116	oss<<" "<<className<<"_hdl->sendAttributToServer("<<className<<"_hdl->"<<name<<");"<<iendl ;\
117	oss<<"}"<<iendl ;\
118	oss<<iendl; \
119	oss<<"void cxios_get_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)"<<iendl ;\
120	oss<<"{"<<iendl; \
121	oss<<" if (!array_copy("<<className<<"_hdl->"<<name<<".getValue(), "<<name<<", extent1))"<<iendl ; \
122	oss<<" ERROR(\"void cxios_set_"<<className<<"_"<<name<<"("<<className<<"_Ptr "<<className<<"_hdl, "<< typeName<<"* "<<name<<", int extent1, int extent2, int extent3)\",<<" \
123	<<"\"Output array size is not conform to array size attribute\") ;"<<iendl; \
124	oss<<"}"<<iendl ;\
125	}
126
127	macro(bool)
128	macro(double)
129	macro(int)
130
131	#undef macro
132
133	// /////////////////////////////////////////////////
134	// // Fortran 2003 Interface //
135	// /////////////////////////////////////////////////
136
137	template <class T>
138	void CInterface::AttributeFortran2003Interface(ostream& oss,const string& className,const string& name)
139	{
140	string fortranType=getStrFortranType<T>() ;
141	string fortranKindC=getStrFortranKindC<T>() ;
142
143	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<") BIND(C)"<<iendl ;
144	oss<<" USE ISO_C_BINDING"<<iendl ;
145	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
146	oss<<" "<<fortranType<<" "<<fortranKindC<<" , VALUE :: "<<name<<iendl ;
147	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ;
148	oss<<iendl ; \
149	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<") BIND(C)"<<iendl ;
150	oss<<" USE ISO_C_BINDING"<<iendl ;
151	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
152	oss<<" "<<fortranType<<" "<<fortranKindC<<" :: "<<name<<iendl ;
153	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ;
154	}
155
156
157	template <>
158	void CInterface::AttributeFortran2003Interface<string>(ostream& oss,const string& className,const string& name)
159	{
160
161	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", "<<name<<"_size) BIND(C)"<<iendl ;
162	oss<<" USE ISO_C_BINDING"<<iendl ;
163	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
164	oss<<" CHARACTER(kind = C_CHAR) , DIMENSION(*) :: "<<name<<iendl ;
165	oss<<" INTEGER (kind = C_INT) , VALUE :: "<<name<<"_size"<<iendl ;
166	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ;
167	oss<<iendl ;
168	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", "<<name<<"_size) BIND(C)"<<iendl ;
169	oss<<" USE ISO_C_BINDING"<<iendl ;
170	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ;
171	oss<<" CHARACTER(kind = C_CHAR) , DIMENSION(*) :: "<<name<<iendl ;
172	oss<<" INTEGER (kind = C_INT) , VALUE :: "<<name<<"_size"<<iendl ;
173	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ;
174
175	}
176
177	#define macro(T)\
178	template <>\
179	void CInterface::AttributeFortran2003Interface<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
180	{ \
181	string fortranType=getStrFortranType<T>() ; \
182	string fortranKindC=getStrFortranKindC<T>() ; \
183	\
184	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
185	oss<<" USE ISO_C_BINDING"<<iendl ; \
186	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
187	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
188	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
189	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
190	oss<<iendl; \
191	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1) BIND(C)"<<iendl ; \
192	oss<<" USE ISO_C_BINDING"<<iendl ; \
193	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
194	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
195	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
196	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
197	} \
198	\
199	template <> \
200	void CInterface::AttributeFortran2003Interface<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
201	{ \
202	string fortranType=getStrFortranType<T>() ; \
203	string fortranKindC=getStrFortranKindC<T>() ; \
204	\
205	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
206	oss<<" USE ISO_C_BINDING"<<iendl ; \
207	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
208	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
209	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
210	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
211	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
212	oss<<iendl ; \
213	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2) BIND(C)"<<iendl ; \
214	oss<<" USE ISO_C_BINDING"<<iendl ; \
215	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
216	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
217	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
218	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
219	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
220	} \
221	\
222	template <> \
223	void CInterface::AttributeFortran2003Interface<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
224	{ \
225	string fortranType=getStrFortranType<T>() ; \
226	string fortranKindC=getStrFortranKindC<T>() ; \
227	\
228	oss<<"SUBROUTINE cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
229	oss<<" USE ISO_C_BINDING"<<iendl ; \
230	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
231	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
232	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
233	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
234	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
235	oss<<"END SUBROUTINE cxios_set_"<<className<<"_"<<name<<iendl ; \
236	oss<<iendl ;\
237	oss<<"SUBROUTINE cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl, "<<name<<", extent1, extent2, extent3) BIND(C)"<<iendl ; \
238	oss<<" USE ISO_C_BINDING"<<iendl ; \
239	oss<<" INTEGER (kind = C_INTPTR_T), VALUE :: "<<className<<"_hdl"<<iendl ; \
240	oss<<" "<<fortranType<<" "<<fortranKindC<<" , DIMENSION(*) :: "<<name<<iendl ; \
241	oss<<" INTEGER (kind = C_INT), VALUE :: extent1"<<iendl ; \
242	oss<<" INTEGER (kind = C_INT), VALUE :: extent2"<<iendl ; \
243	oss<<" INTEGER (kind = C_INT), VALUE :: extent3"<<iendl ; \
244	oss<<"END SUBROUTINE cxios_get_"<<className<<"_"<<name<<iendl ; \
245	}
246
247	macro(bool)
248	macro(double)
249	macro(int)
250
251	#undef macro
252
253	template <class T>
254	void CInterface::AttributeFortranInterfaceDeclaration(ostream& oss,const string& className,const string& name)
255	{
256	oss<<getStrFortranType<T>()<<" "<< getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<iendl ;
257	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>()<<" :: "<<name<<"_tmp"<<iendl ;
258	}
259
260	template <class T>
261	void CInterface::AttributeFortranInterfaceGetDeclaration(ostream& oss,const string& className,const string& name)
262	{
263	oss<<getStrFortranType<T>()<<" "<< getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<iendl ;
264	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>()<<" :: "<<name<<"_tmp"<<iendl ;
265	}
266
267	template <>
268	void CInterface::AttributeFortranInterfaceDeclaration<string>(ostream& oss,const string& className,const string& name)
269	{
270	oss<<"CHARACTER(len = *) , OPTIONAL, INTENT(IN) :: "<<name<<iendl ;
271	}
272
273	template <>
274	void CInterface::AttributeFortranInterfaceGetDeclaration<string>(ostream& oss,const string& className,const string& name)
275	{
276	oss<<"CHARACTER(len = *) , OPTIONAL, INTENT(OUT) :: "<<name<<iendl ;
277	}
278
279	#define macro(T)\
280	template <> \
281	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
282	{ \
283	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:)"<<iendl ; \
284	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
285	} \
286	template <> \
287	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,1)>(ostream& oss,const string& className,const string& name) \
288	{ \
289	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:)"<<iendl ; \
290	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:)"<<iendl ; \
291	} \
292	\
293	template <> \
294	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
295	{ \
296	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:)"<<iendl ; \
297	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
298	} \
299	\
300	template <> \
301	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,2)>(ostream& oss,const string& className,const string& name) \
302	{ \
303	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:)"<<iendl ; \
304	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:)"<<iendl ; \
305	} \
306	\
307	template <> \
308	void CInterface::AttributeFortranInterfaceDeclaration<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
309	{ \
310	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(IN) :: "<<name<<"(:,:,:)"<<iendl ; \
311	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
312	}\
313	\
314	template <> \
315	void CInterface::AttributeFortranInterfaceGetDeclaration<ARRAY(T,3)>(ostream& oss,const string& className,const string& name) \
316	{ \
317	oss<<getStrFortranType<T>()<<" "<<getStrFortranKind<T>() <<" , OPTIONAL, INTENT(OUT) :: "<<name<<"(:,:,:)"<<iendl ; \
318	if (!matchingTypeCFortran<T>()) oss<<getStrFortranType<T>()<<" "<<getStrFortranKindC<T>() <<" , ALLOCATABLE :: "<<name<<"_tmp(:,:,:)"<<iendl ; \
319	}
320
321	macro(bool)
322	macro(double)
323	macro(int)
324
325	#undef macro
326
327
328	template <class T>
329	void CInterface::AttributeFortranInterfaceBody(ostream& oss,const string& className,const string& name)
330	{
331	string name_tmp=name+"__tmp" ;
332
333	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
334	if (!matchingTypeCFortran<T>())
335	{
336	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ;
337	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<")"<<iendl ;
338	}
339	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_)"<<iendl ;
340	oss<<"ENDIF"<<iendl ;
341	}
342
343	template <class T>
344	void CInterface::AttributeFortranInterfaceGetBody(ostream& oss,const string& className,const string& name)
345	{
346	string name_tmp=name+"__tmp" ;
347
348	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
349	if (!matchingTypeCFortran<T>())
350	{
351	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<")"<<iendl ;
352	oss<<" "<<name<<"_="<<name_tmp<<iendl ;
353	}
354	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_)"<<iendl ;
355	oss<<"ENDIF"<<iendl ;
356	}
357
358	template <>
359	void CInterface::AttributeFortranInterfaceBody<string>(ostream& oss,const string& className,const string& name)
360	{
361	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
362	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_, len("<<name<<"_))"<<iendl ;
363	oss<<"ENDIF"<<iendl ;
364	}
365
366	template <>
367	void CInterface::AttributeFortranInterfaceGetBody<string>(ostream& oss,const string& className,const string& name)
368	{
369	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ;
370	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_, len("<<name<<"_))"<<iendl ;
371	oss<<"ENDIF"<<iendl ;
372	}
373
374
375	#define macro(T) \
376	template <> \
377	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,1) >(ostream& oss,const string& className,const string& name) \
378	{ \
379	string name_tmp=name+"__tmp" ; \
380	\
381	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
382	if (!matchingTypeCFortran<T>()) \
383	{ \
384	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
385	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
386	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
387	} \
388	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
389	oss<<"ENDIF"<<iendl ; \
390	} \
391	\
392	template <> \
393	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,2) >(ostream& oss,const string& className,const string& name) \
394	{ \
395	string name_tmp=name+"__tmp" ; \
396	\
397	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
398	if (!matchingTypeCFortran<T>()) \
399	{ \
400	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
401	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
402	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
403	} \
404	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
405	oss<<"ENDIF"<<iendl ; \
406	} \
407	\
408	template <> \
409	void CInterface::AttributeFortranInterfaceBody< ARRAY(T,3) >(ostream& oss,const string& className,const string& name) \
410	{ \
411	string name_tmp=name+"__tmp" ; \
412	\
413	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
414	if (!matchingTypeCFortran<T>()) \
415	{ \
416	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
417	oss<<" "<<name_tmp<<"="<<name<<"_"<<iendl ; \
418	oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
419	} \
420	else oss<<" CALL cxios_set_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
421	oss<<"ENDIF"<<iendl ; \
422	}
423
424	macro(bool)
425	macro(double)
426	macro(int)
427
428	#undef macro
429
430	#define macro(T) \
431	template <> \
432	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,1) >(ostream& oss,const string& className,const string& name) \
433	{ \
434	string name_tmp=name+"__tmp" ; \
435	\
436	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
437	if (!matchingTypeCFortran<T>()) \
438	{ \
439	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1)))"<<iendl ; \
440	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1))"<<iendl ; \
441	oss<<" "<<name<<"_="<<name_tmp<<"_"<<iendl ; \
442	} \
443	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1))"<<iendl ; \
444	oss<<"ENDIF"<<iendl ; \
445	} \
446	\
447	template <> \
448	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,2) >(ostream& oss,const string& className,const string& name) \
449	{ \
450	string name_tmp=name+"__tmp" ; \
451	\
452	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
453	if (!matchingTypeCFortran<T>()) \
454	{ \
455	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2)))"<<iendl ; \
456	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
457	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
458	} \
459	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2))"<<iendl ; \
460	oss<<"ENDIF"<<iendl ; \
461	} \
462	\
463	template <> \
464	void CInterface::AttributeFortranInterfaceGetBody< ARRAY(T,3) >(ostream& oss,const string& className,const string& name) \
465	{ \
466	string name_tmp=name+"__tmp" ; \
467	\
468	oss<<"IF (PRESENT("<<name<<"_)) THEN"<<iendl ; \
469	if (!matchingTypeCFortran<T>()) \
470	{ \
471	oss<<" ALLOCATE("<<name_tmp<<"(size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3)))"<<iendl ; \
472	oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name_tmp<<",size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
473	oss<<" "<<name<<"_="<<name_tmp<<iendl ; \
474	} \
475	else oss<<" CALL cxios_get_"<<className<<"_"<<name<<"("<<className<<"_hdl%daddr, "<<name<<"_,size("<<name<<"_,1),size("<<name<<"_,2),size("<<name<<"_,3))"<<iendl ; \
476	oss<<"ENDIF"<<iendl ; \
477	}
478
479	macro(bool)
480	macro(double)
481	macro(int)
482
483	#undef macro
484	}
485
486	#endif

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

Download in other formats: