C  5 Feb 05 - OQ  - New module for extended TDHF properties
C
C     This module provides functionnalities to save and retrieve
C     quantities (matrices, tensors, ...) of different orders of
C     perturbation.  Up to now, the supported perturbations are the
C     geometric deformation and the dynamic electric fields
C
C     Here's the list of implemented type and their associated variables
C     'ANY'      :
C     'FREE'     :
C     '0'        :
C     'F'        : 'ALPHA'
C     'FG'       : 'BETA'
C     'FGH'      : 'GAMMA'
C
C     Normally this should be implemented with Fortran 90 type
C     to be more efficient and more flexible.
C
C*MODULE TDXIO   *DECK IOInit
      subroutine IOInit
      implicit none
C     Variables and constants
      integer islot,islotx
C     Used common blocks
      integer MAXSLOT
      parameter (MAXSLOT=64)
      logical bDipSet,bQuadSet
      double precision dipole,quadrupole
      common/OLI_MULTIPOLE/dipole(3),quadrupole(9),bDipSet,bQuadSet
C     Body of the subprogram
      bDipSet = .false.
      bQuadSet = .false.
      do islot = 1,MAXSLOT
         islotx = islot
         call ResetSlot(islotx)
      end do
      end
C
C*module tdxio   FindVar
      function FindVar(islot,name)
      implicit none
C     Arguments
      integer FindVar,islot
      character*8 name
C     Variables and constants
      integer ivar,inewvar
      character*8 sNONEVAR
      parameter (sNONEVAR='********')
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      inewvar = 0
      do ivar = 1,MAXVAR
         if(listvar(ivar,islot).eq.name) then
            inewvar = ivar
            if(name.eq.sNONEVAR) then
               FindVar = inewvar
               return
            end if
         end if
      end do
      FindVar = inewvar
      end
C
C*MODULE TDXIO   *DECK FindFreeVar
      function FindFreeVar(islot)
      implicit none
C     Arguments
      integer FindFreeVar,islot
C     Variables and constants
      character*8 sNONEVAR
      parameter (sNONEVAR='********')
C     Called subprogram
      integer FindVar
C     Body of the subprogram
      FindFreeVar = FindVar(islot,sNONEVAR)
      end
C
C*MODULE TDXIO   *DECK AddVar
      function AddVar(islot,name,size)
      implicit none
C     Arguments
      integer AddVar,islot,size
      character*8 name
C     Variables and constants
      integer ivar
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Called subprogram
      integer FindFreeVar
C     Body of the subprogram
      ivar = FindFreeVar(islot)
      write(0,*) "TDXIO:AddVar(",islot,",",name,",",size,")=",ivar
      if(ivar.ne.0) then
         listvar(ivar,islot) = name
         listsize(ivar,islot) = size
      else
         call abrtx("ADDVAR")
      end if
      AddVar = ivar
      end
C
C*MODULE TDXIO   *DECK ReadDataHeader
      subroutine ReadDataHeader(ifile,ivar,islot)
      implicit none
C     Arguments
      integer ifile,ivar,islot
C     Variables
      integer isize,len
      character*8 sname
      double precision header(2)
      equivalence (header(1),sname),(header(2),isize)
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      len=2
      call SQREAD(ifile,header,len)
      write(0,*) 'TDXIO:ReadDataHeader', islot,':',ivar,';',
     &     sname,'=',listvar(ivar,islot),
     &     isize,'=',listsize(ivar,islot)
C      isize = listsize(ivar,islot)
C      sname = listvar(ivar,islot)
      end
C
C*MODULE TDXIO   *DECK WriteDataHeader
      subroutine WriteDataHeader(ifile,ivar,islot)
      implicit none
C     Arguments
      integer ifile,ivar,islot
C     Variables
      integer isize
      character*8 sname
      double precision header(2)
      equivalence (header(1),sname),(header(2),isize)
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      isize = listsize(ivar,islot)
      sname = listvar(ivar,islot)
      call SQWRIT(ifile,header,2)
      write(0,*) 'TDXIO:WriteDataHeader:', islot,':',ivar,';',
     &           sname,',',isize
      end
C
C*MODULE TDXIO   *DECK SkipData
      subroutine SkipData(ifile)
      implicit none
C     Arguments
      integer ifile
C     Body of the subprogram
      call SEQADV(ifile)
      call SEQADV(ifile)
      end
C
C*MODULE TDXIO   *DECK PreLoad
      subroutine PreLoad(ifile,ivar,islot,type,listw,nw)
      implicit none
C     Argument
      integer ifile,ivar,islot
      character*8 type
      integer nw
      double precision listw(nw)
C     Called subprogram
      integer FindSlot
C     Body of the subprogram
      ifile = 0
      ivar  = 0
C     first check slot
      islot = FindSlot(type,listw,nw,.true.)
      if(islot.eq.0) return
C     then set file id
      ifile = -(200+islot)
      ivar = 1
      end
C
C*MODULE TDXIO   *DECK PostLoad
      subroutine PostLoad(ifile)
      implicit none
C     Arguments
      integer ifile
C     Body of the subprogram
      if(ifile.le.0) return
      call SEQCLO(ifile,'KEEP')
      end
C
C*MODULE TDXIO   *DECK LoadData
      function LoadData(ifile,ivar,islot,name,buffer,bLoad)
      implicit none
C     Arguments
      logical LoadData
      integer ifile,ivar,islot
      character*8 name
      double precision buffer(*)
      logical bLoad
C     Variables and constant
      integer inewvar,idummy
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Called subprogram
      character*6 GetSlotName
      integer FindVar
C     Body of the subprogram
      if(ifile.eq.0) then
         LoadData = .false.
         return
      end if
C     Check for the existence of name
      inewvar = FindVar(islot,name)
      if(inewvar.eq.0) then
         LoadData = .false.
         return
      end if
      LoadData = .true.
C     Load data if needed
      if(.not.bLoad) return
C     Open file if not yet done
      if(ifile.le.0) then
         ifile = -ifile
         call SEQOPN(ifile,GetSlotName(islot),'UNKNOWN',.TRUE.,
     &               'UNFORMATTED')
      end if
      if(inewvar.lt.ivar) then
         call SEQREW(ifile)
         ivar = 1
      end if
      if(inewvar.gt.ivar) then
         do idummy = ivar,inewvar-1
            call SkipData(ifile)
         end do
      end if
      ivar = inewvar
C     Use of idummy here because SQREAD set its size argument to 0 in
C     case of success...
      call ReadDataHeader(ifile,ivar,islot)
      idummy = listsize(ivar,islot)
      call SQREAD(ifile,buffer,idummy)
      ivar = ivar+1
      end
C
C*MODULE TDXIO   *DECK LoadOneVar
      function LoadOneVar(type,listw,nw,name,buffer,bLoad)
      implicit none
C     Arguments
      logical LoadOneVar
      character*8 type
      integer nw
      double precision listw(nw),buffer(*)
      character*8 name
      logical bLoad
C     Variables and constants
      integer islot,ifile,ivar
C     Called subprogram
      logical LoadData
C     Body of the subprogram
      call PreLoad(ifile,ivar,islot,type,listw,nw)
      LoadOneVar = LoadData(ifile,ivar,islot,name,buffer,bLoad)
      call PostLoad(ifile)
      end
C
C*MODULE TDXIO   *DECK SaveOneVar
      subroutine SaveOneVar(type,listw,nw,name,buffer,isize)
      implicit none
C     Argument
      character*8 type
      integer nw,isize
      double precision listw(nw),buffer(isize)
      character*8 name
C     Variables and constants
      integer islot,ifile,ivar
C     Body of the subprogram
      call PreSave(ifile,ivar,islot,type,listw,nw)
      call SaveData(ifile,ivar,islot,name,buffer,isize)
      call PostSave(ifile)
      end
C
C*MODULE TDXIO   *DECK PreSave
      subroutine PreSave(ifile,ivar,islot,type,listw,nw)
      implicit none
C     Argument
      integer ifile,ivar,islot
      character*8 type
      integer nw
      double precision listw(nw)
C     Variables and constants
      integer i
C     Called subprogram
      character*6 GetSlotName
      character*8 GetSlotType
      integer FindFreeVar,FindSlot,FindFreeSlot
C     Body of the subprogram
      ifile = 0
      ivar  = 0
      islot = 0
C     first obtain a slot
      islot = FindSlot(type,listw,nw,.true.)
      if(islot.eq.0) islot = FindFreeSlot()
      if(islot.eq.0) return
C     then open file
      ifile = 200+islot
      if(GetSlotType(islot).ne.type) then
         call SetSlot(islot,type,listw,nw)
         call SEQOPN(ifile,GetSlotName(islot),'UNKNOWN',.FALSE.,
     &               'UNFORMATTED')
         ivar = 1
      else
         call SEQOPN(ifile,GetSlotName(islot),'OLD',.FALSE.,
     &               'UNFORMATTED')
         ivar = FindFreeVar(islot)
         do i = 1,ivar-1
            call SkipData(ifile)
         end do
      end if
      end
C
C*MODULE TDXIO   *DECK PostSave
      subroutine PostSave(ifile)
      implicit none
C     Argument
      integer ifile
C     Body of the subprogram
      if(ifile.eq.0) return
      call SEQCLO(ifile,'KEEP')
      end
C
C*MODULE TDXIO   *DECK SaveData
      subroutine SaveData(ifile,ivar,islot,name,buffer,size)
      implicit none
C     Arguments
      integer ifile,ivar,islot,size
      character*8 name
      double precision buffer(size)
C     Variables and constant
      integer inewvar,idummy
C     Called subprogram
      integer AddVar
