common_dict.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: common_dict.f90                                                   #
!#                                                                           #
!# Copyright (C) 2015 Manuel Jung <mjung@astrophysik.uni-kiel.de>            #
!#                                                                           #
!# This program is free software; you can redistribute it and/or modify      #
!# it under the terms of the GNU General Public License as published by      #
!# the Free Software Foundation; either version 2 of the License, or (at     #
!# your option) any later version.                                           #
!#                                                                           #
!# This program is distributed in the hope that it will be useful, but       #
!# WITHOUT ANY WARRANTY; without even the implied warranty of                #
!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or        #
!# NON INFRINGEMENT.  See the GNU General Public License for more            #
!# details.                                                                  #
!#                                                                           #
!# You should have received a copy of the GNU General Public License         #
!# along with this program; if not, write to the Free Software               #
!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                 #
!#                                                                           #
!#############################################################################
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE common_dict
  !USE dict_common, InitDict_common => InitDict
  USE logging_base_mod
  !--------------------------------------------------------------------------!
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  PRIVATE
  ! exclude interface block from doxygen processing
  INTERFACE setattr
    MODULE PROCEDURE setattr0a, setattr0b,                 &
        setattr1, setattr2, setattr3, setattr4, setattr5,  &
        setattr6, setattr7, setattr8, setattr9, setattr10, &
        setattr11, setattr12
  END INTERFACE setattr
  INTERFACE getattr
    MODULE PROCEDURE getattr0,                             &
        getattr1, getattr2, getattr3, getattr4, getattr5,  &
        getattr6, getattr7, getattr8, getattr9, getattr10, &
        getattr11, getattr12
  END INTERFACE getattr
  INTERFACE ref
    MODULE PROCEDURE ref1, ref2
  END INTERFACE ref
  INTERFACE OPERATOR (/)
    MODULE PROCEDURE assign0, assign1, assign2, assign3, assign4, &
        assign5, assign6, assign7, assign8, assign9, assign10,    &
        assign11, assign12
  END INTERFACE
  ! constants
  INTEGER, PARAMETER :: max_char_len     = 128
  INTEGER, PARAMETER :: dict_none        = 0
  INTEGER, PARAMETER :: dict_int         = 1
  INTEGER, PARAMETER :: dict_real        = 2
  INTEGER, PARAMETER :: dict_char        = 3
  INTEGER, PARAMETER :: dict_bool        = 4
  INTEGER, PARAMETER :: dict_real_oned   = 5
  INTEGER, PARAMETER :: dict_real_twod   = 6
  INTEGER, PARAMETER :: dict_real_threed = 7
  INTEGER, PARAMETER :: dict_real_fourd  = 8
  INTEGER, PARAMETER :: dict_int_oned    = 9
  INTEGER, PARAMETER :: dict_real_p      = 10
  INTEGER, PARAMETER :: dict_int_p       = 11
  INTEGER, PARAMETER :: dict_real_fived  = 12
