C 11 APR 08 - HPTI - GRIDS AND PARALLELIZATON
C 20 AUG 07 - MC  - MODIFIED FOR TDDFT GRADIENT CALCULATION
C  6 NOV 06 - MC  - NEW MODULE FOR EXCHANGE-CORRELATION TERMS OF TDDFT
C
C*MODULE TDDFXC  *DECK TDDFTSET
      SUBROUTINE TDDFTSET(RHOSET,XYZGRD,XYZWGT,XYZDCH,V,
     *                    DRHOI_,AOMAX,GMO,ILENG,NPTGRD,L1)
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      DIMENSION XYZGRD(3,*),XYZWGT(*),XYZDCH(*),
     *          V(*),DRHOI_(*),AOMAX(L1),GMO(*)
C
      LOGICAL DBUG,GOPARR,DSKWRK,MASWRK
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
      DBUG=.FALSE.  .AND.  MASWRK
C
C     ---- READ GRID INFORMATION
C
      CALL GRDRD(22,XYZGRD,XYZWGT,IDUMMY,NPTGRD,0)
      IF(DBUG) THEN
         CALL TIMIT(1)
      ENDIF
C
C     ---- DENSITY
C
      CALL DENMEM(RCUTOFF,RHOSET,DRHOI_,V,XYZWGT,XYZGRD,XYZDCH,
     *            AOMAX,GMO,NPTGRD,L1,ILENG)
C
      IF(GOPARR.AND.IBTYP.EQ.1) THEN
          CALL DDI_GSUMF(2350,DRHOI_,4*NPTGRD)
          CALL DDI_GSUMF(2351,RHOSET,1)
      ENDIF
C
      IF (DBUG) THEN
         WRITE(6,*) 'NPTGRD = ',NPTGRD
         WRITE(6,*) 'DENMEM DONE'
         WRITE(6,*) 'INTEGRATED RHO IN DENMEM=',RHOSET
         CALL TIMIT(1)
      ENDIF
C
      RETURN
      END
C*MODULE TDDFXC  *DECK TDFXCP
      SUBROUTINE TDFXCP(F,RHO,XYZGRD,XYZWGT,XYZDCH,VA,VDUM,
     *                  DRHOI_,DTRAI_,COEF,EX,EC,EX0,EC0,AOMAX,
     *                  VALGA,IAO,ILENG,NPTGRD,L1,L2,LX,NDER,IMETHOD)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER (MXATM=2000)
      PARAMETER (MXGRID=10,MXGRIDTYP=10)
      LOGICAL DBUG,GOPARR,DSKWRK,MASWRK,NXT,SG1
      COMMON /DFGRID/ DFTTHR,DFTGTHR,SWOFF,SW0,BSLRD(137),NDFTFG,
     *                NRAD,NTHE,NPHI,NRAD0,NTHE0,NPHI0,
     *                NANGPT(MXGRID),NANGPT0(MXGRID),SG1
      COMMON /DFPRUN/ PRUNERADS(MXGRID,MXGRIDTYP),
     *                PRUNEATOMS(2,MXGRIDTYP),
     *                IPRUNECUTS(MXATM),NTOTGRIDPOINTS(MXATM),
     *                NGRIDS,MAXANG,NGRIDTYPS
      COMMON /SCFOPT/ CONVHF,MAXIT,MCONV,NPUNCH,NPREO(4)
      COMMON /INFOA / NAT,ICH,MUL,NUM,NQMT,NE,NA,NB,
     *                ZAN(MXATM),C(3,MXATM),IAN(MXATM)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
      DIMENSION F(*)
      DIMENSION DRHOI_(*)
      DIMENSION DTRAI_(*)
      DIMENSION VA(*),VDUM(*)
      DIMENSION COEF(*)
      DIMENSION EX(*),EC(*),EX0(*),EC0(*)
      DIMENSION XYZGRD(3,*)
      DIMENSION XYZWGT(*)
      DIMENSION XYZDCH(4,L1,*)
      DIMENSION AOMAX(L1)
      DIMENSION VALGA(*),IAO(*)
      DATA ZERO      /0.0D+00/
      DBUG=.FALSE.
      IF (DBUG) THEN
       WRITE(6,*)'TDFXCP'
       CALL TIMIT(1)
      ENDIF
C     SET CUT-OFFS
C
      NPT = NRAD*MAXANG
      RCUTOFF=CONVHF/(NPT*NAT)
      IF(NDER.EQ.3) RCUTOFF=1.0D-12
      CCUTOFF=1.0D-03/(NPT*NAT)
      IF(DBUG) THEN
       WRITE(6,*)'RCUTOFF/CCUTOFF/IMETHOD=',RCUTOFF,CCUTOFF,IMETHOD
      ENDIF
C
      IST=0
      IEND=0
      IAREA=0
C
      CALL VCLR(F,1,L2)
      RHO=ZERO
C
C     LOAD BALANCING TERMS
      LOOP = 0
      NGRAN = 20
      NLENG = (NPTGRD - 1)/ILENG + 1
      MCHUNK = (NLENG - 1)/(NGRAN*NPROC) + 1
      NEXT = -1
      NXT = IBTYP.EQ.1
C
C     CHANGED GOTO LOOP INTO A DO LOOP FOR THE
C     PARALLELIZATION.
C
      DO 10 ILG=1,NLENG
C
C   10 CONTINUE
C
C     DYNAMIC AND STATIC LOAD BALANCING
C
      IF(GOPARR) THEN
         IF(NXT) THEN
            LOOP = LOOP + 1
            ICHUNK=(LOOP-1)/MCHUNK
            IF(ICHUNK.GT.NEXT) THEN
               CALL DDI_DLBNEXT(NEXT)
            ENDIF
            IF(NEXT.NE.ICHUNK) GOTO 10
         ELSE
            IF(MOD(ILG,NPROC).NE.ME) GOTO 10
         ENDIF
       ENDIF
C
      IST=(ILG - 1) * ILENG + 1
      IEND=IST+ILENG-1
      IAREA=IAREA+1
      IF(IEND.GT.NPTGRD) IEND=NPTGRD
C
C     ---- FUNCTIONAL ENERGY AND DERIVATIVES
C          EX(ILENG,10) & EC(ILENG,20)
      CALL DFXCSET(EX0,EX,EC0,EC,DRHOI_,XYZWGT,RCUTOFF,EXC,ECOR,
     * ILENG,NPTGRD,1,NDER,IST,IEND)
C
C     -- MAKE AO-GRID & AOMAX
C
      CALL GRDGAO(IST,IEND,XYZGRD,XYZDCH,AOMAX,L1)
C
C     ---- TRANSITION DENSITY
C
      IF(IMETHOD.EQ.1) THEN
       CALL TRADEN(RCUTOFF,CCUTOFF,DTRAI_,DRHOI_,VDUM,VA,
     * XYZDCH,VALGA,IST,IEND,L1,LX,NA,NPTGRD,ILENG)
      ELSE
       THRE=1.0D-06
       CALL AOSERCH(THRE,AOMAX,IAO,L1,IAON)
       THRE=1.0D-11
       CALL SELECTPR(THRE,VA,AOMAX,VALGA,IAO,IMAX,L1,IAON)
       CALL TRADEN2(RCUTOFF,DRHOI_,DTRAI_,VA,XYZDCH,VALGA,
     * IST,IEND,NPTGRD,IMAX,L1,ILENG)
      ENDIF
C
C     ---- COEF(3,ILENG)
C
      IF(NDER.EQ.2) THEN
       CALL TDCOF(COEF,EX,EC,DRHOI_,DTRAI_,RCUTOFF,NPTGRD,
     * IST,IEND,ILENG)
      ELSE
       CALL GCOF(COEF,EX,EC,DRHOI_,DTRAI_,RCUTOFF,NPTGRD,
     * IST,IEND,ILENG)
      ENDIF
C
C     -- NUMERICAL INTEGRATION
C
      CALL NUMFK(RHO,RCUTOFF,F,DRHOI_,DTRAI_,COEF,XYZWGT,XYZDCH,
     *           VALGA,IST,IEND,L1,NPTGRD)
C
C      IF(IEND.EQ.NPTGRD) THEN
C      GOTO 20
C      ELSE
C      GOTO 10
C      ENDIF
C   20 CONTINUE
C
 10   CONTINUE
C
C     REQUIRED RESET FOR DYNAMIC LOAD BALANCING
C
      IF(GOPARR.AND.NXT) CALL DDI_DLBRESET
C
      IF (DBUG) THEN
         WRITE(6,*)'TDFXCP DONE'
         WRITE(6,*)'INTEGRATED RHO=',RHO
         CALL TIMIT(1)
      ENDIF
C
      RETURN
      END
C*MODULE TDDFXC  *DECK AOSERCH
      SUBROUTINE AOSERCH(THRE,AOMAX,IAO,L1,IAON)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DIMENSION AOMAX(*)
      DIMENSION IAO(*)
      IAON=0
      DO I=1,L1
      IF(ABS(AOMAX(I)).GT.THRE) THEN
         IAON=IAON+1
         IAO(IAON)=I
      ENDIF
      END DO
      RETURN
      END
C*MODULE TDDFXC  *DECK SELECTPR
      SUBROUTINE SELECTPR(THRE,V,AOMAX,IPRGRD,IAO,IPR,L1,IAON)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DIMENSION AOMAX(*),V(L1,*),IPRGRD(2,*),IAO(*)
      IPR=0
      DO II=1,IAON
         DO JJ=1,IAON
            I=IAO(II)
            J=IAO(JJ)
            DUM=ABS(V(I,J)*AOMAX(I)*AOMAX(J))
            IF(DUM.GT.THRE) THEN
               IPR=IPR+1
               IPRGRD(1,IPR)=I
               IPRGRD(2,IPR)=J
            ENDIF
         ENDDO
      ENDDO
      RETURN
      END
C*MODULE TDDFXC  *DECK TRADEN2
      SUBROUTINE TRADEN2(RCUTOFF,DRHOI_,DTRAI_,D,GAO,IPRGRD,
     * IST,IEND,NPTGRD,IMAX,L1,ILENG)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DIMENSION DRHOI_(NPTGRD,4)
      DIMENSION DTRAI_(4,*)
      DIMENSION D(L1,*)
      DIMENSION GAO(4,L1,*)
      DIMENSION IPRGRD(2,*)
      DATA ZERO      /0.0D+00/
C
      CALL VCLR(DTRAI_,1,4*ILENG)
C     -- GRID LOOP
      DO IPT=IST,IEND
      IIPT=IPT-IST+1
      ROA=DRHOI_(IPT,1)
      ROB=ROA
      IF(ROA+ROB.LT.RCUTOFF) THEN
        GOTO 10
      ENDIF
      TI=ZERO
      DX=ZERO
      DY=ZERO
      DZ=ZERO
      DO IPR=1,IMAX
         M=IPRGRD(1,IPR)
         N=IPRGRD(2,IPR)
         PM=GAO(1,M,IIPT)
         PMX=GAO(2,M,IIPT)
         PMY=GAO(3,M,IIPT)
         PMZ=GAO(4,M,IIPT)
         PN=GAO(1,N,IIPT)
         PNX=GAO(2,N,IIPT)
         PNY=GAO(3,N,IIPT)
         PNZ=GAO(4,N,IIPT)
         GX=PMX*PN+PNX*PM
         GY=PMY*PN+PNY*PM
         GZ=PMZ*PN+PNZ*PM
         DUMN=PM*PN
         DUM=D(M,N)*DUMN
         DUMX=D(M,N)*GX
         DUMY=D(M,N)*GY
         DUMZ=D(M,N)*GZ
         TI=TI+DUM
         DX=DX+DUMX
         DY=DY+DUMY
         DZ=DZ+DUMZ
         ENDDO
       DTRAI_(1,IIPT)=TI
       DTRAI_(2,IIPT)=DX
       DTRAI_(3,IIPT)=DY
       DTRAI_(4,IIPT)=DZ
   10 CONTINUE
      ENDDO
C     -- GRID LOOP END
C
      RETURN
      END
C*MODULE TDDFXC  *DECK TRADEN
      SUBROUTINE TRADEN(RCUTOFF,CCUTOFF,DTRAI_,DRHOI_,V,VH,
     * GAO,GMO,IST,IEND,L1,LX,NA,NPTGRD,ILENG)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DIMENSION DRHOI_(NPTGRD,4)
      DIMENSION DTRAI_(4,*)
      DIMENSION V(L1,*)
      DIMENSION VH(LX,*)
      DIMENSION GAO(4,L1,*)
      DIMENSION GMO(NA,4)
      DATA ZERO      /0.0D+00/
      CALL VCLR(DTRAI_,1,4*ILENG)
C
C     -- GRID LOOP
      DO IPT=IST,IEND
      IIPT=IPT-IST+1
      ROA=DRHOI_(IPT,1)
      ROB=ROA
      IF(ROA+ROB.LT.RCUTOFF) THEN
        GOTO 10
      ENDIF
C
C     -- TRANSFORM
C
      CALL VCLR(GMO,1,4*NA)
      DO I=1,L1
        AO=GAO(1,I,IIPT)
C STB - THIS IS NOT A VALID THRESHOLD
C        IF(ABS(AO).GT.CCUTOFF) THEN
        GX=GAO(2,I,IIPT)
        GY=GAO(3,I,IIPT)
        GZ=GAO(4,I,IIPT)
        IF((ABS(GX)+ABS(GY)+ABS(GZ)+ABS(AO)).GT.CCUTOFF) THEN
          DO J=1,NA
            COA=V(I,J)
            GMO(J,1)=GMO(J,1)+AO*COA
            GMO(J,2)=GMO(J,2)+GX*COA
            GMO(J,3)=GMO(J,3)+GY*COA
            GMO(J,4)=GMO(J,4)+GZ*COA
          END DO
        ENDIF
      END DO
C
C     -- TRANSITION DENSITY
C
      T1=ZERO
      TX=ZERO
      TY=ZERO
      TZ=ZERO
      DO I=1,L1
        AOI=GAO(1,I,IIPT)
C        IF(ABS(AOI).GT.CCUTOFF) THEN
        GXI=GAO(2,I,IIPT)
        GYI=GAO(3,I,IIPT)
        GZI=GAO(4,I,IIPT)
C
        IF((ABS(AOI)+ABS(GXI)+ABS(GYI)+ABS(GZI)).GT.CCUTOFF) THEN
           D0=ZERO
           DX=ZERO
           DY=ZERO
           DZ=ZERO
           DO J=1,NA
              D0=D0+VH(J,I)*GMO(J,1)
              DX=DX+VH(J,I)*GMO(J,2)
              DY=DY+VH(J,I)*GMO(J,3)
              DZ=DZ+VH(J,I)*GMO(J,4)
           END DO
           T1=T1+D0*AOI
           TX=TX+D0*GXI+DX*AOI
           TY=TY+D0*GYI+DY*AOI
           TZ=TZ+D0*GZI+DZ*AOI
        ENDIF
      END DO
C
      DTRAI_(1,IIPT)=T1
      DTRAI_(2,IIPT)=TX
      DTRAI_(3,IIPT)=TY
      DTRAI_(4,IIPT)=TZ
 10   CONTINUE
      END DO
C     -- GRID LOOP END
C
      RETURN
      END
C*MODULE TDDFXC  *DECK DENMEM
      SUBROUTINE DENMEM(RCUTOFF,RHO,DRHOI_,V,XYZWGT,XYZGRD,XYZDCH,
     * AOMAX,GMO,NPTGRD,L1,ILENG)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      PARAMETER (MXATM=2000)
      PARAMETER (MXGRID=10,MXGRIDTYP=10)
C
      LOGICAL GOPARR,DSKWRK,MASWRK,NXT,SG1
C
      DIMENSION DRHOI_(*)
      DIMENSION V(L1,*)
      DIMENSION XYZGRD(3,*)
      DIMENSION XYZWGT(*)
      DIMENSION XYZDCH(4,L1,*)
      DIMENSION AOMAX(*)
      DIMENSION GMO(*)
C
      COMMON /DFGRID/ DFTTHR,DFTGTHR,SWOFF,SW0,BSLRD(137),NDFTFG,
     *                NRAD,NTHE,NPHI,NRAD0,NTHE0,NPHI0,
     *                NANGPT(MXGRID),NANGPT0(MXGRID),SG1
      COMMON /DFPRUN/ PRUNERADS(MXGRID,MXGRIDTYP),
     *                PRUNEATOMS(2,MXGRIDTYP),
     *                IPRUNECUTS(MXATM),NTOTGRIDPOINTS(MXATM),
     *                NGRIDS,MAXANG,NGRIDTYPS
      COMMON /INFOA / NAT,ICH,MUL,NUM,NQMT,NE,NA,NB,
     *                ZAN(MXATM),C(3,MXATM),IAN(MXATM)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /SCFOPT/ CONVHF,MAXIT,MCONV,NPUNCH,NPREO(4)
