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