xmlOutput.F90 18.6 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
MODULE m_xmlOutput

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!!   XML output service routines
!!!
!!!   This module provides several subroutines that simplify the
!!!   generation of the out.xml file.
!!!                                         GM'16
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   IMPLICIT NONE

15
   PRIVATE
16 17 18 19 20
   INTEGER, SAVE :: currentElementIndex
   INTEGER, SAVE :: maxNumElements
   INTEGER, SAVE :: xmlOutputUnit
   CHARACTER(LEN= 40), ALLOCATABLE :: elementList(:)

Gregor Michalicek's avatar
Gregor Michalicek committed
21 22 23
   PUBLIC startXMLOutput, endXMLOutput
   PUBLIC writeXMLElementFormPoly, writeXMLElementPoly
   PUBLIC writeXMLElementForm, writeXMLElement
24 25 26
   PUBLIC openXMLElementFormPoly, openXMLElementPoly
   PUBLIC openXMLElementForm, openXMLElement
   PUBLIC openXMLElementNoAttributes, closeXMLElement
27
   PUBLIC getXMLOutputUnitNumber, isCurrentXMLElement
28

29 30
   CONTAINS

31 32 33 34 35 36
   FUNCTION getXMLOutputUnitNumber()
      IMPLICIT NONE
      INTEGER getXMLOutputUnitNumber
      getXMLOutputUnitNumber = xmlOutputUnit
   END FUNCTION getXMLOutputUnitNumber

37
   SUBROUTINE startXMLOutput()
38

39 40
      USE m_constants

41
      IMPLICIT NONE
42

43 44 45 46
#ifdef CPP_MPI
      include "mpif.h"
      INTEGER::err,isize
#endif
47 48
      CHARACTER(LEN=8)  :: date
      CHARACTER(LEN=10) :: time
49
      CHARACTER(LEN=10)  :: zone
50
      CHARACTER(LEN=10) :: dateString
51
      CHARACTER(LEN=10)  :: timeString
52

53 54 55 56 57
      maxNumElements = 10
      ALLOCATE(elementList(maxNumElements))
      elementList = ''
      currentElementIndex = 0
      xmlOutputUnit = 53
58 59 60
      CALL DATE_AND_TIME(date,time,zone)
      WRITE(dateString,'(a4,a1,a2,a1,a2)') date(1:4),'/',date(5:6),'/',date(7:8)
      WRITE(timeString,'(a2,a1,a2,a1,a2)') time(1:2),':',time(3:4),':',time(5:6)
61 62 63
      OPEN (xmlOutputUnit,file='out.xml',form='formatted',status='unknown')
      WRITE (xmlOutputUnit,'(a)') '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'
      WRITE (xmlOutputUnit,'(a)') '<fleurOutput fleurOutputVersion="0.27">'
64
      CALL writeXMLElement('programVersion',(/'version'/),(/version_const/))
65 66 67 68
#ifdef CPP_MPI
      CALL MPI_COMM_SIZE(MPI_COMM_WORLD,isize,err)
      CALL writeXMLElementPoly('parallelizationParameters',(/'mpiPEs'/),(/isize/))
#endif
69
      CALL writeXMLElement('startDateAndTime',(/'date','time','zone'/),(/dateString,timeString,zone/))
70 71 72
   END SUBROUTINE startXMLOutput

   SUBROUTINE endXMLOutput()
73

74
      IMPLICIT NONE
75 76 77

      CHARACTER(LEN=8)  :: date
      CHARACTER(LEN=10) :: time
78
      CHARACTER(LEN=10)  :: zone
79
      CHARACTER(LEN=10) :: dateString
80
      CHARACTER(LEN=10)  :: timeString
81

82 83 84 85
      DO WHILE (currentElementIndex.NE.0)
         CALL closeXMLElement(elementList(currentElementIndex))
      END DO
      DEALLOCATE(elementList)
86 87 88 89
      CALL DATE_AND_TIME(date,time,zone)
      WRITE(dateString,'(a4,a1,a2,a1,a2)') date(1:4),'/',date(5:6),'/',date(7:8)
      WRITE(timeString,'(a2,a1,a2,a1,a2)') time(1:2),':',time(3:4),':',time(5:6)
      CALL writeXMLElement('endDateAndTime',(/'date','time','zone'/),(/dateString,timeString,zone/))