#define TYPE_DICT_KEY CHARACTER(LEN=MAX_CHAR_LEN)
#define TYPE_DICT_INT INTEGER
#define TYPE_DICT_REAL REAL
#define TYPE_DICT_CHAR CHARACTER(LEN=MAX_CHAR_LEN)
#define TYPE_DICT_BOOL LOGICAL
#define TYPE_DICT_REAL_ONED REAL, DIMENSION(:)
#define TYPE_DICT_REAL_TWOD REAL, DIMENSION(:,:), POINTER
#define TYPE_DICT_REAL_THREED REAL, DIMENSION(:,:,:), POINTER
#define TYPE_DICT_REAL_FOURD REAL, DIMENSION(:,:,:,:), POINTER
#define TYPE_DICT_REAL_FIVED REAL, DIMENSION(:,:,:,:,:), POINTER
#define TYPE_DICT_INT_ONED INTEGER, DIMENSION(:)
#define TYPE_DICT_REAL_P REAL, POINTER
#define TYPE_DICT_INT_P INTEGER, POINTER
! Type of the mold, which holds all the data
#define TYPE_DICT_MOLD CHARACTER(LEN=1), DIMENSION(:)
  ! common data structure
  type_dict_mold, ALLOCATABLE :: mold
  TYPE dict_typ
     PRIVATE
     CHARACTER(LEN=MAX_CHAR_LEN) :: key = ""
     INTEGER                     :: type = dict_none
     type_dict_mold, POINTER     :: value => null()
     TYPE(dict_typ), POINTER     :: child => null()
     TYPE(dict_typ), POINTER     :: next => null()
  END TYPE dict_typ
  TYPE real_t
    type_dict_real_p       :: p
  END TYPE
  TYPE int_t
    type_dict_int_p        :: p
  END TYPE
  TYPE real_twod_t
    type_dict_real_twod    :: p
  END TYPE
  TYPE real_threed_t
    type_dict_real_threed  :: p
  END TYPE
  TYPE real_fourd_t
    type_dict_real_fourd   :: p
  END TYPE
  TYPE real_fived_t
    type_dict_real_fived   :: p
  END TYPE
  TYPE(logging_base), SAVE :: this
  !--------------------------------------------------------------------------!
  PUBLIC :: &
       ! types
       dict_typ, real_t, int_t, &
       ! constants
       max_char_len, dict_none, dict_int, dict_real, dict_char, dict_bool, &
       dict_real_oned, dict_real_twod, dict_real_threed, dict_real_fourd,  &
       dict_int_oned, dict_real_p, dict_int_p, dict_real_fived,            &
       ! methods
       setattr,       &
       getattr,       &
       getnext,       &
       getchild,      &
       getkey,        &
       getdatasize,   &
       getdatatype,   &
       getdata,       &
       setdata,       &
       haschild,      &
       hasdata,       &
       haskey,        &
       ref,           &
       OPERATOR(/),   &
       dict,          &
       copyhierarchy, &
       copydict,      &
       printdict,     &
       initdict,      &
       closedict,     &
       deletedict
  !--------------------------------------------------------------------------!

