ecearth3/sources/tm5mp/base/xmlf_read_xml_primitives.f90

! read_xml_prims.f90 - Read routines for primitive data
!
! $Id: read_xml_prims.f90,v 1.7 2007/12/07 10:38:41 arjenmarkus Exp $
!
! Arjen Markus
!
! General information:
! This module is part of the XML-Fortran library. Its
! purpose is to help read individual items from an XML
! file into the variables that have been connected to
! the various tags. It is used by the code generated
! by the make_xml_reader program.
!
! Because the routines differ mostly by the type of the
! output variable, the body is included, to prevent
! too much repeated blocks of code with all the maintenance
! issues that causes.
!
module xmlf_read_xml_primitives

   use xmlf_parse

   implicit none

   private :: read_from_buffer
   private :: read_from_buffer_integers
   private :: read_from_buffer_reals
   private :: read_from_buffer_doubles
   private :: read_from_buffer_logicals
   private :: read_from_buffer_words

   interface read_from_buffer
      module procedure read_from_buffer_integers
      module procedure read_from_buffer_reals
      module procedure read_from_buffer_doubles
      module procedure read_from_buffer_logicals
      module procedure read_from_buffer_words
   end interface

contains

! skip_until_endtag --
!    Routine to read the XML file until the end tag is encountered
!
! Arguments:
!    info        The XML file data structure
!    tag         The tag in question
!    attribs     Array of attributes and their values
!    data        Array of strings, representing the data
!    error       Has an error occurred?
!
subroutine skip_until_endtag( info, tag, attribs, data, error )
   type(XML_PARSE), intent(inout)                  :: info
   character(len=*), intent(in)                    :: tag
   character(len=*), dimension(:,:), intent(inout) :: attribs
   character(len=*), dimension(:), intent(inout)   :: data
   logical, intent(out)                            :: error

   integer                                         :: noattribs
   integer                                         :: nodata
   integer                                         :: ierr
   logical                                         :: endtag
   character(len=len(tag))                         :: newtag

   error = .true.
   do
      call xml_get( info, newtag, endtag, attribs, noattribs, &
                    data, nodata )
      if ( xml_error(info) ) then
         error = .true.
         exit
      endif
      if ( endtag .and. newtag .eq. tag ) then
         exit
      endif
   enddo
end subroutine skip_until_endtag

! read_xml_integer --
!    Routine to read a single integer from the parsed data
!
! Arguments:
!    info        XML parser structure
!    tag         The tag in question (error message only)
!    endtag      End tag found? (Dummy argument, actually)
!    attribs     Array of attributes and their values
!    noattribs   Number of attributes found
!    data        Array of strings, representing the data
!    nodata      Number of data strings
!    var         Variable to be filled
!    has_var     Has the variable been set?
!
subroutine read_xml_integer( info, tag, endtag, attribs, noattribs, data, nodata, &
                             var, has_var, status )
   integer, intent(inout)                       :: var

   include 'xmlf_read_xml_scalar.inc'

end subroutine read_xml_integer

! read_xml_line --
!    Routine to read a single line of text from the parsed data
!
! Arguments:
!    info        XML parser structure
!    tag         The tag in question (error message only)
!    endtag      End tag found? (Dummy argument, actually)
!    attribs     Array of attributes and their values
!    noattribs   Number of attributes found
!    data        Array of strings, representing the data
!    nodata      Number of data strings
!    var         Variable to be filled
!    has_var     Has the variable been set?
!
subroutine read_xml_line( info, tag, endtag, attribs, noattribs, data, nodata, &
                          var, has_var, status )
   type(XML_PARSE), intent(inout)               :: info
   character(len=*), intent(in)                 :: tag
   logical, intent(inout)                       :: endtag
   character(len=*), dimension(:,:), intent(in) :: attribs
   integer, intent(in)                          :: noattribs
   character(len=*), dimension(:), intent(in)   :: data
   integer, intent(in)                          :: nodata
   character(len=*), intent(inout)              :: var
   logical, intent(inout)                       :: has_var
   integer, intent(out)                         :: status

   character(len=len(attribs(1,1)))             :: buffer
   integer                                      :: idx

   !
   ! The value can be stored in an attribute value="..." or in
   ! the data
   !
   has_var = .false.
   idx = xml_find_attrib( attribs, noattribs, 'value', buffer )
   if ( idx .gt. 0 ) then
      var     = buffer
      has_var = .true.
   else
      do idx = 1,nodata
         if ( data(idx) .ne. ' ' ) then
            var = data(idx)
            has_var = .true.
            exit
         endif
      enddo
   endif

   ! ok
   status = 0

