XML module

Cantera/fortran/src/cantera_xml.f90

@@ -0,0 +1,124 @@
+module cantera_xml
+
+  use fctxml  ! interface for C functions
+
+  type XML_Node
+    integer :: xml_id
+    integer :: wrapper
+    integer :: err
+  end type XML_Node
+
+contains
+
+    type(XML_Node) function new_XML_Node(src, name, wrap)
+      implicit none
+      character*(*), optional, intent(in) :: name
+      character*(*), optional, intent(in) :: src
+      integer, optional, intent(in) :: wrap
+      type(XML_Node) self
+      self%err = 0
+
+      if (present(wrap)) then
+         ! create a wrapper around an existing XML_Node
+         self%xml_id = wrap
+         self%wrapper = 1
+
+      else if (present(src)) then
+         !  read in an XML tree
+         self%xml_id = fxml_get_xml_file(src)
+         self%wrapper = 0
+
+      else
+         ! create an empty node
+         self%xml_id = fxml_new(name)
+         self%wrapper = 0
+      end if
+      new_XML_Node = self
+      return
+    end function new_XML_Node
+
+
+    subroutine ctxml_clear()
+      implicit none
+      integer i
+      i = fxml_clear()
+    end subroutine ctxml_clear
+
+    subroutine ctxml_getAttrib(self, key, value)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(in) :: key
+      character*(*), intent(out) :: value
+      self%err = fxml_attrib(self%xml_id, key, value)
+    end subroutine ctxml_getAttrib
+
+    subroutine ctxml_addAttrib(self, key, value)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(in) :: key
+      character*(*), intent(in) :: value
+      self%err = fxml_addattrib(self%xml_id, key, value)
+    end subroutine ctxml_addAttrib
+
+    subroutine ctxml_addComment(self, comment)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(in) :: comment
+      self%err = fxml_addcomment(self%xml_id, comment)
+    end subroutine ctxml_addComment
+
+    subroutine ctxml_getTag(self, tag)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(out) :: tag
+      self%err = fxml_tag(self%xml_id, tag)
+    end subroutine ctxml_getTag
+
+    subroutine ctxml_getValue(self, value)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(out) :: value
+      self%err = fxml_value(self%xml_id, value)
+    end subroutine ctxml_getValue
+
+    type(XML_Node) function ctxml_child(self, loc, id, name)
+      implicit none
+      type(XML_Node), intent(in) :: self
+      character*(*), optional, intent(in) :: loc
+      character*(*), optional, intent(in) :: id
+      character*(*), optional, intent(in) :: name
+      integer ichild
+
+      if (present(loc)) then
+         ichild = fxml_child(self%xml_id, loc)
+      else if (present(id)) then
+         ichild = fxml_findid(self%xml_id, id)
+      else if (present(name)) then
+         ichild = fxml_findbyname(self%xml_id, name)
+      end if
+      ctxml_child = new_XML_Node(wrap = ichild)
+    end function ctxml_child
+
+    integer function ctxml_nChildren(self)
+      implicit none
+      type(XML_Node), intent(in) :: self
+      ctxml_nChildren = fxml_nchildren(self%xml_id)
+    end function ctxml_nChildren
+
+    subroutine ctxml_addChild(self, name, value)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(in) :: name
+      character*(*), intent(in) :: value
+      integer ichild
+      ichild = fxml_addchild(self%xml_id, name, value)
+    end subroutine ctxml_addChild
+
+    subroutine ctxml_write(self, file)
+      implicit none
+      type(XML_Node), intent(inout) :: self
+      character*(*), intent(in) :: file
+      self%err = fxml_write(self%xml_id, file)
+    end subroutine ctxml_write
+
+end module cantera_xml

Cantera/fortran/src/fctxml_interface.f90