C
      DATA ZERO      /0.0D+00/
C
C     SET CUT-OFFS
C
      NPT=NRAD*MAXANG
      RCUTOFF=CONVHF/(NPT*NAT)
      CCUTOFF=1.0D-03/(NPT*NAT)
C
      IST=0
      IEND=0
      IAREA=0
C
      CALL VCLR(DRHOI_,1,4*NPTGRD)
C
      RHO=ZERO
C
C     LOAD BALANCING TERMS
C
      LOOP = 0
      NGRAN = 20
      NLENG = (NPTGRD - 1)/ILENG + 1
      MCHUNK = (NLENG - 1)/(NGRAN*NPROC) + 1
      NEXT = -1
      NXT = IBTYP.EQ.1
C
C     CHANGED GOTO INTO A LOOP FOR PARALLELIZATION
C
      DO 10 ILG=1,NLENG
C
C   10 CONTINUE
C
C     DYNAMIC AND STATIC LOAD BALANCING TERMS
C
      IF(GOPARR) THEN
         IF(NXT) THEN
            LOOP = LOOP + 1
            ICHUNK=(LOOP-1)/MCHUNK
            IF(ICHUNK.GT.NEXT) THEN
               CALL DDI_DLBNEXT(NEXT)
            ENDIF
            IF(NEXT.NE.ICHUNK) GOTO 10
         ELSE
            IF(MOD(ILG,NPROC).NE.ME) GOTO 10
         ENDIF
      ENDIF
C
      IST=(ILG - 1) * ILENG + 1
      IEND=IST+ILENG-1
      IAREA=IAREA+1
      IF(IEND.GT.NPTGRD) IEND=NPTGRD
C************************************************************
C
C     -- MAKE AO-GRID & AOMAX
      CALL GRDGAO(IST,IEND,XYZGRD,XYZDCH,AOMAX,L1)
C
C     -- NUMERICAL INTEGRATION
C
      CALL DENCNST(RCUTOFF,CCUTOFF,RHO,DRHOI_,V,XYZWGT,XYZDCH,GMO,
     * IST,IEND,L1,NA,NPTGRD)
C     SUBROUTINE DENCNST(RCUTOFF,CCUTOFF,RHO,DRHOI_,V,WGT,GAO,GMO,
C    * IST,IEND,L1,NA,NPTGRD)
C************************************************************
C
C      IF(IEND.EQ.NPTGRD) THEN
C      GOTO 20
C      ELSE
C      GOTO 10
C      ENDIF
C   20 CONTINUE
C
 10   CONTINUE
C
C     REQUIRED DYNAMIC LOAD BALANCING RESET
C
      IF(GOPARR.AND.NXT) CALL DDI_DLBRESET
C
      RETURN
      END
C*MODULE TDDFXC  *DECK DENCNST
      SUBROUTINE DENCNST(RCUTOFF,CCUTOFF,RHO,DRHOI_,V,WGT,GAO,GMO,
     * IST,IEND,L1,NA,NPTGRD)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
        DIMENSION DRHOI_(NPTGRD,4)
      DIMENSION V(L1,*)
      DIMENSION WGT(NPTGRD)
      DIMENSION GAO(4,L1,*)
      DIMENSION GMO(NA,4)
      DATA TWO       /2.0D+00/
C     -- GRID LOOP
      DO IPT=IST,IEND
      IIPT=IPT-IST+1
C
C     -- TRANSFORM
C
      CALL VCLR(GMO,1,4*NA)
      DO I=1,L1
        AO=GAO(1,I,IIPT)
C        IF(ABS(AO).GT.CCUTOFF) THEN
        GX=GAO(2,I,IIPT)
        GY=GAO(3,I,IIPT)
        GZ=GAO(4,I,IIPT)
        IF((ABS(GX)+ABS(GY)+ABS(GZ)).GT.CCUTOFF) THEN
           DO J=1,NA
              COA=V(I,J)
              GMO(J,1)=GMO(J,1)+AO*COA
              GMO(J,2)=GMO(J,2)+GX*COA
              GMO(J,3)=GMO(J,3)+GY*COA
              GMO(J,4)=GMO(J,4)+GZ*COA
           END DO
        ENDIF
      END DO
C
C     -- FORM DENSITY AT THIS POINT
C
      ROA=DDOT(NA,GMO(1,1),1,GMO(1,1),1)
      ROB=ROA
      IF(ROA+ROB.LT.RCUTOFF) THEN
         GOTO 10
      ENDIF
      GRADXA=TWO*DDOT(NA,GMO(1,1),1,GMO(1,2),1)
      GRADYA=TWO*DDOT(NA,GMO(1,1),1,GMO(1,3),1)
      GRADZA=TWO*DDOT(NA,GMO(1,1),1,GMO(1,4),1)
C
      DRHOI_(IPT,1)=ROA
      DRHOI_(IPT,2)=GRADXA
      DRHOI_(IPT,3)=GRADYA
      DRHOI_(IPT,4)=GRADZA
      RHO=RHO+TWO*ROA*WGT(IPT)
 10   CONTINUE
      END DO
C     -- GRID LOOP END
C
      RETURN
      END
C*MODULE TDDFXC  *DECK NUMFK
      SUBROUTINE NUMFK(RHO,RCUTOFF,F,DRHOI_,DTRAI_,COEF,WGT,GAO,
     *                 VALGA,IST,IEND,L1,NPTGRD)
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      DIMENSION F(*)
      DIMENSION DRHOI_(NPTGRD,4,*)
      DIMENSION DTRAI_(4,*)
      DIMENSION COEF(3,*)
      DIMENSION WGT(NPTGRD)
      DIMENSION GAO(4,L1,*)
      DIMENSION VALGA(L1)
C
      DATA ZERO      /0.0D+00/
      DATA TWO       /2.0D+00/
C
C     -- GRID LOOP
C
      DO 200 IPT=IST,IEND
         IIPT=IPT-IST+1
         RHOI = DRHOI_(IPT,1,1)
         IF(RHOI*TWO.LT.RCUTOFF) GOTO 200
         FTOTWT=WGT(IPT)
C
         C1=COEF(1,IIPT)
         C2=COEF(2,IIPT)
         C3=COEF(3,IIPT)
C
         DRHOIX=DRHOI_(IPT,2,1)
         DRHOIY=DRHOI_(IPT,3,1)
         DRHOIZ=DRHOI_(IPT,4,1)
         DXB=DTRAI_(2,IIPT)
         DYB=DTRAI_(3,IIPT)
         DZB=DTRAI_(4,IIPT)
C
         IND=1
         AOMAX=ZERO
         AMAXVAL=ZERO
         DO M=1,L1
            PM=GAO(1,M,IIPT)
            PMX=GAO(2,M,IIPT)
            PMY=GAO(3,M,IIPT)
            PMZ=GAO(4,M,IIPT)
C
            VALGA(M)=(C1/TWO*PM+C2*DRHOIX*PMX+C2*DRHOIY*PMY+
     *                C2*DRHOIZ*PMZ+C3*DXB*PMX+C3*DYB*PMY+
     *                C3*DZB*PMZ)*FTOTWT
C
            VM=VALGA(M)
            AOMAX=MAX(AOMAX,ABS(PM))
            AMAXVAL=MAX(AMAXVAL,ABS(VM))
            DO N=1,M
               PN=GAO(1,N,IIPT)
               F(IND)=F(IND)+PM*VALGA(N)+VM*PN
               IND=IND+1
            END DO
         END DO
C
C     -- DEBUG DENSITY
C
         RHO   =RHO   +TWO*RHOI *WGT(IPT)
  200 CONTINUE
      RETURN
      END
C*MODULE TDDFXC  *DECK CANTOGEN
      SUBROUTINE CANTOGEN(D,SCR,L1)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /IJPAIR/ IA(8192)
        DIMENSION D(*)
      DIMENSION SCR(L1,*)
C
      DO I=1,L1
         DO J=1,L1
            IJ=IA(MAX(I,J))+MIN(I,J)
            SCR(I,J)=D(IJ)
         END DO
      END DO
C
      RETURN
      END
C*MODULE TDDFXC  *DECK TDCOF
      SUBROUTINE TDCOF(COEF,EX,EC,DRHOI_,DTRAI_,RCUTOFF,NPTGRD,
     * IST,IEND,ILENG)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL TRIPLET,SG1T
      PARAMETER (MXRT=100)
      COMMON /INFOTD/ TDM(3,MXRT),CNVTOL,TRIPLET,MOCC(MXRT),MVIR(MXRT),
     *                NRADT,NTHET,NPHIT,NSTAT,NTRIAL,MAXVEC,NTHST,
     *                IRECTD,NLEBT,SG1T
      COMMON /XDERIX/ NXDIM(3),KRA,KRB,KGA,KGB,KRARA,KRAGA,KGAGA,
     *                KRBRB,KRBGB,KGBGB,KRARARA,KRARAGA,KRAGAGA,KGAGAGA,
     *                KRBRBRB,KRBRBGB,KRBGBGB,KGBGBGB
      COMMON/ CDERIX/ NCDIM(3),IRA,IRB,IGA,IGB,IGC,IRARA,IRARB,
     *                IRAGA,IRAGB,IRAGC,IRBRB,IRBGA,IRBGB,IRBGC,IGAGA,
     *                IGAGB,IGAGC,IGBGB,IGBGC,IGCGC,
     *                IRARARA,IRARARB,IRARAGA,IRARAGB,IRARAGC,IRARBRB,
     *                IRARBGA,IRARBGB,IRARBGC,IRAGAGA,IRAGAGB,IRAGAGC,
     *                IRAGBGB,IRAGBGC,IRAGCGC,IRBRBRB,IRBRBGA,IRBRBGB,
     *                IRBRBGC,IRBGAGA,IRBGAGB,IRBGAGC,IRBGBGB,IRBGBGC,
     *                IRBGCGC,IGAGAGA,IGAGAGB,IGAGAGC,IGAGBGB,IGAGBGC,
     *                IGAGCGC,IGBGBGB,IGBGBGC,IGBGCGC,IGCGCGC
      DIMENSION COEF(3,*)
      DIMENSION DRHOI_(NPTGRD,4)
      DIMENSION DTRAI_(4,*)
      DIMENSION EX(ILENG,*)
      DIMENSION EC(ILENG,*)
      DATA TWO       /2.0D+00/
      DATA FOUR      /4.0D+00/
C
      CALL VCLR(COEF,1,ILENG*3)
C
      DO IPT=IST,IEND
      IIPT=IPT-IST+1
      RHOI=DRHOI_(IPT,1)
      IF(RHOI.GT.RCUTOFF) THEN
         DRHOIX=DRHOI_(IPT,2)
         DRHOIY=DRHOI_(IPT,3)
         DRHOIZ=DRHOI_(IPT,4)
         DUMNB=DTRAI_(1,IIPT)
         DXB=DTRAI_(2,IIPT)
         DYB=DTRAI_(3,IIPT)
         DZB=DTRAI_(4,IIPT)
C
C     -- DUMGRB
         DUMGRB=DXB*DRHOIX+DYB*DRHOIY+DZB*DRHOIZ
C
C     ---- CONTRACTION
C     -- EXCHANGE
C     -- FOR DUMN:OK
         XDUM1B=EX(IIPT,KRARA)*DUMNB+TWO*EX(IIPT,KRAGA)*DUMGRB
C     -- FOR DUMGR:OK
         XDUM2B=TWO*EX(IIPT,KRAGA)*DUMNB+FOUR*EX(IIPT,KGAGA)*DUMGRB
C     -- FOR DUMXP:OK
         XDUM3B=TWO*EX(IIPT,KGA)
C     -- CORRELATION
C     -- FOR DUMN:OK
         CDUM1BAA=EC(IIPT,IRARA)*DUMNB+TWO*EC(IIPT,IRAGA)*DUMGRB
     *        +EC(IIPT,IRAGC)*DUMGRB
         CDUM1BAB=EC(IIPT,IRARB)*DUMNB+TWO*EC(IIPT,IRAGB)*DUMGRB
     *        +EC(IIPT,IRAGC)*DUMGRB
C     -- FOR DUMGR:OKX
         CDUM2BAA=TWO*EC(IIPT,IRAGA)*DUMNB+EC(IIPT,IRAGC)*DUMNB
     *        +FOUR*EC(IIPT,IGAGA)*DUMGRB+TWO*EC(IIPT,IGAGC)*DUMGRB
     *        +TWO*EC(IIPT,IGAGC)*DUMGRB+EC(IIPT,IGCGC)*DUMGRB
         CDUM2BAB=TWO*EC(IIPT,IRBGA)*DUMNB+EC(IIPT,IRBGC)*DUMNB
     *        +FOUR*EC(IIPT,IGAGB)*DUMGRB+TWO*EC(IIPT,IGAGC)*DUMGRB
     *        +TWO*EC(IIPT,IGBGC)*DUMGRB+EC(IIPT,IGCGC)*DUMGRB
C     -- FOR DUMXB:OK
         CDUM3BAA=TWO*EC(IIPT,IGA)
         CDUM3BAB=EC(IIPT,IGC)
C     -- TOTAL
         IF(.NOT.TRIPLET) THEN
            COEF(1,IIPT)=XDUM1B+CDUM1BAA+CDUM1BAB
            COEF(2,IIPT)=XDUM2B+CDUM2BAA+CDUM2BAB
            COEF(3,IIPT)=XDUM3B+CDUM3BAA+CDUM3BAB
         ELSE
            COEF(1,IIPT)=XDUM1B+CDUM1BAA-CDUM1BAB
            COEF(2,IIPT)=XDUM2B+CDUM2BAA-CDUM2BAB
            COEF(3,IIPT)=XDUM3B+CDUM3BAA-CDUM3BAB
         ENDIF
      ENDIF
C
      END DO
      RETURN
      END
C     *MODULE TDDFXC  *DECK GCOF
      SUBROUTINE GCOF(COEF,EX,EC,DRHOI_,DTRAI_,RCUTOFF,NPTGRD,
     *     IST,IEND,ILENG)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /XDERIX/ NXDIM(3),KRA,KRB,KGA,KGB,KRARA,KRAGA,KGAGA,
     *     KRBRB,KRBGB,KGBGB,KRARARA,KRARAGA,KRAGAGA,KGAGAGA,
     *     KRBRBRB,KRBRBGB,KRBGBGB,KGBGBGB
      COMMON/ CDERIX/ NCDIM(3),IRA,IRB,IGA,IGB,IGC,IRARA,IRARB,
     *     IRAGA,IRAGB,IRAGC,IRBRB,IRBGA,IRBGB,IRBGC,IGAGA,
     *     IGAGB,IGAGC,IGBGB,IGBGC,IGCGC,
     *     IRARARA,IRARARB,IRARAGA,IRARAGB,IRARAGC,IRARBRB,
     *     IRARBGA,IRARBGB,IRARBGC,IRAGAGA,IRAGAGB,IRAGAGC,
     *     IRAGBGB,IRAGBGC,IRAGCGC,IRBRBRB,IRBRBGA,IRBRBGB,
     *     IRBRBGC,IRBGAGA,IRBGAGB,IRBGAGC,IRBGBGB,IRBGBGC,
     *     IRBGCGC,IGAGAGA,IGAGAGB,IGAGAGC,IGAGBGB,IGAGBGC,
     *     IGAGCGC,IGBGBGB,IGBGBGC,IGBGCGC,IGCGCGC
      DIMENSION COEF(3,*)
      DIMENSION DRHOI_(NPTGRD,4)
      DIMENSION DTRAI_(4,*)
      DIMENSION EX(ILENG,*)
      DIMENSION EC(ILENG,*)
      DIMENSION DUMNV(2),DXV(2),DYV(2),DZV(2),DUMGRV(4),DUMXX(4)
      DATA ZERO      /0.0D+00/
      DATA TWO       /2.0D+00/
      DATA FOUR      /4.0D+00/
C
      CALL VCLR(COEF,1,ILENG*3)
C
      DO IPT=IST,IEND
         IIPT=IPT-IST+1
         RHOA = DRHOI_(IPT,1)
         RHOB = DRHOI_(IPT,1)
         RHOT=RHOA+RHOB
         IF(RHOT.GT.RCUTOFF) THEN
            DRHOAX=DRHOI_(IPT,2)
            DRHOAY=DRHOI_(IPT,3)
            DRHOAZ=DRHOI_(IPT,4)
            DRHOBX=DRHOI_(IPT,2)
            DRHOBY=DRHOI_(IPT,3)
            DRHOBZ=DRHOI_(IPT,4)
