1c
2c $Id$
3c
4
5      SUBROUTINE shll_qnch(ntshel)
6
7      implicit none
8
9      include 'p_input.inc'
10      include 'p_array.inc'
11      include 'p_const.inc'
12      include 'cm_atom.inc'
13      include 'cm_temp.inc'
14      include 'cm_shel.inc'
15
16      integer i,iatm1,iatm2,iatma,iatmb
17      integer ntshel
18
19      real*8 cske,rmu,vij,xscale
20      real*8 tmx,tmy,tmz
21
22      dimension vij(mxshel2,3)
23
24      cske=boltzmann*temp*1.d-4
25
26      do i=1,ntshel
27
28       iatm1=shllist(i,1)
29       iatm2=shllist(i,2)
30       iatma=atmtype(iatm1)
31       iatmb=atmtype(iatm2)
32       rmu=(typmass(iatma)*typmass(iatmb))/
33     $     (typmass(iatma)+typmass(iatmb))
34
35       vij(i,1)=vvv(iatm2,1)-vvv(iatm1,1)
36       vij(i,2)=vvv(iatm2,2)-vvv(iatm1,2)
37       vij(i,3)=vvv(iatm2,3)-vvv(iatm1,3)
38
39       xscale=sqrt(cske/(rmu*(vij(i,1)**2+vij(i,2)**2+vij(i,3)**2)))
40
41       tmx=typmass(iatma)*vvv(iatm1,1)+typmass(iatmb)*vvv(iatm2,1)
42       tmy=typmass(iatma)*vvv(iatm1,2)+typmass(iatmb)*vvv(iatm2,2)
43       tmz=typmass(iatma)*vvv(iatm1,3)+typmass(iatmb)*vvv(iatm2,3)
44
45       vvv(iatm1,1)=tmx/(typmass(iatma)+typmass(iatmb))
46     $             -xscale*rmu*vij(i,1)/typmass(iatma)
47       vvv(iatm2,1)=tmx/(typmass(iatma)+typmass(iatmb))
48     $             +xscale*rmu*vij(i,1)/typmass(iatmb)
49       vvv(iatm1,2)=tmy/(typmass(iatma)+typmass(iatmb))
50     $             -xscale*rmu*vij(i,2)/typmass(iatma)
51       vvv(iatm2,2)=tmy/(typmass(iatma)+typmass(iatmb))
52     $             +xscale*rmu*vij(i,2)/typmass(iatmb)
53       vvv(iatm1,3)=tmz/(typmass(iatma)+typmass(iatmb))
54     $             -xscale*rmu*vij(i,3)/typmass(iatma)
55       vvv(iatm2,3)=tmz/(typmass(iatma)+typmass(iatmb))
56     $             +xscale*rmu*vij(i,3)/typmass(iatmb)
57
58      enddo
59
60      return
61
62      END
63