C     Body of the subprogram
      if(ifile.eq.0) return
      idummy = size
      inewvar = AddVar(islot,name,size)
      call WriteDataHeader(ifile,inewvar,islot)
      call SQWRIT(ifile,buffer,idummy)
C      write(*,*) "SaveData(",name,") in file ",ifile,ivar,islot
      ivar = inewvar+1
C      end if
      end
C
C*MODULE TDXIO   *DECK GetSlotName
      function GetSlotName(islot)
      implicit none
C     Argument
      character*6 GetSlotName
      integer islot
C     Variable
      integer idummy
C     Body of the subprogram
      idummy = 200+islot
      write(GetSlotName,1000) idummy
 1000 format('OLI',I3.3)
      end
C
C*MODULE TDXIO   *DECK FindSlot
      function FindSlot(type,w,nw,bExact)
      implicit none
C     Arguments
      integer FindSlot
      character*8 type
      integer nw
      double precision w(nw)
      logical bExact
C     Variables and constants
      integer iw,islot,ibestslot
      double precision sum,diff,bestsum
      character*8 sANY,STYPEREE
      parameter (sANY='ANY',STYPEREE='FREE')
      double precision ZERO,THRS
      parameter (ZERO=0.0D+00,THRS=1.0D-12)
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      ibestslot = 0
      bestsum = 0.0D+00
      do islot = 1,MAXSLOT
         if( (type.eq.listtype(islot)).or.
     &      ((type.eq.sANY).and.(listtype(islot).ne.STYPEREE))) then
            sum = ZERO
            do iw = 1,nw
               diff = listomega(iw,islot)-w(iw)
               sum = sum + diff*diff
            end do
            if(bExact) then
               if(sum.le.THRS) then
                  FindSlot = islot
                  return
               end if
            else if((ibestslot.eq.0).or.(sum.le.bestsum)) then
               ibestslot = islot
               bestsum = sum
            end if
         end if
      end do
      FindSlot = ibestslot
      end
C
C*MODULE TDXIO   *DECK GetSlotType
      function GetSlotType(islot)
      implicit none
C     Arguments
      character*8 GetSlotType
      integer islot
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      GetSlotType = listtype(islot)
      end
C
C*MODULE TDXIO   *DECK SetSlot
      subroutine SetSlot(islot,type,w,nw)
      implicit none
C     Arguments
      integer islot
      character*8 type
      integer nw
      double precision w(nw)
C     Variables and constants
      integer iw,ivar
      double precision ZERO
      parameter (ZERO=0.0D+00)
      character*8 sNONEVAR
      parameter (sNONEVAR='********')
C     Used common block
      integer MAXSLOT,MAXNW,MAXVAR
      parameter (MAXSLOT=64,MAXNW=3,MAXVAR=20)
      character*8 listtype
      double precision listomega
      character*8 listvar
      integer listsize
      common/OLI_IO/listtype(MAXSLOT),listomega(MAXNW,MAXSLOT),
     &              listvar(MAXVAR,MAXSLOT),listsize(MAXVAR,MAXSLOT)
C     Body of the subprogram
      listtype(islot)=type
      write(0,*) "TDXIO:SetSlot(",islot,",",type,",{",w,"},",nw,")"
      do iw = 1,nw
         listomega(iw,islot) = w(iw)
      end do
      do iw = nw+1,MAXNW
         listomega(iw,islot) = ZERO
      end do
      do ivar = 1,MAXVAR
         listvar(ivar,islot) = sNONEVAR
         listsize(ivar,islot) = 0
      end do
      end
C
C*MODULE TDXIO   *DECK FindFreeSlot
      function FindFreeSlot()
      implicit none
C     Argument
      integer FindFreeSlot
C     Variables and constants
      character*8 STYPEREE
      integer nw
      parameter (nw=0)
      double precision w,ZERO
      parameter (STYPEREE='FREE',ZERO=0.0D+00)
C     Called subprogram
      integer FindSlot
C     Body of the subprogram
      w = ZERO
      FindFreeSlot = FindSlot(STYPEREE,w,nw,.true.)
      end
C
C*MODULE TDXIO   *DECK ResetSlot
      subroutine ResetSlot(islot)
      implicit none
C     Argument
      integer islot
C     Variables and constants
      character*8 STYPEREE
      parameter (STYPEREE='FREE')
      integer nw
      parameter (nw=0)
      double precision listw(1),ZERO
      parameter (ZERO=0.0D+00)
C     Body of the subprogram
      listw(1) = ZERO
      call SetSlot(islot,STYPEREE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK FreeSlot
      subroutine FreeSlot(STYPE,w,nw)
      implicit none
C     Arguments
      character*8 STYPE
      integer nw
      double precision w(nw)
C     Variable
      integer islot
C     Called subprogram
      integer FindSlot
C     Body of the subprogram
      islot = FindSlot(STYPE,w,nw,.true.)
      if(islot.ne.0) call ResetSlot(islot)
      end
C
C*MODULE TDXIO   *DECK FreeSlots
      subroutine FreeSlots(w,nw)
      implicit none
C     Arguments
      integer nw
      double precision w(nw)
C     Variables and constants
      integer islot
      character*8 sANY
      parameter (sANY='ANY')
C     Called subprograms
      integer FindSlot
C     Body of the subprogram
C
C     Fortran 90 solution
C      do
C     Fortran 77 ugly solution
 100  continue
         islot = FindSlot(sANY,w,nw,.true.)
         if(islot.eq.0) return
         call ResetSlot(islot)
C     Fortran 90 solution
C      end do
C     Fortran 77 ugly solution
      goto 100
      end
C
C*MODULE TDXIO   *DECK TransformAsGMat
      subroutine TransformAsGMat(norb,nparams,G)
      implicit none
C     Arguments
      integer norb,nparams
      double precision G(norb,norb,nparams)
C     Variables
      integer iparam,i,j
      double precision dummy
C     Body of the subprogram
      do iparam = 1,nparams
         do j = 1,norb
            do i = 1,j-1
               dummy = G(i,j,iparam)
               G(i,j,iparam) = G(j,i,iparam)
               G(j,i,iparam) = dummy
            end do
         end do
      end do
      end
C
C*MODULE TDXIO   *DECK TransformAsUMat
      subroutine TransformAsUMat(norb,nparams,U,X,bX)
      implicit none
C     Arguments
      integer norb,nparams
      double precision U(norb,norb,nparams),X(norb,norb,nparams)
      logical bX
C     Variables
      integer iparam,i,j
      double precision dummy
C     Body of the subprogram
      if(bX) then
         do iparam = 1,nparams
            do j = 1,norb
               do i = 1,j-1
                  dummy = U(i,j,iparam)
                  U(i,j,iparam) = X(j,i,iparam)-U(j,i,iparam)
                  U(j,i,iparam) = X(i,j,iparam)-dummy
               end do
               U(j,j,iparam) = X(j,j,iparam)-U(j,j,iparam)
            end do
         end do
      else
         do iparam = 1,nparams
            do j = 1,norb
               do i = 1,j-1
                  dummy = U(i,j,iparam)
                  U(i,j,iparam) = -U(j,i,iparam)
                  U(j,i,iparam) = -dummy
               end do
            end do
         end do
      end if
      end
C
C*MODULE TDXIO   *DECK GetDipole
      subroutine GetDipole(dip,bLoad,GotDip)
      implicit none
C     Arguments
      logical GotDip
      double precision dip(3)
      logical bLoad
C     Used common block
      logical bDipSet,bQuadSet
      double precision dipole,quadrupole
      common/OLI_MULTIPOLE/dipole(3),quadrupole(9),bDipSet,bQuadSet
C     Body of the subprogram
      if(bDipSet) then
         GotDip = .true.
         if(bLoad) then
            dip(1) = dipole(1)
            dip(2) = dipole(2)
            dip(3) = dipole(3)
         end if
      else
         GotDip = .false.
      end if
      end
C
C*MODULE TDXIO   *DECK SetDipole
      subroutine SetDipole(dip)
      implicit none
C     Arguments
      double precision dip(3)
C     Used common block
      logical bDipSet,bQuadSet
      double precision dipole,quadrupole
      common/OLI_MULTIPOLE/dipole(3),quadrupole(9),bDipSet,bQuadSet
C     Body of the subprogram
      bDipSet=.true.
      dipole(1) = dip(1)
      dipole(2) = dip(2)
      dipole(3) = dip(3)
      end
C
C--C*MODULE TDXIO   *DECK GetQuadrupole
C--      function GetQuadrupole(quad,bLoad)
C--      implicit none
C--C     Arguments
C--      logical GetQuadrupole
C--      double precision quad(9)
C--      logical bLoad
C--C     Used common block
C--      logical bDipSet,bQuadSet
C--      double precision dipole,quadrupole
C--      common/OLI_MULTIPOLE/dipole(3),quadrupole(9),bDipSet,bQuadSet
C--C     Body of the subprogram
C--      if(bQuadSet) then
C--         GetQuadrupole = .true.
C--         if(bLoad) then
C--            call DCOPY(9,quadrupole,1,quad,1)
C--         end if
C--      else
C--         GetQuadrupole = .false.
C--      end if
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetQuadrupole
C--      subroutine SetQuadrupole(quad)
C--      implicit none
C--C     Arguments
C--      double precision quad(9)
C--C     Used common block
C--      logical bDipSet,bQuadSet
C--      double precision dipole,quadrupole
C--      common/OLI_MULTIPOLE/dipole(3),quadrupole(9),bDipSet,bQuadSet
C--C     Body of the subprogram
C--      bQuadSet=.true.
C--      call DCOPY(9,quad,1,quadrupole,1)
C--      end
C
C*MODULE TDXIO   *DECK GetHf
      function GetHf(Hf,bLoad)
      implicit none
C     Arguments
      logical GetHf
      double precision Hf(*)
      logical bLoad
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHF
      parameter (STYPE='0',sHF='HF')
      integer nw
      parameter (nw=0)
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,nw,sHF,Hf,bLoad)) then
         GetHF=.true.
         return
      end if
      GetHF=.false.
      end