@@ -0,0 +1,111 @@
+module fctxml
+interface
+    integer function fxml_new(name)
+        character*(*), intent(in) :: name
+    end function fxml_new
+
+    integer function fxml_get_xml_file(file)
+        character*(*), intent(in) :: file
+    end function fxml_get_xml_file
+
+    integer function fxml_clear()
+    end function fxml_clear
+
+    integer function fxml_del(i)
+        integer, intent(in) :: i
+    end function fxml_del
+
+    integer function fxml_removechild(i, j)
+        integer, intent(in) :: i
+        integer, intent(in) :: j
+    end function fxml_removechild
+
+    integer function fxml_copy(i)
+        integer, intent(in) :: i
+    end function fxml_copy
+
+    integer function fxml_assign(i, j)
+        integer, intent(in) :: i
+        integer, intent(in) :: j
+    end function fxml_assign
+
+    integer function fxml_preprocess_and_build(i, file)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: file
+    end function fxml_preprocess_and_build
+
+    integer function fxml_attrib(i, key, value)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: key
+        character*(*), intent(out) :: value
+    end function fxml_attrib
+
+    integer function fxml_addattrib(i, key, value)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: key
+        character*(*), intent(in) :: value
+    end function fxml_addattrib
+
+    integer function fxml_addcomment(i, comment)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: comment
+    end function fxml_addcomment
+
+    integer function fxml_tag(i, tag)
+        integer, intent(in) :: i
+        character*(*), intent(out) :: tag
+    end function fxml_tag
+
+    integer function fxml_value(i, value)
+        integer, intent(in) :: i
+        character*(*), intent(out) :: value
+    end function fxml_value
+
+    integer function fxml_child(i, loc)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: loc
+    end function fxml_child
+
+    integer function fxml_child_bynumber(i, m)
+        integer, intent(in) :: i
+        integer, intent(in) :: m
+    end function fxml_child_bynumber
+
+    integer function fxml_findid(i, id)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: id
+    end function fxml_findid
+
+    integer function fxml_findbyname(i, nm)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: nm
+    end function fxml_findbyname
+
+    integer function fxml_nchildren(i)
+        integer, intent(in) :: i
+    end function fxml_nchildren
+
+    integer function fxml_addchild(i, name, value)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: name
+        character*(*), intent(in) :: value
+    end function fxml_addchild
+
+    integer function fxml_addchildnode(i, j)
+        integer, intent(in) :: i
+        integer, intent(in) :: j
+    end function fxml_addchildnode
+
+    integer function fxml_write(i, file)
+        integer, intent(in) :: i
+        character*(*), intent(in) :: file
+    end function fxml_write
+
+    integer function ctml_getfloatarray(i, n, data, iconvert)
+        integer, intent(in) :: i
+        integer, intent(in) :: n
+        integer, intent(in) :: iconvert
+    end function ctml_getfloatarray
+
+end interface
+end module fctxml

Cantera/fortran/src/genf.py

