module dcl_parm
  use dcl_common

  interface DclGetParm
    module procedure DclGetIntegerS, DclGetRealS, DclGetLogicalS, DclGetCharS
  end interface

  interface DclSetParm
    module procedure DclSetInteger, DclSetReal, DclSetLogical, DclSetChar
  end interface

  interface DclSetParmEx
    module procedure DclSetIntegerEX, DclSetRealEX, DclSetLogicalEX, DclSetCharEX
  end interface

!======================================================
  contains
    function DclGetInteger(name)
      integer                       :: DclGetInteger
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetInteger')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udiqin(name,idx)
          if(idx.ne.0) then
            call udiqvl(idx, DclGetInteger) ;  exit
          end if

          call ueiqin(name,idx)
          if(idx.ne.0) then
            call ueiqvl(idx, DclGetInteger) ;  exit
          end if

          call ugiqin(name,idx)
          if(idx.ne.0) then
            call ugiqvl(idx, DclGetInteger) ;  exit
          end if

          call usiqin(name,idx)
          if(idx.ne.0) then
            call usiqvl(idx, DclGetInteger) ;  exit
          end if

          call uziqin(name,idx)
          if(idx.ne.0) then
            call uziqvl(idx, DclGetInteger) ;  exit
          end if

          call uliqin(name,idx)
          if(idx.ne.0) then
            call uliqvl(idx, DclGetInteger) ;  exit
          end if

          call uciqin(name,idx)
          if(idx.ne.0) then
            call uciqvl(idx, DclGetInteger) ;  exit
          end if

          call umiqin(name,idx)
          if(idx.ne.0) then
            call umiqvl(idx, DclGetInteger) ;  exit
          end if

          call sgiqin(name,idx)
          if(idx.ne.0) then
            call sgiqvl(idx, DclGetInteger) ;  exit
          end if

          call swiqin(name,idx)
          if(idx.ne.0) then
            call swiqvl(idx, DclGetInteger) ;  exit
          end if

          call gliqin(name,idx)
          if(idx.ne.0) then
            call gliqvl(idx, DclGetInteger) ;  exit
          end if
          call msgdmp('E', 'DclGetInteger', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udiget(pname,DclGetInteger)
          case('HATCH'   ) ; call ueiget(pname,DclGetInteger)
          case('VECTOR'  ) ; call ugiget(pname,DclGetInteger)
          case('SCALE'   ) ; call usiget(pname,DclGetInteger)
          case('AXIS'    ) ; call uziget(pname,DclGetInteger)
          case('LOG'     ) ; call uliget(pname,DclGetInteger)
          case('CALENDAR') ; call uciget(pname,DclGetInteger)
          case('MAP'     ) ; call umiget(pname,DclGetInteger)
          case('GRAPH'   ) ; call sgiget(pname,DclGetInteger)
          case('DEVICE'  ) ; call swiget(pname,DclGetInteger)
          case('GLOBAL'  ) ; call gliget(pname,DclGetInteger)
          case default
            call msgdmp('E', 'DclGetInteger', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetInteger')

    end function
!------------------------------------------------------
    function DclGetReal(name)
      real                          :: DclGetReal
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetReal')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udrqin(name,idx)
          if(idx.ne.0) then
            call udrqvl(idx, DclGetReal) ;  exit
          end if

          call uerqin(name,idx)
          if(idx.ne.0) then
            call uerqvl(idx, DclGetReal) ;  exit
          end if

          call ugrqin(name,idx)
          if(idx.ne.0) then
            call ugrqvl(idx, DclGetReal) ;  exit
          end if

          call usrqin(name,idx)
          if(idx.ne.0) then
            call usrqvl(idx, DclGetReal) ;  exit
          end if

          call uzrqin(name,idx)
          if(idx.ne.0) then
            call uzrqvl(idx, DclGetReal) ;  exit
          end if

          call ulrqin(name,idx)
          if(idx.ne.0) then
            call ulrqvl(idx, DclGetReal) ;  exit
          end if

          call ucrqin(name,idx)
          if(idx.ne.0) then
            call ucrqvl(idx, DclGetReal) ;  exit
          end if

          call umrqin(name,idx)
          if(idx.ne.0) then
            call umrqvl(idx, DclGetReal) ;  exit
          end if

          call sgrqin(name,idx)
          if(idx.ne.0) then
            call sgrqvl(idx, DclGetReal) ;  exit
          end if

          call swrqin(name,idx)
          if(idx.ne.0) then
            call swrqvl(idx, DclGetReal) ;  exit
          end if

          call glrqin(name,idx)
          if(idx.ne.0) then
            call glrqvl(idx, DclGetReal) ;  exit
          end if
          call msgdmp('E', 'DclGetReal', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udrget(pname,DclGetReal)
          case('HATCH'   ) ; call uerget(pname,DclGetReal)
          case('VECTOR'  ) ; call ugrget(pname,DclGetReal)
          case('SCALE'   ) ; call usrget(pname,DclGetReal)
          case('AXIS'    ) ; call uzrget(pname,DclGetReal)
          case('LOG'     ) ; call ulrget(pname,DclGetReal)
          case('CALENDAR') ; call ucrget(pname,DclGetReal)
          case('MAP'     ) ; call umrget(pname,DclGetReal)
          case('GRAPH'   ) ; call sgrget(pname,DclGetReal)
          case('DEVICE'  ) ; call swrget(pname,DclGetReal)
          case('GLOBAL'  ) ; call glrget(pname,DclGetReal)
          case default
            call msgdmp('E', 'DclGetReal', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetReal')
    end function
!------------------------------------------------------
    function DclGetLogical(name)
      logical                       :: DclGetLogical
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetLogical')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udlqin(name,idx)
          if(idx.ne.0) then
            call udlqvl(idx, DclGetReal) ;  exit
          end if

          call uelqin(name,idx)
          if(idx.ne.0) then
            call uelqvl(idx, DclGetReal) ;  exit
          end if

          call uglqin(name,idx)
          if(idx.ne.0) then
            call uglqvl(idx, DclGetReal) ;  exit
          end if

          call uslqin(name,idx)
          if(idx.ne.0) then
            call uslqvl(idx, DclGetReal) ;  exit
          end if

          call uzlqin(name,idx)
          if(idx.ne.0) then
            call uzlqvl(idx, DclGetReal) ;  exit
          end if

          call ullqin(name,idx)
          if(idx.ne.0) then
            call ullqvl(idx, DclGetReal) ;  exit
          end if

          call uclqin(name,idx)
          if(idx.ne.0) then
            call uclqvl(idx, DclGetReal) ;  exit
          end if

          call umlqin(name,idx)
          if(idx.ne.0) then
            call umlqvl(idx, DclGetReal) ;  exit
          end if

          call sglqin(name,idx)
          if(idx.ne.0) then
            call sglqvl(idx, DclGetReal) ;  exit
          end if

          call swlqin(name,idx)
          if(idx.ne.0) then
            call swlqvl(idx, DclGetReal) ;  exit
          end if

          call gllqin(name,idx)
          if(idx.ne.0) then
            call gllqvl(idx, DclGetReal) ;  exit
          end if
          call msgdmp('E', 'DclGetParm', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udlget(pname,DclGetLogical)
          case('HATCH'   ) ; call uelget(pname,DclGetLogical)
          case('VECTOR'  ) ; call uglget(pname,DclGetLogical)
          case('SCALE'   ) ; call uslget(pname,DclGetLogical)
          case('AXIS'    ) ; call uzlget(pname,DclGetLogical)
          case('LOG'     ) ; call ullget(pname,DclGetLogical)
          case('CALENDAR') ; call uclget(pname,DclGetLogical)
          case('MAP'     ) ; call umlget(pname,DclGetLogical)
          case('GRAPH'   ) ; call sglget(pname,DclGetLogical)
          case('DEVICE'  ) ; call swlget(pname,DclGetLogical)
          case('GLOBAL'  ) ; call gllget(pname,DclGetLogical)
          case default
            call msgdmp('E', 'DclGetLogical', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetLogical')
    end function
!------------------------------------------------------
    function DclGetChar(name)
      character(len=8)              :: DclGetChar
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetChar')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call uscqin(name,idx)
          if(idx.ne.0) then
            call uscqvl(idx, DclGetChar) ;  exit
          end if

          call uzcqin(name,idx)
          if(idx.ne.0) then
            call uzcqvl(idx, DclGetChar) ;  exit
          end if

          call swcqin(name,idx)
          if(idx.ne.0) then
            call swcqvl(idx, DclGetChar) ;  exit
          end if

          call glcqin(name,idx)
          if(idx.ne.0) then
            call glcqvl(idx, DclGetChar) ;  exit
          end if
          call msgdmp('E', 'DclGetChar', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('SCALE'  ) ; call uscget(pname,DclGetChar)
          case('AXIS'   ) ; call uzcget(pname,DclGetChar)
          case('DEVICE' ) ; call swcget(pname,DclGetChar)
          case('GLOBAL' ) ; call glcget(pname,DclGetChar)
          case default
            call msgdmp('E', 'DclGetChar', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetChar')
    end function
!======================================================
    subroutine DclGetIntegerS(name, value)
      integer                       :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetIntegerS')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udiqin(name,idx)
          if(idx.ne.0) then
            call udiqvl(idx, value) ;  exit
          end if

          call ueiqin(name,idx)
          if(idx.ne.0) then
            call ueiqvl(idx, value) ;  exit
          end if

          call ugiqin(name,idx)
          if(idx.ne.0) then
            call ugiqvl(idx, value) ;  exit
          end if

          call usiqin(name,idx)
          if(idx.ne.0) then
            call usiqvl(idx, value) ;  exit
          end if

          call uziqin(name,idx)
          if(idx.ne.0) then
            call uziqvl(idx, value) ;  exit
          end if

          call uliqin(name,idx)
          if(idx.ne.0) then
            call uliqvl(idx, value) ;  exit
          end if

          call uciqin(name,idx)
          if(idx.ne.0) then
            call uciqvl(idx, value) ;  exit
          end if

          call umiqin(name,idx)
          if(idx.ne.0) then
            call umiqvl(idx, value) ;  exit
          end if

          call sgiqin(name,idx)
          if(idx.ne.0) then
            call sgiqvl(idx, value) ;  exit
          end if

          call swiqin(name,idx)
          if(idx.ne.0) then
            call swiqvl(idx, value) ;  exit
          end if

          call gliqin(name,idx)
          if(idx.ne.0) then
            call gliqvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclGetIntegerS', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udiget(pname,value)
          case('HATCH'   ) ; call ueiget(pname,value)
          case('VECTOR'  ) ; call ugiget(pname,value)
          case('SCALE'   ) ; call usiget(pname,value)
          case('AXIS'    ) ; call uziget(pname,value)
          case('LOG'     ) ; call uliget(pname,value)
          case('CALENDAR') ; call uciget(pname,value)
          case('MAP'     ) ; call umiget(pname,value)
          case('GRAPH'   ) ; call sgiget(pname,value)
          case('DEVICE'  ) ; call swiget(pname,value)
          case('GLOBAL'  ) ; call gliget(pname,value)
          case default
            call msgdmp('E', 'DclGetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetIntegerS')

    end subroutine
!------------------------------------------------------
    subroutine DclGetRealS(name, value)
      real                          :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetRealS')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udrqin(name,idx)
          if(idx.ne.0) then
            call udrqvl(idx, value) ;  exit
          end if

          call uerqin(name,idx)
          if(idx.ne.0) then
            call uerqvl(idx, value) ;  exit
          end if

          call ugrqin(name,idx)
          if(idx.ne.0) then
            call ugrqvl(idx, value) ;  exit
          end if

          call usrqin(name,idx)
          if(idx.ne.0) then
            call usrqvl(idx, value) ;  exit
          end if

          call uzrqin(name,idx)
          if(idx.ne.0) then
            call uzrqvl(idx, value) ;  exit
          end if

          call ulrqin(name,idx)
          if(idx.ne.0) then
            call ulrqvl(idx, value) ;  exit
          end if

          call ucrqin(name,idx)
          if(idx.ne.0) then
            call ucrqvl(idx, value) ;  exit
          end if

          call umrqin(name,idx)
          if(idx.ne.0) then
            call umrqvl(idx, value) ;  exit
          end if

          call sgrqin(name,idx)
          if(idx.ne.0) then
            call sgrqvl(idx, value) ;  exit
          end if

          call swrqin(name,idx)
          if(idx.ne.0) then
            call swrqvl(idx, value) ;  exit
          end if

          call glrqin(name,idx)
          if(idx.ne.0) then
            call glrqvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclGetRealS', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udrget(pname,value)
          case('HATCH'   ) ; call uerget(pname,value)
          case('VECTOR'  ) ; call ugrget(pname,value)
          case('SCALE'   ) ; call usrget(pname,value)
          case('AXIS'    ) ; call uzrget(pname,value)
          case('LOG'     ) ; call ulrget(pname,value)
          case('CALENDAR') ; call ucrget(pname,value)
          case('MAP'     ) ; call umrget(pname,value)
          case('GRAPH'   ) ; call sgrget(pname,value)
          case('DEVICE'  ) ; call swrget(pname,value)
          case('GLOBAL'  ) ; call glrget(pname,value)
          case default
            call msgdmp('E', 'DclGetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetRealS')

    end subroutine
!------------------------------------------------------
    subroutine DclGetLogicalS(name, value)
      logical                       :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetLogicalS')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udlqin(name,idx)
          if(idx.ne.0) then
            call udlqvl(idx, value) ;  exit
          end if

          call uelqin(name,idx)
          if(idx.ne.0) then
            call uelqvl(idx, value) ;  exit
          end if

          call uglqin(name,idx)
          if(idx.ne.0) then
            call uglqvl(idx, value) ;  exit
          end if

          call uslqin(name,idx)
          if(idx.ne.0) then
            call uslqvl(idx, value) ;  exit
          end if

          call uzlqin(name,idx)
          if(idx.ne.0) then
            call uzlqvl(idx, value) ;  exit
          end if

          call ullqin(name,idx)
          if(idx.ne.0) then
            call ullqvl(idx, value) ;  exit
          end if

          call uclqin(name,idx)
          if(idx.ne.0) then
            call uclqvl(idx, value) ;  exit
          end if

          call umlqin(name,idx)
          if(idx.ne.0) then
            call umlqvl(idx, value) ;  exit
          end if

          call sglqin(name,idx)
          if(idx.ne.0) then
            call sglqvl(idx, value) ;  exit
          end if

          call swlqin(name,idx)
          if(idx.ne.0) then
            call swlqvl(idx, value) ;  exit
          end if

          call gllqin(name,idx)
          if(idx.ne.0) then
            call gllqvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclGetRealS', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udlget(pname,value)
          case('HATCH'   ) ; call uelget(pname,value)
          case('VECTOR'  ) ; call uglget(pname,value)
          case('SCALE'   ) ; call uslget(pname,value)
          case('AXIS'    ) ; call uzlget(pname,value)
          case('LOG'     ) ; call ullget(pname,value)
          case('CALENDAR') ; call uclget(pname,value)
          case('MAP'     ) ; call umlget(pname,value)
          case('GRAPH'   ) ; call sglget(pname,value)
          case('DEVICE'  ) ; call swlget(pname,value)
          case('GLOBAL'  ) ; call gllget(pname,value)
          case default
            call msgdmp('E', 'DclGetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetLogicalS')

    end subroutine
!------------------------------------------------------
    subroutine DclGetCharS(name, value)
      character(len=8)              :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclGetCharS')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call uscqin(name,idx)
          if(idx.ne.0) then
            call uscqvl(idx, value) ;  exit
          end if

          call uzcqin(name,idx)
          if(idx.ne.0) then
            call uzcqvl(idx, value) ;  exit
          end if

          call swcqin(name,idx)
          if(idx.ne.0) then
            call swcqvl(idx, value) ;  exit
          end if

          call glcqin(name,idx)
          if(idx.ne.0) then
            call glcqvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclGetChar', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('SCALE'  ) ; call uscget(pname,value)
          case('AXIS'   ) ; call uzcget(pname,value)
          case('DEVICE' ) ; call swcget(pname,value)
          case('GLOBAL' ) ; call glcget(pname,value)
          case default
            call msgdmp('E', 'DclGetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclGetCharS')
    end subroutine
!======================================================
    subroutine DclSetInteger(name, value)
      integer                       :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetInteger')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udiqin(name,idx)
          if(idx.ne.0) then
            call udisvl(idx, value) ;  exit
          end if

          call ueiqin(name,idx)
          if(idx.ne.0) then
            call ueisvl(idx, value) ;  exit
          end if

          call ugiqin(name,idx)
          if(idx.ne.0) then
            call ugisvl(idx, value) ;  exit
          end if

          call usiqin(name,idx)
          if(idx.ne.0) then
            call usisvl(idx, value) ;  exit
          end if

          call uziqin(name,idx)
          if(idx.ne.0) then
            call uzisvl(idx, value) ;  exit
          end if

          call uliqin(name,idx)
          if(idx.ne.0) then
            call ulisvl(idx, value) ;  exit
          end if

          call uciqin(name,idx)
          if(idx.ne.0) then
            call ucisvl(idx, value) ;  exit
          end if

          call umiqin(name,idx)
          if(idx.ne.0) then
            call umisvl(idx, value) ;  exit
          end if

          call sgiqin(name,idx)
          if(idx.ne.0) then
            call sgisvl(idx, value) ;  exit
          end if

          call swiqin(name,idx)
          if(idx.ne.0) then
            call swisvl(idx, value) ;  exit
          end if

          call gliqin(name,idx)
          if(idx.ne.0) then
            call glisvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclSetInteger', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udiset(pname,value)
          case('HATCH'   ) ; call ueiset(pname,value)
          case('VECTOR'  ) ; call ugiset(pname,value)
          case('SCALE'   ) ; call usiset(pname,value)
          case('AXIS'    ) ; call uziset(pname,value)
          case('LOG'     ) ; call uliset(pname,value)
          case('CALENDAR') ; call uciset(pname,value)
          case('MAP'     ) ; call umiset(pname,value)
          case('GRAPH'   ) ; call sgiset(pname,value)
          case('DEVICE'  ) ; call swiset(pname,value)
          case('GLOBAL'  ) ; call gliset(pname,value)
          case default
            call msgdmp('E', 'DclSetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetInteger')

    end subroutine
!------------------------------------------------------
    subroutine DclSetReal(name, value)
      real                          :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetReal')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udrqin(name,idx)
          if(idx.ne.0) then
            call udrsvl(idx, value) ;  exit
          end if

          call uerqin(name,idx)
          if(idx.ne.0) then
            call uersvl(idx, value) ;  exit
          end if

          call ugrqin(name,idx)
          if(idx.ne.0) then
            call ugrsvl(idx, value) ;  exit
          end if

          call usrqin(name,idx)
          if(idx.ne.0) then
            call usrsvl(idx, value) ;  exit
          end if

          call uzrqin(name,idx)
          if(idx.ne.0) then
            call uzrsvl(idx, value) ;  exit
          end if

          call ulrqin(name,idx)
          if(idx.ne.0) then
            call ulrsvl(idx, value) ;  exit
          end if

          call ucrqin(name,idx)
          if(idx.ne.0) then
            call ucrsvl(idx, value) ;  exit
          end if

          call umrqin(name,idx)
          if(idx.ne.0) then
            call umrsvl(idx, value) ;  exit
          end if

          call sgrqin(name,idx)
          if(idx.ne.0) then
            call sgrsvl(idx, value) ;  exit
          end if

          call swrqin(name,idx)
          if(idx.ne.0) then
            call swrsvl(idx, value) ;  exit
          end if

          call glrqin(name,idx)
          if(idx.ne.0) then
            call glrsvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclSetParm', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udrset(pname,value)
          case('HATCH'   ) ; call uerset(pname,value)
          case('VECTOR'  ) ; call ugrset(pname,value)
          case('SCALE'   ) ; call usrset(pname,value)
          case('AXIS'    ) ; call uzrset(pname,value)
          case('LOG'     ) ; call ulrset(pname,value)
          case('CALENDAR') ; call ucrset(pname,value)
          case('MAP'     ) ; call umrset(pname,value)
          case('GRAPH'   ) ; call sgrset(pname,value)
          case('DEVICE'  ) ; call swrset(pname,value)
          case('GLOBAL'  ) ; call glrset(pname,value)
          case default
            call msgdmp('E', 'DclSetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetReal')

    end subroutine
!------------------------------------------------------
    subroutine DclSetLogical(name, value)
      logical                       :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetLogical')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call udlqin(name,idx)
          if(idx.ne.0) then
            call udlsvl(idx, value) ;  exit
          end if

          call uelqin(name,idx)
          if(idx.ne.0) then
            call uelsvl(idx, value) ;  exit
          end if

          call uglqin(name,idx)
          if(idx.ne.0) then
            call uglsvl(idx, value) ;  exit
          end if

          call uslqin(name,idx)
          if(idx.ne.0) then
            call uslsvl(idx, value) ;  exit
          end if

          call uzlqin(name,idx)
          if(idx.ne.0) then
            call uzlsvl(idx, value) ;  exit
          end if

          call ullqin(name,idx)
          if(idx.ne.0) then
            call ullsvl(idx, value) ;  exit
          end if

          call uclqin(name,idx)
          if(idx.ne.0) then
            call uclsvl(idx, value) ;  exit
          end if

          call umlqin(name,idx)
          if(idx.ne.0) then
            call umlsvl(idx, value) ;  exit
          end if

          call sglqin(name,idx)
          if(idx.ne.0) then
            call sglsvl(idx, value) ;  exit
          end if

          call swlqin(name,idx)
          if(idx.ne.0) then
            call swlsvl(idx, value) ;  exit
          end if

          call gllqin(name,idx)
          if(idx.ne.0) then
            call gllsvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclSetParm', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udlset(pname,value)
          case('HATCH'   ) ; call uelset(pname,value)
          case('VECTOR'  ) ; call uglset(pname,value)
          case('SCALE'   ) ; call uslset(pname,value)
          case('AXIS'    ) ; call uzlset(pname,value)
          case('LOG'     ) ; call ullset(pname,value)
          case('CALENDAR') ; call uclset(pname,value)
          case('MAP'     ) ; call umlset(pname,value)
          case('GRAPH'   ) ; call sglset(pname,value)
          case('DEVICE'  ) ; call swlset(pname,value)
          case('GLOBAL'  ) ; call gllset(pname,value)
          case default
            call msgdmp('E', 'DclSetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetLogical')

    end subroutine
!------------------------------------------------------
    subroutine DclSetChar(name, value)
      character(len=*)              :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetChar')
      n = index(name, ':')
      if(n.eq.0) then
        do
          call uscqin(name,idx)
          if(idx.ne.0) then
            call uscsvl(idx, value) ;  exit
          end if

          call uzcqin(name,idx)
          if(idx.ne.0) then
            call uzcsvl(idx, value) ;  exit
          end if

          call swcqin(name,idx)
          if(idx.ne.0) then
            call swcsvl(idx, value) ;  exit
          end if

          call glcqin(name,idx)
          if(idx.ne.0) then
            call glcsvl(idx, value) ;  exit
          end if
          call msgdmp('E', 'DclGetChar', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('SCALE'  ) ; call uscset(pname,value)
          case('AXIS'   ) ; call uzcset(pname,value)
          case('DEVICE' ) ; call swcset(pname,value)
          case('GLOBAL' ) ; call glcset(pname,value)
          case default
            call msgdmp('E', 'DclSetParm', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetChar')

    end subroutine
!======================================================
    subroutine DclSetIntegerEX(name, value)
      integer                       :: value, v0
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetIntegerEX')
      n = index(name, ':')
      if(n.eq.0) then
        do
          v0 = value
          call udiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call udisvl(idx, v0) ;  exit
          end if

          call ueiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call ueisvl(idx, v0) ;  exit
          end if

          call ugiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call ugisvl(idx, v0) ;  exit
          end if

          call usiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call usisvl(idx, v0) ;  exit
          end if

          call uziqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call uzisvl(idx, v0) ;  exit
          end if

          call uliqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call ulisvl(idx, v0) ;  exit
          end if

          call uciqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call ucisvl(idx, v0) ;  exit
          end if

          call umiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call umisvl(idx, v0) ;  exit
          end if

          call sgiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call sgisvl(idx, v0) ;  exit
          end if

          call swiqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call swisvl(idx, v0) ;  exit
          end if

          call gliqin(name,idx)
          if(idx.ne.0) then
            call rliget(name, v0, 1)
            call glisvl(idx, v0) ;  exit
          end if
          call msgdmp('E', 'DclSetParmEX', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udistx(pname,value)
          case('HATCH'   ) ; call ueistx(pname,value)
          case('VECTOR'  ) ; call ugistx(pname,value)
          case('SCALE'   ) ; call usistx(pname,value)
          case('AXIS'    ) ; call uzistx(pname,value)
          case('LOG'     ) ; call ulistx(pname,value)
          case('CALENDAR') ; call ucistx(pname,value)
          case('MAP'     ) ; call umistx(pname,value)
          case('GRAPH'   ) ; call sgistx(pname,value)
          case('DEVICE'  ) ; call swistx(pname,value)
          case('GLOBAL'  ) ; call glistx(pname,value)
          case default
            call msgdmp('E', 'DclSetParmEX', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetIntegerEX')

    end subroutine
!------------------------------------------------------
    subroutine DclSetRealEX(name, value)
      real                          :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetRealEX')
      n = index(name, ':')
      if(n.eq.0) then
        do
          v0 = value
          call udrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call udrsvl(idx, v0) ;  exit
          end if

          call uerqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call uersvl(idx, v0) ;  exit
          end if

          call ugrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call ugrsvl(idx, v0) ;  exit
          end if

          call usrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call usrsvl(idx, v0) ;  exit
          end if

          call uzrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call uzrsvl(idx, v0) ;  exit
          end if

          call ulrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call ulrsvl(idx, v0) ;  exit
          end if

          call ucrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call ucrsvl(idx, v0) ;  exit
          end if

          call umrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call umrsvl(idx, v0) ;  exit
          end if

          call sgrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call sgrsvl(idx, v0) ;  exit
          end if

          call swrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call swrsvl(idx, v0) ;  exit
          end if

          call glrqin(name,idx)
          if(idx.ne.0) then
            call rlrget(name, v0, 1)
            call glrsvl(idx, v0) ;  exit
          end if
          call msgdmp('E', 'DclSetParmEX', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udrstx(pname,value)
          case('HATCH'   ) ; call uerstx(pname,value)
          case('VECTOR'  ) ; call ugrstx(pname,value)
          case('SCALE'   ) ; call usrstx(pname,value)
          case('AXIS'    ) ; call uzrstx(pname,value)
          case('LOG'     ) ; call ulrstx(pname,value)
          case('CALENDAR') ; call ucrstx(pname,value)
          case('MAP'     ) ; call umrstx(pname,value)
          case('GRAPH'   ) ; call sgrstx(pname,value)
          case('DEVICE'  ) ; call swrstx(pname,value)
          case('GLOBAL'  ) ; call glrstx(pname,value)
          case default
            call msgdmp('E', 'DclSetParmEX', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetRealEX')

    end subroutine
!------------------------------------------------------
    subroutine DclSetLogicalEX(name, value)
      logical                       :: value, v0
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname

      call prcopn('DclSetLogicalEX')
      n = index(name, ':')
      if(n.eq.0) then
        do
          v0 = value
          call udlqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call udlsvl(idx, v0) ;  exit
          end if

          call uelqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call uelsvl(idx, v0) ;  exit
          end if

          call uglqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call uglsvl(idx, v0) ;  exit
          end if

          call uslqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call uslsvl(idx, v0) ;  exit
          end if

          call uzlqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call uzlsvl(idx, v0) ;  exit
          end if

          call ullqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call ullsvl(idx, v0) ;  exit
          end if

          call uclqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call uclsvl(idx, v0) ;  exit
          end if

          call umlqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call umlsvl(idx, v0) ;  exit
          end if

          call sglqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call sglsvl(idx, v0) ;  exit
          end if

          call swlqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call swlsvl(idx, v0) ;  exit
          end if

          call gllqin(name,idx)
          if(idx.ne.0) then
            call rllget(name, v0, 1)
            call gllsvl(idx, v0) ;  exit
          end if
          call msgdmp('E', 'DclSetParmEX', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('CONTOUR' ) ; call udlstx(pname,value)
          case('HATCH'   ) ; call uelstx(pname,value)
          case('VECTOR'  ) ; call uglstx(pname,value)
          case('SCALE'   ) ; call uslstx(pname,value)
          case('AXIS'    ) ; call uzlstx(pname,value)
          case('LOG'     ) ; call ullstx(pname,value)
          case('CALENDAR') ; call uclstx(pname,value)
          case('MAP'     ) ; call umlstx(pname,value)
          case('GRAPH'   ) ; call sglstx(pname,value)
          case('DEVICE'  ) ; call swlstx(pname,value)
          case('GLOBAL'  ) ; call gllstx(pname,value)
          case default
            call msgdmp('E', 'DclSetParmEX', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetLogicalEX')

    end subroutine
!------------------------------------------------------
    subroutine DclSetCharEX(name, value)
      character(len=*)              :: value
      character(len=*), intent(in)  :: name
      character(len=8)              :: prefix, pname
      character(len=32)             :: v0

      call prcopn('DclSetCharEX')
      n = index(name, ':')
      if(n.eq.0) then
        do
          v0 = value
          call uscqin(name,idx)
          if(idx.ne.0) then
            call rlcget(name, v0, 1)
            call uscsvl(idx, v0) ;  exit
          end if

          call uzcqin(name,idx)
          if(idx.ne.0) then
            call rlcget(name, v0, 1)
            call uzcsvl(idx, v0) ;  exit
          end if

          call swcqin(name,idx)
          if(idx.ne.0) then
            call rlcget(name, v0, 1)
            call swcsvl(idx, v0) ;  exit
          end if

          call glcqin(name,idx)
          if(idx.ne.0) then
            call rlcget(name, v0, 1)
            call glcsvl(idx, v0) ;  exit
          end if
          call msgdmp('E', 'DclSetParmEX', 'Invalid parameter ['//name//']')
        end do
      else
        prefix = name(1:n-1)
        pname  = name(n+1:)
        call cupper(prefix)

        select case(prefix)
          case('SCALE' ) ; call uscstx(pname,value)
          case('AXIS'  ) ; call uzcstx(pname,value)
          case('DEVICE') ; call swcstx(pname,value)
          case('GLOBAL') ; call glcstx(pname,value)
         case default
            call msgdmp('E', 'DclSetParmEX', 'Invalid prefix ['//prefix//']')
        end select
      end if
      call prccls('DclSetCharEX')

    end subroutine
end module dcl_parm