90 91 92 93
      WRITE (xmlOutputUnit,'(a)') '</fleurOutput>'
      CLOSE(xmlOutputUnit)
   END SUBROUTINE endXMLOutput

Gregor Michalicek's avatar
Gregor Michalicek committed
94
   SUBROUTINE writeXMLElementFormPoly(elementName,attributeNames,attributeValues,lengths,contentList)
95 96 97

      IMPLICIT NONE

Gregor Michalicek's avatar
Gregor Michalicek committed
98 99 100 101 102
      CHARACTER(LEN=*), INTENT(IN)           :: elementName
      CHARACTER(LEN=*), INTENT(IN)           :: attributeNames(:)
      CLASS(*),         INTENT(IN)           :: attributeValues(:)
      INTEGER,          INTENT(IN)           :: lengths(:,:)
      CLASS(*),         INTENT(IN), OPTIONAL :: contentList(:)
103 104 105 106 107 108

      CHARACTER(LEN= 30), ALLOCATABLE :: charAttributeValues(:)
      CHARACTER(LEN= 30), ALLOCATABLE :: charContentList(:)
      INTEGER                         :: i

      ALLOCATE(charAttributeValues(SIZE(attributeValues)))
Gregor Michalicek's avatar
Gregor Michalicek committed
109 110
      IF (PRESENT(contentList)) THEN
         ALLOCATE(charContentList(SIZE(contentList)))
111 112
      ELSE
         ALLOCATE(charContentList(1))
Gregor Michalicek's avatar
Gregor Michalicek committed
113
      END IF
114 115 116 117 118 119

      charAttributeValues = ''
      charContentList = ''

      DO i = 1, SIZE(attributeValues)
         SELECT TYPE (attributeValues)
120
           TYPE IS(INTEGER)
121
               WRITE(charAttributeValues(i),'(i0)') attributeValues(i)
122
            TYPE IS(REAL)
123
               WRITE(charAttributeValues(i),'(f19.10)') attributeValues(i)
124
            TYPE IS(LOGICAL)
125
               WRITE(charAttributeValues(i),'(l1)') attributeValues(i)
126
#ifndef __PGI
127
            TYPE IS(CHARACTER(LEN=*))
128
               WRITE(charAttributeValues(i),'(a)') TRIM(ADJUSTL(attributeValues(i)))
129 130
            CLASS DEFAULT
               STOP 'Type of attributeValues not allowed'
131
#endif
132 133 134
         END SELECT
      END DO

Gregor Michalicek's avatar
Gregor Michalicek committed
135 136 137 138
      IF (PRESENT(contentList)) THEN
         DO i = 1, SIZE(contentList)
            SELECT TYPE(contentList)
               TYPE IS(INTEGER)
139
                  WRITE(charContentList(i),'(i0)') contentList(i)
Gregor Michalicek's avatar
Gregor Michalicek committed
140
               TYPE IS(REAL)
141
                  WRITE(charContentList(i),'(f19.10)') contentList(i)
Gregor Michalicek's avatar
Gregor Michalicek committed
142
               TYPE IS(LOGICAL)
143
                  WRITE(charContentList(i),'(l1)') contentList(i)
144
#ifndef __PGI
145
               TYPE IS(CHARACTER(LEN=*))
146
                  WRITE(charContentList(i),'(a)') TRIM(ADJUSTL(contentList(i)))
Gregor Michalicek's avatar
Gregor Michalicek committed
147 148
               CLASS DEFAULT
                  STOP 'Type of contentList not allowed'
149
#endif
Gregor Michalicek's avatar
Gregor Michalicek committed
150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167
            END SELECT
         END DO
         CALL writeXMLElementForm(elementName,attributeNames,charAttributeValues,lengths,charContentList)
         DEALLOCATE(charContentList,charAttributeValues)
      ELSE
         CALL writeXMLElementForm(elementName,attributeNames,charAttributeValues,lengths)
      END IF

   END SUBROUTINE writeXMLElementFormPoly

   SUBROUTINE writeXMLElementPoly(elementName,attributeNames,attributeValues,contentList)

      IMPLICIT NONE

      CHARACTER(LEN=*), INTENT(IN)           :: elementName
      CHARACTER(LEN=*), INTENT(IN)           :: attributeNames(:)
      CLASS(*),         INTENT(IN)           :: attributeValues(:)
      CLASS(*),         INTENT(IN), OPTIONAL :: contentList(:)