@@ -0,0 +1,180 @@
+""" Python script to generate a Python extension module from a clib
+header file.  """
+
+import sys
+
+_class = ''
+_newclass = 1
+
+def getargs(line):
+    """Get the function name and arguments."""
+    i1 = line.find('(')
+    i2 = line.find(')')
+    if (i1 < 0 or i2 < 0):
+        raise 'syntax error: missing open or close quote'
+    nm = line[:i1].split()
+    nm = nm[-1]
+    argline = line[i1+1:i2]
+    args = argline.split(',')
+    for n in range(len(args)): args[n] = args[n].split()
+    v = []
+    for a in args:
+        if len(a) <= 1:
+            pass
+        elif len(a) == 2:
+            v.append(a)
+        elif len(a) == 3 and a[0] == 'const':
+            v.append([a[0]+' '+a[1],a[2]])
+        else:
+            print 'a = ',a, args
+            print 'line = ',line
+            raise 'malformed argument: '
+    return nm, v
+
+_c2fout = {'int*':'integer', 'integer*':'integer', 'double*':'double precision',
+           'char*':'character*(*)'}
+
+_c2fin  = {'const int*':'integer', 'const integer*':'integer',
+           'const double*':'double precision', 'const char*':'character*(*)'}
+
+_c2fret = {'int':'integer', 'integer':'integer', 'double':'double precision'}
+
+
+def writeinterface(fint, rtype, name, args):
+    s = '    '+_c2fret[rtype] + ' function '
+    if name[-1] == '_':
+        name = name[:-1]
+    s += name + '('
+    argstr=''
+    for a in args:
+        if a[0] <> 'ftnlen':
+            argstr += a[1] + ', '
+    if len(argstr) > 0:
+        argstr = argstr[:-2]
+    s += argstr+')\n'
+    fint.write(s)
+    for a in args:
+        if a[0] in _c2fin:
+            fint.write('        '+_c2fin[a[0]]+', intent(in) :: '+a[1]+'\n')
+        elif a[0] in _c2fout:
+            fint.write('        '+_c2fout[a[0]]+', intent(out) :: '+a[1]+'\n')
+    fint.write('    end function '+name+'\n\n')
+    
+
+def writef90(fmod, rtype, otype, hndl, name, args):
+    s = '    '+_c2fret[rtype] + ' function '
+    if name[-1] == '_':
+        name = name[:-1]
+    wname = 'ct'+name[1:]
+    
+    s += wname + '('
+    argstr='self, '
+    for a in args[1:]:
+        if a[0] <> 'ftnlen':
+            argstr += a[1] + ', '
+    if len(argstr) > 0:
+        argstr = argstr[:-2]
+    s += argstr+')\n'
+    fmod.write(s)
+    fmod.write("""      implicit none
+      type("""+otype+'), intent(in) :: self\n')
+    for a in args[1:]:
+        if a[0] in _c2fin:
+            fmod.write('      '+_c2fin[a[0]]+', intent(in) :: '+a[1]+'\n')
+        elif a[0] in _c2fout:
+            fmod.write('      '+_c2fout[a[0]]+', intent(out) :: '+a[1]+'\n')
+    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')
+    
+
+    
+fname = sys.argv[1]
+otype = sys.argv[2]
+hndl = sys.argv[3]
+modname = sys.argv[4]
+
+base, ext = fname.split('.')
+
+f = open(fname,'r')
+fint = open(base+'.f90','w')
+fmod = open(modname+'.f90','w')
+fgen = open('cantera_'+modname+'.f90','w')
+
+lines = f.readlines()
+f.close()
+
+_rtypes = ['int', 'double', 'integer']
+
+infunc = 0
+funcline = ''
+extern = 0
+
+fint.write('module '+base+'\n')
+
+fint.write('interface\n')
+for line in lines:
+    toks = line.split()
+    if len(toks) > 0:
+        if toks[0] == 'extern':
+            extern = 1
+        if extern:
+            if not infunc:
+                if line.find('DLL_EXPORT') > 0:
+                    infunc = 1
+                    funcline = line
+            elif infunc:
+                funcline += line
+            last = toks[-1]
+            if infunc and last[-1] == '{':
+                infunc = 0
+                name, args = getargs(funcline)
+                toks = funcline.split()
+                a = writeinterface(fint, toks[0], name, args)
+                funcline = ''
+fint.write('end interface\n')
+fint.write('end module '+base+'\n')
+fint.close()
+
+fmod.write('module '+modname+'\n')
+fmod.write('  use '+base+"""
+
+  type """+otype+"""
+    integer :: """+hndl+"""
+  end type """+otype+"""
+
+contains
+
+""")
+
+for line in lines:
+    toks = line.split()
+    if len(toks) > 0:
+        if toks[0] == 'extern':
+            extern = 1
+        if extern:
+            if not infunc:
+                if line.find('DLL_EXPORT') > 0:
+                    infunc = 1
+                    funcline = line
+            elif infunc:
+                funcline += line
+            last = toks[-1]
+            if infunc and last[-1] == '{':
+                infunc = 0
+                name, args = getargs(funcline)
+                toks = funcline.split()
+                a = writef90(fmod, toks[0], otype, hndl, name, args)
+                funcline = ''
+
+fmod.write('end module '+base+'\n')
+fmod.close()
+
+
+