1      subroutine dplot_dump(lgaussian,out_unit,iproc,luout,
2     ,     where,what,title,
3     ,     natom,xyz,charge,volume,tol_rho,
4     ,     coofrom,cooto,no_of_spacings,ngrid,values,atag)
5      implicit none
6      logical lgaussian
7      character *(*) title
8      character*8 where,what                ! [input]
9      integer out_unit ! [input]
10      double precision xyz(3,*),charge(*)
11      integer natom
12      integer no_of_spacings(3),ngrid
13      integer iproc,luout
14      double precision values(*),volume,coofrom(3),cooto(3)
15      character*16 atag(*)
16c
17      double precision spread(3),step(3),angle(3),tol_rho
18      integer const_m(3),const_p(3)
19c
20      integer i,ii,ifast,atomicno
21      double precision appch,sum
22      character*16 element
23      character*2 symbol
24      logical geom_tag_to_element
25      external geom_tag_to_element
26c
27      appch=0d0
28      call  dplot_defgrid(volume,angle,
29     ,     spread,step,const_m,const_p,
30     ,     cooto,coofrom,no_of_spacings)
31c
32      If (iProc.eq.0 . and . Where.ne.'NUCLEI') Then
33         if(lgaussian) then
34            Write(Out_Unit,*)"Cube file generated by NWChem"
35            Write(Out_Unit,*) Title
36         else
37            Write(Out_Unit,*)Title
38            Write(Out_Unit,115)
39 115        format('(1F15.10)')
40         endif
41      End If
42      If (iProc.eq.0 . and . Where.ne.'NUCLEI') Then
43         if(lgaussian) then
44 9498       format(I5,3F12.6)
45            Write(Out_Unit,9498)
46     &           natom,(coofrom(i),i=1,3)
47            Write(Out_Unit,9498)
48     &           no_of_spacings(1)+1,step(1),0d0,0d0
49            Write(Out_Unit,9498)
50     &           no_of_spacings(2)+1,0d0,step(2),0d0
51            Write(Out_Unit,9498)
52     &           no_of_spacings(3)+1,0d0,0d0,step(3)
53            do i=1,natom
54            if (.not. geom_tag_to_element(atag(i), symbol,
55     &         element, atomicno)) then
56               if (symbol .ne. 'bq') call errquit
57     &              ('dplotdump: center is neither atom nor bq',
58     &              0,0)
59            endif
60            Write(Out_Unit,9499)
61     .            atomicno,charge(i),xyz(1,i),xyz(2,i),xyz(3,i)
62 9499       format(I5,4F12.6)
63c
64c     dump MOlist (if any)
65c
66         enddo
67         else
68            Write(Out_Unit,'(3(1x,f10.5),3(3x,f5.2))')
69     &           (Spread(i),i=1,3),(Angle(i),i=1,3)
70            Write(Out_Unit,'(3(2x,i4))')(no_of_spacings(i),i=1,3)
71            iFast = 1
72            Write(Out_Unit,'(5x,i1,6(2x,i4))')
73     &           iFast,(Const_M(i),Const_P(i),i=1,3)
74         endif
75      End If
76c
77c     dump grid values
78c
79      If (iProc.eq.0 . and . Where.ne.'NUCLEI') Then
80c
81         if(lgaussian) then ! for cube files
82c
83c     truncation
84c
85            Do i = 1, nGrid
86               if(abs(values(i)).lt.tol_rho) values(i)=0d0
87            enddo
88            Do i = 1, nGrid,No_Of_Spacings(3)+1
89               Write(Out_Unit,99498)(values(i+ii),ii=0,
90     .              No_Of_Spacings(3))
9199498          format(6E13.5)
92            enddo
93         else
94            Do i = 1, nGrid
95               Write(Out_Unit,'(f15.10)')values(i)
96            End Do
97         endif
98         If (What.eq.'VIEW') Then
99            write(Out_unit,19498)
10019498       format(10I5)
101         endif
102c
103         If (What.eq.'DENSITY') Then
104            Sum = 0.d0
105            Do i = 1, nGrid
106               Sum = Sum + values(i)
107            End Do
108            AppCh = Sum*Volume
109            Write(LuOut,*)
110            Write(LuOut,'(a,e30.5)')'  Tol_rho              = ',tol_rho
111            Write(LuOut,'(a,f30.5)')'  Sum of elements      = ',sum
112            Write(LuOut,'(a,f30.5)')'  Integration volume   = ',volume
113            Write(LuOut,'(a,f30.5)')'  Integrated Charge    = ',AppCh
114         End If
115      End If
116      call util_flush(out_unit)
117      return
118      end
119c $Id$
120