C
C*MODULE TDXIO   *DECK SetHf
      subroutine SetHf(Hf,norb,nfld)
      implicit none
C     Argument
      integer norb,nfld
      double precision Hf(norb*norb,nfld)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHF
      parameter (STYPE='0',sHF='HF')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sHF,Hf,norb*norb*nfld)
      end
C
C*MODULE TDXIO   *DECK GetHfa
      function GetHfa(Hfa,bLoad)
      implicit none
C     Arguments
      logical GetHfa
      double precision Hfa(*)
      logical bLoad
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHFa
      parameter (STYPE='0',sHFa='HFa')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sHFa,HFa,bLoad)) then
         GetHFa=.true.
         return
      end if
      GetHFa=.false.
      end
C
C*MODULE TDXIO   *DECK SetHfa
      subroutine SetHfa(Hfa,norb,nxyz,nfld)
      implicit none
C     Argument
      integer norb,nxyz,nfld
      double precision Hfa(*)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHFa
      parameter (STYPE='0',sHFa='HFa')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sHFa,Hfa,norb*norb*nxyz*nfld)
      end
C
C*MODULE TDXIO   *DECK GetHfab
      function GetHfab(Hfab,b)
      implicit none
C     Arguments
      logical GetHfab
      double precision Hfab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHFab
      parameter (STYPE='0',sHFab='HFab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sHFab,HFab,b)) then
         GetHFab=.true.
         return
      end if
      GetHFab=.false.
      end
C
C*MODULE TDXIO   *DECK SetHfab
      subroutine SetHfab(Hfab,norb,nxyz2,nfld)
      implicit none
C     Argument
      integer norb,nxyz2,nfld
      double precision Hfab(*)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHFab
      parameter (STYPE='0',sHFab='HFab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sHFab,Hfab,norb*norb*nxyz2*nfld)
      end
C
C--C*MODULE TDXIO   *DECK GetNop
C--      function GetNop(Nop,bLoad)
C--      implicit none
C--C     Arguments
C--      logical GetNop
C--      double precision Nop(*)
C--      logical bLoad
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sNop
C--      parameter (STYPE='0',sNop='Nop')
C--      integer nw
C--      parameter (nw=0)
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1)=0.0D+00
C--      if(LoadOneVar(STYPE,listw,nw,sNop,Nop,bLoad)) then
C--         GetNop=.true.
C--         return
C--      end if
C--      GetNop=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetNop
C--      subroutine SetNop(Nop,norb,nfld)
C--      implicit none
C--C     Argument
C--      integer norb,nfld
C--      double precision Nop(norb*norb,nfld,nfld)
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sNop
C--      parameter (STYPE='0',sNop='Nop')
C--C     Body of the subprogram
C--      call SaveOneVar(STYPE,listw,0,sNop,Nop,norb*norb*nfld*nfld)
C--      end
C--C
C--C*MODULE TDXIO   *DECK GetNopa
C--      function GetNopa(Nopa,bLoad)
C--      implicit none
C--C     Arguments
C--      logical GetNopa
C--      double precision Nopa(*)
C--      logical bLoad
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sNopa
C--      parameter (STYPE='0',sNopa='Nopa')
C--      integer nw
C--      parameter (nw=0)
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1)=0.0D+00
C--      if(LoadOneVar(STYPE,listw,nw,sNopa,Nopa,bLoad)) then
C--         GetNopa=.true.
C--         return
C--      end if
C--      GetNopa=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetNopa
C--      subroutine SetNopa(Nopa,norb,nxyz,nfld)
C--      implicit none
C--C     Argument
C--      integer norb,nxyz,nfld
C--      double precision Nopa(norb*norb,nxyz,nfld,nfld)
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sNopa
C--      parameter (STYPE='0',sNopa='Nopa')
C--C     Body of the subprogram
C--      call SaveOneVar(STYPE,listw,0,sNopa,Nopa,
C--     &                norb*norb*nxyz*nfld*nfld)
C--      end
C
C*MODULE TDXIO   *DECK GetFFab
      function GetFFab(FFab,b)
      implicit none
