C  4 MAR 08 - HM  - L-SHELL TREATMENT WAS ADDED
C 24 MAR 07 - HM  - INCLUDE MCP GRADIENT INTEGRAL PACKAGE
C
C=======================================================================
C                                                                      C
C     PROGRAM PACKAGE FOR ANALYTIC GRADIENT OF                         C
C                          RELATIVISTIC MODEL CORE POTENTIALS (MCP)    C
C                                                                      C
C     CODED BY HIROTOSHI MORI AND EISAKU MIYOSHI @ KYUSHU UNIVERSITY   C
C                                                                      C
C     E-MAIL: QC_FOREST@MAC.COM, HIRO@AMESLAB.GOV (H.MORI)             C
C             MIYOSHI@ASEM.KYUSHU-U.AC.JP (E.MIYOSHI)                  C
C                                                                      C
C                         LAST UPDATED @ 03/FEB/2008 (H.MORI)          C
C                                                                      C
C     *** CURRENT VERSION SUPPORTS UP TO G-FUNCTIONS GRADIENT    ***   C
C     *** H-FUNCTIONS GRADIENT WHICH IS REQUIRED TO CALCULATE    ***   C
C     *** G-FUNCTIONS HESSIAN WILL BE SUPPORTED IN THE NEXT VER. ***   C
C                                                                      C
C     *** A BUG RELATING WITH FLOATING POINT ERROR WAS FIXED!    ***   C
C     *** A BUG WITH L-SHELL TREATMENT WAS FIXED!                ***   C
C                                                                      C
C=======================================================================
C
C     *** INFORMATION FOR GRADIENT ***
C     EG(3,MXATOM):             GRADIENTS
C     DC(IJ):                   DENSITY MATRIX BETWEEN I-TH ANF J-TH AOS
C                               IJ = I*(I-1)/2+J (I >= J)
C
C     *** INFORMATION FOR ATOMS ***
C     NATOM(I):                 INTEGER, ATOMIC NUMBER OF I-TH ATOM
C     X(I),Y(I),Z(I):           X,Y,Z COORDINATE OF I-TH ATOM
C
C     *** BASIS SET INFORMATION ***
C     MATOM(J):                 SEQUENTIAL ATOM # ON WHICH J-TH AO SITS
C     NG(J):                    COMPONENT NUMBER OF J-TH AO.
C     NT(J):                    NUMBER OF CGTF IN J-TH AO
C     AG(I,J),I=1,NT(J):        EXPONENT ARRAY OF J-TH AO
C     CG(I,J),I=1,NT(J):        COEFFICIENT ARRAY OF J-TH AO
C
C     *** MCP INFORMATION ***
C     ALPHA:                    EXPOTENTS OF THE MCP C-TERM
C     COEFA:                    COEFFIENTS OF THE MCP C-TERM
C     ALPHB:                    EXPOTENTS OF THE MCP D-TERM
C     COEFB:                    COEFFIENTS OF THE MCP D-TERM
C     NTERMA:                   NUMBER OF C-TERM
C     NTERMB:                   NUMBER OF D-TERM
C     IPSET:                    NUMBER OF MCP ELEMENTS [IP=1,IPSET]
C     NPOS(IP):                 NO. OF ATOMS USED A MCP [IPA=1,NPOS(IP)]
C     NSIT(IPA,IP):             SEQUENTIAL NUMBER OF THE MCP ATOM
C     NATM:                     TOTAL NUMBER OF ATOMS
C     IOSET:                    NUMBER OF CORE INITIAL ORBITALS (CIO)
C     MPOS(IO):                 NUMBER OF ATOMS USED THE CIO
C     IPOS(IOA,IO):             SEQUENTIAL NUMBER OF THE ATOM OF THE CIO
C     COEBK(IO):                BK COEFFIENTS OF THE CIO
C     NTC(IO):                  NUMBER OF TERMS OF THE CIO
C     NGC(IO):                  COMPONENT NUMBER OF THE CIO
C     (OEMP(I,IO),I=1,NTC(IO)): EXPONENTS OF THE CIO
C     (CEMP(I,IO),I=1,NTC(IO)): COEFFICIENTS OF THE CIO
C
C=======================================================================
      SUBROUTINE MCPGRD(EG,DC,DD,OVMP,DVMP,MXCO,MXVO)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (MXCS=1000,MXNT=40)
      PARAMETER (MXATM=2000)
      COMMON /ABDATA/ AG(MXNT,MXCS),CG(MXNT,MXCS),
     &                X(MXATM),Y(MXATM),Z(MXATM),
     &                NATOM(MXATM),MATOM(MXCS),NG(MXCS),MG(MXCS),
     &                NT(MXCS),NCO,NAO,NCS,NATM
      COMMON /IOFILE/ IR,IW,IP,IS,IJKT,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      DIMENSION EG(3,*),DC(*),DD(3,*),OVMP(MXCO,MXVO),DVMP(MXCO,MXVO,3)
      LOGICAL GOPARR,DSKWRK,MASWRK

      T0 = 0.0D+00
      CALL TSECND(T0)

      CALL MCPINFO

      IF (NCO.GT.MXCO.AND.MASWRK) THEN
         WRITE(IW,*) 'ERROR IN SUB.MCPGRD'
         WRITE(IW,*) '# OF CORE ORBITALS ',NCO,' IS OVER MXCO=',MXCO
         CALL ABRT
         STOP
      ENDIF
      IF (NAO.GT.MXVO.AND.MASWRK) THEN
         WRITE(IW,*) 'ERROR IN SUB.MCPGRD'
         WRITE(IW,*) '# OF BASIS FUNCTIONS ',NAO,' IS OVER MXVO=',MXVO
         CALL ABRT
         STOP
      ENDIF
      IF (NCS.GT.MXCS.AND.MASWRK) THEN
         WRITE(IW,*) 'ERROR IN SUB.MCPGRD'
         WRITE(IW,*) '# OF VALENCE SHELLS ',NCS,' IS OVER MXCS=',MXCS
         CALL ABRT
         STOP
      ENDIF
      IF (NATM.GT.MXATM.AND.MASWRK) THEN
         WRITE(IW,*) 'ERROR IN SUB.MCPGRD'
         WRITE(IW,*) '# OF ATOMS ',NATM,' IS OVER MXATM=',MXATM
         CALL ABRT
         STOP
      ENDIF

      DO IATM=1,NATM
         DO IX=1,3
            DD(IX,IATM)=EG(IX,IATM)
         ENDDO
      ENDDO

      CALL MCPDER(EG,DC,OVMP,DVMP,MXCO,MXVO)

      DO IATM=1,NATM
         DO IX=1,3
            DD(IX,IATM)=EG(IX,IATM)-DD(IX,IATM)
         ENDDO
      ENDDO

      IF (MASWRK) THEN
         CALL TSECND(T1)
         TG = T1-T0
         WRITE(IW,9999) TG
      END IF
 9999 FORMAT(' TIME TO DO      MCP GRADIENT INTEGRALS=',F10.2)
      RETURN
      END