C
            DUMNV(1)=DTRAI_(1,IIPT)
            DXV(1)=DTRAI_(2,IIPT)
            DYV(1)=DTRAI_(3,IIPT)
            DZV(1)=DTRAI_(4,IIPT)
            DUMNV(2)=DTRAI_(1,IIPT)
            DXV(2)=DTRAI_(2,IIPT)
            DYV(2)=DTRAI_(3,IIPT)
            DZV(2)=DTRAI_(4,IIPT)
C
C     -- DUMGRV
C     1:A*A 2:B*B 3:A*B 4:B*A
            DUMGRV(1)=DXV(1)*DRHOAX+DYV(1)*DRHOAY+DZV(1)*DRHOAZ
            DUMGRV(2)=DXV(2)*DRHOBX+DYV(2)*DRHOBY+DZV(2)*DRHOBZ
            DUMGRV(3)=DXV(1)*DRHOBX+DYV(1)*DRHOBY+DZV(1)*DRHOBZ
            DUMGRV(4)=DXV(2)*DRHOAX+DYV(2)*DRHOAY+DZV(2)*DRHOAZ
            DUMXX(1)=DXV(1)*DXV(1)+DYV(1)*DYV(1)+DZV(1)*DZV(1)
            DUMXX(2)=DXV(2)*DXV(2)+DYV(2)*DYV(2)+DZV(2)*DZV(2)
            DUMXX(3)=DXV(1)*DXV(2)+DYV(1)*DYV(2)+DZV(1)*DZV(2)
            DUMXX(4)=DUMXX(3)
C
C     ---- FOR G(L2):3RD DERIVATIVES :F_CORE
C     ********F_CORE****************
C     ********G_ALPHA***************DUM"A",DUM"A"G
C     --AA
            C1=TWO*DUMXX(1)
            C2=DUMNV(1)*DUMNV(1)
            C3=TWO*DUMNV(1)*DUMGRV(1)
            C4=TWO*DUMGRV(1)*DUMNV(1)
            C5=DUMGRV(1)*DUMNV(1)
            C6=DUMNV(1)*DUMGRV(1)
            C7=FOUR*DUMGRV(1)*DUMGRV(1)
            C8=TWO*DUMGRV(1)*DUMGRV(1)
            C9=TWO*DUMGRV(1)*DUMGRV(1)
            C10=DUMGRV(1)*DUMGRV(1)
C     -- EXCHANGE
            XDUMA=ZERO
            XDUMAG=ZERO
C     A-AA--1
            XDUMA=XDUMA+C1*EX(IIPT,KRAGA)
            XDUMAG=XDUMAG+C1*TWO*EX(IIPT,KGAGA)
C     --2
            XDUMA=XDUMA+C2*EX(IIPT,KRARARA)
            XDUMAG=XDUMAG+C2*TWO*EX(IIPT,KRARAGA)
C     --3
            XDUMA=XDUMA+C3*EX(IIPT,KRARAGA)
            XDUMAG=XDUMAG+C3*TWO*EX(IIPT,KRAGAGA)
C     --4
            XDUMA=XDUMA+C4*EX(IIPT,KRARAGA)
            XDUMAG=XDUMAG+C4*TWO*EX(IIPT,KRAGAGA)
C     --7
            XDUMA=XDUMA+C7*EX(IIPT,KRAGAGA)
            XDUMAG=XDUMAG+C7*TWO*EX(IIPT,KGAGAGA)
C     -- CORRELATION
            CDUMA=ZERO
            CDUMAG1=ZERO
            CDUMAG2=ZERO
C     A-AA--1     GA
            CDUMA=CDUMA+C1*EC(IIPT,IRAGA)
            CDUMAG1=CDUMAG1+C1*TWO*EC(IIPT,IGAGA)
            CDUMAG2=CDUMAG2+C1*EC(IIPT,IGAGC)
C     --2        RARA
            CDUMA=CDUMA+C2*EC(IIPT,IRARARA)
            CDUMAG1=CDUMAG1+C2*TWO*EC(IIPT,IRARAGA)
            CDUMAG2=CDUMAG2+C2*EC(IIPT,IRARAGC)
C     --3        RAGA
            CDUMA=CDUMA+C3*EC(IIPT,IRARAGA)
            CDUMAG1=CDUMAG1+C3*TWO*EC(IIPT,IRAGAGA)
            CDUMAG2=CDUMAG2+C3*EC(IIPT,IRAGAGC)
C     --4        RAGA
            CDUMA=CDUMA+C4*EC(IIPT,IRARAGA)
            CDUMAG1=CDUMAG1+C4*TWO*EC(IIPT,IRAGAGA)
            CDUMAG2=CDUMAG2+C4*EC(IIPT,IRAGAGC)
C     --5        RAGC
            CDUMA=CDUMA+C5*EC(IIPT,IRARAGC)
            CDUMAG1=CDUMAG1+C5*TWO*EC(IIPT,IRAGAGC)
            CDUMAG2=CDUMAG2+C5*EC(IIPT,IRAGCGC)
C     --6        RAGC
            CDUMA=CDUMA+C6*EC(IIPT,IRARAGC)
            CDUMAG1=CDUMAG1+C6*TWO*EC(IIPT,IRAGAGC)
            CDUMAG2=CDUMAG2+C6*EC(IIPT,IRAGCGC)
C     --7        GAGA
            CDUMA=CDUMA+C7*EC(IIPT,IRAGAGA)
            CDUMAG1=CDUMAG1+C7*TWO*EC(IIPT,IGAGAGA)
            CDUMAG2=CDUMAG2+C7*EC(IIPT,IGAGAGC)
C     --8        GAGC
            CDUMA=CDUMA+C8*EC(IIPT,IRAGAGC)
            CDUMAG1=CDUMAG1+C8*TWO*EC(IIPT,IGAGAGC)
            CDUMAG2=CDUMAG2+C8*EC(IIPT,IGAGCGC)
C     --9        GAGC
            CDUMA=CDUMA+C9*EC(IIPT,IRAGAGC)
            CDUMAG1=CDUMAG1+C9*TWO*EC(IIPT,IGAGAGC)
            CDUMAG2=CDUMAG2+C9*EC(IIPT,IGAGCGC)
C     --10       GCGC
            CDUMA=CDUMA+C10*EC(IIPT,IRAGCGC)
            CDUMAG1=CDUMAG1+C10*TWO*EC(IIPT,IGAGCGC)
            CDUMAG2=CDUMAG2+C10*EC(IIPT,IGCGCGC)
C     --BB
            C1=TWO*DUMXX(2)
            C2=DUMNV(2)*DUMNV(2)
            C3=TWO*DUMNV(2)*DUMGRV(2)
            C4=TWO*DUMGRV(2)*DUMNV(2)
            C5=DUMGRV(2)*DUMNV(2)
            C6=DUMNV(2)*DUMGRV(2)
            C7=FOUR*DUMGRV(2)*DUMGRV(2)
            C8=TWO*DUMGRV(2)*DUMGRV(2)
            C9=TWO*DUMGRV(2)*DUMGRV(2)
            C10=DUMGRV(2)*DUMGRV(2)
C     A-BB--1      GB
            CDUMA=CDUMA+C1*EC(IIPT,IRAGB)
            CDUMAG1=CDUMAG1+C1*TWO*EC(IIPT,IGAGB)
            CDUMAG2=CDUMAG2+C1*EC(IIPT,IGBGC)
C     --2        RBRB
            CDUMA=CDUMA+C2*EC(IIPT,IRARBRB)
            CDUMAG1=CDUMAG1+C2*TWO*EC(IIPT,IRBRBGA)
            CDUMAG2=CDUMAG2+C2*EC(IIPT,IRBRBGC)
C     --3        RBGB
            CDUMA=CDUMA+C3*EC(IIPT,IRARBGB)
            CDUMAG1=CDUMAG1+C3*TWO*EC(IIPT,IRBGAGB)
            CDUMAG2=CDUMAG2+C3*EC(IIPT,IRBGBGC)
C     --4        RBGB
            CDUMA=CDUMA+C4*EC(IIPT,IRARBGB)
            CDUMAG1=CDUMAG1+C4*TWO*EC(IIPT,IRBGAGB)
            CDUMAG2=CDUMAG2+C4*EC(IIPT,IRBGBGC)
C     --5        RBGC
            CDUMA=CDUMA+C5*EC(IIPT,IRARBGC)
            CDUMAG1=CDUMAG1+C5*TWO*EC(IIPT,IRBGAGC)
            CDUMAG2=CDUMAG2+C5*EC(IIPT,IRBGCGC)
C     --6        RBGC
            CDUMA=CDUMA+C6*EC(IIPT,IRARBGC)
            CDUMAG1=CDUMAG1+C6*TWO*EC(IIPT,IRBGAGC)
            CDUMAG2=CDUMAG2+C6*EC(IIPT,IRBGCGC)
C     --7        GBGB
            CDUMA=CDUMA+C7*EC(IIPT,IRAGBGB)
            CDUMAG1=CDUMAG1+C7*TWO*EC(IIPT,IGAGBGB)
            CDUMAG2=CDUMAG2+C7*EC(IIPT,IGBGBGC)
C     --8        GBGC
            CDUMA=CDUMA+C8*EC(IIPT,IRAGBGC)
            CDUMAG1=CDUMAG1+C8*TWO*EC(IIPT,IGAGBGC)
            CDUMAG2=CDUMAG2+C8*EC(IIPT,IGBGCGC)
C     --9        GBGC
            CDUMA=CDUMA+C9*EC(IIPT,IRAGBGC)
            CDUMAG1=CDUMAG1+C9*TWO*EC(IIPT,IGAGBGC)
            CDUMAG2=CDUMAG2+C9*EC(IIPT,IGBGCGC)
C     --10       GCGC
            CDUMA=CDUMA+C10*EC(IIPT,IRAGCGC)
            CDUMAG1=CDUMAG1+C10*TWO*EC(IIPT,IGAGCGC)
            CDUMAG2=CDUMAG2+C10*EC(IIPT,IGCGCGC)
C     --ABORBA
            C11=DUMXX(3)
            C12=DUMNV(1)*DUMNV(2)
            C13=TWO*DUMNV(1)*DUMGRV(2)
            C14=TWO*DUMGRV(1)*DUMNV(2)
            C15=DUMNV(1)*DUMGRV(4)
            C16=DUMGRV(3)*DUMNV(2)
            C17=FOUR*DUMGRV(1)*DUMGRV(2)
            C18=TWO*DUMGRV(1)*DUMGRV(4)
            C19=TWO*DUMGRV(3)*DUMGRV(2)
            C20=DUMGRV(3)*DUMGRV(4)
C     A-AB--11   GC
            CDUMA=CDUMA+C11*EC(IIPT,IRAGC)
            CDUMAG1=CDUMAG1+C11*TWO*EC(IIPT,IGAGC)
            CDUMAG2=CDUMAG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
            CDUMA=CDUMA+C12*EC(IIPT,IRARARB)
            CDUMAG1=CDUMAG1+C12*TWO*EC(IIPT,IRARBGA)
            CDUMAG2=CDUMAG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
            CDUMA=CDUMA+C13*EC(IIPT,IRARAGB)
            CDUMAG1=CDUMAG1+C13*TWO*EC(IIPT,IRAGAGB)
            CDUMAG2=CDUMAG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
            CDUMA=CDUMA+C14*EC(IIPT,IRARBGA)
            CDUMAG1=CDUMAG1+C14*TWO*EC(IIPT,IRBGAGA)
            CDUMAG2=CDUMAG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
            CDUMA=CDUMA+C15*EC(IIPT,IRARAGC)
            CDUMAG1=CDUMAG1+C15*TWO*EC(IIPT,IRAGAGC)
            CDUMAG2=CDUMAG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
            CDUMA=CDUMA+C16*EC(IIPT,IRARBGC)
            CDUMAG1=CDUMAG1+C16*TWO*EC(IIPT,IRBGAGC)
            CDUMAG2=CDUMAG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
            CDUMA=CDUMA+C17*EC(IIPT,IRAGAGB)
            CDUMAG1=CDUMAG1+C17*TWO*EC(IIPT,IGAGAGB)
            CDUMAG2=CDUMAG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
            CDUMA=CDUMA+C18*EC(IIPT,IRAGAGC)
            CDUMAG1=CDUMAG1+C18*TWO*EC(IIPT,IGAGAGC)
            CDUMAG2=CDUMAG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
            CDUMA=CDUMA+C19*EC(IIPT,IRAGBGC)
            CDUMAG1=CDUMAG1+C19*TWO*EC(IIPT,IGAGBGC)
            CDUMAG2=CDUMAG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
            CDUMA=CDUMA+C20*EC(IIPT,IRAGCGC)
            CDUMAG1=CDUMAG1+C20*TWO*EC(IIPT,IGAGCGC)
            CDUMAG2=CDUMAG2+C20*EC(IIPT,IGCGCGC)
C     **BA_TERM=AB_TERM**
C     --ABORBA
            C11=DUMXX(3)
            C12=DUMNV(1)*DUMNV(2)
            C13=TWO*DUMNV(1)*DUMGRV(2)
            C14=TWO*DUMGRV(1)*DUMNV(2)
            C15=DUMNV(1)*DUMGRV(4)
            C16=DUMGRV(3)*DUMNV(2)
            C17=FOUR*DUMGRV(1)*DUMGRV(2)
            C18=TWO*DUMGRV(1)*DUMGRV(4)
            C19=TWO*DUMGRV(3)*DUMGRV(2)
            C20=DUMGRV(3)*DUMGRV(4)
C     A-AB--11   GC
            CDUMA=CDUMA+C11*EC(IIPT,IRAGC)
            CDUMAG1=CDUMAG1+C11*TWO*EC(IIPT,IGAGC)
            CDUMAG2=CDUMAG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
            CDUMA=CDUMA+C12*EC(IIPT,IRARARB)
            CDUMAG1=CDUMAG1+C12*TWO*EC(IIPT,IRARBGA)
            CDUMAG2=CDUMAG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
            CDUMA=CDUMA+C13*EC(IIPT,IRARAGB)
            CDUMAG1=CDUMAG1+C13*TWO*EC(IIPT,IRAGAGB)
            CDUMAG2=CDUMAG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
            CDUMA=CDUMA+C14*EC(IIPT,IRARBGA)
            CDUMAG1=CDUMAG1+C14*TWO*EC(IIPT,IRBGAGA)
            CDUMAG2=CDUMAG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
            CDUMA=CDUMA+C15*EC(IIPT,IRARAGC)
            CDUMAG1=CDUMAG1+C15*TWO*EC(IIPT,IRAGAGC)
            CDUMAG2=CDUMAG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
            CDUMA=CDUMA+C16*EC(IIPT,IRARBGC)
            CDUMAG1=CDUMAG1+C16*TWO*EC(IIPT,IRBGAGC)
            CDUMAG2=CDUMAG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
            CDUMA=CDUMA+C17*EC(IIPT,IRAGAGB)
            CDUMAG1=CDUMAG1+C17*TWO*EC(IIPT,IGAGAGB)
            CDUMAG2=CDUMAG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
            CDUMA=CDUMA+C18*EC(IIPT,IRAGAGC)
            CDUMAG1=CDUMAG1+C18*TWO*EC(IIPT,IGAGAGC)
            CDUMAG2=CDUMAG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
            CDUMA=CDUMA+C19*EC(IIPT,IRAGBGC)
            CDUMAG1=CDUMAG1+C19*TWO*EC(IIPT,IGAGBGC)
            CDUMAG2=CDUMAG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
            CDUMA=CDUMA+C20*EC(IIPT,IRAGCGC)
            CDUMAG1=CDUMAG1+C20*TWO*EC(IIPT,IGAGCGC)
            CDUMAG2=CDUMAG2+C20*EC(IIPT,IGCGCGC)
C     ********G_ALPHA END***********DUM"A",DUM"A"G
C     ********G_BETA****************DUM"B",DUM"B"G
C     *RB OR GB OR GC
C     AA
            C1=TWO*DUMXX(1)
            C2=DUMNV(1)*DUMNV(1)
            C3=TWO*DUMNV(1)*DUMGRV(1)
            C4=TWO*DUMGRV(1)*DUMNV(1)
            C5=DUMGRV(1)*DUMNV(1)
            C6=DUMNV(1)*DUMGRV(1)
            C7=FOUR*DUMGRV(1)*DUMGRV(1)
            C8=TWO*DUMGRV(1)*DUMGRV(1)
            C9=TWO*DUMGRV(1)*DUMGRV(1)
            C10=DUMGRV(1)*DUMGRV(1)
C     -- CORRELATION
            CDUMB=ZERO
            CDUMBG1=ZERO
            CDUMBG2=ZERO
