New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
generate_interface_impl.hpp in vendors/XIOS/current/src – NEMO

source: vendors/XIOS/current/src/generate_interface_impl.hpp @ 3408

Last change on this file since 3408 was 3408, checked in by rblod, 12 years ago

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