C=======================================================================
      SUBROUTINE MCPDER(EG,DC,OVMP,DVMP,MXCO,MXVO)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXCS=1000,MXATM=2000 )
      PARAMETER ( MXC=21,MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      LOGICAL GOPARR,DSKWRK,MASWRK
      COMMON /ABDATA/ AG(MXNT,MXCS),CG(MXNT,MXCS),
     &                X(MXATM),Y(MXATM),Z(MXATM),
     &                NATOM(MXATM),MATOM(MXCS),NG(MXCS),MG(MXCS),
     &                NT(MXCS),MCO,NAO,NCS,NTM
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      COMMON /IOFILE/ IR,IW,IP,IS,IJKT,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /MCPOUT/ CTERM(MXC,MXC),DTERM(MXC,MXC)
      COMMON /MCPOUTG/CTERMG(MXC,3,MXC),DTERMG(MXC,3,MXC)
      COMMON /RUNOPT/ RUNTYP,EXETYP,NEVALS,NGLEVL,NHLEVL
      DIMENSION DC(*),OVMP(MXCO,MXVO),DVMP(MXCO,MXVO,3)
      DIMENSION EG(3,MXATM),EGLOC(3,MXATM),EGMCP(3,MXATM)
      DIMENSION EG_WFCD(3,MXATM),EG_WFE(3,MXATM)
      DIMENSION EG_HFCD(3,MXATM),EG_HFE(3,MXATM)
      DIMENSION WW(MXATM)
      PARAMETER (MAXSP=6)
      DIMENSION NSP(0:MAXSP)
      DATA (NSP(I),I=0,MAXSP)/0,1,3,6,10,15,21/
      LOGICAL LSHELLI, LSHELLJ
C     POWERS OF CARTESIAN GAUSSIAN FUNCTION OF VALENCE ORBITALS
      DIMENSION LMNSP(3,35)
      DATA  ((LMNSP(J,I),J=1,3),I=1,35)/
     1      0,0,0,
     2      1,0,0,0,1,0,0,0,1,
     3      2,0,0,1,1,0,1,0,1,0,2,0,0,1,1,0,0,2,
     4      3,0,0,2,1,0,2,0,1,1,2,0,1,1,1,1,0,2,0,3,0,0,2,1,0,1,2,0,0,3,
     5      4,0,0,3,1,0,3,0,1,2,2,0,2,1,1,2,0,2,1,3,0,1,2,1,1,1,2,1,0,3,
     6      0,4,0,0,3,1,0,2,2,0,1,3,0,0,4/
      DIMENSION PA(3),PB(3),LMN(3),NQN(3)
      DATA ONE,TWO /1.0D+00,2.0D+00/
      DIMENSION CEI(MXNT),CEJ(MXNT)
      DIMENSION IUP(15,3),IDN(15,3),NFA(15,3,4)
      DIMENSION LABGM(15,0:4)
      LOGICAL IDORB,IFORB,IGORB,JDORB,JFORB,JGORB
      LOGICAL IJCSEQ,IFREV,IFX
      LOGICAL SLB,DLB
      DATA (LABGM(I,0),I=1,1)/1/
      DATA (LABGM(I,1),I=1,3)/1,2,3/
      DATA (LABGM(I,2),I=1,6)/1,4,5,2,6,3/
      DATA (LABGM(I,3),I=1,10)/1,4,5,6,10,8,2,7,9,3/
      DATA (LABGM(I,4),I=1,15)/1,4,5,10,13,11,6,14,15,8,2,7,12,9,3/
      DATA ((IUP(I,IX),I=1,15),IX=1,3)/
     &                  1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,
     &                  2, 4, 5, 7, 8, 9,11,12,13,14,16,17,18,19,20,
     &                  3, 5, 6, 8, 9,10,12,13,14,15,17,18,19,20,21/
      DATA ((IDN(I,IX),I=1,15),IX=1,3)/
     &                  1, 2, 3, 4, 5, 6, 7, 8, 9,10, 0, 0, 0, 0, 0,
     &                  0, 1, 0, 2, 3, 0, 4, 5, 6, 0, 7, 8, 9,10, 0,
     &                  0, 0, 1, 0, 2, 3, 0, 4, 5, 6, 0, 7, 8, 9,10/
      DATA ((NFA(I,IX,1),I=1, 3),IX=1,3)/1,0,0, 0,1,0, 0,0,1/
      DATA ((NFA(I,IX,2),I=1, 6),IX=1,3)/2,1,1,0,0,0,
     &                                   0,1,0,2,1,0,
     &                                   0,0,1,0,1,2/
      DATA ((NFA(I,IX,3),I=1,10),IX=1,3)/3,2,2,1,1,1,0,0,0,0,
     &                                   0,1,0,2,1,0,3,2,1,0,
     &                                   0,0,1,0,1,2,0,1,2,3/
      DATA ((NFA(I,IX,4),I=1,15),IX=1,3)/4,3,3,2,2,2,1,1,1,1,0,0,0,0,0,
     &                                   0,1,0,2,1,0,3,2,1,0,4,3,2,1,0,
     &                                   0,0,1,0,1,2,0,1,2,3,0,1,2,3,4/
C
C     THE NEXT IS FOR DEBUG
C
      LOGICAL DBG
      DATA DEBUG/8HDEBUG   /, GRD1/8HGRD1    /
      DBG = (EXETYP.EQ.DEBUG .OR. EXETYP.EQ.GRD1)  .AND.  MASWRK
C
C     DRIVER OF MCP GRADIENT
C
      SLB = GOPARR .AND. IBTYP.EQ.0
      DLB = GOPARR .AND. IBTYP.EQ.1

      SQ3 = SQRT(3.0D+00)
      SQ5 = SQRT(5.0D+00)
      SQ7 = SQRT(7.0D+00)

      CALL INITIALIZE_AUXILIARY_INTEGRAL

      IF (DBG) THEN
         WRITE (IW,999)
      ENDIF

C
C     (1) --- <A'|H(MCP_C&D)|B> TERMS ---
C
      CALL DDI_DLBRESET
C
C     INITIALIZE PARALLEL
C
      NEXT = -1
      MINE = -1
      IPCOUNT = ME-1
C
C     I-TH SHELL'S DERIVATIVE
C
      IAO = 0
      CALL VCLR(EGLOC,1,3*NATM)

      DO 1000 ICS=1,NCS
         NGI=NG(ICS)
         NTI=NT(ICS)
C     L-SHELL TREATMENT
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 1001 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            IAO1 = IAO
            IPA=MATOM(ICS)
            LING=NGI/3
            IF (LING.GT.4) LING=4
            IDORB=LING.EQ.2
            IFORB=LING.EQ.3
            IGORB=LING.EQ.4
            IAO = IAO+NGI
C     
C     ----- GO PARALLEL! -----
C     
            IF (DLB) THEN
               MINE = MINE+1
               IF ( MINE.GT.NEXT ) CALL DDI_DLBNEXT(NEXT)
               IF ( NEXT.NE.MINE ) GOTO 1001
            ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
            IF (ILSHELL.EQ.1) THEN
               DO II = 1,NTI
                  CEI(II) = CG(II,ICS)
               ENDDO
C     P-TYPE SHELL OF L-SHELL
            ELSE
               DO II = 1,NTI
                  CEI(II) = CG(II+NTI,ICS)
               ENDDO
            ENDIF

C     
C     ICS UP & DOWN
C     
            IMCS=0
            DO I=1,MAXSP
               IF (NGI.EQ.NSP(I)) THEN
                  IMCS=I
               ENDIF
            ENDDO
            IF (IMCS.NE.0) THEN
               NGIP=NSP(IMCS+1)
               NGIM=NSP(IMCS-1)
            ELSE
               IF (MASWRK) THEN
                  WRITE(IW,*) 'ERROR IN SUB.MCPDER. NG IS WRONG'
                  CALL ABRT
                  STOP
               ENDIF
            ENDIF

            DO II = 1,NTI
C     
C     J-TH SHELLS
C     
               JAO = 0
               DO 1100 JCS=1,ICS
                  IJCSEQ=ICS.EQ.JCS
                  NGJ=NG(JCS)
                  NTJ=NT(JCS)
C     L-SHELL TREATMENT
                  LSHELLJ=.FALSE.
                  IF (NGJ.EQ.4) LSHELLJ=.TRUE.
                  JLSH=1
                  IF (LSHELLJ) JLSH=2
                  DO 1101 JLSHELL=1,JLSH
                     IF (IJCSEQ .AND. ILSHELL.LT.JLSHELL) GOTO 1101
                     IF (JLSHELL.EQ.1 .AND. LSHELLJ) NGJ=1
                     IF (JLSHELL.EQ.2 .AND. LSHELLJ) NGJ=3
                     JAO1 = JAO
                     JPB=MATOM(JCS)
                     LJNG=NGJ/3
                     IF (LJNG.GT.4) LJNG=4
                     JDORB=LJNG.EQ.2
                     JFORB=LJNG.EQ.3
                     JGORB=LJNG.EQ.4
                     JAO = JAO+NGJ
C     
C     ----- GO PARALLEL! -----
C     
                     IF (SLB) THEN
                        IPCOUNT = IPCOUNT+1
                        IF ( MOD(IPCOUNT,NPROC).NE.0 ) GOTO 1101
                     ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
                     IF (JLSHELL.EQ.1) THEN
                        DO JJ = 1,NTJ
                           CEJ(JJ) = CG(JJ,JCS)
                        ENDDO
C     P-TYPE SHELL OF L-SHELL
                     ELSE
                        DO JJ = 1,NTJ
                           CEJ(JJ) = CG(JJ+NTJ,JCS)
                        ENDDO
                     ENDIF
               
C     
C     SET (I,J) IN ORDER I>J   FOR  UP
C     
                     IF (NGJ.GT.NGIP) THEN
                        AA(1) = X(JPB)
                        AA(2) = Y(JPB)
                        AA(3) = Z(JPB)
                        BB(1) = X(IPA)
                        BB(2) = Y(IPA)
                        BB(3) = Z(IPA)
                     ELSE
                        AA(1) = X(IPA)
                        AA(2) = Y(IPA)
                        AA(3) = Z(IPA)
                        BB(1) = X(JPB)
                        BB(2) = Y(JPB)
                        BB(3) = Z(JPB)
                     ENDIF
                     
                     DO JJ = 1,NTJ
                        IF (NGJ.GT.NGIP) THEN
                           AGI = AG(JJ,JCS)
                           AGJ = AG(II,ICS)
                           CALL MCP0CDDRV (NGJ,NGIP,X,Y,Z)
                        ELSE
                           AGI = AG(II,ICS)
                           AGJ = AG(JJ,JCS)
                           CALL MCP0CDDRV (NGIP,NGJ,X,Y,Z)
                        ENDIF
                        
                        DO IX=1,3
                           DO I=1,NGI
                              IU=IUP(I,IX)
                              IGM=LABGM(I,LING)
                              IAO1I=IAO1+IGM
                              II2=IAO1I*(IAO1I-1)/2
                              CCI = CEI(II)
                              IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                              IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                              IF(IFORB.AND.IGM.GE.10) CCI=CCI*SQ3
                              IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                              IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                              IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                              JLIM=NGJ
                              IF (IJCSEQ.AND.ILSHELL.EQ.JLSHELL) JLIM=I
                              DO J=1,JLIM
                                 JGM=LABGM(J,LJNG)
                                 JAO1J=JAO1+JGM
                                 II2J=II2+JAO1J
                                 IFREV = JAO1J.GT.IAO1I
                                 IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                                 CCC=TWO
                                 IF (IAO1I.EQ.JAO1J) CCC=ONE
                                 IF (IAO1I.EQ.JAO1J.AND.
     *                               ILSHELL.NE.JLSHELL) CCC=TWO
                                 CCJ = CEJ(JJ)
                                 IF(JDORB.AND.JGM.GE. 4) CCJ=CCJ*SQ3
                                 IF(JFORB.AND.JGM.GE. 4) CCJ=CCJ*SQ5
                                 IF(JFORB.AND.JGM.GE.10) CCJ=CCJ*SQ3
                                 IF(JGORB.AND.JGM.GE. 4) CCJ=CCJ*SQ7
                                 IF(JGORB.AND.JGM.GE.10) CCJ=CCJ*SQ5/SQ3
                                 IF(JGORB.AND.JGM.GE.13) CCJ=CCJ*SQ3
                                 IF (NGJ.GT.NGIP) THEN
                                 SUM = (CTERM(J,IU)+DTERM(J,IU))*TWO*AGJ
                                 ELSE
                                 SUM = (CTERM(IU,J)+DTERM(IU,J))*TWO*AGI
                                 ENDIF
                                 EGLOC(IX,IPA) = EGLOC(IX,IPA)
     &                                +DC(II2J)*CCI*CCJ*SUM*CCC
                              ENDDO
                           ENDDO
                        ENDDO
                     ENDDO
C     
C     SET (I,J) IN ORDER I>J   FOR  DOWN
C     
                     IF (NGIM.NE.0) THEN
                        IF (NGJ.GT.NGIM) THEN
                           AA(1) = X(JPB)
                           AA(2) = Y(JPB)
                           AA(3) = Z(JPB)
                           BB(1) = X(IPA)
                           BB(2) = Y(IPA)
                           BB(3) = Z(IPA)
                        ELSE
                           AA(1) = X(IPA)
                           AA(2) = Y(IPA)
                           AA(3) = Z(IPA)
                           BB(1) = X(JPB)
                           BB(2) = Y(JPB)
                           BB(3) = Z(JPB)
                        ENDIF
                        
                        DO JJ = 1,NTJ
                           IF (NGJ.GT.NGIM) THEN
                              AGI = AG(JJ,JCS)
                              AGJ = AG(II,ICS)
                              CALL MCP0CDDRV (NGJ,NGIM,X,Y,Z)
                           ELSE
                              AGI = AG(II,ICS)
                              AGJ = AG(JJ,JCS)
                              CALL MCP0CDDRV (NGIM,NGJ,X,Y,Z)
                           ENDIF
                           
                           DO IX=1,3
                              DO I=1,NGI
                                 ID=IDN(I,IX)
                                 IF(ID.NE.0 .AND. ID.LE.NGIM) THEN
                                    NFI=NFA(I,IX,IMCS-1)
                                    IGM=LABGM(I,LING)
                                    IAO1I=IAO1+IGM
                                    II2=IAO1I*(IAO1I-1)/2
                                    CCI = CEI(II)
                                 IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                                 IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                                 IF(IFORB.AND.IGM.GE.10) CCI=CCI*SQ3
                                 IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                                 IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                                 IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                                    JLIM=NGJ
                             IF (IJCSEQ .AND. ILSHELL.EQ.JLSHELL) JLIM=I
                                    DO J=1,JLIM
                                       JGM=LABGM(J,LJNG)
                                       JAO1J=JAO1+JGM
                                       II2J=II2+JAO1J
                                       IFREV = JAO1J.GT.IAO1I
                                 IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                                       CCC=TWO
                                       IF (IAO1I.EQ.JAO1J) CCC=ONE
                                       IF (IAO1I.EQ.JAO1J .AND.
     *                                     ILSHELL.NE.JLSHELL) CCC=TWO
                                       CCJ = CEJ(JJ)
                                 IF(JDORB.AND.JGM.GE. 4) CCJ=CCJ*SQ3
                                 IF(JFORB.AND.JGM.GE. 4) CCJ=CCJ*SQ5
                                 IF(JFORB.AND.JGM.GE.10) CCJ=CCJ*SQ3
                                 IF(JGORB.AND.JGM.GE. 4) CCJ=CCJ*SQ7
                                 IF(JGORB.AND.JGM.GE.10) CCJ=CCJ*SQ5/SQ3
                                 IF(JGORB.AND.JGM.GE.13) CCJ=CCJ*SQ3
                                       IF (NGJ.GT.NGIM) THEN
                                     SUM = (CTERM(J,ID)+DTERM(J,ID))*NFI
                                       ELSE
                                     SUM = (CTERM(ID,J)+DTERM(ID,J))*NFI
                                       ENDIF
                                       EGLOC(IX,IPA) = EGLOC(IX,IPA)
     &                                      -DC(II2J)*CCI*CCJ*SUM*CCC
                                    ENDDO
                                 ENDIF
                              ENDDO
                           ENDDO
                        ENDDO
                     ENDIF
 1101             CONTINUE
 1100          CONTINUE
            ENDDO
 1001    CONTINUE
 1000 CONTINUE

C     
C     SYMMETRIZE THE MCP WF-CONTRIBUTION
C     OF MCP-C&D TERMS TO THE GRADIENT
C
      CALL SYMEG(EGLOC)
C
C     NOW ADD TO EG
C
      IF (GOPARR) CALL DDI_GSUMF(900,EGLOC,3*NATM)
      IF (GOPARR) CALL DSCAL(3*NATM,ONE/NPROC,EGLOC,1)
      IF (DLB) CALL DDI_DLBRESET

      CALL VCLR(EG_WFCD,1,3*NATM)
      DO I=1,NATM
         DO J=1,3
            EG_WFCD(J,I) = EG_WFCD(J,I) + EGLOC(J,I)*NPROC
            EG(J,I) = EG(J,I) + EGLOC(J,I)
         ENDDO
      ENDDO
      CALL VCLR(EGLOC,1,3*NATM)
C
C     INITIALIZE PARALLEL
C
      NEXT = -1
      MINE = -1
      IPCOUNT = ME-1
C
C     J-TH SHELL'S DERIVATIVE
C
      IAO = 0
      DO 1200 ICS=1,NCS
         NGI=NG(ICS)
         NTI=NT(ICS)
C     L-SHELL TREATMENT
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 1201 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            IAO1 = IAO
            IPA=MATOM(ICS)
            LING=NGI/3
            IF (LING.GT.4) LING=4
            IDORB=LING.EQ.2
            IFORB=LING.EQ.3
            IGORB=LING.EQ.4
            IAO = IAO+NGI
C     
C     ----- GO PARALLEL! -----
C     
            IF (DLB) THEN
               MINE = MINE+1
               IF ( MINE.GT.NEXT ) CALL DDI_DLBNEXT(NEXT)
               IF ( NEXT.NE.MINE ) GOTO 1201
            ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
            IF (ILSHELL.EQ.1) THEN
               DO II = 1,NTI
                  CEI(II) = CG(II,ICS)
               ENDDO
C     P-TYPE SHELL OF L-SHELL
            ELSE
               DO II = 1,NTI
                  CEI(II) = CG(II+NTI,ICS)
               ENDDO
            ENDIF

            DO II = 1,NTI
C     
C     J-TH SHELLS
C     
               JAO = 0
               DO 1300 JCS=1,ICS
                  IJCSEQ=ICS.EQ.JCS
                  NGJ=NG(JCS)
                  NTJ=NT(JCS)
C     L-SHELL TREATMENT
                  LSHELLJ=.FALSE.
                  IF (NGJ.EQ.4) LSHELLJ=.TRUE.
                  JLSH=1
                  IF (LSHELLJ) JLSH=2
                  DO 1301 JLSHELL=1,JLSH
                     IF (IJCSEQ .AND. ILSHELL.LT.JLSHELL) GOTO 1301
                     IF (JLSHELL.EQ.1 .AND. LSHELLJ) NGJ=1
                     IF (JLSHELL.EQ.2 .AND. LSHELLJ) NGJ=3
                     JAO1 = JAO
                     JPB=MATOM(JCS)
                     LJNG=NGJ/3
                     IF (LJNG.GT.4) LJNG=4
                     JDORB=LJNG.EQ.2
                     JFORB=LJNG.EQ.3
                     JGORB=LJNG.EQ.4
                     JAO = JAO+NGJ
C     
C     ----- GO PARALLEL! -----
C     
                     IF (SLB) THEN
                        IPCOUNT = IPCOUNT+1
                        IF ( MOD(IPCOUNT,NPROC).NE.0 ) GOTO 1301
                     ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
                     IF (JLSHELL.EQ.1) THEN
                        DO JJ = 1,NTJ
                           CEJ(JJ) = CG(JJ,JCS)
                        ENDDO
C     P-TYPE SHELL OF L-SHELL
                     ELSE
                        DO JJ = 1,NTJ
                           CEJ(JJ) = CG(JJ+NTJ,JCS)
                        ENDDO
                     ENDIF

C     
C     JCS UP & DOWN
C     
                     JMCS=0
                     DO J=1,MAXSP
                        IF (NGJ.EQ.NSP(J)) THEN
                           JMCS=J
                        ENDIF
                     ENDDO
                     IF (JMCS.NE.0) THEN
                        NGJP=NSP(JMCS+1)
                        NGJM=NSP(JMCS-1)
                     ENDIF
C     
C     SET (I,J) IN ORDER I>J   FOR  UP
C     
                     IF (NGJP.GT.NGI) THEN
                        AA(1) = X(JPB)
                        AA(2) = Y(JPB)
                        AA(3) = Z(JPB)
                        BB(1) = X(IPA)
                        BB(2) = Y(IPA)
                        BB(3) = Z(IPA)
                     ELSE
                        AA(1) = X(IPA)
                        AA(2) = Y(IPA)
                        AA(3) = Z(IPA)
                        BB(1) = X(JPB)
                        BB(2) = Y(JPB)
                        BB(3) = Z(JPB)
                     ENDIF
                     
                     DO JJ = 1,NTJ
                        IF (NGJP.GT.NGI) THEN
                           AGI = AG(JJ,JCS)
                           AGJ = AG(II,ICS)
                           CALL MCP0CDDRV (NGJP,NGI,X,Y,Z)
                        ELSE
                           AGI = AG(II,ICS)
                           AGJ = AG(JJ,JCS)
                           CALL MCP0CDDRV (NGI,NGJP,X,Y,Z)
                        ENDIF
                  
                        DO IX=1,3
                           DO I=1,NGI
                              IGM=LABGM(I,LING)
                              IAO1I=IAO1+IGM
                              II2=IAO1I*(IAO1I-1)/2
                              CCI = CEI(II)
                              IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                              IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                              IF(IFORB.AND.IGM.EQ.10) CCI=CCI*SQ3
                              IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                              IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                              IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                              JLIM=NGJ
                              IF (IJCSEQ.AND. ILSHELL.EQ.JLSHELL) JLIM=I
                              DO J=1,JLIM
                                 JU=IUP(J,IX)
                                 JGM=LABGM(J,LJNG)
                                 JAO1J=JAO1+JGM
                                 II2J=II2+JAO1J
                                 IFREV = JAO1J.GT.IAO1I
                                 IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                                 CCC=TWO
                                 IF (IAO1I.EQ.JAO1J) CCC=ONE
                                 IF (IAO1I.EQ.JAO1J .AND.
     *                               ILSHELL.NE.JLSHELL) CCC=TWO
                                 CCJ = CEJ(JJ)
                                 IF(JDORB.AND.JGM.GE. 4) CCJ=CCJ*SQ3
                                 IF(JFORB.AND.JGM.GE. 4) CCJ=CCJ*SQ5
                                 IF(JFORB.AND.JGM.GE.10) CCJ=CCJ*SQ3
                                 IF(JGORB.AND.JGM.GE. 4) CCJ=CCJ*SQ7
                                 IF(JGORB.AND.JGM.GE.10) CCJ=CCJ*SQ5/SQ3
                                 IF(JGORB.AND.JGM.GE.13) CCJ=CCJ*SQ3
                                 IF (NGJP.GT.NGI) THEN
                                 SUM = (CTERM(JU,I)+DTERM(JU,I))*TWO*AGI
                                 ELSE
                                 SUM = (CTERM(I,JU)+DTERM(I,JU))*TWO*AGJ
                                 ENDIF
                                 EGLOC(IX,JPB) = EGLOC(IX,JPB)
     &                                + DC(II2J)*CCI*CCJ*SUM*CCC
                              ENDDO
                           ENDDO
                        ENDDO
                     ENDDO
C     
C     SET (I,J) IN ORDER I>J   FOR  DOWN
C     
                     IF (NGJM.NE.0) THEN
                        IF (NGJM.GT.NGI) THEN
                           AA(1) = X(JPB)
                           AA(2) = Y(JPB)
                           AA(3) = Z(JPB)
                           BB(1) = X(IPA)
                           BB(2) = Y(IPA)
                           BB(3) = Z(IPA)
                        ELSE
                           AA(1) = X(IPA)
                           AA(2) = Y(IPA)
                           AA(3) = Z(IPA)
                           BB(1) = X(JPB)
                           BB(2) = Y(JPB)
                           BB(3) = Z(JPB)
                        ENDIF
                        
                        DO JJ = 1,NTJ
                           IF (NGJM.GT.NGI) THEN
                              AGI = AG(JJ,JCS)
                              AGJ = AG(II,ICS)
                              CALL MCP0CDDRV(NGJM,NGI,X,Y,Z)
                           ELSE
                              AGI = AG(II,ICS)
                              AGJ = AG(JJ,JCS)
                              CALL MCP0CDDRV(NGI,NGJM,X,Y,Z)
                           ENDIF

                           DO IX=1,3
                              DO I=1,NGI
                                 IGM=LABGM(I,LING)
                                 IAO1I=IAO1+IGM
                                 II2=IAO1I*(IAO1I-1)/2
                                 CCI = CEI(II)
                                 IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                                 IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                                 IF(IFORB.AND.IGM.GE.10) CCI=CCI*SQ3
                                 IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                                 IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                                 IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                                 JLIM=NGJ
                                 IF (IJCSEQ .AND.
     *                               ILSHELL.EQ.JLSHELL) JLIM=I
                                 DO J=1,JLIM
                                    JD=IDN(J,IX)
                                    IF(JD.NE.0 .AND. JD.LE.NGJM) THEN
                                       JGM=LABGM(J,LJNG)
                                       JAO1J=JAO1+JGM
                                       NFJ=NFA(J,IX,JMCS-1)
                                       CCJ = CEJ(JJ)
                                 IF(JDORB.AND.JGM.GE. 4) CCJ=CCJ*SQ3
                                 IF(JFORB.AND.JGM.GE. 4) CCJ=CCJ*SQ5
                                 IF(JFORB.AND.JGM.GE.10) CCJ=CCJ*SQ3
                                 IF(JGORB.AND.JGM.GE. 4) CCJ=CCJ*SQ7
                                 IF(JGORB.AND.JGM.GE.10) CCJ=CCJ*SQ5/SQ3
                                 IF(JGORB.AND.JGM.GE.13) CCJ=CCJ*SQ3
                                       II2J=II2+JAO1J
                                       IFREV = JAO1J.GT.IAO1I
                                 IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                                       CCC=TWO
                                       IF (IAO1I.EQ.JAO1J) CCC=ONE
                                       IF (IAO1I.EQ.JAO1J .AND.
     *                                     ILSHELL.NE.JLSHELL) CCC=TWO
                                       IF (NGJM.GT.NGI) THEN
                                     SUM = (CTERM(JD,I)+DTERM(JD,I))*NFJ
                                       ELSE
                                     SUM = (CTERM(I,JD)+DTERM(I,JD))*NFJ
                                       ENDIF
                                       EGLOC(IX,JPB) = EGLOC(IX,JPB)
     &                                      - DC(II2J)*CCI*CCJ*SUM*CCC
                                    ENDIF
                                 ENDDO
                              ENDDO
                           ENDDO
                        ENDDO
                     ENDIF
 1301             CONTINUE
 1300          CONTINUE
            ENDDO
 1201    CONTINUE
 1200 CONTINUE
C     
C     SYMMETRIZE THE MCP WF-CONTRIBUTION
C     OF MCP-C&D TERMS TO THE GRADIENT
C
      CALL SYMEG(EGLOC)
C
C     NOW ADD TO EG
C
      IF (GOPARR) CALL DDI_GSUMF(900,EGLOC,3*NATM)
      IF (GOPARR) CALL DSCAL(3*NATM,ONE/NPROC,EGLOC,1)
      IF (DLB) CALL DDI_DLBRESET

      DO I=1,NATM
         DO J=1,3
            EG_WFCD(J,I) = EG_WFCD(J,I) + EGLOC(J,I)*NPROC
            EG(J,I) = EG(J,I) + EGLOC(J,I)
         ENDDO
      ENDDO
C
C     PRINT OUT MCP-GRADIENT FOR DEBUG
C
      IF (DBG) THEN
         IF (MASWRK) THEN
            WRITE (IW,1999)
            CALL EGOUT(EG_WFCD,NATM)
         ENDIF
      ENDIF
      CALL VCLR(EGLOC,1,3*NATM)

C
C     (2) --- <A'|H(MCP_E)|B> TERMS ---
C
      IAO=0
      DO ICS=1,NCS
         NGI=NG(ICS)
         MGI=MG(ICS)
         NTI=NT(ICS)
         IPA=MATOM(ICS)
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 2002 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            LING=NGI/3
            IF (LING.GT.4) LING=4
            IDORB=LING.EQ.2
            IFORB=LING.EQ.3
            IGORB=LING.EQ.4
            AA(1)=X(IPA)
            AA(2)=Y(IPA)
            AA(3)=Z(IPA)
            DO II=1,NGI
               IAO = IAO+1
               IGM=LABGM(II,LING)
               MMM=MGI+II
               IF (ILSHELL.EQ.2) MMM=MGI+II+1
               NQN(1)=LMNSP(1,MMM)
               NQN(2)=LMNSP(2,MMM)
               NQN(3)=LMNSP(3,MMM)
               
               ICO=0
               DO JCCS=1,IOSET
                  NT1=NQNDMP(4,JCCS)
                  DO K=1,3
                     LMN(K)=NQNDMP(K,JCCS)
                  ENDDO
                  M=MPOS(JCCS)
                  DO N=1,M
                     ICO=ICO+1
                     JPB=IPOS(N,JCCS)
                     BB(1)=X(JPB)
                     BB(2)=Y(JPB)
                     BB(3)=Z(JPB)
                     DO IX=1,3
                        IFX = IX.EQ.1
                        WS = 0.0D+00
                        WD = 0.0D+00
                        DO I=1,NTI
                           OEI=AG(I,ICS)
                           IF (ILSHELL.EQ.1) CCI=CG(I    ,ICS)
                           IF (ILSHELL.EQ.2) CCI=CG(I+NTI,ICS)
                           IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                           IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                           IF(IFORB.AND.IGM.EQ.10) CCI=CCI*SQ3
                           IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                           IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                           IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                           DO J=1,NT1
                              OEJ=OEMP(J,JCCS)
                              CCJ=CEMP(J,JCCS)
                              ZETA = OEI+OEJ
                              GXI  = OEI*OEJ/ZETA
                              DO K=1,3
                                 PA(K)= (OEI*AA(K)+OEJ*BB(K))/ZETA-AA(K)
                                 PB(K)= (OEI*AA(K)+OEJ*BB(K))/ZETA-BB(K)
                              ENDDO
                              IF (IFX) THEN
                     CALL OVLAPV(NQN(1),LMN(1),PA(1),PB(1),ZETA,GXI,WWS)
                                 WS = WS + WWS*CCI*CCJ
                              ENDIF
                              NQN(IX)=NQN(IX)+1
                     CALL OVLAPV(NQN(1),LMN(1),PA(1),PB(1),ZETA,GXI,WWS)
                              WD = WD + WWS*TWO*OEI*CCI*CCJ
                              NQN(IX)=NQN(IX)-2
                              IF(NQN(IX).GE.0) THEN
                     CALL OVLAPV(NQN(1),LMN(1),PA(1),PB(1),ZETA,GXI,WWS)
                                 WD = WD - WWS*(NQN(IX)+1)*CCI*CCJ
                              ENDIF
                              NQN(IX)=NQN(IX)+1
                           ENDDO
                        ENDDO
                        IF (IFX) OVMP(ICO,IAO)=WS
                        DVMP(ICO,IAO,IX)=WD
                     ENDDO
                  ENDDO
               ENDDO
            ENDDO
 2002    CONTINUE
      ENDDO
C     
C     WF FORCE OF PROJECTION OPERATOR
C
      IAO=0
      DO 2000 ICS=1,NCS
         NGI=NG(ICS)
         IPA=MATOM(ICS)
C     L-SHELL TREATMENT
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 2001 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            IAO1 = IAO
            LING=NGI/3
            IF (LING.GT.4) LING=4
            DO I=1,NGI
               IAO = IAO+1
               IGM=LABGM(I,LING)
               IAO1I=IAO1+IGM
               II2=IAO1I*(IAO1I-1)/2
               
               JAO=0
               DO 2100 JCS=1,ICS
                  IJCSEQ=ICS.EQ.JCS
                  NGJ=NG(JCS)
                  JPB=MATOM(JCS)
                  LSHELLJ=.FALSE.
                  IF (NGJ.EQ.4) LSHELLJ=.TRUE.
                  JLSH=1
                  IF (LSHELLJ) JLSH=2
                  DO 2101 JLSHELL=1,JLSH
                     IF (IJCSEQ .AND. ILSHELL.LT.JLSHELL) GOTO 2101
                     IF (JLSHELL.EQ.1 .AND. LSHELLJ) NGJ=1
                     IF (JLSHELL.EQ.2 .AND. LSHELLJ) NGJ=3
                     JAO1 = JAO
                     LJNG=NGJ/3
                     IF (LJNG.GT.4) LJNG=4
                     JLIM=NGJ
                     IF (IJCSEQ .AND. ILSHELL.EQ.JLSHELL) JLIM=I
                     DO J=1,JLIM
                        JAO = JAO+1
                        JGM=LABGM(J,LJNG)
                        JAO1J=JAO1+JGM
                        II2J=II2+JAO1J
                        IFREV = JAO1J.GT.IAO1I
                        IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                        CCC=TWO
                        IF (IAO.EQ.JAO) CCC=ONE
                        IF (IAO.EQ.JAO .AND. ILSHELL.NE.JLSHELL) CCC=TWO
                        
                        DO IX=1,3
                       CALL WFPROJ(IAO,JAO,W1,W2,OVMP,DVMP,IX,MXCO,MXVO)
                           EGLOC(IX,IPA)=EGLOC(IX,IPA) + W1*DC(II2J)*CCC
                           EGLOC(IX,JPB)=EGLOC(IX,JPB) + W2*DC(II2J)*CCC
                        ENDDO

                     ENDDO
 2101             CONTINUE
 2100          CONTINUE
            ENDDO
 2001    CONTINUE
 2000 CONTINUE
C
C     SYMMETRIZE THE MCP WF-CONTRIBUTION
C     OF MCP-C&D TERMS TO THE GRADIENT
C
      CALL SYMEG(EGLOC)
C
C     NOW ADD TO EG
C
      IF (GOPARR) CALL DDI_GSUMF(900,EGLOC,3*NATM)
      IF (GOPARR) CALL DSCAL(3*NATM,ONE/NPROC,EGLOC,1)
      IF (DLB) CALL DDI_DLBRESET

      CALL VCLR(EG_WFE,1,3*NATM)
      DO I=1,NATM
         DO J=1,3
            EG_WFE(J,I) = EG_WFE(J,I) + EGLOC(J,I)
            EG(J,I) = EG(J,I) + EGLOC(J,I)/NPROC
         ENDDO
      ENDDO
      CALL VCLR(EGLOC,1,3*NATM)
C
C     PRINT OUT MCP-GRADIENT FOR DEBUG
C
      IF (DBG) THEN
         IF (MASWRK) THEN
            WRITE (IW,2999)
            CALL EGOUT(EG_WFE,NATM)
         ENDIF
      ENDIF

C
C     (3) --- <A|H'(MCP_C&D)|B> TERMS ---
C
      CALL VCLR(EG_HFCD,1,3*NATM)
C
C     I-TH SHELLS
C
      DO IPX = 1,IPSET
         DO NP = 1,NPOS(IPX)
            IATM = NSIT(NP,IPX)
C
C     INITIALIZE PARALLEL
C
            NEXT = -1
            MINE = -1
            IPCOUNT = ME-1

            IAO = 0
            DO 3000 ICS=1,NCS
               NGI = NG(ICS)
               NTI = NT(ICS)
C     L-SHELL TREATMENT
               LSHELLI=.FALSE.
               IF (NGI.EQ.4) LSHELLI=.TRUE.
               ILSH=1
               IF (LSHELLI) ILSH=2
               DO 3001 ILSHELL=1,ILSH
                  IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
                  IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
                  IAO1 = IAO
                  IPA = MATOM(ICS)
                  LING=NGI/3
                  IF (LING.GT.4) LING=4
                  IDORB=LING.EQ.2
                  IFORB=LING.EQ.3
                  IGORB=LING.EQ.4
                  IAO = IAO+NGI
C     
C     ----- GO PARALLEL! -----
C     
                  IF (DLB) THEN
                     MINE = MINE+1
                     IF ( MINE.GT.NEXT ) CALL DDI_DLBNEXT(NEXT)
                     IF ( NEXT.NE.MINE ) GOTO 3001
                  ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
                  IF (ILSHELL.EQ.1) THEN
                     DO II = 1,NTI
                        CEI(II) = CG(II,ICS)
                     ENDDO
C     P-TYPE SHELL OF L-SHELL
                  ELSE
                     DO II = 1,NTI
                        CEI(II) = CG(II+NTI,ICS)
                     ENDDO
                  ENDIF

                  DO II = 1,NTI
C     
C     J-TH SHELLS
C     
                     JAO = 0
                     DO 3100 JCS=1,ICS
                        IJCSEQ=ICS.EQ.JCS
                        NGJ = NG(JCS)
                        NTJ = NT(JCS)
C     L-SHELL TREATMENT
                        LSHELLJ=.FALSE.
                        IF (NGJ.EQ.4) LSHELLJ=.TRUE.
                        JLSH=1
                        IF (LSHELLJ) JLSH=2
                        
                        DO 3101 JLSHELL=1,JLSH
                           IF (IJCSEQ.AND. ILSHELL.LT.JLSHELL) GOTO 3101
                           IF (JLSHELL.EQ.1 .AND. LSHELLJ) NGJ=1
                           IF (JLSHELL.EQ.2 .AND. LSHELLJ) NGJ=3
                           JAO1 = JAO
                           JPB = MATOM(JCS)
                           LJNG=NGJ/3
                           IF (LJNG.GT.4) LJNG=4
                           JDORB=LJNG.EQ.2
                           JFORB=LJNG.EQ.3
                           JGORB=LJNG.EQ.4
                           JAO = JAO+NGJ
C     
C     ----- GO PARALLEL! -----
C     
                           IF (SLB) THEN
                              IPCOUNT = IPCOUNT+1
                              IF ( MOD(IPCOUNT,NPROC).NE.0 ) GOTO 3101
                           ENDIF

C     S-TYPE SHELL OF L-SHELL OR NON-L SHELL
                           IF (JLSHELL.EQ.1) THEN
                              DO JJ = 1,NTJ
                                 CEJ(JJ) = CG(JJ,JCS)
                              ENDDO
C     P-TYPE SHELL OF L-SHELL
                           ELSE
                              DO JJ = 1,NTJ
                                 CEJ(JJ) = CG(JJ+NTJ,JCS)
                              ENDDO
                           ENDIF

C     
C     SET (I,J) IN ORDER I>J
C     
                           IF (NGJ.GT.NGI) THEN
                              AA(1) = X(JPB)
                              AA(2) = Y(JPB)
                              AA(3) = Z(JPB)
                              BB(1) = X(IPA)
                              BB(2) = Y(IPA)
                              BB(3) = Z(IPA)
                           ELSE
                              AA(1) = X(IPA)
                              AA(2) = Y(IPA)
                              AA(3) = Z(IPA)
                              BB(1) = X(JPB)
                              BB(2) = Y(JPB)
                              BB(3) = Z(JPB)
                           ENDIF

                           DO JJ = 1,NTJ
                              IF (NGJ.GT.NGI) THEN
                                 AGI = AG(JJ,JCS)
                                 AGJ = AG(II,ICS)
                                 CALL MCP1CDDRV (IATM,NGJ,NGI,X,Y,Z)
                              ELSE
                                 AGI = AG(II,ICS)
                                 AGJ = AG(JJ,JCS)
                                 CALL MCP1CDDRV (IATM,NGI,NGJ,X,Y,Z)
                              ENDIF

                              DO IX=1,3
                                 DO I=1,NGI
                                    IGM=LABGM(I,LING)
                                    IAO1I=IAO1+IGM
                                    II2=IAO1I*(IAO1I-1)/2
                                    CCI = CEI(II)
                                 IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                                 IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                                 IF(IFORB.AND.IGM.EQ.10) CCI=CCI*SQ3
                                 IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                                 IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                                 IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                                    JLIM=NGJ
                             IF (IJCSEQ .AND. ILSHELL.EQ.JLSHELL) JLIM=I
                                    DO J=1,JLIM
                                       JGM=LABGM(J,LJNG)
                                       JAO1J=JAO1+JGM
                                       II2J=II2+JAO1J
                                       IFREV = JAO1J.GT.IAO1I
                                 IF (IFREV) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                                       CCC=TWO
                                       IF (IAO1I.EQ.JAO1J) CCC=ONE
                                       IF (IAO1I.EQ.JAO1J .AND.
     *                                     ILSHELL.NE.JLSHELL) CCC=TWO
                                       CCJ = CEJ(JJ)
                                 IF(JDORB.AND.JGM.GE. 4) CCJ=CCJ*SQ3
                                 IF(JFORB.AND.JGM.GE. 4) CCJ=CCJ*SQ5
                                 IF(JFORB.AND.JGM.EQ.10) CCJ=CCJ*SQ3
                                 IF(JGORB.AND.JGM.GE. 4) CCJ=CCJ*SQ7
                                 IF(JGORB.AND.JGM.GE.10) CCJ=CCJ*SQ5/SQ3
                                 IF(JGORB.AND.JGM.GE.13) CCJ=CCJ*SQ3
                                       IF (NGJ.GT.NGI) THEN
                                     SUM = CTERMG(J,IX,I)+DTERMG(J,IX,I)
                                       ELSE
                                     SUM = CTERMG(I,IX,J)+DTERMG(I,IX,J)
                                       ENDIF
                                       EGLOC(IX,IATM) = EGLOC(IX,IATM)
     &                                      +DC(II2J)*CCI*CCJ*SUM*CCC
                                    ENDDO
                                 ENDDO
                              ENDDO
                           ENDDO
 3101                   CONTINUE
 3100                CONTINUE
                  ENDDO
 3001          CONTINUE
 3000       CONTINUE

C
C     SYMMETRIZE THE MCP WF-CONTRIBUTION
C     OF MCP-C&D TERMS TO THE GRADIENT
C
      CALL SYMEG(EGLOC)
C
C     NOW ADD TO EG
C
            IF (GOPARR) CALL DDI_GSUMF(900,EGLOC,3*NATM)
            IF (GOPARR) CALL DSCAL(3*NATM,ONE/NPROC,EGLOC,1)
            IF (DLB) CALL DDI_DLBRESET

            DO I=1,NATM
               DO J=1,3
                  EG_HFCD(J,I) = EG_HFCD(J,I) + EGLOC(J,I)*NPROC
                  EG(J,I) = EG(J,I) + EGLOC(J,I)
               ENDDO
            ENDDO
            CALL VCLR(EGLOC,1,3*NATM)

         ENDDO
      ENDDO
C
C     PRINT OUT MCP-GRADIENT FOR DEBUG
C
      IF (DBG) THEN
         IF (MASWRK) THEN
            WRITE (IW,3999)
            CALL EGOUT(EG_HFCD,NATM)
         ENDIF
      ENDIF

      CALL VCLR(EGLOC,1,3*NATM)

C
C     (4) --- <A|H'(MCP_E)|B> TERMS ---
C
      IAO=0
      DO ICS=1,NCS
         NGI=NG(ICS)
         NTI=NT(ICS)
         MGI=MG(ICS)
         IPA=MATOM(ICS)
C     L-SHELL TREATMENT
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 4002 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            LING=NGI/3
            IF (LING.GT.4) LING=4
            IDORB=LING.EQ.2
            IFORB=LING.EQ.3
            IGORB=LING.EQ.4
            AA(1)=X(IPA)
            AA(2)=Y(IPA)
            AA(3)=Z(IPA)
            DO II=1,NGI
               IAO = IAO+1
               IGM=LABGM(II,LING)
               MMM=MGI+II
               IF (ILSHELL.EQ.2) MMM=MGI+II+1
               NQN(1)=LMNSP(1,MMM)
               NQN(2)=LMNSP(2,MMM)
               NQN(3)=LMNSP(3,MMM)

               ICO=0
               DO JCCS=1,IOSET
C     
C     ----- GO PARALLEL! -----
C     
                  NT1=NQNDMP(4,JCCS)
                  DO K=1,3
                     LMN(K)=NQNDMP(K,JCCS)
                  ENDDO
                  M=MPOS(JCCS)
                  DO N=1,M
                     ICO=ICO+1
                     JPB=IPOS(N,JCCS)
                     BB(1)=X(JPB)
                     BB(2)=Y(JPB)
                     BB(3)=Z(JPB)
                     DO IX=1,3
                        WD = 0.0D+00
                        DO I=1,NTI
                           OEI=AG(I,ICS)
                           IF (ILSHELL.EQ.1) CCI=CG(I    ,ICS)
                           IF (ILSHELL.EQ.2) CCI=CG(I+NTI,ICS)
                           IF(IDORB.AND.IGM.GE. 4) CCI=CCI*SQ3
                           IF(IFORB.AND.IGM.GE. 4) CCI=CCI*SQ5
                           IF(IFORB.AND.IGM.EQ.10) CCI=CCI*SQ3
                           IF(IGORB.AND.IGM.GE. 4) CCI=CCI*SQ7
                           IF(IGORB.AND.IGM.GE.10) CCI=CCI*SQ5/SQ3
                           IF(IGORB.AND.IGM.GE.13) CCI=CCI*SQ3
                           DO J=1,NT1
                              OEJ=OEMP(J,JCCS)
                              CCJ=CEMP(J,JCCS)
                              ZETA = OEI+OEJ
                              GXI  = OEI*OEJ/ZETA
                              DO K=1,3
                                 PA(K)=(OEI*AA(K)+OEJ*BB(K))/ZETA-AA(K)
                                 PB(K)=(OEI*AA(K)+OEJ*BB(K))/ZETA-BB(K)
                              ENDDO
                              LMN(IX)=LMN(IX)+1
                     CALL OVLAPV(NQN(1),LMN(1),PA(1),PB(1),ZETA,GXI,WWS)
                              WD = WD + WWS*TWO*OEJ*CCI*CCJ
                              LMN(IX)=LMN(IX)-2
                              IF(LMN(IX).GE.0) THEN
                     CALL OVLAPV(NQN(1),LMN(1),PA(1),PB(1),ZETA,GXI,WWS)
                                 WD = WD - WWS*(LMN(IX)+1)*CCI*CCJ
                              ENDIF
                              LMN(IX)=LMN(IX)+1
                           ENDDO
                        ENDDO
                        DVMP(ICO,IAO,IX)=WD
                     ENDDO
                  ENDDO
               ENDDO
            ENDDO
 4002    CONTINUE   
      ENDDO

C     
C     GRADIENT OF PROJECTION OPERATOR
C     
      IAO=0
      DO 4000 ICS=1,NCS
         NGI=NG(ICS)
         LSHELLI=.FALSE.
         IF (NGI.EQ.4) LSHELLI=.TRUE.
         ILSH=1
         IF (LSHELLI) ILSH=2
         DO 4001 ILSHELL=1,ILSH
            IF (ILSHELL.EQ.1 .AND. LSHELLI) NGI=1
            IF (ILSHELL.EQ.2 .AND. LSHELLI) NGI=3
            IAO1 = IAO
            LING=NGI/3
            IF (LING.GT.4) LING=4
            DO I=1,NGI
               IAO = IAO+1
               IGM=LABGM(I,LING)
               IAO1I=IAO1+IGM
               II2=IAO1I*(IAO1I-1)/2
     
               JAO=0
               DO 4100 JCS=1,ICS
                  IJCSEQ=ICS.EQ.JCS
                  NGJ=NG(JCS)
                  LSHELLJ=.FALSE.
                  IF (NGJ.EQ.4) LSHELLJ=.TRUE.
                  JLSH=1
                  IF (LSHELLJ) JLSH=2
                  DO 4101 JLSHELL=1,JLSH
                     IF (IJCSEQ .AND. ILSHELL.LT.JLSHELL) GOTO 4101
                     IF (JLSHELL.EQ.1 .AND. LSHELLJ) NGJ=1
                     IF (JLSHELL.EQ.2 .AND. LSHELLJ) NGJ=3
                     JAO1 = JAO
                     LJNG=NGJ/3
                     IF (LJNG.GT.4) LJNG=4
                     JLIM=NGJ
                     IF (IJCSEQ .AND. ILSHELL.EQ.JLSHELL) JLIM=I
                     DO J=1,JLIM
                        JAO = JAO+1
                        JGM=LABGM(J,LJNG)
                        JAO1J=JAO1+JGM
                        II2J=II2+JAO1J
                        IF (JAO1J.GT.IAO1I) II2J=JAO1J*(JAO1J-1)/2+IAO1I
                        CCC=TWO
                        IF (IAO.EQ.JAO) CCC=ONE
                        IF (IAO.EQ.JAO .AND. ILSHELL.NE.JLSHELL) CCC=TWO
                        
                        DO IX=1,3
                          CALL GRPROJ(IAO,JAO,WW,OVMP,DVMP,IX,MXCO,MXVO)
                           DO IATM=1,NATM
                              EGLOC(IX,IATM) = EGLOC(IX,IATM)
     &                             + WW(IATM)*DC(II2J)*CCC
                           ENDDO
                        ENDDO

                     ENDDO
 4101             CONTINUE
 4100          CONTINUE
            ENDDO
 4001    CONTINUE
 4000 CONTINUE
C     
C     SYMMETRIZE THE MCP WF-CONTRIBUTION
C     OF MCP-C&D TERMS TO THE GRADIENT
C
      CALL SYMEG(EGLOC)
C
C     NOW ADD TO EG
C
      IF (GOPARR) CALL DDI_GSUMF(900,EGLOC,3*NATM)
      IF (GOPARR) CALL DSCAL(3*NATM,ONE/NPROC,EGLOC,1)
      IF (DLB) CALL DDI_DLBRESET

      CALL VCLR(EG_HFE,1,3*NATM)
      DO I=1,NATM
         DO J=1,3
            EG_HFE(J,I) = EG_HFE(J,I) + EGLOC(J,I)
            EG(J,I) = EG(J,I) + EGLOC(J,I)/NPROC
         ENDDO
      ENDDO
      CALL VCLR(EGLOC,1,3*NATM)
C
C     PRINT OUT MCP-GRADIENT FOR DEBUG
C
      IF (DBG) THEN
         IF (MASWRK) THEN
            WRITE (IW,4999)
            CALL EGOUT(EG_HFE,NATM)
         ENDIF
      ENDIF
C
C
C     PRINT OUT MCP-GRADIENT FOR DEBUG
C
      IF (DBG) THEN
         IF (MASWRK) THEN
            WRITE (IW,5000)

            DO I=1,NATM
               DO J=1,3
                  EGMCP(J,I)=0.0D+00
               ENDDO
            ENDDO

            DO I=1,NATM
               DO J=1,3
                  EGMCP(J,I) = EGMCP(J,I)
     &                 + EG_WFCD(J,I) + EG_WFE(J,I)
     &                 + EG_HFCD(J,I) + EG_HFE(J,I)
               ENDDO
            ENDDO
            CALL EGOUT(EGMCP,NATM)
            WRITE (IW,5010)
         ENDIF
      ENDIF

 999  FORMAT(/1X,'BEGINNING MCP GRADIENT...')
 1999 FORMAT(/5X,'=== WF-CONTRIBUTION OF MCP-C&D TERMS ===')
 2999 FORMAT(/5X,'=== WF-CONTRIBUTION OF MCP- E  TERM  ===')
 3999 FORMAT(/5X,'=== HF-CONTRIBUTION OF MCP-C&D TERMS ===')
 4999 FORMAT(/5X,'=== HF-CONTRIBUTION OF MCP- E  TERM  ===')
 5000 FORMAT(/5X,40(1H=)
     &       /5X,'=== THE TOTAL MCP CONTRIBUTION TO EG ==='
     &       /5X,40(1H=))
 5010 FORMAT(/,' ...... END OF -MCP- GRADIENT ..... ')
      RETURN
      END
C=======================================================================
      SUBROUTINE WFPROJ(IAO,JAO,W1,W2,OVMP,DVMP,IX,MXCO,MXVO)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      PARAMETER ( B23S5=.6708203932499369D+00, HALF=0.5D+00 )
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      DIMENSION OVMP(MXCO,MXVO),DVMP(MXCO,MXVO,3)
C
      W1=0.0D+00
      W2=0.0D+00
      K=0
      L=1
 10   M=MPOS(L)
C     S,P ORBITALS
      IF (NGC(L).LT.6) THEN
         DO N=1,M
            K=K+1
            W1=W1+COEBK(L)*DVMP(K,IAO,IX)*OVMP(K,JAO)
            W2=W2+COEBK(L)*OVMP(K,IAO)*DVMP(K,JAO,IX)
         ENDDO
         L=L+1
      ENDIF
C     D ORBITALS
      IF (NGC(L).EQ.6) THEN
         DO N=1,M
            K=K+1
            K1=K
            K2=K1+M
            K3=K2+M
            K4=K3+M
            K5=K4+M
            K6=K5+M
       XX = DVMP(K1,IAO,IX)*OVMP(K1,JAO) + DVMP(K2,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K3,JAO) + DVMP(K4,IAO,IX)*OVMP(K4,JAO)
     &    + DVMP(K5,IAO,IX)*OVMP(K5,JAO) + DVMP(K6,IAO,IX)*OVMP(K6,JAO)
     &    -(DVMP(K1,IAO,IX)*OVMP(K2,JAO) + DVMP(K2,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K3,JAO) + DVMP(K3,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K1,JAO) + DVMP(K1,IAO,IX)*OVMP(K3,JAO))
     &    * HALF
            W1=W1+COEBK(L)*XX
       XX = OVMP(K1,IAO)*DVMP(K1,JAO,IX) + OVMP(K2,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K3,JAO,IX) + OVMP(K4,IAO)*DVMP(K4,JAO,IX)
     &    + OVMP(K5,IAO)*DVMP(K5,JAO,IX) + OVMP(K6,IAO)*DVMP(K6,JAO,IX)
     &    -(OVMP(K1,IAO)*DVMP(K2,JAO,IX) + OVMP(K2,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K3,JAO,IX) + OVMP(K3,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K1,JAO,IX) + OVMP(K1,IAO)*DVMP(K3,JAO,IX))
     &    * HALF
            W2=W2+COEBK(L)*XX
         ENDDO
         K=K6
         L=L+6
      ENDIF
C     F ORBITALS
      IF (NGC(L).GT.6) THEN
         DO N=1,M
            K=K+1
            K1=K
            K2=K1+M
            K3=K2+M
            K4=K3+M
            K5=K4+M
            K6=K5+M
            K7=K6+M
            K8=K7+M
            K9=K8+M
            K0=K9+M
       XX = DVMP(K1,IAO,IX)*OVMP(K1,JAO) + DVMP(K2,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K3,JAO) + DVMP(K0,IAO,IX)*OVMP(K0,JAO)
     &    +(DVMP(K4,IAO,IX)*OVMP(K4,JAO) + DVMP(K5,IAO,IX)*OVMP(K5,JAO)
     &    + DVMP(K6,IAO,IX)*OVMP(K6,JAO) + DVMP(K7,IAO,IX)*OVMP(K7,JAO)
     &    + DVMP(K8,IAO,IX)*OVMP(K8,JAO) + DVMP(K9,IAO,IX)*OVMP(K9,JAO))
     &    * 1.20D+00
     &    -(DVMP(K1,IAO,IX)*OVMP(K6,JAO) + DVMP(K6,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K1,IAO,IX)*OVMP(K7,JAO) + DVMP(K7,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K8,JAO) + DVMP(K8,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K4,JAO) + DVMP(K4,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K9,JAO) + DVMP(K9,IAO,IX)*OVMP(K3,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K5,JAO) + DVMP(K5,IAO,IX)*OVMP(K3,JAO))
     &    * B23S5
     &    -(DVMP(K6,IAO,IX)*OVMP(K7,JAO) + DVMP(K7,IAO,IX)*OVMP(K6,JAO)
     &    + DVMP(K8,IAO,IX)*OVMP(K4,JAO) + DVMP(K4,IAO,IX)*OVMP(K8,JAO)
     &    + DVMP(K9,IAO,IX)*OVMP(K5,JAO) + DVMP(K5,IAO,IX)*OVMP(K9,JAO))
     &    * 0.30D+00
            W1=W1+COEBK(L)*XX
       XX = OVMP(K1,IAO)*DVMP(K1,JAO,IX) + OVMP(K2,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K3,JAO,IX) + OVMP(K0,IAO)*DVMP(K0,JAO,IX)
     &    +(OVMP(K4,IAO)*DVMP(K4,JAO,IX) + OVMP(K5,IAO)*DVMP(K5,JAO,IX)
     &    + OVMP(K6,IAO)*DVMP(K6,JAO,IX) + OVMP(K7,IAO)*DVMP(K7,JAO,IX)
     &    + OVMP(K8,IAO)*DVMP(K8,JAO,IX) + OVMP(K9,IAO)*DVMP(K9,JAO,IX))
     &    * 1.20D+00
     &    -(OVMP(K1,IAO)*DVMP(K6,JAO,IX) + OVMP(K6,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K1,IAO)*DVMP(K7,JAO,IX) + OVMP(K7,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K8,JAO,IX) + OVMP(K8,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K4,JAO,IX) + OVMP(K4,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K9,JAO,IX) + OVMP(K9,IAO)*DVMP(K3,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K5,JAO,IX) + OVMP(K5,IAO)*DVMP(K3,JAO,IX))
     &    * B23S5
     &    -(OVMP(K6,IAO)*DVMP(K7,JAO,IX) + OVMP(K7,IAO)*DVMP(K6,JAO,IX)
     &    + OVMP(K8,IAO)*DVMP(K4,JAO,IX) + OVMP(K4,IAO)*DVMP(K8,JAO,IX)
     &    + OVMP(K9,IAO)*DVMP(K5,JAO,IX) + OVMP(K5,IAO)*DVMP(K9,JAO,IX))
     &    * 0.30D+00
            W2=W2+COEBK(L)*XX
         ENDDO
         K=K0
         L=L+10
      ENDIF
      IF (L.LE.IOSET) GOTO 10
      RETURN
      END
C=======================================================================
      SUBROUTINE GRPROJ(IAO,JAO,W,OVMP,DVMP,IX,MXCO,MXVO)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      PARAMETER ( B23S5=.6708203932499369D+00, HALF=0.5D+00 )
      PARAMETER ( MXATM=2000)
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      DIMENSION OVMP(MXCO,MXVO),DVMP(MXCO,MXVO,3)
      DIMENSION W(MXATM)
C
      DO IATM=1,NATM
         W(IATM)=0.0D+00
      ENDDO
      K=0
      L=1
 10   M=MPOS(L)
C     S,P ORBITALS
      IF (NGC(L).LT.6) THEN
         DO N=1,M
            LPA=IPOS(N,L)
            K=K+1
            W(LPA)=W(LPA)+COEBK(L)*(DVMP(K,IAO,IX)*OVMP(K,JAO)
     &                             +OVMP(K,IAO)*DVMP(K,JAO,IX))
         ENDDO
         L=L+1
      ENDIF
C     D ORBITALS
      IF (NGC(L).EQ.6) THEN
         DO N=1,M
            LPA=IPOS(N,L)
            K=K+1
            K1=K
            K2=K1+M
            K3=K2+M
            K4=K3+M
            K5=K4+M
            K6=K5+M
       XX = DVMP(K1,IAO,IX)*OVMP(K1,JAO) + DVMP(K2,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K3,JAO) + DVMP(K4,IAO,IX)*OVMP(K4,JAO)
     &    + DVMP(K5,IAO,IX)*OVMP(K5,JAO) + DVMP(K6,IAO,IX)*OVMP(K6,JAO)
     &    -(DVMP(K1,IAO,IX)*OVMP(K2,JAO) + DVMP(K2,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K3,JAO) + DVMP(K3,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K1,JAO) + DVMP(K1,IAO,IX)*OVMP(K3,JAO))
     &    * HALF
     &    + OVMP(K1,IAO)*DVMP(K1,JAO,IX) + OVMP(K2,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K3,JAO,IX) + OVMP(K4,IAO)*DVMP(K4,JAO,IX)
     &    + OVMP(K5,IAO)*DVMP(K5,JAO,IX) + OVMP(K6,IAO)*DVMP(K6,JAO,IX)
     &    -(OVMP(K1,IAO)*DVMP(K2,JAO,IX) + OVMP(K2,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K3,JAO,IX) + OVMP(K3,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K1,JAO,IX) + OVMP(K1,IAO)*DVMP(K3,JAO,IX))
     &    * HALF
            W(LPA)=W(LPA)+COEBK(L)*XX
         ENDDO
         K=K6
         L=L+6
      ENDIF
C     F ORBITALS
      IF (NGC(L).GT.6) THEN
         DO N=1,M
            LPA=IPOS(N,L)
            K=K+1
            K1=K
            K2=K1+M
            K3=K2+M
            K4=K3+M
            K5=K4+M
            K6=K5+M
            K7=K6+M
            K8=K7+M
            K9=K8+M
            K0=K9+M
       XX = DVMP(K1,IAO,IX)*OVMP(K1,JAO) + DVMP(K2,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K3,JAO) + DVMP(K0,IAO,IX)*OVMP(K0,JAO)
     &    +(DVMP(K4,IAO,IX)*OVMP(K4,JAO) + DVMP(K5,IAO,IX)*OVMP(K5,JAO)
     &    + DVMP(K6,IAO,IX)*OVMP(K6,JAO) + DVMP(K7,IAO,IX)*OVMP(K7,JAO)
     &    + DVMP(K8,IAO,IX)*OVMP(K8,JAO) + DVMP(K9,IAO,IX)*OVMP(K9,JAO))
     &    * 1.20D+00
     &    -(DVMP(K1,IAO,IX)*OVMP(K6,JAO) + DVMP(K6,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K1,IAO,IX)*OVMP(K7,JAO) + DVMP(K7,IAO,IX)*OVMP(K1,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K8,JAO) + DVMP(K8,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K2,IAO,IX)*OVMP(K4,JAO) + DVMP(K4,IAO,IX)*OVMP(K2,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K9,JAO) + DVMP(K9,IAO,IX)*OVMP(K3,JAO)
     &    + DVMP(K3,IAO,IX)*OVMP(K5,JAO) + DVMP(K5,IAO,IX)*OVMP(K3,JAO))
     &    * B23S5
     &    -(DVMP(K6,IAO,IX)*OVMP(K7,JAO) + DVMP(K7,IAO,IX)*OVMP(K6,JAO)
     &    + DVMP(K8,IAO,IX)*OVMP(K4,JAO) + DVMP(K4,IAO,IX)*OVMP(K8,JAO)
     &    + DVMP(K9,IAO,IX)*OVMP(K5,JAO) + DVMP(K5,IAO,IX)*OVMP(K9,JAO))
     &    * 0.30D+00
     &    + OVMP(K1,IAO)*DVMP(K1,JAO,IX) + OVMP(K2,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K3,JAO,IX) + OVMP(K0,IAO)*DVMP(K0,JAO,IX)
     &    +(OVMP(K4,IAO)*DVMP(K4,JAO,IX) + OVMP(K5,IAO)*DVMP(K5,JAO,IX)
     &    + OVMP(K6,IAO)*DVMP(K6,JAO,IX) + OVMP(K7,IAO)*DVMP(K7,JAO,IX)
     &    + OVMP(K8,IAO)*DVMP(K8,JAO,IX) + OVMP(K9,IAO)*DVMP(K9,JAO,IX))
     &    * 1.20D+00
     &    -(OVMP(K1,IAO)*DVMP(K6,JAO,IX) + OVMP(K6,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K1,IAO)*DVMP(K7,JAO,IX) + OVMP(K7,IAO)*DVMP(K1,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K8,JAO,IX) + OVMP(K8,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K2,IAO)*DVMP(K4,JAO,IX) + OVMP(K4,IAO)*DVMP(K2,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K9,JAO,IX) + OVMP(K9,IAO)*DVMP(K3,JAO,IX)
     &    + OVMP(K3,IAO)*DVMP(K5,JAO,IX) + OVMP(K5,IAO)*DVMP(K3,JAO,IX))
     &    * B23S5
     &    -(OVMP(K6,IAO)*DVMP(K7,JAO,IX) + OVMP(K7,IAO)*DVMP(K6,JAO,IX)
     &    + OVMP(K8,IAO)*DVMP(K4,JAO,IX) + OVMP(K4,IAO)*DVMP(K8,JAO,IX)
     &    + OVMP(K9,IAO)*DVMP(K5,JAO,IX) + OVMP(K5,IAO)*DVMP(K9,JAO,IX))
     &         * 0.30D+00
            W(LPA)=W(LPA)+COEBK(L)*XX
         ENDDO
         K=K0
         L=L+10
      ENDIF
      IF (L.LE.IOSET) GOTO 10
      RETURN
      END
C=======================================================================
      SUBROUTINE OVLAPV(LA,LB,PA,PB,ZETA,GXI,WS)
C=======================================================================
C     CALCULATION OF OVERLAP INTEGRAL
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION LA(3),LB(3),PA(3),PB(3)
      DIMENSION BICOE(7,7)
      DATA (BICOE(I,1),I=1,1)
     &     /1.0D+00/
      DATA (BICOE(I,2),I=1,2)
     &     /1.0D+00,1.0D+00/
      DATA (BICOE(I,3),I=1,3)
     &     /1.0D+00,2.0D+00, 1.0D+00/
      DATA (BICOE(I,4),I=1,4)
     &     /1.0D+00,3.0D+00, 3.0D+00, 1.0D+00/
      DATA (BICOE(I,5),I=1,5)
     &     /1.0D+00,4.0D+00, 6.0D+00, 4.0D+00, 1.0D+00/
      DATA (BICOE(I,6),I=1,6)
     &     /1.0D+00,5.0D+00,10.0D+00,10.0D+00, 5.0D+00,1.0D+00/
      DATA (BICOE(I,7),I=1,7)
     &     /1.0D+00,6.0D+00,15.0D+00,20.0D+00,15.0D+00,6.0D+00,1.0D+00/
      DIMENSION DF(7), GINT(12)
      DATA DF/
     & 1.0D+00,1.0D+00,3.0D+00,15.0D+00,105.0D+00,945.0D+00,10395.0D+00/
      DATA TWO /2.0D+00/
      PARAMETER (PI=3.1415926535897932D+00)
C
      SQPI = SQRT(PI)
      WS = 1.0D+00
      DO IX = 1,3
         LAB = LA(IX)+LB(IX)+1
         LA1 = LA(IX)+1
         LB1 = LB(IX)+1
         DO LL = 1,LAB
            GINT(LL) = 0.0D+00
         ENDDO
         DO LL = 1,LAB
            LL1 = LL - 1
            IF (MOD(LL1,2).EQ.0) THEN
               LL2 = LL1/2
               ZPOW = LL
               ZPOW = ZPOW/2.0D+00
               GINT(LL) = SQPI * DF(LL2+1) * TWO**(-LL2) * ZETA**(-ZPOW)
            ENDIF
         ENDDO
         ES = 0.0D+00
         DO LAA = 1,LA(IX)+1
            LAA1 = LAA -1
            DO LBB = 1,LB(IX)+1
               LBB1 = LBB -1
               PAL = PA(IX)
               PBL = PB(IX)
C
C    TO AVOID FLOATING POINT ERROR WHICH ORIGINATS
C    FROM PAL**LAA1 OR PBL**LBB1
C
               IF ((PAL.EQ.0.0D+00 .AND. LAA1.EQ.0) .AND.
     &             (PBL.EQ.0.0D+00 .AND. LBB1.EQ.0)) THEN
               ES = ES+BICOE(LAA,LA1)*BICOE(LBB,LB1)
     &              *GINT(LAB-LAA1-LBB1)
C
               ELSE IF (PAL.EQ.0.0D+00 .AND. LAA1.EQ.0) THEN
               ES = ES+BICOE(LAA,LA1)*BICOE(LBB,LB1)*PBL**LBB1
     &              *GINT(LAB-LAA1-LBB1)
C
               ELSE IF (PBL.EQ.0.0D+00 .AND. LBB1.EQ.0) THEN
               ES = ES+BICOE(LAA,LA1)*BICOE(LBB,LB1)*PAL**LAA1
     &              *GINT(LAB-LAA1-LBB1)
C
               ELSE
               ES = ES+BICOE(LAA,LA1)*BICOE(LBB,LB1)*PAL**LAA1*PBL**LBB1
     &              *GINT(LAB-LAA1-LBB1)
C
               ENDIF
            ENDDO
         ENDDO
         WS = WS*ES*EXP(-GXI*(PAL-PBL)**2)
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1CDDRV (IATM,NGI,NGJ,X,Y,Z)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER (MXATM=2000, MXC=21, MXT=4, MXM=12)
      PARAMETER ( MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTA,NTB,INTTYP,MMAX
      COMMON /MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
      DIMENSION X(MXATM),Y(MXATM),Z(MXATM)
      DIMENSION CC(3)
C
      DO I = 1,MXC
         DO IX= 1,3
            DO J = 1,MXC
               GMCP1C(I,IX,J) = 0
               GMCP1D(I,IX,J) = 0
            ENDDO
         ENDDO
      ENDDO
C
C     -- LOOP FOR MCP ELEMENTS
C     -- LOOP FOR MCP ATOMS IN EACH MCP ELEMENT
C     -- IATOM IS A SERIAL NUMBER OF ATOM
C
      DO IELEM = 1,IPSET
         DO IMCP = 1,NPOS ( IELEM )
            IATOM = NSIT ( IMCP, IELEM )
            IF (IATOM .EQ. IATM) THEN
               CC(1)=X(IATOM)
               CC(2)=Y(IATOM)
               CC(3)=Z(IATOM)
C     -- ALL COEFFICIENTS IN C AND D TERMS --
               CALL MCP0PREP (CC)
C     -- INITIAL INTEGRAL --
               CALL MCP0SSSC (1,NGI,NGJ)
               CALL MCP0SSSD ( )
C     -- RECURSIVE FORMULA --
               CALL MCP1RC  (NGI,NGJ,AGJ)
            ENDIF
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP1RC  (NGACS,NGBCS,ZB)
C=======================================================================
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER (MXT=4, MXM=12)
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      LOGICAL GOPARR,DSKWRK,MASWRK

      IF ( NGACS.EQ.1 ) THEN
         IF (NTERMA.NE.0) CALL MCP1CS (ZB)
         IF (NTERMB.NE.0) CALL MCP1DS
      ELSE IF ( NGACS.EQ.3 ) THEN
         IF (NTERMA.NE.0) CALL MCP1CP (NGACS,NGBCS,ZB)
         IF (NTERMB.NE.0) CALL MCP1DP (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.6 ) THEN
         IF (NTERMA.NE.0) CALL MCP1CD (NGACS,NGBCS,ZB)
         IF (NTERMB.NE.0) CALL MCP1DD (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.10) THEN
         IF (NTERMA.NE.0) CALL MCP1CF (NGACS,NGBCS,ZB)
         IF (NTERMB.NE.0) CALL MCP1DF (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.15) THEN
         IF (NTERMA.NE.0) CALL MCP1CG (NGACS,NGBCS,ZB)
         IF (NTERMB.NE.0) CALL MCP1DG (NGACS,NGBCS)
C     L-SHELL
      ELSE IF ( NGACS.EQ.4 ) THEN
         IF (NTERMA.NE.0) CALL MCP1CS (ZB)
         IF (NTERMB.NE.0) CALL MCP1DS
         IF (NTERMA.NE.0) CALL MCP1CP (NGACS,NGBCS,ZB)
         IF (NTERMB.NE.0) CALL MCP1DP (NGACS,NGBCS)
      ELSE
         GOTO 999
      ENDIF
      RETURN
C     --------------------------------
 999  CONTINUE
      IF (MASWRK) THEN
         WRITE(6,*) 'MCP ROUTINE: SORRY..., NOT SUPPORTED... (MCP1)'
      ENDIF
      CALL ABRT
      END
C=======================================================================
      SUBROUTINE MCPINFO
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXCS=1000,MXATM=2000 )
      PARAMETER ( MXSH=5000, MXGTOT=20000 )
      PARAMETER ( MXMPA=3*MXATM,MXMPSH=2*MXATM, MXMPGT=5*MXMPSH )
      PARAMETER ( MXT1=5,MXIO=202,MXNT=40,MXELM=30,MXPOS=100 )
      PARAMETER ( MAXSP=5 )
      COMMON /ABDATA/ AG(MXNT,MXCS),CGI(MXNT,MXCS),
     &                X(MXATM),Y(MXATM),Z(MXATM),
     &                NATOM(MXATM),MATOM(MXCS),NG(MXCS),MG(MXCS),
     &                NT(MXCS),MCO,NAO,NCS,NTM
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      COMMON /INFOA / NATOMS,ICH,MUL,NBASIS,NQMT,NE,NA,NB,
     &                ZAN(MXATM),C(3,MXATM),IAN(MXATM)
C
C     MODEL-POTENTIAL PARAMETERS AND CORE-SHELL BASIS-SET INFORMATION
C
      COMMON /NSHEL / EX(MXGTOT),CS(MXGTOT),CP(MXGTOT),CD(MXGTOT),
     &                CF(MXGTOT),CG(MXGTOT),CH(MXGTOT),CI(MXGTOT),
     &                KSTART(MXSH),KATOM(MXSH),KTYPE(MXSH),KNG(MXSH),
     &                KLOC(MXSH),KMIN(MXSH),KMAX(MXSH),NSHELL
      COMMON /MMP1  / AN0(MXMPA),ALPN0(MXMPA),AN1(MXMPA),ALPN1(MXMPA),
     &                MPSKP(MXATM),NOAN0(MXATM),NOAN1(MXATM)
      COMMON /MMP2  / BPAR(MXMPSH),EXPMP(MXMPGT),CSMP(MXMPGT),
     &                CPMP(MXMPGT),CDMP(MXMPGT),CFMP(MXMPGT),
     &                MPSKIP(MXATM),NOCOSH(MXATM),MPKSTA(MXMPSH),
     &                MPKNG(MXMPSH),MPKTYP(MXMPSH),MPKMIN(MXMPSH),
     &                MPKMAX(MXMPSH),MPKLOC(MXMPSH)
C
      DIMENSION NSP(MAXSP), MSP(MAXSP)
      DATA (NSP(I),I=1,MAXSP)/1,3,6,10,15/
      DATA (MSP(I),I=1,MAXSP)/0,1,4,10,20/
C
C     POWERS OF CARTESIAN GAUSSIAN FUNCTION OF VALENCE ORBITALS
C
      DIMENSION LMNSPC(3,20)
      DATA  ((LMNSPC(J,I),J=1,3),I=1,20)/
     1      0,0,0,
     2      1,0,0,0,1,0,0,0,1,
     3      2,0,0,0,2,0,0,0,2,1,1,0,0,1,1,1,0,1,
     4      3,0,0,0,3,0,0,0,3,2,1,0,0,2,1,1,0,2,1,2,0,0,1,2,2,0,1,1,1,1/
      DIMENSION AAA(3)
      DATA AAA /0.0,0.0,0.0/
      DIMENSION OEMP1(MXNT),CEMP1(MXNT)
      DIMENSION OOE1(MXNT,90),CCE1(MXNT,90)
      DIMENSION MPOS1(90),IPOS1(MXPOS,90),COEBK1(90),NGC1(90),NTC1(90)
      DIMENSION IZNUC(MXELM)
C
      DO I=1,90
         MPOS1(I)  = 0
         COEBK1(I) = 0.0D+00
      ENDDO
      DO I=1,MXELM
         IZNUC(I) = 0
      ENDDO
C
C     NUCLEAR POSITIONS SET
C
      NATM=NATOMS
      NTM = NATM
      DO IATM=1,NATM
         NATOM(IATM) = IAN(IATM)
         X(IATM) = C(1,IATM)
         Y(IATM) = C(2,IATM)
         Z(IATM) = C(3,IATM)
      ENDDO
C
C     VALENCE ORBITALS SET
C
      NCS=NSHELL
      DO J=1,NCS
         MATOM(J)=KATOM(J)
         NT(J)=KNG(J)
         NG(J)=KTYPE(J)
         IF(KTYPE(J).EQ.2) NG(J)=3
         IF(KMIN(J).EQ.1 .AND. KMAX(J).EQ.4) NG(J)=4
         IF(KTYPE(J).EQ.3) NG(J)=6
         IF(KTYPE(J).EQ.4) NG(J)=10
         IF(KTYPE(J).EQ.5) NG(J)=15
         J1=KSTART(J)
         DO I=1,NT(J)
            AG (I,J) = EX(J1-1+I)
            IF (NG(J).EQ. 1) CGI(I,J) = CS(J1-1+I)
            IF (NG(J).EQ. 3) CGI(I,J) = CP(J1-1+I)
            IF (NG(J).EQ. 4) THEN
                             CGI(I,J) = CS(J1-1+I)
                       CGI(I+NT(J),J) = CP(J1-1+I)
               IF (I+NT(J).GT.MXNT) THEN
                  WRITE(6,*) '# OF SHELL IS TOO LARGE!!'
                  CALL ABRT
               ENDIF
            ENDIF
            IF (NG(J).EQ. 6) CGI(I,J) = CD(J1-1+I)
            IF (NG(J).EQ.10) CGI(I,J) = CF(J1-1+I)
            IF (NG(J).EQ.15) CGI(I,J) = CG(J1-1+I)
         ENDDO
      ENDDO
C
C     MCP DATA SET
C
      IELM=0
      N0=0
      N1=0
      DO IATM=1,NATM
         NATOM(IATM)=INT(ZAN(IATM)+0.01D+00)
      ENDDO
C
      DO IATM=1,NATM
         IF (MPSKP(IATM).EQ.0) THEN
            IF (IELM.GE.1) THEN
               DO J=1,IELM
                  IF (IAN(IATM).EQ.IZNUC(J)) THEN
                     NPOS(J) = NPOS(J)+1
                     NSIT(NPOS(J),J) = IATM
                     N0=N0+NOAN0(IATM)
                     N1=N1+NOAN1(IATM)
                     GOTO 10
                  ENDIF
               ENDDO
C
C     ADDING NEW MCP
C
               IELM=IELM+1
               IZNUC(IELM)  = IAN(IATM)
               NPOS(IELM)   = 1
               NSIT(1,IELM) = IATM
               NTERMA(IELM) = NOAN0(IATM)
               NTERMB(IELM) = NOAN1(IATM)
               NEFF  (IELM) = NATOM(IATM)
               DO K=1,NTERMA(IELM)
                  N0=N0+1
                  ALPHA(K,IELM) = ALPN0(N0)
                  COEFA(K,IELM) =   AN0(N0)
               ENDDO
               DO K=1,NTERMB(IELM)
                  N1=N1+1
                  ALPHB(K,IELM) = ALPN1(N1)
                  COEFB(K,IELM) =   AN1(N1)
               ENDDO
C
C     FIRST MCP SET
C
            ELSE
               IELM=1
               IZNUC(IELM)  = IAN(IATM)
               NPOS(IELM)   = 1
               NSIT(1,IELM) = IATM
               NTERMA(IELM) = NOAN0(IATM)
               NTERMB(IELM) = NOAN1(IATM)
               NEFF  (IELM) = NATOM(IATM)
               DO K=1,NTERMA(IELM)
                  N0=N0+1
                  ALPHA(K,IELM) = ALPN0(N0)
                  COEFA(K,IELM) =   AN0(N0)
               ENDDO
               DO K=1,NTERMB(IELM)
                  N1=N1+1
                  ALPHB(K,IELM) = ALPN1(N1)
                  COEFB(K,IELM) =   AN1(N1)
               ENDDO
            ENDIF
 10         CONTINUE
         ENDIF
      ENDDO
      IPSET = IELM
C
C     CORE ORBITALS SET
C
      EPS=1.0D-6
      IOSET=0
      ICOSH=0
      NCO=0
C
      DO IATM=1,NATM
         IF (MPSKIP(IATM).EQ.0) THEN
            IF (IOSET.GE.1) THEN
               DO ICCS=1,NOCOSH(IATM)
                  ICOSH=ICOSH+1
                  DO J=1,IOSET
                     IF (ABS(COEBK1(J)-BPAR(ICOSH)).LE.EPS) THEN
C
C     SKIP EXISTING CORE ORBITAL SET
C
                        MTYPE=MPKTYP(ICOSH)
                        IF(MTYPE.EQ.1) NGC2=1
                        IF(MTYPE.EQ.2) NGC2=3
                        IF(MTYPE.EQ.3) NGC2=6
                        IF(MTYPE.EQ.4) NGC2=10
                        NCO=NCO+NGC2
                        MPOS1(J) = MPOS1(J)+1
                        IPOS1(MPOS1(J),J) = IATM
                        GOTO 20
                     ENDIF
                  ENDDO
C
C     ADDING NEW CORE ORBITAL SET
C
                  MTYPE=MPKTYP(ICOSH)
                  IF(MTYPE.EQ.1) NGC2=1
                  IF(MTYPE.EQ.2) NGC2=3
                  IF(MTYPE.EQ.3) NGC2=6
                  IF(MTYPE.EQ.4) NGC2=10
                  NCO=NCO+NGC2
                  J1=MPKSTA(ICOSH)
                  NTC2=MPKNG(ICOSH)
                  DO I=1,NTC2
                     OEMP1(I) = EXPMP(J1-1+I)
                     IF (MTYPE.EQ.1) CEMP1(I)=CSMP(J1-1+I)
                     IF (MTYPE.EQ.2) CEMP1(I)=CPMP(J1-1+I)
                     IF (MTYPE.EQ.3) CEMP1(I)=CDMP(J1-1+I)
                     IF (MTYPE.EQ.4) CEMP1(I)=CFMP(J1-1+I)
                  ENDDO
                  IOSET=IOSET+1
                  MPOS1(IOSET)=1
                  IPOS1(1,IOSET)=IATM
                  COEBK1(IOSET)=BPAR(ICOSH)
                  NGC1(IOSET)  =NGC2
                  NTC1(IOSET)  =NTC2
                  DO I=1,NTC2
                     OOE1(I,IOSET)=OEMP1(I)
                     CCE1(I,IOSET)=CEMP1(I)
                  ENDDO
 20               CONTINUE
               ENDDO
            ELSE
C
C     FIRST CORE ORBITAL SET
C
               DO ICCS=1,NOCOSH(IATM)
                  ICOSH=ICOSH+1
                  MTYPE=MPKTYP(ICOSH)
                  IF(MTYPE.EQ.1) NGC2=1
                  IF(MTYPE.EQ.2) NGC2=3
                  IF(MTYPE.EQ.3) NGC2=6
                  IF(MTYPE.EQ.4) NGC2=10
                  NCO=NCO+NGC2
                  J1=MPKSTA(ICOSH)
                  NTC2=MPKNG(ICOSH)
                  DO I=1,NTC2
                     OEMP1(I) = EXPMP(J1-1+I)
                     IF (MTYPE.EQ.1) CEMP1(I)=CSMP(J1-1+I)
                     IF (MTYPE.EQ.2) CEMP1(I)=CPMP(J1-1+I)
                     IF (MTYPE.EQ.3) CEMP1(I)=CDMP(J1-1+I)
                     IF (MTYPE.EQ.4) CEMP1(I)=CFMP(J1-1+I)
                  ENDDO
                  IOSET=IOSET+1
                  MPOS1(IOSET)=1
                  IPOS1(1,IOSET)= IATM
                  COEBK1(IOSET) = BPAR(ICOSH)
                  NGC1(IOSET)   = NGC2
                  NTC1(IOSET)   = NTC2
                  DO I=1,NTC2
                     OOE1(I,IOSET)=OEMP1(I)
                     CCE1(I,IOSET)=CEMP1(I)
                  ENDDO
               ENDDO
            ENDIF
C
         ENDIF
      ENDDO
C
C     EACH SHELL -----> ALL COMPONENTS
C
      IO=0
      DO IOS=1,IOSET
         NGC2=NGC1(IOS)
         IF (NGC2.EQ. 1) MTYPE=1
         IF (NGC2.EQ. 3) MTYPE=2
         IF (NGC2.EQ. 6) MTYPE=3
         IF (NGC2.EQ.10) MTYPE=4
         MM=MSP(MTYPE)
         DO IC=1,NGC2
            IO=IO+1
            MPOS(IO)=MPOS1(IOS)
            DO IPM=1,MPOS1(IOS)
               IPOS(IPM,IO)=IPOS1(IPM,IOS)
            ENDDO
            COEBK(IO)=COEBK1(IOS)
            NGC  (IO)=NGC1  (IOS)
            NTC  (IO)=NTC1  (IOS)
            MMM=MM+IC
            NQNDMP(1,IO)=LMNSPC(1,MMM)
            NQNDMP(2,IO)=LMNSPC(2,MMM)
            NQNDMP(3,IO)=LMNSPC(3,MMM)
            NQNDMP(4,IO)=NTC1(IOS)
            DO I=1,NTC1(IOS)
               OEMP(I,IO)=OOE1(I,IOS)
               CEMP(I,IO)=CCE1(I,IOS)
            ENDDO
         ENDDO
      ENDDO
      IOSET=IO
      MCO=NCO
C
C     SET VALENCE ORBITALS
C
      IAO=0
      DO ICS=1,NCS
         IMCS=0
         DO I=1,MAXSP
            IF (NG(ICS).EQ.NSP(I)) THEN
               IMCS=I
            ENDIF
         ENDDO
C     L-SHELL (IMCS=10 MEANS L-SHELL)
         IF (NG(ICS).EQ.4) IMCS=10
         IF (IMCS.EQ.0) THEN
            STOP '***** ERROR IN MCPINT: NG IS NOT 1, 3, 6, 10, OR 15'
         ENDIF
         IF (IMCS.EQ.10) THEN
            MG(ICS)=MSP(1)
         ELSE
            MG(ICS)=MSP(IMCS)
         ENDIF
         IAO=IAO+NG(ICS)
      ENDDO
      NAO=IAO
C
C     RENORMALIZATION OF CORE ORBITALS
C
      DO I=1,IOSET
         NT1=NQNDMP(4,I)
         WS = 0.0D+00
         DO II=1,NT1
            DO JJ=1,II
               ZETA = OEMP(II,I)+OEMP(JJ,I)
               GXI  = OEMP(II,I)*OEMP(JJ,I)/ZETA
               CALL OVLAPV(NQNDMP(1,I),NQNDMP(1,I),AAA,AAA,
     &              ZETA,GXI,WWS)
               IF (II.EQ.JJ) THEN
                  WS = WS + WWS*CEMP(II,I)*CEMP(JJ,I)
               ELSE
                  WS = WS + WWS*CEMP(II,I)*CEMP(JJ,I)*2.0D+00
               ENDIF
            ENDDO
         ENDDO
         CNORM=1.0D+00/SQRT(WS)
         DO J=1,NT1
            CEMP(J,I)=CEMP(J,I)*CNORM
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0CDDRV (NGI,NGJ,X,Y,Z)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXATM=2000, MXC=21, MXT=4, MXM=12 )
      PARAMETER ( MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                AA(3),BB(3),AGI,AGJ,NTERMA(MXELM),NTERMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTA,NTB,INTTYP,MMAX
      COMMON /MCPOUT/ GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DIMENSION X(MXATM),Y(MXATM),Z(MXATM)
      DIMENSION CC(3)
C
      DO I = 1,MXC
         DO J = 1,MXC
            GMCP0C(I,J) = 0
            GMCP0D(I,J) = 0
         ENDDO
      ENDDO
C
C     -- LOOP FOR MCP ELEMENTS
C     -- LOOP FOR MCP ATOMS IN EACH MCP ELEMENT
C     -- IATOM IS A SERIAL NUMBER OF ATOM
C
      DO IELEM = 1,IPSET
         DO IMCP = 1,NPOS ( IELEM )
            IATOM = NSIT ( IMCP, IELEM )
            CC(1)=X(IATOM)
            CC(2)=Y(IATOM)
            CC(3)=Z(IATOM)
C     -- ALL COEFFICIENTS IN C AND D TERMS --
            CALL MCP0PREP (CC)
C     -- INITIAL INTEGRAL --
            CALL MCP0SSSC (0,NGI,NGJ)
            CALL MCP0SSSD ( )
C     -- RECURSIVE FORMULA --
            CALL MCP0RC  (NGI,NGJ)
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0PREP (CC)
C=======================================================================
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER ( MXT=4, MXM=12 )
      PARAMETER ( MXT1=5,MXIO=202,MXELM=30,MXPOS=100,MXNT=40 )
      DOUBLE PRECISION CC(3)
      COMMON /MCPDAT/ COEBK(MXIO),OEMP(MXNT,MXIO),CEMP(MXNT,MXIO),
     &                ALPHA(MXT1,MXELM),COEFA(MXT1,MXELM),
     &                ALPHB(MXT1,MXELM),COEFB(MXT1,MXELM),
     &                CA(3),CB(3),ZA,ZB,MCPNTEMA(MXELM),MCPNTEMB(MXELM),
     &                NSIT(MXPOS,MXELM),NPOS(MXELM),NEFF(MXELM),
     &                NQNDMP(4,MXIO),IPOS(MXPOS,MXIO),MPOS(MXIO),
     &                NTC(MXIO),NGC(MXIO),IPSET,IOSET,NCO,NATM
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON /MCPITMG/XYZGC(MXT,3)
C
      ZEFF = NEFF(IELEM)
      NTERMA = MCPNTEMA(IELEM)
      NTERMB = MCPNTEMB(IELEM)
C
      DO IT=1,NTERMA
         EXA(IT)  = ALPHA(IT,IELEM)
         COA(IT)  = COEFA(IT,IELEM)
      ENDDO
C
      DO IT=1,NTERMB
         EXB(IT)  = ALPHB(IT,IELEM)
         COB(IT)  = COEFB(IT,IELEM)
      ENDDO
C
      ZETA = ZA + ZB
      XI   = ZA*ZB / ZETA
      AB2  = 0
      CB2  = 0
C
      DO I=1,3
         XYZCB(I) = CC(I) - CB(I)
         CB2      = CB2 + XYZCB(I)**2
         AB2      = AB2 + ( CA(I) - CB(I) )**2
      ENDDO
C
C     ------ CTERM ------
      DO IT=1,NTERMA
         AD2(IT) = 0
         QC2(IT) = 0
      ENDDO
      DO IT=1,NTERMA
         ZETAD(IT)    = EXA(IT) + ZB
         ETA(IT)      = EXA(IT) * ZB/ ZETAD(IT)
         XIC(IT)      = ZA*ZETAD(IT) / (ZA + ZETAD(IT) )
         ZETACABC(IT) = ZA + ZETAD(IT)
         DO IX=1,3
            D            = ( ZB*CB(IX)+EXA(IT)*CC(IX) ) / ZETAD(IT)
            AD2(IT)      = AD2(IT) + ( CA(IX)-D )**2
            Q            = ( ZA*CA(IX)+ZETAD(IT)*D ) / ( ZA+ZETAD(IT) )
            XYZQA(IT,IX) = Q - CA(IX)
            XYZQC(IT,IX) = Q - CC(IX)
            XYZQD(IT,IX) = Q - D
            QC2(IT)      = QC2(IT) + XYZQC(IT,IX)*XYZQC(IT,IX)
         ENDDO
      ENDDO
C
C     ------ DTERM ------
      DO IT=1,NTERMB
         ZETADABC(IT) = ZETA + EXB(IT)
         ETAD(IT)     = EXB(IT)*ZETA / ZETADABC(IT)
         PC2=0
         DO IX=1,3
            P            = ( ZA*CA(IX)+ZB*CB(IX) ) / ZETA
            PC2          = PC2 + (P-CC(IX))**2
            G            = ( ZA*CA(IX)+ZB*CB(IX)+EXB(IT)*CC(IX) )
     &                     / ZETADABC(IT)
            XYZGA(IT,IX) = G - CA(IX)
            XYZGB(IT,IX) = G - CB(IX)
            XYZGC(IT,IX) = G - CC(IX)
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0SSSC (ID,NGACS,NGBCS)
C=======================================================================
C
C     IF ID=0, INITIAL INTEGRALS FOR ENERGY CALCULATIONS ARE PREPARED.
C     IF ID=1, INITIAL INTEGRALS FOR GRADIENT CALCULATIONS ARE PREPARED.
C     IF ID=2, INITIAL INTEGRALS FOR HESSIAN CALCULATIONS ARE PREPARED.
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXT=4, MXM=12 )
      PARAMETER ( PI=3.1415926535897932D+00 )
      DOUBLE PRECISION VFMT(0:MXM)
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C
      MM=NGACS/3
      IF (NGACS.EQ.15) MM=MM-1
      IF (NGACS.EQ.21) MM=MM-2
      MMAX=MM+NGBCS/3
      IF (NGBCS.EQ.15) MMAX=MMAX-1
      IF (NGBCS.EQ.21) MMAX=MMAX-2
      MMAX=MMAX+ID
