1C 2C zfock_cs_exchim.F 3C 4C Computes the imaginary part of the exchange for a complex Fock 5C matrix. 6C 7 subroutine zfock_cs_exchim (params, g_densim, Excim, g_fxim) 8 implicit none 9 10#include "bas.fh" 11#include "errquit.fh" 12#include "mafdecls.fh" 13#include "stdio.fh" 14#include "global.fh" 15#include "util.fh" 16#include "cdft.fh" 17#include "matutils.fh" 18#include "rt_tddft.fh" 19 20 21C == Inputs == 22 type(rt_params_t), intent(in) :: params 23 integer, intent(in) :: g_densim 24 25 26C == Outputs == 27 double precision, intent(out) :: Excim(2) 28 integer, intent(in) :: g_fxim !imag part exchange potential 29 30 31C == Parameters == 32 character(*), parameter :: pname = "zfock_cs_exchim: " 33 34 35C == Variables == 36 double precision jfac, kfac 37C double precision tol2e 38 double precision elapsed 39 40 41 call rt_tddft_cs_confirm (params,'zfock_cs_exchim.F') 42 43 44 if (params%prof) call prof_start (elapsed) 45 46 47C == Initializations == 48C tol2e = 10.d0**(-itol2e) 49 Excim(1) = 0d0 50 51 call ga_zero (g_fxim) 52 53C 54C Note that for imaginary part of exchange we pass antisymm (.true.) 55C to the Fock builder, and we explicitly antisymmetrize the result. 56C 57 58 jfac = 0.0d0 59 kfac = -0.5d0*xfac(1) 60 61 call fock_2e(geom, ao_bas_han, 1, jfac, kfac, 62 $ params%tol2e_im, oskel, g_densim, g_fxim, .true.) 63 64C call asym_fock2e (g_fxim) !xxx 65C call ga_scale (g_fxim, -1d0) !FIXED: Proper canorg transform now, no need for this incorrect fudge 66 67 call ga_antisymmetrize (g_fxim) 68 call ga_scale (g_fxim, -1d0) 69 70 71C 72C Check symmetries (disable for speed). 73C 74 if (params%checklvl .ge. 2) then 75 if (.not. mat_is_symmetric (g_densim, "A", params%tol_zero)) 76 $ call errquit (pname//"Im[P] not antisymm", 0, 0) 77 78 if (.not. mat_is_symmetric (g_fxim, "A", params%tol_zero)) 79 $ call errquit (pname//"Im[Vx] not antisymm", 0, 0) 80 endif 81 82 83C 84C Calculate exchange energy. 85C 86 Excim(1)= 0.5d0 * ga_ddot (g_densim, g_fxim) 87 88 if (params%prof) call prof_end (elapsed, "Fock CS imag exch") 89 90 end subroutine 91 92 93c $Id$ 94