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_stmw.f90 in vendors/XMLF90/current/src/cml – NEMO

source: vendors/XMLF90/current/src/cml/m_stmw.f90 @ 1963

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

importing XMLF90 r_53 vendor

File size: 34.9 KB
Line 
1module m_stmw
2
3  use flib_wxml
4
5  private
6
7  integer, private, parameter ::  sp = selected_real_kind(6,30)
8  integer, private, parameter ::  dp = selected_real_kind(14,100)
9
10!  TYPE(xmlf_t), save,  :: xf
11
12  PUBLIC :: stmAddScalar
13  PUBLIC :: stmAddArray
14  PUBLIC :: stmAddMatrix
15  PUBLIC :: stmAddTriangle
16  PUBLIC :: stmAddStartTag
17
18  INTERFACE stmAddScalar
19     MODULE PROCEDURE stmAddString, stmAddInteger, stmAddFloatSP, stmAddFloatDP
20  END INTERFACE
21
22  INTERFACE stmAddArray
23     MODULE PROCEDURE stmAddFloatArraySP, stmAddFloatArrayDP, stmAddStringArray, &
24                      stmAddIntegerArray
25  END INTERFACE
26
27  INTERFACE stmAddMatrix
28     MODULE PROCEDURE stmAddFloatMatrixSP, stmAddFloatMatrixDP, stmAddIntegerMatrix
29  END INTERFACE
30
31  INTERFACE stmAddTriangle
32     MODULE PROCEDURE stmAddTriangleSP, stmAddTriangleDP
33  END INTERFACE
34
35 
36CONTAINS
37 
38 
39  ! =================================================
40  ! STMML convenience routines
41  ! =================================================
42 
43  ! -------------------------------------------------
44  ! create STMML start tag in xml channel
45  ! -------------------------------------------------
46 
47  SUBROUTINE stmAddStartTag(xf, name, id, title, dictref, dataType, &
48       convention, errorValue, errorBasis, min, max, units)
49
50    implicit none
51    type(xmlf_t) :: xf
52    character(len=*), intent(in) :: name                   ! the element name
53    character(len=*), intent(in), optional :: id           ! the element id; if whitespace, is omitted
54    character(len=*), intent(in), optional :: title        ! the title; if whitespace, is omitted
55    character(len=*), intent(in), optional :: dictref      ! the dictionary reference; if whitespace, is omitted
56    character(len=*), intent(in), optional :: dataType 
57    character(len=*), intent(in), optional :: convention
58    character(len=*), intent(in), optional :: errorValue
59    character(len=*), intent(in), optional :: errorBasis
60    character(len=*), intent(in), optional :: min
61    character(len=*), intent(in), optional :: max
62    character(len=*), intent(in), optional :: units
63
64!    call XMLCHKN9(name)
65    call xml_NewElement(xf, name)
66    if (present(id))         call xml_AddAttribute(xf, 'id', id)
67    if (present(title))      call xml_AddAttribute(xf, 'title', title)
68    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
69    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
70    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
71    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
72    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
73    if (present(min))        call xml_AddAttribute(xf, 'min', min)
74    if (present(max))        call xml_AddAttribute(xf, 'max', max)
75    if (present(units))      call xml_AddAttribute(xf, 'units', units)
76
77  END SUBROUTINE stmAddStartTag
78
79
80  ! -------------------------------------------------
81  ! outputs STMML scalar in xml channel
82  ! -------------------------------------------------
83
84  SUBROUTINE stmAddString(xf, value, id, title, dictref, dataType, &
85       convention, errorValue, errorBasis, min, max, units)
86
87    implicit none
88    type(xmlf_t) :: xf
89    character(len=*), intent(in)           :: value         ! the value to be output
90    character(len=*), intent(in), optional :: id            ! the id
91    character(len=*), intent(in), optional :: title         ! the title
92    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
93    character(len=*), intent(in), optional :: dataType 
94    character(len=*), intent(in), optional :: convention
95    character(len=*), intent(in), optional :: errorValue
96    character(len=*), intent(in), optional :: errorBasis
97    character(len=*), intent(in), optional :: min
98    character(len=*), intent(in), optional :: max
99    character(len=*), intent(in), optional :: units
100
101    ! Internal variables
102    character(len=20) :: temp
103
104!    if (XMLCHKS9(value)) then
105    call xml_AddPcdata(xf, ' '//value)
106
107    call xml_NewElement(xf, 'scalar')
108    if (present(id))         call xml_AddAttribute(xf, 'id', id)
109    if (present(title))      call xml_AddAttribute(xf, 'title', title)
110    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
111    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
112    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
113    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
114    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
115    if (present(min))        call xml_AddAttribute(xf, 'min', min)
116    if (present(max))        call xml_AddAttribute(xf, 'max', max)
117    if (present(units))      call xml_AddAttribute(xf, 'units', units)
118    call xml_EndElement(xf, 'scalar')
119
120  END SUBROUTINE stmAddString
121
122
123  ! -------------------------------------------------
124  ! outputs STMML integer in xml channel
125  ! -------------------------------------------------
126
127  SUBROUTINE stmAddInteger(xf, value, id, title, dictref, dataType, &
128       convention, errorValue, errorBasis, min, max, units)
129
130    implicit none
131    type(xmlf_t) :: xf
132    integer, intent(in) :: value                           ! the value to be output
133    character(len=*), intent(in), optional :: id           ! the id
134    character(len=*), intent(in), optional :: title        ! the title
135    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
136    character(len=*), intent(in), optional :: dataType 
137    character(len=*), intent(in), optional :: convention
138    character(len=*), intent(in), optional :: errorValue
139    character(len=*), intent(in), optional :: errorBasis
140    character(len=*), intent(in), optional :: min
141    character(len=*), intent(in), optional :: max
142    character(len=*), intent(in), optional :: units        ! units (default = none)
143
144
145    ! Flush on entry and exit
146    call xml_NewElement(xf, 'scalar')
147    if (present(id))         call xml_AddAttribute(xf, 'id', id)
148    if (present(title))      call xml_AddAttribute(xf, 'dictRef', title)
149    if (present(dictref))    call xml_AddAttribute(xf, 'title', dictref)
150    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
151    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
152    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
153    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
154    if (present(min))        call xml_AddAttribute(xf, 'min', min)
155    if (present(max))        call xml_AddAttribute(xf, 'max', max)
156    if (present(units))      call xml_AddAttribute(xf, 'units', units)
157    call xml_AddPcdata(xf, str(value))
158    call xml_EndElement(xf, 'scalar')
159
160  END SUBROUTINE stmAddInteger
161
162
163  ! -------------------------------------------------
164  ! 1. create an STMML <scalar> DP float in xml channel
165  ! -------------------------------------------------
166
167  SUBROUTINE stmAddFloatDP(xf, value, id, title, dictref, dataType, &
168       convention, errorValue, errorBasis, min, max, units, fmt)
169
170    implicit none
171    type(xmlf_t) :: xf
172    real(kind=dp), intent(in)               :: value        ! the value to be output
173    character(len=*), intent(in), optional :: id           ! id
174    character(len=*), intent(in), optional :: title        ! the title
175    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
176    character(len=*), intent(in), optional :: dataType 
177    character(len=*), intent(in), optional :: convention
178    character(len=*), intent(in), optional :: errorValue
179    character(len=*), intent(in), optional :: errorBasis
180    character(len=*), intent(in), optional :: min
181    character(len=*), intent(in), optional :: max
182    character(len=*), intent(in), optional :: units        ! units
183    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
184
185    ! Internal Vaiable
186    character(len=10) :: formt
187
188    if (present(fmt)) then
189       formt = fmt
190    else
191       formt = '(f10.4)'
192    endif
193
194
195    ! Flushes on entry and exit
196    call xml_NewElement(xf, 'scalar')
197    if (present(id))         call xml_AddAttribute(xf, 'id', id)
198    if (present(title))      call xml_AddAttribute(xf, 'title', title)
199    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
200    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
201    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
202    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
203    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
204    if (present(min))        call xml_AddAttribute(xf, 'min', min)
205    if (present(max))        call xml_AddAttribute(xf, 'max', max)
206    if (present(units))      call xml_AddAttribute(xf, 'units', units)
207
208    call xml_AddPcdata(xf, str(value))
209    call xml_EndElement(xf, 'scalar')
210
211  END SUBROUTINE stmAddFloatDP
212
213  ! -------------------------------------------------
214  ! 2. create an STMML <scalar> SP float in xml channel
215  ! -------------------------------------------------
216
217  SUBROUTINE stmAddFloatSP(xf, value, id, title, dictref, dataType, &
218       convention, errorValue, errorBasis, min, max, units, fmt)
219
220    implicit none
221    type(xmlf_t) :: xf
222    real(kind=sp), intent(in)               :: value        ! the value to be output
223    character(len=*), intent(in), optional :: id           ! id
224    character(len=*), intent(in), optional :: title        ! the title
225    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
226    character(len=*), intent(in), optional :: units        ! units (' ' = none)
227    character(len=*), intent(in), optional :: dataType 
228    character(len=*), intent(in), optional :: convention
229    character(len=*), intent(in), optional :: errorValue
230    character(len=*), intent(in), optional :: errorBasis
231    character(len=*), intent(in), optional :: min
232    character(len=*), intent(in), optional :: max
233    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
234
235    ! Internal Variable
236    character(len=10) :: formt
237
238    if (present(fmt)) then
239       formt = fmt
240    else
241       formt = '(f10.4)'
242    endif
243
244    ! Flushes on entry and exit
245    call xml_NewElement(xf, 'scalar')
246    if (present(id))         call xml_AddAttribute(xf, 'id', id)
247    if (present(title))      call xml_AddAttribute(xf, 'dictRef', dictref)
248    if (present(dictref))    call xml_AddAttribute(xf, 'title', title)
249    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
250    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
251    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
252    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
253    if (present(min))        call xml_AddAttribute(xf, 'min', min)
254    if (present(max))        call xml_AddAttribute(xf, 'max', max)
255    if (present(units))      call xml_AddAttribute(xf, 'units', units)
256    call xml_AddPcdata(xf, str(value))
257    call xml_EndElement(xf, 'scalar')
258
259  END SUBROUTINE stmAddFloatSP
260
261
262  ! -------------------------------------------------
263  ! outputs string array to xml channel
264  ! -------------------------------------------------
265
266  SUBROUTINE stmAddStringArray(xf, nvalue, array, id, title, dictref, type, delim, ref)
267
268    implicit none
269    type(xmlf_t) :: xf
270    integer, intent(in)                    :: nvalue        ! number of values to be output
271    character(len=*), intent(in)           :: array(*)      ! the values to be output
272    character(len=*), intent(in), optional :: id            ! the id
273    character(len=*), intent(in), optional :: title         ! the title
274    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
275    character(len=*), intent(in), optional :: type          ! the dataType
276    character(len=*), intent(in), optional :: delim         ! delimiter
277    character(len=*), intent(in), optional :: ref           ! delimiter
278
279    ! splits data into lines whenever it overflows workspace/linelength
280    ! Flush on entry and exit
281    character(len=1) :: delim1
282    integer          :: i
283
284
285    if (present(delim)) then
286       delim1 = delim
287    else
288       delim1 = ' '
289    endif
290
291    call xml_NewElement(xf, 'array')
292    if (present(id))      call xml_AddAttribute(xf, 'id', id)
293    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
294    if (present(title))   call xml_AddAttribute(xf, 'title', title)
295    if (present(type))    call xml_AddAttribute(xf, 'type', type)
296    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
297    call xml_AddAttribute(xf, 'delimiter', delim1)
298    call xml_AddAttribute(xf, 'size', str(nvalue))
299
300    call xml_AddPcdata(xf, array(1))
301    do i = 2, nvalue
302       if (delim1 .eq. ' ') then
303          call xml_AddPcdata(xf, ' '//array(i))
304       else
305          call xml_AddPcdata(xf, delim1//array(i))
306       endif
307    enddo
308    call xml_EndElement(xf, 'array')
309
310  END SUBROUTINE stmAddStringArray
311
312
313  ! -------------------------------------------------
314  ! outputs integer array to xml channel
315  ! -------------------------------------------------
316
317  SUBROUTINE stmAddIntegerArray(xf, nvalue, array, id, title, dictref, ref, units)
318
319    implicit none
320    type(xmlf_t) :: xf
321    integer, intent(in)                    :: nvalue        ! the number of values to be output
322    integer, intent(in)                    :: array(*)      ! the values to be output
323    character(len=*), intent(in), optional :: id            ! the id
324    character(len=*), intent(in), optional :: title         ! the title
325    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
326    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
327    character(len=*), intent(in), optional :: ref           ! scienitific units (default ' ')
328
329    ! splits data into lines wherever it overflows the workspace
330    integer          :: i
331
332    ! Flush on entry and exit
333
334    call xml_NewElement(xf, 'array')
335    if (present(id))      call xml_AddAttribute(xf, 'id', id)
336    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
337    if (present(title))   call xml_AddAttribute(xf, 'title', title)
338    if (present(units))   call xml_AddAttribute(xf, 'units', units)
339    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
340    call xml_AddAttribute(xf, 'size', str(nvalue))
341
342
343    call xml_AddPcdata(xf, str(array(1)))
344    do i = 2, nvalue
345       call xml_AddPcdata(xf, str(array(i)))
346    enddo
347    call xml_EndElement(xf, 'array')
348   
349  END SUBROUTINE stmAddIntegerArray
350
351
352  ! -------------------------------------------------
353  ! 1. outputs DP float array to xml channel
354  ! -------------------------------------------------
355
356  SUBROUTINE stmAddFloatArrayDP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
357
358    implicit none
359    type(xmlf_t) :: xf
360    integer, intent(in)                    :: nvalue        ! number of values to be output
361    real(kind=dp), intent(in)               :: array(*)       ! the values to be output
362    character(len=*), intent(in), optional :: id            ! the id
363    character(len=*), intent(in), optional :: title         ! the title
364    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
365    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
366    character(len=*), intent(in), optional :: ref           !
367    character(len=*), intent(in), optional :: fmt           ! the output format
368
369    ! Internal Variable
370    character(len=10) :: formt
371
372    if (present(fmt)) then
373       formt = fmt
374    else
375       formt = '(f8.3)'
376    endif
377
378    ! splits data into lines whenever it overflows workspace/linelength
379    ! Flush on entry and exit
380
381    call xml_NewElement(xf, 'array')
382    if (present(id))      call xml_AddAttribute(xf, 'id', id)
383    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
384    if (present(title))   call xml_AddAttribute(xf, 'title', title)
385    if (present(units))   call xml_AddAttribute(xf, 'units', units)
386    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
387    call xml_AddAttribute(xf, 'size', str(nvalue))
388    call STMARCF9DP(xf, nvalue, array, fmt)
389    call xml_EndElement(xf, 'array')
390
391  END SUBROUTINE stmAddFloatArrayDP
392
393  ! -------------------------------------------------
394  ! 2. outputs SP float array to xml channel
395  ! -------------------------------------------------
396
397  SUBROUTINE stmAddFloatArraySP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
398
399    implicit none
400    type(xmlf_t) :: xf
401    integer, intent(in)                    :: nvalue        ! number of values to be output
402    real(kind=sp), intent(in)               :: array(*)       ! the values to be output
403    character(len=*), intent(in), optional :: id            ! the id
404    character(len=*), intent(in), optional :: title         ! the title
405    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
406    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
407    character(len=*), intent(in), optional :: fmt           ! the output format
408    character(len=*), intent(in), optional :: ref           ! the output format
409
410    ! Internal Variable
411    character(len=10) :: formt
412
413    if (present(fmt)) then
414       formt = fmt
415    else
416       formt = '(f8.3)'
417    endif
418
419    ! splits data into lines whenever it overflows workspace/linelength
420    ! Flush on entry and exit
421
422    call xml_NewElement(xf, 'array')
423    if (present(id))      call xml_AddAttribute(xf, 'id', id)
424    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
425    if (present(title))   call xml_AddAttribute(xf, 'title', title)
426    if (present(units))   call xml_AddAttribute(xf, 'units', units)
427    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
428    call xml_AddAttribute(xf, 'size', str(nvalue))
429    call STMARCF9SP(xf, nvalue, array, fmt)
430    call xml_EndElement(xf, 'array')
431
432  END SUBROUTINE stmAddFloatArraySP
433
434
435  ! -------------------------------------------------
436  ! outputs integer matrix to xml channel
437  ! -------------------------------------------------
438
439  SUBROUTINE stmAddIntegerMatrix(xf, nrows, ncols, dim, matrix, id, title, dictref, units)
440
441    implicit none
442    type(xmlf_t) :: xf
443    integer, intent(in)                    :: nrows         ! the number of rows to be output
444    integer, intent(in)                    :: ncols         ! the number of rows to be output
445    integer, intent(in)                    :: dim           ! the range of the fastest index
446    integer, intent(in)                    :: matrix(nrows,ncols) ! the values to be output
447    character(len=*), intent(in), optional :: id            ! the id
448    character(len=*), intent(in), optional :: title         ! the title
449    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
450    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
451
452    ! splits data into lines wherever it overflows the workspace
453    ! Flush on entry and exit
454    integer ::  i, j
455
456
457
458    call xml_NewElement(xf, 'matrix')
459    if (present(id))      call xml_AddAttribute(xf, 'id', id)
460    if (present(dictref))   call xml_AddAttribute(xf, 'dictRef', dictref)
461    if (present(title)) call xml_AddAttribute(xf, 'title', title)
462    if (present(units))   call xml_AddAttribute(xf, 'units', units)
463    call xml_AddAttribute(xf, 'cols', str(ncols))
464    call xml_AddAttribute(xf, 'rows', str(nrows))
465
466!
467!   Try addArray...
468!
469    do i = 1, ncols
470       do j = 1, nrows
471          call xml_AddPcdata(xf, str(matrix(j, i)))
472       enddo
473    enddo
474    call xml_EndElement(xf, 'matrix')
475
476  END SUBROUTINE stmAddIntegerMatrix
477
478
479  ! -------------------------------------------------
480  ! 1. outputs DP float matrix to xml channel
481  ! -------------------------------------------------
482
483  SUBROUTINE stmAddFloatMatrixDP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
484
485    implicit none
486    type(xmlf_t) :: xf
487    integer, intent(in)                    :: ncols                ! the number of cols to be output
488    integer, intent(in)                    :: nrows                ! the number of rows to be output
489    integer, intent(in)                    :: dim                  ! the range of the fastest index
490    real(kind=dp), intent(in)               :: matrix(ncols,nrows)  ! the values to be output
491    character(len=*), intent(in), optional :: id                   ! the id
492    character(len=*), intent(in), optional :: title                ! the title
493    character(len=*), intent(in), optional :: dictref              ! the dictionary reference
494    character(len=*), intent(in), optional :: units                ! scienitific units (default ' ')
495    character(len=*), intent(in), optional :: fmt                  ! format
496
497    ! internal variable
498    character(len=10) :: formt
499    integer ::  i, j
500
501    if (present(fmt)) then
502       formt = fmt
503    else
504       formt = '(f8.3)'
505    endif
506
507    ! splits data into lines wherever it overflows the workspace
508    ! Flush on entry and exit     
509    !-------------
510    call xml_NewElement(xf, 'matrix')
511    if (present(id))      call xml_AddAttribute(xf, 'id', id)
512    if (present(title))   call xml_AddAttribute(xf, 'title', title)
513    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
514    if (present(units))   call xml_AddAttribute(xf, 'units', units)
515    call xml_AddAttribute(xf, 'cols', str(ncols))
516    call xml_AddAttribute(xf, 'rows', str(nrows))
517    !-------------
518    do i = 1, nrows
519       do j = 1, ncols
520          !              write(*,*) ">>> 1", i, j
521          call xml_AddPcdata(xf, str(matrix(j, i)))
522       enddo
523    enddo
524    call xml_EndElement(xf, 'matrix')
525
526  END SUBROUTINE stmAddFloatMatrixDP
527
528  ! -------------------------------------------------
529  ! 2. outputs SP float matrix to xml channel
530  ! -------------------------------------------------
531
532  SUBROUTINE stmAddFloatMatrixSP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
533
534    implicit none
535    type(xmlf_t) :: xf
536    integer, intent(in)                    :: ncols               ! the number of cols to be output
537    integer, intent(in)                    :: nrows               ! the number of rows to be output
538    integer, intent(in)                    :: dim                 ! the range of the fastest index
539    real(kind=sp), intent(in)               :: matrix(ncols,nrows) ! the values to be output
540    character(len=*), intent(in), optional :: id                  ! the id
541    character(len=*), intent(in), optional :: title               ! the title
542    character(len=*), intent(in), optional :: dictref             ! the dictionary reference
543    character(len=*), intent(in), optional :: units               ! scienitific units (default ' ')
544    character(len=*), intent(in), optional :: fmt                 ! format
545
546    ! internal variable
547    character(len=10) :: formt
548    integer ::  i, j
549
550    if (present(fmt)) then
551       formt = fmt
552    else
553       formt = '(f8.3)'
554    endif
555
556    ! splits data into lines wherever it overflows the workspace
557    ! Flush on entry and exit     
558    !
559    call xml_NewElement(xf, 'matrix')
560    if (present(id))      call xml_AddAttribute(xf, 'id', id)
561    if (present(title))   call xml_AddAttribute(xf, 'title', title)
562    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
563    if (present(units))   call xml_AddAttribute(xf, 'units', units)
564    call xml_AddAttribute(xf, 'cols', str(ncols))
565    call xml_AddAttribute(xf, 'rows', str(nrows))
566    do i = 1, nrows
567       do j = 1, ncols
568          call xml_AddPcdata(xf, str(matrix(j, i)))
569       enddo
570    enddo
571    call xml_EndElement(xf, 'matrix')
572
573  END SUBROUTINE stmAddFloatMatrixSP
574
575
576  ! -------------------------------------------------
577  ! 1. outputs DP lower triangle array to xml channel
578  ! -------------------------------------------------
579
580  SUBROUTINE stmAddTriangleDP(xf, nvalue, array, id, title, dictref, units, fmt)
581
582    implicit none
583    type(xmlf_t) :: xf
584    integer, intent(in)                    :: nvalue         ! number of values to be output
585    real(kind=dp), intent(in)               :: array(*)        ! the values to be output
586    character(len=*), intent(in), optional :: id             ! the id
587    character(len=*), intent(in), optional :: title          ! the title
588    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
589    character(len=*), intent(in), optional :: units          ! units (' ' = none)
590    character(len=*), intent(in), optional :: fmt            ! the output format
591
592    ! splits data into lines whenever it overflows workspace/linelength
593    ! Flush on entry and exit
594    integer           :: size
595    character(len=10) :: formt
596
597    if (present(fmt)) then
598       formt = fmt
599    else
600       formt = '(f8.3)'
601    endif
602
603    size = (nvalue*(nvalue+1))/2
604    call xml_NewElement(xf, 'array')
605    call xml_AddAttribute(xf, 'size', str(size))
606    call xml_AddAttribute(xf, 'rows', str(nvalue))
607    if (present(id))      call xml_AddAttribute(xf, 'id', id)
608    if (present(title))   call xml_AddAttribute(xf, 'title', title)
609    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
610    if (present(units))   call xml_AddAttribute(xf, 'units', units)
611    call STMARCF9DP(xf, size, array, formt)
612    call xml_EndElement(xf, 'matrix')
613
614  END SUBROUTINE stmAddTriangleDP
615
616  ! -------------------------------------------------
617  ! 2. outputs SP lower triangle array to xml channel
618  ! -------------------------------------------------
619
620  SUBROUTINE stmAddTriangleSP(xf, nvalue, array, id, title, dictref, units, fmt)
621
622    implicit none
623    type(xmlf_t) :: xf
624    integer, intent(in)                    :: nvalue         ! number of values to be output
625    real(kind=sp), intent(in)               :: array(*)        ! the values to be output
626    character(len=*), intent(in), optional :: id             ! the id
627    character(len=*), intent(in), optional :: title          ! the title
628    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
629    character(len=*), intent(in), optional :: units          ! units (' ' = none)
630    character(len=*), intent(in), optional :: fmt            ! the output format
631
632    ! splits data into lines whenever it overflows workspace/linelength
633    ! Flush on entry and exit
634    integer           :: size
635    character(len=10) :: formt
636
637    if (present(fmt)) then
638       formt = fmt
639    else
640       formt = '(f8.3)'
641    endif
642
643    size = (nvalue*(nvalue+1))/2
644    call xml_NewElement(xf, 'array')
645    call xml_AddAttribute(xf, 'size', str(size))
646    call xml_AddAttribute(xf, 'rows', str(nvalue))
647    if (present(id))      call xml_AddAttribute(xf, 'id', id)
648    if (present(title))   call xml_AddAttribute(xf, 'title', title)
649    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
650    if (present(units))   call xml_AddAttribute(xf, 'units', units)
651    call STMARCF9SP(xf, size, array, formt)
652    call xml_EndElement(xf, 'matrix')
653
654  END SUBROUTINE stmAddTriangleSP
655
656
657  ! -------------------------------------------------
658  ! outputs fatal error message
659  ! -------------------------------------------------
660
661  SUBROUTINE stmErrorMessage(xf, msg, id, title, dictref)
662
663    implicit none
664    type(xmlf_t) :: xf
665    character(len=*), intent(in)           :: msg            ! the message
666    character(len=*), intent(in), optional :: id             ! the id
667    character(len=*), intent(in), optional :: title          ! the title
668    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
669
670    call xml_NewElement(xf, 'message')
671    call xml_AddAttribute(xf, 'severity', 'fatal')
672    if (present(id)) call xml_AddAttribute(xf, 'id', id)
673    if (present(title)) call xml_AddAttribute(xf, 'title', title)
674    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
675    call xml_AddPcdata(xf, msg)
676    call xml_EndElement(xf, 'message')
677
678  END SUBROUTINE stmErrorMessage
679
680
681  ! -------------------------------------------------
682  ! outputs informational message
683  ! -------------------------------------------------
684
685  SUBROUTINE stmInfoMessage(xf, msg, id, title, dictref)
686
687    implicit none
688    type(xmlf_t) :: xf
689    character(len=*), intent(in)           :: msg            ! the message
690    character(len=*), intent(in), optional :: id             ! the id
691    character(len=*), intent(in), optional :: title          ! the title
692    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
693
694    call xml_NewElement(xf, 'message')
695    call xml_AddAttribute(xf, 'severity', 'warning')
696    if (present(id))      call xml_AddAttribute(xf, 'id', id)
697    if (present(title))   call xml_AddAttribute(xf, 'title', title)
698    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
699    call xml_AddPcdata(xf, msg)
700    call xml_EndElement(xf, 'message')
701
702  END SUBROUTINE stmInfoMessage
703
704
705  ! -------------------------------------------------
706  ! outputs warning message
707  ! -------------------------------------------------
708
709  SUBROUTINE stmWarningMessage(xf, msg, id, title, dictref)
710
711    implicit none
712    type(xmlf_t) :: xf
713    character(len=*), intent(in)           :: msg            ! the message
714    character(len=*), intent(in), optional :: id             ! the id
715    character(len=*), intent(in), optional :: title          ! the title
716    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
717
718    call xml_NewElement(xf, 'message')
719    call xml_AddAttribute(xf, 'severity', 'info')
720    if (present(id)) call xml_AddAttribute(xf, 'id', id)
721    if (present(title)) call xml_AddAttribute(xf, 'title', title)
722    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
723    call xml_AddPcdata(xf, msg)
724    call xml_EndElement(xf, 'message')
725
726  END SUBROUTINE stmWarningMessage
727
728
729
730  ! =================================================
731  ! basic STMML routines
732  ! =================================================
733
734
735  ! -------------------------------------------------
736  ! creates STMML <scalar> string
737  ! -------------------------------------------------
738
739  SUBROUTINE STMSCAS9(xf, value, id, title, dictref, type)
740
741    implicit none
742    type(xmlf_t) :: xf
743    character(len=*), intent(in) :: value                 ! the value to be output
744    character(len=*), intent(in), optional :: id          ! the id
745    character(len=*), intent(in), optional :: title       ! the title
746    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
747    character(len=*), intent(in), optional :: type        ! the data type (default 'xsd:string')
748
749    ! Internal variables
750    character(len=20) :: temp
751
752    call xml_NewElement(xf, 'scalar')
753    if (present(id))      call xml_AddAttribute(xf, 'id', id)
754    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
755    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
756    if (present(type))    call xml_AddAttribute(xf, 'dataType', type)
757
758!    if (XMLCHKS9(value)) then
759    call xml_AddPcdata(xf, value)
760    call xml_EndElement(xf, 'scalar')
761
762  END SUBROUTINE STMSCAS9
763
764
765
766  ! -------------------------------------------------
767  ! output start tag for an STMML array
768  ! -------------------------------------------------
769
770  SUBROUTINE STMARST9(xf, nvalue, id, title, dictref, typunt, tuval, delim)
771
772    implicit none
773    type(xmlf_t) :: xf
774    integer, intent(in)                    :: nvalue      ! the number of values to be output
775    character(len=*), intent(in), optional :: id          ! the id
776    character(len=*), intent(in), optional :: title       ! the title
777    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
778    character(len=*), intent(in), optional :: typunt      ! 'type' (for strings) or 'unit' (for numeric)
779    character(len=*), intent(in), optional :: tuval       ! data type (default 'xsd:string') or units (' ' = none)
780    character(len=*), intent(in), optional :: delim       ! the delimiter (default ' ')
781
782    ! Internal Variables
783    character(len=1) :: delim1
784
785    if (present(delim)) then
786       delim1 = delim
787    else
788       delim1 = ' '
789    endif
790
791    call xml_NewElement(xf, 'array')
792    if (present(id))      call xml_AddAttribute(xf, 'id', id)
793    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
794    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
795    if (present(tuval))   call xml_AddAttribute(xf, 'type', tuval)
796    call xml_AddAttribute(xf, 'delimiter', delim1)
797    call xml_AddAttribute(xf, 'size', str(nvalue))
798    call xml_EndElement(xf, 'array')
799
800  END SUBROUTINE STMARST9
801
802
803
804  ! -------------------------------------------------
805  ! 2. outputs SP float array to channel
806  ! -------------------------------------------------
807
808  SUBROUTINE STMARF9SP(xf, nvalue, arrf, id, title, dictref, units, fmt)
809
810    implicit none
811    type(xmlf_t) :: xf
812    integer, intent(in)                    :: nvalue      ! the number of values to be output
813    real(kind=sp), intent(in)               :: arrf(*)     ! the values to be output
814    character(len=*), intent(in), optional :: id          ! the id
815    character(len=*), intent(in), optional :: title       ! the title
816    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
817    character(len=*), intent(in), optional :: units       ! units (' ' = none)
818    character(len=*)                       :: fmt         ! the output format
819
820    call xml_NewElement(xf, 'scalar')
821    if (present(id))      call xml_AddAttribute(xf, 'id', id)
822    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
823    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
824    if (present(units))   call xml_AddAttribute(xf, 'units', units)
825    call xml_AddAttribute(xf, 'size', str(nvalue))
826    call STMARCF9SP(xf, nvalue, arrf, fmt)
827    call xml_NewElement(xf, 'scalar')
828
829  END SUBROUTINE STMARF9SP
830
831
832  ! -------------------------------------------------
833  ! 1. outputs content of DP float array to channel
834  ! -------------------------------------------------
835
836  SUBROUTINE STMARCF9DP(xf, nvalue, arrf, fmt)
837
838    implicit none
839    type(xmlf_t) :: xf
840    integer, intent(in)          :: nvalue     ! the number of values to be output
841    real(kind=dp), intent(in)     :: arrf(*)    ! the values to be output
842    character(len=*), intent(in) :: fmt        ! the output format
843
844    ! splits data into lines whenever it overflows workspace/linelength
845    integer :: i
846
847    call xml_AddPcdata(xf, str(arrf(1)))
848    do i = 2, nvalue
849       call xml_AddPcdata(xf, str(arrf(i)))
850    enddo
851  END SUBROUTINE STMARCF9DP
852
853
854  ! -------------------------------------------------
855  ! 2. outputs content of SP float array to channel
856  ! -------------------------------------------------
857
858  SUBROUTINE STMARCF9SP(xf, nvalue, arrf, fmt)
859
860    implicit none
861    type(xmlf_t) :: xf
862    integer          :: nvalue     ! the number of values to be output
863    real(kind=sp)     :: arrf(*)    ! the values to be output
864    character(len=*) :: fmt        ! the output format
865
866    ! splits data into lines whenever it overflows workspace/linelength
867    integer :: i
868
869    call xml_AddPcdata(xf, str(arrf(1)))
870    do i = 2, nvalue
871       call xml_AddPcdata(xf, str(arrf(i)))
872    enddo
873  END SUBROUTINE STMARCF9SP
874
875end module m_stmw
Note: See TracBrowser for help on using the repository browser.