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