C     Arguments
      logical GetFFab
      double precision FFab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sFFab
      parameter (STYPE='0',sFFab='FFab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sFFab,FFab,b)) then
         GetFFab=.true.
         return
      end if
      GetFFab=.false.
      end
C
C*MODULE TDXIO   *DECK SetFFab
      subroutine SetFFab(FFab,norb,nxyz2)
      implicit none
C     Argument
      integer norb,nxyz2
      double precision FFab(norb*norb,nxyz2)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sFFab
      parameter (STYPE='0',sFFab='FFab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sFFab,FFab,norb*norb*nxyz2)
      end
C
C*MODULE TDXIO   *DECK GetHab
      function GetHab(Hab,b)
      implicit none
C     Arguments
      logical GetHab
      double precision Hab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHab
      parameter (STYPE='0',sHab='Hab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sHab,Hab,b)) then
         GetHab=.true.
         return
      end if
      GetHab=.false.
      end
C
C*MODULE TDXIO   *DECK SetHab
      subroutine SetHab(Hab,norb,nxyz2)
      implicit none
C     Argument
      integer norb,nxyz2
      double precision Hab(norb*norb,nxyz2)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sHab
      parameter (STYPE='0',sHab='Hab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sHab,Hab,norb*norb*nxyz2)
      end
C
C*MODULE TDXIO   *DECK GetIab
      function GetIab(Iab,b)
      implicit none
C     Arguments
      logical GetIab
      double precision Iab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sIab
      parameter (STYPE='0',sIab='Iab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sIab,Iab,b)) then
         GetIab=.true.
         return
      end if
      GetIab=.false.
      end
C
C*MODULE TDXIO   *DECK SetIab
      subroutine SetIab(Iab,norb,nxyz2)
      implicit none
C     Argument
      integer norb,nxyz2
      double precision Iab(norb*norb,nxyz2)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sIab
      parameter (STYPE='0',sIab='Iab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sIab,Iab,norb*norb*nxyz2)
      end
C
C*MODULE TDXIO   *DECK GetJab
      function GetJab(Jab,b)
      implicit none
C     Arguments
      logical GetJab
      double precision Jab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sJab
      parameter (STYPE='0',sJab='Jab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sJab,Jab,b)) then
         GetJab=.true.
         return
      end if
      GetJab=.false.
      end
C
C*MODULE TDXIO   *DECK SetJab
      subroutine SetJab(Jab,norb,nxyz2)
      implicit none
C     Argument
      integer norb,nxyz2
      double precision Jab(norb*norb,nxyz2)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sJab
      parameter (STYPE='0',sJab='Jab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sJab,Jab,norb*norb*nxyz2)
      end
C
C--C*MODULE TDXIO   *DECK GetDDab
C--      function GetDDab(DDab,b)
C--      implicit none
C--C     Arguments
C--      logical GetDDab
C--      double precision DDab(*)
C--      logical b
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sDDab
C--      parameter (STYPE='0',sDDab='DDab')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1)=0.0D+00
C--      if(LoadOneVar(STYPE,listw,0,sDDab,DDab,b)) then
C--         GetDDab=.true.
C--         return
C--      end if
C--      GetDDab=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetDDab
C--      subroutine SetDDab(DDab,norb,nxyz2)
C--      implicit none
C--C     Argument
C--      integer norb,nxyz2
C--      double precision DDab(norb*norb,nxyz2)
C--C     Variables and constants
C--      double precision listw(1)
C--      character*8 STYPE,sDDab
C--      parameter (STYPE='0',sDDab='DDab')
C--C     Body of the subprogram
C--      call SaveOneVar(STYPE,listw,0,sDDab,DDab,norb*norb*nxyz2)
C--      end
C
C*MODULE TDXIO   *DECK GetXab
      function GetXab(Xab,b)
      implicit none
C     Arguments
      logical GetXab
      double precision Xab(*)
      logical b
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sXab
      parameter (STYPE='0',sXab='Xab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1)=0.0D+00
      if(LoadOneVar(STYPE,listw,0,sXab,Xab,b)) then
         GetXab=.true.
         return
      end if
      GetXab=.false.
      end
C
C*MODULE TDXIO   *DECK SetXab
      subroutine SetXab(Xab,norb,nxyz2)
      implicit none
C     Argument
      integer norb,nxyz2
      double precision Xab(norb*norb,nxyz2)
C     Variables and constants
      double precision listw(1)
      character*8 STYPE,sXab
      parameter (STYPE='0',sXab='Xab')
C     Body of the subprogram
      call SaveOneVar(STYPE,listw,0,sXab,Xab,norb*norb*nxyz2)
      end
C
C*MODULE TDXIO   *DECK GetFFfa
      function GetFFfa(w,FFfa,bLoad)
      implicit none
C     Arguments
      logical GetFFfa
      double precision w,FFfa(*)
      logical bLoad
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sFFfa
      parameter (STYPE='FA',sFFfa='FFfa')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1) = w
      if(LoadOneVar(STYPE,listw,nw,sFFfa,FFfa,bLoad)) then
         GetFFFa=.true.
         return
      end if
      GetFFFa=.false.
      end
C
C*MODULE TDXIO   *DECK SetFFfa
      subroutine SetFFfa(w,FFfa,norb,nxyz,nfld)
      implicit none
C     Argument
      integer norb,nxyz,nfld
      double precision w,FFfa(*)
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sFFfa
      parameter (STYPE='FA',sFFfa='FFfa')
C     Body of the subprogram
      listw(1) = w
      call SaveOneVar(STYPE,listw,nw,sFFfa,FFfa,norb*norb*nxyz*nfld)
      end
C
C*MODULE TDXIO   *DECK GetFFfab
      function GetFFfab(w,FFfab,bLoad)
      implicit none
C     Arguments
      logical GetFFfab
      double precision w,FFfab(*)
      logical bLoad
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sFFfab
      parameter (STYPE='FAB',sFFfab='FFfab')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1) = w
      if(LoadOneVar(STYPE,listw,nw,sFFfab,FFfab,bLoad)) then
         GetFFFab=.true.
         return
      end if
      GetFFFab=.false.
      end
C
C*MODULE TDXIO   *DECK SetFFfab
      subroutine SetFFfab(w,FFfab,norb,nxyz2,nfld)
      implicit none
C     Argument
      integer norb,nxyz2,nfld
      double precision w,FFfab(*)
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sFFfab
      parameter (STYPE='FAB',sFFfab='FFfab')
C     Body of the subprogram
      listw(1) = w
      call SaveOneVar(STYPE,listw,nw,sFFfab,FFfab,norb*norb*nxyz2*nfld)
      end
C
C--C*MODULE TDXIO   *DECK GetAlpha
C--      function GetAlpha(w,alpha,bA)
C--      implicit none
C--C     Arguments
C--      logical GetAlpha
C--      double precision w,alpha(9)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sALPHA
C--      parameter (STYPE='F',sALPHA='ALPHA')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w
C--      if(LoadOneVar(STYPE,listw,nw,sALPHA,alpha,bA)) then
C--         GetAlpha=.true.
C--         return
C--      end if
C--      listw(1) = -w
C--      if(LoadOneVar(STYPE,listw,nw,sALPHA,alpha,bA)) then
C--         GetAlpha=.true.
C--         return
C--      end if
C--      GetAlpha=.false.
C--      end
C
C*MODULE TDXIO   *DECK SetAlpha
      subroutine SetAlpha(w,alpha)
      implicit none
C     Argument
      double precision w,alpha(9)
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sALPHA
      parameter (STYPE='F',sALPHA='ALPHA')
C     Body of the subprogram
      listw(1) = w
      call SaveOneVar(STYPE,listw,nw,sALPHA,alpha,9)
      end
C
C--C*MODULE TDXIO   *DECK GetUpperA
C--      function GetUpperA(w,upperA,bA)
C--      implicit none
C--C     Arguments
C--      logical GetUpperA
C--      double precision w,upperA(27)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sUPPERA
C--      parameter (STYPE='F',sUPPERA='UPPERA')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w
C--      if(LoadOneVar(STYPE,listw,nw,sUPPERA,upperA,bA)) then
C--         GetUpperA=.true.
C--         return
C--      end if
C--      listw(1) = -w
C--      if(LoadOneVar(STYPE,listw,nw,sUPPERA,uppera,bA)) then
C--         GetUpperA=.true.
C--         return
C--      end if
C--      GetUpperA=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetUpperA
C--      subroutine SetUpperA(w,upperA)
C--      implicit none
C--C     Argument
C--      double precision w,upperA(27)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sUPPERA
C--      parameter (STYPE='F',sUPPERA='UPPERA')
C--C     Body of the subprogram
C--      listw(1) = w
C--      call SaveOneVar(STYPE,listw,nw,sUPPERA,upperA,27)
C--      end
C--C
C--C*MODULE TDXIO   *DECK GetBeta
C--      function GetBeta(w1,w2,beta,bB)
C--      implicit none
C--C     Arguments
C--      logical GetBeta
C--      double precision w1,w2,beta(27)
C--      logical bB
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=2)
C--      double precision listw(nw)
C--      character*8 STYPE,sBETA
C--      parameter (STYPE='FG',sBETA='BETA')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      if(LoadOneVar(STYPE,listw,nw,sBETA,beta,bB)) then
C--         GetBeta=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      if(LoadOneVar(STYPE,listw,nw,sBETA,beta,bB)) then
C--         GetBeta=.true.
C--         return
C--      end if
C--      GetBeta=.false.
C--      end
C
C*MODULE TDXIO   *DECK SetBeta
      subroutine SetBeta(w1,w2,beta)
      implicit none
C     Argument
      double precision w1,w2,beta(27)
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sBETA
      parameter (STYPE='FG',sBETA='BETA')
C     Body of the subprogram
      listw(1) = w1
      listw(2) = w2
      call SaveOneVar(STYPE,listw,nw,sBETA,beta,27)
      end
C
C--C*MODULE TDXIO   *DECK GetGamma
C--      function GetGamma(w1,w2,w3,gamma,bG)
C--      implicit none
C--C     Arguments
C--      logical GetGamma
C--      double precision w1,w2,w3,gamma(21)
C--      logical bG
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=3)
C--      double precision listw(nw)
C--      character*8 STYPE,sGAMMA
C--      parameter (STYPE='FGH',sGAMMA='GAMMA')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      listw(3) = w3
C--      if(LoadOneVar(STYPE,listw,nw,sGAMMA,gamma,bG)) then
C--         GetGamma=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      listw(3) = -w3
C--      if(LoadOneVar(STYPE,listw,nw,sGAMMA,gamma,bG)) then
C--         GetGamma=.true.
C--         return
C--      end if
C--      GetGamma=.false.
C--      end
C--C
C*MODULE TDXIO   *DECK SetGamma
      subroutine SetGamma(w1,w2,w3,gamma)
      implicit none
C     Argument
      double precision w1,w2,w3,gamma(21)
C     Variables and constants
      integer nw
      parameter (nw=3)
      double precision listw(nw)
      character*8 STYPE,sGAMMA
      parameter (STYPE='FGH',sGAMMA='GAMMA')
C     Body of the subprogram
      listw(1) = w1
      listw(2) = w2
      listw(3) = w3
      call SaveOneVar(STYPE,listw,nw,sGAMMA,gamma,21)
      end
C--C
C--C*MODULE TDXIO   *DECK GetdAlphadX
C--      function GetdAlphadX(w,dadx,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdAlphadX
C--      double precision w,dadx(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sDADX
C--      parameter (STYPE='FA',sDADX='DADX')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w
C--      if(LoadOneVar(STYPE,listw,nw,sDADX,dadx,bA)) then
C--         GetdAlphadX=.true.
C--         return
C--      end if
C--      listw(1) = -w
C--      if(LoadOneVar(STYPE,listw,nw,sDADX,dadx,bA)) then
C--         GetdAlphadX=.true.
C--         return
C--      end if
C--      GetdAlphadX=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetdAlphadX
C--      subroutine SetdAlphadX(w,dadx,nxyz)
C--      implicit none
C--C     Argument
C--      integer nxyz
C--      double precision w,dadx(*)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sDADX
C--      parameter (STYPE='FA',sDADX='DADX')
C--      integer nparams
C--C     Body of the subprogram
C--      listw(1) = w
C--      nparams = 9*nxyz
C--      call SaveOneVar(STYPE,listw,nw,sDADX,dadx,nparams)
C--      end
C--C
C--C*MODULE TDXIO   *DECK GetdBetadX
C--      function GetdBetadX(w1,w2,dbdx,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdBetadX
C--      double precision w1,w2,dbdx(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=2)
C--      double precision listw(nw)
C--      character*8 STYPE,sDBDX
C--      parameter (STYPE='FGA',sDBDX='DBDX')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      if(LoadOneVar(STYPE,listw,nw,sDBDX,dbdx,bA)) then
C--         GetdBetadX=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      if(LoadOneVar(STYPE,listw,nw,sDBDX,dbdx,bA)) then
C--         GetdBetadX=.true.
C--         return
C--      end if
C--      GetdBetadX=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetdBetadX
C--      subroutine SetdBetadX(w1,w2,dbdx,nxyz)
C--      implicit none
C--C     Argument
C--      integer nxyz
C--      double precision w1,w2,dbdx(*)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=2)
C--      double precision listw(nw)
C--      character*8 STYPE,sDBDX
C--      parameter (STYPE='FGA',sDBDX='DBDX')
C--      integer nparams
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      nparams = 27*nxyz
C--      call SaveOneVar(STYPE,listw,nw,sDBDX,dbdx,nparams)
C--      end
C--C
C--C*MODULE TDXIO   *DECK GetdGammadX
C--      function GetdGammadX(w1,w2,w3,dgdx,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdGammadX
C--      double precision w1,w2,w3,dgdx(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=3)
C--      double precision listw(nw)
C--      character*8 STYPE,sDGDX
C--      parameter (STYPE='FGHA',sDGDX='DGDX')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      listw(3) = w3
C--      if(LoadOneVar(STYPE,listw,nw,sDGDX,dgdx,bA)) then
C--         GetdGammadX=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      listw(3) = -w3
C--      if(LoadOneVar(STYPE,listw,nw,sDGDX,dgdx,bA)) then
C--         GetdGammadX=.true.
C--         return
C--      end if
C--      GetdGammadX=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetdGammadX
C--      subroutine SetdGammadX(w1,w2,w3,dgdx,nxyz)
C--      implicit none
C--C     Argument
C--      integer nxyz
C--      double precision w1,w2,w3,dgdx(*)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=3)
C--      double precision listw(nw)
C--      character*8 STYPE,sDGDX
C--      parameter (STYPE='FGHA',sDGDX='DGDX')
C--      integer nparams
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      listw(3) = w3
C--      nparams = 21*nxyz
C--      call SaveOneVar(STYPE,listw,nw,sDGDX,dgdx,nparams)
C--      end
C--C
C--C*MODULE TDXIO   *DECK GetdMudQ
C--      function GetdMudQ(dmdq,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdMudQ
C--      double precision dmdq(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=0)
C--      double precision listw(1)
C--      character*8 STYPE,sDMDQ
C--      parameter (STYPE='0',sDMDQ='DMDQ')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1)=0.0D+00
C--      if(LoadOneVar(STYPE,listw,nw,sDMDQ,dmdq,bA)) then
C--         GetdMudQ=.true.
C--         return
C--      end if
C--      GetdMudQ=.false.
C--      end
C
C*MODULE TDXIO   *DECK SetdMudQ
      subroutine SetdMudQ(dmdq,nmodes)
      implicit none
C     Argument
      integer nmodes
      double precision dmdq(*)
C     Variables and constants
      integer nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sDMDQ
      parameter (STYPE='0',sDMDQ='DMDQ')
      integer nparams
C     Body of the subprogram
      nparams = 3*nmodes
      call SaveOneVar(STYPE,listw,nw,sDMDQ,dmdq,nparams)
      end
C
C*MODULE TDXIO   *DECK GetdAlphadQ
      function GetdAlphadQ(w,dadq,bA)
      implicit none
C     Arguments
      logical GetdAlphadQ
      double precision w,dadq(*)
      logical bA
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sDADQ
      parameter (STYPE='FA',sDADQ='DADQ')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1) = w
      if(LoadOneVar(STYPE,listw,nw,sDADQ,dadq,bA)) then
         GetdAlphadQ=.true.
         return
      end if
      listw(1) = -w
      if(LoadOneVar(STYPE,listw,nw,sDADQ,dadq,bA)) then
         GetdAlphadQ=.true.
         return
      end if
      GetdAlphadQ=.false.
      end
C
C*MODULE TDXIO   *DECK SetdAlphadQ
      subroutine SetdAlphadQ(w,dadq,nmodes)
      implicit none
C     Argument
      integer nmodes
      double precision w,dadq(*)
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sDADQ
      parameter (STYPE='FA',sDADQ='DADQ')
      integer nparams
C     Body of the subprogram
      listw(1) = w
      nparams = 9*nmodes
      call SaveOneVar(STYPE,listw,nw,sDADQ,dadq,nparams)
      end
C
C*MODULE TDXIO   *DECK GetdBetadQ
      function GetdBetadQ(w1,w2,dbdq,bA)
      implicit none
C     Arguments
      logical GetdBetadQ
      double precision w1,w2,dbdq(*)
      logical bA
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sDBDQ
      parameter (STYPE='FGA',sDBDQ='DBDQ')
C     Called subprogram
      logical LoadOneVar
C     Body of the subprogram
      listw(1) = w1
      listw(2) = w2
      if(LoadOneVar(STYPE,listw,nw,sDBDQ,dbdq,bA)) then
         GetdBetadQ=.true.
         return
      end if
      listw(1) = -w1
      listw(2) = -w2
      if(LoadOneVar(STYPE,listw,nw,sDBDQ,dbdq,bA)) then
         GetdBetadQ=.true.
         return
      end if
      GetdBetadQ=.false.
      end
C
C*MODULE TDXIO   *DECK SetdBetadQ
      subroutine SetdBetadQ(w1,w2,dbdq,nmodes)
      implicit none
C     Argument
      integer nmodes
      double precision w1,w2,dbdq(*)
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sDBDQ
      parameter (STYPE='FGA',sDBDQ='DBDQ')
      integer nparams
C     Body of the subprogram
      listw(1) = w1
      listw(2) = w2
      nparams = 27*nmodes
      call SaveOneVar(STYPE,listw,nw,sDBDQ,dbdq,nparams)
      end
C
C--C*MODULE TDXIO   *DECK GetdGammadQ
C--      function GetdGammadQ(w1,w2,w3,dgdq,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdGammadQ
C--      double precision w1,w2,w3,dgdq(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=3)
C--      double precision listw(nw)
C--      character*8 STYPE,sDGDQ
C--      parameter (STYPE='FGHA',sDGDQ='DGDQ')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      listw(3) = w3
C--      if(LoadOneVar(STYPE,listw,nw,sDGDQ,dgdq,bA)) then
C--         GetdGammadQ=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      listw(3) = -w3
C--      if(LoadOneVar(STYPE,listw,nw,sDGDQ,dgdq,bA)) then
C--         GetdGammadQ=.true.
C--         return
C--      end if
C--      GetdGammadQ=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetdGammadQ
C--      subroutine SetdGammadQ(w1,w2,w3,dgdq,nmodes)
C--      implicit none
C--C     Argument
C--      integer nmodes
C--      double precision w1,w2,w3,dgdq(*)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=3)
C--      double precision listw(nw)
C--      character*8 STYPE,sDGDQ
C--      parameter (STYPE='FGHA',sDGDQ='DGDQ')
C--      integer nparams
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      listw(3) = w3
C--      nparams = 21*nmodes
C--      call SaveOneVar(STYPE,listw,nw,sDGDQ,dgdq,nparams)
C--      end
C--C
C--C*MODULE TDXIO   *DECK Getd2MudQ2
C--      function Getd2MudQ2(d2mdq2,bA)
C--      implicit none
C--C     Arguments
C--      logical Getd2MudQ2
C--      double precision d2mdq2(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=0)
C--      double precision listw(1)
C--      character*8 STYPE,sD2MDQ2
C--      parameter (STYPE='0',sD2MDQ2='D2MDQ2')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1)=0.0D+00
C--      if(LoadOneVar(STYPE,listw,nw,sD2MDQ2,d2mdq2,bA)) then
C--         Getd2MudQ2=.true.
C--         return
C--      end if
C--      Getd2MudQ2=.false.
C--      end
C
C*MODULE TDXIO   *DECK SetdqMudQ2
      subroutine Setd2MudQ2(d2mdq2,nmodes2)
      implicit none
C     Argument
      integer nmodes2
      double precision d2mdq2(*)
C     Variables and constants
      integer nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sD2MDQ2
      parameter (STYPE='0',sD2MDQ2='D2MDQ2')
      integer nparams
C     Body of the subprogram
      nparams = 3*nmodes2
      call SaveOneVar(STYPE,listw,nw,sD2MDQ2,d2mdq2,nparams)
      end
C--C
C--C*MODULE TDXIO   *DECK Getd2AlphadQ2
C--      function Getd2AlphadQ2(w,d2adq2,bA)
C--      implicit none
C--C     Arguments
C--      logical Getd2AlphadQ2
C--      double precision w,d2adq2(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sD2ADQ2
C--      parameter (STYPE='FAB',sD2ADQ2='D2ADQ2')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w
C--      if(LoadOneVar(STYPE,listw,nw,sD2ADQ2,d2adq2,bA)) then
C--         Getd2AlphadQ2=.true.
C--         return
C--      end if
C--      listw(1) = -w
C--      if(LoadOneVar(STYPE,listw,nw,sD2ADQ2,d2adq2,bA)) then
C--         Getd2AlphadQ2=.true.
C--         return
C--      end if
C--      Getd2AlphadQ2=.false.
C--      end
C
C*MODULE TDXIO   *DECK Setd2AlphadQ2
      subroutine Setd2AlphadQ2(w,d2adq2,nmodes2)
      implicit none
C     Argument
      integer nmodes2
      double precision w,d2adq2(*)
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sD2ADQ2
      parameter (STYPE='FAB',sD2ADQ2='D2ADQ2')
      integer nparams
C     Body of the subprogram
      listw(1) = w
      nparams = 9*nmodes2
      call SaveOneVar(STYPE,listw,nw,sD2ADQ2,d2adq2,nparams)
      end
C
C--C*MODULE TDXIO   *DECK Getd2BetadQ2
C--      function Getd2BetadQ2(w1,w2,d2bdq2,bA)
C--      implicit none
C--C     Arguments
C--      logical Getd2BetadQ2
C--      double precision w1,w2,d2bdq2(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=2)
C--      double precision listw(nw)
C--      character*8 STYPE,sD2BDQ2
C--      parameter (STYPE='FGAB',sD2BDQ2='D2BDQ2')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w1
C--      listw(2) = w2
C--      if(LoadOneVar(STYPE,listw,nw,sD2BDQ2,d2bdq2,bA)) then
C--         Getd2BetadQ2=.true.
C--         return
C--      end if
C--      listw(1) = -w1
C--      listw(2) = -w2
C--      if(LoadOneVar(STYPE,listw,nw,sD2BDQ2,d2bdq2,bA)) then
C--         Getd2BetadQ2=.true.
C--         return
C--      end if
C--      Getd2BetadQ2=.false.
C--      end
C
C*MODULE TDXIO   *DECK Setd2betadQ2
      subroutine Setd2BetadQ2(w1,w2,d2bdq2,nmodes2)
      implicit none
C     Argument
      integer nmodes2
      double precision w1,w2,d2bdq2(*)
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sD2BDQ2
      parameter (STYPE='FGAB',sD2BDQ2='D2BDQ2')
      integer nparams
C     Body of the subprogram
      listw(1) = w1
      listw(2) = w2
      nparams = 27*nmodes2
      call SaveOneVar(STYPE,listw,nw,sD2BDQ2,d2bdq2,nparams)
      end
C
C--C*MODULE TDXIO   *DECK GetdUpperAdQ
C--      function GetdUpperAdQ(w,dupperadq,bA)
C--      implicit none
C--C     Arguments
C--      logical GetdUpperAdQ
C--      double precision w,dupperadq(*)
C--      logical bA
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sDUADQ
C--      parameter (STYPE='FA',sDUADQ='DUADQ')
C--C     Called subprogram
C--      logical LoadOneVar
C--C     Body of the subprogram
C--      listw(1) = w
C--      if(LoadOneVar(STYPE,listw,nw,sDUADQ,dupperadq,bA)) then
C--         GetdUpperAdQ=.true.
C--         return
C--      end if
C--      listw(1) = -w
C--      if(LoadOneVar(STYPE,listw,nw,sDUADQ,dupperadq,bA)) then
C--         GetdUpperAdQ=.true.
C--         return
C--      end if
C--      GetdUpperAdQ=.false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetdUpperAdq
C--      subroutine SetdUpperAdQ(w,dupperadq,nmodes)
C--      implicit none
C--C     Argument
C--      integer nmodes
C--      double precision w,dupperadq(*)
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE,sDUADQ
C--      parameter (STYPE='FA',sDUADQ='DUADQ')
C--      integer nparams
C--C     Body of the subprogram
C--      listw(1) = w
C--      nparams = 27*nmodes
C--      call SaveOneVar(STYPE,listw,nw,sDUADQ,dupperadq,nparams)
C--      end
C
C*MODULE TDXIO   *DECK FreeFQX
      subroutine FreeFQX()
      implicit none
C     Variables and constants
      integer nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE
      parameter (STYPE='FQX')
C     Body of the subprogram
      listw(1) = 0.0D+00
      call FreeSlot(STYPE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK CheckFQX
      subroutine CheckFQX(bF,bQ,bX)
      implicit none
C     Arguments
      logical bF,bQ,bX
C     Variables and constants
      integer islot,ifile,ivar
      integer nw
      parameter (nw=0)
      double precision listw(1),dummy
      character*8 STYPE,sX,sF,sQ
      parameter (STYPE='FQX',sX='X',sF='F',sQ='Q')
C     Called subprogram
      logical LoadData
C     Body of the subprogram
      listw(1)=0.0D+00
      dummy=0.0D+00
      call PreLoad(ifile,ivar,islot,STYPE,listw,nw)
      bF = LoadData(ifile,ivar,islot,sF,dummy,.false.)
      bQ = LoadData(ifile,ivar,islot,sQ,dummy,.false.)
      bX = LoadData(ifile,ivar,islot,sX,dummy,.false.)
      call PostLoad(ifile)
      end
C
C*module tdxio   LoadFQX
      function LoadFQX(F,bF,Q,bQ,X,bX,norb,nparams)
      implicit none
C     Arguments
      logical LoadFQX
      integer norb,nparams
      logical bF,bQ,bX
      double precision F(norb,norb,nparams)
      double precision Q(norb,norb,nparams)
      double precision X(norb,norb,nparams)
C     Variables and constants
      logical bFF,bQQ,bXX
      integer ifile,ivar,islot
      integer nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sF,sQ,sX
      parameter (STYPE='FQX',sF='F',sQ='Q',sX='X')
C     Called subprogram
      logical LoadData
C     Body of the subprogram
      listw(1)=0.0D+00
      call PreLoad(ifile,ivar,islot,STYPE,listw,nw)
      bFF = LoadData(ifile,ivar,islot,sF,F,bF)
      bQQ = LoadData(ifile,ivar,islot,sQ,Q,bQ)
      bXX = LoadData(ifile,ivar,islot,sX,X,bX)
      call PostLoad(ifile)
      LoadFQX = ((.not.bF).or.bFF).and.
     &          ((.not.bQ).or.bQQ).and.
     &          ((.not.bX).or.bXX)
      end
C
C*MODULE TDXIO   *DECK SaveFQX
      subroutine SaveFQX(F,bF,Q,bQ,X,bX,norb,nparams)
      implicit none
C     Arguments
      integer norb,nparams
      logical bF,bQ,bX
      double precision F(norb,norb,nparams)
      double precision Q(norb,norb,nparams)
      double precision X(norb,norb,nparams)
C     Variables and constants
      integer ifile,ivar,islot
      double precision listw(1)
      integer nw
      parameter (nw=0)
      character*8 STYPE,sF,sQ,sX
      parameter (STYPE='FQX',sF='F',sQ='Q',sX='X')
C     Body of the subprogram
      listw(1)=0.0D+00
      call PreSave(ifile,ivar,islot,STYPE,listw,nw)
      if(bF) call SaveData(ifile,ivar,islot,sF,F,norb*norb*nparams)
      if(bQ) call SaveData(ifile,ivar,islot,sQ,Q,norb*norb*nparams)
      if(bX) call SaveData(ifile,ivar,islot,sX,X,norb*norb*nparams)
      call PostSave(ifile)
      end
C
C*module tdxio   *deck LoadGUXDE
      function LoadGUXDE(type,listw,nw,nameG,nameU,nameX,nameD,nameE,
     &                   G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,bTransf)
      implicit none
C     Arguments
      logical LoadGUXDE
      character*8 type
      integer nw
      double precision listw(nw)
      character*8 nameG,nameU,nameX,nameD,nameE
      integer norb,nparams
      double precision G(norb,norb,nparams)
      double precision U(norb,norb,nparams)
      double precision X(norb,norb,nparams)
      double precision D(norb,norb,nparams)
      double precision E(norb,norb,nparams)
      logical bG,bU,bX,bD,bE
      logical bTransf
C     Variables and constants
      integer islot,ifile,ivar,iload,nload
      logical bGp,bUp,bXp,bDp,bEp,bLoadX
      character*8 sMISSING
      parameter (sMISSING='missing ')
C     Called subprogram
      logical LoadData
C     Body of the subprogram
      iload = 0
      bGp=nameG.ne.sMISSING
      bUp=nameU.ne.sMISSING
      bXp=nameX.ne.sMISSING
      bDp=nameD.ne.sMISSING
      bEp=nameE.ne.sMISSING
      nload = 0
      if(bGp) nload = nload+1
      if(bUp) nload = nload+1
      if(bXp) nload = nload+1
      if(bDp) nload = nload+1
      if(bEp) nload = nload+1
C
      call PreLoad(ifile,ivar,islot,type,listw,nw)
      if(bXp) then
         if(LoadData(ifile,ivar,islot,nameX,X,bX)) iload=iload+1
      end if
      if(bTransf.and.bU) then
         if(bXp) then
            if(bX) then
               bLoadX = (iload.eq.1)
            else if(bG) then
               bLoadX = LoadData(ifile,ivar,islot,nameX,G,bG)
            else if(bD) then
               bLoadX = LoadData(ifile,ivar,islot,nameX,D,bD)
            else if(bE) then
               bLoadX = LoadData(ifile,ivar,islot,nameX,E,bE)
            else
               call abrtx("LOADGUXDE")
            end if
         else
            bLoadX = .false.
         end if
      end if
      if(bUp) then
         if(LoadData(ifile,ivar,islot,nameU,U,bU)) iload=iload+1
      end if
      if(bTransf.and.bU) then
         if(bLoadX) then
            if(bX) then
               call TransformAsUMat(norb,nparams,U,X,.true.)
            else if(bG) then
               call TransformAsUMat(norb,nparams,U,G,.true.)
            else if(bD) then
               call TransformAsUMat(norb,nparams,U,D,.true.)
            else if(bE) then
               call TransformAsUMat(norb,nparams,U,E,.true.)
            end if
         else
            call TransformAsUMat(norb,nparams,U,X,.false.)
         end if
      end if
      if(bGp) then
         if(LoadData(ifile,ivar,islot,nameG,G,bG)) iload=iload+1
      end if
      if(bDp) then
         if(LoadData(ifile,ivar,islot,nameD,D,bD)) iload=iload+1
      end if
      if(bEp) then
         if(LoadData(ifile,ivar,islot,nameE,E,bE)) iload=iload+1
      end if
      if(bTransf.and.bX) call TransformAsGMat(norb,nparams,X)
      if(bTransf.and.bG) call TransformAsGMat(norb,nparams,G)
      if(bTransf.and.bD) call TransformAsGMat(norb,nparams,D)
      if(bTransf.and.bE) call TransformAsGMat(norb,nparams,E)
C
      call PostLoad(ifile)
      LoadGUXDE=(iload.eq.nload)
      end
C
C*MODULE TDXIO   *DECK SaveGUXDE
      subroutine SaveGUXDE(type,listw,nw,nameG,nameU,nameX,nameD,nameE,
     &                     G,U,X,D,E,norb,nparams)
      implicit none
C     Argument
      character*8 type
      integer nw
      double precision listw(nw)
      character*8 nameG,nameU,nameX,nameD,nameE
      integer norb,nparams
      double precision G(norb,norb,nparams)
      double precision U(norb,norb,nparams)
      double precision X(norb,norb,nparams)
      double precision D(norb,norb,nparams)
      double precision E(norb,norb,nparams)
C     Variables and constants
      integer islot,ifile,ivar,isize
      logical bGp,bUp,bXp,bDp,bEp
      character*8 sMISSING
      parameter (sMISSING='missing ')
C     Body of the subprogram
      isize = norb*norb*nparams
      bGp=nameG.ne.sMISSING
      bUp=nameU.ne.sMISSING
      bXp=nameX.ne.sMISSING
      bDp=nameD.ne.sMISSING
      bEp=nameE.ne.sMISSING
C
      call PreSave(ifile,ivar,islot,type,listw,nw)
      if(bXp) call SaveData(ifile,ivar,islot,nameX,X,isize)
      if(bUp) call SaveData(ifile,ivar,islot,nameU,U,isize)
      if(bGp) call SaveData(ifile,ivar,islot,nameG,G,isize)
      if(bDp) call SaveData(ifile,ivar,islot,nameD,D,isize)
      if(bEp) call SaveData(ifile,ivar,islot,nameE,E,isize)
      call PostSave(ifile)
      end
C
C*MODULE TDXIO   *DECK GetGUDEf
      function GetGUDEf(w,G,bG,U,bU,D,bD,E,bE,norb,nfld)
      implicit none
C     Arguments
      logical GetGUDEf
      double precision w
      integer norb,nfld
      double precision G(norb,norb,nfld)
      double precision U(norb,norb,nfld)
      double precision D(norb,norb,nfld)
      double precision E(norb,norb,nfld)
      logical bG,bU,bD,bE
C     Variables and constants
      integer nw,nparams
      parameter (nw=1)
      double precision listw(nw),X(1)
      logical bX
      parameter (bX=.false.)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='F',sG='G',sU='U',sX='missing ',sD='D',sE='E')
C     Called subprogram
      logical LoadGUXDE
C     Body of the subprogram
      x(1) = 0.0D+00
      nparams=nfld
      listw(1)=w
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.false.)) then
         GetGUDEf = .true.
         return
      end if
      listw(1)=-w
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.true.)) then
         GetGUDEf = .true.
         return
      end if
      GetGUDEf = .false.
      end
C
C*MODULE TDXIO   *DECK SetGUDEf
      subroutine SetGUDEf(w,G,U,D,E,norb,nfld)
      implicit none
C     Arguments
      double precision w
      integer norb,nfld
      double precision G(norb,norb,nfld)
      double precision U(norb,norb,nfld)
      double precision D(norb,norb,nfld)
      double precision E(norb,norb,nfld)
C     Variables and constants
      integer nw,nparams
      parameter (nw=1)
      double precision listw(nw),X(1)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='F',sG='G',sU='U',sX='missing ',sD='D',sE='E')
