1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
SUBROUTINE ADDNUC (ENUCLR)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
COMMON / SOLV / FEPSI,RDS,DISEX2,NSPA,NPS,NPS2,NDEN,
1 COSURF(3,LENABC), SRAD(NUMATM),ABCMAT(LENAB2),
2 TM(3,3,NUMATM),QDEN(MAXDEN),DIRTM(3,NPPA),
3 BH(LENABC)
4 /SOLVI/ IATSP(LENABC+1),NAR(LENABC), NN(2,NUMATM)
COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
1 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
2 NCLOSE,NOPEN,NDUMY,FRACT
COMMON /CORE / CORE(107)
ENCLR=0.D0
I0=NPS2+NDEN*NPS
IDEN=0
DO 20 I=1,NUMAT
IA=NFIRST(I)
IDEL=NLAST(I)-IA
I1=I0+(IDEN*(IDEN+1))/2
COREI = CORE(NAT(I))
DO 10 J=1,I-1
JA=NFIRST(J)
JDEL=NLAST(J)-JA
I1=I1+1
ENCLR = ENCLR + 2 * COREI * ABCMAT(I1) * CORE(NAT(J))
I1=I1+JDEL**2
10 CONTINUE
I1=I1+1
ENCLR = ENCLR + COREI * ABCMAT(I1) * COREI
IDEN=IDEN+1+IDEL**2
20 CONTINUE
ENUCLR = ENUCLR+ENCLR
RETURN
END
|