168

Gregor Michalicek's avatar
Gregor Michalicek committed
169 170
      INTEGER, ALLOCATABLE :: lengths(:,:)
      INTEGER              :: contentListSize
171

Gregor Michalicek's avatar
Gregor Michalicek committed
172 173 174 175 176 177 178 179 180
      contentListSize = 0
      IF (PRESENT(contentList)) THEN
         contentListSize = SIZE(contentList)
      END IF

      ALLOCATE(lengths(MAX(SIZE(attributeNames),contentListSize),3))
      lengths = 0
      CALL writeXMLElementFormPoly(elementName,attributeNames,attributeValues,lengths,contentList)
      DEALLOCATE(lengths)
181

182 183
   END SUBROUTINE writeXMLElementPoly

Gregor Michalicek's avatar
Gregor Michalicek committed
184
   SUBROUTINE writeXMLElementForm(elementName,attributeNames,attributeValues,lengths,contentList)
185 186 187

      IMPLICIT NONE

Gregor Michalicek's avatar
Gregor Michalicek committed
188 189 190 191 192
      CHARACTER(LEN=*), INTENT(IN)           :: elementName
      CHARACTER(LEN=*), INTENT(IN)           :: attributeNames(:)
      CHARACTER(LEN=*), INTENT(IN)           :: attributeValues(:)
      INTEGER,          INTENT(IN)           :: lengths(:,:)
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: contentList(:)
193 194

      CHARACTER(LEN=200), ALLOCATABLE :: contentLineList(:)
Gregor Michalicek's avatar
Gregor Michalicek committed
195 196
      INTEGER, ALLOCATABLE            :: bigLengths(:,:)
      INTEGER :: i, j, contentLineLength, contentLineListSize
197 198
      CHARACTER(LEN=70)               :: format
      CHARACTER(LEN=200)              :: outputString
199
      INTEGER                         :: contentListSize, overallListSize, numContentLineChars
Gregor Michalicek's avatar
Gregor Michalicek committed
200
      INTEGER                         :: lengthsShape(2)
201 202 203 204 205 206

      IF(SIZE(attributeNames).NE.SIZE(attributeValues)) THEN
         WRITE(*,*) 'attributeNames', attributeNames
         WRITE(*,*) 'attributeValues', attributeValues
         STOP 'ERROR: SIZE(attributeNames).NE.SIZE(attributeValues)'
      END IF
Gregor Michalicek's avatar
Gregor Michalicek committed
207 208 209 210 211

      lengthsShape = SHAPE(lengths)
      contentListSize = 0
      IF (PRESENT(contentList)) THEN
         contentListSize = SIZE(contentList)
212
      END IF
Gregor Michalicek's avatar
Gregor Michalicek committed
213 214 215 216 217 218 219 220 221
      overallListSize = MAX(SIZE(attributeNames),contentListSize)
      ALLOCATE(bigLengths(overallListSize,2))
      bigLengths = 0
      DO j = 1, 2
         DO i = 1, MIN(overallListSize,lengthsShape(1))
            bigLengths(i,j) = lengths(i,j)
         END DO
      END DO

222 223
      outputString = '<'//TRIM(ADJUSTL(elementName))
      DO i = 1, SIZE(attributeNames)
Gregor Michalicek's avatar
Gregor Michalicek committed
224 225 226 227 228 229 230
         WRITE(format,'(a)') "(a,a,a"
         IF (bigLengths(i,1).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,1)
         WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a,a"
         IF (bigLengths(i,2).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,2)
         WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a)"
         WRITE(outputString,format) TRIM(ADJUSTL(outputString)), ' ', TRIM(ADJUSTL(attributeNames(i))),&
                                    '="', TRIM(ADJUSTL(attributeValues(i))), '"'
231
      END DO
232
      WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+1),",a)"