C     Body of the subprogram
      nparams=nfld
      listw(1)=w
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &               G,U,X,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUDEf
      subroutine FreeGUDEf(w)
      implicit none
C     Argument
      double precision w
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE
      parameter (STYPE='F')
C     Body of the subprogram
      listw(1)=w
      call FreeSlot(STYPE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK GetGUDEfg
      function GetGUXDEfg(w1,w2,G,bG,U,bU,X,bX,D,bD,E,bE,norb,nfld)
      implicit none
C     Arguments
      logical GetGUXDEfg
      double precision w1,w2
      integer norb,nfld
      double precision G(norb,norb,nfld,nfld)
      double precision U(norb,norb,nfld,nfld)
      double precision X(norb,norb,nfld,nfld)
      double precision D(norb,norb,nfld,nfld)
      double precision E(norb,norb,nfld,nfld)
      logical bG,bU,bX,bD,bE
C     Variables and constants
      integer nw,nparams
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FG',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Called subprogram
      logical LoadGUXDE
C     Body of the subprogram
      nparams=nfld*nfld
      listw(1)=w1
      listw(2)=w2
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.false.)) then
         GetGUXDEfg = .true.
         return
      end if
      listw(1)=-w1
      listw(2)=-w2
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.true.)) then
         GetGUXDEfg = .true.
         return
      end if
      GetGUXDEfg = .false.
      end
