From d7e6c1906745819de3909a741ff7e3880cbe9858 Mon Sep 17 00:00:00 2001 From: Dave Goodwin Date: Thu, 5 Aug 2004 14:07:07 +0000 Subject: [PATCH] *** empty log message *** --- Cantera/fortran/src/Makefile.in | 44 ++- Cantera/fortran/src/cantera.f90 | 380 +++++++++++++++++++ Cantera/fortran/src/cantera_funcs.f90 | 70 ++++ Cantera/fortran/src/cantera_kinetics.f90 | 189 ++++++++++ Cantera/fortran/src/cantera_thermo.f90 | 412 +++++++++++++++++++++ Cantera/fortran/src/cantera_transport.f90 | 74 ++++ Cantera/fortran/src/fct.cpp | 426 +++++++++++----------- Cantera/fortran/src/fctxml.cpp | 90 ++--- Cantera/fortran/src/flib_defs.h | 4 + Cantera/fortran/src/genf.py | 69 ++-- Cantera/fortran/src/makect.py | 45 +++ 11 files changed, 1511 insertions(+), 292 deletions(-) create mode 100644 Cantera/fortran/src/cantera.f90 create mode 100644 Cantera/fortran/src/cantera_funcs.f90 create mode 100644 Cantera/fortran/src/cantera_kinetics.f90 create mode 100644 Cantera/fortran/src/cantera_thermo.f90 create mode 100644 Cantera/fortran/src/cantera_transport.f90 create mode 100644 Cantera/fortran/src/makect.py diff --git a/Cantera/fortran/src/Makefile.in b/Cantera/fortran/src/Makefile.in index 98b8983e9..8525cfe92 100644 --- a/Cantera/fortran/src/Makefile.in +++ b/Cantera/fortran/src/Makefile.in @@ -13,12 +13,36 @@ SUFFIXES= SUFFIXES= .cpp .d .o .f90 .mod CXX_FLAGS = @CXXFLAGS@ $(CXX_OPT) +FORT_FLAGS = @F90FLAGS@ -OBJS = fct.o fctxml.o fctxml_interface.o cantera_xml.o +CXX_OBJS = fct.o fctxml.o -MODULES = fctxml.mod cantera_xml.mod +#INTERFACE_MODULE_OBJS = fct_interface.o fctxml_interface.o +# +#USER_MODULE_OBJS = cantera_xml.o cantera_thermo.o cantera_kinetics.o \ +# cantera_funcs.o canteramod.o +# +#MODULES = $(INTERFACE_MODULE_OBJS) $(USER_MODULE_OBJS) +#OBJS = $(CXX_OBJS) $(USER_MODULE_OBJS) +# +#DEPENDS = $(CXX_OBJS:.o=.d) +#UMODS = $(USER_MODULE_OBJS:cantera_=) +#MODFILES = $(INTERFACE_MODULE_OBJS:_interface.o=.mod) $(UMODS:.o=.mod) -DEPENDS = $(OBJS:.o=.d) + + +CXX_OBJS = fct.o fctxml.o + +INTERFACE_MODULE_OBJS = fct_interface.o fctxml_interface.o + +USER_MODULE_OBJS = cantera_xml.o cantera_thermo.o cantera_kinetics.o \ + cantera_transport.o cantera_funcs.o cantera.o + +MODULES = $(INTERFACE_MODULE_OBJS:_interface.o=.mod) $(USER_MODULE_OBJS) +OBJS = $(CXX_OBJS) $(USER_MODULE_OBJS) + +DEPENDS = $(CXX_OBJS:.o=.d) +MODFILES = $(MODULES:.o=.mod) # Fortran libraries FORT_LIBS = @FLIBS@ @@ -42,6 +66,9 @@ LIB_DEPS = $(CANTERA_LIBDIR)/libcantera.a \ # the directory where Cantera include files may be found. CANTERA_INCDIR=../../src +# the directory where module .mod files should be put +MODULE_DIR = @buildinc@/cantera + CXX_INCLUDES = -I$(CANTERA_INCDIR) # flags passed to the C++ compiler/linker for the linking step @@ -54,16 +81,21 @@ LCXX_FLAGS = -L$(CANTERA_LIBDIR) @CXXFLAGS@ %.o : %.f90 $(F90) -c $< $(FORT_FLAGS) +%.mod : %_interface.f90 + $(F90) -c $< $(FORT_FLAGS) + %.mod : %.f90 $(F90) -c $< $(FORT_FLAGS) + LIB_NAME=libfct.a FTLIB = @buildlib@/$(LIB_NAME) -lib: $(MODULES) $(OBJS) $(LIB_DEPS) +lib: $(MODFILES) $(USER_MODULE_OBJS) $(CXX_OBJS) $(LIB_DEPS) $(RM) $(FTLIB) @ARCHIVE@ $(FTLIB) $(OBJS) + cp -f $(MODFILES) $(MODULE_DIR) clean: $(RM) $(OBJS) $(FTLIB) @@ -82,6 +114,10 @@ depends: $(DEPENDS) cat *.d > .depends $(RM) $(DEPENDS) +cantera_thermo.o: fct.mod cantera_xml.mod cantera_thermo.f90 +fct.mod: fct_interface.f90 +fctxml.mod: fctxml_interface.f90 + ifeq ($(wildcard .depends), .depends) include .depends endif diff --git a/Cantera/fortran/src/cantera.f90 b/Cantera/fortran/src/cantera.f90 new file mode 100644 index 000000000..2f6a3082d --- /dev/null +++ b/Cantera/fortran/src/cantera.f90 @@ -0,0 +1,380 @@ +MODULE CANTERA + + USE cantera_thermo + USE cantera_thermo + USE cantera_kinetics + USE cantera_transport + USE cantera_xml + USE cantera_funcs + + INTERFACE addAttrib + MODULE PROCEDURE ctxml_addAttrib + END INTERFACE addAttrib + + INTERFACE addCanteraDirectory + MODULE PROCEDURE ctfunc_addCanteraDirectory + END INTERFACE addCanteraDirectory + + INTERFACE addChild + MODULE PROCEDURE ctxml_addChild + END INTERFACE addChild + + INTERFACE addComment + MODULE PROCEDURE ctxml_addComment + END INTERFACE addComment + + INTERFACE advanceCoverages + MODULE PROCEDURE ctkin_advanceCoverages + END INTERFACE advanceCoverages + + INTERFACE chemPotentials + MODULE PROCEDURE ctthermo_chemPotentials + END INTERFACE chemPotentials + + INTERFACE child + MODULE PROCEDURE ctxml_child + END INTERFACE child + + INTERFACE clear + MODULE PROCEDURE ctxml_clear + END INTERFACE clear + + INTERFACE cp_mass + MODULE PROCEDURE ctthermo_cp_mass + END INTERFACE cp_mass + + INTERFACE cp_mole + MODULE PROCEDURE ctthermo_cp_mole + END INTERFACE cp_mole + + INTERFACE cv_mass + MODULE PROCEDURE ctthermo_cv_mass + END INTERFACE cv_mass + + INTERFACE cv_mole + MODULE PROCEDURE ctthermo_cv_mole + END INTERFACE cv_mole + + INTERFACE density + MODULE PROCEDURE ctthermo_density + END INTERFACE density + + INTERFACE elementIndex + MODULE PROCEDURE ctthermo_elementIndex + END INTERFACE elementIndex + + INTERFACE enthalpy_mass + MODULE PROCEDURE ctthermo_enthalpy_mass + END INTERFACE enthalpy_mass + + INTERFACE enthalpy_mole + MODULE PROCEDURE ctthermo_enthalpy_mole + END INTERFACE enthalpy_mole + + INTERFACE entropy_mass + MODULE PROCEDURE ctthermo_entropy_mass + END INTERFACE entropy_mass + + INTERFACE entropy_mole + MODULE PROCEDURE ctthermo_entropy_mole + END INTERFACE entropy_mole + + INTERFACE eosType + MODULE PROCEDURE ctthermo_eosType + END INTERFACE eosType + + INTERFACE equilibrate + MODULE PROCEDURE ctthermo_equilibrate + END INTERFACE equilibrate + + INTERFACE getAtomicWeights + MODULE PROCEDURE ctthermo_getAtomicWeights + END INTERFACE getAtomicWeights + + INTERFACE getAttrib + MODULE PROCEDURE ctxml_getAttrib + END INTERFACE getAttrib + + INTERFACE getBinDiffCoeffs + MODULE PROCEDURE ctrans_getBinDiffCoeffs + END INTERFACE getBinDiffCoeffs + + INTERFACE getCanteraError + MODULE PROCEDURE ctfunc_getCanteraError + END INTERFACE getCanteraError + + INTERFACE getCp_R + MODULE PROCEDURE ctthermo_getCp_R + END INTERFACE getCp_R + + INTERFACE getCreationRates + MODULE PROCEDURE ctkin_getCreationRates + END INTERFACE getCreationRates + + INTERFACE getDestructionRates + MODULE PROCEDURE ctkin_getDestructionRates + END INTERFACE getDestructionRates + + INTERFACE getElementName + MODULE PROCEDURE ctthermo_getElementName + END INTERFACE getElementName + + INTERFACE getEnthalpies_RT + MODULE PROCEDURE ctthermo_getEnthalpies_RT + END INTERFACE getEnthalpies_RT + + INTERFACE getEntropies_R + MODULE PROCEDURE ctthermo_getEntropies_R + END INTERFACE getEntropies_R + + INTERFACE getEquilibriumConstants + MODULE PROCEDURE ctkin_getEquilibriumConstants + END INTERFACE getEquilibriumConstants + + INTERFACE getFwdRatesOfProgress + MODULE PROCEDURE ctkin_getFwdRatesOfProgress + END INTERFACE getFwdRatesOfProgress + + INTERFACE getMassFractions + MODULE PROCEDURE ctthermo_getMassFractions + END INTERFACE getMassFractions + + INTERFACE getMixDiffCoeffs + MODULE PROCEDURE ctrans_getMixDiffCoeffs + END INTERFACE getMixDiffCoeffs + + INTERFACE getMoleFractions + MODULE PROCEDURE ctthermo_getMoleFractions + END INTERFACE getMoleFractions + + INTERFACE getMolecularWeights + MODULE PROCEDURE ctthermo_getMolecularWeights + END INTERFACE getMolecularWeights + + INTERFACE getMultiDiffCoeffs + MODULE PROCEDURE ctrans_getMultiDiffCoeffs + END INTERFACE getMultiDiffCoeffs + + INTERFACE getNetProductionRates + MODULE PROCEDURE ctkin_getNetProductionRates + END INTERFACE getNetProductionRates + + INTERFACE getNetRatesOfProgress + MODULE PROCEDURE ctkin_getNetRatesOfProgress + END INTERFACE getNetRatesOfProgress + + INTERFACE getReactionString + MODULE PROCEDURE ctkin_getReactionString + END INTERFACE getReactionString + + INTERFACE getRevRatesOfProgress + MODULE PROCEDURE ctkin_getRevRatesOfProgress + END INTERFACE getRevRatesOfProgress + + INTERFACE getSpeciesName + MODULE PROCEDURE ctthermo_getSpeciesName + END INTERFACE getSpeciesName + + INTERFACE getTag + MODULE PROCEDURE ctxml_getTag + END INTERFACE getTag + + INTERFACE getThermalDiffCoeffs + MODULE PROCEDURE ctrans_getThermalDiffCoeffs + END INTERFACE getThermalDiffCoeffs + + INTERFACE getValue + MODULE PROCEDURE ctxml_getValue + END INTERFACE getValue + + INTERFACE gibbs_mass + MODULE PROCEDURE ctthermo_gibbs_mass + END INTERFACE gibbs_mass + + INTERFACE gibbs_mole + MODULE PROCEDURE ctthermo_gibbs_mole + END INTERFACE gibbs_mole + + INTERFACE importPhase + MODULE PROCEDURE ctfunc_importPhase + END INTERFACE importPhase + + INTERFACE intEnergy_mass + MODULE PROCEDURE ctthermo_intEnergy_mass + END INTERFACE intEnergy_mass + + INTERFACE intEnergy_mole + MODULE PROCEDURE ctthermo_intEnergy_mole + END INTERFACE intEnergy_mole + + INTERFACE isReversible + MODULE PROCEDURE ctkin_isReversible + END INTERFACE isReversible + + INTERFACE kineticsSpeciesIndex + MODULE PROCEDURE ctkin_kineticsSpeciesIndex + END INTERFACE kineticsSpeciesIndex + + INTERFACE kineticsStart + MODULE PROCEDURE ctkin_kineticsStart + END INTERFACE kineticsStart + + INTERFACE kineticsType + MODULE PROCEDURE ctkin_kineticsType + END INTERFACE kineticsType + + INTERFACE massFraction + MODULE PROCEDURE ctthermo_massFraction + END INTERFACE massFraction + + INTERFACE maxTemp + MODULE PROCEDURE ctthermo_maxTemp + END INTERFACE maxTemp + + INTERFACE meanMolecularWeight + MODULE PROCEDURE ctthermo_meanMolecularWeight + END INTERFACE meanMolecularWeight + + INTERFACE minTemp + MODULE PROCEDURE ctthermo_minTemp + END INTERFACE minTemp + + INTERFACE molarDensity + MODULE PROCEDURE ctthermo_molarDensity + END INTERFACE molarDensity + + INTERFACE moleFraction + MODULE PROCEDURE ctthermo_moleFraction + END INTERFACE moleFraction + + INTERFACE multiplier + MODULE PROCEDURE ctkin_multiplier + END INTERFACE multiplier + + INTERFACE nAtoms + MODULE PROCEDURE ctthermo_nAtoms + END INTERFACE nAtoms + + INTERFACE nChildren + MODULE PROCEDURE ctxml_nChildren + END INTERFACE nChildren + + INTERFACE nElements + MODULE PROCEDURE ctthermo_nElements + END INTERFACE nElements + + INTERFACE nReactions + MODULE PROCEDURE ctkin_nReactions + END INTERFACE nReactions + + INTERFACE nSpecies + MODULE PROCEDURE ctthermo_nSpecies + END INTERFACE nSpecies + + INTERFACE nTotalSpecies + MODULE PROCEDURE ctkin_nTotalSpecies + END INTERFACE nTotalSpecies + + INTERFACE phase_report + MODULE PROCEDURE ctfunc_phase_report + END INTERFACE phase_report + + INTERFACE pressure + MODULE PROCEDURE ctthermo_pressure + END INTERFACE pressure + + INTERFACE productStoichCoeff + MODULE PROCEDURE ctkin_productStoichCoeff + END INTERFACE productStoichCoeff + + INTERFACE reactantStoichCoeff + MODULE PROCEDURE ctkin_reactantStoichCoeff + END INTERFACE reactantStoichCoeff + + INTERFACE reactionType + MODULE PROCEDURE ctkin_reactionType + END INTERFACE reactionType + + INTERFACE refPressure + MODULE PROCEDURE ctthermo_refPressure + END INTERFACE refPressure + + INTERFACE setDensity + MODULE PROCEDURE ctthermo_setDensity + END INTERFACE setDensity + + INTERFACE setMassFractions + MODULE PROCEDURE ctthermo_setMassFractions + END INTERFACE setMassFractions + + INTERFACE setMassFractionsByName + MODULE PROCEDURE ctthermo_setMassFractionsByName + END INTERFACE setMassFractionsByName + + INTERFACE setMoleFractions + MODULE PROCEDURE ctthermo_setMoleFractions + END INTERFACE setMoleFractions + + INTERFACE setMoleFractionsByName + MODULE PROCEDURE ctthermo_setMoleFractionsByName + END INTERFACE setMoleFractionsByName + + INTERFACE setMultiplier + MODULE PROCEDURE ctkin_setMultiplier + END INTERFACE setMultiplier + + INTERFACE setParameters + MODULE PROCEDURE ctrans_setParameters + END INTERFACE setParameters + + INTERFACE setPressure + MODULE PROCEDURE ctthermo_setPressure + END INTERFACE setPressure + + INTERFACE setState_HP + MODULE PROCEDURE ctthermo_setState_HP + END INTERFACE setState_HP + + INTERFACE setState_SP + MODULE PROCEDURE ctthermo_setState_SP + END INTERFACE setState_SP + + INTERFACE setState_SV + MODULE PROCEDURE ctthermo_setState_SV + END INTERFACE setState_SV + + INTERFACE setState_TPX + MODULE PROCEDURE ctthermo_setState_TPX + MODULE PROCEDURE ctstring_setState_TPX + END INTERFACE setState_TPX + + INTERFACE setState_UV + MODULE PROCEDURE ctthermo_setState_UV + END INTERFACE setState_UV + + INTERFACE setTemperature + MODULE PROCEDURE ctthermo_setTemperature + END INTERFACE setTemperature + + INTERFACE speciesIndex + MODULE PROCEDURE ctthermo_speciesIndex + END INTERFACE speciesIndex + + INTERFACE temperature + MODULE PROCEDURE ctthermo_temperature + END INTERFACE temperature + + INTERFACE thermalConductivity + MODULE PROCEDURE ctrans_thermalConductivity + END INTERFACE thermalConductivity + + INTERFACE viscosity + MODULE PROCEDURE ctrans_viscosity + END INTERFACE viscosity + + INTERFACE write + MODULE PROCEDURE ctxml_write + END INTERFACE write + +END MODULE CANTERA + diff --git a/Cantera/fortran/src/cantera_funcs.f90 b/Cantera/fortran/src/cantera_funcs.f90 new file mode 100644 index 000000000..bfeb11bb2 --- /dev/null +++ b/Cantera/fortran/src/cantera_funcs.f90 @@ -0,0 +1,70 @@ +module cantera_funcs + + use cantera_xml + use cantera_thermo + use cantera_kinetics + use cantera_transport + + contains + + type(phase_t) function ctfunc_importPhase(src, id, loglevel) + implicit none + character*(*), intent(in) :: src + character*(*), intent(in), optional :: id + integer, intent(in), optional :: loglevel + + character(20) :: model + type(XML_Node) root, s, str + type(phase_t) self + + root = new_XML_Node(src = src) + if (present(id)) then + s = ctxml_child(root, id = id) + else + s = ctxml_child(root, 'phase') + end if + + self = newThermoPhase(s) + call newKinetics(s, self) + + str = ctxml_child(s, 'transport') + call ctxml_getAttrib(str, 'model', model) + if (present(loglevel)) then + write(*,*) 'tr 1' + self%tran_id = newTransport(model, self%thermo_id, loglevel) + else + write(*,*) 'tr 2' + self%tran_id = newTransport(model, self%thermo_id, 0) + end if + + ctfunc_importPhase = self + return + end function ctfunc_importphase + + subroutine ctfunc_phase_report(self, buf, show_thermo) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(out) :: buf + integer, intent(in), optional :: show_thermo + if (present(show_thermo)) then + self%err = ctphase_report(self%thermo_id, buf, show_thermo) + else + self%err = ctphase_report(self%thermo_id, buf, 0) + end if + end subroutine ctfunc_phase_report + + subroutine ctfunc_getCanteraError(buf) + implicit none + integer :: ierr + character*(*), intent(out) :: buf + ierr = ctgetCanteraError(buf) + end subroutine ctfunc_getCanteraError + + subroutine ctfunc_addCanteraDirectory(self, buf) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: buf + self%err = ctaddCanteraDirectory(self%thermo_id, buf) + end subroutine ctfunc_addCanteraDirectory + +end module cantera_funcs diff --git a/Cantera/fortran/src/cantera_kinetics.f90 b/Cantera/fortran/src/cantera_kinetics.f90 new file mode 100644 index 000000000..d794d04fa --- /dev/null +++ b/Cantera/fortran/src/cantera_kinetics.f90 @@ -0,0 +1,189 @@ +module cantera_kinetics + + use cantera_thermo + use cantera_xml + use fct + + contains + + subroutine newKinetics(xml_phase, phase, & + neighbor1, neighbor2, neighbor3, neighbor4) + implicit none + type(XML_Node), intent(in) :: xml_phase + type(phase_t), intent(inout) :: phase + type(phase_t), intent(in), optional :: neighbor1 + type(phase_t), intent(in), optional :: neighbor2 + type(phase_t), intent(in), optional :: neighbor3 + type(phase_t), intent(in), optional :: neighbor4 + integer :: missing + missing = -1 + + if (present(neighbor1)) then + if (present(neighbor2)) then + if (present(neighbor3)) then + if (present(neighbor4)) then + phase%kin_id = newkineticsfromxml(xml_phase%xml_id, phase%thermo_id, & + neighbor1%thermo_id, neighbor2%thermo_id, neighbor3%thermo_id, & + neighbor4%thermo_id) + else + phase%kin_id = newkineticsfromxml(xml_phase%xml_id, phase%thermo_id, & + neighbor1%thermo_id, neighbor2%thermo_id, neighbor3%thermo_id, & + missing) + end if + else + phase%kin_id = newkineticsfromxml(xml_phase%xml_id, phase%thermo_id, & + neighbor1%thermo_id, neighbor2%thermo_id, missing, missing) + end if + else + phase%kin_id = newkineticsfromxml(xml_phase%xml_id, phase%thermo_id, & + neighbor1%thermo_id, missing, missing, missing) + end if + else + phase%kin_id = newkineticsfromxml(xml_phase%xml_id, phase%thermo_id, & + missing, missing, missing, missing) + end if + end subroutine newKinetics + + integer function ctkin_kineticsType(self) + implicit none + type(phase_t), intent(inout) :: self + ctkin_kineticsType = kin_type(self%kin_id) + end function ctkin_kineticsType + + integer function ctkin_kineticsStart(self, p) + implicit none + type(phase_t), intent(in) :: self + integer, intent(in) :: p + ctkin_kineticsStart = kin_start(self%kin_id, p) + end function ctkin_kineticsstart + + integer function ctkin_kineticsSpeciesIndex(self, name, phase) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: name + character*(*), intent(in) :: phase + ctkin_kineticsSpeciesIndex = kin_speciesindex(self%kin_id, name, phase) + end function ctkin_kineticsSpeciesIndex + + integer function ctkin_nTotalSpecies(self) + implicit none + type(phase_t), intent(inout) :: self + ctkin_ntotalspecies = kin_ntotalspecies(self%kin_id) + end function ctkin_ntotalspecies + + integer function ctkin_nReactions(self) + implicit none + type(phase_t), intent(inout) :: self + ctkin_nreactions = kin_nreactions(self%kin_id) + end function ctkin_nreactions + + double precision function ctkin_reactantStoichCoeff(self, k, i) + implicit none + type(phase_t), intent(in) :: self + integer, intent(in) :: k + integer, intent(in) :: i + ctkin_reactantstoichcoeff = kin_reactantstoichcoeff(self%kin_id, k, i) + end function ctkin_reactantstoichcoeff + + double precision function ctkin_productStoichCoeff(self, k, i) + implicit none + type(phase_t), intent(in) :: self + integer, intent(in) :: k + integer, intent(in) :: i + ctkin_productstoichcoeff = kin_productstoichcoeff(self%kin_id, k, i) + end function ctkin_productstoichcoeff + + integer function ctkin_reactionType(self, i) + implicit none + type(phase_t), intent(in) :: self + integer, intent(in) :: i + ctkin_reactiontype = kin_reactiontype(self%kin_id, i) + end function ctkin_reactiontype + + subroutine ctkin_getFwdRatesOfProgress(self, fwdROP) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: fwdROP(*) + self%err = kin_getfwdratesofprogress(self%kin_id, fwdROP) + end subroutine ctkin_getfwdratesofprogress + + subroutine ctkin_getRevRatesOfProgress(self, revROP) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: revROP(*) + self%err = kin_getrevratesofprogress(self%kin_id, revROP) + end subroutine ctkin_getrevratesofprogress + + integer function ctkin_isReversible(self, i) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: i + ctkin_isreversible = kin_isreversible(self%kin_id, i) + end function ctkin_isreversible + + subroutine ctkin_getNetRatesOfProgress(self, netROP) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: netROP(*) + self%err = kin_getnetratesofprogress(self%kin_id, netROP) + end subroutine ctkin_getnetratesofprogress + + subroutine ctkin_getCreationRates(self, cdot) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: cdot(*) + self%err = kin_getcreationrates(self%kin_id, cdot) + end subroutine ctkin_getcreationrates + + subroutine ctkin_getDestructionRates(self, ddot) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: ddot(*) + self%err = kin_getdestructionrates(self%kin_id, ddot) + end subroutine ctkin_getdestructionrates + + subroutine ctkin_getNetProductionRates(self, wdot) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: wdot(*) + self%err = kin_getnetproductionrates(self%kin_id, wdot) + end subroutine ctkin_getnetproductionrates + + double precision function ctkin_multiplier(self, i) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: i + ctkin_multiplier = kin_multiplier(self%kin_id, i) + end function ctkin_multiplier + + subroutine ctkin_getEquilibriumConstants(self, kc) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: kc(*) + self%err = kin_getequilibriumconstants(self%kin_id, kc) + end subroutine ctkin_getequilibriumconstants + + subroutine ctkin_getReactionString(self, i, buf) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: i + character*(*), intent(out) :: buf + self%err = kin_getreactionstring(self%kin_id, i, buf) + end subroutine ctkin_getreactionstring + + subroutine ctkin_setMultiplier(self, i, v) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: i + double precision, intent(inout) :: v + self%err = kin_setmultiplier(self%kin_id, i, v) + end subroutine ctkin_setmultiplier + + subroutine ctkin_advanceCoverages(self, tstep) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: tstep + self%err = kin_advancecoverages(self%kin_id, tstep) + end subroutine ctkin_advancecoverages + +end module cantera_kinetics diff --git a/Cantera/fortran/src/cantera_thermo.f90 b/Cantera/fortran/src/cantera_thermo.f90 new file mode 100644 index 000000000..124a6410c --- /dev/null +++ b/Cantera/fortran/src/cantera_thermo.f90 @@ -0,0 +1,412 @@ +module cantera_thermo + + use fct + use cantera_xml + + type phase_t + integer :: thermo_id + integer :: kin_id + integer :: tran_id + integer :: err + integer :: nel + integer :: nsp + end type phase_t + + integer, parameter :: TV = 100 + integer, parameter :: HP = 101 + +contains + + type(phase_t) function newThermoPhase(xml_phase, index) + implicit none + type(XML_Node), intent(inout), optional :: xml_phase + integer, intent(in), optional :: index + type(phase_t) :: self + if (present(index)) then + self%thermo_id = index + self%err = 0 + else if (present(xml_phase)) then + self%thermo_id = newthermofromxml(xml_phase%xml_id) + self%nel = phase_nelements(self%thermo_id) + self%nsp = phase_nspecies(self%thermo_id) + self%err = 0 + else + call cantera_error('newThermoPhase','xml_phase or id must be specified.') + end if + newThermoPhase = self + end function newThermoPhase + + integer function ctthermo_nElements(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_nelements = phase_nelements(self%thermo_id) + end function ctthermo_nElements + + integer function ctthermo_nSpecies(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_nspecies = phase_nspecies(self%thermo_id) + end function ctthermo_nSpecies + + double precision function ctthermo_temperature(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_temperature = phase_temperature(self%thermo_id) + end function ctthermo_temperature + + subroutine ctthermo_setTemperature(self, t) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: t + self%err = phase_settemperature(self%thermo_id, t) + end subroutine ctthermo_setTemperature + + double precision function ctthermo_density(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_density = phase_density(self%thermo_id) + end function ctthermo_density + + subroutine ctthermo_setDensity(self, rho) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: rho + self%err = phase_setdensity(self%thermo_id, rho) + end subroutine ctthermo_setDensity + + double precision function ctthermo_molarDensity(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_molardensity = phase_molardensity(self%thermo_id) + end function ctthermo_molarDensity + + double precision function ctthermo_meanMolecularWeight(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_meanmolecularweight = phase_meanmolecularweight(self%thermo_id) + end function ctthermo_meanMolecularWeight + + integer function ctthermo_elementIndex(self, nm) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: nm + ctthermo_elementindex = phase_elementindex(self%thermo_id, nm) + end function ctthermo_elementIndex + + integer function ctthermo_speciesIndex(self, nm) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: nm + ctthermo_speciesindex = phase_speciesindex(self%thermo_id, nm) + end function ctthermo_speciesIndex + + subroutine ctthermo_getMoleFractions(self, x) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: x(self%nsp) + self%err = phase_getmolefractions(self%thermo_id, x) + end subroutine ctthermo_getMoleFractions + + double precision function ctthermo_moleFraction(self, k) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + ctthermo_molefraction = phase_molefraction(self%thermo_id, k) + end function ctthermo_moleFraction + + subroutine ctthermo_getMassFractions(self, y) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: y(self%nsp) + self%err = phase_getmassfractions(self%thermo_id, y) + end subroutine ctthermo_getMassFractions + + double precision function ctthermo_massFraction(self, k) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + ctthermo_massfraction = phase_massfraction(self%thermo_id, k) + end function ctthermo_massFraction + + subroutine ctthermo_setMoleFractions(self, x, norm) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: x(self%nsp) + integer, intent(in), optional :: norm + integer :: n + if (present(norm)) then + n = norm + else + n = 1 + end if + self%err = phase_setmolefractions(self%thermo_id, x, n) + end subroutine ctthermo_setmolefractions + + subroutine ctthermo_setMoleFractionsByName(self, x) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: x + self%err = phase_setmolefractionsbyname(self%thermo_id, x) + end subroutine ctthermo_setmolefractionsbyname + + subroutine ctthermo_setMassFractions(self, y, norm) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: y(self%nsp) + integer, intent(in), optional :: norm + integer :: n + if (present(norm)) then + n = norm + else + n = 1 + end if + self%err = phase_setmassfractions(self%thermo_id, y, n) + end subroutine ctthermo_setmassfractions + + subroutine ctthermo_setMassFractionsByName(self, y) + implicit none + type(phase_t), intent(inout) :: self + character*(*), intent(in) :: y + self%err = phase_setmassfractionsbyname(self%thermo_id, y) + end subroutine ctthermo_setmassfractionsbyname + + subroutine ctthermo_getAtomicWeights(self, atw) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: atw(self%nel) + self%err = phase_getatomicweights(self%thermo_id, atw) + end subroutine ctthermo_getatomicweights + + subroutine ctthermo_getMolecularWeights(self, mw) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: mw(self%nsp) + self%err = phase_getmolecularweights(self%thermo_id, mw) + end subroutine ctthermo_getmolecularweights + + subroutine ctthermo_getSpeciesName(self, k, nm) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + character*(*), intent(out) :: nm + self%err = phase_getspeciesname(self%thermo_id, k, nm) + end subroutine ctthermo_getspeciesname + + subroutine ctthermo_getElementName(self, m, nm) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: m + character*(*), intent(out) :: nm + self%err = phase_getelementname(self%thermo_id, m, nm) + end subroutine ctthermo_getelementname + + double precision function ctthermo_nAtoms(self, k, m) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + integer, intent(in) :: m + ctthermo_natoms = phase_natoms(self%thermo_id, k, m) + end function ctthermo_natoms + + integer function ctthermo_eosType(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_eostype = th_eostype(self%thermo_id) + end function ctthermo_eostype + + double precision function ctthermo_enthalpy_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_enthalpy_mole = th_enthalpy_mole(self%thermo_id) + end function ctthermo_enthalpy_mole + + double precision function ctthermo_intEnergy_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_intenergy_mole = th_intenergy_mole(self%thermo_id) + end function ctthermo_intenergy_mole + + double precision function ctthermo_entropy_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_entropy_mole = th_entropy_mole(self%thermo_id) + end function ctthermo_entropy_mole + + double precision function ctthermo_gibbs_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_gibbs_mole = th_gibbs_mole(self%thermo_id) + end function ctthermo_gibbs_mole + + double precision function ctthermo_cp_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_cp_mole = th_cp_mole(self%thermo_id) + end function ctthermo_cp_mole + + double precision function ctthermo_cv_mole(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_cv_mole = th_cv_mole(self%thermo_id) + end function ctthermo_cv_mole + + double precision function ctthermo_pressure(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_pressure = th_pressure(self%thermo_id) + end function ctthermo_pressure + + double precision function ctthermo_enthalpy_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_enthalpy_mass = th_enthalpy_mass(self%thermo_id) + end function ctthermo_enthalpy_mass + + double precision function ctthermo_intEnergy_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_intEnergy_mass = th_intenergy_mass(self%thermo_id) + end function ctthermo_intEnergy_mass + + double precision function ctthermo_entropy_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_entropy_mass = th_entropy_mass(self%thermo_id) + end function ctthermo_entropy_mass + + double precision function ctthermo_gibbs_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_gibbs_mass = th_gibbs_mass(self%thermo_id) + end function ctthermo_gibbs_mass + + double precision function ctthermo_cp_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_cp_mass = th_cp_mass(self%thermo_id) + end function ctthermo_cp_mass + + double precision function ctthermo_cv_mass(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_cv_mass = th_cv_mass(self%thermo_id) + end function ctthermo_cv_mass + + subroutine ctthermo_chemPotentials(self, mu) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: mu(self%nsp) + self%err = th_chempotentials(self%thermo_id, mu) + end subroutine ctthermo_chempotentials + + subroutine ctthermo_setPressure(self, p) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: p + self%err = th_setpressure(self%thermo_id, p) + end subroutine ctthermo_setpressure + + subroutine ctthermo_setState_TPX(self, t, p, x) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: t + double precision, intent(in) :: p + double precision, intent(in) :: x(*) + call ctthermo_setTemperature(self, t) + call ctthermo_setMoleFractions(self, x) + call ctthermo_setPressure(self, p) + end subroutine ctthermo_setState_TPX + + subroutine ctstring_setState_TPX(self, t, p, x) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: t + double precision, intent(in) :: p + character*(*), intent(in) :: x + call ctthermo_setTemperature(self, t) + call ctthermo_setMoleFractionsByName(self, x) + call ctthermo_setPressure(self, p) + end subroutine ctstring_setState_TPX + + subroutine ctthermo_setState_HP(self, h, p) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: h + double precision, intent(in) :: p + self%err = th_set_hp(self%thermo_id, h, p) + end subroutine ctthermo_setstate_hp + + subroutine ctthermo_setState_UV(self, u, v) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: u + double precision, intent(in) :: v + self%err = th_set_uv(self%thermo_id, u, v) + end subroutine ctthermo_setstate_uv + + subroutine ctthermo_setState_SV(self, s, v) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: s + double precision, intent(in) :: v + self%err = th_set_sv(self%thermo_id, s, v) + end subroutine ctthermo_setstate_sv + + subroutine ctthermo_setState_SP(self, s, p) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(in) :: s + double precision, intent(in) :: p + self%err = th_set_sp(self%thermo_id, s, p) + end subroutine ctthermo_setstate_sp + + subroutine ctthermo_equilibrate(self, XY) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: XY + self%err = th_equil(self%thermo_id, XY) + end subroutine ctthermo_equilibrate + + double precision function ctthermo_refPressure(self) + implicit none + type(phase_t), intent(inout) :: self + ctthermo_refpressure = th_refpressure(self%thermo_id) + end function ctthermo_refpressure + + double precision function ctthermo_minTemp(self, k) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + ctthermo_mintemp = th_mintemp(self%thermo_id, k) + end function ctthermo_mintemp + + double precision function ctthermo_maxTemp(self, k) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: k + ctthermo_maxtemp = th_maxtemp(self%thermo_id, k) + end function ctthermo_maxtemp + + subroutine ctthermo_getEnthalpies_RT(self, h_rt) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: h_rt(self%nsp) + self%err = th_getenthalpies_rt(self%thermo_id, h_rt) + end subroutine ctthermo_getenthalpies_rt + + subroutine ctthermo_getEntropies_R(self, s_r) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: s_r(self%nsp) + self%err = th_getentropies_r(self%thermo_id, s_r) + end subroutine ctthermo_getentropies_r + + subroutine ctthermo_getCp_R(self, lenm, cp_r) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(out) :: lenm + double precision, intent(out) :: cp_r(self%nsp) + self%err = th_getcp_r(self%thermo_id, lenm, cp_r) + end subroutine ctthermo_getcp_r + +end module cantera_thermo diff --git a/Cantera/fortran/src/cantera_transport.f90 b/Cantera/fortran/src/cantera_transport.f90 new file mode 100644 index 000000000..36a5620c1 --- /dev/null +++ b/Cantera/fortran/src/cantera_transport.f90 @@ -0,0 +1,74 @@ +module cantera_transport + + use cantera_thermo + use fct + +contains + +!!$ integer function newTransport(model, phase, loglevel) +!!$ implicit none +!!$ type(XML_Node), intent(in) :: xml_phase +!!$ type(phase_t), intent(inout) :: phase +!!$ integer, optional :: loglevel +!!$ integer :: llevel +!!$ llevel = 0 +!!$ if (present(loglevel)) then +!!$ llevel = loglevel +!!$ end if +!!$ phase%tran_id = newtransport(xml_phase%xml_id, phase%phase_id, loglevel) +!!$ end function newTransport + + double precision function ctrans_viscosity(self) + implicit none + type(phase_t), intent(inout) :: self + ctrans_viscosity = trans_viscosity(self%tran_id) + self%err = 0 + end function ctrans_viscosity + + double precision function ctrans_thermalConductivity(self) + implicit none + type(phase_t), intent(inout) :: self + ctrans_thermalConductivity = trans_thermalConductivity(self%tran_id) + self%err = 0 + end function ctrans_thermalConductivity + + subroutine ctrans_getThermalDiffCoeffs(self, dt) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: dt(*) + self%err = trans_getThermalDiffCoeffs(self%tran_id, dt) + end subroutine ctrans_getThermalDiffCoeffs + + subroutine ctrans_getMixDiffCoeffs(self, d) + implicit none + type(phase_t), intent(inout) :: self + double precision, intent(out) :: d(*) + self%err = trans_getMixDiffCoeffs(self%tran_id, d) + end subroutine ctrans_getMixDiffCoeffs + + subroutine ctrans_getBinDiffCoeffs(self, ld, d) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: ld + double precision, intent(out) :: d(*) + self%err = trans_getBinDiffCoeffs(self%tran_id, ld, d) + end subroutine ctrans_getBinDiffCoeffs + + subroutine ctrans_getMultiDiffCoeffs(self, ld, d) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: ld + double precision, intent(out) :: d(*) + self%err = trans_getMultiDiffCoeffs(self%tran_id, ld, d) + end subroutine ctrans_getMultiDiffCoeffs + + subroutine ctrans_setParameters(self, type, k, d) + implicit none + type(phase_t), intent(inout) :: self + integer, intent(in) :: type + integer, intent(in) :: k + double precision, intent(in) :: d(*) + self%err = trans_setParameters(self%tran_id, type, k, d) + end subroutine ctrans_setParameters + +end module cantera_transport diff --git a/Cantera/fortran/src/fct.cpp b/Cantera/fortran/src/fct.cpp index 721a3593b..f864a0e8e 100644 --- a/Cantera/fortran/src/fct.cpp +++ b/Cantera/fortran/src/fct.cpp @@ -27,28 +27,38 @@ #include "flib_defs.h" -inline XML_Node* _xml(integer* n) { +inline XML_Node* _xml(const integer* n) { return Cabinet::cabinet()->item(*n); } -inline ThermoPhase* _fph(integer* n) { - return Cabinet::cabinet()->item(*n); +inline ThermoPhase* _fph(const integer* n) { + return th(*n); } -inline Kinetics* _fkin(integer* n) { - return Cabinet::cabinet()->item(*n); +inline Kinetics* _fkin(const integer* n) { + return kin(*n); } -inline ThermoPhase* _fth(integer* n) { - return Cabinet::cabinet()->item(*n); +inline ThermoPhase* _fth(const integer* n) { + return th(*n); } -inline Transport* _ftrans(integer* n) { - return Cabinet::cabinet()->item(*n); +inline Transport* _ftrans(const integer* n) { + return trans(*n); } -inline string f2string(const char* s, ftnlen n) { - return string(s, n); +string f2string(const char* s, ftnlen n) { + int k; + string ss = ""; + for (k = 0; k < n; k++) { + if (s[k] == '\0') break; + ss += s[k]; + } + return ss; +} + +static void handleError() { + error(lastErrorMessage()); } /** @@ -56,79 +66,91 @@ inline string f2string(const char* s, ftnlen n) { */ extern "C" { + status_t cantera_error_(const char* proc, const char* msg, + ftnlen proclen, ftnlen msglen) { + try { + string sproc = f2string(proc, proclen); + string smsg = f2string(msg, msglen); + throw CanteraError(sproc, smsg); + } + catch (CanteraError) { + handleError(); return -1; + } + } + //--------------- Phase ---------------------// - integer DLL_EXPORT phase_nelements_(integer* n) { + integer DLL_EXPORT phase_nelements_(const integer* n) { return _fph(n)->nElements(); } - integer DLL_EXPORT phase_nspecies_(integer* n) { + integer DLL_EXPORT phase_nspecies_(const integer* n) { return _fph(n)->nSpecies(); } - doublereal DLL_EXPORT phase_temperature_(integer* n) { + doublereal DLL_EXPORT phase_temperature_(const integer* n) { return _fph(n)->temperature(); } - integer DLL_EXPORT phase_settemperature_(integer* n, doublereal* t) { + status_t DLL_EXPORT phase_settemperature_(const integer* n, doublereal* t) { _fph(n)->setTemperature(*t); return 0; } - doublereal DLL_EXPORT phase_density_(integer* n) { + doublereal DLL_EXPORT phase_density_(const integer* n) { return _fph(n)->density(); } - integer DLL_EXPORT phase_setdensity_(integer* n, doublereal* rho) { + status_t DLL_EXPORT phase_setdensity_(const integer* n, doublereal* rho) { _fph(n)->setDensity(*rho); return 0; } - doublereal DLL_EXPORT phase_molardensity_(integer* n) { + doublereal DLL_EXPORT phase_molardensity_(const integer* n) { return _fph(n)->molarDensity(); } - doublereal DLL_EXPORT phase_meanmolecularweight_(integer* n) { + doublereal DLL_EXPORT phase_meanmolecularweight_(const integer* n) { return _fph(n)->meanMolecularWeight(); } - integer DLL_EXPORT phase_elementindex_(integer* n, char* nm, ftnlen lennm) { + integer DLL_EXPORT phase_elementindex_(const integer* n, char* nm, ftnlen lennm) { string elnm = f2string(nm, lennm); - return _fph(n)->elementIndex(elnm); + return _fph(n)->elementIndex(elnm) + 1; } - integer DLL_EXPORT phase_speciesindex_(integer* n, char* nm, ftnlen lennm) { + integer DLL_EXPORT phase_speciesindex_(const integer* n, char* nm, ftnlen lennm) { string spnm = f2string(nm, lennm); - return _fph(n)->speciesIndex(spnm); + return _fph(n)->speciesIndex(spnm) + 1; } - integer DLL_EXPORT phase_getmolefractions_(integer* n, doublereal* x) { + status_t DLL_EXPORT phase_getmolefractions_(const integer* n, doublereal* x) { _fph(n)->getMoleFractions(x); return 0; } - doublereal DLL_EXPORT phase_molefraction_(integer* n, integer* k) { - return _fph(n)->moleFraction(*k); + doublereal DLL_EXPORT phase_molefraction_(const integer* n, integer* k) { + return _fph(n)->moleFraction(*k-1); } - integer DLL_EXPORT phase_getmassfractions_(integer* n, doublereal* y) { + status_t DLL_EXPORT phase_getmassfractions_(const integer* n, doublereal* y) { ThermoPhase* p = _fph(n); p->getMassFractions(y); return 0; } - doublereal DLL_EXPORT phase_massfraction_(integer* n, integer* k) { - return _fph(n)->massFraction(*k); + doublereal DLL_EXPORT phase_massfraction_(const integer* n, integer* k) { + return _fph(n)->massFraction(*k-1); } - integer DLL_EXPORT phase_setmolefractions_(integer* n, double* x, integer* norm) { + status_t DLL_EXPORT phase_setmolefractions_(const integer* n, double* x, const integer* norm) { ThermoPhase* p = _fph(n); if (*norm) p->setMoleFractions(x); else p->setMoleFractions_NoNorm(x); return 0; } - integer DLL_EXPORT phase_setmolefractionsbyname_(integer* n, char* x, ftnlen lx) { + status_t DLL_EXPORT phase_setmolefractionsbyname_(const integer* n, char* x, ftnlen lx) { try { ThermoPhase* p = _fph(n); compositionMap xx; @@ -140,17 +162,17 @@ extern "C" { p->setMoleFractionsByName(xx); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT phase_setmassfractions_(integer* n, doublereal* y, integer* norm) { + status_t DLL_EXPORT phase_setmassfractions_(const integer* n, doublereal* y, const integer* norm) { ThermoPhase* p = _fph(n); if (*norm) p->setMassFractions(y); else p->setMassFractions_NoNorm(y); return 0; } - integer DLL_EXPORT phase_setmassfractionsbyname_(integer* n, char* y, ftnlen leny) { + status_t DLL_EXPORT phase_setmassfractionsbyname_(const integer* n, char* y, ftnlen leny) { try { ThermoPhase* p = _fph(n); compositionMap yy; @@ -162,17 +184,17 @@ extern "C" { p->setMassFractionsByName(yy); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT phase_getatomicweights_(integer* n, doublereal* atw) { + status_t DLL_EXPORT phase_getatomicweights_(const integer* n, doublereal* atw) { ThermoPhase* p = _fph(n); const vector_fp& wt = p->atomicWeights(); copy(wt.begin(), wt.end(), atw); return 0; } - integer DLL_EXPORT phase_getmolecularweights_(integer* n, doublereal* mw) { + status_t DLL_EXPORT phase_getmolecularweights_(const integer* n, doublereal* mw) { ThermoPhase* p = _fph(n); const vector_fp& wt = p->molecularWeights(); copy(wt.begin(), wt.end(), mw); @@ -180,34 +202,34 @@ extern "C" { } - integer DLL_EXPORT phase_getspeciesname_(integer* n, integer* k, char* nm, ftnlen lennm) { + status_t DLL_EXPORT phase_getspeciesname_(const integer* n, integer* k, char* nm, ftnlen lennm) { try { - string spnm = _fph(n)->speciesName(*k); + string spnm = _fph(n)->speciesName(*k-1); int lout = min(lennm,spnm.size()); copy(spnm.c_str(), spnm.c_str() + lout, nm); - for (int nn = lout; nn < lennm; nn++) nm[nn] = '\0'; + for (int nn = lout; nn < lennm; nn++) nm[nn] = ' '; return 0; } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT phase_getelementname_(integer* n, integer* m, char* nm, ftnlen lennm) { + status_t DLL_EXPORT phase_getelementname_(const integer* n, integer* m, char* nm, ftnlen lennm) { try { - string elnm = _fph(n)->elementName(*m); + string elnm = _fph(n)->elementName(*m-1); int lout = min(lennm,elnm.size()); copy(elnm.c_str(), elnm.c_str() + lout, nm); - for (int nn = lout; nn < lennm; nn++) nm[nn] = '\0'; + for (int nn = lout; nn < lennm; nn++) nm[nn] = ' '; return 0; } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - doublereal DLL_EXPORT phase_natoms_(integer* n, integer* k, integer* m) { + doublereal DLL_EXPORT phase_natoms_(const integer* n, integer* k, integer* m) { try { - return _fph(n)->nAtoms(*k,*m); + return _fph(n)->nAtoms(*k-1,*m-1); } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } @@ -216,7 +238,7 @@ extern "C" { //-------------- Thermo --------------------// - // integer DLL_EXPORT th_thermoIndex(char* id) { + // status_t DLL_EXPORT th_thermoIndex(char* id) { // return thermo_index(id); //} @@ -224,161 +246,161 @@ extern "C" { try { XML_Node* x = _xml(mxml); thermo_t* th = newPhase(*x); - return Cabinet::cabinet()->add(th); + return Storage::storage()->addThermo(th); } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT th_nspecies_(integer* n) { + integer DLL_EXPORT th_nspecies_(const integer* n) { return _fth(n)->nSpecies(); } - integer DLL_EXPORT th_eostype_(integer* n) { + integer DLL_EXPORT th_eostype_(const integer* n) { return _fth(n)->eosType(); } - doublereal DLL_EXPORT th_enthalpy_mole_(integer* n) { + doublereal DLL_EXPORT th_enthalpy_mole_(const integer* n) { try {return _fth(n)->enthalpy_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_intenergy_mole_(integer* n) { + doublereal DLL_EXPORT th_intenergy_mole_(const integer* n) { try {return _fth(n)->intEnergy_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_entropy_mole_(integer* n) { + doublereal DLL_EXPORT th_entropy_mole_(const integer* n) { try {return _fth(n)->entropy_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_gibbs_mole_(integer* n) { + doublereal DLL_EXPORT th_gibbs_mole_(const integer* n) { try {return _fth(n)->gibbs_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_cp_mole_(integer* n) { + doublereal DLL_EXPORT th_cp_mole_(const integer* n) { try {return _fth(n)->cp_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_cv_mole_(integer* n) { + doublereal DLL_EXPORT th_cv_mole_(const integer* n) { try {return _fth(n)->cv_mole();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_pressure_(integer* n) { + doublereal DLL_EXPORT th_pressure_(const integer* n) { try {return _fth(n)->pressure();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_enthalpy_mass_(integer* n) { + doublereal DLL_EXPORT th_enthalpy_mass_(const integer* n) { try {return _fth(n)->enthalpy_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_intEnergy_mass_(integer* n) { + doublereal DLL_EXPORT th_intenergy_mass_(const integer* n) { try {return _fth(n)->intEnergy_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_entropy_mass_(integer* n) { + doublereal DLL_EXPORT th_entropy_mass_(const integer* n) { try {return _fth(n)->entropy_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_gibbs_mass_(integer* n) { + doublereal DLL_EXPORT th_gibbs_mass_(const integer* n) { try {return _fth(n)->gibbs_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_cp_mass_(integer* n) { + doublereal DLL_EXPORT th_cp_mass_(const integer* n) { try {return _fth(n)->cp_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - doublereal DLL_EXPORT th_cv_mass_(integer* n) { + doublereal DLL_EXPORT th_cv_mass_(const integer* n) { try {return _fth(n)->cv_mass();} - catch (CanteraError) {return DERR;} + catch (CanteraError) {handleError(); return DERR;} } - integer DLL_EXPORT th_chempotentials_(integer* n, doublereal* murt) { + status_t DLL_EXPORT th_chempotentials_(const integer* n, doublereal* murt) { thermo_t* thrm = _fth(n); thrm->getChemPotentials(murt); return 0; } - integer DLL_EXPORT th_setpressure_(integer* n, doublereal* p) { + status_t DLL_EXPORT th_setpressure_(const integer* n, doublereal* p) { try { _fth(n)->setPressure(*p); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT th_set_hp_(integer* n, doublereal* vals) { + status_t DLL_EXPORT th_set_hp_(const integer* n, doublereal* v1, doublereal* v2) { try { - _fth(n)->setState_HP(vals[0],vals[1]); + _fth(n)->setState_HP(*v1, *v2); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT th_set_uv_(integer* n, doublereal* vals) { + status_t DLL_EXPORT th_set_uv_(const integer* n, doublereal* v1, doublereal* v2) { try { - _fth(n)->setState_UV(vals[0],vals[1]); + _fth(n)->setState_UV(*v1, *v2); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT th_set_sv_(integer* n, doublereal* vals) { - try { _fth(n)->setState_SV(vals[0],vals[1]); + status_t DLL_EXPORT th_set_sv_(const integer* n, doublereal* v1, doublereal* v2) { + try { _fth(n)->setState_SV(*v1, *v2); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT th_set_sp_(integer* n, doublereal* vals) { + status_t DLL_EXPORT th_set_sp_(const integer* n, doublereal* v1, doublereal* v2) { try { - _fth(n)->setState_SP(vals[0],vals[1]); + _fth(n)->setState_SP(*v1, *v2); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT th_equil_(integer* n, integer* XY) { + status_t DLL_EXPORT th_equil_(const integer* n, integer* XY) { try { equilibrate(*_fth(n), *XY); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - doublereal DLL_EXPORT th_refpressure_(integer* n) { + doublereal DLL_EXPORT th_refpressure_(const integer* n) { return _fth(n)->refPressure(); } - doublereal DLL_EXPORT th_mintemp_(integer* n, integer* k) { - return _fth(n)->minTemp(*k); + doublereal DLL_EXPORT th_mintemp_(const integer* n, integer* k) { + return _fth(n)->minTemp(*k-1); } - doublereal DLL_EXPORT th_maxtemp_(integer* n, integer* k) { - return _fth(n)->maxTemp(*k); + doublereal DLL_EXPORT th_maxtemp_(const integer* n, integer* k) { + return _fth(n)->maxTemp(*k-1); } - integer DLL_EXPORT th_getenthalpies_rt_(integer* n, doublereal* h_rt) { + status_t DLL_EXPORT th_getenthalpies_rt_(const integer* n, doublereal* h_rt) { thermo_t* thrm = _fth(n); thrm->getEnthalpy_RT(h_rt); return 0; } - integer DLL_EXPORT th_getentropies_r_(integer* n, doublereal* s_r) { + status_t DLL_EXPORT th_getentropies_r_(const integer* n, doublereal* s_r) { thermo_t* thrm = _fth(n); thrm->getEntropy_R(s_r); return 0; } - integer DLL_EXPORT th_getcp_r_(integer* n, integer* lenm, doublereal* cp_r) { + status_t DLL_EXPORT th_getcp_r_(const integer* n, integer* lenm, doublereal* cp_r) { thermo_t* thrm = _fth(n); thrm->getCp_R(cp_r); return 0; @@ -387,35 +409,37 @@ extern "C" { //-------------- Kinetics ------------------// - integer DLL_EXPORT newkineticsfromxml_(integer* mxml, integer* iphase, - integer* neighbor1, integer* neighbor2, integer* neighbor3, - integer* neighbor4) { + status_t DLL_EXPORT newkineticsfromxml_(integer* mxml, integer* iphase, + const integer* neighbor1, const integer* neighbor2, const integer* neighbor3, + const integer* neighbor4) { try { XML_Node* x = _xml(mxml); vector phases; phases.push_back(_fth(iphase)); - if (neighbor1 >= 0) { + if (*neighbor1 >= 0) { phases.push_back(_fth(neighbor1)); - if (neighbor2 >= 0) { + if (*neighbor2 >= 0) { phases.push_back(_fth(neighbor2)); - if (neighbor3 >= 0) { + if (*neighbor3 >= 0) { phases.push_back(_fth(neighbor3)); - if (neighbor4 >= 0) { + if (*neighbor4 >= 0) { phases.push_back(_fth(neighbor4)); } } } } Kinetics* kin = newKineticsMgr(*x, phases); - if (kin) - return Cabinet::cabinet()->add(kin); - else + if (kin) { + return Storage::storage()->addKinetics(kin); + } + else { return 0; + } } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } -// integer DLL_EXPORT installRxnArrays_(integer* pxml, integer* ikin, +// status_t DLL_EXPORT installRxnArrays_(integer* pxml, integer* ikin, // char* default_phase) { // try { // XML_Node* p = _xml(pxml); @@ -424,141 +448,141 @@ extern "C" { // installReactionArrays(*p, *k, defphase); // return 0; // } -// catch (CanteraError) { return -1; } +// catch (CanteraError) { handleError(); return -1; } // } //------------------------------------- - integer DLL_EXPORT kin_type_(integer* n) { + integer DLL_EXPORT kin_type_(const integer* n) { return _fkin(n)->type(); } - integer DLL_EXPORT kin_start_(integer* n, integer* p) { - return _fkin(n)->start(*p); + integer DLL_EXPORT kin_start_(const integer* n, integer* p) { + return _fkin(n)->start(*p)+1; } - integer DLL_EXPORT kin_speciesindex_(integer* n, const char* nm, const char* ph, + integer DLL_EXPORT kin_speciesindex_(const integer* n, const char* nm, const char* ph, ftnlen lennm, ftnlen lenph) { - return _fkin(n)->kineticsSpeciesIndex(f2string(nm, lennm), f2string(ph, lenph)); + return _fkin(n)->kineticsSpeciesIndex(f2string(nm, lennm), f2string(ph, lenph))+1; } //--------------------------------------- - integer DLL_EXPORT kin_ntotalspecies_(integer* n) { + integer DLL_EXPORT kin_ntotalspecies_(const integer* n) { return _fkin(n)->nTotalSpecies(); } - integer DLL_EXPORT kin_nreactions_(integer* n) { + integer DLL_EXPORT kin_nreactions_(const integer* n) { return _fkin(n)->nReactions(); } - doublereal DLL_EXPORT kin_reactantstoichcoeff_(integer* n, integer* k, integer* i) { - return _fkin(n)->reactantStoichCoeff(*k,*i); + doublereal DLL_EXPORT kin_reactantstoichcoeff_(const integer* n, integer* k, integer* i) { + return _fkin(n)->reactantStoichCoeff(*k-1,*i-1); } - doublereal DLL_EXPORT kin_productstoichcoeff_(integer* n, integer* k, integer* i) { - return _fkin(n)->productStoichCoeff(*k,*i); + doublereal DLL_EXPORT kin_productstoichcoeff_(const integer* n, integer* k, integer* i) { + return _fkin(n)->productStoichCoeff(*k-1,*i-1); } - integer DLL_EXPORT kin_reactiontype_(integer* n, integer* i) { - return _fkin(n)->reactionType(*i); + integer DLL_EXPORT kin_reactiontype_(const integer* n, integer* i) { + return _fkin(n)->reactionType(*i-1); } - integer DLL_EXPORT kin_getfwdratesofprogress_(integer* n, doublereal* fwdROP) { + status_t DLL_EXPORT kin_getfwdratesofprogress_(const integer* n, doublereal* fwdROP) { Kinetics* k = _fkin(n); try { k->getFwdRatesOfProgress(fwdROP); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_getrevratesofprogress_(integer* n, doublereal* revROP) { + status_t DLL_EXPORT kin_getrevratesofprogress_(const integer* n, doublereal* revROP) { Kinetics* k = _fkin(n); try { k->getRevRatesOfProgress(revROP); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_isreversible_(integer* n, integer* i) { + integer DLL_EXPORT kin_isreversible_(const integer* n, integer* i) { return (int)_fkin(n)->isReversible(*i); } - integer DLL_EXPORT kin_getnetratesofprogress_(integer* n, doublereal* netROP) { + status_t DLL_EXPORT kin_getnetratesofprogress_(const integer* n, doublereal* netROP) { try { Kinetics* k = _fkin(n); k->getNetRatesOfProgress(netROP); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_getcreationrates_(integer* n, doublereal* cdot) { + status_t DLL_EXPORT kin_getcreationrates_(const integer* n, doublereal* cdot) { try { Kinetics* k = _fkin(n); k->getCreationRates(cdot); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_getdestructionrates_(integer* n, doublereal* ddot) { + status_t DLL_EXPORT kin_getdestructionrates_(const integer* n, doublereal* ddot) { try { Kinetics* k = _fkin(n); k->getDestructionRates(ddot); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_getnetproductionrates_(integer* n, doublereal* wdot) { + status_t DLL_EXPORT kin_getnetproductionrates_(const integer* n, doublereal* wdot) { try { Kinetics* k = _fkin(n); k->getNetProductionRates(wdot); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - doublereal DLL_EXPORT kin_multiplier_(integer* n, integer* i) { + doublereal DLL_EXPORT kin_multiplier_(const integer* n, integer* i) { return _fkin(n)->multiplier(*i); } - //integer DLL_EXPORT kin_phase_(integer* n, integer* i) { + //status_t DLL_EXPORT kin_phase_(const integer* n, integer* i) { // return thermo_index(_fkin(n)->thermo(*i).id()); //} - integer DLL_EXPORT kin_getequilibriumconstants_(integer* n, doublereal* kc) { + status_t DLL_EXPORT kin_getequilibriumconstants_(const integer* n, doublereal* kc) { try { Kinetics* k = _fkin(n); k->getEquilibriumConstants(kc); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_getreactionstring_(integer* n, integer* i, char* buf, ftnlen lenbuf) { + status_t DLL_EXPORT kin_getreactionstring_(const integer* n, integer* i, char* buf, ftnlen lenbuf) { try { Kinetics* k = _fkin(n); - string r = k->reactionString(*i); + string r = k->reactionString(*i-1); int lout = min(lenbuf,r.size()); copy(r.c_str(), r.c_str() + lout, buf); - for (int nn = lout; nn < lenbuf; nn++) buf[nn] = '\0'; + for (int nn = lout; nn < lenbuf; nn++) buf[nn] = ' '; return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_setmultiplier_(integer* n, integer* i, doublereal* v) { + status_t DLL_EXPORT kin_setmultiplier_(const integer* n, integer* i, doublereal* v) { try { - _fkin(n)->setMultiplier(*i,*v); + _fkin(n)->setMultiplier(*i-1,*v); return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } - integer DLL_EXPORT kin_advancecoverages_(integer* n, doublereal* tstep) { + status_t DLL_EXPORT kin_advancecoverages_(const integer* n, doublereal* tstep) { try { Kinetics* k = _fkin(n); if (k->type() == cInterfaceKinetics) { @@ -570,60 +594,62 @@ extern "C" { } return 0; } - catch (CanteraError) {return -1;} + catch (CanteraError) {handleError(); return -1;} } //------------------- Transport --------------------------- - integer DLL_EXPORT newtransport(char* model, + integer DLL_EXPORT newtransport_(char* model, integer* ith, integer* loglevel, ftnlen lenmodel) { string mstr = f2string(model, lenmodel); thermo_t* t = _fth(ith); try { + cout << int(mstr[5]) << endl; + cout << "mstr = >" << mstr << "< " << endl; Transport* tr = newTransportMgr(mstr, t, *loglevel); - return Cabinet::cabinet()->add(tr); + return Storage::storage()->addTransport(tr); } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - doublereal DLL_EXPORT trans_viscosity_(integer* n) { + doublereal DLL_EXPORT trans_viscosity_(const integer* n) { try {return _ftrans(n)->viscosity();} - catch (CanteraError) { return -1.0; } + catch (CanteraError) { handleError(); return DERR; } } - doublereal DLL_EXPORT trans_thermalConductivity_(integer* n) { + doublereal DLL_EXPORT trans_thermalconductivity_(const integer* n) { try {return _ftrans(n)->thermalConductivity();} - catch (CanteraError) { return -1.0; } + catch (CanteraError) { handleError(); return DERR; } } - integer DLL_EXPORT trans_getThermalDiffCoeffs_(integer* n, doublereal* dt) { + status_t DLL_EXPORT trans_getthermaldiffcoeffs_(const integer* n, doublereal* dt) { try { _ftrans(n)->getThermalDiffCoeffs(dt); return 0; } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT trans_getMixDiffCoeffs_(integer* n, doublereal* d) { + status_t DLL_EXPORT trans_getmixdiffcoeffs_(const integer* n, doublereal* d) { try { _ftrans(n)->getMixDiffCoeffs(d); return 0;} - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT trans_getBinDiffCoeffs_(integer* n, integer* ld, doublereal* d) { + status_t DLL_EXPORT trans_getbindiffcoeffs_(const integer* n, integer* ld, doublereal* d) { try { _ftrans(n)->getBinaryDiffCoeffs(*ld,d); return 0;} - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT trans_getMultiDiffCoeffs_(integer* n, integer* ld, doublereal* d) { + status_t DLL_EXPORT trans_getmultidiffcoeffs_(const integer* n, integer* ld, doublereal* d) { try { _ftrans(n)->getMultiDiffCoeffs(*ld,d); return 0;} - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT trans_setParameters_(integer* n, integer* type, integer* k, doublereal* d) { + status_t DLL_EXPORT trans_setparameters_(const integer* n, integer* type, integer* k, doublereal* d) { try { _ftrans(n)->setParameters(*type, *k, d); return 0;} - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } //-------------------- Functions --------------------------- -// integer DLL_EXPORT import_phase_(integer* nth, integer* nxml, char* id, ftnlen lenid) { +// status_t DLL_EXPORT import_phase_(const integer* nth, const integer* nxml, char* id, ftnlen lenid) { // thermo_t* thrm = th(nth); // XML_Node* node = _xml(nxml); // string idstr = f2string(id, lenid); @@ -631,11 +657,11 @@ extern "C" { // importPhase(*node, thrm); // return 0; // } -// catch (CanteraError) { return -1; } +// catch (CanteraError) { handleError(); return -1; } // } -// integer DLL_EXPORT import_kinetics_(integer* nxml, char* id, -// integer* nphases, integer* ith, integer* nkin, ftnlen lenid) { +// status_t DLL_EXPORT import_kinetics_(const integer* nxml, char* id, +// const integer* nphases, integer* ith, const integer* nkin, ftnlen lenid) { // vector phases; // for (int i = 0; i < nphases; i++) { // phases.push_back(th(ith[i])); @@ -647,11 +673,11 @@ extern "C" { // importKinetics(*node, phases, k); // return 0; // } -// catch (CanteraError) { return -1; } +// catch (CanteraError) { handleError(); return -1; } // } - integer DLL_EXPORT phase_report_(integer* nth, + status_t DLL_EXPORT ctphase_report_(const integer* nth, char* buf, integer* show_thermo, ftnlen buflen) { try { bool stherm = (*show_thermo != 0); @@ -660,29 +686,29 @@ extern "C" { return -(s.size() + 1); } copy(s.begin(), s.end(), buf); - for (int nn = s.size(); nn < buflen; nn++) buf[nn] = '\0'; + for (int nn = s.size(); nn < buflen; nn++) buf[nn] = ' '; return 0; } - catch (CanteraError) { return -1; } + catch (CanteraError) { handleError(); return -1; } } - integer DLL_EXPORT getCanteraError_(char* buf, ftnlen buflen) { + status_t DLL_EXPORT ctgetcanteraerror_(char* buf, ftnlen buflen) { string e; // = ""; //if (nErrors() > 0) e = lastErrorMessage(); int n = min(e.size(), buflen-1); copy(e.begin(), e.begin() + n, buf); - for (int nn = n; nn < buflen; nn++) buf[nn] = '\0'; + for (int nn = n; nn < buflen; nn++) buf[nn] = ' '; return 0; } - integer DLL_EXPORT addCanteraDirectory_(integer* buflen, char* buf) { + status_t DLL_EXPORT ctaddcanteradirectory_(integer* buflen, char* buf) { addDirectory(string(buf)); return 0; } -// integer DLL_EXPORT readlog_(integer* n, char* buf) { +// status_t DLL_EXPORT readlog_(const integer* n, char* buf) { // string s; // writelog("function readlog is deprecated!"); // //getlog(s); @@ -697,27 +723,8 @@ extern "C" { // } - integer DLL_EXPORT delThermo_(integer* n) { - try { - Cabinet::cabinet()->del(*n); - return 0; - } - catch (CanteraError) { - return -1; - } - } - integer DLL_EXPORT delKinetics_(integer* n) { - Cabinet::cabinet()->del(*n); - return 0; - } - - integer DLL_EXPORT delTransport_(integer* n) { - Cabinet::cabinet()->del(*n); - return 0; - } - - integer DLL_EXPORT buildSolutionFromXML(char* src, integer* ixml, char* id, + status_t DLL_EXPORT ctbuildsolutionfromxml(char* src, integer* ixml, char* id, integer* ith, integer* ikin, ftnlen lensrc, ftnlen lenid) { XML_Node* root = 0; @@ -737,7 +744,7 @@ extern "C" { x = get_XML_Node(idS, r); } // x = find_XML(f2string(src, lensrc), r, f2string(id,lenid), "", "phase"); - if (!x) return false; + if (!x) return 0; importPhase(*x, t); kin.addPhase(*t); kin.init(); @@ -749,11 +756,4 @@ extern "C" { else delete &x->root(); return 0; } - - - // integer DLL_EXPORT ck_to_ctml(char* in_file, char* db_file, -// char* tr_file, char* out_file, char* id_tag) { -// return convert_ck(in_file, db_file, tr_file, out_file, id_tag); -// } - } diff --git a/Cantera/fortran/src/fctxml.cpp b/Cantera/fortran/src/fctxml.cpp index 0ee94e6d7..87a19f8bd 100644 --- a/Cantera/fortran/src/fctxml.cpp +++ b/Cantera/fortran/src/fctxml.cpp @@ -7,12 +7,6 @@ #include "../../clib/src/Cabinet.h" -// Values returned for error conditions -#define ERR -999 -#define DERR -999.999 - -//Cabinet* Cabinet::__storage = 0; - inline XML_Node* _xml(const integer* i) { return Cabinet::cabinet(false)->item(*i); } @@ -21,22 +15,23 @@ static void handleError() { error(lastErrorMessage()); } +string f2string(const char* s, ftnlen n); + extern "C" { - int DLL_EXPORT fxml_new_(const char* name, ftnlen namelen) { + integer DLL_EXPORT fxml_new_(const char* name, ftnlen namelen) { XML_Node* x; if (!name) x = new XML_Node; else - x = new XML_Node(string(name, namelen)); + x = new XML_Node(f2string(name, namelen)); return Cabinet::cabinet(true)->add(x); } - int DLL_EXPORT fxml_get_xml_file_(const char* file, ftnlen filelen) { + status_t DLL_EXPORT fxml_get_xml_file_(const char* file, ftnlen filelen) { try { - XML_Node* x = get_XML_File(string(file, filelen)); + XML_Node* x = get_XML_File(f2string(file, filelen)); int ix = Cabinet::cabinet(false)->add(x); - cout << "ix = " << ix << endl; return ix; } catch (CanteraError) { @@ -45,7 +40,7 @@ extern "C" { } } - int DLL_EXPORT fxml_clear_() { + status_t DLL_EXPORT fxml_clear_() { try { Cabinet::cabinet(false)->clear(); close_XML_File("all"); @@ -54,39 +49,28 @@ extern "C" { catch (CanteraError) { handleError(); return -1;} } - int DLL_EXPORT fxml_del_(const integer* i) { + status_t DLL_EXPORT fxml_del_(const integer* i) { Cabinet::cabinet(false)->del(*i); return 0; } - int DLL_EXPORT fxml_removechild_(const integer* i, const integer* j) { + status_t DLL_EXPORT fxml_removechild_(const integer* i, const integer* j) { _xml(i)->removeChild(_xml(j)); return 0; } - int DLL_EXPORT fxml_copy_(const integer* i) { + status_t DLL_EXPORT fxml_copy_(const integer* i) { return Cabinet::cabinet(false)->newCopy(*i); } - int DLL_EXPORT fxml_assign_(const integer* i, const integer* j) { + status_t DLL_EXPORT fxml_assign_(const integer* i, const integer* j) { return Cabinet::cabinet(false)->assign(*i,*j); } -// int DLL_EXPORT fxml_preprocess_and_build_(const integer* i, -// const char* file, ftnlen filelen) { -// try { -// get_CTML_Tree(_xml(i), string(file, filelen)); -// return 0; -// } -// catch (CanteraError) { handleError(); return -1;} -// } - - - - int DLL_EXPORT fxml_attrib_(const integer* i, const char* key, + status_t DLL_EXPORT fxml_attrib_(const integer* i, const char* key, char* value, ftnlen keylen, ftnlen valuelen) { try { - string ky = string(key, keylen); + string ky = f2string(key, keylen); XML_Node& node = *_xml(i); if (node.hasAttrib(ky)) { string v = node[ky]; @@ -100,11 +84,11 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_addattrib_(const integer* i, + status_t DLL_EXPORT fxml_addattrib_(const integer* i, const char* key, const char* value, ftnlen keylen, ftnlen valuelen) { try { - string ky = string(key, keylen); - string val = string(value, valuelen); + string ky = f2string(key, keylen); + string val = f2string(value, valuelen); XML_Node& node = *_xml(i); node.addAttribute(ky, val); } @@ -112,10 +96,10 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_addcomment_(const integer* i, const char* comment, + status_t DLL_EXPORT fxml_addcomment_(const integer* i, const char* comment, ftnlen commentlen) { try { - string c = string(comment, commentlen); + string c = f2string(comment, commentlen); XML_Node& node = *_xml(i); node.addComment(c); } @@ -123,7 +107,7 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_tag_(const integer* i, char* tag, ftnlen taglen) { + status_t DLL_EXPORT fxml_tag_(const integer* i, char* tag, ftnlen taglen) { try { XML_Node& node = *_xml(i); const string v = node.name(); @@ -133,7 +117,7 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_value_(const integer* i, char* value, ftnlen valuelen) { + status_t DLL_EXPORT fxml_value_(const integer* i, char* value, ftnlen valuelen) { try { XML_Node& node = *_xml(i); const string v = node.value(); @@ -143,17 +127,17 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_child_(const integer* i, const char* loc, ftnlen loclen) { + status_t DLL_EXPORT fxml_child_(const integer* i, const char* loc, ftnlen loclen) { try { XML_Node& node = *_xml(i); - XML_Node& c = node.child(string(loc, loclen)); + XML_Node& c = node.child(f2string(loc, loclen)); return Cabinet::cabinet()->add(&c); } catch (CanteraError) { handleError(); } return 0; } - int DLL_EXPORT fxml_child_bynumber_(const integer* i, const integer* m) { + status_t DLL_EXPORT fxml_child_bynumber_(const integer* i, const integer* m) { try { XML_Node& node = *_xml(i); XML_Node& c = node.child(*m); @@ -163,36 +147,36 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_findid_(const integer* i, const char* id, ftnlen idlen) { + status_t DLL_EXPORT fxml_findid_(const integer* i, const char* id, ftnlen idlen) { try { XML_Node& node = *_xml(i); - XML_Node* c = node.findID(string(id, idlen)); + XML_Node* c = node.findID(f2string(id, idlen)); if (c) { return Cabinet::cabinet()->add(c); } else - throw CanteraError("fxml_find_id","id not found: "+string(id, idlen)); + throw CanteraError("fxml_find_id","id not found: "+f2string(id, idlen)); } catch (CanteraError) { handleError(); } return 0; } - int DLL_EXPORT fxml_findbyname_(const integer* i, const char* nm, ftnlen nmlen) { + status_t DLL_EXPORT fxml_findbyname_(const integer* i, const char* nm, ftnlen nmlen) { try { XML_Node& node = *_xml(i); - XML_Node* c = node.findByName(string(nm, nmlen)); + XML_Node* c = node.findByName(f2string(nm, nmlen)); if (c) { return Cabinet::cabinet()->add(c); } else - throw CanteraError("fxml_findByName","name "+string(nm, nmlen) + throw CanteraError("fxml_findByName","name "+f2string(nm, nmlen) +" not found"); } catch (CanteraError) { handleError(); } return 0; } - int DLL_EXPORT fxml_nchildren_(const integer* i) { + integer DLL_EXPORT fxml_nchildren_(const integer* i) { try { XML_Node& node = *_xml(i); return node.nChildren(); @@ -201,19 +185,19 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_addchild_(const integer* i, const char* name, + status_t DLL_EXPORT fxml_addchild_(const integer* i, const char* name, const char* value, ftnlen namelen, ftnlen valuelen) { try { XML_Node& node = *_xml(i); - XML_Node& c = node.addChild(string(name, namelen), - string(value,valuelen)); + XML_Node& c = node.addChild(f2string(name, namelen), + f2string(value,valuelen)); return Cabinet::cabinet()->add(&c); } catch (CanteraError) { handleError(); } return 0; } - int DLL_EXPORT fxml_addchildnode_(const integer* i, const integer* j) { + status_t DLL_EXPORT fxml_addchildnode_(const integer* i, const integer* j) { try { XML_Node& node = *_xml(i); XML_Node& chld = *_xml(j); @@ -224,7 +208,7 @@ extern "C" { return 0; } - int DLL_EXPORT fxml_write_(const integer* i, const char* file, ftnlen filelen) { + status_t DLL_EXPORT fxml_write_(const integer* i, const char* file, ftnlen filelen) { try { string ff(file, filelen); ofstream f(ff.c_str()); @@ -234,7 +218,7 @@ extern "C" { } else { throw CanteraError("fxml_write", - "file "+string(file, filelen)+" not found."); + "file "+f2string(file, filelen)+" not found."); } return 0; } @@ -242,7 +226,7 @@ extern "C" { return 0; } - int DLL_EXPORT ctml_getfloatarray_(const integer* i, const integer* n, + status_t DLL_EXPORT ctml_getfloatarray_(const integer* i, const integer* n, doublereal* data, const integer* iconvert) { try { XML_Node& node = *_xml(i); diff --git a/Cantera/fortran/src/flib_defs.h b/Cantera/fortran/src/flib_defs.h index d8361d87a..ee5dbbaee 100644 --- a/Cantera/fortran/src/flib_defs.h +++ b/Cantera/fortran/src/flib_defs.h @@ -16,4 +16,8 @@ #define ERR -999 #define DERR -999.999 +#include "../../src/config.h" + +typedef integer status_t; + #endif diff --git a/Cantera/fortran/src/genf.py b/Cantera/fortran/src/genf.py index 4e5cb0302..ba7cca383 100644 --- a/Cantera/fortran/src/genf.py +++ b/Cantera/fortran/src/genf.py @@ -31,13 +31,19 @@ def getargs(line): raise 'malformed argument: ' return nm, v -_c2fout = {'int*':'integer', 'integer*':'integer', 'double*':'double precision', +_c2fout = {'int*':'integer', 'integer*':'integer', + 'double*':'double precision', 'doublereal*':'double precision', 'char*':'character*(*)'} _c2fin = {'const int*':'integer', 'const integer*':'integer', - 'const double*':'double precision', 'const char*':'character*(*)'} + 'const double*':'double precision', + 'const doublereal*':'double precision', + 'const char*':'character*(*)'} -_c2fret = {'int':'integer', 'integer':'integer', 'double':'double precision'} +_c2fret = {'int':'integer', 'integer':'integer', + 'double':'double precision', + 'status_t':'integer', + 'doublereal':'double precision'} def writeinterface(fint, rtype, name, args): @@ -54,15 +60,25 @@ def writeinterface(fint, rtype, name, args): s += argstr+')\n' fint.write(s) for a in args: + if a[0][0] == 'd': + arr = '(*)' + else: + arr = '' if a[0] in _c2fin: - fint.write(' '+_c2fin[a[0]]+', intent(in) :: '+a[1]+'\n') + fint.write(' '+_c2fin[a[0]]+', intent(in) :: '+a[1]+arr+'\n') elif a[0] in _c2fout: - fint.write(' '+_c2fout[a[0]]+', intent(out) :: '+a[1]+'\n') + fint.write(' '+_c2fout[a[0]]+', intent(out) :: '+a[1]+arr+'\n') fint.write(' end function '+name+'\n\n') def writef90(fmod, rtype, otype, hndl, name, args): - s = ' '+_c2fret[rtype] + ' function ' + subroutine = 0 + if rtype == 'status_t': + subroutine = 1 + if subroutine: + s = ' subroutine ' + else: + s = ' '+_c2fret[rtype] + ' function ' if name[-1] == '_': name = name[:-1] wname = 'ct'+name[1:] @@ -77,40 +93,49 @@ def writef90(fmod, rtype, otype, hndl, name, args): s += argstr+')\n' fmod.write(s) fmod.write(""" implicit none - type("""+otype+'), intent(in) :: self\n') + type("""+otype+'), intent(inout) :: self\n') for a in args[1:]: + if a[0][0] == 'd': + arr = '(*)' + else: + arr = '' if a[0] in _c2fin: - fmod.write(' '+_c2fin[a[0]]+', intent(in) :: '+a[1]+'\n') + fmod.write(' '+_c2fin[a[0]]+', intent(in) :: '+a[1]+arr+'\n') elif a[0] in _c2fout: - fmod.write(' '+_c2fout[a[0]]+', intent(out) :: '+a[1]+'\n') - s = ' '+wname+' = '+name+'(self%'+hndl+', ' + fmod.write(' '+_c2fout[a[0]]+', intent(out) :: '+a[1]+arr+'\n') + if subroutine: + s = ' self%err = '+name+'(self%'+hndl+', ' + else: + s = ' '+wname+' = '+name+'(self%'+hndl+', ' argstr = '' for a in args[1:]: if a[0] <> 'ftnlen': argstr += a[1] + ', ' argstr = argstr[:-2] s += argstr+')' - fmod.write(s+""" - end function """+wname+'\n\n') + if subroutine: + fmod.write(s+'\n end subroutine '+wname+'\n\n') + else: + fmod.write(s+'\n end function '+wname+'\n\n') -fname = sys.argv[1] -otype = sys.argv[2] -hndl = sys.argv[3] -modname = sys.argv[4] +fname = sys.argv[1] # fctxml +otype = sys.argv[2] # XML_Node +hndl = sys.argv[3] # xml_id base, ext = fname.split('.') +modname = base f = open(fname,'r') -fint = open(base+'.f90','w') -fmod = open(modname+'.f90','w') -fgen = open('cantera_'+modname+'.f90','w') +fint = open(base+'_interface.f90','w') +#fmod = open(modname+'.f90','w') +fmod = open('cantera_'+modname+'.f90','w') lines = f.readlines() f.close() -_rtypes = ['int', 'double', 'integer'] +#_rtypes = ['int', 'double', 'integer'] infunc = 0 funcline = '' @@ -121,7 +146,7 @@ fint.write('module '+base+'\n') fint.write('interface\n') for line in lines: toks = line.split() - if len(toks) > 0: + if len(toks) > 0 and toks[0][:2] <> '//': if toks[0] == 'extern': extern = 1 if extern: @@ -155,7 +180,7 @@ contains for line in lines: toks = line.split() - if len(toks) > 0: + if len(toks) > 0 and toks[0][:2] <> '//': if toks[0] == 'extern': extern = 1 if extern: diff --git a/Cantera/fortran/src/makect.py b/Cantera/fortran/src/makect.py new file mode 100644 index 000000000..7c93f393f --- /dev/null +++ b/Cantera/fortran/src/makect.py @@ -0,0 +1,45 @@ +f = open('modules','r') +lines = f.readlines() +gen = {} +mods = [] +for m in lines: + file, prefix = m.split() + fm = open(file,'r') + mlines = fm.readlines() + for line in mlines: + toks = line.split() + if len(toks) == 2: + if toks[0] == 'module': + mods.append(toks[1]) + + le = line.find('end') + lf = line.find('function') + ls = line.find('subroutine') + loc = line.find(prefix+'_') + if le < 0 and (lf > 0 or ls > 0): + if loc > 0: + sline = line[loc:] + n = len(prefix) + p = sline.find('(') + nm = sline[n+1:p] + if nm <> '': + if gen.has_key(nm): + gen[nm].append(prefix+'_'+nm) + else: + gen[nm] = [prefix+'_'+nm] + +fout = open('canteramod.f90','w') +fout.write('MODULE CANTERA\n\n') +for m in mods: + fout.write(' USE '+m+'\n') + +funcs = gen.keys() +funcs.sort() +for fn in funcs: + fout.write('\n INTERFACE '+fn+'\n') + for cf in gen[fn]: + fout.write(' MODULE PROCEDURE '+cf+'\n') + fout.write(' END INTERFACE '+fn+'\n') + +fout.write('\nEND MODULE CANTERA\n\n') +