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