C
C*MODULE TDXIO   *DECK SetGUXDEfg
      subroutine SetGUXDEfg(w1,w2,G,U,X,D,E,norb,nfld)
      implicit none
C     Arguments
      double precision w1,w2
      integer norb,nfld
      double precision G(norb,norb,nfld,nfld)
      double precision U(norb,norb,nfld,nfld)
      double precision X(norb,norb,nfld,nfld)
      double precision D(norb,norb,nfld,nfld)
      double precision E(norb,norb,nfld,nfld)
C     Variables and constants
      integer nw,nparams
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FG',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Body of the subprogram
      nparams=nfld*nfld
      listw(1)=w1
      listw(2)=w2
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &               G,U,X,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUXDEfg
      subroutine FreeGUXDEfg(w1,w2)
      implicit none
C     Argument
      double precision w1,w2
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE
      parameter (STYPE='FG')
C     Body of the subprogram
      listw(1)=w1
      listw(2)=w2
      call FreeSlot(STYPE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK GetGUDEfgh
      function GetGUXDEfgh(w1,w2,w3,G,bG,U,bU,X,bX,D,bD,E,bE,norb,nfld)
      implicit none
C     Arguments
      logical GetGUXDEfgh
      double precision w1,w2,w3
      integer norb,nfld
      double precision G(norb,norb,nfld,nfld,nfld)
      double precision U(norb,norb,nfld,nfld,nfld)
      double precision X(norb,norb,nfld,nfld,nfld)
      double precision D(norb,norb,nfld,nfld,nfld)
      double precision E(norb,norb,nfld,nfld,nfld)
      logical bG,bU,bX,bD,bE
C     Variables and constants
      integer nw,nparams
      parameter (nw=3)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FGH',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Called subprogram
      logical LoadGUXDE
C     Body of the subprogram
      nparams=nfld*nfld*nfld
      listw(1)=w1
      listw(2)=w2
      listw(3)=w3
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.false.)) then
         GetGUXDEfgh = .true.
         return
      end if
      listw(1)=-w1
      listw(2)=-w2
      listw(3)=-w3
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.true.)) then
         GetGUXDEfgh = .true.
         return
      end if
      GetGUXDEfgh = .false.
      end