C     B-AA--1     GA
            CDUMB=CDUMB+C1*EC(IIPT,IRBGA)
            CDUMBG1=CDUMBG1+C1*TWO*EC(IIPT,IGAGB)
            CDUMBG2=CDUMBG2+C1*EC(IIPT,IGAGC)
C     --2        RARA
            CDUMB=CDUMB+C2*EC(IIPT,IRARARB)
            CDUMBG1=CDUMBG1+C2*TWO*EC(IIPT,IRARAGB)
            CDUMBG2=CDUMBG2+C2*EC(IIPT,IRARAGC)
C     --3        RAGA
            CDUMB=CDUMB+C3*EC(IIPT,IRARBGA)
            CDUMBG1=CDUMBG1+C3*TWO*EC(IIPT,IRAGAGB)
            CDUMBG2=CDUMBG2+C3*EC(IIPT,IRAGAGC)
C     --4        RAGA
            CDUMB=CDUMB+C4*EC(IIPT,IRARBGA)
            CDUMBG1=CDUMBG1+C4*TWO*EC(IIPT,IRAGAGB)
            CDUMBG2=CDUMBG2+C4*EC(IIPT,IRAGAGC)
C     --5        RAGC
            CDUMB=CDUMB+C5*EC(IIPT,IRARBGC)
            CDUMBG1=CDUMBG1+C5*TWO*EC(IIPT,IRAGBGC)
            CDUMBG2=CDUMBG2+C5*EC(IIPT,IRAGCGC)
C     --6        RAGC
            CDUMB=CDUMB+C6*EC(IIPT,IRARBGC)
            CDUMBG1=CDUMBG1+C6*TWO*EC(IIPT,IRAGBGC)
            CDUMBG2=CDUMBG2+C6*EC(IIPT,IRAGCGC)
C     --7        GAGA
            CDUMB=CDUMB+C7*EC(IIPT,IRBGAGA)
            CDUMBG1=CDUMBG1+C7*TWO*EC(IIPT,IGAGAGB)
            CDUMBG2=CDUMBG2+C7*EC(IIPT,IGAGAGC)
C     --8        GAGC
            CDUMB=CDUMB+C8*EC(IIPT,IRBGAGC)
            CDUMBG1=CDUMBG1+C8*TWO*EC(IIPT,IGAGBGC)
            CDUMBG2=CDUMBG2+C8*EC(IIPT,IGAGCGC)
C     --9        GAGC
            CDUMB=CDUMB+C9*EC(IIPT,IRBGAGC)
            CDUMBG1=CDUMBG1+C9*TWO*EC(IIPT,IGAGBGC)
            CDUMBG2=CDUMBG2+C9*EC(IIPT,IGAGCGC)
C     --10       GCGC
            CDUMB=CDUMB+C10*EC(IIPT,IRBGCGC)
            CDUMBG1=CDUMBG1+C10*TWO*EC(IIPT,IGBGCGC)
            CDUMBG2=CDUMBG2+C10*EC(IIPT,IGCGCGC)
C     --BB
            C1=TWO*DUMXX(2)
            C2=DUMNV(2)*DUMNV(2)
            C3=TWO*DUMNV(2)*DUMGRV(2)
            C4=TWO*DUMGRV(2)*DUMNV(2)
            C5=DUMGRV(2)*DUMNV(2)
            C6=DUMNV(2)*DUMGRV(2)
            C7=FOUR*DUMGRV(2)*DUMGRV(2)
            C8=TWO*DUMGRV(2)*DUMGRV(2)
            C9=TWO*DUMGRV(2)*DUMGRV(2)
            C10=DUMGRV(2)*DUMGRV(2)
C     -- EXCHANGE
            XDUMB=ZERO
            XDUMBG=ZERO
C     B-BB--1      GB
            XDUMB=XDUMB+C1*EX(IIPT,KRBGB)
            XDUMBG=XDUMBG+C1*TWO*EX(IIPT,KGBGB)
C     --2          RBRB
            XDUMB=XDUMB+C2*EX(IIPT,KRBRBRB)
            XDUMBG=XDUMBG+C2*TWO*EX(IIPT,KRBRBGB)
C     --3          RBGB
            XDUMB=XDUMB+C3*EX(IIPT,KRBRBGB)
            XDUMBG=XDUMBG+C3*TWO*EX(IIPT,KRBGBGB)
C     --4          RBGB
            XDUMB=XDUMB+C4*EX(IIPT,KRBRBGB)
            XDUMBG=XDUMBG+C4*TWO*EX(IIPT,KRBGBGB)
C     --7          GBGB
            XDUMB=XDUMB+C7*EX(IIPT,KRBGBGB)
            XDUMBG=XDUMBG+C7*TWO*EX(IIPT,KGBGBGB)
C     B-BB--1      GB
            CDUMB=CDUMB+C1*EC(IIPT,IRBGB)
            CDUMBG1=CDUMBG1+C1*TWO*EC(IIPT,IGBGB)
            CDUMBG2=CDUMBG2+C1*EC(IIPT,IGBGC)
C     --2        RBRB
            CDUMB=CDUMB+C2*EC(IIPT,IRBRBRB)
            CDUMBG1=CDUMBG1+C2*TWO*EC(IIPT,IRBRBGB)
            CDUMBG2=CDUMBG2+C2*EC(IIPT,IRBRBGC)
C     --3        RBGB
            CDUMB=CDUMB+C3*EC(IIPT,IRBRBGB)
            CDUMBG1=CDUMBG1+C3*TWO*EC(IIPT,IRBGBGB)
            CDUMBG2=CDUMBG2+C3*EC(IIPT,IRBGBGC)
C     --4        RBGB
            CDUMB=CDUMB+C4*EC(IIPT,IRBRBGB)
            CDUMBG1=CDUMBG1+C4*TWO*EC(IIPT,IRBGBGB)
            CDUMBG2=CDUMBG2+C4*EC(IIPT,IRBGBGC)
C     --5        RBGC
            CDUMB=CDUMB+C5*EC(IIPT,IRBRBGC)
            CDUMBG1=CDUMBG1+C5*TWO*EC(IIPT,IRBGBGC)
            CDUMBG2=CDUMBG2+C5*EC(IIPT,IRBGCGC)
C     --6        RBGC
            CDUMB=CDUMB+C6*EC(IIPT,IRBRBGC)
            CDUMBG1=CDUMBG1+C6*TWO*EC(IIPT,IRBGBGC)
            CDUMBG2=CDUMBG2+C6*EC(IIPT,IRBGCGC)
C     --7        GBGB
            CDUMB=CDUMB+C7*EC(IIPT,IRBGBGB)
            CDUMBG1=CDUMBG1+C7*TWO*EC(IIPT,IGBGBGB)
            CDUMBG2=CDUMBG2+C7*EC(IIPT,IGBGBGC)
C     --8        GBGC
            CDUMB=CDUMB+C8*EC(IIPT,IRBGBGC)
            CDUMBG1=CDUMBG1+C8*TWO*EC(IIPT,IGBGBGC)
            CDUMBG2=CDUMBG2+C8*EC(IIPT,IGBGCGC)
C     --9        GBGC
            CDUMB=CDUMB+C9*EC(IIPT,IRBGBGC)
            CDUMBG1=CDUMBG1+C9*TWO*EC(IIPT,IGBGBGC)
            CDUMBG2=CDUMBG2+C9*EC(IIPT,IGBGCGC)
C     --10       GCGC
            CDUMB=CDUMB+C10*EC(IIPT,IRBGCGC)
            CDUMBG1=CDUMBG1+C10*TWO*EC(IIPT,IGBGCGC)
            CDUMBG2=CDUMBG2+C10*EC(IIPT,IGCGCGC)
C     --ABORBA
            C11=DUMXX(3)
            C12=DUMNV(1)*DUMNV(2)
            C13=TWO*DUMNV(1)*DUMGRV(2)
            C14=TWO*DUMGRV(1)*DUMNV(2)
            C15=DUMNV(1)*DUMGRV(4)
            C16=DUMGRV(3)*DUMNV(2)
            C17=FOUR*DUMGRV(1)*DUMGRV(2)
            C18=TWO*DUMGRV(1)*DUMGRV(4)
            C19=TWO*DUMGRV(3)*DUMGRV(2)
            C20=DUMGRV(3)*DUMGRV(4)
C     B-AB--11   GC
            CDUMB=CDUMB+C11*EC(IIPT,IRBGC)
            CDUMBG1=CDUMBG1+C11*TWO*EC(IIPT,IGBGC)
            CDUMBG2=CDUMBG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
            CDUMB=CDUMB+C12*EC(IIPT,IRARBRB)
            CDUMBG1=CDUMBG1+C12*TWO*EC(IIPT,IRARBGB)
            CDUMBG2=CDUMBG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
            CDUMB=CDUMB+C13*EC(IIPT,IRARBGB)
            CDUMBG1=CDUMBG1+C13*TWO*EC(IIPT,IRAGBGB)
            CDUMBG2=CDUMBG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
            CDUMB=CDUMB+C14*EC(IIPT,IRBRBGA)
            CDUMBG1=CDUMBG1+C14*TWO*EC(IIPT,IRBGAGB)
            CDUMBG2=CDUMBG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
            CDUMB=CDUMB+C15*EC(IIPT,IRARBGC)
            CDUMBG1=CDUMBG1+C15*TWO*EC(IIPT,IRAGBGC)
            CDUMBG2=CDUMBG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
            CDUMB=CDUMB+C16*EC(IIPT,IRBRBGC)
            CDUMBG1=CDUMBG1+C16*TWO*EC(IIPT,IRBGBGC)
            CDUMBG2=CDUMBG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
            CDUMB=CDUMB+C17*EC(IIPT,IRBGAGB)
            CDUMBG1=CDUMBG1+C17*TWO*EC(IIPT,IGAGBGB)
            CDUMBG2=CDUMBG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
            CDUMB=CDUMB+C18*EC(IIPT,IRBGAGC)
            CDUMBG1=CDUMBG1+C18*TWO*EC(IIPT,IGAGBGC)
            CDUMBG2=CDUMBG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
            CDUMB=CDUMB+C19*EC(IIPT,IRBGBGC)
            CDUMBG1=CDUMBG1+C19*TWO*EC(IIPT,IGBGBGC)
            CDUMBG2=CDUMBG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
            CDUMB=CDUMB+C20*EC(IIPT,IRBGCGC)
            CDUMBG1=CDUMBG1+C20*TWO*EC(IIPT,IGBGCGC)
            CDUMBG2=CDUMBG2+C20*EC(IIPT,IGCGCGC)
C     **BA_TERM=AB_TERM**
C     B-BA--11   GC
            CDUMB=CDUMB+C11*EC(IIPT,IRBGC)
            CDUMBG1=CDUMBG1+C11*TWO*EC(IIPT,IGBGC)
            CDUMBG2=CDUMBG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
            CDUMB=CDUMB+C12*EC(IIPT,IRARBRB)
            CDUMBG1=CDUMBG1+C12*TWO*EC(IIPT,IRARBGB)
            CDUMBG2=CDUMBG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
            CDUMB=CDUMB+C13*EC(IIPT,IRARBGB)
            CDUMBG1=CDUMBG1+C13*TWO*EC(IIPT,IRAGBGB)
            CDUMBG2=CDUMBG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
            CDUMB=CDUMB+C14*EC(IIPT,IRBRBGA)
            CDUMBG1=CDUMBG1+C14*TWO*EC(IIPT,IRBGAGB)
            CDUMBG2=CDUMBG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
            CDUMB=CDUMB+C15*EC(IIPT,IRARBGC)
            CDUMBG1=CDUMBG1+C15*TWO*EC(IIPT,IRAGBGC)
            CDUMBG2=CDUMBG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
            CDUMB=CDUMB+C16*EC(IIPT,IRBRBGC)
            CDUMBG1=CDUMBG1+C16*TWO*EC(IIPT,IRBGBGC)
            CDUMBG2=CDUMBG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
            CDUMB=CDUMB+C17*EC(IIPT,IRBGAGB)
            CDUMBG1=CDUMBG1+C17*TWO*EC(IIPT,IGAGBGB)
            CDUMBG2=CDUMBG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
            CDUMB=CDUMB+C18*EC(IIPT,IRBGAGC)
            CDUMBG1=CDUMBG1+C18*TWO*EC(IIPT,IGAGBGC)
            CDUMBG2=CDUMBG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
            CDUMB=CDUMB+C19*EC(IIPT,IRBGBGC)
            CDUMBG1=CDUMBG1+C19*TWO*EC(IIPT,IGBGBGC)
            CDUMBG2=CDUMBG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
            CDUMB=CDUMB+C20*EC(IIPT,IRBGCGC)
            CDUMBG1=CDUMBG1+C20*TWO*EC(IIPT,IGBGCGC)
            CDUMBG2=CDUMBG2+C20*EC(IIPT,IGCGCGC)
C     ********G_BETA END************DUM"B",DUM"B"G
C     *****F_CORE_END**********************
C
C     ********EDGE****************
C
C     --EXCHANGE
C
C     --GA*
            XDUMAGEA=0
C     --E1 (GA)*RA
            XDUMAGEA=XDUMAGEA+TWO*TWO*DUMNV(1)*EX(IIPT,KRAGA)
C     --E2 (GA)*GA
            XDUMAGEA=XDUMAGEA+TWO*TWO*TWO*DUMGRV(2)*EX(IIPT,KGAGA)
C
C     --GB
            XDUMAGEB=0
C     --E1 (GB)*RB
            XDUMAGEB=XDUMAGEB+TWO*TWO*DUMNV(2)*EX(IIPT,KRBGB)
C     --E2 (GB)*GB
            XDUMAGEB=XDUMAGEB+TWO*TWO*TWO*DUMGRV(2)*EX(IIPT,KGBGB)
C
C     --CORRELATION
C
            CDUMAGEA=ZERO
C     --GA
C     --E1A GA*RA
            CDUMAGEA=CDUMAGEA+TWO*DUMNV(1)*TWO*EC(IIPT,IRAGA)
C     --E2A GA*GA
            CDUMAGEA=CDUMAGEA+TWO*DUMGRV(1)*TWO*TWO*EC(IIPT,IGAGA)
C     --E3A GA*GC !
            CDUMAGEA=CDUMAGEA+TWO*DUMGRV(3)*TWO*EC(IIPT,IGAGC)
C     --E1B GA*RB
            CDUMAGEA=CDUMAGEA+TWO*DUMNV(2)*TWO*EC(IIPT,IRBGA)
C     --E2B GA*GB
            CDUMAGEA=CDUMAGEA+TWO*DUMGRV(2)*TWO*TWO*EC(IIPT,IGAGB)
C     --E3B GA*GC
            CDUMAGEA=CDUMAGEA+TWO*DUMGRV(4)*TWO*EC(IIPT,IGAGC)
C
            CDUMAGEB=ZERO
C     --GB
C     --E1A GB*RA
            CDUMAGEB=CDUMAGEB+TWO*DUMNV(1)*TWO*EC(IIPT,IRAGB)
C     --E2A GB*GA
            CDUMAGEB=CDUMAGEB+TWO*DUMGRV(1)*TWO*TWO*EC(IIPT,IGAGB)
C     --E3A GB*GC !
            CDUMAGEB=CDUMAGEB+TWO*DUMGRV(3)*TWO*EC(IIPT,IGBGC)
C     --E1B GB*RB
            CDUMAGEB=CDUMAGEB+TWO*DUMNV(2)*TWO*EC(IIPT,IRBGB)
C     --E2B GB*GB
            CDUMAGEB=CDUMAGEB+TWO*DUMGRV(2)*TWO*TWO*EC(IIPT,IGBGB)
C     --E3B GB*GC
            CDUMAGEB=CDUMAGEB+TWO*DUMGRV(4)*TWO*EC(IIPT,IGBGC)
C
            CDUMAGEC=ZERO
C     --GC*
C     --E1A GC*RA
            CDUMAGEC=CDUMAGEC+TWO*DUMNV(1)*EC(IIPT,IRAGC)
C     --E2A GCA*GA
            CDUMAGEC=CDUMAGEC+TWO*DUMGRV(1)*TWO*EC(IIPT,IGAGC)
C     --E3A GCA*GC
            CDUMAGEC=CDUMAGEC+TWO*DUMGRV(3)*EC(IIPT,IGCGC)
C     --E1B GCA*RB
            CDUMAGEC=CDUMAGEC+TWO*DUMNV(2)*EC(IIPT,IRBGC)
C     --E2B GCA*GB
            CDUMAGEC=CDUMAGEC+TWO*DUMGRV(2)*TWO*EC(IIPT,IGBGC)
C     --E3B GCA*GC
            CDUMAGEC=CDUMAGEC+TWO*DUMGRV(4)*EC(IIPT,IGCGC)
