New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
m_cmlw.f90 in vendors/XMLF90/current/src/cml – NEMO

source: vendors/XMLF90/current/src/cml/m_cmlw.f90 @ 1967

Last change on this file since 1967 was 1967, checked in by flavoni, 14 years ago

importing XMLF90 vendor
File size: 66.8 KB
Line 
1module m_cmlw
2
3  use flib_wxml
4  use m_stmw
5
6  private
7
8  integer, private, parameter ::  sp = selected_real_kind(6,30)
9  integer, private, parameter ::  dp = selected_real_kind(14,100)
10
11
12! CMLUnits
13  character(len=40), parameter :: U_ANGSTR = 'units:angstrom'
14  character(len=40), parameter :: U_PMETER = 'units:pm'
15  character(len=40), parameter :: U_DEGREE = 'units:degree'
16  character(len=40), parameter :: U_RADIAN = 'units:radian'
17  character(len=40), parameter :: U_INVCM  = 'units:cm-1'
18  character(len=40), parameter :: U_KCALMO = 'units:kcal-mole'
19  character(len=40), parameter :: U_EVOLT  = 'units:ev'
20  character(len=40), parameter :: U_SECOND = 'units:second'
21  character(len=40), parameter :: U_VOLT   = 'units:volt'
22
23! CMLCore
24  PUBLIC :: cmlAddCoordinates
25  PUBLIC :: cmlAddCrystal
26  PUBLIC :: cmlAddAngle
27  PUBLIC :: cmlAddLength
28  PUBLIC :: cmlAddEigenvalue
29  PUBLIC :: cmlAddProperty
30  PUBLIC :: cmlAddPropertyList
31  PUBLIC :: cmlAddMolecule
32  PUBLIC :: cmlAddMetadata
33
34! CMLComp
35  PUBLIC :: cmlAddLattice
36  PUBLIC :: cmlAddLatticeVector
37  PUBLIC :: cmlAddParameter
38
39! CMLCore
40  INTERFACE cmlAddCoordinates
41     MODULE PROCEDURE cmlAddCoordinatesSP, cmlAddCoordinatesDP
42  END INTERFACE
43
44  INTERFACE cmlAddCrystal
45     MODULE PROCEDURE cmlAddCrystalSP, cmlAddCrystalDP
46  END INTERFACE
47
48  INTERFACE cmlAddAngle
49     MODULE PROCEDURE cmlAddAngleSP, cmlAddAngleDP
50  END INTERFACE
51
52  INTERFACE cmlAddLength
53     MODULE PROCEDURE cmlAddLengthSP, cmlAddLengthDP
54  END INTERFACE
55
56  INTERFACE cmlAddEigenvalue
57     MODULE PROCEDURE cmlAddEigenvalueSP, cmlAddEigenvalueDP
58  END INTERFACE
59
60  INTERFACE cmlAddMolecule
61     MODULE PROCEDURE cmlAddMoleculeSP, cmlAddMoleculeDP, cmlAddMolecule3SP, &
62                      cmlAddMolecule3DP
63  END INTERFACE
64
65! CMLComa
66  INTERFACE cmlAddLattice
67     MODULE PROCEDURE cmlAddLatticeSP, cmlAddLatticeDP
68  END INTERFACE
69
70  INTERFACE cmlAddLatticeVector
71     MODULE PROCEDURE cmlAddLatticeVectorSP, cmlAddLatticeVectorDP
72  END INTERFACE
73
74  INTERFACE cmlAddProperty
75     MODULE PROCEDURE &
76          cmlAddPropScalarDP, cmlAddPropScalarSP, cmlAddPropScalarI, & 
77          cmlAddPropMatrixDP, cmlAddPropMatrixSP, cmlAddPropMatrixI, &
78          cmlAddPropArrayDP,  cmlAddPropArraySP,  cmlAddPropArrayI
79  END INTERFACE
80
81  INTERFACE cmlAddParameter
82     MODULE PROCEDURE &
83        cmlAddParameterCH, cmlAddParameterI, &
84        cmlAddParameterSP, cmlAddParameterDP, &
85        cmlAddParameterLG
86  END INTERFACE
87
88
89CONTAINS
90
91  ! =================================================
92  ! convenience CML routines
93  ! =================================================
94 
95  ! -------------------------------------------------
96  ! writes a propertyList start Tag to xml channel
97  ! -------------------------------------------------
98 
99  SUBROUTINE cmlAddPropertyList(xf, id, title, conv, dictref, ref, role)
100
101    implicit none
102    type(xmlf_t) :: xf
103    character(len=*), intent(in), optional :: id
104    character(len=*), intent(in), optional :: title
105    character(len=*), intent(in), optional :: conv
106    character(len=*), intent(in), optional :: dictref
107    character(len=*), intent(in), optional :: ref
108    character(len=*), intent(in), optional :: role
109   
110    call xml_NewElement(xf, 'propertyList')
111    if (present(id)) call xml_AddAttribute(xf, 'id', id)
112    if (present(title)) call xml_AddAttribute(xf, 'title', title)
113    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
114    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
115    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
116    if (present(role)) call xml_AddAttribute(xf, 'role', role)
117   
118  END SUBROUTINE cmlAddPropertyList
119 
120 
121  ! -------------------------------------------------
122  ! 1. writes a DP property to xml channel
123  ! -------------------------------------------------
124 
125  SUBROUTINE cmlAddPropScalarDP(xf, property, id, title, conv, dictref, ref, units, fmt)
126
127    implicit none
128    type(xmlf_t) :: xf
129    real(kind=dp), intent(in)               :: property
130    character(len=*), intent(in), optional :: id
131    character(len=*), intent(in), optional :: title
132    character(len=*), intent(in), optional :: dictref
133    character(len=*), intent(in), optional :: conv
134    character(len=*), intent(in), optional :: ref
135    character(len=*), intent(in), optional :: fmt
136    character(len=*), intent(in), optional :: units
137
138    call xml_NewElement(xf, 'property')
139    if (present(id))      call xml_AddAttribute(xf, 'id', id)
140    if (present(title))   call xml_AddAttribute(xf, 'title', title)
141    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
142    if (present(conv))    call xml_AddAttribute(xf, 'convention', conv)
143    if (present(ref))    call xml_AddAttribute(xf, 'ref', ref)
144    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
145    call xml_EndElement(xf, 'property')
146
147  END SUBROUTINE cmlAddPropScalarDP
148
149  ! -------------------------------------------------
150  ! 2. writes a Scalar SP property to xml channel
151  ! -------------------------------------------------
152
153  SUBROUTINE cmlAddPropScalarSP(xf, property, id, title, conv, dictref, ref, units, fmt)
154
155    implicit none
156    type(xmlf_t) :: xf
157    real(kind=sp), intent(in) :: property
158    character(len=*), intent(in), optional :: id
159    character(len=*), intent(in), optional :: title
160    character(len=*), intent(in), optional :: dictref
161    character(len=*), intent(in), optional :: conv
162    character(len=*), intent(in), optional :: ref
163    character(len=*), intent(in), optional :: fmt
164    character(len=*), intent(in), optional :: units
165
166    call xml_NewElement(xf, 'property')
167    if (present(id)) call xml_AddAttribute(xf, 'id', id)
168    if (present(title)) call xml_AddAttribute(xf, 'title', title)
169    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
170    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
171    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
172    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
173    call xml_EndElement(xf, 'property')
174  END SUBROUTINE cmlAddPropScalarSP
175 
176  ! -------------------------------------------------
177  ! 3. writes a Scalar integer property to xml channel
178  ! -------------------------------------------------
179 
180  SUBROUTINE cmlAddPropScalarI(xf, property, id, title, conv, dictref, ref, units)
181
182    implicit none
183    type(xmlf_t) :: xf
184    integer, intent(in) :: property
185    character(len=*), intent(in), optional :: id
186    character(len=*), intent(in), optional :: title
187    character(len=*), intent(in), optional :: dictref
188    character(len=*), intent(in), optional :: conv
189    character(len=*), intent(in), optional :: ref
190    character(len=*), intent(in), optional :: units
191
192    call xml_NewElement(xf, 'property')
193    if (present(id)) call xml_AddAttribute(xf, 'id', id)
194    if (present(title)) call xml_AddAttribute(xf, 'title', title)
195    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
196    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
197    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
198    call stmAddScalar(xf=xf, value=property, units=units)
199    call xml_EndElement(xf, 'property')
200  END SUBROUTINE cmlAddPropScalarI
201
202  ! -------------------------------------------------
203  ! 4. writes an Float matrix property to xml channel
204  ! -------------------------------------------------
205
206  SUBROUTINE cmlAddPropMatrixDP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
207
208    implicit none
209    type(xmlf_t) :: xf
210    integer, intent(in)      :: nrows
211    integer, intent(in)      :: ncols
212    integer, intent(in)      :: dim
213    real(kind=dp), intent(in) :: property(nrows,ncols)
214    character(len=*), intent(in), optional :: id
215    character(len=*), intent(in), optional :: title
216    character(len=*), intent(in), optional :: dictref
217    character(len=*), intent(in), optional :: conv
218    character(len=*), intent(in), optional :: ref
219    character(len=*), intent(in), optional :: fmt
220    character(len=*), intent(in), optional :: units
221
222    call xml_NewElement(xf, 'property')
223    if (present(id)) call xml_AddAttribute(xf, 'id', id)
224    if (present(title)) call xml_AddAttribute(xf, 'title', title)
225    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
226    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
227    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
228    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
229    call xml_EndElement(xf, 'property')
230  END SUBROUTINE cmlAddPropMatrixDP
231
232  ! -------------------------------------------------
233  ! 5. writes an SP Float matrix property to xml channel
234  ! -------------------------------------------------
235
236  SUBROUTINE cmlAddPropMatrixSP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
237
238    implicit none
239    type(xmlf_t) :: xf
240    integer, intent(in)      :: nrows
241    integer, intent(in)      :: ncols
242    integer, intent(in)      :: dim
243    real(kind=sp), intent(in) :: property(nrows,ncols)
244    character(len=*), intent(in), optional :: id
245    character(len=*), intent(in), optional :: title
246    character(len=*), intent(in), optional :: dictref
247    character(len=*), intent(in), optional :: conv
248    character(len=*), intent(in), optional :: ref
249    character(len=*), intent(in), optional :: fmt
250    character(len=*), intent(in), optional :: units
251
252    call xml_NewElement(xf, 'property')
253    if (present(id)) call xml_AddAttribute(xf, 'id', id)
254    if (present(title)) call xml_AddAttribute(xf, 'title', title)
255    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
256    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
257    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
258    call stmAddMatrix(xf=xf,matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
259    call xml_EndElement(xf, 'property')
260  END SUBROUTINE cmlAddPropMatrixSP
261
262
263  ! -------------------------------------------------
264  ! 6. writes an Integer matrix property to xml channel
265  ! -------------------------------------------------
266
267  SUBROUTINE cmlAddPropMatrixI(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
268
269    implicit none
270    type(xmlf_t) :: xf
271
272    integer, intent(in)                    :: nrows
273    integer, intent(in)                    :: ncols
274    integer, intent(in), optional          :: dim
275    integer, intent(in)                    :: property(nrows,ncols)
276    character(len=*), intent(in), optional :: id
277    character(len=*), intent(in), optional :: title
278    character(len=*), intent(in), optional :: dictref
279    character(len=*), intent(in), optional :: conv
280    character(len=*), intent(in), optional :: ref
281    character(len=*), intent(in), optional :: fmt
282    character(len=*), intent(in), optional :: units
283
284    call xml_NewElement(xf, 'property')
285    if (present(id)) call xml_AddAttribute(xf, 'id', id)
286    if (present(title)) call xml_AddAttribute(xf, 'title', title)
287    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
288    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
289    if (present(conv)) call xml_AddAttribute(xf, 'ref', ref)
290    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units)
291    call xml_EndElement(xf, 'property')
292  END SUBROUTINE cmlAddPropMatrixI
293
294
295  ! -------------------------------------------------
296  ! 7. writes an Array DP property to xml channel
297  ! -------------------------------------------------
298
299  SUBROUTINE cmlAddPropArrayDP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
300
301    implicit none
302    type(xmlf_t) :: xf
303    real(kind=dp), intent(in)               :: property(*)
304    integer, intent(in)                    :: nvalue
305    character(len=*), intent(in), optional :: id
306    character(len=*), intent(in), optional :: title
307    character(len=*), intent(in), optional :: dictref
308    character(len=*), intent(in), optional :: conv
309    character(len=*), intent(in), optional :: ref
310    character(len=*), intent(in), optional :: fmt
311    character(len=*), intent(in), optional :: units
312
313    call xml_NewElement(xf, 'property')
314    if (present(id)) call xml_AddAttribute(xf, 'id', id)
315    if (present(title)) call xml_AddAttribute(xf, 'title', title)
316    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
317    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
318    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
319    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
320    call xml_EndElement(xf, 'property')
321  END SUBROUTINE cmlAddPropArrayDP
322
323  ! -------------------------------------------------
324  ! 8. writes an Array SP property to xml channel
325  ! -------------------------------------------------
326
327  SUBROUTINE cmlAddPropArraySP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
328
329    implicit none
330    type(xmlf_t) :: xf
331    real(kind=sp), intent(in)               :: property(*)
332    integer, intent(in)                    :: nvalue
333    character(len=*), intent(in), optional :: id
334    character(len=*), intent(in), optional :: title
335    character(len=*), intent(in), optional :: dictref
336    character(len=*), intent(in), optional :: conv
337    character(len=*), intent(in), optional :: ref
338    character(len=*), intent(in), optional :: fmt
339    character(len=*), intent(in), optional :: units
340
341    call xml_NewElement(xf, 'property')
342    if (present(id)) call xml_AddAttribute(xf, 'id', id)
343    if (present(title)) call xml_AddAttribute(xf, 'title', title)
344    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
345    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
346    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
347    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
348    call xml_EndElement(xf, 'property')
349  END SUBROUTINE cmlAddPropArraySP
350
351  ! -------------------------------------------------
352  ! 9. writes an Array integer property to xml channel
353  ! -------------------------------------------------
354
355  SUBROUTINE cmlAddPropArrayI(xf, property, nvalue, id, title, conv, dictref, ref, units)
356
357    implicit none
358    type(xmlf_t) :: xf
359    integer, intent(in)                    :: property(*)
360    integer, intent(in)                    :: nvalue
361    character(len=*), intent(in), optional :: id
362    character(len=*), intent(in), optional :: title
363    character(len=*), intent(in), optional :: dictref
364    character(len=*), intent(in), optional :: conv
365    character(len=*), intent(in), optional :: ref
366    character(len=*), intent(in), optional :: units
367
368    call xml_NewElement(xf, 'property')
369    if (present(id)) call xml_AddAttribute(xf, 'id', id)
370    if (present(title)) call xml_AddAttribute(xf, 'title', title)
371    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
372    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
373    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
374    call stmAddArray(xf, array=property, nvalue=nvalue, units=units)
375    call xml_EndElement(xf, 'property')
376  END SUBROUTINE cmlAddPropArrayI
377
378  !------------------------------------------------------------
379  ! END OF PROPERTIES
380  !------------------------------------------------------------
381
382
383  ! -------------------------------------------------
384  ! 1. writes complete DP molecule to xml channel
385  ! -------------------------------------------------
386
387  SUBROUTINE cmlAddMoleculeDP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
388
389    implicit none
390    type(xmlf_t) :: xf
391    integer, intent(in)                    :: natoms             ! number of atoms
392    real(kind=dp), intent(in)               :: coords(3, natoms)  ! atomic coordinates
393    character(len=*), intent(in)           :: elements(natoms)   ! chemical element types
394    character(len=*), intent(in), optional :: id                 ! id
395    character(len=*), intent(in), optional :: title              ! the title
396    character(len=*), intent(in), optional :: dictref            ! the dictionary reference
397    character(len=*), intent(in), optional :: fmt                ! format for coords
398    character(len=*), intent(in), optional :: style              ! type of coordinates
399
400    ! 'x3' for Cartesians,
401    ! 'xFrac' for fractionals
402    ! default => cartesians
403
404    ! Internal Variables
405    character(len=6) :: id1, id0
406    character(len=10):: formt, stylei
407    integer          :: i
408
409    if (present(fmt)) then
410       formt = fmt
411    else
412       formt = '(f8.3)'
413    endif
414    if (present(style)) then
415       stylei = style
416    else
417       stylei = 'x3'
418    endif
419
420    call stmAddStartTag(xf, 'molecule', id, title, dictref)
421    call xml_NewElement(xf, 'atomArray')
422    do i = 1, natoms
423       write(id0, '(i4)') i
424       id0 = adjustl(id0)
425       id1 = 'a'
426       id1(2:) = id0
427       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
428       if (stylei .eq. 'x3') then
429          call CMLATX39DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
430       elseif (stylei .eq. 'xFrac') then
431          call CMLATXF9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
432       elseif (stylei .eq. 'xyz3') then
433          call CMLATXYZ39DP(xf, coords(1, i), coords (2, i), coords(3, i), formt)
434       elseif (stylei .eq. 'xyzFrac') then
435          call CMLATXYZFRACT9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
436       endif
437       call xml_EndElement(xf, 'atom')
438    enddo
439
440    call xml_EndElement(xf, 'atomArray')
441    call xml_EndElement(xf, 'molecule')
442   
443  END SUBROUTINE cmlAddMoleculeDP
444
445 
446  ! -------------------------------------------------
447  ! 2. writes complete SP molecule to xml channel
448  ! -------------------------------------------------
449 
450  SUBROUTINE cmlAddMoleculeSP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
451    implicit none
452    type(xmlf_t) :: xf
453    integer, intent(in)                    :: natoms          ! number of atoms
454    character(len=*), intent(in)           :: elements(*)     ! chemical element types
455    real(kind=sp), intent(in)               :: coords(3, *)    ! atomic coordinates
456    character(len=*), intent(in), optional :: id              ! id
457    character(len=*), intent(in), optional :: title           ! the title
458    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
459    character(len=*), intent(in), optional :: fmt             ! format for coords
460    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac'
461    ! for fractionals; ' ' = default => cartesians)
462    ! Flush on entry and exit
463    character(len=6) :: id1, id0
464    integer          :: i
465    character(len=10):: formt, stylei
466
467    if (present(fmt)) then
468       formt = fmt
469    else
470       formt = '(f8.3)'
471    endif
472    if (present(style)) then
473       stylei = style
474    else
475       stylei = 'x3'
476    endif
477
478    call stmAddStartTag(xf, 'molecule', id, title, dictref)
479    call xml_NewElement(xf, 'atomArray')
480    do i = 1, natoms
481       write(id0, '(i4)') i
482       id0 = adjustl(id0)
483       id1 = 'a'
484       id1(2:) = id0
485       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
486       if (stylei .eq. 'x3') then
487          call CMLATX39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
488       elseif (stylei .eq. 'xFrac') then
489          call CMLATXF9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
490       elseif (stylei .eq. 'xyz3') then
491          call CMLATXYZ39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
492       elseif (stylei .eq. 'xyzFrac') then
493          call CMLATXYZFRACT9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
494       endif
495       call xml_EndElement(xf, 'atom')
496    enddo
497
498    call xml_EndElement(xf, 'atomArray')
499    call xml_EndElement(xf, 'molecule')
500   
501   
502  END SUBROUTINE cmlAddMoleculeSP
503 
504 
505  ! -------------------------------------------------
506  ! 1. writes complete DP molecule to xml channel (No. 2)
507  ! -------------------------------------------------
508 
509  SUBROUTINE cmlAddMolecule3DP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
510    implicit none
511    type(xmlf_t) :: xf
512    integer, intent(in)                    :: natoms          ! number of atoms
513    real(kind=dp), intent(in)               :: x(*)
514    real(kind=dp), intent(in)               :: y(*)
515    real(kind=dp), intent(in)               :: z(*)
516    character(len=*), intent(in)           :: elements(*)     ! chemical element types
517    character(len=*), intent(in), optional :: id              ! id
518    character(len=*), intent(in), optional :: title           ! the title
519    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
520    character(len=*), intent(in), optional :: fmt             ! format for coords
521    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac'
522    ! for fractionals; ' ' = default => cartesians)
523    character(len=6)  :: id1, id0
524    integer           :: i, l
525    character(len=10) :: formt, stylei
526
527    if (present(fmt)) then
528       formt = fmt
529    else
530       formt = '(f8.3)'
531    endif
532    if (present(style)) then
533       stylei = trim(style)
534    else
535       stylei = 'x3'
536    endif
537
538    call stmAddStartTag(xf=xf, name='molecule', id=id, title=title, dictref=dictref)
539    call xml_NewElement(xf, 'atomArray')
540
541    do i = 1, natoms
542       write(id0, '(i4)') i
543       id0 = adjustl(id0)
544       id1 = 'a'
545       id1(2:) = id0
546       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
547       if (trim(stylei) .eq. 'x3') then
548          call CMLATX39DP(xf, x(i), y(i), z(i), formt)
549       elseif (stylei .eq. 'xFrac') then
550          call CMLATXF9DP(xf, x(i), y(i), z(i), formt)
551       elseif (stylei .eq. 'xyz3') then
552          call CMLATXYZ39DP(xf, x(i), y(i), z(i), formt)
553       elseif (stylei .eq. 'xyzFrac') then
554          call CMLATXYZFRACT9DP(xf, x(i), y(i), z(i), formt)
555       endif
556       call xml_EndElement(xf, 'atom')
557    enddo
558
559    call xml_EndElement(xf, 'atomArray')
560    call xml_EndElement(xf, 'molecule')
561   
562  END SUBROUTINE cmlAddMolecule3DP
563 
564 
565  ! -------------------------------------------------
566  ! 2. writes complete SP molecule to xml channel (No. 2)
567  ! -------------------------------------------------
568 
569  SUBROUTINE cmlAddMolecule3SP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
570
571
572    implicit none
573    type(xmlf_t) :: xf
574    ! 10 Arguments
575    integer, intent(in)                    :: natoms          ! number of atoms
576    real(kind=sp), intent(in)               :: x(*)
577    real(kind=sp), intent(in)               :: y(*)
578    real(kind=sp), intent(in)               :: z(*)
579    character(len=*), intent(in)           :: elements(*)      ! chemical element types
580    character(len=*), intent(in), optional :: id               ! id
581    character(len=*), intent(in), optional :: title            ! the title
582    character(len=*), intent(in), optional :: dictref          ! the dictionary reference
583    character(len=*), intent(in), optional :: fmt              ! format for coords
584    character(len=*), intent(in), optional :: style            ! type of coordinates ('x3' for Cartesians, 'xFrac'
585    ! for fractionals; ' ' = default => cartesians)
586    ! Internal variables
587    character(len=6)  :: id1, id0
588    integer           :: i, l
589    character(len=10) :: formt, stylei
590
591    if (present(fmt)) then
592       formt = fmt
593    else
594       formt = '(f8.3)'
595    endif
596    if (present(style)) then
597       stylei = style
598    else
599       stylei = 'x3'
600    endif
601
602    call xml_NewElement(xf, 'molecule')
603    call xml_AddAttribute(xf, 'id', id)
604    call xml_AddAttribute(xf, 'title', title)
605    call xml_AddAttribute(xf, 'dictref', dictref)
606    call xml_NewElement(xf, 'atomArray')
607    do i = 1, natoms
608       write(id0, '(i4)') i
609       id0 = adjustl(id0)
610       id1 = 'a'
611       id1(2:) = id0
612       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
613       if (stylei .eq. 'x3') then
614          call CMLATX39SP(xf, x(i), y(i), z(i), formt)
615       else if (stylei .eq. 'xFrac') then
616          call CMLATXF9SP(xf, x(i), y(i), z(i), formt)
617       else if (stylei .eq. 'xyz3') then
618          call CMLATXYZ39SP(xf, x(i), y(i), z(i), formt)
619       else if (stylei .eq. 'xyzFrac') then
620          call CMLATXYZFRACT9SP(xf, x(i), y(i), z(i), formt)
621       endif
622           call xml_EndElement(xf, 'atom')
623    enddo
624
625    call xml_EndElement(xf, 'atomArray')
626    call xml_EndElement(xf, 'molecule')
627
628  END SUBROUTINE cmlAddMolecule3SP
629 
630  ! -------------------------------------------------
631  ! writes an <atom> start tag
632  ! -------------------------------------------------
633 
634  SUBROUTINE cmlAddAtom(xf, elem, id, charge, hCount, occupancy, fmt)
635
636
637    implicit none
638    type(xmlf_t) :: xf
639    integer, intent(in), optional           :: charge     ! formalCharge
640    integer, intent(in), optional           :: hCount     ! hydrogenCount
641    real(kind=sp), intent(in), optional      :: occupancy  ! hydrogenCount
642    character(len=*), intent(in), optional  :: elem       ! chemical element name
643    character(len=*), intent(in), optional  :: id         ! atom id
644    character(len=*), intent(in), optional  :: fmt        ! format
645
646    ! internal Variable
647    character(len=10):: formt
648    if (present(fmt)) then
649       formt = fmt
650    else
651       formt = '(f8.3)'
652    endif
653
654    call xml_NewElement(xf, 'atom')
655    if (present(elem))      call xml_AddAttribute(xf, 'elementType', elem)
656    if (present(id))        call xml_AddAttribute(xf, 'id', id)
657    if (present(charge))    call xml_AddAttribute(xf, 'formalCharge', str(charge))
658    if (present(hCount))    call xml_AddAttribute(xf, 'hydrogenCount', str(hCount))
659    if (present(occupancy)) call xml_AddAttribute(xf, 'occupancy', str(occupancy,formt))
660
661  END SUBROUTINE cmlAddAtom
662 
663 
664  ! -------------------------------------------------
665  ! 1. append SP coordinates to atom tag
666  ! -------------------------------------------------
667 
668  SUBROUTINE cmlAddCoordinatesSP(xf, x, y, z, style, fmt)
669    implicit none
670    type(xmlf_t) :: xf
671    real(kind=sp), intent(in)               :: x, y
672    real(kind=sp), intent(in), optional     :: z
673    character(len=*), intent(in), optional :: style
674    character(len=*), intent(in), optional :: fmt
675
676    ! Internal variable
677    character(len=10):: formt
678    character(len=10):: stylei
679    if (present(fmt)) then
680       formt = fmt
681    else
682       formt = '(f8.3)'
683    endif
684    if (present(style)) then
685       stylei = style
686    else
687       stylei = 'x3'
688    endif
689
690    if (present(z) .and. stylei .eq. 'x3') then
691       call CMLATX39SP(xf, x, y, z, formt)
692    else if (present(z) .and. stylei .eq. 'xFrac') then
693       call CMLATXF9SP(xf, x, y, z, formt)
694    else if (present(z) .and. stylei .eq. 'xyz3') then
695       call CMLATXYZ39SP(xf, x, y, z, formt)
696    else if (present(z) .and. stylei .eq. 'xyzFrac') then
697       call CMLATXYZFRACT9SP(xf, x, y, z, formt)
698    elseif (.not. present(z) .and. stylei .eq. 'xy2') then
699       call CMLATXY9SP(xf, x, y, formt)           
700    endif
701
702  END SUBROUTINE cmlAddCoordinatesSP
703
704  ! -------------------------------------------------
705  ! 2. append DP coordinates to atom tag
706  ! -------------------------------------------------
707
708  SUBROUTINE cmlAddCoordinatesDP(xf, x, y, z, style, fmt)
709    implicit none
710    type(xmlf_t) :: xf 
711    real(kind=dp), intent(in)               :: x, y
712    real(kind=dp), intent(in), optional     :: z
713    character(len=*), intent(in), optional :: style
714    character(len=*), intent(in), optional :: fmt
715   
716    ! Internal variable
717    character(len=10):: formt
718    character(len=10):: stylei
719    if (present(fmt)) then
720       formt = fmt
721    else
722       formt = '(f8.3)'
723    endif
724    if (present(style)) then
725       stylei = style
726    else
727       stylei = 'x3'
728    endif
729   
730    if (present(z) .and. stylei .eq. 'x3') then
731       call CMLATX39DP(xf, x, y, z, formt)
732    else if (present(z) .and. stylei .eq. 'xFrac') then
733       call CMLATXF9DP(xf, x, y, z, formt)
734    else if (present(z) .and. stylei .eq. 'xyz3') then
735       call CMLATXYZ39DP(xf, x, y, z, formt)
736    else if (present(z) .and. stylei .eq. 'xyzFrac') then
737       call CMLATXYZFRACT9DP(xf, x, y, z, formt)
738    else if (.not. present(z) .and. stylei .eq. 'xy2') then
739       call CMLATXY9DP(xf, x, y, formt)           
740    endif
741   
742  END SUBROUTINE cmlAddCoordinatesDP
743
744 
745  ! -------------------------------------------------
746  ! 1. writes a DP <length> element to output channel
747  ! -------------------------------------------------
748 
749  SUBROUTINE cmlAddLengthDP(xf, length, id, atomRef1, atomRef2, fmt)
750    implicit none
751    type(xmlf_t) :: xf
752    real(kind=dp), intent(in)     :: length     ! length
753    character(len=*), intent(in) :: id         ! length id
754    character(len=*), intent(in) :: atomRef1   ! ref to first atom
755    character(len=*), intent(in) :: atomRef2   ! ref to second atom
756    character(len=*), intent(in) :: fmt        ! format
757
758    optional         :: fmt
759    character(len=10):: formt
760
761    if (present(fmt)) then
762       formt = fmt
763    else
764       formt = '(f8.3)'
765    endif
766
767    ! Flush on entry and exit
768    call CMLLEN9DP(xf, id, atomRef1, atomRef2, length, formt)
769  END SUBROUTINE cmlAddLengthDP
770
771  ! -------------------------------------------------
772  ! 2. writes a SP <length> element to output channel
773  ! -------------------------------------------------
774 
775  SUBROUTINE cmlAddLengthSP(xf, length, id, atomRef1, atomRef2, fmt)
776
777    implicit none
778    type(xmlf_t) :: xf
779    real(kind=sp), intent(in)     :: length     ! the length
780    character(len=*), intent(in) :: id         ! length id
781    character(len=*), intent(in) :: atomRef1   ! ref to first atom
782    character(len=*), intent(in) :: atomRef2   ! ref to second atom
783    character(len=*), intent(in) :: fmt        ! format
784
785    optional         :: fmt
786    character(len=10):: formt
787
788    if (present(fmt)) then
789       formt = fmt
790    else
791       formt = '(f8.3)'
792    endif
793
794    ! Flush on entry and exit
795    call CMLLEN9SP(xf, id, atomRef1, atomRef2, length, formt)
796  END SUBROUTINE cmlAddLengthSP
797
798
799  ! -------------------------------------------------
800  ! 1. writes an DP <angle> element to output channel
801  ! -------------------------------------------------
802
803  SUBROUTINE cmlAddAngleDP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
804
805    implicit none
806    type(xmlf_t) :: xf
807    real(kind=dp), intent(in)     :: angle        ! the angle
808    character(len=*), intent(in) :: id           ! angle id
809    character(len=*), intent(in) :: atomRef1     ! ref to first atom
810    character(len=*), intent(in) :: atomRef2     ! ref to second atom
811    character(len=*), intent(in) :: atomRef3     ! ref to third atom
812    character(len=*), intent(in) :: fmt          ! format
813
814    optional         :: fmt
815    character(len=10):: formt
816
817    if (present(fmt)) then
818       formt = fmt
819    else
820       formt = '(f8.3)'
821    endif
822
823    ! Flush on entry and exit
824    call CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
825  END SUBROUTINE cmlAddAngleDP
826
827  ! -------------------------------------------------
828  ! 2. writes an SP <angle> element to output channel
829  ! -------------------------------------------------
830
831  SUBROUTINE cmlAddAngleSP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
832
833
834    implicit none
835    type(xmlf_t) :: xf
836    real(kind=sp), intent(in)     :: angle        ! the angle
837    character(len=*), intent(in) :: id           ! angle id
838    character(len=*), intent(in) :: atomRef1     ! ref to first atom
839    character(len=*), intent(in) :: atomRef2     ! ref to second atom
840    character(len=*), intent(in) :: atomRef3     ! ref to third atom
841    character(len=*), intent(in) :: fmt          ! format
842
843    optional         :: fmt
844    character(len=10):: formt
845
846    if (present(fmt)) then
847       formt = fmt
848    else
849       formt = '(f8.3)'
850    endif
851
852    ! Flush on entry and exit
853    call CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
854  END SUBROUTINE cmlAddAngleSP
855
856
857  ! -------------------------------------------------
858  ! 1. creates and writes a DP <torsion> element
859  ! -------------------------------------------------
860
861  SUBROUTINE cmlAddTorsionDP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
862
863
864    implicit none
865    type(xmlf_t) :: xf
866    real(kind=dp), intent(in)     :: torsion         ! the torsion
867    character(len=*), intent(in) :: id              ! torsion id
868    character(len=*), intent(in) :: atomRef1        ! ref to first atom
869    character(len=*), intent(in) :: atomRef2        ! ref to second atom
870    character(len=*), intent(in) :: atomRef3        ! ref to third atom
871    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
872    character(len=*), intent(in) :: fmt             ! format
873
874    optional         :: fmt
875    character(len=10):: formt
876
877    if (present(fmt)) then
878       formt = fmt
879    else
880       formt = '(f8.3)'
881    endif
882
883    ! Flush on entry and exit
884    call CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
885  END SUBROUTINE cmlAddTorsionDP
886 
887  ! -------------------------------------------------
888  ! 2. creates and writes a SP <torsion> element
889  ! -------------------------------------------------
890 
891  SUBROUTINE cmlAddTorsionSP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
892
893
894    implicit none
895    type(xmlf_t) :: xf
896    real(kind=sp), intent(in)     :: torsion         ! the torsion
897    character(len=*), intent(in) :: id              ! torsion id
898    character(len=*), intent(in) :: atomRef1        ! ref to first atom
899    character(len=*), intent(in) :: atomRef2        ! ref to second atom
900    character(len=*), intent(in) :: atomRef3        ! ref to third atom
901    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
902    character(len=*), intent(in) :: fmt             ! format
903
904    optional         :: fmt
905    character(len=10):: formt
906
907    if (present(fmt)) then
908       formt = fmt
909    else
910       formt = '(f8.3)'
911    endif
912
913    ! Flush on entry and exit
914    call CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
915  END SUBROUTINE cmlAddTorsionSP
916
917
918  ! -------------------------------------------------
919  ! 1. creates and writes an SP Lattice element
920  ! -------------------------------------------------
921
922  SUBROUTINE cmlAddLatticeSP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
923
924    implicit none
925    type(xmlf_t) :: xf
926    real(kind=sp), intent(in)               :: cell(3,3)
927    character(len=*), intent(in), optional :: units       
928    character(len=*), intent(in), optional :: id           ! id
929    character(len=*), intent(in), optional :: title        ! title
930    character(len=*), intent(in), optional :: dictref      ! dictref
931    character(len=*), intent(in), optional :: conv         ! format
932    character(len=*), intent(in), optional :: lattType     !
933    character(len=*), intent(in), optional :: spaceType    !
934    character(len=*), intent(in), optional :: fmt         
935
936    ! Internal Variables
937    integer           :: i
938    character(len=10) :: formt
939
940    if (present(fmt)) then
941       formt = fmt
942    else
943       formt = '(f8.3)'   
944    endif
945
946    call xml_NewElement(xf, 'lattice')
947    if (present(id)) call xml_AddAttribute(xf, 'id', id)
948    if (present(title)) call xml_AddAttribute(xf, 'title', title)
949    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
950    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
951    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
952    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
953
954    do i = 1,3
955       call xml_NewElement(xf, 'latticeVector')
956       if (present(units)) call xml_AddAttribute(xf, 'units', units)
957       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
958       call xml_AddPcdata(xf, str(cell(1,i), formt))
959       call xml_AddPcdata(xf, str(cell(2,i), formt))
960       call xml_AddPcdata(xf, str(cell(3,i), formt))
961    call xml_EndElement(xf, 'latticeVector')
962    enddo
963    call xml_EndElement(xf, 'lattice')
964
965  END SUBROUTINE cmlAddLatticeSP
966
967
968  ! -------------------------------------------------
969  ! 2. creates and writes DP Lattice element
970  ! -------------------------------------------------
971
972  SUBROUTINE cmlAddLatticeDP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
973
974    implicit none
975    type(xmlf_t) :: xf
976    real(kind=dp), intent(in)               :: cell(3,3)
977    character(len=*), intent(in), optional :: units       
978    character(len=*), intent(in), optional :: id           ! id
979    character(len=*), intent(in), optional :: title        ! title
980    character(len=*), intent(in), optional :: dictref      ! dictref
981    character(len=*), intent(in), optional :: conv         ! format
982    character(len=*), intent(in), optional :: lattType     !
983    character(len=*), intent(in), optional :: spaceType    !
984    character(len=*), intent(in), optional :: fmt         
985
986    ! Internal Variables
987    integer           :: i
988    character(len=10) :: formt
989
990    if (present(fmt)) then
991       formt = fmt
992    else
993       formt = '(f8.3)'   
994    endif
995
996    call xml_NewElement(xf, 'lattice')
997    if (present(id)) call xml_AddAttribute(xf, 'id', id)
998    if (present(title)) call xml_AddAttribute(xf, 'title', title)
999    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
1000    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1001    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
1002    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
1003
1004    do i = 1,3
1005       call xml_NewElement(xf, 'latticeVector')
1006       if (present(units)) call xml_AddAttribute(xf, 'units', units)
1007       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
1008       call xml_AddPcdata(xf, str(cell(1,i), formt))
1009       call xml_AddPcdata(xf, str(cell(2,i), formt))
1010       call xml_AddPcdata(xf, str(cell(3,i), formt))
1011       call xml_EndElement(xf, 'latticeVector')
1012    enddo
1013   
1014    call xml_EndElement(xf, 'lattice')
1015
1016  END SUBROUTINE cmlAddLatticeDP
1017
1018
1019  ! -------------------------------------------------
1020  ! 1. creates a DP Lattice Vector element
1021  ! -------------------------------------------------
1022 
1023  SUBROUTINE cmlAddLatticeVectorDP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
1024    implicit none
1025    type(xmlf_t) :: xf
1026    real(kind=dp), intent(in) :: vector(3)
1027    character(len=*), intent(in), optional :: title       
1028    character(len=*), intent(in), optional :: id           
1029    character(len=*), intent(in), optional :: dictref     
1030    character(len=*), intent(in), optional :: conv       
1031    character(len=*), intent(in), optional :: units       
1032    character(len=*), intent(in), optional :: periodic   
1033    character(len=*), intent(in), optional :: fmt         
1034
1035    ! Deal with optional things
1036    ! that have defaults
1037    character(len=10) :: formt
1038    if (present(fmt)) then
1039       formt = fmt
1040    else
1041       formt = '(f8.3)'   
1042    endif
1043
1044    call xml_NewElement(xf, 'latticeVector')
1045    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1046    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1047    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
1048    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1049    if (present(units)) call xml_AddAttribute(xf, 'units', units)
1050    if (present(periodic)) call xml_AddAttribute(xf, 'periodic', periodic)
1051    call xml_AddPcdata(xf, str(vector(1), formt))
1052    call xml_AddPcdata(xf, str(vector(2), formt))
1053    call xml_AddPcdata(xf, str(vector(3), formt))
1054    call xml_EndElement(xf, 'latticeVector')
1055
1056  END SUBROUTINE cmlAddLatticeVectorDP
1057
1058
1059  ! -------------------------------------------------
1060  ! 2. creates a SP Lattice Vector element
1061  ! -------------------------------------------------
1062
1063  SUBROUTINE cmlAddLatticeVectorSP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
1064    implicit none
1065    type(xmlf_t) :: xf
1066    real(kind=sp), intent(in) :: vector(3)
1067    character(len=*), intent(in), optional :: title       
1068    character(len=*), intent(in), optional :: id           
1069    character(len=*), intent(in), optional :: dictref     
1070    character(len=*), intent(in), optional :: conv       
1071    character(len=*), intent(in), optional :: units       ! should this be optional
1072    character(len=*), intent(in), optional :: periodic   
1073    character(len=*), intent(in), optional :: fmt         
1074
1075    ! Deal with optional things
1076    ! that have defaults
1077    character(len=10) :: formt
1078    if (present(fmt)) then
1079       formt = fmt
1080    else
1081       formt = '(f8.3)'   
1082    endif
1083
1084    call xml_NewElement(xf, 'latticeVector')
1085    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1086    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1087    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
1088    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1089    if (present(units)) call xml_AddAttribute(xf, 'units', units)
1090    if (present(units)) call xml_AddAttribute(xf, 'periodic', periodic)
1091    call xml_AddPcdata(xf, str(vector(1), formt))
1092    call xml_AddPcdata(xf, str(vector(2), formt))
1093    call xml_AddPcdata(xf, str(vector(3), formt))
1094    call xml_EndElement(xf, 'latticeVector')
1095
1096  END SUBROUTINE cmlAddLatticeVectorSP
1097
1098  ! -------------------------------------------------
1099  ! 1. creates and writes a DP <cell> element
1100  ! -------------------------------------------------
1101
1102  SUBROUTINE cmlAddCrystalDP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
1103    implicit none
1104    type(xmlf_t) :: xf
1105    real(kind=dp), intent(in)               :: a, b, c      ! cell parameters
1106    real(kind=dp), intent(in)               :: alpha        ! alpha cell parameter
1107    real(kind=dp), intent(in)               :: beta         ! beta cell parameter
1108    real(kind=dp), intent(in)               :: gamma        ! gamma cell parameter
1109    character(len=*), intent(in), optional :: id           ! id
1110    character(len=*), intent(in), optional :: title        ! title
1111    character(len=*), intent(in), optional :: dictref      ! dictref
1112    character(len=*), intent(in), optional :: lenunits     ! units for length (default = angstrom)
1113    character(len=*), intent(in), optional :: angunits     ! units for angles (default = degree)
1114    character(len=*), intent(in), optional :: fmt          ! format
1115
1116    ! Flush on entry and exit
1117    character(len=30) ::  lunits, aunits
1118    character(len=10) :: formt
1119
1120    if (present(fmt)) then
1121       formt = fmt
1122    else
1123       formt = '(f8.3)'
1124    endif
1125    if (present(lenunits)) then
1126       lunits = lenunits
1127    else
1128       lunits = 'units:angstrom'
1129    endif
1130    if (present(angunits)) then
1131       aunits = angunits
1132    else
1133       aunits = 'units:degree'
1134    endif
1135
1136    call stmAddStartTag(xf=xf, name='crystal', id=id, title=title, dictref=dictref)
1137    call stmAddScalar(xf=xf, value=a, title='a', dictref='cml:a', units=lunits, fmt=formt)
1138    call stmAddScalar(xf=xf, value=b, title='b', dictref='cml:b', units=lunits, fmt=formt)
1139    call stmAddScalar(xf=xf, value=c, title='c', dictref='cml:c', units=lunits, fmt=formt)
1140    call stmAddScalar(xf=xf, value=alpha, title='alpha', dictref='cml:alpha', units=aunits, fmt=formt)
1141    call stmAddScalar(xf=xf, value=beta,  title='beta',  dictref='cml:beta',  units=aunits, fmt=formt)
1142    call stmAddScalar(xf=xf, value=gamma, title='gamma', dictref='cml:gamma', units=aunits, fmt=formt)
1143    call xml_EndElement(xf, 'crystal')
1144
1145  END SUBROUTINE cmlAddCrystalDP
1146
1147  ! -------------------------------------------------
1148  ! 2. creates and writes a SP <cell> element
1149  ! -------------------------------------------------
1150
1151  SUBROUTINE cmlAddCrystalSP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
1152    implicit none
1153    type(xmlf_t) :: xf
1154    real(kind=sp), intent(in)     :: a, b, c      ! cell parameters
1155    real(kind=sp), intent(in)     :: alpha        ! alpha cell parameter
1156    real(kind=sp), intent(in)     :: beta         ! beta cell parameter
1157    real(kind=sp), intent(in)     :: gamma        ! gamma cell parameter
1158    character(len=*), intent(in), optional :: id           ! id
1159    character(len=*), intent(in), optional :: title        ! title
1160    character(len=*), intent(in), optional :: dictref      ! dictref
1161    character(len=*), intent(in), optional :: lenunits     ! units for length (' ' = angstrom)
1162    character(len=*), intent(in), optional :: angunits     ! units for angles (' ' = degree)
1163    character(len=*), intent(in), optional :: fmt          ! format
1164
1165    ! Flush on entry and exit
1166    character(len=30) :: lunits, aunits
1167    character(len=10) :: formt
1168
1169    if (present(fmt)) then
1170       formt = fmt
1171    else
1172       formt = '(f8.3)'
1173    endif
1174    if (present(lenunits)) then
1175       lunits = lenunits
1176    else
1177       lunits = U_ANGSTR
1178    endif
1179    if (present(angunits)) then
1180       aunits = angunits
1181    else
1182       aunits = U_DEGREE
1183    endif
1184
1185    call stmAddStartTag(xf, 'crystal', id, title, dictref)
1186    call stmAddScalar(xf, a, ' ', 'a', 'cml:a', lunits, formt)
1187    call stmAddScalar(xf, b, ' ', 'b', 'cml:b', lunits, formt)
1188    call stmAddScalar(xf, c, ' ', 'c', 'cml:c', lunits, formt)
1189    call stmAddScalar(xf, alpha, ' ', 'alpha', 'cml:alpha', aunits, formt)
1190    call stmAddScalar(xf, beta, ' ', 'beta', 'cml:beta', aunits, formt)
1191    call stmAddScalar(xf, gamma, ' ', 'gamma', 'cml:gamma', aunits, formt)
1192    call xml_EndElement(xf, 'crystal')
1193
1194  END SUBROUTINE cmlAddCrystalSP
1195 
1196 
1197  ! -------------------------------------------------
1198  ! 1. creates and writes an DP <eigen> element
1199  ! -------------------------------------------------
1200 
1201  SUBROUTINE cmlAddEigenvalueDP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
1202
1203
1204    implicit none
1205    type(xmlf_t) :: xf
1206    integer, intent(in)          :: n              ! number of elements
1207    integer, intent(in)          :: dim            ! dimension of matrix
1208    real(kind=dp), intent(in)     :: eigvec(dim, *) ! eigenvectors
1209    real(kind=dp), intent(in)     :: eigval(*)      ! eigenvalues
1210    character(len=*), intent(in), optional :: id             ! id
1211    character(len=*), intent(in), optional :: title          ! title
1212    character(len=*), intent(in), optional :: dictref        ! dictionary reference
1213    character(len=*), intent(in), optional :: fmt            ! format
1214    character(len=10):: formt
1215    integer ::  i, j
1216
1217    if (present(fmt)) then
1218       formt = fmt
1219    else
1220       formt = '(f8.3)'
1221    endif
1222
1223    ! Flush on entry and exit
1224    call xml_NewElement(xf, 'eigen')
1225    if (present(id))      call xml_AddAttribute(xf, 'id', id)
1226    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
1227    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
1228    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
1229    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
1230    call xml_EndElement(xf, 'eigen')
1231
1232  END SUBROUTINE cmlAddEigenvalueDP
1233
1234
1235
1236  ! -------------------------------------------------
1237  ! 2. creates and writes an SP <eigen> element
1238  ! -------------------------------------------------
1239 
1240  SUBROUTINE cmlAddEigenvalueSP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
1241
1242
1243    implicit none
1244    type(xmlf_t) :: xf
1245    integer, intent(in)          :: n              ! number of elements
1246    integer, intent(in)          :: dim            ! dimension of matrix
1247    real(kind=sp), intent(in)     :: eigvec(dim, *) ! eigenvectors
1248    real(kind=sp), intent(in)     :: eigval(*)      ! eigenvalues
1249    character(len=*), intent(in), optional :: id             ! id
1250    character(len=*), intent(in), optional :: title          ! title
1251    character(len=*), intent(in), optional :: dictref        ! dictionary reference
1252    character(len=*), intent(in), optional :: fmt            ! format
1253    character(len=10):: formt
1254    integer ::  i, j
1255
1256    if (present(fmt)) then
1257       formt = fmt
1258    else
1259       formt = '(f8.3)'
1260    endif
1261
1262    ! Flush on entry and exit
1263    call xml_NewElement(xf, 'eigen')
1264    if (present(id))      call xml_AddAttribute(xf, 'id', id)
1265    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
1266    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
1267    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
1268    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
1269    call xml_EndElement(xf, 'eigen')
1270
1271  END SUBROUTINE cmlAddEigenvalueSP
1272
1273
1274  SUBROUTINE cmlAddMetadata(xf, name, content, conv)
1275   
1276    implicit none
1277    type(xmlf_t) :: xf
1278    character(len=*) :: name
1279    character(len=*) :: content
1280    character(len=*), optional :: conv
1281   
1282    call xml_NewElement(xf, 'metadata')
1283    call xml_AddAttribute(xf, 'name', name)
1284    call xml_AddAttribute(xf, 'content', content)
1285    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1286    call xml_EndElement(xf, 'metadata')
1287
1288  END SUBROUTINE cmlAddMetadata
1289
1290
1291  ! -------------------------------------------------
1292  ! 1. creates and writes an Char <parameter> element
1293  ! -------------------------------------------------
1294
1295
1296  SUBROUTINE cmlAddParameterCh(xf, value, ref, id, title, conv, &
1297       cons, units, name, role)
1298
1299    implicit none
1300    type(xmlf_t) :: xf
1301    character(len=*) :: value
1302    character(len=*), optional :: ref 
1303    character(len=*), optional :: title
1304    character(len=*), optional :: id
1305    character(len=*), optional :: conv
1306    character(len=*), optional :: cons
1307    character(len=*), optional :: units
1308    character(len=*), optional :: name
1309    character(len=*), optional :: role
1310
1311    call xml_NewElement(xf, 'parameter')
1312    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
1313    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1314    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1315    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1316    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
1317    if (present(name)) call xml_AddAttribute(xf, 'name', name)
1318    if (present(role)) call xml_AddAttribute(xf, 'role', role)
1319    if (present(units)) then
1320       call xml_NewElement(xf, 'scalar')
1321       call xml_AddAttribute(xf, 'units', units)
1322       call xml_AddPcdata(xf, value)
1323       call xml_EndElement(xf, 'scalar')
1324    else
1325       call xml_AddAttribute(xf, 'value', value)
1326    endif
1327    call xml_EndElement(xf, 'parameter')
1328
1329  END SUBROUTINE CMLADDPARAMETERCH
1330
1331
1332  ! -------------------------------------------------
1333  ! 2. creates and writes an SP <parameter> element
1334  ! -------------------------------------------------
1335
1336
1337  SUBROUTINE cmlAddParameterSP(xf, value, ref, title, id, conv, &
1338       cons, units, name, role, fmt)
1339
1340    implicit none
1341    type(xmlf_t) :: xf
1342    real(kind=sp) :: value
1343    character(len=*), optional :: ref 
1344    character(len=*), optional :: title
1345    character(len=*), optional :: id
1346    character(len=*), optional :: conv
1347    character(len=*), optional :: cons
1348    character(len=*), optional :: units
1349    character(len=*), optional :: name
1350    character(len=*), optional :: role
1351    character(len=*), optional :: fmt   
1352
1353    character(len=10) :: formt
1354
1355    if (present(fmt)) then
1356       formt = fmt
1357    else
1358       formt = '(f8.3)'
1359    endif
1360
1361    call xml_NewElement(xf, 'parameter')
1362    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
1363    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1364    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1365    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1366    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
1367    if (present(name)) call xml_AddAttribute(xf, 'name', name)
1368    if (present(role)) call xml_AddAttribute(xf, 'role', role)
1369    if (present(units)) then
1370       call xml_NewElement(xf, 'scalar')
1371       call xml_AddAttribute(xf, 'units', units)
1372       call xml_AddPcdata(xf, str(value))
1373       call xml_EndElement(xf, 'scalar')
1374    else
1375       call xml_AddAttribute(xf, 'value', str(value,formt))
1376    endif
1377    call xml_EndElement(xf, 'parameter')
1378
1379  END SUBROUTINE CMLADDPARAMETERSP
1380
1381
1382  ! -------------------------------------------------
1383  ! 3. creates and writes an DP <parameter> element
1384  ! -------------------------------------------------
1385
1386
1387  SUBROUTINE cmlAddParameterDP(xf, value, ref, title, id, conv, &
1388       cons, units, name, role, fmt)
1389
1390    implicit none
1391    type(xmlf_t) :: xf
1392    real(kind=dp) :: value
1393    character(len=*), optional :: ref 
1394    character(len=*), optional :: title
1395    character(len=*), optional :: id
1396    character(len=*), optional :: conv
1397    character(len=*), optional :: cons
1398    character(len=*), optional :: units
1399    character(len=*), optional :: name
1400    character(len=*), optional :: role
1401    character(len=*), optional :: fmt   
1402
1403    character(len=10) :: formt
1404
1405    if (present(fmt)) then
1406       formt = fmt
1407    else
1408       formt = '(f8.3)'
1409    endif
1410
1411    call xml_NewElement(xf, 'parameter')
1412    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
1413    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1414    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1415    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1416    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
1417    if (present(name)) call xml_AddAttribute(xf, 'name', name)
1418    if (present(role)) call xml_AddAttribute(xf, 'role', role)
1419    if (present(units)) then
1420       call xml_NewElement(xf, 'scalar')
1421       call xml_AddAttribute(xf, 'units', units)
1422       call xml_AddPcdata(xf, str(value))
1423       call xml_EndElement(xf, 'scalar')
1424    else
1425       call xml_AddAttribute(xf, 'value', str(value))
1426    endif
1427    call xml_EndElement(xf, 'parameter')
1428
1429  END SUBROUTINE CMLADDPARAMETERDP
1430
1431
1432  ! -------------------------------------------------
1433  ! 4. creates and writes an Integer <parameter> element
1434  ! -------------------------------------------------
1435
1436
1437  SUBROUTINE cmlAddParameterI(xf, value, ref, id, title, conv, &
1438       cons, units, name, role)
1439
1440    implicit none
1441    type(xmlf_t) :: xf
1442    integer :: value
1443    character(len=*), optional :: ref 
1444    character(len=*), optional :: title
1445    character(len=*), optional :: id
1446    character(len=*), optional :: conv
1447    character(len=*), optional :: cons
1448    character(len=*), optional :: units
1449    character(len=*), optional :: name
1450    character(len=*), optional :: role
1451
1452    call xml_NewElement(xf, 'parameter')
1453    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
1454    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1455    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1456    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1457    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
1458    if (present(name)) call xml_AddAttribute(xf, 'name', name)
1459    if (present(role)) call xml_AddAttribute(xf, 'role', role)
1460    if (present(units)) then
1461       call xml_NewElement(xf, 'scalar')
1462       call xml_AddAttribute(xf, 'units', units)
1463       call xml_AddPcdata(xf, str(value))
1464       call xml_EndElement(xf, 'scalar')
1465    else
1466       call xml_AddAttribute(xf, 'value', str(value))
1467    endif
1468    call xml_EndElement(xf, 'parameter')
1469
1470  END SUBROUTINE CMLADDPARAMETERI
1471
1472  SUBROUTINE cmlAddParameterLG(xf, value, ref, id, title, conv, &
1473       cons, units, name, role)
1474
1475    implicit none
1476    type(xmlf_t) :: xf
1477    logical      :: value
1478    character(len=*), optional :: ref 
1479    character(len=*), optional :: title
1480    character(len=*), optional :: id
1481    character(len=*), optional :: conv
1482    character(len=*), optional :: cons
1483    character(len=*), optional :: units
1484    character(len=*), optional :: name
1485    character(len=*), optional :: role
1486
1487    call xml_NewElement(xf, 'parameter')
1488    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
1489    if (present(title)) call xml_AddAttribute(xf, 'title', title)
1490    if (present(id)) call xml_AddAttribute(xf, 'id', id)
1491    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
1492    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
1493    if (present(name)) call xml_AddAttribute(xf, 'name', name)
1494    if (present(role)) call xml_AddAttribute(xf, 'role', role)
1495    if (present(units)) then
1496       call xml_NewElement(xf, 'scalar')
1497       call xml_AddAttribute(xf, 'units', units)
1498       call xml_AddPcdata(xf, str(value))
1499       call xml_EndElement(xf, 'scalar')
1500    else
1501       call xml_AddAttribute(xf, 'value', str(value))
1502    endif
1503    call xml_EndElement(xf, 'parameter')
1504
1505  END SUBROUTINE CMLADDPARAMETERLG
1506
1507
1508
1509! =================================================
1510! basic CML routines
1511! =================================================
1512
1513 
1514  ! -------------------------------------------------
1515  ! 1. adds DP xyz3 to start tag
1516  ! -------------------------------------------------
1517 
1518  SUBROUTINE CMLATXYZ39DP(xf, x3, y3, z3, fmt)
1519    implicit none
1520    type(xmlf_t) :: xf
1521    real(kind=dp)      :: x3, y3, z3 ! coordinates
1522    character(len=*)  :: fmt        ! format (default '(f8.3)')
1523    character(len=45) :: x, y, z
1524
1525    write(x,fmt) x3
1526    write(y,fmt) y3
1527    write(z,fmt) z3
1528
1529    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
1530
1531  END SUBROUTINE CMLATXYZ39DP
1532
1533
1534  ! -------------------------------------------------
1535  ! 2. adds SP xyz3 to start tag
1536  ! -------------------------------------------------
1537
1538  SUBROUTINE CMLATXYZ39SP(xf, x3, y3, z3, fmt)
1539    implicit none
1540    type(xmlf_t) :: xf
1541    real(kind=sp)      :: x3, y3, z3 ! coordinates
1542    character(len=*)  :: fmt        ! format (default '(f8.3)')
1543
1544    character(len=45) :: x, y, z
1545
1546    write(x,fmt) x3
1547    write(y,fmt) y3
1548    write(z,fmt) z3
1549
1550    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
1551
1552  END SUBROUTINE CMLATXYZ39SP
1553 
1554  ! -------------------------------------------------
1555  ! 1. adds DP xyzFrac to start tag
1556  ! -------------------------------------------------
1557 
1558  SUBROUTINE CMLATXYZFRACT9DP(xf, x3, y3, z3, fmt)
1559    implicit none
1560    type(xmlf_t) :: xf
1561    real(kind=dp)      :: x3, y3, z3 ! coordinates
1562    character(len=*)  :: fmt        ! format (default '(f8.3)')
1563
1564    character(len=45) :: x, y, z
1565
1566    write(x,fmt) x3
1567    write(y,fmt) y3
1568    write(z,fmt) z3
1569
1570    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
1571
1572  END SUBROUTINE CMLATXYZFRACT9DP
1573
1574  ! -------------------------------------------------
1575  ! 2. adds SP xyzFrac to start tag
1576  ! -------------------------------------------------
1577
1578  SUBROUTINE CMLATXYZFRACT9SP(xf, x3, y3, z3, fmt)
1579    implicit none
1580    type(xmlf_t) :: xf
1581    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
1582    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
1583
1584    character(len=45) :: x, y, z
1585
1586    write(x,fmt) x3
1587    write(y,fmt) y3
1588    write(z,fmt) z3
1589
1590    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(y)//' '//trim(z))
1591
1592  END SUBROUTINE CMLATXYZFRACT9SP
1593
1594
1595  ! -------------------------------------------------
1596  ! 1. adds DP x3, y3, z3 to start tag
1597  ! -------------------------------------------------
1598
1599  SUBROUTINE CMLATX39DP(xf, x3, y3, z3, fmt)
1600    implicit none
1601    type(xmlf_t) :: xf
1602    real(kind=dp), intent(in)     :: x3, y3, z3 ! coordinates
1603    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
1604
1605    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
1606    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
1607    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
1608
1609  END SUBROUTINE CMLATX39DP
1610
1611  ! -------------------------------------------------
1612  ! 2. adds SP x3, y3, z3 to start tag
1613  ! -------------------------------------------------
1614
1615  SUBROUTINE CMLATX39SP(xf, x3, y3, z3, fmt)
1616    implicit none
1617    type(xmlf_t) :: xf
1618    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
1619    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
1620
1621    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
1622    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
1623    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
1624
1625  END SUBROUTINE CMLATX39SP
1626
1627
1628  ! -------------------------------------------------
1629  ! 1. adds DP xFract, yFract, zFract to start tag
1630  ! -------------------------------------------------
1631
1632  SUBROUTINE CMLATXF9DP(xf, xFract, yFract, zFract, fmt)
1633    implicit none
1634    type(xmlf_t) :: xf
1635    real(kind=dp), intent(in)     :: xFract, yFract, zFract ! coordinates
1636    character(len=*), intent(in) :: fmt                    ! format (default '(f8.3)')
1637
1638    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
1639    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
1640    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
1641
1642  END SUBROUTINE CMLATXF9DP
1643 
1644  ! -------------------------------------------------
1645  ! 2. adds SP xfrac, yFractractrac, zFractrac to start tag
1646  ! -------------------------------------------------
1647 
1648  SUBROUTINE CMLATXF9SP(xf, xFract, yFract, zFract, fmt)
1649    implicit none
1650    type(xmlf_t) :: xf
1651    real(kind=sp)     :: xFract, yFract, zFract   ! fractional coordinates
1652    character(len=*) :: fmt                      ! format (default '(f8.3)')
1653
1654    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
1655    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
1656    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
1657
1658  END SUBROUTINE CMLATXF9SP
1659
1660
1661  ! -------------------------------------------------
1662  ! 1. adds DP x2, y2 to start tag
1663  ! -------------------------------------------------
1664
1665  SUBROUTINE CMLATXY9DP(xf, x2, y2, fmt)
1666    implicit none
1667    type(xmlf_t) :: xf
1668    real(kind=dp)     :: x2, y2   ! coordinates
1669    character(len=*) :: fmt      ! format (default f8.3)
1670
1671    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
1672    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
1673    call xml_AddPcdata(xf, '>')                   !!! AG****
1674
1675  END SUBROUTINE CMLATXY9DP
1676
1677  ! -------------------------------------------------
1678  ! 2. adds SP x2, y2 to start tag
1679  ! -------------------------------------------------
1680
1681  SUBROUTINE CMLATXY9SP(xf, x2, y2, fmt)
1682    implicit none
1683    type(xmlf_t) :: xf
1684    real(kind=sp)     :: x2, y2   ! coordinates
1685    character(len=*) :: fmt      ! format (default f8.3)
1686
1687    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
1688    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
1689    call xml_AddPcdata(xf, '>')                      !!AG***
1690
1691  END SUBROUTINE CMLATXY9SP
1692
1693
1694  ! -------------------------------------------------
1695  ! 1. creates a DP <length> element
1696  ! -------------------------------------------------
1697
1698  SUBROUTINE CMLLEN9DP(xf, id, atomRef1, atomRef2, length, fmt)
1699    implicit none
1700    type(xmlf_t) :: xf
1701    character(len=*) :: id           ! length id
1702    character(len=*) :: atomRef1     ! ref to first atom
1703    character(len=*) :: atomRef2     ! ref to second atom
1704    real(kind=dp)     :: length       ! the length
1705    character(len=*) :: fmt          ! format
1706    character(len=20) :: temp
1707
1708    temp = atomRef1//' '//adjustl(atomRef2)
1709
1710    call xml_NewElement(xf, 'length')
1711    call xml_AddAttribute(xf, 'id', id)
1712    call xml_AddAttribute(xf, 'atomRefs2', temp)
1713    call xml_AddPcdata(xf, str(length, fmt))
1714    call xml_EndElement(xf, 'length')
1715
1716  END SUBROUTINE CMLLEN9DP
1717 
1718  ! -------------------------------------------------
1719  ! 2. creates a SP <length> element
1720  ! -------------------------------------------------
1721 
1722  SUBROUTINE CMLLEN9SP(xf, id, atomRef1, atomRef2, length, fmt)
1723    implicit none
1724    type(xmlf_t) :: xf
1725    character(len=*) :: id           ! length id
1726    character(len=*) :: atomRef1     ! ref to first atom
1727    character(len=*) :: atomRef2     ! ref to second atom
1728    real(kind=sp)     :: length       ! the length
1729    character(len=*) :: fmt          ! format
1730    character(len=20) :: temp
1731
1732    temp = atomRef1//' '//adjustl(atomRef2)
1733
1734    call xml_NewElement(xf, 'length')
1735    call xml_AddAttribute(xf, 'id', id)
1736    call xml_AddAttribute(xf, 'atomRefs2', temp)
1737    call xml_AddPcdata(xf, str(length, fmt))
1738    call xml_EndElement(xf, 'length')
1739
1740  END SUBROUTINE CMLLEN9SP
1741
1742
1743  ! -------------------------------------------------
1744  ! 1. creates a DP <angle> element
1745  ! -------------------------------------------------
1746
1747  SUBROUTINE CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
1748    implicit none
1749    type(xmlf_t) :: xf
1750    character(len=*) :: id              ! angle id
1751    character(len=*) :: atomRef1        ! ref to first atom
1752    character(len=*) :: atomRef2        ! ref to second atom
1753    character(len=*) :: atomRef3        ! ref to third atom
1754    real(kind=dp)     :: angle           ! the angle
1755    character(len=*) :: fmt             ! format
1756    character(len=20) :: temp
1757
1758    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
1759
1760    call xml_NewElement(xf, 'angle')
1761    call xml_AddAttribute(xf, 'id', id)
1762    call xml_AddAttribute(xf, 'atomRefs3', temp)
1763    call xml_AddPcdata(xf, str(angle, fmt))
1764    call xml_EndElement(xf, 'angle')
1765
1766  END SUBROUTINE CMLANG9DP
1767
1768  ! -------------------------------------------------
1769  ! 2. creates a SP <angle> element
1770  ! -------------------------------------------------
1771
1772  SUBROUTINE CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
1773    implicit none
1774    type(xmlf_t) :: xf
1775    character(len=*) :: id              ! angle id
1776    character(len=*) :: atomRef1        ! ref to first atom
1777    character(len=*) :: atomRef2        ! ref to second atom
1778    character(len=*) :: atomRef3        ! ref to third atom
1779    real(kind=sp)     :: angle           ! the angle
1780    character(len=*) :: fmt             ! format
1781    character(len=20) :: temp
1782
1783    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
1784
1785    call xml_NewElement(xf, 'angle')
1786    call xml_AddAttribute(xf, 'id', id)
1787    call xml_AddAttribute(xf, 'atomRefs3', temp)
1788    call xml_AddPcdata(xf, str(angle, fmt))
1789    call xml_EndElement(xf, 'angle')
1790
1791  END SUBROUTINE CMLANG9SP
1792
1793
1794  ! -------------------------------------------------
1795  ! 1. creates a DP <torsion> element
1796  ! -------------------------------------------------
1797 
1798  SUBROUTINE CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
1799    implicit none
1800    type(xmlf_t) :: xf
1801    character(len=*) :: id              ! torsion id
1802    character(len=*) :: atomRef1        ! ref to first atom
1803    character(len=*) :: atomRef2        ! ref to second atom
1804    character(len=*) :: atomRef3        ! ref to third atom
1805    character(len=*) :: atomRef4        ! ref to fourth atom
1806    real(kind=dp)     :: torsion         ! the torsion
1807    character(len=*) :: fmt             ! format
1808    character(len=20) :: temp
1809
1810    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
1811
1812    call xml_NewElement(xf, 'torsion')
1813    call xml_AddAttribute(xf, 'id', id)
1814    call xml_AddAttribute(xf, 'atomRefs4', temp)
1815    call xml_AddPcdata(xf, str(torsion, fmt))
1816    call xml_EndElement(xf, 'torsion')
1817
1818  END SUBROUTINE CMLTOR9DP
1819
1820  ! -------------------------------------------------
1821  ! 2. creates a SP <torsion> element
1822  ! -------------------------------------------------
1823
1824  SUBROUTINE CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
1825    implicit none
1826    type(xmlf_t) :: xf
1827    character(len=*) :: id              ! torsion id
1828    character(len=*) :: atomRef1        ! ref to first atom
1829    character(len=*) :: atomRef2        ! ref to second atom
1830    character(len=*) :: atomRef3        ! ref to third atom
1831    character(len=*) :: atomRef4        ! ref to fourth atom
1832    real(kind=sp)     :: torsion         ! the torsion
1833    character(len=*) :: fmt             ! format
1834    character(len=20) :: temp
1835
1836    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
1837
1838    call xml_NewElement(xf, 'torsion')
1839    call xml_AddAttribute(xf, 'id', id)
1840    call xml_AddAttribute(xf, 'atomRefs4', temp)
1841    call xml_AddPcdata(xf, str(torsion, fmt))
1842    call xml_EndElement(xf, 'torsion')
1843
1844  END SUBROUTINE CMLTOR9SP
1845
1846end module m_cmlw
Note: See TracBrowser for help on using the repository browser.