mopac606_nbo/src/deri23.f

   1       SUBROUTINE DERI23 (F,FD,E,FCI,CMO,EMO,NORBS)
   2       IMPLICIT DOUBLE PRECISION (A-H,O-Z)
   3       INCLUDE 'SIZES'
   4       DIMENSION F(*), FD(*), E(*), FCI(*), CMO(NORBS,*), EMO(*)
   5 ***********************************************************************
   6 *  1) UNPACK THE C.I-ACTIVE M.O. DERIVATIVES IN M.O. BASIS,
   7 *     DIAGONAL BLOCKS INCLUDED.
   8 *  2) EXTRACT THE FOCK EIGENVALUES RELAXATION OVER C.I-ACTIVE M.O.
   9 *   INPUT
  10 *     F           : UNSCALED SOLUTIONS VECTOR IN M.O. BASIS,
  11 *                   OFF-DIAGONAL BLOCKS PACKED AS DEFINED IN 'DERI21'.
  12 *     FD          : DIAGONAL BLOCKS OF NON-RELAXED FOCK MATRIX
  13 *                   AS DEFINED IN 'DERI1'.
  14 *     E(NORBS)    : FOCK EIGENVALUES.
  15 *     FCI         : DIAGONAL BLOCKS OF RELAXATION OF THE FOCK MATRIX.
  16 *     NORBS       : NUMBER OF M.O
  17 *     NELEC,NMOS  : # OF LAST FROZEN CORE M.O , C.I-ACTIVE BAND LENGTH.
  18 *   OUTPUT
  19 *     CMO(N,NELEC+1,...,NELEC+NMOS): C.I-ACTIVE M.O DERIVATIVES
  20 *                                  IN M.O BASIS.
  21 *     EMO(  NELEC+1,...,NELEC+NMOS): C.I-ACTIVE FOCK EIGENVALUE RELAXATI
  22 *
  23 ***********************************************************************
  24       COMMON /FOKMAT/ FDUMY(MPACK), SCALAR(MPACK)
  25       COMMON /NVOMAT/ DIAG(MPACK/2)
  26       COMMON /CIBITS/ NMOS,LAB,NELEC,NBO(3)
  27      1       /MOLKST/ NDUMY(4*NUMATM+8),FRACT
  28 C
  29       NOPEN  =NBO(1)+NBO(2)
  30       CONST=1.D-3
  31 C
  32 C     PART 1.
  33 C     -------
  34 C     COMPUTE AND UNPACK DIAGONAL BLOCKS, DIAGONAL TERMS INCLUDED,
  35 C     ACCORDING TO CMO(I,J) = (FD(I,J)-FCI(I,J))/(E(I)-E(J))
  36 C     AND TAKING   CMO(I,J)=0 IF E(I)=E(J) (THRESHOLD 1D-4 EV),
  37 C                             I.E WHEN M.O. DEGENERACY OCCURS.
  38       L=1
  39       NEND=0
  40       DO 30 LOOP=1,3
  41          NINIT=NEND+1
  42          NEND =NEND+NBO(LOOP)
  43          N1=MAX(NINIT,NELEC+1   )
  44          N2=MIN(NEND ,NELEC+NMOS)
  45          IF(N2.LT.N1) GO TO 30
  46          DO 20 I=N1,N2
  47             IF(I.GT.NINIT) THEN
  48                DO 10 J=NINIT,I-1
  49                   DIFFE=E(I)-E(J)
  50                   IF(ABS(DIFFE).GT.1.D-4) THEN
  51                      COM=(FD(L)-FCI(L))/DIFFE
  52                   ELSE
  53                      COM=0.D0
  54                   ENDIF
  55                   CMO(I,J)=-COM
  56                   CMO(J,I)= COM
  57    10          L=L+1
  58             ENDIF
  59    20    CMO(I,I)= 0.D0
  60    30 CONTINUE
  61 C
  62 C     C.I-ACTIVE EIGENVALUES RELAXATION.
  63       CALL SCOPY(NMOS,FCI(L),1,EMO(NELEC+1),1)
  64 C
  65 C     PART 2.
  66 C     -------
  67 C     UNPACK THE ANTISYMMETRIC MATRIX F IN CMO, (OFF-DIAGONAL BLOCKS).
  68 C
  69       L=1
  70       IF(NBO(2).GT.0 .AND. NBO(1).GT.0) THEN
  71 C        OPEN-CLOSED
  72          SCAL=1.D0/(2.D0-FRACT+CONST)
  73          DO 40 J=1       ,NBO(1)
  74             DO 40 I=NBO(1)+1,NOPEN
  75                COM=F(L)*SCAL
  76                CMO(I,J)=-COM
  77                CMO(J,I)= COM
  78    40    L=L+1
  79       ENDIF
  80       IF(NBO(3).GT.0 .AND. NBO(1).GT.0) THEN
  81 C        VIRTUAL-CLOSED
  82          SCAL=0.5D0
  83          DO 50 J=1     ,NBO(1)
  84             DO 50 I=NOPEN+1,NORBS
  85                COM=F(L)*SCAL
  86                CMO(I,J)=-COM
  87                CMO(J,I)= COM
  88    50    L=L+1
  89       ENDIF
  90       IF(NBO(3).NE.0 .AND. NBO(2).NE.0) THEN
  91 C        VIRTUAL-OPEN
  92          SCAL=1.D0/(FRACT+CONST)
  93          DO 60 J=NBO(1)+1,NOPEN
  94             DO 60 I=NOPEN+1  ,NORBS
  95                COM=F(L)*SCAL
  96                CMO(I,J)=-COM
  97                CMO(J,I)= COM
  98    60    L=L+1
  99       ENDIF
 100       RETURN
 101       END