C     ********EDGE END************
C
C     --CONTRUCTION
C     ALPHA
            DUM1A=XDUMA+CDUMA
            DUM2A=XDUMAG+CDUMAG1+CDUMAG2
            DUM3A=XDUMAGEA+CDUMAGEA+CDUMAGEC
C     BETA
C     DUM1B=XDUMB+CDUMB
C     DUM2B=XDUMBG+CDUMBG1+CDUMBG2
C     DUM3B=XDUMAGEB+CDUMAGEB+CDUMAGEC
C     NOW, ONLY ALPHA..
            COEF(1,IIPT)=DUM1A
            COEF(2,IIPT)=DUM2A
            COEF(3,IIPT)=DUM3A
         ENDIF
      END DO
      RETURN
      END
C     *MODULE TDDFXC  *DECK GSVCOEF
      SUBROUTINE GSVCOEF(DDUM,PDUM,VDUM,DRHOI_,DTRAI_,EX,EC,EX0,EC0
     *     ,GRDFUN,RHOMIN,NPTGRD,ILENG,IST,IEND,IRU)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /XDERIX/ NXDIM(3),KRA,KRB,KGA,KGB,KRARA,KRAGA,KGAGA,
     *     KRBRB,KRBGB,KGBGB,KRARARA,KRARAGA,KRAGAGA,KGAGAGA,
     *     KRBRBRB,KRBRBGB,KRBGBGB,KGBGBGB
      COMMON/ CDERIX/ NCDIM(3),IRA,IRB,IGA,IGB,IGC,IRARA,IRARB,
     *     IRAGA,IRAGB,IRAGC,IRBRB,IRBGA,IRBGB,IRBGC,IGAGA,
     *     IGAGB,IGAGC,IGBGB,IGBGC,IGCGC,
     *     IRARARA,IRARARB,IRARAGA,IRARAGB,IRARAGC,IRARBRB,
     *     IRARBGA,IRARBGB,IRARBGC,IRAGAGA,IRAGAGB,IRAGAGC,
     *     IRAGBGB,IRAGBGC,IRAGCGC,IRBRBRB,IRBRBGA,IRBRBGB,
     *     IRBRBGC,IRBGAGA,IRBGAGB,IRBGAGC,IRBGBGB,IRBGBGC,
     *     IRBGCGC,IGAGAGA,IGAGAGB,IGAGAGC,IGAGBGB,IGAGBGC,
     *     IGAGCGC,IGBGBGB,IGBGBGC,IGBGCGC,IGCGCGC
      DIMENSION DRHOI_(NPTGRD,4,*),DTRAI_(4,ILENG,*)
      DIMENSION DDUM(ILENG,4,*),PDUM(ILENG,4,*),VDUM(ILENG,4,*)
      DIMENSION EX(ILENG,*)
      DIMENSION EC(ILENG,*)
      DIMENSION EX0(*)
      DIMENSION EC0(*)
      DIMENSION GRDFUN(*)
      DIMENSION DUMGRV(4),DUMXX(4),DUMNV(2)
      DIMENSION DXV(2),DYV(2),DZV(2)
      DATA ZERO  /0.0D+00/
      DATA TWO   /2.0D+00/
C     INITIALIZE
      CALL VCLR(DDUM,1,IRU*4*ILENG)
      CALL VCLR(PDUM,1,IRU*4*ILENG)
      CALL VCLR(VDUM,1,IRU*4*ILENG)
C
      DO IPT=IST,IEND
         IIPT=IPT-IST+1
         RHOA = DRHOI_(IPT,1,1)
         RHOB = DRHOI_(IPT,1,IRU)
         RHOT=RHOA+RHOB
         IF(RHOT.GT.RHOMIN) THEN
            DRHOAX=DRHOI_(IPT,2,1)
            DRHOAY=DRHOI_(IPT,3,1)
            DRHOAZ=DRHOI_(IPT,4,1)
            DRHOBX=DRHOI_(IPT,2,IRU)
            DRHOBY=DRHOI_(IPT,3,IRU)
            DRHOBZ=DRHOI_(IPT,4,IRU)
C
C     ---- DIFFERENCE DENSITY
C
            DUMNV(1)=DTRAI_(1,IIPT,1)
            DXV(1)=DTRAI_(2,IIPT,1)
            DYV(1)=DTRAI_(3,IIPT,1)
            DZV(1)=DTRAI_(4,IIPT,1)
            DUMNV(2)=DTRAI_(1,IIPT,IRU)
            DXV(2)=DTRAI_(2,IIPT,IRU)
            DYV(2)=DTRAI_(3,IIPT,IRU)
            DZV(2)=DTRAI_(4,IIPT,IRU)
C     -- DUMGRV
C     1:A*A 2:B*B 3:A*B 4:B*A
            DUMGRV(1)=DXV(1)*DRHOAX+DYV(1)*DRHOAY+DZV(1)*DRHOAZ
            DUMGRV(2)=DXV(2)*DRHOBX+DYV(2)*DRHOBY+DZV(2)*DRHOBZ
            DUMGRV(3)=DXV(1)*DRHOBX+DYV(1)*DRHOBY+DZV(1)*DRHOBZ
            DUMGRV(4)=DXV(2)*DRHOAX+DYV(2)*DRHOAY+DZV(2)*DRHOAZ
            DUMXX(1)=DXV(1)*DXV(1)+DYV(1)*DYV(1)+DZV(1)*DZV(1)
            DUMXX(2)=DXV(2)*DXV(2)+DYV(2)*DYV(2)+DZV(2)*DZV(2)
            DUMXX(3)=DXV(1)*DXV(2)+DYV(1)*DYV(2)+DZV(1)*DZV(2)
            DUMXX(4)=DUMXX(3)
C
C     ---- GROUND STATE CONTRIBUTION
C     ALPHA COMPONENTS
            GDUMA=EX(IIPT,KRA)+EC(IIPT,IRA)
            GDUMAG1=TWO*EX(IIPT,KGA)+TWO*EC(IIPT,IGA)
            GDUMAG2=EC(IIPT,IGC)
C     BETA COMPONENTS
            GDUMB=EX(IIPT,KRB)+EC(IIPT,IRB)
            GDUMBG1=TWO*EX(IIPT,KGB)+TWO*EC(IIPT,IGB)
            GDUMBG2=EC(IIPT,IGC)
C     CONTRACTION
            GDUMAX=GDUMAG1*DRHOAX+GDUMAG2*DRHOBX
            GDUMAY=GDUMAG1*DRHOAY+GDUMAG2*DRHOBY
            GDUMAZ=GDUMAG1*DRHOAZ+GDUMAG2*DRHOBZ
            GDUMBX=GDUMBG1*DRHOBX+GDUMBG2*DRHOAX
            GDUMBY=GDUMBG1*DRHOBY+GDUMBG2*DRHOAY
            GDUMBZ=GDUMBG1*DRHOBZ+GDUMBG2*DRHOAZ
C
C     ---- VNC CONTRIBUTION
C     **************V NON CORE***************************
C     ALPHA
C     VNC_A=EXC(IRA)*DUMNV(1)+TWO*EXC(IGA)*DUMGRV(1)+EXC(IGC)*DUMGRV(3)
C     --DUMNV(1) GRADIENT
            DUMNV1=EX(IIPT,KRA)+EC(IIPT,IRA)
C     --DUMGRV(1) GRADIENT
            DUMGRV1=TWO*(EX(IIPT,KGA)+EC(IIPT,IGA))
C     --DUMGRV(3) GRADIENT
            DUMGRV3=EC(IIPT,IGC)
C     BETA
C     VNC_B=EXC(IRB)*DUMNV(2)+TWO*EXC(IGB)*DUMGRV(2)+EXC(IGC)*DUMGRV(4)
C     --DUMNV(2) GRADIENT
            DUMNV2=EX(IIPT,KRB)+EC(IIPT,IRB)
C     --DUMGRV(2) GRADIENT
            DUMGRV2=TWO*(EX(IIPT,KGA)+EC(IIPT,IGA))
C     --DUMGRV(4) GRADIENT
            DUMGRV4=EC(IIPT,IGC)
C
C     CONTRACTION
C
C     -- TOTAL
C     --ALPHA
            VNCDOMA=DUMNV1
            VNCDOMAX=DUMGRV1*DRHOAX+DUMGRV3*DRHOBX
            VNCDOMAY=DUMGRV1*DRHOAY+DUMGRV3*DRHOBY
            VNCDOMAZ=DUMGRV1*DRHOAZ+DUMGRV3*DRHOBZ
            VNCDUMAX=DUMGRV1*DXV(1)+DUMGRV4*DXV(2)
            VNCDUMAY=DUMGRV1*DYV(1)+DUMGRV4*DYV(2)
            VNCDUMAZ=DUMGRV1*DZV(1)+DUMGRV4*DZV(2)
C     --BETA
            VNCDOMB=DUMNV2
            VNCDOMBX=DUMGRV2*DRHOBX+DUMGRV4*DRHOAX
            VNCDOMBY=DUMGRV2*DRHOBY+DUMGRV4*DRHOAY
            VNCDOMBZ=DUMGRV2*DRHOBZ+DUMGRV4*DRHOAZ
            VNCDUMBX=DUMGRV2*DXV(2)+DUMGRV3*DXV(1)
            VNCDUMBY=DUMGRV2*DYV(2)+DUMGRV3*DYV(1)
            VNCDUMBZ=DUMGRV2*DZV(2)+DUMGRV3*DZV(1)
C     **************V NON CORE END***********************
C
C     --- VC CONTRIBUTION
C     ******************V CORE***************************
C     --ALPHA GRADIENT
            C1=DUMNV(1)
            C2=TWO*DUMGRV(1)
            C3=DUMGRV(3)
            C4=DUMNV(2)
            C5=TWO*DUMGRV(2)
            C6=DUMGRV(4)
            DUMA=ZERO
            DUMAG1=ZERO
            DUMAG2=ZERO
C     IRA C1
            DUMA=DUMA+C1*(EX(IIPT,KRARA)+EC(IIPT,IRARA))
            DUMAG1=DUMAG1+C1*TWO*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
            DUMAG2=DUMAG2+C1*EC(IIPT,IRAGC)
C     IGA C2
            DUMA=DUMA+C2*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
            DUMAG1=DUMAG1+C2*TWO*(EX(IIPT,KGAGA)+EC(IIPT,IGAGA))
            DUMAG2=DUMAG2+C2*EC(IIPT,IGAGC)
C     IGC C3
            DUMA=DUMA+C3*EC(IIPT,IRAGC)
            DUMAG1=DUMAG1+C3*TWO*EC(IIPT,IGAGC)
            DUMAG2=DUMAG2+C3*EC(IIPT,IGCGC)
C     IRB C4
            DUMA=DUMA+C4*EC(IIPT,IRARB)
            DUMAG1=DUMAG1+C4*TWO*EC(IIPT,IRBGA)
            DUMAG2=DUMAG2+C4*EC(IIPT,IRBGC)
C     IGB C5
            DUMA=DUMA+C5*EC(IIPT,IRAGB)
            DUMAG1=DUMAG1+C5*TWO*EC(IIPT,IGAGB)
            DUMAG2=DUMAG2+C5*EC(IIPT,IGBGC)
C     IGC C6
            DUMA=DUMA+C6*EC(IIPT,IRAGC)
            DUMAG1=DUMAG1+C6*TWO*EC(IIPT,IGAGC)
            DUMAG2=DUMAG2+C6*EC(IIPT,IGCGC)
C     --BETA GRADIENT
            C1=DUMNV(1)
            C2=TWO*DUMGRV(1)
            C3=DUMGRV(3)
            C4=DUMNV(2)
            C5=TWO*DUMGRV(2)
            C6=DUMGRV(4)
            DUMB=ZERO
            DUMBG1=ZERO
            DUMBG2=ZERO
C     IRA C1
            DUMB=DUMB+C1*EC(IIPT,IRARB)
            DUMBG1=DUMBG1+C1*TWO*EC(IIPT,IRAGB)
            DUMBG2=DUMBG2+C1*EC(IIPT,IRAGC)
C     IGA C2
            DUMB=DUMB+C2*EC(IIPT,IRBGA)
            DUMBG1=DUMBG1+C2*TWO*EC(IIPT,IGAGB)
            DUMBG2=DUMBG2+C2*EC(IIPT,IGAGC)
C     IGC C3
            DUMB=DUMB+C3*EC(IIPT,IRBGC)
            DUMBG1=DUMBG1+C3*TWO*EC(IIPT,IGBGC)
            DUMBG2=DUMBG2+C3*EC(IIPT,IGCGC)
C     IRB C4
            DUMB=DUMB+C4*(EX(IIPT,KRBRB)+EC(IIPT,IRBRB))
            DUMBG1=DUMBG1+C4*TWO*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
            DUMBG2=DUMBG2+C4*EC(IIPT,IRBGC)
C     IGB C5
            DUMB=DUMB+C5*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
            DUMBG1=DUMBG1+C5*TWO*(EX(IIPT,KGBGB)+EC(IIPT,IGBGB))
            DUMBG2=DUMBG2+C5*EC(IIPT,IGBGC)
C     IGC C6
            DUMB=DUMB+C6*EC(IIPT,IRBGC)
            DUMBG1=DUMBG1+C6*TWO*EC(IIPT,IGBGC)
            DUMBG2=DUMBG2+C6*EC(IIPT,IGCGC)
C
C     CONTRACTION OF VC
C
C     DUMA,DUMAG1,DUMAG2,DUMG,DUMBG1,DUMBG2
            VCDUMA=DUMA
            VCDUMAX=DUMAG1*DRHOAX+DUMAG2*DRHOBX
            VCDUMAY=DUMAG1*DRHOAY+DUMAG2*DRHOBY
            VCDUMAZ=DUMAG1*DRHOAZ+DUMAG2*DRHOBZ
            VCDUMB=DUMB
            VCDUMBX=DUMBG1*DRHOBX+DUMBG2*DRHOAX
            VCDUMBY=DUMBG1*DRHOBY+DUMBG2*DRHOAY
            VCDUMBZ=DUMBG1*DRHOBZ+DUMBG2*DRHOAZ
C     ******************V CORE END***********************
C
C     -- TOTAL
C     --D
            DDUM(IIPT,1,1)=DDUM(IIPT,1,1)+GDUMA+VCDUMA
            DDUM(IIPT,2,1)=DDUM(IIPT,2,1)+GDUMAX+VNCDUMAX+VCDUMAX
            DDUM(IIPT,3,1)=DDUM(IIPT,3,1)+GDUMAY+VNCDUMAY+VCDUMAY
            DDUM(IIPT,4,1)=DDUM(IIPT,4,1)+GDUMAZ+VNCDUMAZ+VCDUMAZ
            IF(IRU.EQ.2) THEN
               DDUM(IIPT,1,IRU)=DDUM(IIPT,1,IRU)+GDUMB+VCDUMB
               DDUM(IIPT,2,IRU)=DDUM(IIPT,2,IRU)+GDUMBX+VNCDUMBX+VCDUMBX
               DDUM(IIPT,3,IRU)=DDUM(IIPT,3,IRU)+GDUMBY+VNCDUMBY+VCDUMBY
               DDUM(IIPT,4,IRU)=DDUM(IIPT,4,IRU)+GDUMBZ+VNCDUMBZ+VCDUMBZ
            ENDIF
C     --PA
            PDUM(IIPT,1,1)=VNCDOMA
            PDUM(IIPT,2,1)=VNCDOMAX
            PDUM(IIPT,3,1)=VNCDOMAY
            PDUM(IIPT,4,1)=VNCDOMAZ
            IF(IRU.EQ.2) THEN
               PDUM(IIPT,1,IRU)=VNCDOMB
               PDUM(IIPT,2,IRU)=VNCDOMBX
               PDUM(IIPT,3,IRU)=VNCDOMBY
               PDUM(IIPT,4,IRU)=VNCDOMBZ
            ENDIF
C     FOR GRDFUN
C     GROUND STATE
            DUMEXC=EX0(IIPT)+EC0(IIPT)
C     VXC
            DUM1=EX(IIPT,KRA)+EC(IIPT,IRA)
            DUM2=TWO*(EX(IIPT,KGA)+EC(IIPT,IGA))
            DUM3=EC(IIPT,IGC)
            DUM4=EX(IIPT,KRB)+EC(IIPT,IRB)
            DUM5=TWO*(EX(IIPT,KGB)+EC(IIPT,IGB))
            DUM6=EC(IIPT,IGC)
            DUMVA=DUM1*DUMNV(1)+DUM2*DUMGRV(1)+DUM3*DUMGRV(3)
            DUMVB=DUM4*DUMNV(2)+DUM5*DUMGRV(2)+DUM6*DUMGRV(4)
            DUMV=DUMVA+DUMVB
            GRDFUN(IPT)=GRDFUN(IPT)+DUMEXC+DUMV