Gregor Michalicek's avatar
Gregor Michalicek committed
233 234 235 236 237 238 239 240 241
      IF (PRESENT(contentList)) THEN
         contentLineLength = 5 ! At most 5 data elements per line
         contentLineListSize = SIZE(contentList) / contentLineLength
         IF(contentLineListSize*contentLineLength.NE.SIZE(contentList)) THEN
            contentLineListSize = contentLineListSize + 1
         END IF
         ALLOCATE(contentLineList(contentLineListSize))
         CALL fillContentLineList(contentList,contentLineList,contentLineLength)
         IF(SIZE(contentLineList).LE.1) THEN
242 243
            outputString = TRIM(ADJUSTL(outputString))//'>'//contentLineList(1)//'</'//&
                 TRIM(ADJUSTL(elementName))//'>'
Gregor Michalicek's avatar
Gregor Michalicek committed
244 245 246
         ELSE
            outputString = TRIM(ADJUSTL(outputString))//'>'
         END IF
247
         WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
Gregor Michalicek's avatar
Gregor Michalicek committed
248 249
         IF(SIZE(contentLineList).GT.1) THEN
            DO i = 1, SIZE(contentLineList)
250 251 252 253 254 255 256
               IF (i.EQ.SIZE(contentLineList)) THEN
                  numContentLineChars = 20*MOD(SIZE(contentList),contentLineLength)
                  IF(numContentLineChars.EQ.0) numContentLineChars = 20 * contentLineLength
                  WRITE(format,'(a,i0,a,i0,a)') "(a",3*(currentElementIndex+2),",a",numContentLineChars,")"
               ELSE
                  WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+2),",a100)"
               END IF
Gregor Michalicek's avatar
Gregor Michalicek committed
257 258 259 260 261 262 263 264 265 266 267
               WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(contentLineList(i)))
            END DO
            WRITE(format,'(a,i0,a)') "(a",3*(currentElementIndex+1),",a)"
            outputString = '</'//TRIM(ADJUSTL(elementName))//'>'
            WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
         END IF
      ELSE
         outputString = TRIM(ADJUSTL(outputString))//'/>'
         WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(outputString))
      END IF
      DEALLOCATE (bigLengths)
268

Gregor Michalicek's avatar
Gregor Michalicek committed
269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285
   END SUBROUTINE writeXMLElementForm

   SUBROUTINE writeXMLElement(elementName,attributeNames,attributeValues,contentList)

      IMPLICIT NONE

      CHARACTER(LEN=*), INTENT(IN)           :: elementName
      CHARACTER(LEN=*), INTENT(IN)           :: attributeNames(:)
      CHARACTER(LEN=*), INTENT(IN)           :: attributeValues(:)
      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: contentList(:)

      INTEGER, ALLOCATABLE :: lengths(:,:)
      INTEGER              :: contentListSize

      contentListSize = 0
      IF (PRESENT(contentList)) THEN
         contentListSize = SIZE(contentList)
286
      END IF
Gregor Michalicek's avatar
Gregor Michalicek committed
287 288 289 290 291

      ALLOCATE(lengths(MAX(SIZE(attributeNames),contentListSize),2))
      lengths = 0
      CALL writeXMLElementForm(elementName,attributeNames,attributeValues,lengths,contentList)
      DEALLOCATE(lengths)
292

293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
   END SUBROUTINE writeXMLElement

   SUBROUTINE fillContentLineList(contentList,contentLineList,contentLineLength)

      IMPLICIT NONE

      CHARACTER(LEN= 30), INTENT(IN)    :: contentList(:)
      CHARACTER(LEN=200), INTENT(INOUT) :: contentLineList(:)
      INTEGER,            INTENT(IN)    :: contentLineLength
      INTEGER :: i, j

      contentLineList = ''
      DO i = 1, SIZE(contentLineList)
         DO j = 1, contentLineLength
            IF((i-1)*contentLineLength+j.GT.SIZE(contentList)) THEN
               RETURN
            END IF
310 311
            WRITE(contentLineList(i),'(a,a20)') TRIM(ADJUSTL(contentLineList(i))),&
                        TRIM(ADJUSTL(contentList((i-1)*contentLineLength+j)))
312 313 314 315 316 317 318 319
         END DO
      END DO
   END SUBROUTINE fillContentLineList

   SUBROUTINE openXMLElementPoly(elementName,attributeNames,attributeValues)

      IMPLICIT NONE

