1 /*!
2  * \file   mfront/src/FortranMaterialPropertyInterface.cxx
3  * \brief
4  *
5  * \author Thomas Helfer
6  * \date   01 déc 2008
7  * \copyright Copyright (C) 2006-2018 CEA/DEN, EDF R&D. All rights
8  * reserved.
9  * This project is publicly released under either the GNU GPL Licence
10  * or the CECILL-A licence. A copy of thoses licences are delivered
11  * with the sources of TFEL. CEA or EDF may also distribute this
12  * project under specific licensing conditions.
13  */
14 
15 #include<sstream>
16 #include<algorithm>
17 #include<stdexcept>
18 
19 #include"TFEL/Raise.hxx"
20 #include"TFEL/Config/GetInstallPath.hxx"
21 #include"MFront/MFrontHeader.hxx"
22 #include"MFront/DSLUtilities.hxx"
23 #include"MFront/MFrontUtilities.hxx"
24 #include"MFront/TargetsDescription.hxx"
25 #include"MFront/MaterialPropertyDescription.hxx"
26 #include"MFront/FortranMaterialPropertyInterface.hxx"
27 
28 namespace mfront
29 {
30 
31   std::string
32   FortranMaterialPropertyInterface::getName()
33   {
34     return "fortran";
35   }
36 
37   FortranMaterialPropertyInterface::FortranMaterialPropertyInterface() = default;
38 
39   std::pair<bool,tfel::utilities::CxxTokenizer::TokensContainer::const_iterator>
40   FortranMaterialPropertyInterface::treatKeyword(const std::string& key,
41 						 const std::vector<std::string>& i,
42 						 tokens_iterator current,
43 						 const tokens_iterator)
44   {
45     if(std::find(i.begin(),i.end(),"fortran")!=i.end()){
46       tfel::raise_if(key!="@Module","FortranMaterialPropertyInterface::treatKeyword: "
47 		     "unsupported key '"+key+"'");
48     }
49     return {false,current};
50   }
51 
52   void
53   FortranMaterialPropertyInterface::getTargetsDescription(TargetsDescription& d,
54 							  const MaterialPropertyDescription& mpd) const
55 
56   {
57     const auto lib  = "Fortran"+getMaterialLawLibraryNameBase(mpd);
58     const auto name = this->getSrcFileName(mpd.material,mpd.className);
59     const auto f = makeLowerCase(mpd.material.empty()
60 				 ? mpd.className : mpd.material+"_"+mpd.className);
61     const auto tfel_config = tfel::getTFELConfigExecutableName();
62     insert_if(d[lib].cppflags,
63 	      "$(shell "+tfel_config+" --cppflags --compiler-flags)");
64     insert_if(d[lib].include_directories,
65 	      "$(shell "+tfel_config+" --include-path)");
66     insert_if(d[lib].sources,name+".cxx");
67 #if  !((defined _WIN32) && (defined _MSC_VER))
68     insert_if(d[lib].link_libraries,"m");
69 #endif /* !((defined _WIN32) && (defined _MSC_VER)) */
70     insert_if(d[lib].epts,{f,f+"_checkBounds"});
71   } // end of FortranMaterialPropertyInterface::getTargetsDescription
72 
73   std::string
74   FortranMaterialPropertyInterface::getHeaderFileName(const std::string&,
75 						      const std::string&) const
76   {
77     return "";
78   } // end of FortranMaterialPropertyInterface::getHeaderFileName
79 
80   std::string
81   FortranMaterialPropertyInterface::getSrcFileName(const std::string& material,
82 						   const std::string& className) const
83   {
84     if(material.empty()){
85       return className+"-fortran";
86     }
87     return material+"_"+className+"-fortran";
88   } // end of FortranMaterialPropertyInterface::getSrcFileName
89 
90   void FortranMaterialPropertyInterface::writeInterfaceSymbol(std::ostream& out,
91 							      const MaterialPropertyDescription& mpd) const{
92     mfront::writeInterfaceSymbol(out,this->getFunctionName(mpd),"Fortran");
93   } // end of FortranMaterialPropertyInterface
94 
95   void
96   FortranMaterialPropertyInterface::writeInterfaceSpecificVariables(std::ostream& os,
97 								    const VariableDescriptionContainer& inputs) const
98   {
99     for(const auto& i : inputs){
100       os << "const mfront_fortran_real8 " << i.name
101 	 << " =  *(_mfront_var_" << i.name << ");\n";
102     }
103   } // end of FortranMaterialPropertyInterface::writeInterfaceSpecificVariables
104 
105   void
106   FortranMaterialPropertyInterface::writeParameterList(std::ostream& file,
107 						       const VariableDescriptionContainer& inputs) const{
108     if(!inputs.empty()){
109       for(auto p=inputs.begin();p!=inputs.end();){
110 	file << "const mfront_fortran_real8 * const _mfront_var_" << p->name;
111 	if((++p)!=inputs.end()){
112 	  file << ",\n";
113 	}
114       }
115     } else {
116       file << "void";
117     }
118   } // end of FortranMaterialPropertyInterface::writeParameterList
119 
120   void
121   FortranMaterialPropertyInterface::writeSrcPreprocessorDirectives(std::ostream& os,
122 								   const MaterialPropertyDescription& mpd) const
123   {
124     const auto name = (!mpd.material.empty()) ? mpd.material+"_"+mpd.className : mpd.className;
125     const auto f77_func = (name.find('_')!=std::string::npos) ? "F77_FUNC_" : "F77_FUNC";
126     writeExportDirectives(os);
127     writeF77FUNCMacros(os);
128     os << "#define " << this->getFunctionName(mpd)
129        << " " << f77_func << "("
130        << makeLowerCase(name) << ","
131        << makeUpperCase(name) << ")\n"
132        << "#define " << this->getCheckBoundsFunctionName(mpd)
133        << " F77_FUNC_(" << makeLowerCase(name) << "_checkbounds,"
134        << makeUpperCase(name) << "_CHECKBOUNDS)\n\n"
135        << "#ifdef __cplusplus\n"
136        << "extern \"C\"{\n"
137        << "#endif /* __cplusplus */\n\n"
138        << "typedef double mfront_fortran_real8;\n\n"
139        << "\nMFRONT_SHAREDOBJ double "
140        << this->getFunctionName(mpd) << "(";
141     this->writeParameterList(os,mpd.inputs);
142     os << ");\n"
143        << "MFRONT_SHAREDOBJ int "
144        << this->getCheckBoundsFunctionName(mpd) << "(";
145     this->writeParameterList(os,mpd.inputs);
146     os << ");\n\n"
147        << "#ifdef __cplusplus\n"
148        << "}\n"
149        << "#endif /* __cplusplus */\n\n";
150   } // end of FortranMaterialPropertyInterface::writeSrcPreprocessorDirectives
151 
152   void FortranMaterialPropertyInterface::writeBeginHeaderNamespace(std::ostream&) const
153   {} // end of FortranMaterialPropertyInterface::writeBeginHeaderNamespace
154 
155   void FortranMaterialPropertyInterface::writeEndHeaderNamespace(std::ostream&) const
156   {} // end of FortranMaterialPropertyInterface::writeEndHeaderNamespace()
157 
158   void FortranMaterialPropertyInterface::writeBeginSrcNamespace(std::ostream& os) const
159   {
160     os << "#ifdef __cplusplus\n"
161        << "extern \"C\"{\n"
162        << "#endif /* __cplusplus */\n\n";
163   } // end of FortranMaterialPropertyInterface::writeBeginSrcNamespace
164 
165   void FortranMaterialPropertyInterface::writeEndSrcNamespace(std::ostream& os) const
166   {
167     os << "#ifdef __cplusplus\n"
168        << "} // end of extern \"C\"\n"
169        << "#endif /* __cplusplus */\n\n";
170   } // end of FortranMaterialPropertyInterface::writeEndSrcNamespace()
171 
172   std::string
173   FortranMaterialPropertyInterface::getFunctionName(const MaterialPropertyDescription& mpd) const
174   {
175     const auto material  = mpd.material;
176     const auto className = mpd.className;
177     return (material.empty() ? makeUpperCase(className) :
178 	    makeUpperCase(material+"_"+className)) + "_F77";
179   } // end of FortranMaterialPropertyInterface::getFunctionName
180 
181   bool FortranMaterialPropertyInterface::requiresCheckBoundsFunction() const
182   {
183     return false;
184   }
185 
186   std::string
187   FortranMaterialPropertyInterface::getCheckBoundsFunctionName(const MaterialPropertyDescription& mpd) const
188   {
189     const auto material  = mpd.material;
190     const auto className = mpd.className;
191     return (material.empty() ? makeUpperCase(className) :
192 	    makeUpperCase(material+"_"+className)) + "_CHECKBOUNDS_F77";
193   } // end of FortranMaterialPropertyInterface::getCheckBoundsFunctionName
194 
195   FortranMaterialPropertyInterface::~FortranMaterialPropertyInterface() = default;
196 
197 } // end of namespace mfront
198