C     DUMVA=DUM1*DUMNV(1)+DUM2*DUMGRV(1)
C     DUMVB=DUM4*DUMNV(2)+DUM2*DUMGRV(1)
C     DUMV=DUMVA+DUMVB
C     GRDFUN(IPT)=GRDFUN(IPT)+DUMEXC+DUMV
C
         ENDIF
      END DO
      RETURN
      END
C*MODULE TDDFXC  *DECK FCOEF
      SUBROUTINE FCOEF(DDUM,VDUM,DRHOI_,DTRAI_,EX,EC
     * ,GRDFUN,RHOMIN,NPTGRD,ILENG,IST,IEND,IRU)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /XDERIX/ NXDIM(3),KRA,KRB,KGA,KGB,KRARA,KRAGA,KGAGA,
     *                KRBRB,KRBGB,KGBGB,KRARARA,KRARAGA,KRAGAGA,KGAGAGA,
     *                KRBRBRB,KRBRBGB,KRBGBGB,KGBGBGB
      COMMON/ CDERIX/ NCDIM(3),IRA,IRB,IGA,IGB,IGC,IRARA,IRARB,
     *                IRAGA,IRAGB,IRAGC,IRBRB,IRBGA,IRBGB,IRBGC,IGAGA,
     *                IGAGB,IGAGC,IGBGB,IGBGC,IGCGC,
     *                IRARARA,IRARARB,IRARAGA,IRARAGB,IRARAGC,IRARBRB,
     *                IRARBGA,IRARBGB,IRARBGC,IRAGAGA,IRAGAGB,IRAGAGC,
     *                IRAGBGB,IRAGBGC,IRAGCGC,IRBRBRB,IRBRBGA,IRBRBGB,
     *                IRBRBGC,IRBGAGA,IRBGAGB,IRBGAGC,IRBGBGB,IRBGBGC,
     *                IRBGCGC,IGAGAGA,IGAGAGB,IGAGAGC,IGAGBGB,IGAGBGC,
     *                IGAGCGC,IGBGBGB,IGBGBGC,IGBGCGC,IGCGCGC
      DIMENSION DRHOI_(NPTGRD,4,*),DTRAI_(4,ILENG,*)
      DIMENSION DDUM(ILENG,4,*),VDUM(ILENG,4,*)
      DIMENSION EX(ILENG,*)
      DIMENSION EC(ILENG,*)
      DIMENSION GRDFUN(*)
      DIMENSION DUMGRV(4),DUMXX(4),DUMNV(2)
      DIMENSION DXV(2),DYV(2),DZV(2)
      DATA ZERO  /0.0D+00/
      DATA TWO   /2.0D+00/
      DATA FOUR  /4.0D+00/
C
      DO IPT=IST,IEND
      IIPT=IPT-IST+1
      RHOA = DRHOI_(IPT,1,1)
      RHOB = DRHOI_(IPT,1,IRU)
      RHOT=RHOA+RHOB
      IF(RHOT.GT.RHOMIN) THEN
      DRHOAX=DRHOI_(IPT,2,1)
      DRHOAY=DRHOI_(IPT,3,1)
      DRHOAZ=DRHOI_(IPT,4,1)
      DRHOBX=DRHOI_(IPT,2,IRU)
      DRHOBY=DRHOI_(IPT,3,IRU)
      DRHOBZ=DRHOI_(IPT,4,IRU)
C
C     ---- TRANSITION DENSITY
C
      DUMNV(1)=DTRAI_(1,IIPT,1)
      DXV(1)=DTRAI_(2,IIPT,1)
      DYV(1)=DTRAI_(3,IIPT,1)
      DZV(1)=DTRAI_(4,IIPT,1)
      DUMNV(2)=DTRAI_(1,IIPT,IRU)
      DXV(2)=DTRAI_(2,IIPT,IRU)
      DYV(2)=DTRAI_(3,IIPT,IRU)
      DZV(2)=DTRAI_(4,IIPT,IRU)
C
C     -- DUMGRV
C      1:A*A 2:B*B 3:A*B 4:B*A
      DUMGRV(1)=DXV(1)*DRHOAX+DYV(1)*DRHOAY+DZV(1)*DRHOAZ
      DUMGRV(2)=DXV(2)*DRHOBX+DYV(2)*DRHOBY+DZV(2)*DRHOBZ
      DUMGRV(3)=DXV(1)*DRHOBX+DYV(1)*DRHOBY+DZV(1)*DRHOBZ
      DUMGRV(4)=DXV(2)*DRHOAX+DYV(2)*DRHOAY+DZV(2)*DRHOAZ
      DUMXX(1)=DXV(1)*DXV(1)+DYV(1)*DYV(1)+DZV(1)*DZV(1)
      DUMXX(2)=DXV(2)*DXV(2)+DYV(2)*DYV(2)+DZV(2)*DZV(2)
      DUMXX(3)=DXV(1)*DXV(2)+DYV(1)*DYV(2)+DZV(1)*DZV(2)
      DUMXX(4)=DUMXX(3)
C
C     ---- FNC CONTRIBUTION
C     **************F NON CORE***************************
      DUMXX1=ZERO
      DUMXX2=ZERO
      DUMXX3=ZERO
      DUMNV1=ZERO
      DUMNV2=ZERO
      DUMGRV1=ZERO
      DUMGRV2=ZERO
      DUMGRV3=ZERO
      DUMGRV4=ZERO
C
C     --AA COMPONENTS--
C     --AA
      C1=TWO*(EX(IIPT,KGA)+EC(IIPT,IGA))
      C2=EX(IIPT,KRARA)+EC(IIPT,IRARA)
      C3=TWO*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
      C4=TWO*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
      C5=EC(IIPT,IRAGC)
      C6=EC(IIPT,IRAGC)
      C7=FOUR*(EX(IIPT,KGAGA)+EC(IIPT,IGAGA))
      C8=TWO*EC(IIPT,IGAGC)
      C9=TWO*EC(IIPT,IGAGC)
      C10=EC(IIPT,IGCGC)
C     -- DUMXX(1) GRADIENT *TWO
      DUMC=C1
      DUMXX1=DUMXX1+DUMC*TWO
C     -- DUMNV(1) GRADIENT *TWO
      DUMC=C2
      DUMNV1=DUMNV1+DUMC*DUMNV(1)*TWO
C     -- DUMNV(1) OR DUMGRV(1) GRADIENT
      DUMC=C3+C4
      DUMNV1=DUMNV1+DUMC*DUMGRV(1)
      DUMGRV1=DUMGRV1+DUMC*DUMNV(1)
C     -- DUMNV(1) OR DUMGRV(3) GRADIENT
      DUMC=C5+C6
      DUMNV1=DUMNV1+DUMC*DUMGRV(3)
      DUMGRV3=DUMGRV3+DUMC*DUMNV(1)
C     --DUMGRV(1) GRADIENT *TWO
      DUMC=C7
      DUMGRV1=DUMGRV1+C7*DUMGRV(1)*TWO
C     --DUMGRV(1) OR DUMGRV(3) GRADIENT
      DUMC=C8+C9
      DUMGRV1=DUMGRV1+DUMC*DUMGRV(3)
      DUMGRV3=DUMGRV3+DUMC*DUMGRV(1)
C     --DUMGRV(3) GRADIENT *TWO
      DUMC=C10
      DUMGRV3=DUMGRV3+DUMC*DUMGRV(3)*TWO
C
C     --AB AND BA COMPONENTS--
C     --AB AND BA
      C11=EC(IIPT,IGC)
      C12=EC(IIPT,IRARB)
      C13=TWO*EC(IIPT,IRAGB)
      C14=TWO*EC(IIPT,IRBGA)
      C15=EC(IIPT,IRAGC)
      C16=EC(IIPT,IRBGC)
      C17=FOUR*EC(IIPT,IGAGB)
      C18=TWO*EC(IIPT,IGAGC)
      C19=TWO*EC(IIPT,IGBGC)
      C20=EC(IIPT,IGCGC)
C     -- DUMXX(3) GRADIENT
      DUMC=C11*TWO
      DUMXX3=DUMXX3+DUMC
C     -- DUMNV(1) OR DUMNV(2) GRADIENT
      DUMC=C12*TWO
      DUMNV1=DUMNV1+DUMC*DUMNV(2)
      DUMNV2=DUMNV2+DUMC*DUMNV(1)
C     -- DUMNV(1) OR DUMGRV(2) GRADIENT
      DUMC=C13*TWO
      DUMNV1=DUMNV1+DUMC*DUMGRV(2)
      DUMGRV2=DUMGRV2+DUMC*DUMNV(1)
C     -- DUMNV(2) OR DUMGRV(1) GRADIENT
      DUMC=C14*TWO
      DUMNV2=DUMNV2+DUMC*DUMGRV(1)
      DUMGRV1=DUMGRV1+DUMC*DUMNV(2)
C     -- DUMNV(1) OR DUMGRV(4) GRADIENT
      DUMC=C15*TWO
      DUMNV1=DUMNV1+DUMC*DUMGRV(4)
      DUMGRV4=DUMGRV4+DUMC*DUMNV(1)
C     -- DUMNV(2) OR DUMGRV(3) GRADIENT
      DUMC=C16*TWO
      DUMNV2=DUMNV2+DUMC*DUMGRV(3)
      DUMGRV3=DUMGRV3+DUMC*DUMNV(2)
C     -- DUMGRV(1) OR DUMGRV(2) GRADIENT
      DUMC=C17*TWO
      DUMGRV1=DUMGRV1+DUMC*DUMGRV(2)
      DUMGRV2=DUMGRV2+DUMC*DUMGRV(1)
C     -- DUMGRV(1) OR DUMGRV(4) GRADIENT
      DUMC=C18*TWO
      DUMGRV1=DUMGRV1+DUMC*DUMGRV(4)
      DUMGRV4=DUMGRV4+DUMC*DUMGRV(1)
C     -- DUMGRV(2) OR DUMGRV(3) GRADIENT
      DUMC=C19*TWO
      DUMGRV2=DUMGRV2+DUMC*DUMGRV(3)
      DUMGRV3=DUMGRV3+DUMC*DUMGRV(2)
C     -- DUMGRV(3) OR DUMGRV(4) GRADIENT
      DUMC=C20*TWO
      DUMGRV3=DUMGRV3+DUMC*DUMGRV(4)
      DUMGRV4=DUMGRV4+DUMC*DUMGRV(3)
C
C     --BB COMPONENTS--
C     --BB
      C1=TWO*(EX(IIPT,KGB)+EC(IIPT,IGB))
      C2=EX(IIPT,KRBRB)+EC(IIPT,IRBRB)
      C3=TWO*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
      C4=TWO*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
      C5=EC(IIPT,IRBGC)
      C6=EC(IIPT,IRBGC)
      C7=FOUR*(EX(IIPT,KGBGB)+EC(IIPT,IGBGB))
      C8=TWO*EC(IIPT,IGBGC)
      C9=TWO*EC(IIPT,IGBGC)
      C10=EC(IIPT,IGCGC)
C     -- DUMXX(2) GRADIENT *TWO
      DUMC=C1
      DUMXX2=DUMXX2+DUMC*TWO
C     -- DUMNV(2) GRADIENT *TWO
      DUMC=C2
      DUMNV2=DUMNV2+DUMC*DUMNV(2)*TWO
C     -- DUMNV(2) OR DUMGRV(2) GRADIENT
      DUMC=C3+C4
      DUMNV2=DUMNV2+DUMC*DUMGRV(2)
      DUMGRV2=DUMGRV2+DUMC*DUMNV(2)
C     -- DUMNV(2) OR DUMGRV(4) GRADIENT
      DUMC=C5+C6
      DUMNV2=DUMNV2+DUMC*DUMGRV(4)
      DUMGRV4=DUMGRV4+DUMC*DUMNV(2)
C     --DUMGRV(2) GRADIENT *TWO
      DUMC=C7
      DUMGRV2=DUMGRV2+DUMC*DUMGRV(2)*TWO
C     --DUMGRV(2) OR DUMGRV(4) GRADIENT
      DUMC=C8+C9
      DUMGRV2=DUMGRV2+DUMC*DUMGRV(4)
      DUMGRV4=DUMGRV4+DUMC*DUMGRV(2)
C     --DUMGRV(4) GRADIENT *TWO
      DUMC=C10
      DUMGRV4=DUMGRV4+DUMC*DUMGRV(4)*TWO
C
C     CONTRACTION OF FNC
C
C     -- TOTAL
C     --ALPHA
      FNCDOMA=DUMNV1
      FNCDOMAX=DUMGRV1*DRHOAX+DUMGRV3*DRHOBX+DUMXX1*DXV(1)+
     * DUMXX3*DXV(2)
      FNCDOMAY=DUMGRV1*DRHOAY+DUMGRV3*DRHOBY+DUMXX1*DYV(1)+
     * DUMXX3*DYV(2)
      FNCDOMAZ=DUMGRV1*DRHOAZ+DUMGRV3*DRHOBZ+DUMXX1*DZV(1)+
     * DUMXX3*DZV(2)
      FNCDUMAX=DUMGRV1*DXV(1)+DUMGRV4*DXV(2)
      FNCDUMAY=DUMGRV1*DYV(1)+DUMGRV4*DYV(2)
      FNCDUMAZ=DUMGRV1*DZV(1)+DUMGRV4*DZV(2)
C     --BETA
      FNCDOMB=DUMNV2
      FNCDOMBX=DUMGRV2*DRHOBX+DUMGRV4*DRHOAX+DUMXX2*DXV(2)+
     * DUMXX3*DXV(1)
      FNCDOMBY=DUMGRV2*DRHOBY+DUMGRV4*DRHOAY+DUMXX2*DYV(2)+
     * DUMXX3*DYV(1)
      FNCDOMBZ=DUMGRV2*DRHOBZ+DUMGRV4*DRHOAZ+DUMXX2*DZV(2)+
     * DUMXX3*DZV(1)
      FNCDUMBX=DUMGRV2*DXV(2)+DUMGRV3*DXV(1)
      FNCDUMBY=DUMGRV2*DYV(2)+DUMGRV3*DYV(1)
      FNCDUMBZ=DUMGRV2*DZV(2)+DUMGRV3*DZV(1)
C     **************F NON CORE END***********************
C
C     ---- FC CONTRIBUTION
C
C     ********F_CORE****************
C     ********G_ALPHA***************DUM"A",DUM"A"G
C     --AA
      C1=TWO*DUMXX(1)
      C2=DUMNV(1)*DUMNV(1)
      C3=TWO*DUMNV(1)*DUMGRV(1)
      C4=TWO*DUMGRV(1)*DUMNV(1)
      C5=DUMGRV(1)*DUMNV(1)
      C6=DUMNV(1)*DUMGRV(1)
      C7=FOUR*DUMGRV(1)*DUMGRV(1)
      C8=TWO*DUMGRV(1)*DUMGRV(1)
      C9=TWO*DUMGRV(1)*DUMGRV(1)
      C10=DUMGRV(1)*DUMGRV(1)
C     -- EXCHANGE
      XDUMA=ZERO
      XDUMAG=ZERO
C     A-AA--1
      XDUMA=XDUMA+C1*EX(IIPT,KRAGA)
      XDUMAG=XDUMAG+C1*TWO*EX(IIPT,KGAGA)
C     --2
      XDUMA=XDUMA+C2*EX(IIPT,KRARARA)
      XDUMAG=XDUMAG+C2*TWO*EX(IIPT,KRARAGA)
C     --3
      XDUMA=XDUMA+C3*EX(IIPT,KRARAGA)
      XDUMAG=XDUMAG+C3*TWO*EX(IIPT,KRAGAGA)
C     --4
      XDUMA=XDUMA+C4*EX(IIPT,KRARAGA)
      XDUMAG=XDUMAG+C4*TWO*EX(IIPT,KRAGAGA)
C     --7
      XDUMA=XDUMA+C7*EX(IIPT,KRAGAGA)
      XDUMAG=XDUMAG+C7*TWO*EX(IIPT,KGAGAGA)
C     -- CORRELATION
      CDUMA=ZERO
      CDUMAG1=ZERO
      CDUMAG2=ZERO
C     A-AA--1     GA
      CDUMA=CDUMA+C1*EC(IIPT,IRAGA)
      CDUMAG1=CDUMAG1+C1*TWO*EC(IIPT,IGAGA)
      CDUMAG2=CDUMAG2+C1*EC(IIPT,IGAGC)