C
C*MODULE TDXIO   *DECK SetGUXDEfgh
      subroutine SetGUXDEfgh(w1,w2,w3,G,U,X,D,E,norb,nfld)
      implicit none
C     Arguments
      double precision w1,w2,w3
      integer norb,nfld
      double precision G(norb,norb,nfld,nfld,nfld)
      double precision U(norb,norb,nfld,nfld,nfld)
      double precision X(norb,norb,nfld,nfld,nfld)
      double precision D(norb,norb,nfld,nfld,nfld)
      double precision E(norb,norb,nfld,nfld,nfld)
C     Variables and constants
      integer nw,nparams
      parameter (nw=3)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FGH',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Body of the subprogram
      nparams=nfld*nfld*nfld
      listw(1)=w1
      listw(2)=w2
      listw(3)=w3
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &               G,U,X,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUXDEfgh
      subroutine FreeGUXDEfgh(w1,w2,w3)
      implicit none
C     Argument
      double precision w1,w2,w3
C     Variables and constants
      integer nw
      parameter (nw=3)
      double precision listw(nw)
      character*8 STYPE
      parameter (STYPE='FGH')
C     Body of the subprogram
      listw(1)=w1
      listw(2)=w2
      listw(3)=w3
      call FreeSlot(STYPE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK GetGUDEa
      function GetGUIDEa(G,bG,U,bU,I,bI,D,bD,E,bE,norb,nxyz)
      implicit none
C     Arguments
      logical GetGUIDEa
      integer norb,nxyz
      double precision G(norb,norb,nxyz)
      double precision U(norb,norb,nxyz)
      double precision I(norb,norb,nxyz)
      double precision D(norb,norb,nxyz)
      double precision E(norb,norb,nxyz)
      logical bG,bU,bI,bD,bE
C     Variables and constants
      integer nw,nparams
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sG,sU,sI,sD,sE
      parameter (STYPE='A',sG='G',sU='U',sI='I',sD='D',sE='E')
C     Called subprogram
      logical LoadGUXDE
C     Body of the subprogram
      listw(1)=0.0D+00
      nparams=nxyz
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sI,sD,sE,
     &             G,bG,U,bU,I,bI,D,bD,E,bE,norb,nparams,.false.)) then
         GetGUIDEa = .true.
         return
      end if
      GetGUIDEa = .false.
      end
C
C*MODULE TDXIO   *DECK SetGUIDEa
      subroutine SetGUIDEa(G,U,I,D,E,norb,nxyz)
      implicit none
C     Arguments
      integer norb,nxyz
      double precision G(norb,norb,nxyz)
      double precision U(norb,norb,nxyz)
      double precision I(norb,norb,nxyz)
      double precision D(norb,norb,nxyz)
      double precision E(norb,norb,nxyz)
C     Variables and constants
      integer nw,nparams
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sG,sU,sI,sD,sE
      parameter (STYPE='A',sG='G',sU='U',sI='I',sD='D',sE='E')
C     Body of the subprogram
      nparams=nxyz
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sI,sD,sE,
     &               G,U,I,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUIDEa
      subroutine FreeGUIDEa()
      implicit none
C     Argument
C     Variables and constants
      integer nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE
      parameter (STYPE='A')
C     Body of the subprogram
      listw(1) = 0.0D+00
      call FreeSlot(STYPE,listw,nw)
      end
C
C*MODULE TDXIO   *DECK GetFNM
      function GetFNM(F,bF,Q,bQ,nxyz,nmodes)
      implicit none
C     Arguments
      logical GetFNM
      integer nxyz,nmodes
      double precision F(nmodes)
      double precision Q(nxyz,nmodes)
      logical bF,bQ
C     Variables and constants
      logical bFF,bQQ
      integer ifile,ivar,islot,nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sF,sQ
      parameter (STYPE='FNM',sF='F',sQ='Q')
C     Called subprogram
      logical LoadData
C     Body of the subprogram
      listw(1)=0.0D+00
      call PreLoad(ifile,ivar,islot,STYPE,listw,nw)
      bFF = LoadData(ifile,ivar,islot,sF,F,bF)
      bQQ = LoadData(ifile,ivar,islot,sQ,Q,bQ)
      call PostLoad(ifile)
      GetFNM = ((.not.bF).or.bFF).and.((.not.bQ).or.bQQ)
      end
