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