C     --2        RARA
      CDUMA=CDUMA+C2*EC(IIPT,IRARARA)
      CDUMAG1=CDUMAG1+C2*TWO*EC(IIPT,IRARAGA)
      CDUMAG2=CDUMAG2+C2*EC(IIPT,IRARAGC)
C     --3        RAGA
      CDUMA=CDUMA+C3*EC(IIPT,IRARAGA)
      CDUMAG1=CDUMAG1+C3*TWO*EC(IIPT,IRAGAGA)
      CDUMAG2=CDUMAG2+C3*EC(IIPT,IRAGAGC)
C     --4        RAGA
      CDUMA=CDUMA+C4*EC(IIPT,IRARAGA)
      CDUMAG1=CDUMAG1+C4*TWO*EC(IIPT,IRAGAGA)
      CDUMAG2=CDUMAG2+C4*EC(IIPT,IRAGAGC)
C     --5        RAGC
      CDUMA=CDUMA+C5*EC(IIPT,IRARAGC)
      CDUMAG1=CDUMAG1+C5*TWO*EC(IIPT,IRAGAGC)
      CDUMAG2=CDUMAG2+C5*EC(IIPT,IRAGCGC)
C     --6        RAGC
      CDUMA=CDUMA+C6*EC(IIPT,IRARAGC)
      CDUMAG1=CDUMAG1+C6*TWO*EC(IIPT,IRAGAGC)
      CDUMAG2=CDUMAG2+C6*EC(IIPT,IRAGCGC)
C     --7        GAGA
      CDUMA=CDUMA+C7*EC(IIPT,IRAGAGA)
      CDUMAG1=CDUMAG1+C7*TWO*EC(IIPT,IGAGAGA)
      CDUMAG2=CDUMAG2+C7*EC(IIPT,IGAGAGC)
C     --8        GAGC
      CDUMA=CDUMA+C8*EC(IIPT,IRAGAGC)
      CDUMAG1=CDUMAG1+C8*TWO*EC(IIPT,IGAGAGC)
      CDUMAG2=CDUMAG2+C8*EC(IIPT,IGAGCGC)
C     --9        GAGC
      CDUMA=CDUMA+C9*EC(IIPT,IRAGAGC)
      CDUMAG1=CDUMAG1+C9*TWO*EC(IIPT,IGAGAGC)
      CDUMAG2=CDUMAG2+C9*EC(IIPT,IGAGCGC)
C     --10       GCGC
      CDUMA=CDUMA+C10*EC(IIPT,IRAGCGC)
      CDUMAG1=CDUMAG1+C10*TWO*EC(IIPT,IGAGCGC)
      CDUMAG2=CDUMAG2+C10*EC(IIPT,IGCGCGC)
C     --BB
      C1=TWO*DUMXX(2)
      C2=DUMNV(2)*DUMNV(2)
      C3=TWO*DUMNV(2)*DUMGRV(2)
      C4=TWO*DUMGRV(2)*DUMNV(2)
      C5=DUMGRV(2)*DUMNV(2)
      C6=DUMNV(2)*DUMGRV(2)
      C7=FOUR*DUMGRV(2)*DUMGRV(2)
      C8=TWO*DUMGRV(2)*DUMGRV(2)
      C9=TWO*DUMGRV(2)*DUMGRV(2)
      C10=DUMGRV(2)*DUMGRV(2)
C     A-BB--1      GB
      CDUMA=CDUMA+C1*EC(IIPT,IRAGB)
      CDUMAG1=CDUMAG1+C1*TWO*EC(IIPT,IGAGB)
      CDUMAG2=CDUMAG2+C1*EC(IIPT,IGBGC)
C     --2        RBRB
      CDUMA=CDUMA+C2*EC(IIPT,IRARBRB)
      CDUMAG1=CDUMAG1+C2*TWO*EC(IIPT,IRBRBGA)
      CDUMAG2=CDUMAG2+C2*EC(IIPT,IRBRBGC)
C     --3        RBGB
      CDUMA=CDUMA+C3*EC(IIPT,IRARBGB)
      CDUMAG1=CDUMAG1+C3*TWO*EC(IIPT,IRBGAGB)
      CDUMAG2=CDUMAG2+C3*EC(IIPT,IRBGBGC)
C     --4        RBGB
      CDUMA=CDUMA+C4*EC(IIPT,IRARBGB)
      CDUMAG1=CDUMAG1+C4*TWO*EC(IIPT,IRBGAGB)
      CDUMAG2=CDUMAG2+C4*EC(IIPT,IRBGBGC)
C     --5        RBGC
      CDUMA=CDUMA+C5*EC(IIPT,IRARBGC)
      CDUMAG1=CDUMAG1+C5*TWO*EC(IIPT,IRBGAGC)
      CDUMAG2=CDUMAG2+C5*EC(IIPT,IRBGCGC)
C     --6        RBGC
      CDUMA=CDUMA+C6*EC(IIPT,IRARBGC)
      CDUMAG1=CDUMAG1+C6*TWO*EC(IIPT,IRBGAGC)
      CDUMAG2=CDUMAG2+C6*EC(IIPT,IRBGCGC)
C     --7        GBGB
      CDUMA=CDUMA+C7*EC(IIPT,IRAGBGB)
      CDUMAG1=CDUMAG1+C7*TWO*EC(IIPT,IGAGBGB)
      CDUMAG2=CDUMAG2+C7*EC(IIPT,IGBGBGC)
C     --8        GBGC
      CDUMA=CDUMA+C8*EC(IIPT,IRAGBGC)
      CDUMAG1=CDUMAG1+C8*TWO*EC(IIPT,IGAGBGC)
      CDUMAG2=CDUMAG2+C8*EC(IIPT,IGBGCGC)
C     --9        GBGC
      CDUMA=CDUMA+C9*EC(IIPT,IRAGBGC)
      CDUMAG1=CDUMAG1+C9*TWO*EC(IIPT,IGAGBGC)
      CDUMAG2=CDUMAG2+C9*EC(IIPT,IGBGCGC)
C     --10       GCGC
      CDUMA=CDUMA+C10*EC(IIPT,IRAGCGC)
      CDUMAG1=CDUMAG1+C10*TWO*EC(IIPT,IGAGCGC)
      CDUMAG2=CDUMAG2+C10*EC(IIPT,IGCGCGC)
C     --ABORBA
      C11=DUMXX(3)
      C12=DUMNV(1)*DUMNV(2)
      C13=TWO*DUMNV(1)*DUMGRV(2)
      C14=TWO*DUMGRV(1)*DUMNV(2)
      C15=DUMNV(1)*DUMGRV(4)
      C16=DUMGRV(3)*DUMNV(2)
      C17=FOUR*DUMGRV(1)*DUMGRV(2)
      C18=TWO*DUMGRV(1)*DUMGRV(4)
      C19=TWO*DUMGRV(3)*DUMGRV(2)
      C20=DUMGRV(3)*DUMGRV(4)
C     A-AB--11   GC
      CDUMA=CDUMA+C11*EC(IIPT,IRAGC)
      CDUMAG1=CDUMAG1+C11*TWO*EC(IIPT,IGAGC)
      CDUMAG2=CDUMAG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
      CDUMA=CDUMA+C12*EC(IIPT,IRARARB)
      CDUMAG1=CDUMAG1+C12*TWO*EC(IIPT,IRARBGA)
      CDUMAG2=CDUMAG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
      CDUMA=CDUMA+C13*EC(IIPT,IRARAGB)
      CDUMAG1=CDUMAG1+C13*TWO*EC(IIPT,IRAGAGB)
      CDUMAG2=CDUMAG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
      CDUMA=CDUMA+C14*EC(IIPT,IRARBGA)
      CDUMAG1=CDUMAG1+C14*TWO*EC(IIPT,IRBGAGA)
      CDUMAG2=CDUMAG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
      CDUMA=CDUMA+C15*EC(IIPT,IRARAGC)
      CDUMAG1=CDUMAG1+C15*TWO*EC(IIPT,IRAGAGC)
      CDUMAG2=CDUMAG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
      CDUMA=CDUMA+C16*EC(IIPT,IRARBGC)
      CDUMAG1=CDUMAG1+C16*TWO*EC(IIPT,IRBGAGC)
      CDUMAG2=CDUMAG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
      CDUMA=CDUMA+C17*EC(IIPT,IRAGAGB)
      CDUMAG1=CDUMAG1+C17*TWO*EC(IIPT,IGAGAGB)
      CDUMAG2=CDUMAG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
      CDUMA=CDUMA+C18*EC(IIPT,IRAGAGC)
      CDUMAG1=CDUMAG1+C18*TWO*EC(IIPT,IGAGAGC)
      CDUMAG2=CDUMAG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
      CDUMA=CDUMA+C19*EC(IIPT,IRAGBGC)
      CDUMAG1=CDUMAG1+C19*TWO*EC(IIPT,IGAGBGC)
      CDUMAG2=CDUMAG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
      CDUMA=CDUMA+C20*EC(IIPT,IRAGCGC)
      CDUMAG1=CDUMAG1+C20*TWO*EC(IIPT,IGAGCGC)
      CDUMAG2=CDUMAG2+C20*EC(IIPT,IGCGCGC)
C     **BA_TERM=AB_TERM**
C     --ABORBA
      C11=DUMXX(3)
      C12=DUMNV(1)*DUMNV(2)
      C13=TWO*DUMNV(1)*DUMGRV(2)
      C14=TWO*DUMGRV(1)*DUMNV(2)
      C15=DUMNV(1)*DUMGRV(4)
      C16=DUMGRV(3)*DUMNV(2)
      C17=FOUR*DUMGRV(1)*DUMGRV(2)
      C18=TWO*DUMGRV(1)*DUMGRV(4)
      C19=TWO*DUMGRV(3)*DUMGRV(2)
      C20=DUMGRV(3)*DUMGRV(4)
C     A-AB--11   GC
      CDUMA=CDUMA+C11*EC(IIPT,IRAGC)
      CDUMAG1=CDUMAG1+C11*TWO*EC(IIPT,IGAGC)
      CDUMAG2=CDUMAG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
      CDUMA=CDUMA+C12*EC(IIPT,IRARARB)
      CDUMAG1=CDUMAG1+C12*TWO*EC(IIPT,IRARBGA)
      CDUMAG2=CDUMAG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
      CDUMA=CDUMA+C13*EC(IIPT,IRARAGB)
      CDUMAG1=CDUMAG1+C13*TWO*EC(IIPT,IRAGAGB)
      CDUMAG2=CDUMAG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
      CDUMA=CDUMA+C14*EC(IIPT,IRARBGA)
      CDUMAG1=CDUMAG1+C14*TWO*EC(IIPT,IRBGAGA)
      CDUMAG2=CDUMAG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
      CDUMA=CDUMA+C15*EC(IIPT,IRARAGC)
      CDUMAG1=CDUMAG1+C15*TWO*EC(IIPT,IRAGAGC)
      CDUMAG2=CDUMAG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
      CDUMA=CDUMA+C16*EC(IIPT,IRARBGC)
      CDUMAG1=CDUMAG1+C16*TWO*EC(IIPT,IRBGAGC)
      CDUMAG2=CDUMAG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
      CDUMA=CDUMA+C17*EC(IIPT,IRAGAGB)
      CDUMAG1=CDUMAG1+C17*TWO*EC(IIPT,IGAGAGB)
      CDUMAG2=CDUMAG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
      CDUMA=CDUMA+C18*EC(IIPT,IRAGAGC)
      CDUMAG1=CDUMAG1+C18*TWO*EC(IIPT,IGAGAGC)
      CDUMAG2=CDUMAG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
      CDUMA=CDUMA+C19*EC(IIPT,IRAGBGC)
      CDUMAG1=CDUMAG1+C19*TWO*EC(IIPT,IGAGBGC)
      CDUMAG2=CDUMAG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
      CDUMA=CDUMA+C20*EC(IIPT,IRAGCGC)
      CDUMAG1=CDUMAG1+C20*TWO*EC(IIPT,IGAGCGC)
      CDUMAG2=CDUMAG2+C20*EC(IIPT,IGCGCGC)
C     ********G_ALPHA END***********DUM"A",DUM"A"G
C     ********G_BETA****************DUM"B",DUM"B"G
C     *RB OR GB OR GC
C     AA
      C1=TWO*DUMXX(1)
      C2=DUMNV(1)*DUMNV(1)
      C3=TWO*DUMNV(1)*DUMGRV(1)
      C4=TWO*DUMGRV(1)*DUMNV(1)
      C5=DUMGRV(1)*DUMNV(1)
      C6=DUMNV(1)*DUMGRV(1)
      C7=FOUR*DUMGRV(1)*DUMGRV(1)
      C8=TWO*DUMGRV(1)*DUMGRV(1)
      C9=TWO*DUMGRV(1)*DUMGRV(1)
      C10=DUMGRV(1)*DUMGRV(1)
C     -- CORRELATION
      CDUMB=ZERO
      CDUMBG1=ZERO
      CDUMBG2=ZERO
C     B-AA--1     GA
      CDUMB=CDUMB+C1*EC(IIPT,IRBGA)
      CDUMBG1=CDUMBG1+C1*TWO*EC(IIPT,IGAGB)
      CDUMBG2=CDUMBG2+C1*EC(IIPT,IGAGC)
C     --2        RARA
      CDUMB=CDUMB+C2*EC(IIPT,IRARARB)
      CDUMBG1=CDUMBG1+C2*TWO*EC(IIPT,IRARAGB)
      CDUMBG2=CDUMBG2+C2*EC(IIPT,IRARAGC)
C     --3        RAGA
      CDUMB=CDUMB+C3*EC(IIPT,IRARBGA)
      CDUMBG1=CDUMBG1+C3*TWO*EC(IIPT,IRAGAGB)
      CDUMBG2=CDUMBG2+C3*EC(IIPT,IRAGAGC)
C     --4        RAGA
      CDUMB=CDUMB+C4*EC(IIPT,IRARBGA)
      CDUMBG1=CDUMBG1+C4*TWO*EC(IIPT,IRAGAGB)
      CDUMBG2=CDUMBG2+C4*EC(IIPT,IRAGAGC)
C     --5        RAGC
      CDUMB=CDUMB+C5*EC(IIPT,IRARBGC)
      CDUMBG1=CDUMBG1+C5*TWO*EC(IIPT,IRAGBGC)
      CDUMBG2=CDUMBG2+C5*EC(IIPT,IRAGCGC)
C     --6        RAGC
      CDUMB=CDUMB+C6*EC(IIPT,IRARBGC)
      CDUMBG1=CDUMBG1+C6*TWO*EC(IIPT,IRAGBGC)
      CDUMBG2=CDUMBG2+C6*EC(IIPT,IRAGCGC)
C     --7        GAGA
      CDUMB=CDUMB+C7*EC(IIPT,IRBGAGA)
      CDUMBG1=CDUMBG1+C7*TWO*EC(IIPT,IGAGAGB)
      CDUMBG2=CDUMBG2+C7*EC(IIPT,IGAGAGC)
C     --8        GAGC
      CDUMB=CDUMB+C8*EC(IIPT,IRBGAGC)
      CDUMBG1=CDUMBG1+C8*TWO*EC(IIPT,IGAGBGC)
      CDUMBG2=CDUMBG2+C8*EC(IIPT,IGAGCGC)
C     --9        GAGC
      CDUMB=CDUMB+C9*EC(IIPT,IRBGAGC)
      CDUMBG1=CDUMBG1+C9*TWO*EC(IIPT,IGAGBGC)
      CDUMBG2=CDUMBG2+C9*EC(IIPT,IGAGCGC)
C     --10       GCGC
      CDUMB=CDUMB+C10*EC(IIPT,IRBGCGC)
      CDUMBG1=CDUMBG1+C10*TWO*EC(IIPT,IGBGCGC)
      CDUMBG2=CDUMBG2+C10*EC(IIPT,IGCGCGC)
C     --BB
      C1=TWO*DUMXX(2)
      C2=DUMNV(2)*DUMNV(2)
      C3=TWO*DUMNV(2)*DUMGRV(2)
      C4=TWO*DUMGRV(2)*DUMNV(2)
      C5=DUMGRV(2)*DUMNV(2)
      C6=DUMNV(2)*DUMGRV(2)
      C7=FOUR*DUMGRV(2)*DUMGRV(2)
      C8=TWO*DUMGRV(2)*DUMGRV(2)
      C9=TWO*DUMGRV(2)*DUMGRV(2)
      C10=DUMGRV(2)*DUMGRV(2)
C     -- EXCHANGE
      XDUMB=ZERO
      XDUMBG=ZERO
C     B-BB--1      GB
      XDUMB=XDUMB+C1*EX(IIPT,KRBGB)
      XDUMBG=XDUMBG+C1*TWO*EX(IIPT,KGBGB)