320 321 322
      CHARACTER(LEN=*)             :: elementName
      CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
      CLASS(*),         INTENT(IN) :: attributeValues(:)
323

324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341
      INTEGER, ALLOCATABLE :: lengths(:,:)

      ALLOCATE(lengths(SIZE(attributeNames),2))
      lengths = 0
      CALL openXMLElementFormPoly(elementName,attributeNames,attributeValues,lengths)
      DEALLOCATE(lengths)

   END SUBROUTINE openXMLElementPoly

   SUBROUTINE openXMLElementFormPoly(elementName,attributeNames,attributeValues,lengths)

      IMPLICIT NONE

      CHARACTER(LEN=*)             :: elementName
      CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
      CLASS(*),         INTENT(IN) :: attributeValues(:)
      INTEGER,          INTENT(IN) :: lengths(:,:)

342 343 344 345 346 347 348 349 350 351
      CHARACTER(LEN= 30), ALLOCATABLE :: charAttributeValues(:)
      INTEGER                         :: i

      ALLOCATE(charAttributeValues(SIZE(attributeValues)))

      charAttributeValues = ''

      DO i = 1, SIZE(attributeValues)
         SELECT TYPE (attributeValues)
            TYPE IS(INTEGER)
352
               WRITE(charAttributeValues(i),'(i0)') attributeValues(i)
353
            TYPE IS(REAL)
354
               WRITE(charAttributeValues(i),'(f19.10)') attributeValues(i)
355
            TYPE IS(LOGICAL)
356
               WRITE(charAttributeValues(i),'(l1)') attributeValues(i)
357
#ifndef __PGI
358
            TYPE IS(CHARACTER(LEN=*))
359
               WRITE(charAttributeValues(i),'(a)') TRIM(ADJUSTL(attributeValues(i)))
360 361
            CLASS DEFAULT
               STOP 'Type of attributeValues not allowed'
362
#endif
363 364 365
         END SELECT
      END DO

366
      CALL openXMLElementForm(elementName,attributeNames,charAttributeValues,lengths)
367 368
      DEALLOCATE(charAttributeValues)

369
   END SUBROUTINE openXMLElementFormPoly
370

371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389
   SUBROUTINE openXMLElementNoAttributes(elementName)

      IMPLICIT NONE

      CHARACTER(LEN=*)             :: elementName

      INTEGER :: i
      CHARACTER(LEN=70)  :: format
      CHARACTER(LEN=200) :: openingString

      IF(currentElementIndex.EQ.maxNumElements) THEN
         WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
         STOP 'ERROR: xml hierarchy too deep!'
      END IF
      currentElementIndex = currentElementIndex + 1
      elementList(currentElementIndex) = TRIM(ADJUSTL(elementName))
      openingString = '<'//TRIM(ADJUSTL(elementName))//'>'
      WRITE(format,'(a,i0,a)') "(a",3*currentElementIndex,",a)"
      WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(openingString))
390

391 392
   END SUBROUTINE openXMLElementNoAttributes

393 394 395 396
   SUBROUTINE openXMLElement(elementName,attributeNames,attributeValues)

      IMPLICIT NONE

397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413
      CHARACTER(LEN=*), INTENT(IN)           :: elementName
      CHARACTER(LEN=*), INTENT(IN)           :: attributeNames(:)
      CHARACTER(LEN=*), INTENT(IN)           :: attributeValues(:)

      INTEGER, ALLOCATABLE :: lengths(:,:)

      ALLOCATE(lengths(SIZE(attributeNames),2))
      lengths = 0
      CALL openXMLElementForm(elementName,attributeNames,attributeValues,lengths)
      DEALLOCATE(lengths)

   END SUBROUTINE

   SUBROUTINE openXMLElementForm(elementName,attributeNames,attributeValues,lengths)

      IMPLICIT NONE

414 415 416
      CHARACTER(LEN=*)             :: elementName
      CHARACTER(LEN=*), INTENT(IN) :: attributeNames(:)
      CHARACTER(LEN=*), INTENT(IN) :: attributeValues(:)
417
      INTEGER,          INTENT(IN) :: lengths(:,:)
418 419 420 421

      CHARACTER(LEN=70)  :: format
      CHARACTER(LEN=200) :: openingString

