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.) THEN
      IF (.NOT.ASSOCIATED(res)) &
        CALL this%Error("FindPath","Create was activated, so res should be associated.")
    END IF
  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