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