422 423 424 425 426
      INTEGER, ALLOCATABLE            :: bigLengths(:,:)
      INTEGER                         :: i, j
      INTEGER                         :: overallListSize
      INTEGER                         :: lengthsShape(2)

427 428 429 430 431 432 433 434 435 436 437 438
      IF(SIZE(attributeNames).NE.SIZE(attributeValues)) THEN
         WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
         WRITE(*,*) 'attributeNames', attributeNames
         WRITE(*,*) 'attributeValues', attributeValues
         STOP 'ERROR: SIZE(attributeNames).NE.SIZE(attributeValues)'
      END IF
      IF(currentElementIndex.EQ.maxNumElements) THEN
         WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
         WRITE(*,*) 'attributeNames', attributeNames
         WRITE(*,*) 'attributeValues', attributeValues
         STOP 'ERROR: xml hierarchy too deep!'
      END IF
439 440 441 442 443 444 445 446 447 448 449

      lengthsShape = SHAPE(lengths)
      overallListSize = SIZE(attributeNames)
      ALLOCATE(bigLengths(overallListSize,2))
      bigLengths = 0
      DO j = 1, 2
         DO i = 1, MIN(overallListSize,lengthsShape(1))
            bigLengths(i,j) = lengths(i,j)
         END DO
      END DO

450 451
      openingString = '<'//TRIM(ADJUSTL(elementName))
      DO i = 1, SIZE(attributeNames)
452 453 454 455 456 457 458
         WRITE(format,'(a)') "(a,a,a"
         IF (bigLengths(i,1).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,1)
         WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a,a"
         IF (bigLengths(i,2).GT.0) WRITE(format,'(a,i0)') TRIM(ADJUSTL(format)),bigLengths(i,2)
         WRITE(format,'(a,a)') TRIM(ADJUSTL(format)),",a)"
         WRITE(openingString,format) TRIM(ADJUSTL(openingString)), ' ', TRIM(ADJUSTL(attributeNames(i))),&
                                    '="', TRIM(ADJUSTL(attributeValues(i))), '"'
459 460
      END DO
      openingString = TRIM(ADJUSTL(openingString))//'>'
461 462 463

      currentElementIndex = currentElementIndex + 1
      elementList(currentElementIndex) = TRIM(ADJUSTL(elementName))
464
      WRITE(format,'(a,i0,a)') "(a",3*currentElementIndex,",a)"
465
      WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(openingString))
466 467 468
      DEALLOCATE (bigLengths)

   END SUBROUTINE openXMLElementForm
469 470 471 472 473 474 475 476 477 478 479 480 481 482 483

   SUBROUTINE closeXMLElement(elementName)

      IMPLICIT NONE

      CHARACTER(LEN=*), INTENT(IN) :: elementName
      INTEGER :: i
      CHARACTER(LEN=70) :: format
      CHARACTER(LEN=70) :: closingString

      IF(TRIM(ADJUSTL(elementList(currentElementIndex))).NE.TRIM(ADJUSTL(elementName))) THEN
         WRITE(*,*) 'elementList(currentElementIndex):', TRIM(ADJUSTL(elementList(currentElementIndex)))
         WRITE(*,*) 'elementName', TRIM(ADJUSTL(elementName))
         STOP 'ERROR: Closing xml element inconsistency!'
      END IF
484 485
      closingString = '</'//TRIM(ADJUSTL(elementName))//'>'
      WRITE(format,'(a,i0,a)') "(a",3*currentElementIndex,",a)"
486 487
      WRITE(xmlOutputUnit,format) ' ', TRIM(ADJUSTL(closingString))
      currentElementIndex = currentElementIndex - 1
488

489 490
   END SUBROUTINE closeXMLElement

491 492 493 494 495 496 497 498 499 500
   LOGICAL FUNCTION isCurrentXMLElement(elementName)

      IMPLICIT NONE

      CHARACTER(LEN=*), INTENT(IN) :: elementName

      isCurrentXMLElement = (TRIM(ADJUSTL(elementList(currentElementIndex))).EQ.TRIM(ADJUSTL(elementName)))

   END FUNCTION isCurrentXMLElement

501
END MODULE m_xmlOutput