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 branches/2012/dev_r3406_LOCEAN4_XIOS/NEMOGCM/EXTERNAL/XIOS/src – NEMO

source: branches/2012/dev_r3406_LOCEAN4_XIOS/NEMOGCM/EXTERNAL/XIOS/src/generate_interface_impl.hpp @ 3474

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

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