CONTAINS
  SUBROUTINE initdict()
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    IF (.NOT.ALLOCATED(mold)) ALLOCATE(mold(1))
  END SUBROUTINE initdict


  SUBROUTINE closedict()
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    IF (ALLOCATED(mold)) DEALLOCATE(mold)
  END SUBROUTINE closedict


  FUNCTION findpath(root, key, create) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ),POINTER :: root
    CHARACTER(LEN=*)       :: key
    LOGICAL, OPTIONAL      :: create
    TYPE(dict_typ),POINTER :: res
    !------------------------------------------------------------------------!
    TYPE(dict_typ),POINTER :: parent,node
    LOGICAL                :: c
    type_dict_char         :: k, key_
    !------------------------------------------------------------------------!
    INTENT(IN)             :: key, create
    !------------------------------------------------------------------------!
    c = .false.
    IF(PRESENT(create)) &
      c = create
    key_ = trim(key)
    NULLIFY(parent)
    node => root
    k = tokenize(key_)
    DO WHILE(len_trim(k).GT.0)
      node => findchild(node,trim(k))
      IF(ASSOCIATED(node)) THEN
        parent => node
        node => node%child
      ELSE
        IF(c) THEN
          ALLOCATE(node)
          node%key = k
          IF(ASSOCIATED(parent)) THEN
            IF(ASSOCIATED(parent%child)) THEN
              parent => getlast(parent%child)
              parent%next => node
            ELSE
              parent%child => node
            END IF
          ELSE
            IF(ASSOCIATED(root)) THEN
              parent => getlast(root)
              parent%next => node
            ELSE
              root => node
            END IF
          END IF
          parent => node
        ELSE
          NULLIFY(parent)
          k = ''
          key_ = ''
        END IF
      END IF
      k = tokenize(key_)
    END DO
    res => parent

    IF(c.EQV..true..AND..NOT.ASSOCIATED(res)) &
      CALL this%Error("FindPath","Create was activated, so res should be associated.")
  END FUNCTION findpath

  RECURSIVE SUBROUTINE setattr0a(root, key, value)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    CHARACTER(LEN=*)        :: key
    TYPE(dict_typ), TARGET  :: value
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: node, parent
    type_dict_char          :: k
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key
    !------------------------------------------------------------------------!
    node => value
    DO WHILE(ASSOCIATED(node))
      WRITE(k,'(A,A,A)') trim(key),'/',trim(node%key)
      parent => node

      IF(ASSOCIATED(node%child)) THEN
        CALL setattr0a(root, trim(k), node%child)
      ELSE
        CALL setattr0b(root, trim(k), node%value, node%type)
      END IF
      node => node%next
      CALL deletenode(parent,k)
    END DO
  END SUBROUTINE setattr0a

  SUBROUTINE setattr0b(root, key, value, type)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP),POINTER :: root
    CHARACTER(LEN=*)       :: key
    INTEGER                :: type
    type_dict_mold         :: value
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP),POINTER :: node
    !------------------------------------------------------------------------!
    INTENT(IN)             :: key, type, value
    !------------------------------------------------------------------------!
    node => findpath(root,key,.true.)
    node%type = type
    CALL setdata(node,value)
  END SUBROUTINE setattr0b

  SUBROUTINE getattr0a(root, key, parent)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP),POINTER :: root, parent, child
    CHARACTER(LEN=*)       :: key
    !------------------------------------------------------------------------!
    type_dict_char         :: k, key_
    !------------------------------------------------------------------------!
    INTENT(IN)             :: key
    !------------------------------------------------------------------------!
    parent => root
    child => root
    key_ = trim(key)
    DO WHILE(ASSOCIATED(child).AND.len_trim(key_).GT.0)
      k = tokenize(key_)
      parent => findchild(child,k)
      IF(ASSOCIATED(parent)) &
        child => parent%child
    END DO
    IF(len_trim(key_).GT.0) &
      NULLIFY(parent)
  END SUBROUTINE getattr0a

  SUBROUTINE getattr0b(root, key, type, value, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER  :: root
    CHARACTER(LEN=*)         :: key
    INTEGER                  :: type
    type_dict_mold, POINTER  :: value
    type_dict_mold, OPTIONAL :: default
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER  :: node
    CHARACTER(LEN=10)        :: b1,b2
    !------------------------------------------------------------------------!
    INTENT(IN)               :: key, type, default
    !------------------------------------------------------------------------!
    CALL getattr0a(root, key, node)
    IF(.NOT.ASSOCIATED(node)) THEN
      IF(PRESENT(default)) THEN
        CALL setattr0b(root,key,default,type)
        CALL getattr0a(root, key, node)
        IF(.NOT.ASSOCIATED(node)) &
          CALL this%Error("GetAttr", "Setting a default value has gone wrong.")
      ELSE
        CALL this%Error("GetAttr", "Couldn't find key '"//trim(key)//"'.")
      END IF
    END IF
    IF(type.NE.node%type) THEN
      WRITE(b1,"(I4.4)") node%type
      WRITE(b2,"(I4.4)") type
      CALL this%Error("GetAttr", "Key '"//trim(key)//"' is of type "//trim(b1) &
        //", but type "//trim(b2)//" requested.")
    END IF
    value => node%value
  END SUBROUTINE getattr0b

  FUNCTION findchild(root,key) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CHARACTER(LEN=*), INTENT(IN) :: key
    TYPE(dict_typ), POINTER      :: root,res
    !------------------------------------------------------------------------!
    res => root
    DO WHILE(ASSOCIATED(res))
      IF(trim(res%key).EQ.trim(key)) EXIT
      res => res%next
    END DO
  END FUNCTION findchild

  FUNCTION getnext(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root, res
    !------------------------------------------------------------------------!
    res => root%next
  END FUNCTION getnext

  FUNCTION getlast(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root, res
    !------------------------------------------------------------------------!
    res => root
    IF(ASSOCIATED(res)) THEN
      DO WHILE(ASSOCIATED(res%next))
        res => res%next
      END DO
    END IF
  END FUNCTION getlast

  FUNCTION getchild(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root, res
    !------------------------------------------------------------------------!
    res => root%child
  END FUNCTION getchild

  FUNCTION getkey(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    type_dict_char          :: res
    !------------------------------------------------------------------------!
    res = root%key
  END FUNCTION getkey

  FUNCTION getdatasize(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    INTEGER                 :: res
    !------------------------------------------------------------------------!
    IF(ASSOCIATED(root%value)) THEN
      res = SIZE(root%value)
    ELSE
      res = 0
    END IF
  END FUNCTION getdatasize

  FUNCTION getdatatype(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    INTEGER                 :: res
    !------------------------------------------------------------------------!
    res = root%type
  END FUNCTION getdatatype

  FUNCTION getdata(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    type_dict_mold, POINTER :: res
    !------------------------------------------------------------------------!
    res => root%value
  END FUNCTION getdata

  FUNCTION haschild(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    LOGICAL                 :: res
    !------------------------------------------------------------------------!
    res = ASSOCIATED(root%child)
  END FUNCTION haschild

  FUNCTION hasdata(root) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    LOGICAL                 :: res
    !------------------------------------------------------------------------!
    res = ASSOCIATED(root%value)
  END FUNCTION hasdata

  FUNCTION haskey(root, key) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root
    CHARACTER(LEN=*)        :: key
    LOGICAL                 :: res
    !------------------------------------------------------------------------!
    res = ASSOCIATED(findpath(root,trim(key)))
  END FUNCTION haskey

  SUBROUTINE setdata(node, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: node
    type_dict_mold          :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: val
    !------------------------------------------------------------------------!
    IF(SIZE(val).LE.0) &
      CALL this%Error("SetData", "Array size smaller 0 is not possible.")
    IF(ASSOCIATED(node%value)) &
      DEALLOCATE(node%value)
    ALLOCATE(node%value(SIZE(val)))
    node%value = val
  END SUBROUTINE setdata

  FUNCTION tokenize(key,back) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CHARACTER(LEN=MAX_CHAR_LEN) :: key
    LOGICAL,OPTIONAL            :: back
    type_dict_char              :: res
    !------------------------------------------------------------------------!
    LOGICAL                     :: back_
    INTEGER                     :: i
    !------------------------------------------------------------------------!
    INTENT(IN)                  :: back
    INTENT(INOUT)               :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(back)) THEN
      back_ = back
    ELSE
      back_ = .false.
    END IF
    res = ''
    IF(key(1:1).EQ.'/') key = key(2:)
    i = scan(key,'/',back_)
    IF(i.GT.0) THEN
      IF(.NOT.back_) THEN
        res = key(1:i-1)
        key = key(i+1:)
      ELSE
        res = key(i+1:)
        key = key(1:i-1)
      END IF
    ELSE
      res = key
      key = ''
    END IF
  END FUNCTION tokenize

  FUNCTION  dict(n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12,n13,n14,n15,n16,n17,&
                 n18,n19,n20) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER           :: res,n1
    TYPE(dict_typ), POINTER, OPTIONAL :: n2,n3,n4,n5,n6,n7,n8,n9,n10,n11, &
                                         n12,n13,n14,n15,n16,n17,n18,n19,n20
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr0a(res,'',n1)
    IF(PRESENT( n2)) CALL setattr0a(res,'', n2)
    IF(PRESENT( n3)) CALL setattr0a(res,'', n3)
    IF(PRESENT( n4)) CALL setattr0a(res,'', n4)
    IF(PRESENT( n5)) CALL setattr0a(res,'', n5)
    IF(PRESENT( n6)) CALL setattr0a(res,'', n6)
    IF(PRESENT( n7)) CALL setattr0a(res,'', n7)
    IF(PRESENT( n8)) CALL setattr0a(res,'', n8)
    IF(PRESENT( n9)) CALL setattr0a(res,'', n9)
    IF(PRESENT(n10)) CALL setattr0a(res,'',n10)
    IF(PRESENT(n11)) CALL setattr0a(res,'',n11)
    IF(PRESENT(n12)) CALL setattr0a(res,'',n12)
    IF(PRESENT(n13)) CALL setattr0a(res,'',n13)
    IF(PRESENT(n14)) CALL setattr0a(res,'',n14)
    IF(PRESENT(n15)) CALL setattr0a(res,'',n15)
    IF(PRESENT(n16)) CALL setattr0a(res,'',n16)
    IF(PRESENT(n17)) CALL setattr0a(res,'',n17)
    IF(PRESENT(n18)) CALL setattr0a(res,'',n18)
    IF(PRESENT(n19)) CALL setattr0a(res,'',n19)
    IF(PRESENT(n20)) CALL setattr0a(res,'',n20)
  END FUNCTION dict

  SUBROUTINE setattr1(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    type_dict_int           :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_int)
  END SUBROUTINE setattr1

  SUBROUTINE setattr2(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    type_dict_real          :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_real)
  END SUBROUTINE setattr2

  SUBROUTINE setattr3(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key, val
    type_dict_char          :: val_
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    val_ = trim(val)
    CALL setattr0b(root,key,transfer(val_,mold),dict_char)
  END SUBROUTINE setattr3

  SUBROUTINE setattr4(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    type_dict_bool          :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_bool)
  END SUBROUTINE setattr4

  SUBROUTINE setattr5(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    type_dict_real_oned     :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_real_oned)
  END SUBROUTINE setattr5

  SUBROUTINE setattr6(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER      :: root
    CHARACTER(LEN=*)             :: key
    REAL, DIMENSION(:,:), TARGET :: val
    TYPE(real_twod_t)            :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                   :: key,val
    !------------------------------------------------------------------------!
    c%p => val
    CALL setattr0b(root,key,transfer(c,mold),dict_real_twod)
  END SUBROUTINE setattr6

  SUBROUTINE setattr7(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER        :: root
    CHARACTER(LEN=*)               :: key
    REAL, DIMENSION(:,:,:), TARGET :: val
    TYPE(real_threed_t)            :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                     :: key, val
    !------------------------------------------------------------------------!
    c%p => val
    CALL setattr0b(root,key,transfer(c,mold),dict_real_threed)
  END SUBROUTINE setattr7

  SUBROUTINE setattr8(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER          :: root
    CHARACTER(LEN=*)                 :: key
    REAL, DIMENSION(:,:,:,:), TARGET :: val
    TYPE(real_fourd_t)               :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                       :: key, val
    !------------------------------------------------------------------------!
    c%p => val
    CALL setattr0b(root,key,transfer(c,mold),dict_real_fourd)
  END SUBROUTINE setattr8

  SUBROUTINE setattr9(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    type_dict_int_oned      :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_int_oned)
  END SUBROUTINE setattr9

  SUBROUTINE setattr10(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    TYPE(real_t)            :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_real_p)
  END SUBROUTINE setattr10

  SUBROUTINE setattr11(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    CHARACTER(LEN=*)        :: key
    TYPE(int_t)             :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    CALL setattr0b(root,key,transfer(val,mold),dict_int_p)
  END SUBROUTINE setattr11

  SUBROUTINE setattr12(root, key, val)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER            :: root
    CHARACTER(LEN=*)                   :: key
    REAL, DIMENSION(:,:,:,:,:), TARGET :: val
    TYPE(real_fived_t)                 :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                         :: key, val
    !------------------------------------------------------------------------!
    c%p => val
    CALL setattr0b(root,key,transfer(c,mold),dict_real_fived)
  END SUBROUTINE setattr12

  RECURSIVE SUBROUTINE printdict(root, prefix)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), TARGET     ::root
    CHARACTER(LEN=*), OPTIONAL :: prefix
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: node
    type_dict_char          :: prefix_
    type_dict_char          :: s,str
    !------------------------------------------------------------------------!
    node => root
    prefix_ = ''
    IF(PRESENT(prefix)) &
      prefix_ = trim(prefix)
    DO WHILE(ASSOCIATED(node))
      WRITE(s,'(A,A,A)') trim(prefix_),'/',trim(node%key)
      IF(ASSOCIATED(node%value)) THEN
        WRITE(str,'(A,I2,A,A,A,I4)') "type=",node%type,", key=",trim(s),&
          ", size=",SIZE(node%value)
      ELSE
        WRITE(str,'(A,I2,A,A)') "type=",node%type,", key=",trim(s)
      END IF
      CALL this%Info(str)
      IF(ASSOCIATED(node%child)) &
        CALL printdict(node%child, s)
      node => node%next
    END DO
  END SUBROUTINE printdict

  RECURSIVE SUBROUTINE copydict(root, outdir)
  IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER     :: root, outdir, dir, odir, tmp
    !------------------------------------------------------------------------!
    dir => root
    NULLIFY(outdir)
    NULLIFY(odir)
    DO WHILE(ASSOCIATED(dir))
      IF(ASSOCIATED(odir)) THEN
        ALLOCATE(odir%next)
        odir => odir%next
      ELSE
        ALLOCATE(odir)
        outdir => odir
      END IF
      odir%type = dir%type
      odir%key = dir%key
      IF(ASSOCIATED(dir%value)) THEN
        CALL setdata(odir,dir%value)
      END IF

      IF(ASSOCIATED(dir%child)) THEN
        CALL copydict(dir%child, tmp)
        odir%child => tmp
      END IF
      dir => dir%next
    END DO
  END SUBROUTINE copydict


  RECURSIVE SUBROUTINE copyhierarchy(root, outdir)
  IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER     :: root, outdir, dir, odir
    !------------------------------------------------------------------------!
    dir => root
    NULLIFY(outdir)
    NULLIFY(odir)
    DO WHILE(ASSOCIATED(dir))
       IF(ASSOCIATED(dir%child)) THEN
         IF(ASSOCIATED(odir)) THEN
           ALLOCATE(odir%next)
           odir => odir%next
         ELSE
           ALLOCATE(odir)
           outdir => odir
         END IF
         odir%key = dir%key
         CALL copyhierarchy(dir%child,odir%child)
       END IF
       dir => dir%next
    END DO
  END SUBROUTINE copyhierarchy

  SUBROUTINE getattr0(root, key, res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root, res
    CHARACTER(LEN=*)        :: key
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key
    !------------------------------------------------------------------------!
    CALL getattr0a(root, key, res)
    IF(ASSOCIATED(res)) THEN
      IF(.NOT.hasdata(res).AND.haschild(res)) THEN
        res => res%child
      END IF
    END IF
  END SUBROUTINE getattr0

  SUBROUTINE getattr1(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    type_dict_int           :: res
    type_dict_int, OPTIONAL :: default
    CHARACTER(LEN=*)        :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER :: value
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, default
    INTENT(INOUT)           :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_int, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_int, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr1

  SUBROUTINE getattr2(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER  :: root
    type_dict_real           :: res
    type_dict_real, OPTIONAL :: default
    CHARACTER(LEN=*)         :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER  :: value
    !------------------------------------------------------------------------!
    INTENT(IN)               :: key, default
    INTENT(INOUT)            :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_real, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_real, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr2

  SUBROUTINE getattr3(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER  :: root
    type_dict_char           :: res
    type_dict_char, OPTIONAL :: default
    CHARACTER(LEN=*)         :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER  :: value
    !------------------------------------------------------------------------!
    INTENT(IN)               :: key
    INTENT(INOUT)            :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_char, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_char, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr3

  SUBROUTINE getattr4(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER  :: root
    type_dict_bool           :: res
    type_dict_bool, OPTIONAL :: default
    CHARACTER(LEN=*)         :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER  :: value
    !------------------------------------------------------------------------!
    INTENT(IN)               :: key
    INTENT(INOUT)            :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_bool, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_bool, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr4

  SUBROUTINE getattr5(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER       :: root
    type_dict_real_oned           :: res
    type_dict_real_oned, OPTIONAL :: default
    CHARACTER(LEN=*)              :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER       :: value
    !------------------------------------------------------------------------!
    INTENT(IN)                    :: key
    INTENT(INOUT)                 :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_real_oned, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_oned, value)
    END IF
    IF(SIZE(transfer(value,res)).NE.SIZE(res)) &
      CALL this%Error("GetAttr5","1D array with key '" // trim(key) &
        // "' has the wrong size.")

    res = transfer(value,res)
  END SUBROUTINE getattr5

  SUBROUTINE getattr6(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER       :: root
    type_dict_real_twod           :: res
    type_dict_real_twod, OPTIONAL :: default
    CHARACTER(LEN=*)              :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER       :: value
    TYPE(real_twod_t)             :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                    :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      c%p => default
      CALL getattr0b(root, key, dict_real_twod, value, transfer(c,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_twod, value)
    END IF
    c = transfer(value,c)
    res => c%p
  END SUBROUTINE getattr6

  SUBROUTINE getattr7(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER         :: root
    type_dict_real_threed           :: res
    type_dict_real_threed, OPTIONAL :: default
    CHARACTER(LEN=*)                :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER         :: value
    TYPE(real_threed_t)             :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                      :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      c%p => default
      CALL getattr0b(root, key, dict_real_threed, value, transfer(c,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_threed, value)
    END IF
    c = transfer(value,c)
    res => c%p
  END SUBROUTINE getattr7

  SUBROUTINE getattr8(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER        :: root
    type_dict_real_fourd           :: res
    type_dict_real_fourd, OPTIONAL :: default
    CHARACTER(LEN=*)               :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER        :: value
    TYPE(real_fourd_t)             :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                     :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      c%p => default
      CALL getattr0b(root, key, dict_real_fourd, value, transfer(c,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_fourd, value)
    END IF
    c = transfer(value,c)
    res => c%p
  END SUBROUTINE getattr8

  SUBROUTINE getattr9(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER      :: root
    type_dict_int_oned           :: res
    type_dict_int_oned, OPTIONAL :: default
    CHARACTER(LEN=*)             :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER      :: value
    !------------------------------------------------------------------------!
    INTENT(IN)                   :: key
    INTENT(INOUT)                :: res
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_int_oned, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_int_oned, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr9

  SUBROUTINE getattr10(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    TYPE(real_t)            :: res
    TYPE(real_t), OPTIONAL  :: default
    CHARACTER(LEN=*)        :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER :: value
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_real_p, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_p, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr10

  SUBROUTINE getattr11(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: root
    TYPE(int_t)             :: res
    TYPE(int_t), OPTIONAL   :: default
    CHARACTER(LEN=*)        :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER :: value
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      CALL getattr0b(root, key, dict_int_p, value, transfer(default,mold))
    ELSE
      CALL getattr0b(root, key, dict_int_p, value)
    END IF
    res = transfer(value,res)
  END SUBROUTINE getattr11

  SUBROUTINE getattr12(root, key, res, default)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER        :: root
    type_dict_real_fived           :: res
    type_dict_real_fived, OPTIONAL :: default
    CHARACTER(LEN=*)               :: key
    !------------------------------------------------------------------------!
    type_dict_mold, POINTER        :: value
    TYPE(real_fived_t)             :: c
    !------------------------------------------------------------------------!
    INTENT(IN)                     :: key
    !------------------------------------------------------------------------!
    IF(PRESENT(default)) THEN
      c%p => default
      CALL getattr0b(root, key, dict_real_fived, value, transfer(c,mold))
    ELSE
      CALL getattr0b(root, key, dict_real_fived, value)
    END IF
    c = transfer(value,c)
    res => c%p
  END SUBROUTINE getattr12

  SUBROUTINE deletenode(node,k)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(Dict_TYP), POINTER :: node
    CHARACTER(LEN=*)        :: k
    LOGICAL, SAVE           :: first=.true.
    !------------------------------------------------------------------------!
    INTEGER            :: status
    CHARACTER(LEN=512) :: str
    !------------------------------------------------------------------------!
    NULLIFY(node%child,node%next)
    IF(ASSOCIATED(node%value)) &
      DEALLOCATE(node%value)
    DEALLOCATE(node,stat=status)
    IF(status.NE.0.AND.first) THEN
      ! This warning (no. 195) does occur on the SX ACE. The definite reason
      ! is unknown. It is probably related to deallocating a pointer, which
      ! has been associated to a TARGET subroutine parameter. But this cannot
      ! be change, since a TARGET instead of a POINTER is required for
      ! overloading the '/' operator.
      WRITE(str,'(A,A,A,I3)')&
        "Deallocating key '",trim(k),&
        "' throws the error nio.: ",status
      !CALL Warning(this,"SetAttr0a",TRIM(str))
      WRITE(str,'(A,A,A,I3)')&
        "More invocations of this error will be suppressed."
      !CALL Warning(this,"SetAttr0a",TRIM(str))
      first = .false.
    END IF
  END SUBROUTINE deletenode

  RECURSIVE SUBROUTINE deletedict(root)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: root, node, next, child
    !------------------------------------------------------------------------!
    type_dict_char          :: k
    !------------------------------------------------------------------------!
    node => root
    DO WHILE(ASSOCIATED(node))
        next => node%next
        child => node%child
        k = trim(node%key)
        CALL deletenode(node,trim(k))
        IF (ASSOCIATED(child)) &
           CALL deletedict(child)
        node => next
    END DO
    NULLIFY(root)
  END SUBROUTINE deletedict

  FUNCTION assign0(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    TYPE(dict_typ), TARGET  :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key,val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign0

  FUNCTION assign1(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    type_dict_int           :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign1

  FUNCTION assign2(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    type_dict_real          :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign2

  FUNCTION assign3(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key, val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign3

  FUNCTION assign4(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    type_dict_bool          :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign4

  FUNCTION assign5(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    type_dict_real_oned     :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign5

  FUNCTION assign6(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER      :: res
    CHARACTER(LEN=*)             :: key
    REAL, DIMENSION(:,:), TARGET :: val
    !------------------------------------------------------------------------!
    INTENT(IN)                   :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign6

  FUNCTION assign7(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER        :: res
    CHARACTER(LEN=*)               :: key
    REAL, DIMENSION(:,:,:), TARGET :: val
    !------------------------------------------------------------------------!
    INTENT(IN)                     :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign7

  FUNCTION assign8(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER          :: res
    CHARACTER(LEN=*)                 :: key
    REAL, DIMENSION(:,:,:,:), TARGET :: val
    !------------------------------------------------------------------------!
    INTENT(IN)                       :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign8

  FUNCTION assign9(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    type_dict_int_oned      :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign9

  FUNCTION assign10(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    TYPE(real_t)            :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign10

  FUNCTION assign11(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER :: res
    CHARACTER(LEN=*)        :: key
    TYPE(int_t)             :: val
    !------------------------------------------------------------------------!
    INTENT(IN)              :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign11

  FUNCTION assign12(key, val) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(dict_typ), POINTER            :: res
    CHARACTER(LEN=*)                   :: key
    REAL, DIMENSION(:,:,:,:,:), TARGET :: val
    !------------------------------------------------------------------------!
    INTENT(IN)                         :: key, val
    !------------------------------------------------------------------------!
    NULLIFY(res)
    CALL setattr(res, key, val)
  END FUNCTION assign12

  FUNCTION ref1(p) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    type_dict_real_p :: p
    TYPE(real_t)     :: res
    !------------------------------------------------------------------------!
    res%p => p
  END FUNCTION ref1

  FUNCTION ref2(p) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    type_dict_int_p :: p
    TYPE(int_t)     :: res
    !------------------------------------------------------------------------!
    res%p => p
  END FUNCTION ref2

END MODULE common_dict