C
C*MODULE TDXIO   *DECK SetFNM
      subroutine SetFNM(F,Q,nxyz,nmodes)
      implicit none
C     Arguments
      integer nxyz,nmodes
      double precision F(nmodes)
      double precision Q(nxyz,nmodes)
C     Variables and constants
      integer ifile,ivar,islot,nw
      parameter (nw=0)
      double precision listw(1)
      character*8 STYPE,sF,sQ
      parameter (STYPE='FNM',sF='F',sQ='Q')
C     Body of the subprogram
      listw(1)=0.0D+00
      call PreSave(ifile,ivar,islot,STYPE,listw,nw)
      call SaveData(ifile,ivar,islot,sF,F,nmodes)
      call SaveData(ifile,ivar,islot,sQ,Q,nxyz*nmodes)
      call PostSave(ifile)
      end
C
C--C*MODULE TDXIO   *DECK FreeFNM
C--      subroutine FreeFNM()
C--      implicit none
C--C     Argument
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=0)
C--      double precision listw(1)
C--      character*8 STYPE
C--      parameter (STYPE='FNM')
C--C     Body of the subprogram
C--      listw(1) = 0.0D+00
C--      call FreeSlot(STYPE,listw,nw)
C--      end
C
C*MODULE TDXIO   *DECK GetGUXDEfa
      function GetGUXDEfa(w,G,bG,U,bU,X,bX,D,bD,E,bE,norb,nfld,ngeom)
      implicit none
C     Arguments
      logical GetGUXDEfa
      double precision w
      integer norb,nfld,ngeom
      double precision G(norb,norb,nfld,ngeom)
      double precision U(norb,norb,nfld,ngeom)
      double precision X(norb,norb,nfld,ngeom)
      double precision D(norb,norb,nfld,ngeom)
      double precision E(norb,norb,nfld,ngeom)
      logical bG,bU,bX,bD,bE
C     Variables and constants
      integer nw,nparams
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FA',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Called subprogram
      logical LoadGUXDE
C     Body of the subprogram
      nparams=nfld*ngeom
      listw(1)=w
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.false.)) then
         GetGUXDEfa = .true.
         return
      end if
      listw(1)=-w
      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &             G,bG,U,bU,X,bX,D,bD,E,bE,norb,nparams,.true.)) then
         GetGUXDEfa = .true.
         return
      end if
      GetGUXDEfa = .false.
      end
C
C*MODULE TDXIO   *DECK SetGUXDEfa
      subroutine SetGUXDEfa(w,G,U,X,D,E,norb,nfld,ngeom)
      implicit none
C     Arguments
      double precision w
      integer norb,nfld,ngeom
      double precision G(norb,norb,nfld,ngeom)
      double precision U(norb,norb,nfld,ngeom)
      double precision X(norb,norb,nfld,ngeom)
      double precision D(norb,norb,nfld,ngeom)
      double precision E(norb,norb,nfld,ngeom)
C     Variables and constants
      integer nw,nparams
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FA',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Body of the subprogram
      nparams=nfld*ngeom
      listw(1)=w
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &               G,U,X,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUXDEfa
      subroutine FreeGUXDEfa(w)
      implicit none
C     Argument
      double precision w
C     Variables and constants
      integer nw
      parameter (nw=1)
      double precision listw(nw)
      character*8 STYPE
      parameter (STYPE='FA')
C     Body of the subprogram
      listw(1)=w
      call FreeSlot(STYPE,listw,nw)
      end
C
C--C*MODULE TDXIO   *DEC GetGUXDEfga
C--      function GetGUXDEfga(w1,w2,G,bG,U,bU,X,bX,D,bD,E,bE,
C--     &                     norb,nfld,ngeom)
C--      implicit none
C--C     Arguments
C--      logical GetGUXDEfga
C--      double precision w1,w2
C--      integer norb,nfld,ngeom
C--      double precision G(norb,norb,nfld,ngeom)
C--      double precision U(norb,norb,nfld,ngeom)
C--      double precision X(norb,norb,nfld,ngeom)
C--      double precision D(norb,norb,nfld,ngeom)
C--      double precision E(norb,norb,nfld,ngeom)
C--      logical bG,bU,bX,bD,bE
C--C     Variables and constants
C--      integer nw,nparams
C--      parameter (nw=2)
C--      double precision listw(nw)
C--      character*8 STYPE,sG,sU,sX,sD,sE
C--      parameter (STYPE='FGA',sG='G',sU='U',sX='X',sD='D',sE='E')
C--C     Called subprogram
C--      logical LoadGUXDE
C--C     Body of the subprogram
C--      nparams=nfld*ngeom
C--      listw(1)=w1
C--      listw(2)=w2
C--      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,G,bG,U,bU,
C--     &             X,bX,D,bD,E,bE,norb,nparams,.false.)) then
C--         GetGUXDEfga = .true.
C--         return
C--      end if
C--      listw(1)=-w1
C--      listw(2)=-w2
C--      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,G,bG,U,bU,
C--     &             X,bX,D,bD,E,bE,norb,nparams,.true.)) then
C--         GetGUXDEfga = .true.
C--         return
C--      end if
C--      GetGUXDEfga = .false.
C--      end
C
C*MODULE TDXIO   *DECK SetGUXDEfga
      subroutine SetGUXDEfga(w1,w2,G,U,X,D,E,norb,nfld,ngeom)
      implicit none
C     Arguments
      double precision w1,w2
      integer norb,nfld,ngeom
      double precision G(norb,norb,nfld,ngeom)
      double precision U(norb,norb,nfld,ngeom)
      double precision X(norb,norb,nfld,ngeom)
      double precision D(norb,norb,nfld,ngeom)
      double precision E(norb,norb,nfld,ngeom)
C     Variables and constants
      integer nw,nparams
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE,sG,sU,sX,sD,sE
      parameter (STYPE='FGA',sG='G',sU='U',sX='X',sD='D',sE='E')
C     Body of the subprogram
      nparams=nfld*ngeom
      listw(1)=w1
      listw(2)=w2
      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
     &               G,U,X,D,E,norb,nparams)
      end
C
C*MODULE TDXIO   *DECK FreeGUXDEfga
      subroutine FreeGUXDEfga(w1,w2)
      implicit none
C     Argument
      double precision w1,w2
C     Variables and constants
      integer nw
      parameter (nw=2)
      double precision listw(nw)
      character*8 STYPE
      parameter (STYPE='FGA')
C     Body of the subprogram
      listw(1)=w1
      listw(2)=w2
      call FreeSlot(STYPE,listw,nw)
C--      end
C--C
C--C*module tdxio   *deck GetGUDEop
C--      function GetGUDEop(w,G,bG,U,bU,D,bD,E,bE,norb,nfld)
C--      implicit none
C--C     Arguments
C--      logical GetGUDEop
C--      double precision w
C--      integer norb,nfld
C--      double precision G(norb,norb,nfld,nfld)
C--      double precision U(norb,norb,nfld,nfld)
C--      double precision D(norb,norb,nfld,nfld)
C--      double precision E(norb,norb,nfld,nfld)
C--      logical bG,bU,bD,bE
C--C     Variables and constants
C--      integer nw,nparams
C--      parameter (nw=1)
C--      double precision listw(nw),X(1)
C--      logical bX
C--      parameter (bX=.false.)
C--      character*8 STYPE,sG,sU,sX,sD,sE
C--      parameter (STYPE='OP',sG='G',sU='U',
C--     &           sX='missing ',sD='D',sE='E')
C--C     Called subprogram
C--      logical LoadGUXDE
C--C     Body of the subprogram
C--      x(1) = 0.0D+00
C--      nparams=nfld*nfld
C--      listw(1)=w
C--      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,G,bG,U,bU,
C--     &             X,bX,D,bD,E,bE,norb,nparams,.false.)) then
C--         GetGUDEop = .true.
C--         return
C--      end if
C--      listw(1)=-w
C--      if(LoadGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,G,bG,U,bU,
C--     &             X,bX,D,bD,E,bE,norb,nparams,.true.)) then
C--         GetGUDEop = .true.
C--         return
C--      end if
C--      GetGUDEop = .false.
C--      end
C--C
C--C*MODULE TDXIO   *DECK SetGUDEop
C--      subroutine SetGUDEop(w,G,U,D,E,norb,nfld)
C--      implicit none
C--C     Arguments
C--      double precision w
C--      integer norb,nfld
C--      double precision G(norb,norb,nfld,nfld)
C--      double precision U(norb,norb,nfld,nfld)
C--      double precision D(norb,norb,nfld,nfld)
C--      double precision E(norb,norb,nfld,nfld)
C--C     Variables and constants
C--      integer nw,nparams
C--      parameter (nw=1)
C--      double precision listw(nw),X(1)
C--      character*8 STYPE,sG,sU,sX,sD,sE
C--      parameter (STYPE='OP',sG='G',sU='U',
C--     &           sX='missing ',sD='D',sE='E')
C--C     Body of the subprogram
C--      nparams=nfld*nfld
C--      listw(1)=w
C--      call SaveGUXDE(STYPE,listw,nw,sG,sU,sX,sD,sE,
C--     &               G,U,X,D,E,norb,nparams)
C--      end
C--C
C--C*MODULE TDXIO   *DECK FreeGUDEop
C--      subroutine FreeGUDEop(w)
C--      implicit none
C--C     Argument
C--      double precision w
C--C     Variables and constants
C--      integer nw
C--      parameter (nw=1)
C--      double precision listw(nw)
C--      character*8 STYPE
C--      parameter (STYPE='OP')
C--C     Body of the subprogram
C--      listw(1)=w
C--      call FreeSlot(STYPE,listw,nw)
      return
      end