C
      DO IT=1,NTERMA
         U = ZETACABC(IT) * QC2(IT)
         COEF = 2 * (PI/ZETACABC(IT)) * EXP( -XIC(IT)*AD2(IT) )
         CALL FMTVAL(VFMT, MMAX, U, COEF)
         DO IM=0,MMAX
            SSSC(IM,IT) = VFMT(IM)
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0SSSD ( )
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      PARAMETER ( MXT=4, MXM=12 )
      PARAMETER ( PI=3.1415926535897932D+00 )
      COMMON /MCPITM/ ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),
     &                ZEFF,EXA(MXT),EXB(MXT),COA(MXT),COB(MXT),ETA(MXT),
     &                ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),
     &                XYZCB(3),XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),
     &                XYZGA(MXT,3),XYZGB(MXT,3),
     &                SSSC(0:MXM,MXT),SSSD(MXT),
     &                IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      DO IT=1,NTERMB
         SSSD(IT) = ( PI/ZETADABC(IT) )**(1.5D+00)
     &            * EXP( -XI*AB2 ) * EXP( -ETAD(IT)*PC2 )
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0RC  (NGACS,NGBCS)
C=======================================================================
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      PARAMETER (MXT=4, MXM=12)
      COMMON/MCPITM/ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),
     &  QC2(MXT),ZEFF,EXA(MXT),EXB(MXT),COA(MXT),
     &  COB(MXT),ETA(MXT),ZETACABC(MXT),ETAD(MXT),
     &  ZETADABC(MXT),ZETAD(MXT),XYZCB(3),XYZQA(MXT,3),
     &  XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),
     &  XYZGB(MXT,3),SSSC(0:MXM,MXT),SSSD(MXT),
     &  IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      LOGICAL GOPARR,DSKWRK,MASWRK

      IF ( NGACS.EQ.1 ) THEN
         IF (NTERMA.NE.0) CALL MCP0CS
         IF (NTERMB.NE.0) CALL MCP0DS
      ELSE IF ( NGACS.EQ.3 ) THEN
         IF (NTERMA.NE.0) CALL MCP0CP (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DP (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.6 ) THEN
         IF (NTERMA.NE.0) CALL MCP0CD (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DD (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.10) THEN
         IF (NTERMA.NE.0) CALL MCP0CF (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DF (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.15) THEN
         IF (NTERMA.NE.0) CALL MCP0CG (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DG (NGACS,NGBCS)
      ELSE IF ( NGACS.EQ.21) THEN
         IF (NTERMA.NE.0) CALL MCP0CH (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DH (NGACS,NGBCS)
C     L-SHELL
      ELSE IF ( NGACS.EQ.4 ) THEN
         IF (NTERMA.NE.0) CALL MCP0CS
         IF (NTERMB.NE.0) CALL MCP0DS
         IF (NTERMA.NE.0) CALL MCP0CP (NGACS,NGBCS)
         IF (NTERMB.NE.0) CALL MCP0DP (NGACS,NGBCS)
      ELSE
         GOTO 999
      ENDIF
      RETURN
C
  999 CONTINUE
      IF (MASWRK) THEN
         WRITE(6,*) 'MCP ROUTINE: SORRY..., NOT SUPPORTED... (MCP0)'
      ENDIF
      CALL ABRT
      END
C=======================================================================
      SUBROUTINE FMTVAL ( FMT_BUFF, MVALUE, TVALUE, CONST )
C=======================================================================
      IMPLICIT DOUBLE PRECISION ( A-H, O-Z )
      PARAMETER (MXM=12)
      DOUBLE PRECISION FMT_BUFF(0:MXM)
      DOUBLE PRECISION FVALUE  (0:MXM)
      DOUBLE PRECISION TVALUE, CONST
      INTEGER M
      CALL FMT (FVALUE,MVALUE,TVALUE)
      DO M = 0, MVALUE
         FMT_BUFF (M) = CONST * FVALUE (M)
      ENDDO
      END
C=======================================================================
      SUBROUTINE INITIALIZE_AUXILIARY_INTEGRAL
C=======================================================================
C     FM(T)
C     4-TERM TAYLOR EXPANSION METHOD
C     AUXILIARY_INTEGRAL_TABLE
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER FMT_MAX_M,FMT_N_STEP
      INTEGER I,J,M,NU
      DOUBLE PRECISION FMT_STEP_SIZE
      DOUBLE PRECISION FMT_TABLE
      DOUBLE PRECISION EPS,T,EXPT,T2,TERM,FUNC
C
C     PARAMETER ( FMT_M=14 )
C     PARAMETER ( FMT_INV_D=2**9 )
C     PARAMETER ( FMT_MAX_M=FMT_M+3 )
C     PARAMETER ( FMT_T=2*FMT_M+36 )
C     PARAMETER ( FMT_N_STEP=FMT_T*FMT_INV_D )
C     PARAMETER ( FMT_STEP_SIZE=DBLE(FMT_T)/FMT_N_STEP )
C     PARAMETER ( THR_ZERO=1.0D-17 )
C
      PARAMETER ( FMT_MAX_M=17 )
      PARAMETER ( FMT_N_STEP=32768 )
      PARAMETER ( FMT_STEP_SIZE=1.0D+00/512 )
      PARAMETER ( THR_ZERO=1.0D-17 )
C
      COMMON /FMTTB/ FMT_TABLE(0:FMT_MAX_M,0:FMT_N_STEP)
C
      DO M=0,FMT_MAX_M
         FMT_TABLE(M,0)=1.0D+00/(2*M+1)
      ENDDO
      M=FMT_MAX_M
      DO J=1,FMT_N_STEP
         T=FMT_STEP_SIZE*J
         EXPT=EXP(-T)
         NU=2*M+1
         T2=T*2.0D+00
         EPS=(EXPT/T2)*THR_ZERO
         TERM=1.0D+00/NU
         FUNC=TERM
         I=NU
 1       CONTINUE
         I=I+2
         TERM=TERM*T2/I
         FUNC=FUNC+TERM
         IF (TERM.GT.EPS) GOTO 1
         FMT_TABLE(M,J)=EXPT*FUNC
         DO I=M-1,0,-1
            NU=NU-2
            FMT_TABLE(I,J)=(EXPT+T2*FMT_TABLE(I+1,J))/NU
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE FMT(F,M,T)
C=======================================================================
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER FMT_MAX_M,FMT_N_STEP
      INTEGER M
      INTEGER TS,I
      DOUBLE PRECISION INV2,INV6,FMT_STEP_SIZE,FMT_INV_STEP_SIZE
      DOUBLE PRECISION FMT_TABLE
      DOUBLE PRECISION T
      DOUBLE PRECISION F(0:M)
      DOUBLE PRECISION D,T_INV,NU
C
      PARAMETER ( PI=3.1415926535897932D+00 )
      PARAMETER ( PI_DIV2=PI/2.0D+00 )
      PARAMETER ( INV2=0.5D+00 )
      PARAMETER ( INV6=0.1666666666666D+00 )
C
C     PARAMETER ( FMT_M=14 )
C     PARAMETER ( FMT_INV_D=2**9 )
C     PARAMETER ( FMT_MAX_M=FMT_M+3 )
C     PARAMETER ( FMT_T=2*FMT_M+36 )
C     PARAMETER ( FMT_N_STEP=FMT_T*FMT_INV_D )
C     PARAMETER ( FMT_STEP_SIZE=DBLE(FMT_T)/FMT_N_STEP )
C
      PARAMETER ( FMT_MAX_M=17 )
      PARAMETER ( FMT_N_STEP=32768 )
      PARAMETER ( FMT_STEP_SIZE=1.0D+00/512 )
      PARAMETER ( FMT_INV_STEP_SIZE=1.0D+00/FMT_STEP_SIZE )
C
      COMMON /FMTTB/ FMT_TABLE(0:FMT_MAX_M,0:FMT_N_STEP)
C
      IF (T .LE. (2*M+36)) THEN
         TS=INT(0.5D+00+T*FMT_INV_STEP_SIZE)
         D=TS*FMT_STEP_SIZE-T
         DO I=0,M
            F(I)=((FMT_TABLE(I+3,TS)*INV6*D
     &            +FMT_TABLE(I+2,TS)*INV2)*D
     &            +FMT_TABLE(I+1,TS))*D
     &            +FMT_TABLE(I  ,TS)
         ENDDO
      ELSE
         T_INV=INV2/T
         F(0)=SQRT(PI_DIV2*T_INV)
         NU=1.0D+00
         DO I=1,M
            F(I)=T_INV*NU*F(I-1)
            NU=2.0D+00+NU
         ENDDO
      ENDIF
      END
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C                    MCP C-TERM ENERGY CALCULATION                    @C
C     ~ LEVEL1 RECURSION FORMULA : UP TO H FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.04.26                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP0CS
C=======================================================================
C
C     LEVEL 1 RECURSION (S|0|S): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DO I = 1,NTERMA
         IF (CB2*ETA(I).LE.7.0D+2) THEN
            VAL = -ZEFF*SSSC(0,I)/EXP(CB2*ETA(I))
            GMCP0C(1,1) = GMCP0C(1,1) + VAL * COEFA(I)
         ENDIF
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0CP (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (P|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (P|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSC(0)
C
         DO IX = 1,NCA
            DO I = 1,NTERMA
               IF (CB2*ETA(I).LE.7.0D+2) THEN
                  VAL = -ZEFF*PSSC(0,I,IX,1)/EXP(CB2*ETA(I))
                  GMCP0C(IX,1) = GMCP0C(IX,1) + VAL * COEFA(I)
               ENDIF
            ENDDO
         ENDDO
C
C     (P|0|P) TYPE
C
      ELSE
C
         CALL MCP0PSC(1)
         CALL MCP0PPC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                    VAL = -ZEFF*
     &                   (                             PSPC(0,I,IX1,IX2)
     &                    + EXA(I)/ZETAD(I)*XYZCB(IX2)*PSSC(0,I,IX1,  1)
     &                   )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0CD (NCA,NCB)
C=======================================================================
C
C LEVEL 1 RECURSION (D|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DIMENSION IXY(6,2)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
C
C     (D|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSC(1)
         CALL MCP0DSC(0)
C
         DO IX = 1,NCA
            DO I = 1,NTERMA
               IF (CB2*ETA(I).LE.7.0D+2) THEN
                  VAL = -ZEFF*DSSC(0,I,IX,1)/EXP(CB2*ETA(I))
                  GMCP0C(IX,1) = GMCP0C(IX,1) + VAL * COEFA(I)
               ENDIF
            ENDDO
         ENDDO
C
C     (D|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSC(2)
         CALL MCP0DSC(1)
         CALL MCP0DPC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                            DSPC(0,I,IX1,IX2)
     &                    + EXA(I)/ZETAD(I)*XYZCB(IX2)*DSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (D|0|D) TYPE
C
      ELSE
C
         CALL MCP0PSC(3)
         CALL MCP0DSC(2)
         CALL MCP0PPC(1)
         CALL MCP0DPC(1)
         CALL MCP0DDC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           DSDC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*DSPC(0,I,IX1, J2)
     &                                    + XYZCB(J2)*DSPC(0,I,IX1, J1))
     &                     + (EXA(I)/ZETAD(I))**2*
     &                            XYZCB(J1)*XYZCB(J2)*DSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0CF (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (F|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DIMENSION IXY(6,2),IXYZ(10,6)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
C
C     (F|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSC(2)
         CALL MCP0DSC(1)
         CALL MCP0FSC(0)
C
         DO IX = 1,NCA
            DO I = 1,NTERMA
               IF (CB2*ETA(I).LE.7.0D+2) THEN
                  VAL = -ZEFF*FSSC(0,I,IX,1)/EXP(CB2*ETA(I))
                  GMCP0C(IX,1) = GMCP0C(IX,1) + VAL * COEFA(I)
               ENDIF
            ENDDO
         ENDDO
C
C     (F|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSC(3)
         CALL MCP0DSC(2)
         CALL MCP0FSC(1)
         CALL MCP0FPC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                            FSPC(0,I,IX1,IX2)
     &                    + EXA(I)/ZETAD(I)*XYZCB(IX2)*FSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (F|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSC(4)
         CALL MCP0DSC(3)
         CALL MCP0FSC(2)
         CALL MCP0DPC(1)
         CALL MCP0FPC(1)
         CALL MCP0FDC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           FSDC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*FSPC(0,I,IX1, J2)
     &                                    + XYZCB(J2)*FSPC(0,I,IX1, J1))
     &                     + (EXA(I)/ZETAD(I))**2*
     &                            XYZCB(J1)*XYZCB(J2)*FSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (F|0|F) TYPE
C
      ELSE
C
         CALL MCP0PSC(5)
         CALL MCP0DSC(4)
         CALL MCP0FSC(3)
         CALL MCP0PPC(2)
         CALL MCP0DPC(2)
         CALL MCP0FPC(2)
         CALL MCP0DDC(1)
         CALL MCP0FDC(1)
         CALL MCP0FFC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               J13 = IXYZ(IX2,5)
               J23 = IXYZ(IX2,6)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           FSFC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*FSDC(0,I,IX1,J23)
     &                                    + XYZCB(J2)*FSDC(0,I,IX1,J13)
     &                                    + XYZCB(J3)*FSDC(0,I,IX1,J12))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                            XYZCB(J1)*XYZCB(J2)*FSPC(0,I,IX1, J3)
     &                          + XYZCB(J2)*XYZCB(J3)*FSPC(0,I,IX1, J1)
     &                          + XYZCB(J3)*XYZCB(J1)*FSPC(0,I,IX1, J2))
     &                     + (EXA(I)/ZETAD(I))**3*
     &                  XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*FSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0CG (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (G|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
C
C     (G|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSC(3)
         CALL MCP0DSC(2)
         CALL MCP0FSC(1)
         CALL MCP0GSC(0)
C
         DO IX = 1,NCA
            DO I = 1,NTERMA
               IF (CB2*ETA(I).LE.7.0D+2) THEN
                  VAL = -ZEFF*GSSC(0,I,IX,1)/EXP(CB2*ETA(I))
                  GMCP0C(IX,1) = GMCP0C(IX,1) + VAL * COEFA(I)
               ENDIF
            ENDDO
         ENDDO
C
C     (G|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSC(4)
         CALL MCP0DSC(3)
         CALL MCP0FSC(2)
         CALL MCP0GSC(1)
         CALL MCP0GPC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                            GSPC(0,I,IX1,IX2)
     &                    + EXA(I)/ZETAD(I)*XYZCB(IX2)*GSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (G|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSC(5)
         CALL MCP0DSC(4)
         CALL MCP0FSC(3)
         CALL MCP0GSC(2)
         CALL MCP0FPC(1)
         CALL MCP0GPC(1)
         CALL MCP0GDC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           GSDC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*GSPC(0,I,IX1, J2)
     &                                   +  XYZCB(J2)*GSPC(0,I,IX1, J1))
     &                     + (EXA(I)/ZETAD(I))**2*
     &                            XYZCB(J1)*XYZCB(J2)*GSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (G|0|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
         CALL MCP0PSC(6)
         CALL MCP0DSC(5)
         CALL MCP0FSC(4)
         CALL MCP0GSC(3)
         CALL MCP0DPC(2)
         CALL MCP0FPC(2)
         CALL MCP0GPC(2)
         CALL MCP0FDC(1)
         CALL MCP0GDC(1)
         CALL MCP0GFC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               J13 = IXYZ(IX2,5)
               J23 = IXYZ(IX2,6)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           GSFC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*GSDC(0,I,IX1,J23)
     &                                    + XYZCB(J2)*GSDC(0,I,IX1,J13)
     &                                    + XYZCB(J3)*GSDC(0,I,IX1,J12))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                            XYZCB(J1)*XYZCB(J2)*GSPC(0,I,IX1, J3)
     &                          + XYZCB(J2)*XYZCB(J3)*GSPC(0,I,IX1, J1)
     &                          + XYZCB(J3)*XYZCB(J1)*GSPC(0,I,IX1, J2))
     &                     + (EXA(I)/ZETAD(I))**3*
     &                  XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*GSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (G|0|G) TYPE
C
      ELSE
C
         CALL MCP0PSC(7)
         CALL MCP0DSC(6)
         CALL MCP0FSC(5)
         CALL MCP0GSC(4)
         CALL MCP0PPC(3)
         CALL MCP0DPC(3)
         CALL MCP0FPC(3)
         CALL MCP0GPC(3)
         CALL MCP0DDC(2)
         CALL MCP0FDC(2)
         CALL MCP0GDC(2)
         CALL MCP0FFC(1)
         CALL MCP0GFC(1)
         CALL MCP0GGC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1   = IXYZW(IX2,1)
               J2   = IXYZW(IX2,2)
               J3   = IXYZW(IX2,3)
               J4   = IXYZW(IX2,4)
               J12  = IXYZW(IX2,5)
               J13  = IXYZW(IX2,6)
               J14  = IXYZW(IX2,7)
               J23  = IXYZW(IX2,8)
               J24  = IXYZW(IX2,9)
               J34  = IXYZW(IX2,10)
               J123 = IXYZW(IX2,11)
               J124 = IXYZW(IX2,12)
               J134 = IXYZW(IX2,13)
               J234 = IXYZW(IX2,14)
C
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                          GSGC(0,I,IX1, IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                     XYZCB(J1)*GSFC(0,I,IX1,J234)
     &                                   + XYZCB(J2)*GSFC(0,I,IX1,J134)
     &                                   + XYZCB(J3)*GSFC(0,I,IX1,J124)
     &                                   + XYZCB(J4)*GSFC(0,I,IX1,J123))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                           XYZCB(J1)*XYZCB(J2)*GSDC(0,I,IX1, J34)
     &                         + XYZCB(J1)*XYZCB(J3)*GSDC(0,I,IX1, J24)
     &                         + XYZCB(J1)*XYZCB(J4)*GSDC(0,I,IX1, J23)
     &                         + XYZCB(J2)*XYZCB(J3)*GSDC(0,I,IX1, J14)
     &                         + XYZCB(J2)*XYZCB(J4)*GSDC(0,I,IX1, J13)
     &                         + XYZCB(J3)*XYZCB(J4)*GSDC(0,I,IX1, J12))
     &                     + (EXA(I)/ZETAD(I))**3*(
     &                 XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*GSPC(0,I,IX1,  J4)
     &               + XYZCB(J1)*XYZCB(J2)*XYZCB(J4)*GSPC(0,I,IX1,  J3)
     &               + XYZCB(J1)*XYZCB(J3)*XYZCB(J4)*GSPC(0,I,IX1,  J2)
     &               + XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*GSPC(0,I,IX1,  J1))
     &                     + (EXA(I)/ZETAD(I))**4*
     &       XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*GSSC(0,I,IX1,   1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0CH (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (H|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IXYZWV(21,30)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA IXYZWV/
     1   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3,
     2   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 2, 2, 2, 2, 3, 3,
     3   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 2, 2, 2, 3, 3, 3,
     4   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 2, 2, 3, 3, 3, 3,
     5   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 2, 3, 3, 3, 3, 3,
     6   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6,
     7   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6,
     8   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, 6,
     9   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 4, 5, 5, 5, 5, 6,
     &   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 4, 4, 4, 5, 6, 6,
     1   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 4, 4, 5, 5, 6, 6,
     2   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 4, 5, 5, 5, 6, 6,
     3   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 4, 4, 5, 6, 6, 6,
     4   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 4, 5, 5, 6, 6, 6,
     5   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6, 4, 5, 6, 6, 6, 6,
     6   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 7, 7, 8, 9,10,
     7   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 8, 8, 9,10,
     8   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 7, 8, 8, 8, 9,10,
     9   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9,10,
     &   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9,10,
     1   1, 2, 3, 4, 5, 6, 7, 5, 6, 6, 4, 5, 6, 6, 6, 7, 8, 9, 9, 9,10,
     2   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10, 7, 7, 8, 9,10,10,
     3   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10, 7, 8, 8, 9,10,10,
     4   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10, 7, 8, 9, 9,10,10,
     5   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10, 7, 8, 9,10,10,10,
     6   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,11,11,12,13,14,15,
     7   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,11,12,12,13,14,15,
     8   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,11,12,13,13,14,15,
     9   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10,11,12,13,14,14,15,
     &   1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,11,12,13,14,15,15/
C
C     (H|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSC(4)
         CALL MCP0DSC(3)
         CALL MCP0FSC(2)
         CALL MCP0GSC(1)
         CALL MCP0HSC(0)
C
         DO IX = 1,NCA
            DO I = 1,NTERMA
               IF (CB2*ETA(I).LE.7.0D+2) THEN
                  VAL = -ZEFF*HSSC(0,I,IX,1)/EXP(CB2*ETA(I))
                  GMCP0C(IX,1) = GMCP0C(IX,1) + VAL * COEFA(I)
               ENDIF
            ENDDO
         ENDDO
C
C     (H|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSC(5)
         CALL MCP0DSC(4)
         CALL MCP0FSC(3)
         CALL MCP0GSC(2)
         CALL MCP0HSC(1)
         CALL MCP0HPC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                   (                             HSPC(0,I,IX1,IX2)
     &                    + EXA(I)/ZETAD(I)*XYZCB(IX2)*HSSC(0,I,IX1,  1)
     &                   )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSC(6)
         CALL MCP0DSC(5)
         CALL MCP0FSC(4)
         CALL MCP0GSC(3)
         CALL MCP0HSC(2)
         CALL MCP0GPC(1)
         CALL MCP0HPC(1)
         CALL MCP0HDC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           HSDC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*HSPC(0,I,IX1, J2)
     &                                   +  XYZCB(J2)*HSPC(0,I,IX1, J1))
     &                     + (EXA(I)/ZETAD(I))**2*
     &                            XYZCB(J1)*XYZCB(J2)*HSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
         CALL MCP0PSC(7)
         CALL MCP0DSC(6)
         CALL MCP0FSC(5)
         CALL MCP0GSC(4)
         CALL MCP0HSC(3)
         CALL MCP0FPC(2)
         CALL MCP0GPC(2)
         CALL MCP0HPC(2)
         CALL MCP0GDC(1)
         CALL MCP0HDC(1)
         CALL MCP0HFC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               J13 = IXYZ(IX2,5)
               J23 = IXYZ(IX2,6)
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                           HSFC(0,I,IX1,IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                      XYZCB(J1)*HSDC(0,I,IX1,J23)
     &                                    + XYZCB(J2)*HSDC(0,I,IX1,J13)
     &                                    + XYZCB(J3)*HSDC(0,I,IX1,J12))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                            XYZCB(J1)*XYZCB(J2)*HSPC(0,I,IX1, J3)
     &                          + XYZCB(J2)*XYZCB(J3)*HSPC(0,I,IX1, J1)
     &                          + XYZCB(J3)*XYZCB(J1)*HSPC(0,I,IX1, J2))
     &                     + (EXA(I)/ZETAD(I))**3*
     &                  XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*HSSC(0,I,IX1,  1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|G) TYPE
C
      ELSE IF (NCB.EQ.15) THEN
C
         CALL MCP0PSC(8)
         CALL MCP0DSC(7)
         CALL MCP0FSC(6)
         CALL MCP0GSC(5)
         CALL MCP0HSC(4)
         CALL MCP0DPC(3)
         CALL MCP0FPC(3)
         CALL MCP0GPC(3)
         CALL MCP0HPC(3)
         CALL MCP0FDC(2)
         CALL MCP0GDC(2)
         CALL MCP0HDC(2)
         CALL MCP0GFC(1)
         CALL MCP0HFC(1)
         CALL MCP0HGC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1   = IXYZW(IX2,1)
               J2   = IXYZW(IX2,2)
               J3   = IXYZW(IX2,3)
               J4   = IXYZW(IX2,4)
               J12  = IXYZW(IX2,5)
               J13  = IXYZW(IX2,6)
               J14  = IXYZW(IX2,7)
               J23  = IXYZW(IX2,8)
               J24  = IXYZW(IX2,9)
               J34  = IXYZW(IX2,10)
               J123 = IXYZW(IX2,11)
               J124 = IXYZW(IX2,12)
               J134 = IXYZW(IX2,13)
               J234 = IXYZW(IX2,14)
C
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                          HSGC(0,I,IX1, IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                     XYZCB(J1)*HSFC(0,I,IX1,J234)
     &                                   + XYZCB(J2)*HSFC(0,I,IX1,J134)
     &                                   + XYZCB(J3)*HSFC(0,I,IX1,J124)
     &                                   + XYZCB(J4)*HSFC(0,I,IX1,J123))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                           XYZCB(J1)*XYZCB(J2)*HSDC(0,I,IX1, J34)
     &                         + XYZCB(J1)*XYZCB(J3)*HSDC(0,I,IX1, J24)
     &                         + XYZCB(J1)*XYZCB(J4)*HSDC(0,I,IX1, J23)
     &                         + XYZCB(J2)*XYZCB(J3)*HSDC(0,I,IX1, J14)
     &                         + XYZCB(J2)*XYZCB(J4)*HSDC(0,I,IX1, J13)
     &                         + XYZCB(J3)*XYZCB(J4)*HSDC(0,I,IX1, J12))
     &                     + (EXA(I)/ZETAD(I))**3*(
     &                 XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*HSPC(0,I,IX1,  J4)
     &               + XYZCB(J1)*XYZCB(J2)*XYZCB(J4)*HSPC(0,I,IX1,  J3)
     &               + XYZCB(J1)*XYZCB(J3)*XYZCB(J4)*HSPC(0,I,IX1,  J2)
     &               + XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*HSPC(0,I,IX1,  J1))
     &                     + (EXA(I)/ZETAD(I))**4*
     &       XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*HSSC(0,I,IX1,   1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|H) TYPE
C
      ELSE
C
         CALL MCP0PSC(9)
         CALL MCP0DSC(8)
         CALL MCP0FSC(7)
         CALL MCP0GSC(6)
         CALL MCP0HSC(5)
         CALL MCP0PPC(4)
         CALL MCP0DPC(4)
         CALL MCP0FPC(4)
         CALL MCP0GPC(4)
         CALL MCP0HPC(4)
         CALL MCP0DDC(3)
         CALL MCP0FDC(3)
         CALL MCP0GDC(3)
         CALL MCP0HDC(3)
         CALL MCP0FFC(2)
         CALL MCP0GFC(2)
         CALL MCP0HFC(2)
         CALL MCP0GGC(1)
         CALL MCP0HGC(1)
         CALL MCP0HHC(0)
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               J1    = IXYZWV(IX2,1)
               J2    = IXYZWV(IX2,2)
               J3    = IXYZWV(IX2,3)
               J4    = IXYZWV(IX2,4)
               J5    = IXYZWV(IX2,5)
               J12   = IXYZWV(IX2,6)
               J13   = IXYZWV(IX2,7)
               J14   = IXYZWV(IX2,8)
               J15   = IXYZWV(IX2,9)
               J23   = IXYZWV(IX2,10)
               J24   = IXYZWV(IX2,11)
               J25   = IXYZWV(IX2,12)
               J34   = IXYZWV(IX2,13)
               J35   = IXYZWV(IX2,14)
               J45   = IXYZWV(IX2,15)
               J123  = IXYZWV(IX2,16)
               J124  = IXYZWV(IX2,17)
               J125  = IXYZWV(IX2,18)
               J134  = IXYZWV(IX2,19)
               J135  = IXYZWV(IX2,20)
               J145  = IXYZWV(IX2,21)
               J234  = IXYZWV(IX2,22)
               J235  = IXYZWV(IX2,23)
               J245  = IXYZWV(IX2,24)
               J345  = IXYZWV(IX2,25)
               J1234 = IXYZWV(IX2,26)
               J1235 = IXYZWV(IX2,27)
               J1245 = IXYZWV(IX2,28)
               J1345 = IXYZWV(IX2,29)
               J2345 = IXYZWV(IX2,30)
C
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
                     VAL = -ZEFF*
     &                    (                         HSHC(0,I,IX1,  IX2)
     &                     + (EXA(I)/ZETAD(I))*(
     &                                    XYZCB(J1)*HSGC(0,I,IX1,J2345)
     &                                  + XYZCB(J2)*HSGC(0,I,IX1,J1345)
     &                                  + XYZCB(J3)*HSGC(0,I,IX1,J1245)
     &                                  + XYZCB(J4)*HSGC(0,I,IX1,J1235)
     &                                  + XYZCB(J5)*HSGC(0,I,IX1,J1234))
     &                     + (EXA(I)/ZETAD(I))**2*(
     &                          XYZCB(J1)*XYZCB(J2)*HSFC(0,I,IX1, J345)
     &                        + XYZCB(J1)*XYZCB(J3)*HSFC(0,I,IX1, J245)
     &                        + XYZCB(J1)*XYZCB(J4)*HSFC(0,I,IX1, J235)
     &                        + XYZCB(J1)*XYZCB(J5)*HSFC(0,I,IX1, J234)
     &                        + XYZCB(J2)*XYZCB(J3)*HSFC(0,I,IX1, J145)
     &                        + XYZCB(J2)*XYZCB(J4)*HSFC(0,I,IX1, J135)
     &                        + XYZCB(J2)*XYZCB(J5)*HSFC(0,I,IX1, J134)
     &                        + XYZCB(J3)*XYZCB(J4)*HSFC(0,I,IX1, J125)
     &                        + XYZCB(J3)*XYZCB(J5)*HSFC(0,I,IX1, J124)
     &                        + XYZCB(J4)*XYZCB(J5)*HSFC(0,I,IX1, J123))
     &                        + (EXA(I)/ZETAD(I))**3*(
     &                XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*HSDC(0,I,IX1,  J45)
     &              + XYZCB(J1)*XYZCB(J2)*XYZCB(J4)*HSDC(0,I,IX1,  J35)
     &              + XYZCB(J1)*XYZCB(J2)*XYZCB(J5)*HSDC(0,I,IX1,  J34)
     &              + XYZCB(J1)*XYZCB(J3)*XYZCB(J4)*HSDC(0,I,IX1,  J25)
     &              + XYZCB(J1)*XYZCB(J3)*XYZCB(J5)*HSDC(0,I,IX1,  J24)
     &              + XYZCB(J1)*XYZCB(J4)*XYZCB(J5)*HSDC(0,I,IX1,  J23)
     &              + XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*HSDC(0,I,IX1,  J15)
     &              + XYZCB(J2)*XYZCB(J3)*XYZCB(J5)*HSDC(0,I,IX1,  J14)
     &              + XYZCB(J2)*XYZCB(J4)*XYZCB(J5)*HSDC(0,I,IX1,  J13)
     &              + XYZCB(J3)*XYZCB(J4)*XYZCB(J5)*HSDC(0,I,IX1,  J12))
     &                        + (EXA(I)/ZETAD(I))**4*(
     &      XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*HSPC(0,I,IX1,   J5)
     &    + XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J5)*HSPC(0,I,IX1,   J4)
     &    + XYZCB(J1)*XYZCB(J2)*XYZCB(J4)*XYZCB(J5)*HSPC(0,I,IX1,   J3)
     &    + XYZCB(J1)*XYZCB(J3)*XYZCB(J4)*XYZCB(J5)*HSPC(0,I,IX1,   J2)
     &    + XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*XYZCB(J5)*HSPC(0,I,IX1,   J1))
     &                        + (EXA(I)/ZETAD(I))**5*
     &      XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J4)
     &                                   *XYZCB(J5)*HSSC(0,I,IX1,    1)
     &                    )/EXP(CB2*ETA(I))
                     GMCP0C(IX1,IX2) = GMCP0C(IX1,IX2) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C                    MCP C-TERM ENERGY CALCULATION                    @C
C     ~ LEVEL2 RECURSION FORMULA : UP TO H FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.04.26                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP0PSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (P|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      DIMENSION IDT(3,3)
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (P|0|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX = 1,3
            DO I = 1,NTERMA
               PSSC(M,I,IX,1) = XYZQA(I,IX) * SSSC(M ,I)
     &                        - XYZQC(I,IX) * SSSC(M1,I)
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (P|0|P) TYPE
C
      ENTRY MCP0PPC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,3
            DO IX2 = 1,3
               DO I = 1,NTERMA
                  PSPC(M,I,IX1,IX2) = XYZQD( I,IX2) * PSSC(M ,I,IX1,1)
     &                              - XYZQC( I,IX2) * PSSC(M1,I,IX1,1)
     &                              + (IDT(IX1,IX2) *(SSSC(M ,I)
     &                                               -SSSC(M1,I))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0DSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (D|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      DIMENSION IXY(6,2),IDT(3,3)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (D|0|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX = 1,6
            I1 = IXY(IX,1)
            I2 = IXY(IX,2)
            DO I = 1,NTERMA
               DSSC(M,I,IX,1) = XYZQA(I,I2) * PSSC(M ,I,I1,1)
     &                        - XYZQC(I,I2) * PSSC(M1,I,I1,1)
     &                        + IDT( I1,I2) *(SSSC(M ,I)
     &                                       -SSSC(M1,I)
     &                                       )/(2*ZETACABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|0|P) TYPE
C
      ENTRY MCP0DPC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO IX2 = 1,3
               DO I = 1,NTERMA
                  DSPC(M,I,IX1,IX2) = XYZQD(I,IX2) * DSSC(M ,I,IX1,1)
     &                              - XYZQC(I,IX2) * DSSC(M1,I,IX1,1)
     &                              + (IDT(I1,IX2) *(PSSC(M ,I, I2,1)
     &                                              -PSSC(M1,I, I2,1))
     &                                +IDT(I2,IX2) *(PSSC(M ,I, I1,1)
     &                                              -PSSC(M1,I, I1,1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|0|D) TYPE
C
      ENTRY MCP0DDC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO IX2 = 1,6
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  DSDC(M,I,IX1,IX2) = XYZQD(I,J2) * DSPC(M ,I,IX1,J1)
     &                              - XYZQC(I,J2) * DSPC(M1,I,IX1,J1)
     &                              + (IDT(I1,J2) *(PSPC(M ,I, I2,J1)
     &                                             -PSPC(M1,I, I2,J1))
     &                                +IDT(I2,J2) *(PSPC(M ,I, I1,J1)
     &                                             -PSPC(M1,I, I1,J1))
     &                                +IDT(J1,J2) *(DSSC(M ,I,IX1, 1)
     &                                             -DSSC(M1,I,IX1, 1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0FSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (F|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IDT(3,3)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
      DATA IDT /1,0,0,
     &          0,1,0,
     &          0,0,1/
C
C     (F|0|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX = 1,10
            I1  = IXYZ(IX,1)
            I2  = IXYZ(IX,2)
            I3  = IXYZ(IX,3)
            I12 = IXYZ(IX,4)
            DO I = 1,NTERMA
               FSSC(M,I,IX,1) = XYZQA(I,I3) * DSSC(M ,I,I12,1)
     &                        - XYZQC(I,I3) * DSSC(M1,I,I12,1)
     &                        + (IDT(I1,I3) *(PSSC(M ,I, I2,1)
     &                                       -PSSC(M1,I, I2,1))
     &                          +IDT(I2,I3) *(PSSC(M ,I, I1,1)
     &                                       -PSSC(M1,I, I1,1))
     &                          )/(2*ZETACABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|0|P) TYPE
C
      ENTRY MCP0FPC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,3
               DO I = 1,NTERMA
                  FSPC(M,I,IX1,IX2) = XYZQD(I,IX2) * FSSC(M ,I,IX1,1)
     &                              - XYZQC(I,IX2) * FSSC(M1,I,IX1,1)
     &                              + (IDT(I1,IX2) *(DSSC(M ,I,I23,1)
     &                                              -DSSC(M1,I,I23,1))
     &                                +IDT(I2,IX2) *(DSSC(M ,I,I13,1)
     &                                              -DSSC(M1,I,I13,1))
     &                                +IDT(I3,IX2) *(DSSC(M ,I,I12,1)
     &                                              -DSSC(M1,I,I12,1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|0|D) TYPE
C
      ENTRY MCP0FDC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,6
               J1  = IXY(IX2,1)
               J2  = IXY(IX2,2)
               DO I = 1,NTERMA
                  FSDC(M,I,IX1,IX2) = XYZQD(I,J2) * FSPC(M ,I,IX1,J1)
     &                              - XYZQC(I,J2) * FSPC(M1,I,IX1,J1)
     &                              + (IDT(I1,J2) *(DSPC(M ,I,I23,J1)
     &                                             -DSPC(M1,I,I23,J1))
     &                                +IDT(I2,J2) *(DSPC(M ,I,I13,J1)
     &                                             -DSPC(M1,I,I13,J1))
     &                                +IDT(I3,J2) *(DSPC(M ,I,I12,J1)
     &                                             -DSPC(M1,I,I12,J1))
     &                                +IDT(J1,J2) *(FSSC(M ,I,IX1, 1)
     &                                             -FSSC(M1,I,IX1, 1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|0|F) TYPE
C
      ENTRY MCP0FFC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               DO I = 1,NTERMA
                  FSFC(M,I,IX1,IX2) = XYZQD(I,J3) * FSDC(M ,I,IX1,J12)
     &                              - XYZQC(I,J3) * FSDC(M1,I,IX1,J12)
     &                              + (IDT(I1,J3) *(DSDC(M ,I,I23,J12)
     &                                             -DSDC(M1,I,I23,J12))
     &                                +IDT(I2,J3) *(DSDC(M ,I,I13,J12)
     &                                             -DSDC(M1,I,I13,J12))
     &                                +IDT(I3,J3) *(DSDC(M ,I,I12,J12)
     &                                             -DSDC(M1,I,I12,J12))
     &                                +IDT(J1,J3) *(FSPC(M ,I,IX1, J2)
     &                                             -FSPC(M1,I,IX1, J2))
     &                                +IDT(J2,J3) *(FSPC(M ,I,IX1, J1)
     &                                             -FSPC(M1,I,IX1, J1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0GSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (G|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (G|0|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX  = 1,15
            I1   = IXYZW(IX,1)
            I2   = IXYZW(IX,2)
            I3   = IXYZW(IX,3)
            I4   = IXYZW(IX,4)
            I12  = IXYZW(IX,5)
            I13  = IXYZW(IX,6)
C           I14  = IXYZW(IX,7)
            I23  = IXYZW(IX,8)
C           I24  = IXYZW(IX,9)
C           I34  = IXYZW(IX,10)
            I123 = IXYZW(IX,11)
C           I124 = IXYZW(IX,12)
C           I134 = IXYZW(IX,13)
C           I234 = IXYZW(IX,14)
C
            DO I = 1,NTERMA
               GSSC(M,I,IX,1) = XYZQA(I,I4) * FSSC(M ,I,I123,1)
     &                        - XYZQC(I,I4) * FSSC(M1,I,I123,1)
     &                        + (IDT(I1,I4) *(DSSC(M ,I, I23,1)
     &                                       -DSSC(M1,I, I23,1))
     &                          +IDT(I2,I4) *(DSSC(M ,I, I13,1)
     &                                       -DSSC(M1,I, I13,1))
     &                          +IDT(I3,I4) *(DSSC(M ,I, I12,1)
     &                                       -DSSC(M1,I, I12,1))
     &                          )/(2*ZETACABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|P) TYPE
C
      ENTRY MCP0GPC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,3
               DO I = 1,NTERMA
                  GSPC(M,I,IX1,IX2) = XYZQD(I,IX2) * GSSC(M ,I, IX1,1)
     &                              - XYZQC(I,IX2) * GSSC(M1,I, IX1,1)
     &                              + (IDT(I1,IX2) *(FSSC(M ,I,I234,1)
     &                                              -FSSC(M1,I,I234,1))
     &                                +IDT(I2,IX2) *(FSSC(M ,I,I134,1)
     &                                              -FSSC(M1,I,I134,1))
     &                                +IDT(I3,IX2) *(FSSC(M ,I,I124,1)
     &                                              -FSSC(M1,I,I124,1))
     &                                +IDT(I4,IX2) *(FSSC(M ,I,I123,1)
     &                                              -FSSC(M1,I,I123,1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|D) TYPE
C
      ENTRY MCP0GDC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,6
               J1  = IXY(IX2,1)
               J2  = IXY(IX2,2)
               DO I = 1,NTERMA
                  GSDC(M,I,IX1,IX2) = XYZQD(I,J2) * GSPC(M ,I, IX1,J1)
     &                              - XYZQC(I,J2) * GSPC(M1,I, IX1,J1)
     &                              + (IDT(I1,J2) *(FSPC(M ,I,I234,J1)
     &                                             -FSPC(M1,I,I234,J1))
     &                                +IDT(I2,J2) *(FSPC(M ,I,I134,J1)
     &                                             -FSPC(M1,I,I134,J1))
     &                                +IDT(I3,J2) *(FSPC(M ,I,I124,J1)
     &                                             -FSPC(M1,I,I124,J1))
     &                                +IDT(I4,J2) *(FSPC(M ,I,I123,J1)
     &                                             -FSPC(M1,I,I123,J1))
     &                                +IDT(J1,J2) *(GSSC(M ,I,IX1 , 1)
     &                                             -GSSC(M1,I,IX1 , 1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|F) TYPE
C
      ENTRY MCP0GFC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               DO I = 1,NTERMA
                  GSFC(M,I,IX1,IX2) = XYZQD(I,J3) * GSDC(M ,I, IX1,J12)
     &                              - XYZQC(I,J3) * GSDC(M1,I, IX1,J12)
     &                              + (IDT(I1,J3) *(FSDC(M ,I,I234,J12)
     &                                             -FSDC(M1,I,I234,J12))
     &                                +IDT(I2,J3) *(FSDC(M ,I,I134,J12)
     &                                             -FSDC(M1,I,I134,J12))
     &                                +IDT(I3,J3) *(FSDC(M ,I,I124,J12)
     &                                             -FSDC(M1,I,I124,J12))
     &                                +IDT(I4,J3) *(FSDC(M ,I,I123,J12)
     &                                             -FSDC(M1,I,I123,J12))
     &                                +IDT(J1,J3) *(GSPC(M ,I, IX1,J2 )
     &                                             -GSPC(M1,I,IX1 ,J2 ))
     &                                +IDT(J2,J3) *(GSPC(M ,I,IX1 ,J1 )
     &                                             -GSPC(M1,I,IX1 ,J1 ))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|G) TYPE
C
      ENTRY MCP0GGC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
C
            DO IX2 = 1,15
               J1   = IXYZW(IX2,1)
               J2   = IXYZW(IX2,2)
               J3   = IXYZW(IX2,3)
               J4   = IXYZW(IX2,4)
               J12  = IXYZW(IX2,5)
               J13  = IXYZW(IX2,6)
C              J14  = IXYZW(IX2,7)
               J23  = IXYZW(IX2,8)
C              J24  = IXYZW(IX2,9)
C              J34  = IXYZW(IX2,10)
               J123 = IXYZW(IX2,11)
C              J124 = IXYZW(IX2,12)
C              J134 = IXYZW(IX2,13)
C              J234 = IXYZW(IX2,14)
C
               DO I = 1,NTERMA
                 GSGC(M,I,IX1,IX2) = XYZQD(I,J4) * GSFC(M ,I, IX1,J123)
     &                             - XYZQC(I,J4) * GSFC(M1,I, IX1,J123)
     &                             + (IDT(I1,J4) *(FSFC(M ,I,I234,J123)
     &                                            -FSFC(M1,I,I234,J123))
     &                               +IDT(I2,J4) *(FSFC(M ,I,I134,J123)
     &                                            -FSFC(M1,I,I134,J123))
     &                               +IDT(I3,J4) *(FSFC(M ,I,I124,J123)
     &                                            -FSFC(M1,I,I124,J123))
     &                               +IDT(I4,J4) *(FSFC(M ,I,I123,J123)
     &                                            -FSFC(M1,I,I123,J123))
     &                               +IDT(J1,J4) *(GSDC(M ,I, IX1,J23 )
     &                                            -GSDC(M1,I, IX1,J23 ))
     &                               +IDT(J2,J4) *(GSDC(M ,I, IX1,J13 )
     &                                            -GSDC(M1,I, IX1,J13 ))
     &                               +IDT(J3,J4) *(GSDC(M ,I, IX1,J12 )
     &                                            -GSDC(M1,I, IX1,J12 ))
     &                               )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0HSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (H|0|X): C-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IXYZWV(21,30),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA IXYZWV/
     1   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3,
     2   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 2, 2, 2, 2, 3, 3,
     3   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 2, 2, 2, 3, 3, 3,
     4   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 2, 2, 3, 3, 3, 3,
     5   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 2, 3, 3, 3, 3, 3,
     6   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6,
     7   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6,
     8   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, 6,
     9   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 4, 5, 5, 5, 5, 6,
     &   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 4, 4, 4, 5, 6, 6,
     1   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 4, 4, 5, 5, 6, 6,
     2   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 4, 5, 5, 5, 6, 6,
     3   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 4, 4, 5, 6, 6, 6,
     4   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 4, 5, 5, 6, 6, 6,
     5   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6, 4, 5, 6, 6, 6, 6,
     6   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 7, 7, 8, 9,10,
     7   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 8, 8, 9,10,
     8   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 7, 8, 8, 8, 9,10,
     9   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9,10,
     &   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9,10,
     1   1, 2, 3, 4, 5, 6, 7, 5, 6, 6, 4, 5, 6, 6, 6, 7, 8, 9, 9, 9,10,
     2   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10, 7, 7, 8, 9,10,10,
     3   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10, 7, 8, 8, 9,10,10,
     4   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10, 7, 8, 9, 9,10,10,
     5   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10, 7, 8, 9,10,10,10,
     6   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,11,11,12,13,14,15,
     7   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,11,12,12,13,14,15,
     8   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,11,12,13,13,14,15,
     9   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10,11,12,13,14,14,15,
     &   1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,11,12,13,14,15,15/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (H|0|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX  = 1,21
            I1    = IXYZWV(IX,1)
            I2    = IXYZWV(IX,2)
            I3    = IXYZWV(IX,3)
            I4    = IXYZWV(IX,4)
            I5    = IXYZWV(IX,5)
C           I12   = IXYZWV(IX,6)
C           I13   = IXYZWV(IX,7)
C           I14   = IXYZWV(IX,8)
C           I15   = IXYZWV(IX,9)
C           I23   = IXYZWV(IX,10)
C           I24   = IXYZWV(IX,11)
C           I25   = IXYZWV(IX,12)
C           I34   = IXYZWV(IX,13)
C           I35   = IXYZWV(IX,14)
C           I45   = IXYZWV(IX,15)
            I123  = IXYZWV(IX,16)
            I124  = IXYZWV(IX,17)
C           I125  = IXYZWV(IX,18)
            I134  = IXYZWV(IX,19)
C           I135  = IXYZWV(IX,20)
C           I145  = IXYZWV(IX,21)
            I234  = IXYZWV(IX,22)
C           I235  = IXYZWV(IX,23)
C           I245  = IXYZWV(IX,24)
C           I345  = IXYZWV(IX,25)
            I1234 = IXYZWV(IX,26)
            I1235 = IXYZWV(IX,27)
            I1245 = IXYZWV(IX,28)
            I1345 = IXYZWV(IX,29)
            I2345 = IXYZWV(IX,30)
            DO I = 1,NTERMA
               HSSC(M,I,IX,1) = XYZQA(I,I5) * GSSC(M ,I,I1234,1)
     &                        - XYZQC(I,I5) * GSSC(M1,I,I1234,1)
     &                        + (IDT(I1,I5) *(FSSC(M ,I, I234,1)
     &                                       -FSSC(M1,I, I234,1))
     &                          +IDT(I2,I5) *(FSSC(M ,I, I134,1)
     &                                       -FSSC(M1,I, I134,1))
     &                          +IDT(I3,I5) *(FSSC(M ,I, I124,1)
     &                                      -FSSC(M1,I, I124,1))
     &                          +IDT(I4,I5) *(FSSC(M ,I, I123,1)
     &                                      -FSSC(M1,I, I123,1))
     &                          )/(2*ZETACABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|P) TYPE
C
      ENTRY MCP0HPC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,21
            I1    = IXYZWV(IX1,1)
            I2    = IXYZWV(IX1,2)
            I3    = IXYZWV(IX1,3)
            I4    = IXYZWV(IX1,4)
            I5    = IXYZWV(IX1,5)
C           I12   = IXYZWV(IX1,6)
C           I13   = IXYZWV(IX1,7)
C           I14   = IXYZWV(IX1,8)
C           I15   = IXYZWV(IX1,9)
C           I23   = IXYZWV(IX1,10)
C           I24   = IXYZWV(IX1,11)
C           I25   = IXYZWV(IX1,12)
C           I34   = IXYZWV(IX1,13)
C           I35   = IXYZWV(IX1,14)
C           I45   = IXYZWV(IX1,15)
            I123  = IXYZWV(IX1,16)
            I124  = IXYZWV(IX1,17)
C           I125  = IXYZWV(IX1,18)
            I134  = IXYZWV(IX1,19)
C           I135  = IXYZWV(IX1,20)
C           I145  = IXYZWV(IX1,21)
            I234  = IXYZWV(IX1,22)
C           I235  = IXYZWV(IX1,23)
C           I245  = IXYZWV(IX1,24)
C           I345  = IXYZWV(IX1,25)
            I1234 = IXYZWV(IX1,26)
            I1235 = IXYZWV(IX1,27)
            I1245 = IXYZWV(IX1,28)
            I1345 = IXYZWV(IX1,29)
            I2345 = IXYZWV(IX1,30)
            DO IX2 = 1,3
               DO I = 1,NTERMA
                  HSPC(M,I,IX1,IX2) = XYZQD(I,IX2) * HSSC(M ,I,  IX1,1)
     &                              - XYZQC(I,IX2) * HSSC(M1,I,  IX1,1)
     &                              + (IDT(I1,IX2) *(GSSC(M ,I,I2345,1)
     &                                              -GSSC(M1,I,I2345,1))
     &                                +IDT(I2,IX2) *(GSSC(M ,I,I1345,1)
     &                                              -GSSC(M1,I,I1345,1))
     &                                +IDT(I3,IX2) *(GSSC(M ,I,I1245,1)
     &                                              -GSSC(M1,I,I1245,1))
     &                                +IDT(I4,IX2) *(GSSC(M ,I,I1235,1)
     &                                              -GSSC(M1,I,I1235,1))
     &                                +IDT(I5,IX2) *(GSSC(M ,I,I1234,1)
     &                                              -GSSC(M1,I,I1234,1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|D) TYPE
C
      ENTRY MCP0HDC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,21
            I1    = IXYZWV(IX1,1)
            I2    = IXYZWV(IX1,2)
            I3    = IXYZWV(IX1,3)
            I4    = IXYZWV(IX1,4)
            I5    = IXYZWV(IX1,5)
C           I12   = IXYZWV(IX1,6)
C           I13   = IXYZWV(IX1,7)
C           I14   = IXYZWV(IX1,8)
C           I15   = IXYZWV(IX1,9)
C           I23   = IXYZWV(IX1,10)
C           I24   = IXYZWV(IX1,11)
C           I25   = IXYZWV(IX1,12)
C           I34   = IXYZWV(IX1,13)
C           I35   = IXYZWV(IX1,14)
C           I45   = IXYZWV(IX1,15)
            I123  = IXYZWV(IX1,16)
            I124  = IXYZWV(IX1,17)
C           I125  = IXYZWV(IX1,18)
            I134  = IXYZWV(IX1,19)
C           I135  = IXYZWV(IX1,20)
C           I145  = IXYZWV(IX1,21)
            I234  = IXYZWV(IX1,22)
C           I235  = IXYZWV(IX1,23)
C           I245  = IXYZWV(IX1,24)
C           I345  = IXYZWV(IX1,25)
            I1234 = IXYZWV(IX1,26)
            I1235 = IXYZWV(IX1,27)
            I1245 = IXYZWV(IX1,28)
            I1345 = IXYZWV(IX1,29)
            I2345 = IXYZWV(IX1,30)
            DO IX2 = 1,6
               J1  = IXY(IX2,1)
               J2  = IXY(IX2,2)
               DO I = 1,NTERMA
                  HSDC(M,I,IX1,IX2) = XYZQD(I,J2) * HSPC(M ,I,  IX1,J1)
     &                              - XYZQC(I,J2) * HSPC(M1,I,  IX1,J1)
     &                              + (IDT(I1,J2) *(GSPC(M ,I,I2345,J1)
     &                                             -GSPC(M1,I,I2345,J1))
     &                                +IDT(I2,J2) *(GSPC(M ,I,I1345,J1)
     &                                             -GSPC(M1,I,I1345,J1))
     &                                +IDT(I3,J2) *(GSPC(M ,I,I1245,J1)
     &                                             -GSPC(M1,I,I1245,J1))
     &                                +IDT(I4,J2) *(GSPC(M ,I,I1235,J1)
     &                                             -GSPC(M1,I,I1235,J1))
     &                                +IDT(I5,J2) *(GSPC(M ,I,I1234,J1)
     &                                             -GSPC(M1,I,I1234,J1))
     &                                +IDT(J1,J2) *(HSSC(M ,I,  IX1, 1)
     &                                             -HSSC(M1,I,  IX1, 1))
     &                                )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|F) TYPE
C
      ENTRY MCP0HFC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,21
            I1    = IXYZWV(IX1,1)
            I2    = IXYZWV(IX1,2)
            I3    = IXYZWV(IX1,3)
            I4    = IXYZWV(IX1,4)
            I5    = IXYZWV(IX1,5)
C           I12   = IXYZWV(IX1,6)
C           I13   = IXYZWV(IX1,7)
C           I14   = IXYZWV(IX1,8)
C           I15   = IXYZWV(IX1,9)
C           I23   = IXYZWV(IX1,10)
C           I24   = IXYZWV(IX1,11)
C           I25   = IXYZWV(IX1,12)
C           I34   = IXYZWV(IX1,13)
C           I35   = IXYZWV(IX1,14)
C           I45   = IXYZWV(IX1,15)
            I123  = IXYZWV(IX1,16)
            I124  = IXYZWV(IX1,17)
C           I125  = IXYZWV(IX1,18)
            I134  = IXYZWV(IX1,19)
C           I135  = IXYZWV(IX1,20)
C           I145  = IXYZWV(IX1,21)
            I234  = IXYZWV(IX1,22)
C           I235  = IXYZWV(IX1,23)
C           I245  = IXYZWV(IX1,24)
C           I345  = IXYZWV(IX1,25)
            I1234 = IXYZWV(IX1,26)
            I1235 = IXYZWV(IX1,27)
            I1245 = IXYZWV(IX1,28)
            I1345 = IXYZWV(IX1,29)
            I2345 = IXYZWV(IX1,30)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
               DO I = 1,NTERMA
                 HSFC(M,I,IX1,IX2) = XYZQD(I,J3) * HSDC(M ,I,  IX1,J12)
     &                             - XYZQC(I,J3) * HSDC(M1,I,  IX1,J12)
     &                             + (IDT(I1,J3) *(GSDC(M ,I,I2345,J12)
     &                                            -GSDC(M1,I,I2345,J12))
     &                               +IDT(I2,J3) *(GSDC(M ,I,I1345,J12)
     &                                            -GSDC(M1,I,I1345,J12))
     &                               +IDT(I3,J3) *(GSDC(M ,I,I1245,J12)
     &                                            -GSDC(M1,I,I1245,J12))
     &                               +IDT(I4,J3) *(GSDC(M ,I,I1235,J12)
     &                                            -GSDC(M1,I,I1235,J12))
     &                               +IDT(I5,J3) *(GSDC(M ,I,I1234,J12)
     &                                            -GSDC(M1,I,I1234,J12))
     &                               +IDT(J1,J3) *(HSPC(M ,I,  IX1,J2 )
     &                                            -HSPC(M1,I,  IX1,J2 ))
     &                               +IDT(J2,J3) *(HSPC(M ,I,  IX1,J1 )
     &                                            -HSPC(M1,I,  IX1,J1 ))
     &                               )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|G) TYPE
C
      ENTRY MCP0HGC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,21
            I1    = IXYZWV(IX1,1)
            I2    = IXYZWV(IX1,2)
            I3    = IXYZWV(IX1,3)
            I4    = IXYZWV(IX1,4)
            I5    = IXYZWV(IX1,5)
C           I12   = IXYZWV(IX1,6)
C           I13   = IXYZWV(IX1,7)
C           I14   = IXYZWV(IX1,8)
C           I15   = IXYZWV(IX1,9)
C           I23   = IXYZWV(IX1,10)
C           I24   = IXYZWV(IX1,11)
C           I25   = IXYZWV(IX1,12)
C           I34   = IXYZWV(IX1,13)
C           I35   = IXYZWV(IX1,14)
C           I45   = IXYZWV(IX1,15)
            I123  = IXYZWV(IX1,16)
            I124  = IXYZWV(IX1,17)
C           I125  = IXYZWV(IX1,18)
            I134  = IXYZWV(IX1,19)
C           I135  = IXYZWV(IX1,20)
C           I145  = IXYZWV(IX1,21)
            I234  = IXYZWV(IX1,22)
C           I235  = IXYZWV(IX1,23)
C           I245  = IXYZWV(IX1,24)
C           I345  = IXYZWV(IX1,25)
            I1234 = IXYZWV(IX1,26)
            I1235 = IXYZWV(IX1,27)
            I1245 = IXYZWV(IX1,28)
            I1345 = IXYZWV(IX1,29)
            I2345 = IXYZWV(IX1,30)
            DO IX2 = 1,15
               J1   = IXYZW(IX2,1)
               J2   = IXYZW(IX2,2)
               J3   = IXYZW(IX2,3)
               J4   = IXYZW(IX2,4)
               J12  = IXYZW(IX2,5)
               J13  = IXYZW(IX2,6)
C              J14  = IXYZW(IX2,7)
               J23  = IXYZW(IX2,8)
C              J24  = IXYZW(IX2,9)
C              J34  = IXYZW(IX2,10)
               J123 = IXYZW(IX2,11)
C              J124 = IXYZW(IX2,12)
C              J134 = IXYZW(IX2,13)
C              J234 = IXYZW(IX2,14)
C
               DO I = 1,NTERMA
                HSGC(M,I,IX1,IX2) = XYZQD(I,J4) * HSFC(M ,I,  IX1,J123)
     &                            - XYZQC(I,J4) * HSFC(M1,I,  IX1,J123)
     &                            + (IDT(I1,J4) *(GSFC(M ,I,I2345,J123)
     &                                           -GSFC(M1,I,I2345,J123))
     &                              +IDT(I2,J4) *(GSFC(M ,I,I1345,J123)
     &                                           -GSFC(M1,I,I1345,J123))
     &                              +IDT(I3,J4) *(GSFC(M ,I,I1245,J123)
     &                                           -GSFC(M1,I,I1245,J123))
     &                              +IDT(I4,J4) *(GSFC(M ,I,I1235,J123)
     &                                           -GSFC(M1,I,I1235,J123))
     &                              +IDT(I5,J4) *(GSFC(M ,I,I1234,J123)
     &                                           -GSFC(M1,I,I1234,J123))
     &                              +IDT(J1,J4) *(HSDC(M ,I,  IX1,J23 )
     &                                           -HSDC(M1,I,  IX1,J23 ))
     &                              +IDT(J2,J4) *(HSDC(M ,I,  IX1,J13 )
     &                                           -HSDC(M1,I,  IX1,J13 ))
     &                              +IDT(J3,J4) *(HSDC(M ,I,  IX1,J12 )
     &                                           -HSDC(M1,I,  IX1,J12 ))
     &                              )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|H) TYPE
C
      ENTRY MCP0HHC(MX)
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,21
            I1    = IXYZWV(IX1,1)
            I2    = IXYZWV(IX1,2)
            I3    = IXYZWV(IX1,3)
            I4    = IXYZWV(IX1,4)
            I5    = IXYZWV(IX1,5)
C           I12   = IXYZWV(IX1,6)
C           I13   = IXYZWV(IX1,7)
C           I14   = IXYZWV(IX1,8)
C           I15   = IXYZWV(IX1,9)
C           I23   = IXYZWV(IX1,10)
C           I24   = IXYZWV(IX1,11)
C           I25   = IXYZWV(IX1,12)
C           I34   = IXYZWV(IX1,13)
C           I35   = IXYZWV(IX1,14)
C           I45   = IXYZWV(IX1,15)
            I123  = IXYZWV(IX1,16)
            I124  = IXYZWV(IX1,17)
C           I125  = IXYZWV(IX1,18)
            I134  = IXYZWV(IX1,19)
C           I135  = IXYZWV(IX1,20)
C           I145  = IXYZWV(IX1,21)
            I234  = IXYZWV(IX1,22)
C           I235  = IXYZWV(IX1,23)
C           I245  = IXYZWV(IX1,24)
C           I345  = IXYZWV(IX1,25)
            I1234 = IXYZWV(IX1,26)
            I1235 = IXYZWV(IX1,27)
            I1245 = IXYZWV(IX1,28)
            I1345 = IXYZWV(IX1,29)
            I2345 = IXYZWV(IX1,30)
            DO IX2 = 1,21
               J1    = IXYZWV(IX2,1)
               J2    = IXYZWV(IX2,2)
               J3    = IXYZWV(IX2,3)
               J4    = IXYZWV(IX2,4)
               J5    = IXYZWV(IX2,5)
               J12   = IXYZWV(IX2,6)
               J13   = IXYZWV(IX2,7)
C              J14   = IXYZWV(IX2,8)
C              J15   = IXYZWV(IX2,9)
               J23   = IXYZWV(IX2,10)
C              J24   = IXYZWV(IX2,11)
C              J25   = IXYZWV(IX2,12)
C              J34   = IXYZWV(IX2,13)
C              J35   = IXYZWV(IX2,14)
C              J45   = IXYZWV(IX2,15)
               J123  = IXYZWV(IX2,16)
               J124  = IXYZWV(IX2,17)
C              J125  = IXYZWV(IX2,18)
               J134  = IXYZWV(IX2,19)
C              J135  = IXYZWV(IX2,20)
C              J145  = IXYZWV(IX2,21)
               J234  = IXYZWV(IX2,22)
C              J235  = IXYZWV(IX2,23)
C              J245  = IXYZWV(IX2,24)
C              J345  = IXYZWV(IX2,25)
               J1234 = IXYZWV(IX2,26)
C              J1235 = IXYZWV(IX2,27)
C              J1245 = IXYZWV(IX2,28)
C              J1345 = IXYZWV(IX2,29)
C              J2345 = IXYZWV(IX2,30)
               DO I = 1,NTERMA
              HSHC(M,I,IX1,IX2) = XYZQD(I,J5) * HSGC(M ,I,  IX1,J1234)
     &                          - XYZQC(I,J5) * HSGC(M1,I,  IX1,J1234)
     &                          + (IDT(I1,J5) *(GSGC(M ,I,I2345,J1234)
     &                                         -GSGC(M1,I,I2345,J1234))
     &                            +IDT(I2,J5) *(GSGC(M ,I,I1345,J1234)
     &                                         -GSGC(M1,I,I1345,J1234))
     &                            +IDT(I3,J5) *(GSGC(M ,I,I1245,J1234)
     &                                         -GSGC(M1,I,I1245,J1234))
     &                            +IDT(I4,J5) *(GSGC(M ,I,I1235,J1234)
     &                                         -GSGC(M1,I,I1235,J1234))
     &                            +IDT(I5,J5) *(GSGC(M ,I,I1234,J1234)
     &                                         -GSGC(M1,I,I1234,J1234))
     &                            +IDT(J1,J5) *(HSFC(M ,I,  IX1,J234 )
     &                                         -HSFC(M1,I,  IX1,J234 ))
     &                            +IDT(J2,J5) *(HSFC(M ,I,  IX1,J134 )
     &                                         -HSFC(M1,I,  IX1,J134 ))
     &                            +IDT(J3,J5) *(HSFC(M ,I,  IX1,J124 )
     &                                         -HSFC(M1,I,  IX1,J124 ))
     &                            +IDT(J4,J5) *(HSFC(M ,I,  IX1,J123 )
     &                                         -HSFC(M1,I,  IX1,J123 ))
     &                            )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C                    MCP D-TERM ENERGY CALCULATION                    @C
C     ~ LEVEL1 RECURSION FORMULA : UP TO H FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.02.15                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP0DS
C=======================================================================
C
C     LEVEL 1 RECURSION (S|0|S): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
      DO I=1,NTERMB
         VAL = -ZEFF*SSSD(I)
         GMCP0D(1,1) = GMCP0D(1,1) + VAL * COEFB(I)
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP0DP (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (P|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (P|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
        CALL MCP0PSD ()
C
        DO IX = 1,NCA
           DO I=1,NTERMB
              VAL = -ZEFF*PSSD(I,IX,1)
              GMCP0D(IX,1) = GMCP0D(IX,1) + VAL * COEFB(I)
           ENDDO
        ENDDO
C
C (P|0|P) TYPE
C
      ELSE
C
        CALL MCP0PSD ()
        CALL MCP0PPD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*PSPD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
        ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0DD (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (D|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (D|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
C
        DO IX = 1,NCA
           DO I=1,NTERMB
              VAL = -ZEFF*DSSD(I,IX,1)
              GMCP0D(IX,1) = GMCP0D(IX,1) + VAL * COEFB(I)
           ENDDO
        ENDDO
C
C     (D|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*DSPD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (D|0|D) TYPE
C
      ELSE
C
        CALL MCP0PSD ()
        CALL MCP0PPD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
        CALL MCP0DDD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*DSDD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0DF (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (F|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (F|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0FSD ()
C
        DO IX = 1,NCA
           DO I=1,NTERMB
              VAL = -ZEFF*FSSD(I,IX,1)
              GMCP0D(IX,1) = GMCP0D(IX,1) + VAL * COEFB(I)
           ENDDO
        ENDDO
C
C     (F|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*FSPD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (F|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
        CALL MCP0FDD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*FSDD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (F|0|F) TYPE
C
      ELSE
C
        CALL MCP0PSD ()
        CALL MCP0PPD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
        CALL MCP0DDD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
        CALL MCP0FDD ()
        CALL MCP0FFD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*FSFD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0DG (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (G|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (G|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0FSD ()
        CALL MCP0GSD ()
C
        DO IX = 1,NCA
           DO I=1,NTERMB
              VAL = -ZEFF*GSSD(I,IX,1)
              GMCP0D(IX,1) = GMCP0D(IX,1) + VAL * COEFB(I)
           ENDDO
        ENDDO
C
C     (G|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0FSD ()
        CALL MCP0GSD ()
        CALL MCP0GPD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*GSPD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (G|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
        CALL MCP0GSD ()
        CALL MCP0GPD ()
        CALL MCP0GDD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*GSDD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (G|0|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
        CALL MCP0PSD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
        CALL MCP0FDD ()
        CALL MCP0GSD ()
        CALL MCP0GPD ()
        CALL MCP0GDD ()
        CALL MCP0GFD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*GSFD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
C
C     (G|0|G) TYPE
C
      ELSE
C
        CALL MCP0PSD ()
        CALL MCP0PPD ()
        CALL MCP0DSD ()
        CALL MCP0DPD ()
        CALL MCP0DDD ()
        CALL MCP0FSD ()
        CALL MCP0FPD ()
        CALL MCP0FDD ()
        CALL MCP0FFD ()
        CALL MCP0GSD ()
        CALL MCP0GPD ()
        CALL MCP0GDD ()
        CALL MCP0GFD ()
        CALL MCP0GGD ()
C
        DO IX1 = 1,NCA
           DO IX2 = 1,NCB
              DO I=1,NTERMB
                 VAL = -ZEFF*GSGD(I,IX1,IX2)
                 GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
              ENDDO
           ENDDO
        ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP0DH (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (H|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      COMMON/MCPOUT/GMCP0C(MXC,MXC),GMCP0D(MXC,MXC)
C
C     (H|0|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
C
         DO IX = 1,NCA
            DO I=1,NTERMB
               VAL = -ZEFF*HSSD(I,IX,1)
               GMCP0D(IX,1) = GMCP0D(IX,1) + VAL * COEFB(I)
            ENDDO
         ENDDO
C
C     (H|0|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
         CALL MCP0HPD ()
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I=1,NTERMB
                  VAL = -ZEFF*HSPD(I,IX1,IX2)
                  GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
         CALL MCP0GPD ()
         CALL MCP0HPD ()
         CALL MCP0HDD ()
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I=1,NTERMB
                  VAL = -ZEFF*HSDD(I,IX1,IX2)
                  GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
         CALL MCP0FPD ()
         CALL MCP0GPD ()
         CALL MCP0HPD ()
         CALL MCP0GDD ()
         CALL MCP0HDD ()
         CALL MCP0HFD ()
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I=1,NTERMB
                  VAL = -ZEFF*HSFD(I,IX1,IX2)
                  GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|G) TYPE
C
      ELSE IF (NCB.EQ.15) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
         CALL MCP0DPD ()
         CALL MCP0FPD ()
         CALL MCP0GPD ()
         CALL MCP0HPD ()
         CALL MCP0FDD ()
         CALL MCP0GDD ()
         CALL MCP0HDD ()
         CALL MCP0GFD ()
         CALL MCP0HFD ()
         CALL MCP0HGD ()
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I=1,NTERMB
                  VAL = -ZEFF*HSGD(I,IX1,IX2)
                  GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (H|0|H) TYPE
C
      ELSE
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP0HSD ()
         CALL MCP0PPD ()
         CALL MCP0DPD ()
         CALL MCP0FPD ()
         CALL MCP0GPD ()
         CALL MCP0HPD ()
         CALL MCP0DDD ()
         CALL MCP0FDD ()
         CALL MCP0GDD ()
         CALL MCP0HDD ()
         CALL MCP0FFD ()
         CALL MCP0GFD ()
         CALL MCP0HFD ()
         CALL MCP0GGD ()
         CALL MCP0HGD ()
         CALL MCP0HHD ()
C
         DO IX1 = 1,NCA
            DO IX2 = 1,NCB
               DO I=1,NTERMB
                  VAL = -ZEFF*HSHD(I,IX1,IX2)
                  GMCP0D(IX1,IX2) = GMCP0D(IX1,IX2) + VAL * COEFB(I)
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C                    MCP D-TERM ENERGY CALCULATION                    @C
C     ~ LEVEL2 RECURSION FORMULA : UP TO H FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.02.14                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP0PSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (P|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      DIMENSION IDT(3,3)
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (P|0|S) TYPE
C
      DO IX = 1,3
         DO I = 1,NTERMB
            PSSD(I,IX,1) = XYZGA(I,IX)*SSSD(I)
         ENDDO
      ENDDO
      RETURN
C
C     (P|0|P) TYPE
C
      ENTRY MCP0PPD ()
      DO IX1 = 1,3
         DO IX2 = 1,3
            DO I = 1,NTERMB
               PSPD(I,IX1,IX2) = XYZGB(I,IX2)*PSSD(I,IX1,1)
     &                         + IDT(IX1,IX2)*SSSD(I)
     &                           /(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0DSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (D|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      DIMENSION IXY(6,2),IDT(3,3)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (D|0|S) TYPE
C
      DO IX = 1,6
         I1 = IXY(IX,1)
         I2 = IXY(IX,2)
         DO I = 1,NTERMB
            DSSD(I,IX,1) = XYZGA(I,I2)*PSSD(I,I1,1)
     &                   + IDT( I1,I2)*SSSD(I)
     &                     /(2*ZETADABC(I))
          ENDDO
        ENDDO
      RETURN
C
C     (D|0|P) TYPE
C
      ENTRY MCP0DPD ()
      DO IX1 = 1,6
         I1 = IXY(IX1,1)
         I2 = IXY(IX1,2)
         DO IX2 = 1,3
            DO I = 1,NTERMB
               DSPD(I,IX1,IX2) = XYZGB(I,IX2)*DSSD(I,IX1,1)
     &                         + (IDT(I2,IX2)*PSSD(I, I1,1)
     &                           +IDT(I1,IX2)*PSSD(I, I2,1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|0|D) TYPE
C
      ENTRY MCP0DDD ()
      DO IX1 = 1,6
         I1 = IXY(IX1,1)
         I2 = IXY(IX1,2)
         DO IX2 = 1,6
            J1 = IXY(IX2,1)
            J2 = IXY(IX2,2)
            DO I = 1,NTERMB
               DSDD(I,IX1,IX2) = XYZGB(I,J2)*DSPD(I,IX1,J1)
     &                         + (IDT(I1,J2)*PSPD(I, I2,J1)
     &                           +IDT(I2,J2)*PSPD(I, I1,J1)
     &                           +IDT(J1,J2)*DSSD(I,IX1, 1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0FSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (F|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IDT(3,3)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
      DATA  IDT/1,0,0,
     &          0,1,0,
     &          0,0,1/
C
C     (F|0|S) TYPE
C
      DO IX = 1,10
         I1  = IXYZ(IX,1)
         I2  = IXYZ(IX,2)
         I3  = IXYZ(IX,3)
         I12 = IXYZ(IX,4)
         DO I = 1,NTERMB
            FSSD(I,IX,1) = XYZGA(I,I3)*DSSD(I,I12,1)
     &                   + (IDT(I1,I3)*PSSD(I, I2,1)
     &                     +IDT(I2,I3)*PSSD(I, I1,1)
     &                     )/(2*ZETADABC(I))
          ENDDO
        ENDDO
      RETURN
C
C     (F|0|P) TYPE
C
      ENTRY MCP0FPD ()
      DO IX1 = 1,10
         I1  = IXYZ(IX1,1)
         I2  = IXYZ(IX1,2)
         I3  = IXYZ(IX1,3)
         I12 = IXYZ(IX1,4)
         I13 = IXYZ(IX1,5)
         I23 = IXYZ(IX1,6)
         DO IX2 = 1,3
            DO I = 1,NTERMB
               FSPD(I,IX1,IX2) = XYZGB(I,IX2)*FSSD(I,IX1,1)
     &                         + (IDT(I1,IX2)*DSSD(I,I23,1)
     &                           +IDT(I2,IX2)*DSSD(I,I13,1)
     &                           +IDT(I3,IX2)*DSSD(I,I12,1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|0|D) TYPE
C
      ENTRY MCP0FDD ()
      DO IX1 = 1,10
         I1  = IXYZ(IX1,1)
         I2  = IXYZ(IX1,2)
         I3  = IXYZ(IX1,3)
         I12 = IXYZ(IX1,4)
         I13 = IXYZ(IX1,5)
         I23 = IXYZ(IX1,6)
         DO IX2 = 1,6
            J1 = IXY(IX2,1)
            J2 = IXY(IX2,2)
            DO I = 1,NTERMB
               FSDD(I,IX1,IX2) = XYZGB(I,J2)*FSPD(I,IX1,J1)
     &                         + (IDT(I1,J2)*DSPD(I,I23,J1)
     &                           +IDT(I2,J2)*DSPD(I,I13,J1)
     &                           +IDT(I3,J2)*DSPD(I,I12,J1)
     &                           +IDT(J1,J2)*FSSD(I,IX1, 1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|0|F) TYPE
C
      ENTRY MCP0FFD ()
      DO IX1 = 1,10
         I1  = IXYZ(IX1,1)
         I2  = IXYZ(IX1,2)
         I3  = IXYZ(IX1,3)
         I12 = IXYZ(IX1,4)
         I13 = IXYZ(IX1,5)
         I23 = IXYZ(IX1,6)
         DO IX2 = 1,10
            J1  = IXYZ(IX2,1)
            J2  = IXYZ(IX2,2)
            J3  = IXYZ(IX2,3)
            J12 = IXYZ(IX2,4)
            DO I = 1,NTERMB
               FSFD(I,IX1,IX2) = XYZGB(I,J3)*FSDD(I,IX1,J12)
     &                         + (IDT(I1,J3)*DSDD(I,I23,J12)
     &                           +IDT(I2,J3)*DSDD(I,I13,J12)
     &                           +IDT(I3,J3)*DSDD(I,I12,J12)
     &                           +IDT(J1,J3)*FSPD(I,IX1,J2 )
     &                           +IDT(J2,J3)*FSPD(I,IX1,J1 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0GSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (G|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (G|0|S) TYPE
C
      DO IX = 1,15
         I1   = IXYZW(IX,1)
         I2   = IXYZW(IX,2)
         I3   = IXYZW(IX,3)
         I4   = IXYZW(IX,4)
         I12  = IXYZW(IX,5)
         I13  = IXYZW(IX,6)
C        I14  = IXYZW(IX,7)
         I23  = IXYZW(IX,8)
C        I24  = IXYZW(IX,9)
C        I34  = IXYZW(IX,10)
         I123 = IXYZW(IX,11)
C        I124 = IXYZW(IX,12)
C        I134 = IXYZW(IX,13)
C        I234 = IXYZW(IX,14)
C
         DO I = 1,NTERMB
            GSSD(I,IX,1) = XYZGA(I,I4)*FSSD(I,I123,1)
     &                    +(IDT(I1,I4)*DSSD(I,I23 ,1)
     &                     +IDT(I2,I4)*DSSD(I,I13 ,1)
     &                     +IDT(I3,I4)*DSSD(I,I12 ,1)
     &                     )/(2*ZETADABC(I))
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|P) TYPE
C
      ENTRY MCP0GPD ()
      DO IX1 = 1,15
         I1   = IXYZW(IX1,1)
         I2   = IXYZW(IX1,2)
         I3   = IXYZW(IX1,3)
         I4   = IXYZW(IX1,4)
C        I12  = IXYZW(IX1,5)
C        I13  = IXYZW(IX1,6)
C        I14  = IXYZW(IX1,7)
C        I23  = IXYZW(IX1,8)
C        I24  = IXYZW(IX1,9)
C        I34  = IXYZW(IX1,10)
         I123 = IXYZW(IX1,11)
         I124 = IXYZW(IX1,12)
         I134 = IXYZW(IX1,13)
         I234 = IXYZW(IX1,14)
C
         DO IX2 = 1,3
            DO I = 1,NTERMB
               GSPD(I,IX1,IX2) = XYZGB(I,IX2)*GSSD(I,IX1 ,1)
     &                         + (IDT(I1,IX2)*FSSD(I,I234,1)
     &                           +IDT(I2,IX2)*FSSD(I,I134,1)
     &                           +IDT(I3,IX2)*FSSD(I,I124,1)
     &                           +IDT(I4,IX2)*FSSD(I,I123,1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|D) TYPE
C
      ENTRY MCP0GDD ()
      DO IX1 = 1,15
         I1   = IXYZW(IX1,1)
         I2   = IXYZW(IX1,2)
         I3   = IXYZW(IX1,3)
         I4   = IXYZW(IX1,4)
C        I12  = IXYZW(IX1,5)
C        I13  = IXYZW(IX1,6)
C        I14  = IXYZW(IX1,7)
C        I23  = IXYZW(IX1,8)
C        I24  = IXYZW(IX1,9)
C        I34  = IXYZW(IX1,10)
         I123 = IXYZW(IX1,11)
         I124 = IXYZW(IX1,12)
         I134 = IXYZW(IX1,13)
         I234 = IXYZW(IX1,14)
C
         DO IX2 = 1,6
            J1 = IXY(IX2,1)
            J2 = IXY(IX2,2)
            DO I = 1,NTERMB
               GSDD(I,IX1,IX2) = XYZGB(I,J2)*GSPD(I,IX1 ,J1)
     &                          +(IDT(I1,J2)*FSPD(I,I234,J1)
     &                           +IDT(I2,J2)*FSPD(I,I134,J1)
     &                           +IDT(I3,J2)*FSPD(I,I124,J1)
     &                           +IDT(I4,J2)*FSPD(I,I123,J1)
     &                           +IDT(J1,J2)*GSSD(I,IX1 , 1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|F) TYPE
C
      ENTRY MCP0GFD ()
      DO IX1 = 1,15
         I1   = IXYZW(IX1,1)
         I2   = IXYZW(IX1,2)
         I3   = IXYZW(IX1,3)
         I4   = IXYZW(IX1,4)
C        I12  = IXYZW(IX1,5)
C        I13  = IXYZW(IX1,6)
C        I14  = IXYZW(IX1,7)
C        I23  = IXYZW(IX1,8)
C        I24  = IXYZW(IX1,9)
C        I34  = IXYZW(IX1,10)
         I123 = IXYZW(IX1,11)
         I124 = IXYZW(IX1,12)
         I134 = IXYZW(IX1,13)
         I234 = IXYZW(IX1,14)
C
         DO IX2 = 1,10
            J1  = IXYZ(IX2,1)
            J2  = IXYZ(IX2,2)
            J3  = IXYZ(IX2,3)
            J12 = IXYZ(IX2,4)
            DO I = 1,NTERMB
               GSFD(I,IX1,IX2) = XYZGB(I,J3)*GSDD(I,IX1 ,J12)
     &                         + (IDT(I1,J3)*FSDD(I,I234,J12)
     &                           +IDT(I2,J3)*FSDD(I,I134,J12)
     &                           +IDT(I3,J3)*FSDD(I,I124,J12)
     &                           +IDT(I4,J3)*FSDD(I,I123,J12)
     &                           +IDT(J1,J3)*GSPD(I,IX1 ,J2 )
     &                           +IDT(J2,J3)*GSPD(I,IX1 ,J1 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|0|G) TYPE
C
      ENTRY MCP0GGD ()
      DO IX1 = 1,15
         I1   = IXYZW(IX1,1)
         I2   = IXYZW(IX1,2)
         I3   = IXYZW(IX1,3)
         I4   = IXYZW(IX1,4)
C        I12  = IXYZW(IX1,5)
C        I13  = IXYZW(IX1,6)
C        I14  = IXYZW(IX1,7)
C        I23  = IXYZW(IX1,8)
C        I24  = IXYZW(IX1,9)
C        I34  = IXYZW(IX1,10)
         I123 = IXYZW(IX1,11)
         I124 = IXYZW(IX1,12)
         I134 = IXYZW(IX1,13)
         I234 = IXYZW(IX1,14)
C
         DO IX2 = 1,15
            J1   = IXYZW(IX2,1)
            J2   = IXYZW(IX2,2)
            J3   = IXYZW(IX2,3)
            J4   = IXYZW(IX2,4)
            J12  = IXYZW(IX2,5)
            J13  = IXYZW(IX2,6)
C           J14  = IXYZW(IX2,7)
            J23  = IXYZW(IX2,8)
C           J24  = IXYZW(IX2,9)
C           J34  = IXYZW(IX2,10)
            J123 = IXYZW(IX2,11)
C           J124 = IXYZW(IX2,12)
C           J134 = IXYZW(IX2,13)
C           J234 = IXYZW(IX2,14)
C
            DO I = 1,NTERMB
               GSGD(I,IX1,IX2) = XYZGB(I,J4)*GSFD(I,IX1 ,J123)
     &                         + (IDT(I1,J4)*FSFD(I,I234,J123)
     &                           +IDT(I2,J4)*FSFD(I,I134,J123)
     &                           +IDT(I3,J4)*FSFD(I,I124,J123)
     &                           +IDT(I4,J4)*FSFD(I,I123,J123)
     &                           +IDT(J1,J4)*GSDD(I,IX1 ,J23 )
     &                           +IDT(J2,J4)*GSDD(I,IX1 ,J13 )
     &                           +IDT(J3,J4)*GSDD(I,IX1 ,J12 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0HSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (H|0|X): D-TERM ENERGY
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IXYZWV(21,30),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA ((IXYZWV(I,J),I=1,21),J=1,15)/
     1   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3,
     2   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 2, 2, 2, 2, 3, 3,
     3   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 2, 2, 2, 3, 3, 3,
     4   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 2, 2, 3, 3, 3, 3,
     5   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 2, 3, 3, 3, 3, 3,
     6   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6,
     7   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6,
     8   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, 6,
     9   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 4, 5, 5, 5, 5, 6,
     &   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 4, 4, 4, 5, 6, 6,
     1   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 4, 4, 5, 5, 6, 6,
     2   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 4, 5, 5, 5, 6, 6,
     3   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 4, 4, 5, 6, 6, 6,
     4   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 4, 5, 5, 6, 6, 6,
     5   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6, 4, 5, 6, 6, 6, 6/
      DATA ((IXYZWV(I,J),I=1,21),J=16,30)/
     6   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 7, 7, 8, 9,10,
     7   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 8, 8, 9,10,
     8   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 7, 8, 8, 8, 9,10,
     9   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9,10,
     &   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9,10,
     1   1, 2, 3, 4, 5, 6, 7, 5, 6, 6, 4, 5, 6, 6, 6, 7, 8, 9, 9, 9,10,
     2   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10, 7, 7, 8, 9,10,10,
     3   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10, 7, 8, 8, 9,10,10,
     4   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10, 7, 8, 9, 9,10,10,
     5   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10, 7, 8, 9,10,10,10,
     6   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,11,11,12,13,14,15,
     7   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,11,12,12,13,14,15,
     8   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,11,12,13,13,14,15,
     9   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10,11,12,13,14,14,15,
     &   1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,11,12,13,14,15,15/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (H|0|S) TYPE
C
      DO IX = 1,21
         I1    = IXYZWV(IX,1)
         I2    = IXYZWV(IX,2)
         I3    = IXYZWV(IX,3)
         I4    = IXYZWV(IX,4)
         I5    = IXYZWV(IX,5)
C        I12   = IXYZWV(IX,6)
C        I13   = IXYZWV(IX,7)
C        I14   = IXYZWV(IX,8)
C        I15   = IXYZWV(IX,9)
C        I23   = IXYZWV(IX,10)
C        I24   = IXYZWV(IX,11)
C        I25   = IXYZWV(IX,12)
C        I34   = IXYZWV(IX,13)
C        I35   = IXYZWV(IX,14)
C        I45   = IXYZWV(IX,15)
         I123  = IXYZWV(IX,16)
         I124  = IXYZWV(IX,17)
C        I125  = IXYZWV(IX,18)
         I134  = IXYZWV(IX,19)
C        I135  = IXYZWV(IX,20)
C        I145  = IXYZWV(IX,21)
         I234  = IXYZWV(IX,22)
C        I235  = IXYZWV(IX,23)
C        I245  = IXYZWV(IX,24)
C        I345  = IXYZWV(IX,25)
         I1234 = IXYZWV(IX,26)
         I1235 = IXYZWV(IX,27)
         I1245 = IXYZWV(IX,28)
         I1345 = IXYZWV(IX,29)
         I2345 = IXYZWV(IX,30)
C
         DO I = 1,NTERMB
            HSSD(I,IX,1) = XYZGA(I,I5)*GSSD(I,I1234,1)
     &                    +(IDT(I1,I5)*FSSD(I,I234 ,1)
     &                     +IDT(I2,I5)*FSSD(I,I134 ,1)
     &                     +IDT(I3,I5)*FSSD(I,I124 ,1)
     &                     +IDT(I4,I5)*FSSD(I,I123 ,1)
     &                     )/(2*ZETADABC(I))
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|P) TYPE
C
      ENTRY MCP0HPD ()
      DO IX1 = 1,21
         I1    = IXYZWV(IX1,1)
         I2    = IXYZWV(IX1,2)
         I3    = IXYZWV(IX1,3)
         I4    = IXYZWV(IX1,4)
         I5    = IXYZWV(IX1,5)
C        I12   = IXYZWV(IX1,6)
C        I13   = IXYZWV(IX1,7)
C        I14   = IXYZWV(IX1,8)
C        I15   = IXYZWV(IX1,9)
C        I23   = IXYZWV(IX1,10)
C        I24   = IXYZWV(IX1,11)
C        I25   = IXYZWV(IX1,12)
C        I34   = IXYZWV(IX1,13)
C        I35   = IXYZWV(IX1,14)
C        I45   = IXYZWV(IX1,15)
         I123  = IXYZWV(IX1,16)
         I124  = IXYZWV(IX1,17)
C        I125  = IXYZWV(IX1,18)
         I134  = IXYZWV(IX1,19)
C        I135  = IXYZWV(IX1,20)
C        I145  = IXYZWV(IX1,21)
         I234  = IXYZWV(IX1,22)
C        I235  = IXYZWV(IX1,23)
C        I245  = IXYZWV(IX1,24)
C        I345  = IXYZWV(IX1,25)
         I1234 = IXYZWV(IX1,26)
         I1235 = IXYZWV(IX1,27)
         I1245 = IXYZWV(IX1,28)
         I1345 = IXYZWV(IX1,29)
         I2345 = IXYZWV(IX1,30)
         DO IX2 = 1,3
            DO I = 1,NTERMB
               HSPD(I,IX1,IX2) = XYZGB(I,IX2)*HSSD(I,IX1  ,1)
     &                         + (IDT(I1,IX2)*GSSD(I,I2345,1)
     &                           +IDT(I2,IX2)*GSSD(I,I1345,1)
     &                           +IDT(I3,IX2)*GSSD(I,I1245,1)
     &                           +IDT(I4,IX2)*GSSD(I,I1235,1)
     &                           +IDT(I5,IX2)*GSSD(I,I1234,1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|D) TYPE
C
      ENTRY MCP0HDD ()
      DO IX1 = 1,21
         I1    = IXYZWV(IX1,1)
         I2    = IXYZWV(IX1,2)
         I3    = IXYZWV(IX1,3)
         I4    = IXYZWV(IX1,4)
         I5    = IXYZWV(IX1,5)
C        I12   = IXYZWV(IX1,6)
C        I13   = IXYZWV(IX1,7)
C        I14   = IXYZWV(IX1,8)
C        I15   = IXYZWV(IX1,9)
C        I23   = IXYZWV(IX1,10)
C        I24   = IXYZWV(IX1,11)
C        I25   = IXYZWV(IX1,12)
C        I34   = IXYZWV(IX1,13)
C        I35   = IXYZWV(IX1,14)
C        I45   = IXYZWV(IX1,15)
         I123  = IXYZWV(IX1,16)
         I124  = IXYZWV(IX1,17)
C        I125  = IXYZWV(IX1,18)
         I134  = IXYZWV(IX1,19)
C        I135  = IXYZWV(IX1,20)
C        I145  = IXYZWV(IX1,21)
         I234  = IXYZWV(IX1,22)
C        I235  = IXYZWV(IX1,23)
C        I245  = IXYZWV(IX1,24)
C        I345  = IXYZWV(IX1,25)
         I1234 = IXYZWV(IX1,26)
         I1235 = IXYZWV(IX1,27)
         I1245 = IXYZWV(IX1,28)
         I1345 = IXYZWV(IX1,29)
         I2345 = IXYZWV(IX1,30)
         DO IX2 = 1,6
            J1 = IXY(IX2,1)
            J2 = IXY(IX2,2)
            DO I = 1,NTERMB
               HSDD(I,IX1,IX2) = XYZGB(I,J2)*HSPD(I,IX1  ,J1)
     &                         + (IDT(I1,J2)*GSPD(I,I2345,J1)
     &                           +IDT(I2,J2)*GSPD(I,I1345,J1)
     &                           +IDT(I3,J2)*GSPD(I,I1245,J1)
     &                           +IDT(I4,J2)*GSPD(I,I1235,J1)
     &                           +IDT(I5,J2)*GSPD(I,I1234,J1)
     &                           +IDT(J1,J2)*HSSD(I,IX1  , 1)
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|F) TYPE
C
      ENTRY MCP0HFD ()
      DO IX1 = 1,21
         I1    = IXYZWV(IX1,1)
         I2    = IXYZWV(IX1,2)
         I3    = IXYZWV(IX1,3)
         I4    = IXYZWV(IX1,4)
         I5    = IXYZWV(IX1,5)
C        I12   = IXYZWV(IX1,6)
C        I13   = IXYZWV(IX1,7)
C        I14   = IXYZWV(IX1,8)
C        I15   = IXYZWV(IX1,9)
C        I23   = IXYZWV(IX1,10)
C        I24   = IXYZWV(IX1,11)
C        I25   = IXYZWV(IX1,12)
C        I34   = IXYZWV(IX1,13)
C        I35   = IXYZWV(IX1,14)
C        I45   = IXYZWV(IX1,15)
         I123  = IXYZWV(IX1,16)
         I124  = IXYZWV(IX1,17)
C        I125  = IXYZWV(IX1,18)
         I134  = IXYZWV(IX1,19)
C        I135  = IXYZWV(IX1,20)
C        I145  = IXYZWV(IX1,21)
         I234  = IXYZWV(IX1,22)
C        I235  = IXYZWV(IX1,23)
C        I245  = IXYZWV(IX1,24)
C        I345  = IXYZWV(IX1,25)
         I1234 = IXYZWV(IX1,26)
         I1235 = IXYZWV(IX1,27)
         I1245 = IXYZWV(IX1,28)
         I1345 = IXYZWV(IX1,29)
         I2345 = IXYZWV(IX1,30)
         DO IX2 = 1,10
            J1  = IXYZ(IX2,1)
            J2  = IXYZ(IX2,2)
            J3  = IXYZ(IX2,3)
            J12 = IXYZ(IX2,4)
            DO I = 1,NTERMB
               HSFD(I,IX1,IX2) = XYZGB(I,J3)*HSDD(I,IX1  ,J12)
     &                         + (IDT(I1,J3)*GSDD(I,I2345,J12)
     &                           +IDT(I2,J3)*GSDD(I,I1345,J12)
     &                           +IDT(I3,J3)*GSDD(I,I1245,J12)
     &                           +IDT(I4,J3)*GSDD(I,I1235,J12)
     &                           +IDT(I5,J3)*GSDD(I,I1234,J12)
     &                           +IDT(J1,J3)*HSPD(I,IX1  ,J2 )
     &                           +IDT(J2,J3)*HSPD(I,IX1  ,J1 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|G) TYPE
C
      ENTRY MCP0HGD ()
      DO IX1 = 1,21
         I1    = IXYZWV(IX1,1)
         I2    = IXYZWV(IX1,2)
         I3    = IXYZWV(IX1,3)
         I4    = IXYZWV(IX1,4)
         I5    = IXYZWV(IX1,5)
C        I12   = IXYZWV(IX1,6)
C        I13   = IXYZWV(IX1,7)
C        I14   = IXYZWV(IX1,8)
C        I15   = IXYZWV(IX1,9)
C        I23   = IXYZWV(IX1,10)
C        I24   = IXYZWV(IX1,11)
C        I25   = IXYZWV(IX1,12)
C        I34   = IXYZWV(IX1,13)
C        I35   = IXYZWV(IX1,14)
C        I45   = IXYZWV(IX1,15)
         I123  = IXYZWV(IX1,16)
         I124  = IXYZWV(IX1,17)
C        I125  = IXYZWV(IX1,18)
         I134  = IXYZWV(IX1,19)
C        I135  = IXYZWV(IX1,20)
C        I145  = IXYZWV(IX1,21)
         I234  = IXYZWV(IX1,22)
C        I235  = IXYZWV(IX1,23)
C        I245  = IXYZWV(IX1,24)
C        I345  = IXYZWV(IX1,25)
         I1234 = IXYZWV(IX1,26)
         I1235 = IXYZWV(IX1,27)
         I1245 = IXYZWV(IX1,28)
         I1345 = IXYZWV(IX1,29)
         I2345 = IXYZWV(IX1,30)
         DO IX2 = 1,15
            J1   = IXYZW(IX2,1)
            J2   = IXYZW(IX2,2)
            J3   = IXYZW(IX2,3)
            J4   = IXYZW(IX2,4)
            J12  = IXYZW(IX2,5)
            J13  = IXYZW(IX2,6)
C           J14  = IXYZW(IX2,7)
            J23  = IXYZW(IX2,8)
C           J24  = IXYZW(IX2,9)
C           J34  = IXYZW(IX2,10)
            J123 = IXYZW(IX2,11)
            J124 = IXYZW(IX2,12)
            J134 = IXYZW(IX2,13)
            J234 = IXYZW(IX2,14)
            DO I = 1,NTERMB
               HSGD(I,IX1,IX2) = XYZGB(I,J4)*HSFD(I,IX1  ,J123)
     &                         + (IDT(I1,J4)*GSFD(I,I2345,J123)
     &                           +IDT(I2,J4)*GSFD(I,I1345,J123)
     &                           +IDT(I3,J4)*GSFD(I,I1245,J123)
     &                           +IDT(I4,J4)*GSFD(I,I1235,J123)
     &                           +IDT(I5,J4)*GSFD(I,I1234,J123)
     &                           +IDT(J1,J4)*HSDD(I,IX1  ,J23 )
     &                           +IDT(J2,J4)*HSDD(I,IX1  ,J13 )
     &                           +IDT(J3,J4)*HSDD(I,IX1  ,J12 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (H|0|H) TYPE
C
      ENTRY MCP0HHD ()
      DO IX1 = 1,21
         I1    = IXYZWV(IX1,1)
         I2    = IXYZWV(IX1,2)
         I3    = IXYZWV(IX1,3)
         I4    = IXYZWV(IX1,4)
         I5    = IXYZWV(IX1,5)
C        I12   = IXYZWV(IX1,6)
C        I13   = IXYZWV(IX1,7)
C        I14   = IXYZWV(IX1,8)
C        I15   = IXYZWV(IX1,9)
C        I23   = IXYZWV(IX1,10)
C        I24   = IXYZWV(IX1,11)
C        I25   = IXYZWV(IX1,12)
C        I34   = IXYZWV(IX1,13)
C        I35   = IXYZWV(IX1,14)
C        I45   = IXYZWV(IX1,15)
         I123  = IXYZWV(IX1,16)
         I124  = IXYZWV(IX1,17)
C        I125  = IXYZWV(IX1,18)
         I134  = IXYZWV(IX1,19)
C        I135  = IXYZWV(IX1,20)
C        I145  = IXYZWV(IX1,21)
         I234  = IXYZWV(IX1,22)
C        I235  = IXYZWV(IX1,23)
C        I245  = IXYZWV(IX1,24)
C        I345  = IXYZWV(IX1,25)
         I1234 = IXYZWV(IX1,26)
         I1235 = IXYZWV(IX1,27)
         I1245 = IXYZWV(IX1,28)
         I1345 = IXYZWV(IX1,29)
         I2345 = IXYZWV(IX1,30)
         DO IX2 = 1,21
            J1    = IXYZWV(IX2,1)
            J2    = IXYZWV(IX2,2)
            J3    = IXYZWV(IX2,3)
            J4    = IXYZWV(IX2,4)
            J5    = IXYZWV(IX2,5)
            J12   = IXYZWV(IX2,6)
            J13   = IXYZWV(IX2,7)
C           J14   = IXYZWV(IX2,8)
C           J15   = IXYZWV(IX2,9)
            J23   = IXYZWV(IX2,10)
C           J24   = IXYZWV(IX2,11)
C           J25   = IXYZWV(IX2,12)
C           J34   = IXYZWV(IX2,13)
C           J35   = IXYZWV(IX2,14)
C           J45   = IXYZWV(IX2,15)
            J123  = IXYZWV(IX2,16)
            J124  = IXYZWV(IX2,17)
C           J125  = IXYZWV(IX2,18)
            J134  = IXYZWV(IX2,19)
C           J135  = IXYZWV(IX2,20)
C           J145  = IXYZWV(IX2,21)
            J234  = IXYZWV(IX2,22)
C           J235  = IXYZWV(IX2,23)
C           J245  = IXYZWV(IX2,24)
C           J345  = IXYZWV(IX2,25)
            J1234 = IXYZWV(IX2,26)
C           J1235 = IXYZWV(IX2,27)
C           J1245 = IXYZWV(IX2,28)
C           J1345 = IXYZWV(IX2,29)
C           J2345 = IXYZWV(IX2,30)
            DO I = 1,NTERMB
               HSHD(I,IX1,IX2) = XYZGB(I,J5)*HSGD(I,IX1  ,J1234)
     &                         + (IDT(I1,J5)*GSGD(I,I2345,J1234)
     &                           +IDT(I2,J5)*GSGD(I,I1345,J1234)
     &                           +IDT(I3,J5)*GSGD(I,I1245,J1234)
     &                           +IDT(I4,J5)*GSGD(I,I1235,J1234)
     &                           +IDT(I5,J5)*GSGD(I,I1234,J1234)
     &                           +IDT(J1,J5)*HSFD(I,IX1  ,J234 )
     &                           +IDT(J2,J5)*HSFD(I,IX1  ,J134 )
     &                           +IDT(J3,J5)*HSFD(I,IX1  ,J124 )
     &                           +IDT(J4,J5)*HSFD(I,IX1  ,J123 )
     &                           )/(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C            MCP C-TERM OPERATOR 1ST DERIVATIVE CALCULATION           @C
C     ~ LEVEL1 RECURSION FORMULA : UP TO G FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.04.27                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP1CS(ZB)
C=======================================================================
C
C     LEVEL 1 RECURSION (S|1|S): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
      CALL MCP0SPC(0)
      CALL MCP1SSC(0)
C
      DO IXD=1,3
         DO I = 1,NTERMA
            IF (CB2*ETA(I).LE.7.0D+2) THEN
               VAL = -ZEFF*
     &              (                              SPSC(0,I,1,IXD,  1)
     &               +2*EXA(I)*(                   SSPC(0,I,1    ,IXD)
     &                  - (ZB/ZETAD(I))*XYZCB(IXD)*SSSC(0,I))
     &              )/EXP(CB2*ETA(I))
               GMCP1C(1,IXD,1) = GMCP1C(1,IXD,1) + VAL * COEFA(I)
            ENDIF
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP1CP (NCA,NCB,ZB)
C=======================================================================
C
C     LEVEL 1 RECURSION (P|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
      DIMENSION ID2P(3,3)
      DATA ID2P/1,2,3,
     &          2,4,5,
     &          3,5,6/
C
C     (P|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP1SSC(1)
         CALL MCP0PSC(1)
         CALL MCP0PPC(0)
         CALL MCP1PSC(0)
C
         DO IXD=1,3
            DO IX1 = 1,NCA
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                             PPSC(0,I,IX1,IXD,  1)
     &       +2*EXA(I)*(                  PSPC(0,I,IX1    ,IXD)
     &         - (ZB/ZETAD(I))*XYZCB(IXD)*PSSC(0,I,IX1    ,  1))
     &      )/EXP(CB2*ETA(I))
                  GMCP1C(IX1,IXD,1) = GMCP1C(IX1,IXD,1) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (P|1|P) TYPE
C
      ELSE
C
         CALL MCP1SSC(2)
         CALL MCP0PSC(2)
         CALL MCP0SPC(1)
         CALL MCP0PPC(1)
         CALL MCP1PSC(1)
         CALL MCP0PDC(0)
         CALL MCP1PPC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  IXD2 = ID2P(IXD,IX2)
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               PPPC(0,I,IX1,IXD, IX2)
     &         +2*EXA(I)*(                  PSDC(0,I,IX1    ,IXD2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*PSPC(0,I,IX1    , IX2))
     &       +(EXA(I)/ZETAD(I))*XYZCB(IX2)*(
     &                                      PPSC(0,I,IX1,IXD,   1)
     &         +2*EXA(I)*(                  PSPC(0,I,IX1    , IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*PSSC(0,I,IX1    ,   1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1CD (NCA,NCB,ZB)
C=======================================================================
C
C     LEVEL 1 RECURSION (D|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
      DIMENSION ID2D(3,6),IXY(6,2)
      DATA ID2D/ 1, 2, 3,
     &           2, 4, 5,
     &           3, 5, 6,
     &           4, 7, 8,
     &           5, 8, 9,
     &           6, 9,10/
      DATA  IXY/ 1, 1, 1, 2, 2, 3,
     &           1, 2, 3, 2, 3, 3/
C
C     (D|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP1SSC(2)
         CALL MCP0PSC(2)
         CALL MCP1PSC(1)
         CALL MCP0DSC(1)
         CALL MCP0DPC(0)
         CALL MCP1DSC(0)
C
         DO IXD=1,3
            DO IX1 = 1,NCA
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                             DPSC(0,I,IX1,IXD,  1)
     &       +2*EXA(I)*(                  DSPC(0,I,IX1    ,IXD)
     &         - (ZB/ZETAD(I))*XYZCB(IXD)*DSSC(0,I,IX1    ,  1))
     &      )/EXP(CB2*ETA(I))
                  GMCP1C(IX1,IXD,1) = GMCP1C(IX1,IXD,1) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (D|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP1SSC(3)
         CALL MCP0PSC(3)
         CALL MCP1PSC(2)
         CALL MCP0DSC(2)
         CALL MCP0PPC(1)
         CALL MCP0DPC(1)
         CALL MCP1DSC(1)
         CALL MCP0DDC(0)
         CALL MCP1DPC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  IXD2 = ID2D(IXD,IX2)
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               DPPC(0,I,IX1,IXD, IX2)
     &         +2*EXA(I)*(                  DSDC(0,I,IX1    ,IXD2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSPC(0,I,IX1    , IX2))
     &       +(EXA(I)/ZETAD(I))*XYZCB(IX2)*(
     &                                      DPSC(0,I,IX1,IXD,   1)
     &         +2*EXA(I)*(                  DSPC(0,I,IX1    , IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSSC(0,I,IX1    ,   1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (D|1|D) TYPE
C
      ELSE
C
         CALL MCP1SSC(4)
         CALL MCP0PSC(4)
         CALL MCP1PSC(3)
         CALL MCP0DSC(3)
         CALL MCP0SPC(2)
         CALL MCP0PPC(2)
         CALL MCP0DPC(2)
         CALL MCP1DSC(2)
         CALL MCP0PDC(1)
         CALL MCP1PPC(1)
         CALL MCP0DDC(1)
         CALL MCP1DPC(1)
         CALL MCP0DFC(0)
         CALL MCP1DDC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
C
                  J1 = IXY(IX2,1)
                  J2 = IXY(IX2,2)
C
                  IXDJ1 = ID2D(IXD,J1)
                  IXDJ2 = ID2D(IXD,J2)
                  IXD2  = ID2D(IXD,IX2)
C
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               DPDC(0,I,IX1,IXD,  IX2)
     &         +2*EXA(I)*(                  DSFC(0,I,IX1    , IXD2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSDC(0,I,IX1    ,  IX2))
     &       +(EXA(I)/ZETAD(I))*(
     &          XYZCB(J1)*(
     &                                      DPPC(0,I,IX1,IXD,   J2)
     &           +2*EXA(I)*(                DSDC(0,I,IX1    ,IXDJ2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSPC(0,I,IX1    ,   J2)))
     &         +XYZCB(J2)*(
     &                                      DPPC(0,I,IX1,IXD,   J1)
     &           +2*EXA(I)*(                DSDC(0,I,IX1    ,IXDJ1)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSPC(0,I,IX1    ,   J1))))
     &       +(EXA(I)/ZETAD(I))**2*
     &          XYZCB(J1)*XYZCB(J2)*(
     &                                      DPSC(0,I,IX1,IXD,    1)
     &           +2*EXA(I)*(                DSPC(0,I,IX1    ,  IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*DSSC(0,I,IX1    ,    1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1CF (NCA,NCB,ZB)
C=======================================================================
C
C     LEVEL 1 RECURSION (F|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
      DIMENSION ID2F(3,10),IXY(6,2),IXYZ(10,6)
      DATA ID2F/ 1, 2, 3,
     &           2, 4, 5,
     &           3, 5, 6,
     &           4, 7, 8,
     &           5, 8, 9,
     &           6, 9,10,
     &           7,11,12,
     &           8,12,13,
     &           9,13,14,
     &          10,14,15/
      DATA  IXY/ 1, 1, 1, 2, 2, 3,
     &           1, 2, 3, 2, 3, 3/
      DATA IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &           1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &           1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &           1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &           1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &           1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
C
C     (F|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP1SSC(3)
         CALL MCP0PSC(3)
         CALL MCP1PSC(2)
         CALL MCP0DSC(2)
         CALL MCP1DSC(1)
         CALL MCP0FSC(1)
         CALL MCP0FPC(0)
         CALL MCP1FSC(0)
C
         DO IXD=1,3
            DO IX1 = 1,NCA
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               FPSC(0,I,IX1,IXD,  1)
     &         +2*EXA(I)*(                  FSPC(0,I,IX1    ,IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSSC(0,I,IX1    ,  1))
     &      )/EXP(CB2*ETA(I))
                  GMCP1C(IX1,IXD,1) = GMCP1C(IX1,IXD,1) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP1SSC(4)
         CALL MCP0PSC(4)
         CALL MCP1PSC(3)
         CALL MCP0DSC(3)
         CALL MCP1DSC(2)
         CALL MCP0FSC(2)
         CALL MCP0DPC(1)
         CALL MCP0FPC(1)
         CALL MCP1FSC(1)
         CALL MCP0FDC(0)
         CALL MCP1FPC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  IXD2 = ID2F(IXD,IX2)
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               FPPC(0,I,IX1,IXD, IX2)
     &         +2*EXA(I)*(                  FSDC(0,I,IX1    ,IXD2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    , IX2))
     &       +(EXA(I)/ZETAD(I))*XYZCB(IX2)*(
     &                                      FPSC(0,I,IX1,IXD,   1)
     &         +2*EXA(I)*(                  FSPC(0,I,IX1    , IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSSC(0,I,IX1    ,   1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP1SSC(5)
         CALL MCP0PSC(5)
         CALL MCP1PSC(4)
         CALL MCP0DSC(4)
         CALL MCP1DSC(3)
         CALL MCP0FSC(3)
         CALL MCP0PPC(2)
         CALL MCP0DPC(2)
         CALL MCP0FPC(2)
         CALL MCP1FSC(2)
         CALL MCP0DDC(1)
         CALL MCP1DPC(1)
         CALL MCP0FDC(1)
         CALL MCP1FPC(1)
         CALL MCP0FFC(0)
         CALL MCP1FDC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  J1 = IXY(IX2,1)
                  J2 = IXY(IX2,2)
C
                  IXDJ1 = ID2F(IXD,J1)
                  IXDJ2 = ID2F(IXD,J2)
                  IXD2  = ID2F(IXD,IX2)
C
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                               FPDC(0,I,IX1,IXD,  IX2)
     &         +2*EXA(I)*(                  FSFC(0,I,IX1    , IXD2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSDC(0,I,IX1    ,  IX2))
     &       +(EXA(I)/ZETAD(I))*(
     &             XYZCB(J1)*(
     &                                      FPPC(0,I,IX1,IXD,   J2)
     &          +2*EXA(I)*(                 FSDC(0,I,IX1    ,IXDJ2)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    ,   J2)))
     &            +XYZCB(J2)*(
     &                                      FPPC(0,I,IX1,IXD,   J1)
     &          +2*EXA(I)*(                 FSDC(0,I,IX1    ,IXDJ1)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    ,   J1))))
     &       +(EXA(I)/ZETAD(I))**2*
     &             XYZCB(J1)*XYZCB(J2)*(
     &                                      FPSC(0,I,IX1,IXD,    1)
     &          +2*EXA(I)*(                 FSPC(0,I,IX1    ,  IXD)
     &           - (ZB/ZETAD(I))*XYZCB(IXD)*FSSC(0,I,IX1    ,    1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|F) TYPE
C
      ELSE
C
         CALL MCP1SSC(6)
         CALL MCP0PSC(6)
         CALL MCP1PSC(5)
         CALL MCP0DSC(5)
         CALL MCP1DSC(4)
         CALL MCP0FSC(4)
         CALL MCP0SPC(3)
         CALL MCP0PPC(3)
         CALL MCP0DPC(3)
         CALL MCP0FPC(3)
         CALL MCP1FSC(3)
         CALL MCP0PDC(2)
         CALL MCP1PPC(2)
         CALL MCP0DDC(2)
         CALL MCP1DPC(2)
         CALL MCP0FDC(2)
         CALL MCP1FPC(2)
         CALL MCP0DFC(1)
         CALL MCP1DDC(1)
         CALL MCP0FFC(1)
         CALL MCP1FDC(1)
         CALL MCP0FGC(0)
         CALL MCP1FFC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  J1  = IXYZ(IX2,1)
                  J2  = IXYZ(IX2,2)
                  J3  = IXYZ(IX2,3)
                  J12 = IXYZ(IX2,4)
                  J13 = IXYZ(IX2,5)
                  J23 = IXYZ(IX2,6)
C
                  IXDJ1  = ID2F(IXD,J1)
                  IXDJ2  = ID2F(IXD,J2)
                  IXDJ3  = ID2F(IXD,J3)
                  IXDJ12 = ID2F(IXD,J12)
                  IXDJ13 = ID2F(IXD,J13)
                  IXDJ23 = ID2F(IXD,J23)
                  IXD2   = ID2F(IXD,IX2)
C
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                              FPFC(0,I,IX1,IXD,  IX2)
     &         +2*EXA(I)*(                 FSGC(0,I,IX1    , IXD2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSFC(0,I,IX1    ,  IX2))
     &       +(EXA(I)/ZETAD(I))*(
     &                       XYZCB(J1)*(
     &                                     FPDC(0,I,IX1,IXD,   J23)
     &         +2*EXA(I)*(                 FSFC(0,I,IX1    ,IXDJ23)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSDC(0,I,IX1    ,   J23)))
     &                       +XYZCB(J2)*(
     &                                     FPDC(0,I,IX1,IXD,   J13)
     &         +2*EXA(I)*(                 FSFC(0,I,IX1    ,IXDJ13)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSDC(0,I,IX1    ,   J13)))
     &                       +XYZCB(J3)*(
     &                                     FPDC(0,I,IX1,IXD,   J12)
     &         +2*EXA(I)*(                 FSFC(0,I,IX1    ,IXDJ12)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSDC(0,I,IX1    ,   J12))))
     &       +(EXA(I)/ZETAD(I))**2*(
     &                        XYZCB(J1)*XYZCB(J2)*(
     &                                     FPPC(0,I,IX1,IXD,    J3)
     &         +2*EXA(I)*(                 FSDC(0,I,IX1    , IXDJ3)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    ,    J3)))
     &                       +XYZCB(J1)*XYZCB(J3)*(
     &                                     FPPC(0,I,IX1,IXD,    J2)
     &         +2*EXA(I)*(                 FSDC(0,I,IX1    , IXDJ2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    ,    J2)))
     &                       +XYZCB(J2)*XYZCB(J3)*(
     &                                     FPPC(0,I,IX1,IXD,    J1)
     &         +2*EXA(I)*(                 FSDC(0,I,IX1    , IXDJ1)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSPC(0,I,IX1    ,    J1))))
     &       +(EXA(I)/ZETAD(I))**3*(
     &                       XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*(
     &                                     FPSC(0,I,IX1,IXD,     1)
     &         +2*EXA(I)*(                 FSPC(0,I,IX1    ,   IXD)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*FSSC(0,I,IX1    ,     1))))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1CG (NCA,NCB,ZB)
C=======================================================================
C
C     LEVEL 1 RECURSION (G|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
      DIMENSION ID2G(3,15),IXY(6,2),IXYZ(10,6),IXYZW(15,14)
      DATA  ID2G/ 1, 2, 3,
     &            2, 4, 5,
     &            3, 5, 6,
     &            4, 7, 8,
     &            5, 8, 9,
     &            6, 9,10,
     &            7,11,12,
     &            8,12,13,
     &            9,13,14,
     &           10,14,15,
     &           11,16,17,
     &           12,17,18,
     &           13,18,19,
     &           14,19,20,
     &           15,20,21/
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
C
C     (G|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP1SSC(4)
         CALL MCP0PSC(4)
         CALL MCP1PSC(3)
         CALL MCP0DSC(3)
         CALL MCP1DSC(2)
         CALL MCP0FSC(2)
         CALL MCP1FSC(1)
         CALL MCP0GSC(1)
         CALL MCP0GPC(0)
         CALL MCP1GSC(0)
C
         DO IXD=1,3
            DO IX1 = 1,NCA
               DO I = 1,NTERMA
                  IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                              GPSC(0,I,IX1,IXD,  1)
     &         +2*EXA(I)*(                 GSPC(0,I,IX1    ,IXD)
     &          - (ZB/ZETAD(I))*XYZCB(IXD)*GSSC(0,I,IX1    ,  1))
     &      )/EXP(CB2*ETA(I))
                  GMCP1C(IX1,IXD,1) = GMCP1C(IX1,IXD,1) + VAL * COEFA(I)
                  ENDIF
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP1SSC(5)
         CALL MCP0PSC(5)
         CALL MCP1PSC(4)
         CALL MCP0DSC(4)
         CALL MCP1DSC(3)
         CALL MCP0FSC(3)
         CALL MCP1FSC(2)
         CALL MCP0GSC(2)
         CALL MCP0FPC(1)
         CALL MCP0GPC(1)
         CALL MCP1GSC(1)
         CALL MCP0GDC(0)
         CALL MCP1GPC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  IXD2 = ID2G(IXD,IX2)
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                              GPPC(0,I,IX1,IXD, IX2)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    ,IXD2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    , IX2))
     &               +(EXA(I)/ZETAD(I))*
     &                          XYZCB(IX2)*(
     &                                     GPSC(0,I,IX1,IXD,   1)
     &         +2*EXA(I)*(                 GSPC(0,I,IX1    , IXD)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSSC(0,I,IX1    ,   1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP1SSC(6)
         CALL MCP0PSC(6)
         CALL MCP1PSC(5)
         CALL MCP0DSC(5)
         CALL MCP1DSC(4)
         CALL MCP0FSC(4)
         CALL MCP1FSC(3)
         CALL MCP0GSC(3)
         CALL MCP0DPC(2)
         CALL MCP0FPC(2)
         CALL MCP0GPC(2)
         CALL MCP1GSC(2)
         CALL MCP0FDC(1)
         CALL MCP1FPC(1)
         CALL MCP0GDC(1)
         CALL MCP1GPC(1)
         CALL MCP0GFC(0)
         CALL MCP1GDC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  J1 = IXY(IX2,1)
                  J2 = IXY(IX2,2)
                  IXDJ1 = ID2G(IXD,J1)
                  IXDJ2 = ID2G(IXD,J2)
                  IXD2  = ID2G(IXD,IX2)
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                              GPDC(0,I,IX1,IXD,  IX2)
     &         +2*EXA(I)*(                 GSFC(0,I,IX1    , IXD2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,  IX2))
     &             +(EXA(I)/ZETAD(I))*(
     &                        XYZCB(J1)*(
     &                                     GPPC(0,I,IX1,IXD,   J2)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    ,IXDJ2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,   J2)))
     &                       +XYZCB(J2)*(
     &                                     GPPC(0,I,IX1,IXD,   J1)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    ,IXDJ1)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,   J1))))
     &                       +(EXA(I)/ZETAD(I))**2*
     &                       XYZCB(J1)*XYZCB(J2)*(
     &                                     GPSC(0,I,IX1,IXD,    1)
     &         +2*EXA(I)*(                 GSPC(0,I,IX1    ,  IXD)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSSC(0,I,IX1    ,    1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
         CALL MCP1SSC(7)
         CALL MCP0PSC(7)
         CALL MCP1PSC(6)
         CALL MCP0DSC(6)
         CALL MCP1DSC(5)
         CALL MCP0FSC(5)
         CALL MCP1FSC(4)
         CALL MCP0GSC(4)
         CALL MCP0PPC(3)
         CALL MCP0DPC(3)
         CALL MCP0FPC(3)
         CALL MCP0GPC(3)
         CALL MCP1GSC(3)
         CALL MCP0DDC(2)
         CALL MCP1DPC(2)
         CALL MCP0FDC(2)
         CALL MCP1FPC(2)
         CALL MCP0GDC(2)
         CALL MCP1GPC(2)
         CALL MCP0FFC(1)
         CALL MCP1FDC(1)
         CALL MCP0GFC(1)
         CALL MCP1GDC(1)
         CALL MCP0GGC(0)
         CALL MCP1GFC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  J1  = IXYZ(IX2,1)
                  J2  = IXYZ(IX2,2)
                  J3  = IXYZ(IX2,3)
                  J12 = IXYZ(IX2,4)
                  J13 = IXYZ(IX2,5)
                  J23 = IXYZ(IX2,6)
C
                  IXDJ1  = ID2G(IXD,J1)
                  IXDJ2  = ID2G(IXD,J2)
                  IXDJ3  = ID2G(IXD,J3)
                  IXDJ12 = ID2G(IXD,J12)
                  IXDJ13 = ID2G(IXD,J13)
                  IXDJ23 = ID2G(IXD,J23)
                  IXD2   = ID2G(IXD,IX2)
C
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                              GPFC(0,I,IX1,IXD,   IX2)
     &         +2*EXA(I)*(                 GSGC(0,I,IX1    ,  IXD2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSFC(0,I,IX1    ,   IX2))
     &             +(EXA(I)/ZETAD(I))*(
     &                        XYZCB(J1)*(
     &                                     GPDC(0,I,IX1,IXD,   J23)
     &         +2*EXA(I)*(                 GSFC(0,I,IX1    ,IXDJ23)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,   J23)))
     &                       +XYZCB(J2)*(
     &                                     GPDC(0,I,IX1,IXD,   J13)
     &         +2*EXA(I)*(                 GSFC(0,I,IX1    ,IXDJ13)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,   J13)))
     &                       +XYZCB(J3)*(
     &                                     GPDC(0,I,IX1,IXD,   J12)
     &         +2*EXA(I)*(                 GSFC(0,I,IX1    ,IXDJ12)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,   J12))))
     &             +(EXA(I)/ZETAD(I))**2*(
     &                        XYZCB(J1)*XYZCB(J2)*(
     &                                     GPPC(0,I,IX1,IXD,    J3)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    , IXDJ3)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,    J3)))
     &                       +XYZCB(J1)*XYZCB(J3)*(
     &                                     GPPC(0,I,IX1,IXD,    J2)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    , IXDJ2)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,    J2)))
     &                       +XYZCB(J2)*XYZCB(J3)*(
     &                                     GPPC(0,I,IX1,IXD,    J1)
     &         +2*EXA(I)*(                 GSDC(0,I,IX1    , IXDJ1)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,    J1))))
     &             +(EXA(I)/ZETAD(I))**3*
     &                        XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*(
     &                                     GPSC(0,I,IX1,IXD,     1)
     &         +2*EXA(I)*(                 GSPC(0,I,IX1    ,   IXD)
     &           -(ZB/ZETAD(I))*XYZCB(IXD)*GSSC(0,I,IX1    ,     1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|G) TYPE
C
      ELSE
C
         CALL MCP1SSC(8)
         CALL MCP0PSC(8)
         CALL MCP1PSC(7)
         CALL MCP0DSC(7)
         CALL MCP1DSC(6)
         CALL MCP0FSC(6)
         CALL MCP1FSC(5)
         CALL MCP0GSC(5)
         CALL MCP0SPC(4)
         CALL MCP0PPC(4)
         CALL MCP0DPC(4)
         CALL MCP0FPC(4)
         CALL MCP0GPC(4)
         CALL MCP1GSC(4)
         CALL MCP0PDC(3)
         CALL MCP1PPC(3)
         CALL MCP0DDC(3)
         CALL MCP1DPC(3)
         CALL MCP0FDC(3)
         CALL MCP1FPC(3)
         CALL MCP0GDC(3)
         CALL MCP1GPC(3)
         CALL MCP0DFC(2)
         CALL MCP1DDC(2)
         CALL MCP0FFC(2)
         CALL MCP1FDC(2)
         CALL MCP0GFC(2)
         CALL MCP1GDC(2)
         CALL MCP0FGC(1)
         CALL MCP1FFC(1)
         CALL MCP0GGC(1)
         CALL MCP1GFC(1)
         CALL MCP0GHC(0)
         CALL MCP1GGC(0)
C
         DO IXD = 1,3
            DO IX1 = 1,NCA
               DO IX2 = 1,NCB
                  J1   = IXYZW(IX2,1)
                  J2   = IXYZW(IX2,2)
                  J3   = IXYZW(IX2,3)
                  J4   = IXYZW(IX2,4)
                  J12  = IXYZW(IX2,5)
                  J13  = IXYZW(IX2,6)
                  J14  = IXYZW(IX2,7)
                  J23  = IXYZW(IX2,8)
                  J24  = IXYZW(IX2,9)
                  J34  = IXYZW(IX2,10)
                  J123 = IXYZW(IX2,11)
                  J124 = IXYZW(IX2,12)
                  J134 = IXYZW(IX2,13)
                  J234 = IXYZW(IX2,14)
C
                  IXDJ1   = ID2G(IXD,J1)
                  IXDJ2   = ID2G(IXD,J2)
                  IXDJ3   = ID2G(IXD,J3)
                  IXDJ4   = ID2G(IXD,J4)
                  IXDJ12  = ID2G(IXD,J12)
                  IXDJ13  = ID2G(IXD,J13)
                  IXDJ14  = ID2G(IXD,J14)
                  IXDJ23  = ID2G(IXD,J23)
                  IXDJ24  = ID2G(IXD,J24)
                  IXDJ34  = ID2G(IXD,J34)
                  IXDJ123 = ID2G(IXD,J123)
                  IXDJ124 = ID2G(IXD,J124)
                  IXDJ134 = ID2G(IXD,J134)
                  IXDJ234 = ID2G(IXD,J234)
                  IXD2    = ID2G(IXD,IX2)
C
                  DO I = 1,NTERMA
                     IF (CB2*ETA(I).LE.7.0D+2) THEN
       VAL = -ZEFF*
     &      (                             GPGC(0,I,IX1,IXD,    IX2)
     &         +2*EXA(I)*(                GSHC(0,I,IX1    ,   IXD2)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSGC(0,I,IX1    ,    IX2))
     &             +(EXA(I)/ZETAD(I))*(
     &                    XYZCB(J1)*(
     &                                    GPFC(0,I,IX1,IXD,   J234)
     &         +2*EXA(I)*(                GSGC(0,I,IX1    ,IXDJ234)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSFC(0,I,IX1    ,   J234)))
     &                    +XYZCB(J2)*(
     &                                    GPFC(0,I,IX1,IXD,   J134)
     &         +2*EXA(I)*(                GSGC(0,I,IX1    ,IXDJ134)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSFC(0,I,IX1    ,   J134)))
     &                    +XYZCB(J3)*(
     &                                    GPFC(0,I,IX1,IXD,   J124)
     &         +2*EXA(I)*(                GSGC(0,I,IX1    ,IXDJ124)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSFC(0,I,IX1    ,   J124)))
     &                    +XYZCB(J4)*(
     &                                    GPFC(0,I,IX1,IXD,   J123)
     &         +2*EXA(I)*(                GSGC(0,I,IX1    ,IXDJ123)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSFC(0,I,IX1    ,   J123))))
     &             +(EXA(I)/ZETAD(I))**2*(
     &                    XYZCB(J1)*XYZCB(J2)*(
     &                                    GPDC(0,I,IX1,IXD,    J34)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ34)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J34)))
     &                    +XYZCB(J1)*XYZCB(J3)*(
     &                                    GPDC(0,I,IX1,IXD,    J24)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ24)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J24)))
     &                    +XYZCB(J1)*XYZCB(J4)*(
     &                                    GPDC(0,I,IX1,IXD,    J23)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ23)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J23)))
     &                    +XYZCB(J2)*XYZCB(J3)*(
     &                                    GPDC(0,I,IX1,IXD,    J14)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ14)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J14)))
     &                    +XYZCB(J2)*XYZCB(J4)*(
     &                                    GPDC(0,I,IX1,IXD,    J13)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ13)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J13)))
     &                    +XYZCB(J3)*XYZCB(J4)*(
     &                                    GPDC(0,I,IX1,IXD,    J12)
     &         +2*EXA(I)*(                GSFC(0,I,IX1    , IXDJ12)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSDC(0,I,IX1    ,    J12))))
     &             +(EXA(I)/ZETAD(I))**3*(
     &                    XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*(
     &                                    GPPC(0,I,IX1,IXD,     J4)
     &         +2*EXA(I)*(                GSDC(0,I,IX1    ,  IXDJ4)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,     J4)))
     &                    +XYZCB(J1)*XYZCB(J2)*XYZCB(J4)*(
     &                                    GPPC(0,I,IX1,IXD,     J3)
     &         +2*EXA(I)*(                GSDC(0,I,IX1    ,  IXDJ3)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,     J3)))
     &                    +XYZCB(J1)*XYZCB(J3)*XYZCB(J4)*(
     &                                    GPPC(0,I,IX1,IXD,     J2)
     &         +2*EXA(I)*(                GSDC(0,I,IX1    ,  IXDJ2)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,     J2)))
     &                    +XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*(
     &                                    GPPC(0,I,IX1,IXD,     J1)
     &         +2*EXA(I)*(                GSDC(0,I,IX1    ,  IXDJ1)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSPC(0,I,IX1    ,     J1))))
     &             +(EXA(I)/ZETAD(I))**4*
     &                    XYZCB(J1)*XYZCB(J2)*XYZCB(J3)*XYZCB(J4)*(
     &                                    GPSC(0,I,IX1,IXD,      1)
     &         +2*EXA(I)*(                GSPC(0,I,IX1    ,    IXD)
     &          -(ZB/ZETAD(I))*XYZCB(IXD)*GSSC(0,I,IX1    ,      1)))
     &      )/EXP(CB2*ETA(I))
              GMCP1C(IX1,IXD,IX2) = GMCP1C(IX1,IXD,IX2) + VAL * COEFA(I)
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C            MCP C-TERM OPERATOR 1ST DERIVATIVE CALCULATION           @C
C     ~ LEVEL2 RECURSION FORMULA : UP TO G FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.04.28                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP1SSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (S|1|S): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C     DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
C
C     (S|1|S) TYPE
C
      DO M=0,MX
         DO IDX = 1,3
            DO I = 1,NTERMA
C     EQUATON(A25) OBARA-SAIKA:   J.CHEM.PHYS. 84,3963 (1986)
              SPSC(M,I,1,IDX,1) = 2*ZETACABC(I)*XYZQC(I,IDX)*SSSC(M+1,I)
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1PSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (P|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IDT(3,3)
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (P|1|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,3
               DO I = 1,NTERMA
                 PPSC(M,I,IX1,IXD,1) = XYZQA(I,IX1) * SPSC(M ,I,1,IXD,1)
     &                               - XYZQC(I,IX1) * SPSC(M1,I,1,IXD,1)
     &                               + IDT(IXD,IX1) * SSSC(M1,I)
              ENDDO
           ENDDO
        ENDDO
      ENDDO
      RETURN
C
C     (P|1|P) TYPE
C
      ENTRY MCP1PPC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,3
               DO IX2 = 1,3
                  DO I = 1,NTERMA
            PPPC(M,I,IX1,IXD,IX2) = XYZQD(I,IX2) * PPSC(M ,I,IX1,IXD,1)
     &                            - XYZQC(I,IX2) * PPSC(M1,I,IX1,IXD,1)
     &                            + IDT(IX1,IX2) *(SPSC(M ,I,  1,IXD,1)
     &                                            -SPSC(M1,I,  1,IXD,1))
     &                                            /(2*ZETACABC(I))
     &                            + IDT(IXD,IX2) * PSSC(M1,I,IX1    ,1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1DSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (D|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXY(6,2),IDT(3,3)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (D|1|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,6
               I1 = IXY(IX1,1)
               I2 = IXY(IX1,2)
               DO I = 1,NTERMA
                DPSC(M,I,IX1,IXD,1) = XYZQA(I,I2) * PPSC(M ,I,I1,IXD,1)
     &                              - XYZQC(I,I2) * PPSC(M1,I,I1,IXD,1)
     &                              + IDT( I1,I2) *(SPSC(M ,I, 1,IXD,1)
     &                                             -SPSC(M1,I, 1,IXD,1))
     &                                             /(2*ZETACABC(I))
     &                              + IDT(IXD,I2) * PSSC(M1,I,I1    ,1)
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|1|P) TYPE
C
      ENTRY MCP1DPC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,6
               I1 = IXY(IX1,1)
               I2 = IXY(IX1,2)
               DO IX2 = 1,3
                  DO I = 1,NTERMA
           DPPC(M,I,IX1,IXD,IX2) = XYZQD( I,IX2) * DPSC(M ,I,IX1,IXD,1)
     &                           - XYZQC( I,IX2) * DPSC(M1,I,IX1,IXD,1)
     &                           + (IDT( I1,IX2) *(PPSC(M ,I, I2,IXD,1)
     &                                            -PPSC(M1,I, I2,IXD,1))
     &                             +IDT( I2,IX2) *(PPSC(M ,I, I1,IXD,1)
     &                                            -PPSC(M1,I, I1,IXD,1))
     &                             )/(2*ZETACABC(I))
     &                           +  IDT(IXD,IX2) * DSSC(M1,I,IX1    ,1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|1|D) TYPE
C
      ENTRY MCP1DDC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,6
               I1 = IXY(IX1,1)
               I2 = IXY(IX1,2)
               DO IX2 = 1,6
                  J1 = IXY(IX2,1)
                  J2 = IXY(IX2,2)
                  DO I = 1,NTERMA
            DPDC(M,I,IX1,IXD,IX2) = XYZQD(I,J2) * DPPC(M ,I,IX1,IXD,J1)
     &                            - XYZQC(I,J2) * DPPC(M1,I,IX1,IXD,J1)
     &                            +(IDT( I1,J2) *(PPPC(M ,I, I2,IXD,J1)
     &                                           -PPPC(M1,I, I2,IXD,J1))
     &                             +IDT( I2,J2) *(PPPC(M ,I, I1,IXD,J1)
     &                                           -PPPC(M1,I, I1,IXD,J1))
     &                             +IDT( J1,J2) *(DPSC(M ,I,IX1,IXD, 1)
     &                                           -DPSC(M1,I,IX1,IXD, 1))
     &                             )/(2*ZETACABC(I))
     &                            + IDT(IXD,J2) * DSPC(M1,I,IX1,    J1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1FSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (F|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IDT(3,3)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
      DATA  IDT/1,0,0,
     &          0,1,0,
     &          0,0,1/
C
C     (F|1|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,10
               I1  = IXYZ(IX1,1)
               I2  = IXYZ(IX1,2)
               I3  = IXYZ(IX1,3)
               I12 = IXYZ(IX1,4)
               DO I = 1,NTERMA
               FPSC(M,I,IX1,IXD,1) = XYZQA(I,I3) * DPSC(M ,I,I12,IXD,1)
     &                             - XYZQC(I,I3) * DPSC(M1,I,I12,IXD,1)
     &                             +(IDT( I1,I3) *(PPSC(M ,I, I2,IXD,1)
     &                                            -PPSC(M1,I, I2,IXD,1))
     &                             + IDT( I2,I3) *(PPSC(M ,I, I1,IXD,1)
     &                                            -PPSC(M1,I, I1,IXD,1))
     &                              )/(2*ZETACABC(I))
     &                             + IDT(IXD,I3) * DSSC(M1,I,I12    ,1)
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|P) TYPE
C
      ENTRY MCP1FPC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,10
               I1  = IXYZ(IX1,1)
               I2  = IXYZ(IX1,2)
               I3  = IXYZ(IX1,3)
               I12 = IXYZ(IX1,4)
               I13 = IXYZ(IX1,5)
               I23 = IXYZ(IX1,6)
               DO IX2 = 1,3
                  DO I = 1,NTERMA
            FPPC(M,I,IX1,IXD,IX2) = XYZQD(I,IX2) * FPSC(M ,I,IX1,IXD,1)
     &                            - XYZQC(I,IX2) * FPSC(M1,I,IX1,IXD,1)
     &                            +(IDT( I1,IX2) *(DPSC(M ,I,I23,IXD,1)
     &                                            -DPSC(M1,I,I23,IXD,1))
     &                             +IDT( I2,IX2) *(DPSC(M ,I,I13,IXD,1)
     &                                            -DPSC(M1,I,I13,IXD,1))
     &                             +IDT( I3,IX2) *(DPSC(M ,I,I12,IXD,1)
     &                                            -DPSC(M1,I,I12,IXD,1))
     &                             )/(2*ZETACABC(I))
     &                            + IDT(IXD,IX2) * FSSC(M1,I,IX1    ,1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|D) TYPE
C
      ENTRY MCP1FDC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,10
               I1  = IXYZ(IX1,1)
               I2  = IXYZ(IX1,2)
               I3  = IXYZ(IX1,3)
               I12 = IXYZ(IX1,4)
               I13 = IXYZ(IX1,5)
               I23 = IXYZ(IX1,6)
               DO IX2 = 1,6
                  J1  = IXY(IX2,1)
                  J2  = IXY(IX2,2)
                  DO I = 1,NTERMA
            FPDC(M,I,IX1,IXD,IX2) = XYZQD(I,J2) * FPPC(M ,I,IX1,IXD,J1)
     &                            - XYZQC(I,J2) * FPPC(M1,I,IX1,IXD,J1)
     &                            +(IDT( I1,J2) *(DPPC(M ,I,I23,IXD,J1)
     &                                           -DPPC(M1,I,I23,IXD,J1))
     &                            + IDT( I2,J2) *(DPPC(M ,I,I13,IXD,J1)
     &                                           -DPPC(M1,I,I13,IXD,J1))
     &                            + IDT( I3,J2) *(DPPC(M ,I,I12,IXD,J1)
     &                                           -DPPC(M1,I,I12,IXD,J1))
     &                            + IDT( J1,J2) *(FPSC(M ,I,IX1,IXD, 1)
     &                                           -FPSC(M1,I,IX1,IXD, 1))
     &                             )/(2*ZETACABC(I))
     &                            + IDT(IXD,J2) * FSPC(M1,I,IX1    ,J1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|F) TYPE
C
      ENTRY MCP1FFC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,10
               I1  = IXYZ(IX1,1)
               I2  = IXYZ(IX1,2)
               I3  = IXYZ(IX1,3)
               I12 = IXYZ(IX1,4)
               I13 = IXYZ(IX1,5)
               I23 = IXYZ(IX1,6)
               DO IX2 = 1,10
                  J1  = IXYZ(IX2,1)
                  J2  = IXYZ(IX2,2)
                  J3  = IXYZ(IX2,3)
                  J12 = IXYZ(IX2,4)
                  DO I = 1,NTERMA
           FPFC(M,I,IX1,IXD,IX2) = XYZQD(I,J3) * FPDC(M ,I,IX1,IXD,J12)
     &                           - XYZQC(I,J3) * FPDC(M1,I,IX1,IXD,J12)
     &                           +(IDT( I1,J3) *(DPDC(M ,I,I23,IXD,J12)
     &                                          -DPDC(M1,I,I23,IXD,J12))
     &                            +IDT( I2,J3) *(DPDC(M ,I,I13,IXD,J12)
     &                                          -DPDC(M1,I,I13,IXD,J12))
     &                            +IDT( I3,J3) *(DPDC(M ,I,I12,IXD,J12)
     &                                          -DPDC(M1,I,I12,IXD,J12))
     &                            +IDT( J1,J3) *(FPPC(M ,I,IX1,IXD, J2)
     &                                          -FPPC(M1,I,IX1,IXD, J2))
     &                            +IDT( J2,J3) *(FPPC(M ,I,IX1,IXD, J1)
     &                                          -FPPC(M1,I,IX1,IXD, J1))
     &                            )/(2*ZETACABC(I))
     &                           + IDT(IXD,J3) * FSDC(M1,I,IX1    ,J12)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1GSC(MX)
C=======================================================================
C
C     LEVEL 2 NORMAL-RECURSION (G|1|X): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (G|1|S) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,15
               I1   = IXYZW(IX1,1)
               I2   = IXYZW(IX1,2)
               I3   = IXYZW(IX1,3)
               I4   = IXYZW(IX1,4)
               I12  = IXYZW(IX1,5)
               I13  = IXYZW(IX1,6)
C              I14  = IXYZW(IX1,7)
               I23  = IXYZW(IX1,8)
C              I24  = IXYZW(IX1,9)
C              I34  = IXYZW(IX1,10)
               I123 = IXYZW(IX1,11)
C              I124 = IXYZW(IX1,12)
C              I134 = IXYZW(IX1,13)
C              I234 = IXYZW(IX1,14)
C
               DO I = 1,NTERMA
              GPSC(M,I,IX1,IXD,1) = XYZQA(I,I4) * FPSC(M ,I,I123,IXD,1)
     &                            - XYZQC(I,I4) * FPSC(M1,I,I123,IXD,1)
     &                            +(IDT( I1,I4) *(DPSC(M ,I, I23,IXD,1)
     &                                           -DPSC(M1,I, I23,IXD,1))
     &                             +IDT( I2,I4) *(DPSC(M ,I, I13,IXD,1)
     &                                           -DPSC(M1,I, I13,IXD,1))
     &                             +IDT( I3,I4) *(DPSC(M ,I, I12,IXD,1)
     &                                           -DPSC(M1,I, I12,IXD,1))
     &                             )/(2*ZETACABC(I))
     &                            + IDT(IXD,I4) * FSSC(M1,I,I123    ,1)
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|P) TYPE
C
      ENTRY MCP1GPC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,15
               I1   = IXYZW(IX1,1)
               I2   = IXYZW(IX1,2)
               I3   = IXYZW(IX1,3)
               I4   = IXYZW(IX1,4)
C              I12  = IXYZW(IX1,5)
C              I13  = IXYZW(IX1,6)
C              I14  = IXYZW(IX1,7)
C              I23  = IXYZW(IX1,8)
C              I24  = IXYZW(IX1,9)
C              I34  = IXYZW(IX1,10)
               I123 = IXYZW(IX1,11)
               I124 = IXYZW(IX1,12)
               I134 = IXYZW(IX1,13)
               I234 = IXYZW(IX1,14)
               DO IX2 = 1,3
                  DO I = 1,NTERMA
           GPPC(M,I,IX1,IXD,IX2) = XYZQD(I,IX2) * GPSC(M ,I, IX1,IXD,1)
     &                           - XYZQC(I,IX2) * GPSC(M1,I, IX1,IXD,1)
     &                           +(IDT( I1,IX2) *(FPSC(M ,I,I234,IXD,1)
     &                                           -FPSC(M1,I,I234,IXD,1))
     &                            +IDT( I2,IX2) *(FPSC(M ,I,I134,IXD,1)
     &                                           -FPSC(M1,I,I134,IXD,1))
     &                            +IDT( I3,IX2) *(FPSC(M ,I,I124,IXD,1)
     &                                           -FPSC(M1,I,I124,IXD,1))
     &                            +IDT( I4,IX2) *(FPSC(M ,I,I123,IXD,1)
     &                                           -FPSC(M1,I,I123,IXD,1))
     &                            )/(2*ZETACABC(I))
     &                           + IDT(IXD,IX2) * GSSC(M1,I, IX1    ,1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|D) TYPE
C
      ENTRY MCP1GDC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,15
               I1   = IXYZW(IX1,1)
               I2   = IXYZW(IX1,2)
               I3   = IXYZW(IX1,3)
               I4   = IXYZW(IX1,4)
C              I12  = IXYZW(IX1,5)
C              I13  = IXYZW(IX1,6)
C              I14  = IXYZW(IX1,7)
C              I23  = IXYZW(IX1,8)
C              I24  = IXYZW(IX1,9)
C              I34  = IXYZW(IX1,10)
               I123 = IXYZW(IX1,11)
               I124 = IXYZW(IX1,12)
               I134 = IXYZW(IX1,13)
               I234 = IXYZW(IX1,14)
               DO IX2 = 1,6
                  J1  = IXY(IX2,1)
                  J2  = IXY(IX2,2)
                  DO I = 1,NTERMA
           GPDC(M,I,IX1,IXD,IX2) = XYZQD(I,J2) * GPPC(M ,I, IX1,IXD,J1)
     &                           - XYZQC(I,J2) * GPPC(M1,I, IX1,IXD,J1)
     &                           +(IDT( I1,J2) *(FPPC(M ,I,I234,IXD,J1)
     &                                          -FPPC(M1,I,I234,IXD,J1))
     &                            +IDT( I2,J2) *(FPPC(M ,I,I134,IXD,J1)
     &                                          -FPPC(M1,I,I134,IXD,J1))
     &                            +IDT( I3,J2) *(FPPC(M ,I,I124,IXD,J1)
     &                                          -FPPC(M1,I,I124,IXD,J1))
     &                            +IDT( I4,J2) *(FPPC(M ,I,I123,IXD,J1)
     &                                          -FPPC(M1,I,I123,IXD,J1))
     &                            +IDT( J1,J2) *(GPSC(M ,I, IX1,IXD, 1)
     &                                          -GPSC(M1,I, IX1,IXD, 1))
     &                            )/(2*ZETACABC(I))
     &                           + IDT(IXD,J2) * GSPC(M1,I, IX1    ,J1)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|F) TYPE
C
      ENTRY MCP1GFC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,15
               I1   = IXYZW(IX1,1)
               I2   = IXYZW(IX1,2)
               I3   = IXYZW(IX1,3)
               I4   = IXYZW(IX1,4)
C              I12  = IXYZW(IX1,5)
C              I13  = IXYZW(IX1,6)
C              I14  = IXYZW(IX1,7)
C              I23  = IXYZW(IX1,8)
C              I24  = IXYZW(IX1,9)
C              I34  = IXYZW(IX1,10)
               I123 = IXYZW(IX1,11)
               I124 = IXYZW(IX1,12)
               I134 = IXYZW(IX1,13)
               I234 = IXYZW(IX1,14)
               DO IX2 = 1,10
                  J1  = IXYZ(IX2,1)
                  J2  = IXYZ(IX2,2)
                  J3  = IXYZ(IX2,3)
                  J12 = IXYZ(IX2,4)
C                 J13 = IXYZ(IX2,5)
C                 J23 = IXYZ(IX2,6)
                  DO I = 1,NTERMA
          GPFC(M,I,IX1,IXD,IX2) = XYZQD(I,J3) * GPDC(M ,I, IX1,IXD,J12)
     &                          - XYZQC(I,J3) * GPDC(M1,I, IX1,IXD,J12)
     &                          +(IDT( I1,J3) *(FPDC(M ,I,I234,IXD,J12)
     &                                         -FPDC(M1,I,I234,IXD,J12))
     &                           +IDT( I2,J3) *(FPDC(M ,I,I134,IXD,J12)
     &                                         -FPDC(M1,I,I134,IXD,J12))
     &                           +IDT( I3,J3) *(FPDC(M ,I,I124,IXD,J12)
     &                                         -FPDC(M1,I,I124,IXD,J12))
     &                           +IDT( I4,J3) *(FPDC(M ,I,I123,IXD,J12)
     &                                         -FPDC(M1,I,I123,IXD,J12))
     &                           +IDT( J1,J3) *(GPPC(M ,I, IX1,IXD, J2)
     &                                         -GPPC(M1,I, IX1,IXD, J2))
     &                           +IDT( J2,J3) *(GPPC(M ,I, IX1,IXD, J1)
     &                                         -GPPC(M1,I, IX1,IXD, J1))
     &                           )/(2*ZETACABC(I))
     &                          + IDT(IXD,J3) * GSDC(M1,I, IX1    ,J12)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|G) TYPE
C
      ENTRY MCP1GGC(MX)
      DO M=0,MX
         M1=M+1
         DO IXD = 1,3
            DO IX1 = 1,15
               I1   = IXYZW(IX1,1)
               I2   = IXYZW(IX1,2)
               I3   = IXYZW(IX1,3)
               I4   = IXYZW(IX1,4)
C              I12  = IXYZW(IX1,5)
C              I13  = IXYZW(IX1,6)
C              I14  = IXYZW(IX1,7)
C              I23  = IXYZW(IX1,8)
C              I24  = IXYZW(IX1,9)
C              I34  = IXYZW(IX1,10)
               I123 = IXYZW(IX1,11)
               I124 = IXYZW(IX1,12)
               I134 = IXYZW(IX1,13)
               I234 = IXYZW(IX1,14)
               DO IX2 = 1,15
                  J1   = IXYZW(IX2,1)
                  J2   = IXYZW(IX2,2)
                  J3   = IXYZW(IX2,3)
                  J4   = IXYZW(IX2,4)
                  J12  = IXYZW(IX2,5)
                  J13  = IXYZW(IX2,6)
C                 J14  = IXYZW(IX2,7)
                  J23  = IXYZW(IX2,8)
C                 J24  = IXYZW(IX2,9)
C                 J34  = IXYZW(IX2,10)
                  J123 = IXYZW(IX2,11)
C                 J124 = IXYZW(IX2,12)
C                 J134 = IXYZW(IX2,13)
C                 J234 = IXYZW(IX2,14)
                  DO I = 1,NTERMA
         GPGC(M,I,IX1,IXD,IX2) = XYZQD(I,J4) * GPFC(M ,I, IX1,IXD,J123)
     &                         - XYZQC(I,J4) * GPFC(M1,I, IX1,IXD,J123)
     &                         +(IDT( I1,J4) *(FPFC(M ,I,I234,IXD,J123)
     &                                        -FPFC(M1,I,I234,IXD,J123))
     &                          +IDT( I2,J4) *(FPFC(M ,I,I134,IXD,J123)
     &                                        -FPFC(M1,I,I134,IXD,J123))
     &                          +IDT( I3,J4) *(FPFC(M ,I,I124,IXD,J123)
     &                                        -FPFC(M1,I,I124,IXD,J123))
     &                          +IDT( I4,J4) *(FPFC(M ,I,I123,IXD,J123)
     &                                        -FPFC(M1,I,I123,IXD,J123))
     &                          +IDT( J1,J4) *(GPDC(M ,I, IX1,IXD, J23)
     &                                        -GPDC(M1,I, IX1,IXD, J23))
     &                          +IDT( J2,J4) *(GPDC(M ,I, IX1,IXD, J13)
     &                                        -GPDC(M1,I, IX1,IXD, J13))
     &                          +IDT( J3,J4) *(GPDC(M ,I, IX1,IXD, J12)
     &                                        -GPDC(M1,I, IX1,IXD, J12))
     &                          )/(2*ZETACABC(I))
     &                         + IDT(IXD,J4) * GSFC(M1,I, IX1    ,J123)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C            MCP C-TERM OPERATOR 1ST DERIVATIVE CALCULATION           @C
C  ~ LEVEL2 EXTRA-RECURSION FORMULA : UP TO G FUNCTION IS SUPPORTED~  @C
C                       LAST UPDATED AT 06.04.27                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP0SPC(MX)
C=======================================================================
C
C     LEVEL 2 EXTRA-RECURSION (S|0|P): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C     DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER ( MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
C
C     (S|0|P) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX2 = 1,3
            DO I = 1,NTERMA
               SSPC(M,I,1,IX2) = SSSC(M ,I)*XYZQD(I,IX2)
     &                         - SSSC(M1,I)*XYZQC(I,IX2)
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0PDC(MX)
C=======================================================================
C
C     LEVEL 2 EXTRA-RECURSION (P|0|D): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXY(6,2),IDT(3,3)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (P|0|D) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,3
            DO IX2 = 1,6
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMA
                  PSDC(M,I,IX1,IX2) = XYZQD(I,J2) * PSPC(M ,I,IX1,J1)
     &                              - XYZQC(I,J2) * PSPC(M1,I,IX1,J1)
     &                              +(IDT(IX1,J2) *(SSPC(M ,I,  1,J1)
     &                                             -SSPC(M1,I,  1,J1))
     &                               +IDT( J1,J2) *(PSSC(M ,I,IX1, 1)
     &                                             -PSSC(M1,I,IX1, 1))
     &                               )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0DFC(MX)
C=======================================================================
C
C     LEVEL 2 EXTRA-RECURSION (D|0|F): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXY(6,2),IXYZ(10,6),IDT(3,3)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
      DATA  IDT/1,0,0,
     &          0,1,0,
     &          0,0,1/
C
C     (D|0|F) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
C              J13 = IXYZ(IX2,5)
C              J23 = IXYZ(IX2,6)
               DO I = 1,NTERMA
                  DSFC(M,I,IX1,IX2) = XYZQD(I,J3) * DSDC(M ,I,IX1,J12)
     &                              - XYZQC(I,J3) * DSDC(M1,I,IX1,J12)
     &                              +(IDT( I1,J3) *(PSDC(M ,I, I2,J12)
     &                                             -PSDC(M1,I, I2,J12))
     &                               +IDT( I2,J3) *(PSDC(M ,I, I1,J12)
     &                                             -PSDC(M1,I, I1,J12))
     &                               +IDT( J1,J3) *(DSPC(M ,I,IX1, J2)
     &                                             -DSPC(M1,I,IX1, J2))
     &                               +IDT( J2,J3) *(DSPC(M ,I,IX1, J1)
     &                                             -DSPC(M1,I,IX1, J1))
     &                               )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0FGC(MX)
C=======================================================================
C
C     LEVEL 2 EXTRA-RECURSION (F|0|G): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXYZ(10,6),IXYZW(15,14),IDT(3,3)
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (F|0|G) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,15
               J1   = IXYZW(IX2,1)
               J2   = IXYZW(IX2,2)
               J3   = IXYZW(IX2,3)
               J4   = IXYZW(IX2,4)
               J12  = IXYZW(IX2,5)
               J13  = IXYZW(IX2,6)
C              J14  = IXYZW(IX2,7)
               J23  = IXYZW(IX2,8)
C              J24  = IXYZW(IX2,9)
C              J34  = IXYZW(IX2,10)
               J123 = IXYZW(IX2,11)
C              J124 = IXYZW(IX2,12)
C              J134 = IXYZW(IX2,13)
C              J234 = IXYZW(IX2,14)
               DO I = 1,NTERMA
                  FSGC(M,I,IX1,IX2) = XYZQD(I,J4) * FSFC(M ,I,IX1,J123)
     &                              - XYZQC(I,J4) * FSFC(M1,I,IX1,J123)
     &                              +(IDT( I1,J4) *(DSFC(M ,I,I23,J123)
     &                                             -DSFC(M1,I,I23,J123))
     &                               +IDT( I2,J4) *(DSFC(M ,I,I13,J123)
     &                                             -DSFC(M1,I,I13,J123))
     &                               +IDT( I3,J4) *(DSFC(M ,I,I12,J123)
     &                                             -DSFC(M1,I,I12,J123))
     &                               +IDT( J1,J4) *(FSDC(M ,I,IX1, J23)
     &                                             -FSDC(M1,I,IX1, J23))
     &                               +IDT( J2,J4) *(FSDC(M ,I,IX1, J13)
     &                                             -FSDC(M1,I,IX1, J13))
     &                               +IDT( J3,J4) *(FSDC(M ,I,IX1, J12)
     &                                             -FSDC(M1,I,IX1, J12))
     &                               )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP0GHC(MX)
C=======================================================================
C
C     LEVEL 2 EXTRA-RECURSION (G|0|H): C-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      DOUBLE PRECISION ISSC,ISPC,ISDC,ISFC,ISGC,ISHC,ISIC
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKC/
     & PSSC(0:12,MXT, 3, 1),PSPC(0:11,MXT, 3, 3),DSSC(0:11,MXT, 6, 1),
     & DSPC(0:10,MXT, 6, 3),DSDC(0: 9,MXT, 6, 6),FSSC(0:10,MXT,10, 1),
     & FSPC(0: 9,MXT,10, 3),FSDC(0: 8,MXT,10, 6),FSFC(0: 7,MXT,10,10),
     & GSSC(0: 9,MXT,15, 1),GSPC(0: 8,MXT,15, 3),GSDC(0: 7,MXT,15, 6),
     & GSFC(0: 6,MXT,15,10),GSGC(0: 5,MXT,15,15),HSSC(0: 8,MXT,21, 1),
     & HSPC(0: 7,MXT,21, 3),HSDC(0: 6,MXT,21, 6),HSFC(0: 5,MXT,21,10),
     & HSGC(0: 4,MXT,21,15),HSHC(0: 3,MXT,21,21),ISSC(0: 7,MXT,28, 1),
     & ISPC(0: 6,MXT,28, 3),ISDC(0: 5,MXT,28, 6),ISFC(0: 4,MXT,28,10),
     & ISGC(0: 3,MXT,28,15),ISHC(0: 2,MXT,28,21),ISIC(0: 1,MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKCG/
     & SPSC(0:11,MXT, 1,3, 1),PPSC(0:10,MXT, 3,3, 1),
     & PPPC(0: 9,MXT, 3,3, 3),DPSC(0: 9,MXT, 6,3, 1),
     & DPPC(0: 8,MXT, 6,3, 3),DPDC(0: 7,MXT, 6,3, 6),
     & FPSC(0: 8,MXT,10,3, 1),FPPC(0: 7,MXT,10,3, 3),
     & FPDC(0: 6,MXT,10,3, 6),FPFC(0: 5,MXT,10,3,10),
     & GPSC(0: 7,MXT,15,3, 1),GPPC(0: 6,MXT,15,3, 3),
     & GPDC(0: 5,MXT,15,3, 6),GPFC(0: 4,MXT,15,3,10),
     & GPGC(0: 3,MXT,15,3,15),HPSC(0: 6,MXT,21,3, 1),
     & HPPC(0: 5,MXT,21,3, 3),HPDC(0: 4,MXT,21,3, 6),
     & HPFC(0: 3,MXT,21,3,10),HPGC(0: 2,MXT,21,3,15),
     & HPHC(0: 1,MXT,21,3,21),
     &
     & SSPC(0:5,MXT, 1, 3),
     & PSDC(0:5,MXT, 3, 6),
     & DSFC(0:5,MXT, 6,10),
     & FSGC(0:5,MXT,10,15),
     & GSHC(0:5,MXT,15,21),
     & HSIC(0:5,MXT,21,28)
      DIMENSION IXYZW(15,14),IXYZWV(21,30),IDT(3,3)
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA IXYZWV/
     1   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3,
     2   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 2, 2, 2, 2, 3, 3,
     3   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 2, 2, 2, 3, 3, 3,
     4   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 2, 2, 3, 3, 3, 3,
     5   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 2, 3, 3, 3, 3, 3,
     6   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 4, 4, 5, 6,
     7   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6,
     8   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3, 4, 4, 5, 5, 5, 6,
     9   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3, 4, 5, 5, 5, 5, 6,
     &   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 4, 4, 4, 5, 6, 6,
     1   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 4, 4, 5, 5, 6, 6,
     2   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 4, 5, 5, 5, 6, 6,
     3   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 4, 4, 5, 6, 6, 6,
     4   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 4, 5, 5, 6, 6, 6,
     5   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6, 4, 5, 6, 6, 6, 6,
     6   1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6, 7, 7, 7, 8, 9,10,
     7   1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6, 7, 7, 8, 8, 9,10,
     8   1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6, 7, 8, 8, 8, 9,10,
     9   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6, 7, 7, 8, 9, 9,10,
     &   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6, 7, 8, 8, 9, 9,10,
     1   1, 2, 3, 4, 5, 6, 7, 5, 6, 6, 4, 5, 6, 6, 6, 7, 8, 9, 9, 9,10,
     2   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10, 7, 7, 8, 9,10,10,
     3   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10, 7, 8, 8, 9,10,10,
     4   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10, 7, 8, 9, 9,10,10,
     5   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10, 7, 8, 9,10,10,10,
     6   1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,11,11,12,13,14,15,
     7   1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,11,12,12,13,14,15,
     8   1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,11,12,13,13,14,15,
     9   1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10,11,12,13,14,14,15,
     &   1, 2, 3, 4, 5, 6, 7, 8, 9,10,11,12,13,14,15,11,12,13,14,15,15/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (G|0|H) TYPE
C
      DO M=0,MX
         M1=M+1
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,21
               J1    = IXYZWV(IX2,1)
               J2    = IXYZWV(IX2,2)
               J3    = IXYZWV(IX2,3)
               J4    = IXYZWV(IX2,4)
               J5    = IXYZWV(IX2,5)
C              J12   = IXYZWV(IX2,6)
C              J13   = IXYZWV(IX2,7)
C              J14   = IXYZWV(IX2,8)
C              J15   = IXYZWV(IX2,9)
C              J23   = IXYZWV(IX2,10)
C              J24   = IXYZWV(IX2,11)
C              J25   = IXYZWV(IX2,12)
C              J34   = IXYZWV(IX2,13)
C              J35   = IXYZWV(IX2,14)
C              J45   = IXYZWV(IX2,15)
               J123  = IXYZWV(IX2,16)
               J124  = IXYZWV(IX2,17)
C              J125  = IXYZWV(IX2,18)
               J134  = IXYZWV(IX2,19)
C              J135  = IXYZWV(IX2,20)
C              J145  = IXYZWV(IX2,21)
               J234  = IXYZWV(IX2,22)
C              J235  = IXYZWV(IX2,23)
C              J245  = IXYZWV(IX2,24)
C              J345  = IXYZWV(IX2,25)
               J1234 = IXYZWV(IX2,26)
C              J1235 = IXYZWV(IX2,27)
C              J1245 = IXYZWV(IX2,28)
C              J1345 = IXYZWV(IX2,29)
C              J2345 = IXYZWV(IX2,30)
               DO I = 1,NTERMA
                GSHC(M,I,IX1,IX2) = XYZQD(I,J5) * GSGC(M ,I, IX1,J1234)
     &                            - XYZQC(I,J5) * GSGC(M1,I, IX1,J1234)
     &                            +(IDT( I1,J5) *(FSGC(M ,I,I234,J1234)
     &                                           -FSGC(M1,I,I234,J1234))
     &                             +IDT( I2,J5) *(FSGC(M ,I,I134,J1234)
     &                                           -FSGC(M1,I,I134,J1234))
     &                             +IDT( I3,J5) *(FSGC(M ,I,I124,J1234)
     &                                           -FSGC(M1,I,I124,J1234))
     &                             +IDT( I4,J5) *(FSGC(M ,I,I123,J1234)
     &                                           -FSGC(M1,I,I123,J1234))
     &                             +IDT( J1,J5) *(GSFC(M ,I, IX1, J234)
     &                                           -GSFC(M1,I, IX1, J234))
     &                             +IDT( J2,J5) *(GSFC(M ,I, IX1, J134)
     &                                           -GSFC(M1,I, IX1, J134))
     &                             +IDT( J3,J5) *(GSFC(M ,I, IX1, J124)
     &                                           -GSFC(M1,I, IX1, J124))
     &                             +IDT( J4,J5) *(GSFC(M ,I, IX1, J123)
     &                                           -GSFC(M1,I, IX1, J123))
     &                             )/(2*ZETACABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C            MCP D-TERM OPERATOR 1ST DERIVATIVE CALCULATION           @C
C     ~ LEVEL1 RECURSION FORMULA : UP TO G FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.02.16                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP1DS
C=======================================================================
C
C     LEVEL 1 RECURSION (S|1|S): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
C     (S|1|S) TYPE
C
C
      CALL MCP1SSD ()
C
      DO IXD=1,3
         DO I=1,NTERMB
            VAL = -2*ZEFF*SPSD(I,1,IXD,1)
            GMCP1D(1,IXD,1) = GMCP1D(1,IXD,1) + VAL*EXB(I)*COEFB(I)
         ENDDO
      ENDDO
      END
C=======================================================================
      SUBROUTINE MCP1DP (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (P|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
C     (P|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSD ()
         CALL MCP1PSD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO I=1,NTERMB
                  VAL = -2*ZEFF*PPSD(I,IX1,IXD,1)
                  GMCP1D(IX1,IXD,1) = GMCP1D(IX1,IXD,1)
     &                              + VAL*EXB(I)*COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (P|1|P) TYPE
C
      ELSE
C
         CALL MCP0PSD ()
         CALL MCP1SSD ()
         CALL MCP1PSD ()
         CALL MCP1PPD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*PPPD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1DD (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (D|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
C     (D|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP1DSD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO I=1,NTERMB
                  VAL = -2*ZEFF*DPSD(I,IX1,IXD,1)
                  GMCP1D(IX1,IXD,1) = GMCP1D(IX1,IXD,1)
     &                              + VAL*EXB(I)*COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (D|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1DPD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*DPPD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (D|1|D) TYPE
C
      ELSE
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP1SSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1PPD ()
         CALL MCP0DPD ()
         CALL MCP1DPD ()
         CALL MCP1DDD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*DPDD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1DF (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (F|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
C     (F|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP1FSD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO I=1,NTERMB
                  VAL = -2*ZEFF*FPSD(I,IX1,IXD,1)
                  GMCP1D(IX1,IXD,1) = GMCP1D(IX1,IXD,1)
     &                              + VAL*EXB(I)*COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1FPD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*FPPD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1DPD ()
         CALL MCP0FPD ()
         CALL MCP1FPD ()
         CALL MCP1FDD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*FPDD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (F|1|F) TYPE
C
      ELSE
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP1SSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1PPD ()
         CALL MCP0DPD ()
         CALL MCP1DPD ()
         CALL MCP0FPD ()
         CALL MCP1FPD ()
         CALL MCP1DDD ()
         CALL MCP0FDD ()
         CALL MCP1FDD ()
         CALL MCP1FFD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*FPFD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C=======================================================================
      SUBROUTINE MCP1DG (NCA,NCB)
C=======================================================================
C
C     LEVEL 1 RECURSION (G|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXC=21, MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      COMMON/MCPOUTG/GMCP1C(MXC,3,MXC),GMCP1D(MXC,3,MXC)
C
C     (G|1|S) TYPE
C
      IF (NCB.EQ.1) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP1GSD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO I=1,NTERMB
                  VAL = -2*ZEFF*GPSD(I,IX1,IXD,1)
                  GMCP1D(IX1,IXD,1) = GMCP1D(IX1,IXD,1)
     &                              + VAL*EXB(I)*COEFB(I)
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|P) TYPE
C
      ELSE IF (NCB.EQ.3) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP1FSD ()
         CALL MCP1GSD ()
         CALL MCP1GPD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*GPPD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|D) TYPE
C
      ELSE IF (NCB.EQ.6) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1GSD ()
         CALL MCP1FPD ()
         CALL MCP0GPD ()
         CALL MCP1GPD ()
         CALL MCP1GDD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*GPDD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|F) TYPE
C
      ELSE IF (NCB.EQ.10) THEN
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1GSD ()
         CALL MCP1DPD ()
         CALL MCP0FPD ()
         CALL MCP1FPD ()
         CALL MCP0GPD ()
         CALL MCP1GPD ()
         CALL MCP1FDD ()
         CALL MCP0GDD ()
         CALL MCP1GDD ()
         CALL MCP1GFD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*GPFD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
C
C     (G|1|G) TYPE
C
      ELSE
C
         CALL MCP0PSD ()
         CALL MCP0DSD ()
         CALL MCP0FSD ()
         CALL MCP0GSD ()
         CALL MCP1SSD ()
         CALL MCP1PSD ()
         CALL MCP1DSD ()
         CALL MCP1FSD ()
         CALL MCP1GSD ()
         CALL MCP1PPD ()
         CALL MCP0DPD ()
         CALL MCP1DPD ()
         CALL MCP0FPD ()
         CALL MCP1FPD ()
         CALL MCP0GPD ()
         CALL MCP1GPD ()
         CALL MCP1DDD ()
         CALL MCP0FDD ()
         CALL MCP1FDD ()
         CALL MCP0GDD ()
         CALL MCP1GDD ()
         CALL MCP1FFD ()
         CALL MCP0GFD ()
         CALL MCP1GFD ()
         CALL MCP1GGD ()
C
         DO IXD=1,3
            DO IX1=1,NCA
               DO IX2=1,NCB
                  DO I=1,NTERMB
                     VAL = -2*ZEFF*GPGD(I,IX1,IXD,IX2)
                     GMCP1D(IX1,IXD,IX2) = GMCP1D(IX1,IXD,IX2)
     &                                   + VAL*EXB(I)*COEFB(I)
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDIF
      END
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C            MCP D-TERM OPERATOR 1ST DERIVATIVE CALCULATION           @C
C     ~ LEVEL2 RECURSION FORMULA : UP TO G FUNCTION IS SUPPORTED~     @C
C                       LAST UPDATED AT 06.02.16                      @C
C@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@C
C=======================================================================
      SUBROUTINE MCP1SSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (S|1|S): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C     DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPITMG/XYZGC(MXT,3)
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
C
C     (S|1|S) TYPE
C
      DO IXD = 1,3
         DO I = 1,NTERMB
            SPSD(I,1,IXD,1)=SSSD(I)*XYZGC(I,IXD)
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1PSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (P|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPITMG/XYZGC(MXT,3)
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      DIMENSION IDT(3,3)
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (P|1|S) TYPE
C
      DO IXD = 1,3
         DO IX1 = 1,3
            DO I = 1,NTERMB
               PPSD(I,IX1,IXD,1) = XYZGC(I,IXD)*PSSD(I,IX1,1)
     &                           + IDT(IX1,IXD)*SSSD(I)
     &                             /(2*ZETADABC(I))
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (P|1|P) TYPE
C
      ENTRY MCP1PPD ()
      DO IXD = 1,3
         DO IX1 = 1,3
            DO IX2 = 1,3
               DO I = 1,NTERMB
                  PPPD(I,IX1,IXD,IX2) = XYZGB(I,IX2)*PPSD(I,IX1,IXD,1)
     &                                +(IDT(IXD,IX2)*PSSD(I,IX1    ,1)
     &                                + IDT(IX1,IX2)*SPSD(I,  1,IXD,1)
     &                                 )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1DSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (D|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPITMG/XYZGC(MXT,3)
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      DIMENSION IXY(6,2), IDT(3,3)
      DATA IXY/1,1,1,2,2,3,
     &         1,2,3,2,3,3/
      DATA IDT/1,0,0,
     &         0,1,0,
     &         0,0,1/
C
C     (D|1|S) TYPE
C
      DO IXD = 1,3
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO I = 1,NTERMB
               DPSD(I,IX1,IXD,1) = XYZGC(I ,IXD)*DSSD(I,IX1,1)
     &                           + ( IDT(I1,IXD)*PSSD(I, I2,1)
     &                              +IDT(I2,IXD)*PSSD(I, I1,1)
     &                             )/(2*ZETADABC(I))
C
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|1|P) TYPE
C
      ENTRY MCP1DPD ()
      DO IXD = 1,3
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO IX2 = 1,3
               DO I = 1,NTERMB
                  DPPD(I,IX1,IXD,IX2) = XYZGB(I  ,IX2)*DPSD(I,IX1,IXD,1)
     &                                + ( IDT(I1 ,IX2)*PPSD(I,I2 ,IXD,1)
     &                                   +IDT(I2 ,IX2)*PPSD(I,I1 ,IXD,1)
     &                                   +IDT(IXD,IX2)*DSSD(I,IX1    ,1)
     &                                  )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (D|1|D) TYPE
C
      ENTRY MCP1DDD ()
      DO IXD = 1,3
         DO IX1 = 1,6
            I1 = IXY(IX1,1)
            I2 = IXY(IX1,2)
            DO IX2 = 1,6
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMB
                  DPDD(I,IX1,IXD,IX2) = XYZGB(I  ,J2)*DPPD(I,IX1,IXD,J1)
     &                                + ( IDT(I1 ,J2)*PPPD(I, I2,IXD,J1)
     &                                   +IDT(I2 ,J2)*PPPD(I, I1,IXD,J1)
     &                                   +IDT(IXD,J2)*DSPD(I,IX1    ,J1)
     &                                   +IDT(J1 ,J2)*DPSD(I,IX1,IXD, 1)
     &                                  )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1FSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (F|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPITMG/XYZGC(MXT,3)
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      DIMENSION IXY(6,2),IXYZ(10,6),IDT(3,3)
      DATA  IXY/1,1,1,2,2,3,
     &          1,2,3,2,3,3/
      DATA IXYZ/1,1,1,1,1,1,2,2,2,3,
     &          1,1,1,2,2,3,2,2,3,3,
     &          1,2,3,2,3,3,2,3,3,3,
     &          1,1,1,2,2,3,4,4,5,6,
     &          1,2,3,2,3,3,4,5,5,6,
     &          1,2,3,4,5,6,4,5,6,6/
      DATA  IDT/1,0,0,
     &          0,1,0,
     &          0,0,1/
C
C     (F|1|S) TYPE
C
      DO IXD = 1,3
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO I = 1,NTERMB
               FPSD(I,IX1,IXD,1) = XYZGC(I ,IXD)*FSSD(I,IX1,1)
     &                           + ( IDT(I1,IXD)*DSSD(I,I23,1)
     &                              +IDT(I2,IXD)*DSSD(I,I13,1)
     &                              +IDT(I3,IXD)*DSSD(I,I12,1)
     &                             )/(2*ZETADABC(I))
C
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|P) TYPE
C
      ENTRY MCP1FPD ()
      DO IXD = 1,3
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,3
               DO I = 1,NTERMB
                  FPPD(I,IX1,IXD,IX2) = XYZGB(I  ,IX2)*FPSD(I,IX1,IXD,1)
     &                                + ( IDT(I1 ,IX2)*DPSD(I,I23,IXD,1)
     &                                   +IDT(I2 ,IX2)*DPSD(I,I13,IXD,1)
     &                                   +IDT(I3 ,IX2)*DPSD(I,I12,IXD,1)
     &                                   +IDT(IXD,IX2)*FSSD(I,IX1    ,1)
     &                                  )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|D) TYPE
C
      ENTRY MCP1FDD ()
      DO IXD = 1,3
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,6
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMB
                  FPDD(I,IX1,IXD,IX2) = XYZGB(I  ,J2)*FPPD(I,IX1,IXD,J1)
     &                                + ( IDT(I1 ,J2)*DPPD(I,I23,IXD,J1)
     &                                   +IDT(I2 ,J2)*DPPD(I,I13,IXD,J1)
     &                                   +IDT(I3 ,J2)*DPPD(I,I12,IXD,J1)
     &                                   +IDT(IXD,J2)*FSPD(I,IX1    ,J1)
     &                                   +IDT(J1 ,J2)*FPSD(I,IX1,IXD, 1)
     &                                  )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (F|1|F) TYPE
C
      ENTRY MCP1FFD ()
      DO IXD = 1,3
         DO IX1 = 1,10
            I1  = IXYZ(IX1,1)
            I2  = IXYZ(IX1,2)
            I3  = IXYZ(IX1,3)
            I12 = IXYZ(IX1,4)
            I13 = IXYZ(IX1,5)
            I23 = IXYZ(IX1,6)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
C              J13 = IXYZ(IX2,5)
C              J23 = IXYZ(IX2,6)
               DO I = 1,NTERMB
                 FPFD(I,IX1,IXD,IX2) = XYZGB(I  ,J3)*FPDD(I,IX1,IXD,J12)
     &                               + ( IDT(I1 ,J3)*DPDD(I,I23,IXD,J12)
     &                                  +IDT(I2 ,J3)*DPDD(I,I13,IXD,J12)
     &                                  +IDT(I3 ,J3)*DPDD(I,I12,IXD,J12)
     &                                  +IDT(IXD,J3)*FSDD(I,IX1    ,J12)
     &                                  +IDT(J1 ,J3)*FPPD(I,IX1,IXD, J2)
     &                                  +IDT(J2 ,J3)*FPPD(I,IX1,IXD, J1)
     &                                 )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
C=======================================================================
      SUBROUTINE MCP1GSD ()
C=======================================================================
C
C     LEVEL 2 RECURSION (G|1|X): D-TERM GRADIENT
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DOUBLE PRECISION ISSD,ISPD,ISDD,ISFD,ISGD,ISHD,ISID
      PARAMETER (MXT=4, MXM=12)
C     COMMON BLOCK FOR ENERGY
      COMMON/MCPITM/
     & ZETA,XI,AB2,CB2,PC2,XIC(MXT),AD2(MXT),QC2(MXT),ZEFF,
     & EXA(MXT),EXB(MXT),COEFA(MXT),COEFB(MXT),ETA(MXT),
     & ZETACABC(MXT),ETAD(MXT),ZETADABC(MXT),ZETAD(MXT),XYZCB(3),
     & XYZQA(MXT,3),XYZQD(MXT,3),XYZQC(MXT,3),XYZGA(MXT,3),XYZGB(MXT,3),
     & SSSC(0:MXM,MXT),SSSD(MXT),
     & IELEM,IMCP,IATOM,NTERMA,NTERMB,INTTYP,MMAX
      COMMON/MCPWRKD/
     & PSSD(MXT, 3, 1),PSPD(MXT, 3, 3),DSSD(MXT, 6, 1),DSPD(MXT, 6, 3),
     & DSDD(MXT, 6, 6),FSSD(MXT,10, 1),FSPD(MXT,10, 3),FSDD(MXT,10, 6),
     & FSFD(MXT,10,10),GSSD(MXT,15, 1),GSPD(MXT,15, 3),GSDD(MXT,15, 6),
     & GSFD(MXT,15,10),GSGD(MXT,15,15),HSSD(MXT,21, 1),HSPD(MXT,21, 3),
     & HSDD(MXT,21, 6),HSFD(MXT,21,10),HSGD(MXT,21,15),HSHD(MXT,21,21),
     & ISSD(MXT,28, 1),ISPD(MXT,28, 3),ISDD(MXT,28, 6),ISFD(MXT,28,10),
     & ISGD(MXT,28,15),ISHD(MXT,28,21),ISID(MXT,28,28)
C     ADDITIONAL COMMON FOR GRADIENT
      COMMON/MCPITMG/XYZGC(MXT,3)
      COMMON/MCPWRKDG/
     & SPSD(MXT, 1,3, 1),PPSD(MXT, 3,3, 1),PPPD(MXT, 3,3, 3),
     & DPSD(MXT, 6,3, 1),DPPD(MXT, 6,3, 3),DPDD(MXT, 6,3, 6),
     & FPSD(MXT,10,3, 1),FPPD(MXT,10,3, 3),FPDD(MXT,10,3, 6),
     & FPFD(MXT,10,3,10),GPSD(MXT,15,3, 1),GPPD(MXT,15,3, 3),
     & GPDD(MXT,15,3, 6),GPFD(MXT,15,3,10),GPGD(MXT,15,3,15),
     & HPSD(MXT,21,3, 1),HPPD(MXT,21,3, 3),HPDD(MXT,21,3, 6),
     & HPFD(MXT,21,3,10),HPGD(MXT,21,3,15),HPHD(MXT,21,3,21)
      DIMENSION IXY(6,2),IXYZ(10,6),IXYZW(15,14),IDT(3,3)
      DATA   IXY/ 1, 1, 1, 2, 2, 3,
     &            1, 2, 3, 2, 3, 3/
      DATA  IXYZ/ 1, 1, 1, 1, 1, 1, 2, 2, 2, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6/
      DATA IXYZW/ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 2, 2, 2, 3, 3,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 2, 2, 3, 3, 3,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 2, 3, 3, 3, 3,
     &            1, 1, 1, 1, 1, 1, 2, 2, 2, 3, 4, 4, 4, 5, 6,
     &            1, 1, 1, 2, 2, 3, 2, 2, 3, 3, 4, 4, 5, 5, 6,
     &            1, 2, 3, 2, 3, 3, 2, 3, 3, 3, 4, 5, 5, 5, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 4, 4, 5, 6, 6,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 4, 5, 5, 6, 6,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 4, 5, 6, 6, 6,
     &            1, 1, 1, 2, 2, 3, 4, 4, 5, 6, 7, 7, 8, 9,10,
     &            1, 2, 3, 2, 3, 3, 4, 5, 5, 6, 7, 8, 8, 9,10,
     &            1, 2, 3, 4, 5, 6, 4, 5, 6, 6, 7, 8, 9, 9,10,
     &            1, 2, 3, 4, 5, 6, 7, 8, 9,10, 7, 8, 9,10,10/
      DATA   IDT/ 1, 0, 0,
     &            0, 1, 0,
     &            0, 0, 1/
C
C     (G|1|S) TYPE
C
      DO IXD = 1,3
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO I = 1,NTERMB
               GPSD(I,IX1,IXD,1) = XYZGC(I ,IXD)*GSSD(I,IX1 ,1)
     &                           + ( IDT(I1,IXD)*FSSD(I,I234,1)
     &                              +IDT(I2,IXD)*FSSD(I,I134,1)
     &                              +IDT(I3,IXD)*FSSD(I,I124,1)
     &                              +IDT(I4,IXD)*FSSD(I,I123,1)
     &                             )/(2*ZETADABC(I))
C
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|P) TYPE
C
      ENTRY MCP1GPD ()
      DO IXD = 1,3
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,3
               DO I = 1,NTERMB
                 GPPD(I,IX1,IXD,IX2) = XYZGB(I  ,IX2)*GPSD(I,IX1 ,IXD,1)
     &                               + ( IDT(I1 ,IX2)*FPSD(I,I234,IXD,1)
     &                                  +IDT(I2 ,IX2)*FPSD(I,I134,IXD,1)
     &                                  +IDT(I3 ,IX2)*FPSD(I,I124,IXD,1)
     &                                  +IDT(I4 ,IX2)*FPSD(I,I123,IXD,1)
     &                                  +IDT(IXD,IX2)*GSSD(I,IX1     ,1)
     &                                 )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|D) TYPE
C
      ENTRY MCP1GDD ()
      DO IXD = 1,3
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,6
               J1 = IXY(IX2,1)
               J2 = IXY(IX2,2)
               DO I = 1,NTERMB
                 GPDD(I,IX1,IXD,IX2) = XYZGB(I  ,J2)*GPPD(I,IX1 ,IXD,J1)
     &                               + ( IDT(I1 ,J2)*FPPD(I,I234,IXD,J1)
     &                                  +IDT(I2 ,J2)*FPPD(I,I134,IXD,J1)
     &                                  +IDT(I3 ,J2)*FPPD(I,I124,IXD,J1)
     &                                  +IDT(I4 ,J2)*FPPD(I,I123,IXD,J1)
     &                                  +IDT(IXD,J2)*GSPD(I,IX1     ,J1)
     &                                  +IDT(J1 ,J2)*GPSD(I,IX1 ,IXD, 1)
     &                                 )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|F) TYPE
C
      ENTRY MCP1GFD ()
      DO IXD = 1,3
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,10
               J1  = IXYZ(IX2,1)
               J2  = IXYZ(IX2,2)
               J3  = IXYZ(IX2,3)
               J12 = IXYZ(IX2,4)
C              J13 = IXYZ(IX2,5)
C              J23 = IXYZ(IX2,6)
               DO I = 1,NTERMB
                GPFD(I,IX1,IXD,IX2) = XYZGB(I  ,J3)*GPDD(I,IX1 ,IXD,J12)
     &                              + ( IDT(I1 ,J3)*FPDD(I,I234,IXD,J12)
     &                                 +IDT(I2 ,J3)*FPDD(I,I134,IXD,J12)
     &                                 +IDT(I3 ,J3)*FPDD(I,I124,IXD,J12)
     &                                 +IDT(I4 ,J3)*FPDD(I,I123,IXD,J12)
     &                                 +IDT(IXD,J3)*GSDD(I,IX1     ,J12)
     &                                 +IDT(J1 ,J3)*GPPD(I,IX1 ,IXD, J2)
     &                                 +IDT(J2 ,J3)*GPPD(I,IX1 ,IXD, J1)
     &                                )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
C
C     (G|1|G) TYPE
C
      ENTRY MCP1GGD ()
      DO IXD = 1,3
         DO IX1 = 1,15
            I1   = IXYZW(IX1,1)
            I2   = IXYZW(IX1,2)
            I3   = IXYZW(IX1,3)
            I4   = IXYZW(IX1,4)
C           I12  = IXYZW(IX1,5)
C           I13  = IXYZW(IX1,6)
C           I14  = IXYZW(IX1,7)
C           I23  = IXYZW(IX1,8)
C           I24  = IXYZW(IX1,9)
C           I34  = IXYZW(IX1,10)
            I123 = IXYZW(IX1,11)
            I124 = IXYZW(IX1,12)
            I134 = IXYZW(IX1,13)
            I234 = IXYZW(IX1,14)
            DO IX2 = 1,15
              J1   = IXYZW(IX2,1)
              J2   = IXYZW(IX2,2)
              J3   = IXYZW(IX2,3)
              J4   = IXYZW(IX2,4)
              J12  = IXYZW(IX2,5)
              J13  = IXYZW(IX2,6)
C             J14  = IXYZW(IX2,7)
              J23  = IXYZW(IX2,8)
C             J24  = IXYZW(IX2,9)
C             J34  = IXYZW(IX2,10)
              J123 = IXYZW(IX2,11)
C             J124 = IXYZW(IX2,12)
C             J134 = IXYZW(IX2,13)
C             J234 = IXYZW(IX2,14)
               DO I = 1,NTERMB
               GPGD(I,IX1,IXD,IX2) = XYZGB(I  ,J4)*GPFD(I,IX1 ,IXD,J123)
     &                             + ( IDT(I1 ,J4)*FPFD(I,I234,IXD,J123)
     &                                +IDT(I2 ,J4)*FPFD(I,I134,IXD,J123)
     &                                +IDT(I3 ,J4)*FPFD(I,I124,IXD,J123)
     &                                +IDT(I4 ,J4)*FPFD(I,I123,IXD,J123)
     &                                +IDT(IXD,J4)*GSFD(I,IX1     ,J123)
     &                                +IDT(J1 ,J4)*GPDD(I,IX1 ,IXD,J23 )
     &                                +IDT(J2 ,J4)*GPDD(I,IX1 ,IXD,J13 )
     &                                +IDT(J3 ,J4)*GPDD(I,IX1 ,IXD,J12 )
     &                               )/(2*ZETADABC(I))
               ENDDO
            ENDDO
         ENDDO
      ENDDO
      RETURN
      END
