Context Navigation

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

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

Enhancement : Add fortran interface to know if an attribute is set or not
ex : CALL xios_is_defined_field_attr("field_A",enabled=ok)

YM

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

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

Download in other formats: