1      subroutine dimqm_printDipole(rtdb, muind, icmplx, lpprint)
2c
3c
4c
5c
6c
7      implicit none
8#include "errquit.fh"
9#include "inp.fh"
10#include "rtdb.fh"
11#include "stdio.fh"
12#include "nwc_const.fh"
13#include "mafdecls.fh"
14#include "global.fh"
15#include "dimqm_constants.fh"
16#include "dimqm.fh"
17
18c   Input variables
19      integer rtdb
20      integer icmplx
21      double precision muind(3,nDIM,icmplx)
22c      double precision qind(nDIM, icmplx)
23      logical lpprint
24c
25c   Local variables
26      double precision diptot(3, icmplx)
27      character*60 dd
28      character*60 d
29
30      if(ga_nodeid().ne.0) return
31      diptot = SUM(muind, DIM = 2)
32      dd =
33     $ '============================================================='
34      d =
35     $ '-------------------------------------------------------------'
36c   BLAS matrix-matrix multiply to add in charge term
37
38      if(lpprint) then
39       write(luout,'(/1x,a)') dd
40       write(luout,'(1x,a)')
41     $                   'Total induced dipole moment in DIM system :'
42       write(luout,'(1x,a)') d
43       if(icmplx == 1) then
44        write(luout,'(2x,a,2x,3f16.8)') 'A.U.:', diptot(:,1)
45        write(luout,'(2x,a,1x,3f16.8)') 'Debye:', diptot(:,1)*AU2DEBYE
46       else
47        write(luout,'(1x,a)') 'A.U.'
48        write(luout,'(1x,a,3f16.8)') 'Real: ', diptot(:,1)
49        write(luout,'(1x,a,3f16.8)') 'Imag: ', diptot(:,2)
50        write(luout,'(1x,a)') d
51        write(luout,'(1x,a)') 'Debye'
52        write(luout,'(1x,a,3f16.8)') 'Real: ', diptot(:,1)*AU2DEBYE
53        write(luout,'(1x,a,3f16.8)') 'Imag: ', diptot(:,2)*AU2DEBYE
54       end if
55       write(luout,'(1x,a/)') dd
56      else
57       write(luout,'(1x,a)')
58     $                   'Total induced dipole moment in DIM system :'
59       if(icmplx == 1) then
60        write(luout,'(3f14.8)') diptot(:,1)
61       else
62         write (luout,'(1x,a,3f16.8)') 'Real: ', diptot(:,1)
63         write (luout,'(1x,a,3f16.8)') 'Imag: ', diptot(:,2)
64       end if
65      end if
66
67      end subroutine dimqm_printDipole
68