end subroutine read_xml_line

! read_xml_real, ... --
!    See read_xml_integer for an explanation
!
subroutine read_xml_real( info, tag, endtag, attribs, noattribs, data, nodata, &
                          var, has_var, status )
   real(4), intent(inout)                          :: var

   include 'xmlf_read_xml_scalar.inc'

end subroutine read_xml_real

subroutine read_xml_double( info, tag, endtag, attribs, noattribs, data, nodata, &
                            var, has_var, status )
   real(8), intent(inout)       :: var

   include 'xmlf_read_xml_scalar.inc'

end subroutine read_xml_double

subroutine read_xml_logical( info, tag, endtag, attribs, noattribs, data, nodata, &
                             var, has_var, status )
   logical, intent(inout)       :: var

   include 'xmlf_read_xml_scalar.inc'

end subroutine read_xml_logical

subroutine read_xml_word( info, tag, endtag, attribs, noattribs, data, nodata, &
                          var, has_var, status )
   character(len=*), intent(inout)       :: var

   include 'xmlf_read_xml_scalar.inc'

end subroutine read_xml_word

! read_xml_integer_array --
!    Routine to read a one-dimensional integer array from the parsed
!    ata
!
! Arguments:
!    info        XML parser structure
!    tag         The tag in question (error message only)
!    endtag      End tag found? (Dummy argument, actually)
!    attribs     Array of attributes and their values
!    noattribs   Number of attributes found
!    data        Array of strings, representing the data
!    nodata      Number of data strings
!    var         Variable to be filled
!    has_var     Has the variable been set?
!
subroutine read_xml_integer_array( info, tag, endtag, attribs, noattribs, data, &
                                   nodata, var, has_var, status )
   integer, dimension(:), pointer                :: var

   include 'xmlf_read_xml_array.inc'

end subroutine read_xml_integer_array

