1 subroutine addd(imo,ipsi,iao, 2 & p,paa,psi) 3c THIS IS REALLY atmd 4 implicit double precision (a-h,o-z) 5 parameter (numatm=2000) 6 common /atopla/ xsym(numatm),ysym(numatm),zsym(numatm), 7 & isym(numatm) 8 common /moldat/ natoms, norbs, nelecs,nat(numatm) 9 common /coord / xyz(3,numatm) 10 common /slagau/ ihasd,isgau,ido5d,ido7f,ido9g,ihasg 11 common /orbhlp/ mxorb,iuhf,ispd 12 common /rdwr/ iun1,iun2,iun3,iun4,iun5 13 parameter (mxel=100) 14 character*2 elemnt 15 common /elem/elemnt(mxel) 16 dimension p(*),paa(*),psi(*) 17 18 ipreca = 0 19 write(iun3,'(//''ELECTR. DENSITY/INTENSITY AT ATOMS '', 20 & ''LYING IN THE PLANE OF THE PLOT''//)') 21 write(iun3, 22 & '('' ATOM X Y Z VALUE'')') 23 write(iun3,'(//)') 24 do l=1,natoms 25 if (isym(l).eq.1) then 26 if (imo.eq.1) then 27 call slater(xyz(1,l),xyz(2,l),xyz(3,l),psi) 28 elseif (iao.eq.1.and.isgau.eq.0) then 29 call adffun(xyz(1,l),xyz(2,l),xyz(3,l),psi) 30 else 31 call gaussian(xyz(1,l),xyz(2,l),xyz(3,l),psi,norbs, 32 & ipreca,0,0) 33 endif 34 sum = 0.0d0 35 if (ipsi.eq.0) then 36 do i=1,norbs 37 sum = sum - psi(i)*psi(i)*p((i-1)*mxorb+i)*0.5d0 38 do j=1,i 39 sum = sum + psi(i)*psi(j)*p((j-1)*mxorb+i) 40 end do 41 end do 42 sum = sum + sum 43 else 44 do i=1,norbs 45 sum = sum + paa(i)*psi(i) 46 end do 47 endif 48 write(iun3,222)elemnt(nat(l)),(xyz(ig,l),ig=1,3),sum 49 endif 50 end do 51 52222 format(4x,a2,3f10.5,2x,f13.5) 53 54 return 55 end 56