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