Fetching contributors…
Cannot retrieve contributors at this time
789 lines (641 sloc) 26.9 KB
dnl
include(`foreach.m4')`'dnl
dnl
include(`common.m4')`'dnl
dnl
dnl Below we only use arguments with a type of xsd:string
define(`TOHWM4_moleculeargs', `(dictRef,convention,title,id,ref,formula,chirality,role)')dnl
dnl
define(`TOHWM4_moleculeargslist', `dnl
m4_foreach(`x', TOHWM4_moleculeargs, `,x')dnl
')dnl
dnl
define(`TOHWM4_moleculeargsdecl',`dnl
m4_foreach(`x',TOHWM4_moleculeargs,`TOHWM4_dummyargdecl(x)')
')dnl
define(`TOHWM4_moleculeargsuse',`dnl
m4_foreach(`x',TOHWM4_moleculeargs,`TOHWM4_dummyarguse(x)')
')dnl
define(`TOHWM4_dlpolymoleculecheck',`dnl
if (present(style)) then
if (style=="DL_POLY") then
if (present(atomRefs).or.present(occupancies).or.present(atomIds).or.present(fmt)) &
call FoX_error("With DL_POLY style, no optional arguments permitted.")
call addDlpolyMatrix(xf, $1, elements)
return
endif
endif
')dnl
dnl
define(`TOHWM4_writeatom', `
do i = 1, natoms
call xml_NewElement(xf, "atom")
call xml_AddAttribute(xf, "elementType", trim(elements(i)))
call cmlAddCoords(xf, coords=$1, style=style, fmt=fmt)
if (present(occupancies)) call xml_AddAttribute(xf, "occupancy", occupancies(i))
if (present(atomRefs)) call xml_AddAttribute(xf, "ref", trim(atomRefs(i)))
if (present(atomIds)) call xml_AddAttribute(xf, "id", trim(atomIds(i)))
call xml_EndElement(xf, "atom")
enddo
')dnl
dnl
define(`TOHWM4_writeparticle', `
do i = 1, natoms
call xml_NewElement(xf, "particle")
if (present(elements)) call xml_AddAttribute(xf, "elementType", trim(elements(i)))
call cmlAddCoords(xf, coords=$1, style=style, fmt=fmt)
if (present(occupancies)) call xml_AddAttribute(xf, "occupancy", occupancies(i))
if (present(atomRefs)) call xml_AddAttribute(xf, "ref", trim(atomRefs(i)))
if (present(atomIds)) call xml_AddAttribute(xf, "id", trim(atomIds(i)))
call xml_EndElement(xf, "particle")
enddo
')dnl
define(`TOHWM4_molecule_subs', ``'dnl
subroutine cmlAddMolecule$1(xf, elements, atomRefs, coords, occupancies, atomIds, style, fmt &
TOHWM4_moleculeargslist , &
bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds, nobondcheck)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: coords(:, :)
character(len=*), intent(in) :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: atomIds(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
TOHWM4_moleculeargsdecl
character(len=*), intent(in), optional :: bondAtom1Refs(:)
character(len=*), intent(in), optional :: bondAtom2Refs(:)
character(len=*), intent(in), optional :: bondOrders(:)
character(len=*), intent(in), optional :: bondIds(:)
logical, intent(in), optional :: nobondcheck
#ifndef DUMMYLIB
call cmlStartMolecule(xf &
TOHWM4_moleculeargslist)
call cmlAddAtoms(xf, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
if (present(bondAtom1Refs)) then
if (present(bondAtom2Refs).and.present(bondOrders)) then
if (present(atomIds)) then
call checkBondIdRefs(atomIds, bondAtom1Refs, bondAtom2Refs, nobondcheck)
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("AtomIds must be provided to add bonds")
endif
else
call FoX_error("Two AtomRefs arrays and a bondOrder array must be provided to add bonds")
endif
endif
call cmlEndMolecule(xf)
#endif
end subroutine cmlAddMolecule$1
subroutine cmlAddMolecule$1_sh(xf, natoms, elements, atomRefs, coords, occupancies, atomIds, style, fmt &
TOHWM4_moleculeargslist , &
bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds, nobondcheck)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: coords(3, natoms)
character(len=*), intent(in) :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
TOHWM4_moleculeargsdecl
character(len=*), intent(in), optional :: bondAtom1Refs(:)
character(len=*), intent(in), optional :: bondAtom2Refs(:)
character(len=*), intent(in), optional :: bondOrders(:)
character(len=*), intent(in), optional :: bondIds(:)
logical, intent(in), optional :: nobondcheck
#ifndef DUMMYLIB
call cmlStartMolecule(xf &
TOHWM4_moleculeargslist)
call cmlAddAtoms(xf, natoms, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
if (present(bondAtom1Refs)) then
if (present(bondAtom2Refs).and.present(bondOrders)) then
if (present(atomIds)) then
call checkBondIdRefs(atomIds, bondAtom1Refs, bondAtom2Refs, nobondcheck)
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("AtomIds must be provided to add bonds")
endif
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("Two AtomRefs arrays and a bondOrder array must be provided to add bonds")
endif
endif
call cmlEndMolecule(xf)
#endif
end subroutine cmlAddMolecule$1_sh
subroutine cmlAddMolecule_3_$1(xf, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt &
TOHWM4_moleculeargslist , &
bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds, nobondcheck)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: x(:)
real(kind=$1), intent(in) :: y(:)
real(kind=$1), intent(in) :: z(:)
character(len=*), intent(in) :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
character(len=*), intent(in), optional :: atomIds(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
TOHWM4_moleculeargsdecl
character(len=*), intent(in), optional :: bondAtom1Refs(:)
character(len=*), intent(in), optional :: bondAtom2Refs(:)
character(len=*), intent(in), optional :: bondOrders(:)
character(len=*), intent(in), optional :: bondIds(:)
logical, intent(in), optional :: nobondcheck
#ifndef DUMMYLIB
call cmlStartMolecule(xf &
TOHWM4_moleculeargslist)
call cmlAddAtoms(xf, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
if (present(bondAtom1Refs)) then
if (present(bondAtom2Refs).and.present(bondOrders)) then
if (present(atomIds)) then
call checkBondIdRefs(atomIds, bondAtom1Refs, bondAtom2Refs, nobondcheck)
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("AtomIds must be provided to add bonds")
endif
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("Two AtomRefs arrays and a bondOrder array must be provided to add bonds")
endif
endif
call cmlEndMolecule(xf)
#endif
end subroutine cmlAddMolecule_3_$1
subroutine cmlAddMolecule_3_$1_sh(xf, natoms, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt &
TOHWM4_moleculeargslist , &
bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds, nobondcheck)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: x(natoms)
real(kind=$1), intent(in) :: y(natoms)
real(kind=$1), intent(in) :: z(natoms)
character(len=*), intent(in) :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
TOHWM4_moleculeargsdecl
character(len=*), intent(in), optional :: bondAtom1Refs(:)
character(len=*), intent(in), optional :: bondAtom2Refs(:)
character(len=*), intent(in), optional :: bondOrders(:)
character(len=*), intent(in), optional :: bondIds(:)
logical, intent(in), optional :: nobondcheck
#ifndef DUMMYLIB
call cmlStartMolecule(xf &
TOHWM4_moleculeargslist)
call cmlAddAtoms(xf, natoms, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
if (present(bondAtom1Refs)) then
if (present(bondAtom2Refs).and.present(bondOrders)) then
if (present(atomIds)) then
call checkBondIdRefs(atomIds, bondAtom1Refs, bondAtom2Refs, nobondcheck)
call addBondArray(xf, bondAtom1Refs, bondAtom2Refs, bondOrders, bondIds)
else
call FoX_error("AtomIds must be provided to add bonds")
endif
else
call FoX_error("Two AtomRefs arrays and a bondOrder array must be provided to add bonds")
endif
endif
call cmlEndMolecule(xf)
#endif
end subroutine cmlAddMolecule_3_$1_sh
subroutine cmlAddAtoms$1(xf, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: coords(:, :)
character(len=*), intent(in) :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: atomIds(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i, natoms
TOHWM4_dlpolymoleculecheck(`coords')`'
call xml_NewElement(xf, "atomArray")
natoms = size(coords,2)
TOHWM4_writeatom(`coords(:,i)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddAtoms$1
subroutine cmlAddAtoms$1_sh(xf, natoms, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: coords(3, natoms)
character(len=*), intent(in) :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i
TOHWM4_dlpolymoleculecheck(`coords(:,:natoms)')`'
call xml_NewElement(xf, "atomArray")
TOHWM4_writeatom(`coords(:,i)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddAtoms$1_sh
subroutine cmlAddAtoms_3_$1(xf, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: x(:)
real(kind=$1), intent(in) :: y(:)
real(kind=$1), intent(in) :: z(:)
character(len=*), intent(in) :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
character(len=*), intent(in), optional :: atomIds(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i, natoms
TOHWM4_dlpolymoleculecheck(`x, y, z')`'
call xml_NewElement(xf, "atomArray")
natoms = size(x)
TOHWM4_writeatom(`(/x(i),y(i),z(i)/)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddAtoms_3_$1
subroutine cmlAddAtoms_3_$1_sh(xf, natoms, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: x(natoms)
real(kind=$1), intent(in) :: y(natoms)
real(kind=$1), intent(in) :: z(natoms)
character(len=*), intent(in) :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i
TOHWM4_dlpolymoleculecheck(`x(:natoms), y(:natoms), z(:natoms)')`'
call xml_NewElement(xf, "atomArray")
TOHWM4_writeatom(`(/x(i),y(i),z(i)/)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddAtoms_3_$1_sh
subroutine cmlAddParticles$1(xf, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: coords(:, :)
character(len=*), intent(in), optional :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: atomIds(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i, natoms
TOHWM4_dlpolymoleculecheck(`coords')`'
call xml_NewElement(xf, "atomArray")
natoms = size(coords,2)
TOHWM4_writeparticle(`coords(:,i)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddParticles$1
subroutine cmlAddParticles$1_sh(xf, natoms, elements, atomRefs, coords, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: coords(3, natoms)
character(len=*), intent(in), optional :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i
TOHWM4_dlpolymoleculecheck(`coords(:,:natoms)')`'
call xml_NewElement(xf, "atomArray")
TOHWM4_writeparticle(`coords(:,i)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddParticles$1_sh
subroutine cmlAddParticles_3_$1(xf, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in) :: x(:)
real(kind=$1), intent(in) :: y(:)
real(kind=$1), intent(in) :: z(:)
character(len=*), intent(in), optional :: elements(:)
character(len=*), intent(in), optional :: atomRefs(:)
character(len=*), intent(in), optional :: atomIds(:)
real(kind=$1), intent(in), optional :: occupancies(:)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i, natoms
TOHWM4_dlpolymoleculecheck(`x, y, z')`'
call xml_NewElement(xf, "atomArray")
natoms = size(x)
TOHWM4_writeparticle(`(/x(i),y(i),z(i)/)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddParticles_3_$1
subroutine cmlAddParticles_3_$1_sh(xf, natoms, elements, x, y, z, atomRefs, occupancies, atomIds, style, fmt)
type(xmlf_t), intent(inout) :: xf
integer, intent(in) :: natoms
real(kind=$1), intent(in) :: x(natoms)
real(kind=$1), intent(in) :: y(natoms)
real(kind=$1), intent(in) :: z(natoms)
character(len=*), intent(in), optional :: elements(natoms)
character(len=*), intent(in), optional :: atomRefs(natoms)
character(len=*), intent(in), optional :: atomIds(natoms)
real(kind=$1), intent(in), optional :: occupancies(natoms)
character(len=*), intent(in), optional :: fmt
character(len=*), intent(in), optional :: style
#ifndef DUMMYLIB
integer :: i
TOHWM4_dlpolymoleculecheck(`x(:natoms), y(:natoms), z(:natoms)')`'
call xml_NewElement(xf, "atomArray")
TOHWM4_writeparticle(`(/x(i),y(i),z(i)/)')`'
call xml_EndElement(xf, "atomArray")
#endif
end subroutine cmlAddParticles_3_$1_sh
#ifndef DUMMYLIB
subroutine cmlAddCoords_$1(xf, coords, style, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:) :: coords
character(len=*), intent(in), optional :: style
character(len=*), intent(in), optional :: fmt
if (present(style)) then
select case(style)
case ("x3")
call addcoords_x3_$1(xf, coords, fmt)
case ("cartesian")
call addcoords_x3_$1(xf, coords, fmt)
case ("xFrac")
call addcoords_xfrac_$1(xf, coords, fmt)
case ("fractional")
call addcoords_xfrac_$1(xf, coords, fmt)
case ("xyz3")
call addcoords_xyz3_$1(xf, coords, fmt)
case ("xyzFrac")
call addcoords_xyzfrac_$1(xf, coords, fmt)
case default
call FoX_error("Invalid style specification for atomic coordinates")
end select
else
call addcoords_x3_$1(xf, coords, fmt)
endif
end subroutine cmlAddCoords_$1
subroutine addcoords_xyz3_$1(xf, coords, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:) :: coords
character(len=*), intent(in), optional :: fmt
select case (size(coords))
case (2)
call xml_AddAttribute(xf, "xy2", coords,fmt)
case(3)
call xml_AddAttribute(xf, "xyz3", coords,fmt)
end select
end subroutine addcoords_xyz3_$1
subroutine addcoords_xyzfrac_$1(xf, coords, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:) :: coords
character(len=*), intent(in), optional :: fmt
select case (size(coords))
case (2)
call xml_AddAttribute(xf, "xyFract", coords, fmt)
case(3)
call xml_AddAttribute(xf, "xyzFract", coords, fmt)
end select
end subroutine addcoords_xyzfrac_$1
subroutine addcoords_x3_$1(xf, coords, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:):: coords
character(len=*), intent(in), optional :: fmt
select case(size(coords))
case(2)
call xml_AddAttribute(xf, "x2", coords(1), fmt)
call xml_AddAttribute(xf, "y2", coords(2), fmt)
case(3)
call xml_AddAttribute(xf, "x3", coords(1), fmt)
call xml_AddAttribute(xf, "y3", coords(2), fmt)
call xml_AddAttribute(xf, "z3", coords(3), fmt)
end select
end subroutine addcoords_x3_$1
subroutine addcoords_xfrac_$1(xf, coords, fmt)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:) :: coords
character(len=*), intent(in), optional :: fmt
call xml_AddAttribute(xf, "xFract", coords(1), fmt)
call xml_AddAttribute(xf, "yFract", coords(2), fmt)
call xml_AddAttribute(xf, "zFract", coords(3), fmt)
end subroutine addcoords_xfrac_$1
subroutine addDlpolyMatrix_$1(xf, coords, elems)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:, :) :: coords
character(len=2), intent(in), dimension(:) :: elems
integer :: natoms, i
natoms = size(elems)
call xml_NewElement(xf, "matrix")
call xml_AddAttribute(xf, "nrows", size(elems))
call xml_AddAttribute(xf, "ncols", 11)
call xml_AddAttribute(xf, "dataType", "xsd:string")
call xml_AddNewline(xf)
do i = 1, natoms
call xml_AddCharacters(xf, elems(i)//" "//str(i))
call xml_AddNewline(xf)
call xml_AddCharacters(xf, str(coords(1,i))//" "//str(coords(2,i))//" "//str(coords(3,i)))
call xml_AddNewline(xf)
call xml_AddCharacters(xf, "0 0 0")
call xml_AddNewline(xf)
call xml_AddCharacters(xf, "0 0 0")
call xml_AddNewline(xf)
enddo
call xml_EndElement(xf, "matrix")
end subroutine addDlpolyMatrix_$1
subroutine addDlpolyMatrix_3_$1(xf, x, y, z, elems)
type(xmlf_t), intent(inout) :: xf
real(kind=$1), intent(in), dimension(:) :: x, y, z
character(len=2), intent(in), dimension(:) :: elems
integer :: natoms, i
natoms = size(elems)
call xml_NewElement(xf, "matrix")
call xml_AddAttribute(xf, "nrows", size(elems))
call xml_AddAttribute(xf, "ncols", 11)
call xml_AddAttribute(xf, "dataType", "xsd:string")
call xml_AddNewline(xf)
do i = 1, natoms
call xml_AddCharacters(xf, elems(i)//" "//str(i))
call xml_AddNewline(xf)
call xml_AddCharacters(xf, str(x(i))//" "//str(y(i))//" "//str(z(i)))
call xml_AddNewline(xf)
call xml_AddCharacters(xf, "0 0 0")
call xml_AddNewline(xf)
call xml_AddCharacters(xf, "0 0 0")
call xml_AddNewline(xf)
enddo
call xml_EndElement(xf, "matrix")
end subroutine addDlpolyMatrix_3_$1
#endif
')dnl
dnl
! This file is AUTOGENERATED
! To change, edit m_wcml_molecule.m4 and regenerate
module m_wcml_molecule
use fox_m_fsys_realtypes, only: sp, dp
use FoX_wxml, only: xmlf_t
#ifndef DUMMYLIB
use fox_m_fsys_format, only: str
use m_common_error, only: FoX_error
use FoX_wxml, only: xml_NewElement, xml_EndElement
use FoX_wxml, only: xml_AddAttribute, xml_AddCharacters, xml_AddNewline
! Fix for pgi, requires this explicitly:
use m_wxml_overloads
#endif
implicit none
private
interface cmlAddMolecule
module procedure cmlAddMoleculeSP
module procedure cmlAddMoleculeSP_sh
module procedure cmlAddMolecule_3_SP
module procedure cmlAddMolecule_3_SP_sh
module procedure cmlAddMoleculeDP
module procedure cmlAddMoleculeDP_sh
module procedure cmlAddMolecule_3_DP
module procedure cmlAddMolecule_3_DP_sh
end interface
interface cmlAddAtoms
module procedure cmlAddAtomsSP
module procedure cmlAddAtomsSP_sh
module procedure cmlAddAtoms_3_SP
module procedure cmlAddAtoms_3_SP_sh
module procedure cmlAddAtomsDP
module procedure cmlAddAtomsDP_sh
module procedure cmlAddAtoms_3_DP
module procedure cmlAddAtoms_3_DP_sh
end interface
interface cmlAddParticles
module procedure cmlAddParticlesSP
module procedure cmlAddParticlesSP_sh
module procedure cmlAddParticles_3_SP
module procedure cmlAddParticles_3_SP_sh
module procedure cmlAddParticlesDP
module procedure cmlAddParticlesDP_sh
module procedure cmlAddParticles_3_DP
module procedure cmlAddParticles_3_DP_sh
end interface
#ifndef DUMMYLIB
interface cmlAddCoords
module procedure cmlAddCoords_sp
module procedure cmlAddCoords_dp
end interface
interface addDlpolyMatrix
module procedure addDlpolyMatrix_sp
module procedure addDlpolyMatrix_3_sp
module procedure addDlpolyMatrix_dp
module procedure addDlpolyMatrix_3_dp
end interface
#endif
public :: cmlStartMolecule
public :: cmlEndMolecule
public :: cmlAddAtoms
public :: cmlAddParticles
public :: cmlAddMolecule
contains
subroutine cmlStartMolecule(xf &
TOHWM4_moleculeargslist)
type(xmlf_t), intent(inout) :: xf
TOHWM4_moleculeargsdecl
#ifndef DUMMYLIB
call xml_NewElement(xf, "molecule")
TOHWM4_moleculeargsuse
#endif
end subroutine cmlStartMolecule
subroutine cmlEndMolecule(xf)
type(xmlf_t), intent(inout) :: xf
#ifndef DUMMYLIB
call xml_EndElement(xf, "molecule")
#endif
end subroutine cmlEndMolecule
TOHWM4_molecule_subs(`sp')
TOHWM4_molecule_subs(`dp')
#ifndef DUMMYLIB
subroutine addBondArray(xf, atom1Refs, atom2Refs, orders, bondIds)
type(xmlf_t), intent(inout) :: xf
character(len=*), intent(in) :: atom1Refs(:)
character(len=*), intent(in) :: atom2Refs(:)
character(len=*), intent(in) :: orders(:)
character(len=*), intent(in), optional :: bondIds(:)
integer :: nbonds
integer :: i
nbonds = size(atom1Refs)
! Basic argument verification
if (size(atom2Refs).ne.nbonds) &
call FoX_error("Length of atomRef arrays must match in WCML addBondArray")
if (size(orders).ne.nbonds) &
call FoX_error("Length of atomRef and order arrays must match in WCML addBondArray")
if (present(bondIds)) then
if (size(bondIds).ne.nbonds) &
call FoX_error("Length of atomRef and bondId arrays must match in WCML addBondArray")
endif
! Add the bond array
call xml_NewElement(xf, "bondArray")
do i = 1, nbonds
call xml_NewElement(xf, "bond")
call xml_AddAttribute(xf, "atomRefs2", trim(atom1Refs(i))//" "//trim(atom2Refs(i)))
call xml_AddAttribute(xf, "order", orders(i))
if (present(bondIds)) &
call xml_AddAttribute(xf, "id", trim(bondIds(i)))
call xml_EndElement(xf, "bond")
enddo
call xml_EndElement(xf, "bondArray")
end subroutine addBondArray
subroutine checkBondIdRefs(atomArrayIds, bondAtom1Refs, bondAtom2Refs, nobondcheck)
character(len=*), intent(in) :: atomArrayIds(:)
character(len=*), intent(in) :: bondAtom1Refs(:)
character(len=*), intent(in) :: bondAtom2Refs(:)
logical, intent(in), optional :: nobondcheck
logical :: bondmatrix(size(atomArrayIds),size(atomArrayIds))
integer :: nbonds
integer :: natoms
integer :: i
integer :: j
logical :: bond1OK
logical :: bond2OK
integer :: atom1num
integer :: atom2num
if (present(nobondcheck)) then
if (nobondcheck) return ! skip all checks
endif
atom1num = -1 ! Supress bogus gfortran warning
atom2num = -1
bondmatrix = .false.
natoms = size(atomArrayIds)
nbonds = size(bondAtom1Refs)
if (size(bondAtom2Refs).ne.nbonds) &
call FoX_error("Length of atomRef arrays must match in WCML checkBondIdRefs")
do i = 1, nbonds
if (trim(bondAtom1Refs(i)).eq.trim(bondAtom2Refs(i))) &
call FoX_error("The two atomRefs in a bond must be different")
bond1OK = .false.
bond2OK = .false.
do j = 1, natoms
if (trim(bondAtom1Refs(i)).eq.trim(atomArrayIds(j))) &
bond1OK = .true.
atom1num = j
if (trim(bondAtom2Refs(i)).eq.trim(atomArrayIds(j))) &
bond2OK = .true.
atom2num = j
if (bond1OK.and.bond2OK) exit
enddo
if (.not.bond1OK) call FoX_error(bondAtom1Refs(i) // " not found in checkBondIdRefs")
if (.not.bond2OK) call FoX_error(bondAtom2Refs(i) // " not found in checkBondIdRefs")
! Both atoms bust have been found to get here...
if (bondmatrix(atom1num,atom2num)) then
! Seen this bond before
call FoX_error("A bond cannot be added twice.")
else
! We've seen this bond (both ways) - so don't forget
bondmatrix(atom1num,atom2num) = .true.
bondmatrix(atom2num,atom1num) = .true.
endif
enddo
end subroutine checkBondIdRefs
#endif
end module m_wcml_molecule