C     --2          RBRB
      XDUMB=XDUMB+C2*EX(IIPT,KRBRBRB)
      XDUMBG=XDUMBG+C2*TWO*EX(IIPT,KRBRBGB)
C     --3          RBGB
      XDUMB=XDUMB+C3*EX(IIPT,KRBRBGB)
      XDUMBG=XDUMBG+C3*TWO*EX(IIPT,KRBGBGB)
C     --4          RBGB
      XDUMB=XDUMB+C4*EX(IIPT,KRBRBGB)
      XDUMBG=XDUMBG+C4*TWO*EX(IIPT,KRBGBGB)
C     --7          GBGB
      XDUMB=XDUMB+C7*EX(IIPT,KRBGBGB)
      XDUMBG=XDUMBG+C7*TWO*EX(IIPT,KGBGBGB)
C     B-BB--1      GB
      CDUMB=CDUMB+C1*EC(IIPT,IRBGB)
      CDUMBG1=CDUMBG1+C1*TWO*EC(IIPT,IGBGB)
      CDUMBG2=CDUMBG2+C1*EC(IIPT,IGBGC)
C     --2        RBRB
      CDUMB=CDUMB+C2*EC(IIPT,IRBRBRB)
      CDUMBG1=CDUMBG1+C2*TWO*EC(IIPT,IRBRBGB)
      CDUMBG2=CDUMBG2+C2*EC(IIPT,IRBRBGC)
C     --3        RBGB
      CDUMB=CDUMB+C3*EC(IIPT,IRBRBGB)
      CDUMBG1=CDUMBG1+C3*TWO*EC(IIPT,IRBGBGB)
      CDUMBG2=CDUMBG2+C3*EC(IIPT,IRBGBGC)
C     --4        RBGB
      CDUMB=CDUMB+C4*EC(IIPT,IRBRBGB)
      CDUMBG1=CDUMBG1+C4*TWO*EC(IIPT,IRBGBGB)
      CDUMBG2=CDUMBG2+C4*EC(IIPT,IRBGBGC)
C     --5        RBGC
      CDUMB=CDUMB+C5*EC(IIPT,IRBRBGC)
      CDUMBG1=CDUMBG1+C5*TWO*EC(IIPT,IRBGBGC)
      CDUMBG2=CDUMBG2+C5*EC(IIPT,IRBGCGC)
C     --6        RBGC
      CDUMB=CDUMB+C6*EC(IIPT,IRBRBGC)
      CDUMBG1=CDUMBG1+C6*TWO*EC(IIPT,IRBGBGC)
      CDUMBG2=CDUMBG2+C6*EC(IIPT,IRBGCGC)
C     --7        GBGB
      CDUMB=CDUMB+C7*EC(IIPT,IRBGBGB)
      CDUMBG1=CDUMBG1+C7*TWO*EC(IIPT,IGBGBGB)
      CDUMBG2=CDUMBG2+C7*EC(IIPT,IGBGBGC)
C     --8        GBGC
      CDUMB=CDUMB+C8*EC(IIPT,IRBGBGC)
      CDUMBG1=CDUMBG1+C8*TWO*EC(IIPT,IGBGBGC)
      CDUMBG2=CDUMBG2+C8*EC(IIPT,IGBGCGC)
C     --9        GBGC
      CDUMB=CDUMB+C9*EC(IIPT,IRBGBGC)
      CDUMBG1=CDUMBG1+C9*TWO*EC(IIPT,IGBGBGC)
      CDUMBG2=CDUMBG2+C9*EC(IIPT,IGBGCGC)
C     --10       GCGC
      CDUMB=CDUMB+C10*EC(IIPT,IRBGCGC)
      CDUMBG1=CDUMBG1+C10*TWO*EC(IIPT,IGBGCGC)
      CDUMBG2=CDUMBG2+C10*EC(IIPT,IGCGCGC)
C     --ABORBA
      C11=DUMXX(3)
      C12=DUMNV(1)*DUMNV(2)
      C13=TWO*DUMNV(1)*DUMGRV(2)
      C14=TWO*DUMGRV(1)*DUMNV(2)
      C15=DUMNV(1)*DUMGRV(4)
      C16=DUMGRV(3)*DUMNV(2)
      C17=FOUR*DUMGRV(1)*DUMGRV(2)
      C18=TWO*DUMGRV(1)*DUMGRV(4)
      C19=TWO*DUMGRV(3)*DUMGRV(2)
      C20=DUMGRV(3)*DUMGRV(4)
C     B-AB--11   GC
      CDUMB=CDUMB+C11*EC(IIPT,IRBGC)
      CDUMBG1=CDUMBG1+C11*TWO*EC(IIPT,IGBGC)
      CDUMBG2=CDUMBG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
      CDUMB=CDUMB+C12*EC(IIPT,IRARBRB)
      CDUMBG1=CDUMBG1+C12*TWO*EC(IIPT,IRARBGB)
      CDUMBG2=CDUMBG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
      CDUMB=CDUMB+C13*EC(IIPT,IRARBGB)
      CDUMBG1=CDUMBG1+C13*TWO*EC(IIPT,IRAGBGB)
      CDUMBG2=CDUMBG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
      CDUMB=CDUMB+C14*EC(IIPT,IRBRBGA)
      CDUMBG1=CDUMBG1+C14*TWO*EC(IIPT,IRBGAGB)
      CDUMBG2=CDUMBG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
      CDUMB=CDUMB+C15*EC(IIPT,IRARBGC)
      CDUMBG1=CDUMBG1+C15*TWO*EC(IIPT,IRAGBGC)
      CDUMBG2=CDUMBG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
      CDUMB=CDUMB+C16*EC(IIPT,IRBRBGC)
      CDUMBG1=CDUMBG1+C16*TWO*EC(IIPT,IRBGBGC)
      CDUMBG2=CDUMBG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
      CDUMB=CDUMB+C17*EC(IIPT,IRBGAGB)
      CDUMBG1=CDUMBG1+C17*TWO*EC(IIPT,IGAGBGB)
      CDUMBG2=CDUMBG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
      CDUMB=CDUMB+C18*EC(IIPT,IRBGAGC)
      CDUMBG1=CDUMBG1+C18*TWO*EC(IIPT,IGAGBGC)
      CDUMBG2=CDUMBG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
      CDUMB=CDUMB+C19*EC(IIPT,IRBGBGC)
      CDUMBG1=CDUMBG1+C19*TWO*EC(IIPT,IGBGBGC)
      CDUMBG2=CDUMBG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
      CDUMB=CDUMB+C20*EC(IIPT,IRBGCGC)
      CDUMBG1=CDUMBG1+C20*TWO*EC(IIPT,IGBGCGC)
      CDUMBG2=CDUMBG2+C20*EC(IIPT,IGCGCGC)
C     **BA_TERM=AB_TERM**
C     B-BA--11   GC
      CDUMB=CDUMB+C11*EC(IIPT,IRBGC)
      CDUMBG1=CDUMBG1+C11*TWO*EC(IIPT,IGBGC)
      CDUMBG2=CDUMBG2+C11*EC(IIPT,IGCGC)
C     --12     RARB
      CDUMB=CDUMB+C12*EC(IIPT,IRARBRB)
      CDUMBG1=CDUMBG1+C12*TWO*EC(IIPT,IRARBGB)
      CDUMBG2=CDUMBG2+C12*EC(IIPT,IRARBGC)
C     --13     RAGB
      CDUMB=CDUMB+C13*EC(IIPT,IRARBGB)
      CDUMBG1=CDUMBG1+C13*TWO*EC(IIPT,IRAGBGB)
      CDUMBG2=CDUMBG2+C13*EC(IIPT,IRAGBGC)
C     --14     RBGA
      CDUMB=CDUMB+C14*EC(IIPT,IRBRBGA)
      CDUMBG1=CDUMBG1+C14*TWO*EC(IIPT,IRBGAGB)
      CDUMBG2=CDUMBG2+C14*EC(IIPT,IRBGAGC)
C     --15     RAGC
      CDUMB=CDUMB+C15*EC(IIPT,IRARBGC)
      CDUMBG1=CDUMBG1+C15*TWO*EC(IIPT,IRAGBGC)
      CDUMBG2=CDUMBG2+C15*EC(IIPT,IRAGCGC)
C     --16     RBGC
      CDUMB=CDUMB+C16*EC(IIPT,IRBRBGC)
      CDUMBG1=CDUMBG1+C16*TWO*EC(IIPT,IRBGBGC)
      CDUMBG2=CDUMBG2+C16*EC(IIPT,IRBGCGC)
C     --17     GAGB
      CDUMB=CDUMB+C17*EC(IIPT,IRBGAGB)
      CDUMBG1=CDUMBG1+C17*TWO*EC(IIPT,IGAGBGB)
      CDUMBG2=CDUMBG2+C17*EC(IIPT,IGAGBGC)
C     --18     GAGC
      CDUMB=CDUMB+C18*EC(IIPT,IRBGAGC)
      CDUMBG1=CDUMBG1+C18*TWO*EC(IIPT,IGAGBGC)
      CDUMBG2=CDUMBG2+C18*EC(IIPT,IGAGCGC)
C     --19     GBGC
      CDUMB=CDUMB+C19*EC(IIPT,IRBGBGC)
      CDUMBG1=CDUMBG1+C19*TWO*EC(IIPT,IGBGBGC)
      CDUMBG2=CDUMBG2+C19*EC(IIPT,IGBGCGC)
C     --20     GCGC
      CDUMB=CDUMB+C20*EC(IIPT,IRBGCGC)
      CDUMBG1=CDUMBG1+C20*TWO*EC(IIPT,IGBGCGC)
      CDUMBG2=CDUMBG2+C20*EC(IIPT,IGCGCGC)
C     ********G_BETA END************DUM"B",DUM"B"G
C
C     CONTRACTION OF FC
C     -- ALPHA
      FCDUMA=XDUMA+CDUMA
      FCDUMAG1=XDUMAG+CDUMAG1
      FCDUMAG2=CDUMAG2
      FCDUMAX=FCDUMAG1*DRHOAX+FCDUMAG2*DRHOBX
      FCDUMAY=FCDUMAG1*DRHOAY+FCDUMAG2*DRHOBY
      FCDUMAZ=FCDUMAG1*DRHOAZ+FCDUMAG2*DRHOBZ
C     -- BETA
      FCDUMB=XDUMB+CDUMB
      FCDUMBG1=XDUMBG+CDUMBG1
      FCDUMBG2=CDUMBG2
      FCDUMBX=FCDUMBG1*DRHOBX+FCDUMBG2*DRHOAX
      FCDUMBY=FCDUMBG1*DRHOBY+FCDUMBG2*DRHOAY
      FCDUMBZ=FCDUMBG1*DRHOBZ+FCDUMBG2*DRHOAZ
C
C     *****F_CORE_END**********************
C
C     --D
      DDUM(IIPT,1,1)=DDUM(IIPT,1,1)+FCDUMA
      DDUM(IIPT,2,1)=DDUM(IIPT,2,1)+FNCDUMAX+FCDUMAX
      DDUM(IIPT,3,1)=DDUM(IIPT,3,1)+FNCDUMAY+FCDUMAY
      DDUM(IIPT,4,1)=DDUM(IIPT,4,1)+FNCDUMAZ+FCDUMAZ
      IF(IRU.EQ.2) THEN
      DDUM(IIPT,1,IRU)=DDUM(IIPT,1,IRU)+FCDUMB
      DDUM(IIPT,2,IRU)=DDUM(IIPT,2,IRU)+FNCDUMBX+FCDUMBX
      DDUM(IIPT,3,IRU)=DDUM(IIPT,3,IRU)+FNCDUMBY+FCDUMBY
      DDUM(IIPT,4,IRU)=DDUM(IIPT,4,IRU)+FNCDUMBZ+FCDUMBZ
      ENDIF
C     --V1
      VDUM(IIPT,1,1)=FNCDOMA
      VDUM(IIPT,2,1)=FNCDOMAX
      VDUM(IIPT,3,1)=FNCDOMAY
      VDUM(IIPT,4,1)=FNCDOMAZ
      VDUM(IIPT,1,IRU)=FNCDOMB
      VDUM(IIPT,2,IRU)=FNCDOMBX
      VDUM(IIPT,3,IRU)=FNCDOMBY
      VDUM(IIPT,4,IRU)=FNCDOMBZ
C     FOR GRDFUN
C     -- FXC CONTRIBUTION
C     --AA
      C1=TWO*(EX(IIPT,KGA)+EC(IIPT,IGA))
      C2=EX(IIPT,KRARA)+EC(IIPT,IRARA)
      C3=TWO*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
      C4=TWO*(EX(IIPT,KRAGA)+EC(IIPT,IRAGA))
      C5=EC(IIPT,IRAGC)
      C6=EC(IIPT,IRAGC)
      C7=FOUR*(EX(IIPT,KGAGA)+EC(IIPT,IGAGA))
      C8=TWO*EC(IIPT,IGAGC)
      C9=TWO*EC(IIPT,IGAGC)
      C10=EC(IIPT,IGCGC)
      DUMA=ZERO
      DUMA=DUMA+C1*DUMXX(1)
      DUMA=DUMA+C2*DUMNV(1)**2
      DUMA=DUMA+C3*DUMNV(1)*DUMGRV(1)
      DUMA=DUMA+C4*DUMNV(1)*DUMGRV(1)
      DUMA=DUMA+C5*DUMNV(1)*DUMGRV(3)
      DUMA=DUMA+C6*DUMNV(1)*DUMGRV(3)
      DUMA=DUMA+C7*DUMGRV(1)**2
      DUMA=DUMA+C8*DUMGRV(1)*DUMGRV(3)
      DUMA=DUMA+C9*DUMGRV(1)*DUMGRV(3)
      DUMA=DUMA+C10*DUMGRV(3)**2
C     --BB
      C1=TWO*(EX(IIPT,KGB)+EC(IIPT,IGB))
      C2=EX(IIPT,KRBRB)+EC(IIPT,IRBRB)
      C3=TWO*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
      C4=TWO*(EX(IIPT,KRBGB)+EC(IIPT,IRBGB))
      C5=EC(IIPT,IRBGC)
      C6=EC(IIPT,IRBGC)
      C7=FOUR*(EX(IIPT,KGBGB)+EC(IIPT,IGBGB))
      C8=TWO*EC(IIPT,IGBGC)
      C9=TWO*EC(IIPT,IGBGC)
      C10=EC(IIPT,IGCGC)
      DUMB=ZERO
      DUMB=DUMB+C1*DUMXX(2)
      DUMB=DUMB+C2*DUMNV(2)**2
      DUMB=DUMB+C3*DUMNV(2)*DUMGRV(2)
      DUMB=DUMB+C4*DUMNV(2)*DUMGRV(2)
      DUMB=DUMB+C5*DUMNV(2)*DUMGRV(4)
      DUMB=DUMB+C6*DUMNV(2)*DUMGRV(4)
      DUMB=DUMB+C7*DUMGRV(2)**2
      DUMB=DUMB+C8*DUMGRV(2)*DUMGRV(4)
      DUMB=DUMB+C9*DUMGRV(2)*DUMGRV(4)
      DUMB=DUMB+C10*DUMGRV(4)**2
C     --AB OR BA
      C11=EC(IIPT,IGC)
      C12=EC(IIPT,IRARB)
      C13=TWO*EC(IIPT,IRAGB)
      C14=TWO*EC(IIPT,IRBGA)
      C15=EC(IIPT,IRAGC)
      C16=EC(IIPT,IRBGC)
      C17=FOUR*EC(IIPT,IGAGB)
      C18=TWO*EC(IIPT,IGAGC)
      C19=TWO*EC(IIPT,IGBGC)
      C20=EC(IIPT,IGCGC)
      DUMAB=ZERO
      DUMAB=DUMAB+C11*DUMXX(3)
      DUMAB=DUMAB+C12*DUMNV(1)*DUMNV(2)
      DUMAB=DUMAB+C13*DUMNV(1)*DUMGRV(2)
      DUMAB=DUMAB+C14*DUMNV(2)*DUMGRV(1)
      DUMAB=DUMAB+C15*DUMNV(1)*DUMGRV(4)
      DUMAB=DUMAB+C16*DUMNV(2)*DUMGRV(3)
      DUMAB=DUMAB+C17*DUMGRV(1)*DUMGRV(2)
      DUMAB=DUMAB+C18*DUMGRV(1)*DUMGRV(4)
      DUMAB=DUMAB+C19*DUMGRV(2)*DUMGRV(3)
      DUMAB=DUMAB+C20*DUMGRV(3)*DUMGRV(4)
C
      GRDFUN(IPT)=GRDFUN(IPT)+DUMA+DUMB+DUMAB*TWO
C
      ENDIF
      END DO
      RETURN
      END
C