! read_xml_line_array --
!    Routine to read an array of lines of text from the parsed data
!
! Arguments:
!    info        XML parser structure
!    tag         The tag in question (error message only)
!    attribs     Array of attributes and their values
!    noattribs   Number of attributes found
!    data        Array of strings, representing the data
!    nodata      Number of data strings
!    var         Variable to be filled
!    has_var     Has the variable been set?
!
subroutine read_xml_line_array( info, tag, endtag, attribs, noattribs, data, &
                                nodata, var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   character(len=*), dimension(:), pointer       :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: idx
   integer                                       :: idxv
   logical                                       :: started

   !
   ! The value can be stored in an attribute values="..." or in
   ! the data
   !
   has_var = .false.
   idx = xml_find_attrib( attribs, noattribs, 'values', buffer )
   if ( idx .gt. 0 ) then
      allocate( var(1:1) )
      var(1) = buffer
      if ( buffer .ne. ' ' ) then
         has_var = .true.
      endif
   else
      idxv    = 0
      started = .false.
      do idx = 1,nodata
         if ( data(idx) .ne. ' ' .or. started ) then
            if ( .not. started ) then
               allocate( var(1:nodata-idx+1) )
               started = .true.
            endif
            idxv = idxv + 1
            var(idxv) = data(idx)
         endif
      enddo
      if ( started ) then
         has_var = .true.
      endif
   endif

   ! ok
   status = 0

end subroutine read_xml_line_array

! read_xml_real_array, ... --
!    See read_xml_integer_array for an explanation
!
subroutine read_xml_real_array( info, tag, endtag, attribs, noattribs, data, &
                                nodata, var, has_var, status )
   real(4), dimension(:), pointer :: var

   include 'xmlf_read_xml_array.inc'

end subroutine read_xml_real_array

subroutine read_xml_double_array( info, tag, endtag, attribs, noattribs, data, &
                                  nodata, var, has_var, status )
   real(8), dimension(:), pointer :: var

   include 'xmlf_read_xml_array.inc'

end subroutine read_xml_double_array

subroutine read_xml_logical_array( info, tag, endtag, attribs, noattribs, data, &
                                   nodata, var, has_var, status )
   logical, dimension(:), pointer :: var

   include 'xmlf_read_xml_array.inc'

end subroutine read_xml_logical_array

subroutine read_xml_word_array( info, tag, endtag, attribs, noattribs, data, &
                                nodata, var, has_var, status )
   character(len=*), dimension(:), pointer :: var

   include 'xmlf_read_xml_array.inc'

end subroutine read_xml_word_array

! read_from_buffer_integers --
!    Routine to read all integers from a long string
!
! Arguments:
!    buffer      String containing the data
!    var         Variable to be filled
!    ierror      Error flag
!
subroutine read_from_buffer_integers( buffer, var, ierror )
   integer, dimension(:), pointer                :: var
   integer, dimension(:), pointer                :: work

   include 'xmlf_read_from_buffer.inc'

end subroutine read_from_buffer_integers

! read_xml_from_buffer_reals, ... -
!    See read_xml_from_buffer_integers for an explanation
!
subroutine read_from_buffer_reals( buffer, var, ierror )
   real(4), dimension(:), pointer                :: var
   real(4), dimension(:), pointer                :: work

   include 'xmlf_read_from_buffer.inc'

end subroutine read_from_buffer_reals

subroutine read_from_buffer_doubles( buffer, var, ierror )
   real(8), dimension(:), pointer :: var
   real(8), dimension(:), pointer :: work

   include 'xmlf_read_from_buffer.inc'

end subroutine read_from_buffer_doubles

subroutine read_from_buffer_logicals( buffer, var, ierror )
   logical, dimension(:), pointer :: var
   logical, dimension(:), pointer :: work

   include 'xmlf_read_from_buffer.inc'

end subroutine read_from_buffer_logicals

subroutine read_from_buffer_words( buffer, var, ierror )
   character(len=*), dimension(:), pointer :: var
   character(len=len(var)), dimension(:), pointer :: work

   include 'xmlf_read_from_buffer.inc'

end subroutine read_from_buffer_words

! read_xml_word_1dim, ... -
!    Read an array of "words" (or ...) but from different elements
!
subroutine read_xml_integer_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                                  var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   integer, dimension(:), pointer                :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   integer,dimension(:), pointer                 :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_integer( info, tag, endtag, attribs, noattribs, data, nodata, &
                          var(newsize), has_var, status )

end subroutine read_xml_integer_1dim

subroutine read_xml_real_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                               var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   real(4), dimension(:), pointer                :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   real(4), dimension(:), pointer                :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_real( info, tag, endtag, attribs, noattribs, data, nodata, &
                       var(newsize), has_var, status )

end subroutine read_xml_real_1dim

subroutine read_xml_double_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                                 var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   real(8), dimension(:), pointer                :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   real(8), dimension(:), pointer                :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_double( info, tag, endtag, attribs, noattribs, data, nodata, &
                       var(newsize), has_var, status )

end subroutine read_xml_double_1dim

subroutine read_xml_logical_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                                  var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   logical, dimension(:), pointer                :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   logical, dimension(:), pointer                :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_logical( info, tag, endtag, attribs, noattribs, data, nodata, &
                          var(newsize), has_var, status )

end subroutine read_xml_logical_1dim

subroutine read_xml_word_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                             var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   character(len=*), dimension(:), pointer       :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   character(len=len(var)),dimension(:), pointer :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_word( info, tag, endtag, attribs, noattribs, data, nodata, &
                       var(newsize), has_var, status )

end subroutine read_xml_word_1dim

subroutine read_xml_line_1dim( info, tag, endtag, attribs, noattribs, data, nodata, &
                             var, has_var, status )
   type(XML_PARSE), intent(inout)                :: info
   character(len=*), intent(in)                  :: tag
   logical, intent(inout)                        :: endtag
   character(len=*), dimension(:,:), intent(in)  :: attribs
   integer, intent(in)                           :: noattribs
   character(len=*), dimension(:), intent(in)    :: data
   integer, intent(in)                           :: nodata
   character(len=*), dimension(:), pointer       :: var
   logical, intent(inout)                        :: has_var
   integer, intent(out)                          :: status

   character(len=len(var)),dimension(:), pointer :: newvar
   character(len=len(attribs(1,1)))              :: buffer
   integer                                       :: newsize

   newsize = size(var) + 1
   allocate( newvar(1:newsize) )
   newvar(1:newsize-1) = var
   deallocate( var )
   var => newvar

   call read_xml_line( info, tag, endtag, attribs, noattribs, data, nodata, &
                       var(newsize), has_var, status )

end subroutine read_xml_line_1dim


end module xmlf_read_xml_primitives