From 20ea77a650ea150de5303b10e4a0dbf2e6562464 Mon Sep 17 00:00:00 2001 From: Ken Lopata Date: Sat, 21 May 2016 05:33:52 +0000 Subject: [PATCH] added RT-TDDFT molecular orbital complex absorbing potential --- .../rt_tddft/closedshell/rt_tddft_cs_prop.F | 15 +- .../rt_tddft/closedshell/zfock_cs_build.F | 30 +++- src/nwdft/rt_tddft/headers/rt_tddft.fh | 9 ++ src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F | 35 ++++- src/nwdft/rt_tddft/input/GNUmakefile | 1 + src/nwdft/rt_tddft/input/rt_tddft_input.F | 7 + .../input/rt_tddft_input_put_defaults.F | 4 + .../rt_tddft/openshell/rt_tddft_os_prop.F | 20 ++- src/nwdft/rt_tddft/openshell/zfock_os_build.F | 45 ++++++ src/nwdft/rt_tddft/rtutils/GNUmakefile | 3 +- src/nwdft/rt_tddft/rtutils/rt_tddft_project.F | 133 ++++++++++++++---- .../rtutils/rt_tddft_zdens_tot_movecs.F | 6 +- 12 files changed, 265 insertions(+), 43 deletions(-) diff --git a/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F b/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F index 3aadde1dc6..c3c1474011 100644 --- a/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F +++ b/src/nwdft/rt_tddft/closedshell/rt_tddft_cs_prop.F @@ -188,10 +188,15 @@ C call zfock_cs_build (params, g_zdens_ao, energies, g_zfock_ao) call canorg_trans (params,"F","AO->MO", g_zfock_ao, g_zfock_mo) - if (.not. mat_is_purereal (g_zfock_mo, params%tol_zero)) - $ call errquit (pname// - $ "initial Fock matrix in MO basis is not pure real", 0, 0) -C call rt_tddft_print_notice ("Disabled init MO Fock check") + if (params%mocap_active) then + call rt_tddft_print_notice ( + $ "MO CAP active: Disabled initial MO Fock check") + else + if (.not. mat_is_purereal (g_zfock_mo, params%tol_zero)) + $ call errquit (pname// + $ "initial Fock matrix in MO basis is not pure real", 0, 0) + endif + call rt_tddft_calc_Etot (params, energies) energies%gs = energies%tot @@ -229,7 +234,7 @@ C if (params%print_moocc .or. do_zora) then if (.not. mat_is_purereal (g_zfock_mo, params%tol_zero)) $ call errquit (pname// - $ "initial Fock matrix in MO basis is not pure real", 0, 0) + $ "MO occup needs initial MO Fock mat to be pure real",0,0) call rt_tddft_movecs_gs (params, g_zfock_mo, g_movecs_mo_gs) endif diff --git a/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F b/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F index 6e5e55436e..a49cf75797 100644 --- a/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F +++ b/src/nwdft/rt_tddft/closedshell/zfock_cs_build.F @@ -54,7 +54,7 @@ C == Variables == double precision dftExc(2) logical status double precision elapsed, elapsed_tot - + integer g_zfock_mo, g_zcapmo ! for MO damping C == External routines == logical xc_gotxc @@ -258,6 +258,34 @@ C not have changed. Perhaps double check this?? if (params%prof) call prof_end (elapsed, "Fock CS d2z") + +C +C Apply molecular orbital complex absorbing potential (MO CAP) +C + if (params%mocap_active) then + if (.not. ga_create(mt_dcpl, params%ns_mo, params%ns_mo, + $ "Fock MO tmp" , 0, 0, g_zfock_mo)) + $ call errquit(pname//"GA alloc failed",0, GA_ERR) + + if (.not. ga_create(mt_dcpl, params%ns_mo, params%ns_mo, + $ "Fock MO tmp" , 0, 0, g_zcapmo)) + $ call errquit(pname//"GA alloc failed",0, GA_ERR) + + call canorg_trans (params,"F","AO->MO", g_zfock, g_zfock_mo) + call rt_tddft_mocap (params, g_zfock_mo, g_zcapmo) + call ga_zadd (z1, g_zfock_mo, z1, g_zcapmo, g_zfock_mo) + call canorg_trans (params,"F","MO->AO", g_zfock_mo, g_zfock) + call rt_tddft_print_notice ("Applied closed shell MO CAP") + + if (.not. ga_destroy(g_zfock_mo)) + $ call errquit(pname//"GA destroy failed",0, GA_ERR) + + if (.not. ga_destroy(g_zcapmo)) + $ call errquit(pname//"GA destroy failed",0, GA_ERR) + endif + + + C C Extra checks, disabled for speed. C diff --git a/src/nwdft/rt_tddft/headers/rt_tddft.fh b/src/nwdft/rt_tddft/headers/rt_tddft.fh index 22e0102089..587f00e58e 100644 --- a/src/nwdft/rt_tddft/headers/rt_tddft.fh +++ b/src/nwdft/rt_tddft/headers/rt_tddft.fh @@ -351,6 +351,15 @@ C (zora stuff) integer :: g_zora_sf(2) integer :: g_zora_scale_sf(2) + +C (MO complex absorbing potential stuff) + logical :: mocap_active + logical :: mocap_print + logical :: mocap_checks + double precision :: mocap_emin + double precision :: mocap_maxval + double precision :: mocap_prefac + double precision :: mocap_expconst end type rt_params_t c $Id$ diff --git a/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F b/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F index ae49a73a3f..6312c06de3 100644 --- a/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F +++ b/src/nwdft/rt_tddft/init/rt_tddft_init_rtdb.F @@ -206,6 +206,39 @@ C $ params%excite(iexcite)) enddo - + +C +C MO CAP +C + if (.not.rtdb_get(params%rtdb, "rt_tddft:mocap_active", + $ mt_log, 1, params%mocap_active)) call errquit (pname// + $ "failed to read mocap_active from rtdb", 0, RTDB_ERR) + + if (params%mocap_active) then + if (.not. rtdb_get (params%rtdb, "rt_tddft:mocap_emin", + $ mt_dbl, 1, params%mocap_emin)) call errquit (pname// + $ "failed to read mocap_emin from rtdb", 0, RTDB_ERR) + + if (.not. rtdb_get (params%rtdb, "rt_tddft:mocap_maxval", + $ mt_dbl, 1, params%mocap_maxval)) call errquit (pname// + $ "failed to read mocap_maxval from rtdb", 0, RTDB_ERR) + + if (.not. rtdb_get (params%rtdb, "rt_tddft:mocap_prefac", + $ mt_dbl, 1, params%mocap_prefac)) call errquit (pname// + $ "failed to read mocap_prefac from rtdb", 0, RTDB_ERR) + + if (.not. rtdb_get (params%rtdb, "rt_tddft:mocap_expconst", + $ mt_dbl, 1, params%mocap_expconst)) call errquit (pname// + $ "failed to read mocap_expconst from rtdb", 0, RTDB_ERR) + + if (.not.rtdb_get(params%rtdb, "rt_tddft:mocap_checks", + $ mt_log, 1, params%mocap_checks)) call errquit (pname// + $ "failed to read mocap_checks from rtdb", 0, RTDB_ERR) + + if (.not.rtdb_get(params%rtdb, "rt_tddft:mocap_print", + $ mt_log, 1, params%mocap_print)) call errquit (pname// + $ "failed to read mocap_print from rtdb", 0, RTDB_ERR) + endif + end subroutine c $Id$ diff --git a/src/nwdft/rt_tddft/input/GNUmakefile b/src/nwdft/rt_tddft/input/GNUmakefile index b28a4d0a0a..bd064cc645 100644 --- a/src/nwdft/rt_tddft/input/GNUmakefile +++ b/src/nwdft/rt_tddft/input/GNUmakefile @@ -5,6 +5,7 @@ rt_tddft_input_print.o \ rt_tddft_input_excite.o \ rt_tddft_input_tolerances.o \ rt_tddft_input_visualization.o \ +rt_tddft_input_mocap.o \ rt_tddft_input.o diff --git a/src/nwdft/rt_tddft/input/rt_tddft_input.F b/src/nwdft/rt_tddft/input/rt_tddft_input.F index 2d2f7363ac..97b3689ade 100644 --- a/src/nwdft/rt_tddft/input/rt_tddft_input.F +++ b/src/nwdft/rt_tddft/input/rt_tddft_input.F @@ -182,6 +182,13 @@ C visualization sub-block C elseif (inp_compare(.false.,test,'visualization')) then call rt_tddft_input_visualization (rtdb) + + +C +C MO CAP sub-block +C + elseif (inp_compare(.false.,test,'mocap')) then + call rt_tddft_input_mocap (rtdb) C diff --git a/src/nwdft/rt_tddft/input/rt_tddft_input_put_defaults.F b/src/nwdft/rt_tddft/input/rt_tddft_input_put_defaults.F index 8e0f410a50..5797395233 100644 --- a/src/nwdft/rt_tddft/input/rt_tddft_input_put_defaults.F +++ b/src/nwdft/rt_tddft/input/rt_tddft_input_put_defaults.F @@ -41,6 +41,7 @@ C integer, parameter :: nsnapshots = 0 logical, parameter :: nodisk = .false. !XXX DISABLED NOW--ie, just use DFT settings logical, parameter :: matrix_checks = .false. logical, parameter :: use_dmat = .false. + logical, parameter :: mocap = .false. character(len=*), parameter :: tag = ": " @@ -189,6 +190,9 @@ C if (.not.rtdb_put(rtdb,'rt_tddft:use_dmat',mt_log,1,use_dmat)) $ call errquit(pname//'Write failed to rtdb',0,RTDB_ERR) + if (.not.rtdb_put(rtdb,'rt_tddft:mocap_active',mt_log,1,mocap)) + $ call errquit(pname//'Write failed to rtdb',0,RTDB_ERR) + end subroutine diff --git a/src/nwdft/rt_tddft/openshell/rt_tddft_os_prop.F b/src/nwdft/rt_tddft/openshell/rt_tddft_os_prop.F index 1df53bd45d..db54a504eb 100644 --- a/src/nwdft/rt_tddft/openshell/rt_tddft_os_prop.F +++ b/src/nwdft/rt_tddft/openshell/rt_tddft_os_prop.F @@ -218,14 +218,22 @@ C call canorg_trans(params,"F","AO->MO",g_zfock_ao(1),g_zfock_mo(1)) call canorg_trans(params,"F","AO->MO",g_zfock_ao(2),g_zfock_mo(2)) - if (.not. mat_is_purereal (g_zfock_mo(1), params%tol_zero)) - $ call errquit (pname// - $ "initial Fock alpha matrix in MO basis is not pure real",0,0) - if (.not. mat_is_purereal (g_zfock_mo(2), params%tol_zero)) - $ call errquit (pname// - $ "initial Fock beta matrix in MO basis is not pure real",0,0) + if (params%mocap_active) then + call rt_tddft_print_notice ( + $ "MO CAP active: Disabled initial MO Fock check") + else + if (.not. mat_is_purereal (g_zfock_mo(1), params%tol_zero)) + $ call errquit (pname// + $ "initial Fock alpha matrix in MO basis not pure real",0,0) + + if (.not. mat_is_purereal (g_zfock_mo(2), params%tol_zero)) + $ call errquit (pname// + $ "initial Fock beta matrix in MO basis not pure real",0,0) + endif + + call rt_tddft_calc_Etot (params, energies) energies%gs = energies%tot diff --git a/src/nwdft/rt_tddft/openshell/zfock_os_build.F b/src/nwdft/rt_tddft/openshell/zfock_os_build.F index cce4d823f2..3f6af61926 100644 --- a/src/nwdft/rt_tddft/openshell/zfock_os_build.F +++ b/src/nwdft/rt_tddft/openshell/zfock_os_build.F @@ -62,6 +62,7 @@ C == Variables == logical status double precision elapsed, elapsed_tot integer is !spin counter + integer g_zcapmo, g_zfock_mo ! tmp GAs for MO CAP C == External routines == @@ -252,6 +253,50 @@ C if (params%prof) call prof_end (elapsed, "Fock OS d2z") + +C +C Apply molecular orbital complex absorbing potential (MO CAP). +C Potential is different for alpha and beta spins, as it is +C built from their respective Fock matrices. +C + if (params%mocap_active) then + if (.not. ga_create(mt_dcpl, params%ns_mo, params%ns_mo, + $ "Fock MO tmp" , 0, 0, g_zfock_mo)) + $ call errquit(pname//"GA alloc failed",0, GA_ERR) + + if (.not. ga_create(mt_dcpl, params%ns_mo, params%ns_mo, + $ "Fock MO tmp" , 0, 0, g_zcapmo)) + $ call errquit(pname//"GA alloc failed",0, GA_ERR) + +C (alpha spin) + call canorg_trans (params,"F","AO->MO", + $ g_zfock(1), g_zfock_mo) + call rt_tddft_mocap (params, g_zfock_mo, g_zcapmo) + call ga_zadd (z1, g_zfock_mo, + $ z1, g_zcapmo, g_zfock_mo) + call canorg_trans (params,"F","MO->AO", + $ g_zfock_mo, g_zfock(1)) + call rt_tddft_print_notice ("Applied MO CAP to alpha spin") + +C (beta spin) + call canorg_trans (params,"F","AO->MO", + $ g_zfock(2), g_zfock_mo) + call rt_tddft_mocap (params, g_zfock_mo, g_zcapmo) + call ga_zadd (z1, g_zfock_mo, + $ z1, g_zcapmo, g_zfock_mo) + call canorg_trans (params,"F","MO->AO", + $ g_zfock_mo, g_zfock(2)) + call rt_tddft_print_notice ("Applied MO CAP to beta spin") + + + if (.not. ga_destroy(g_zfock_mo)) + $ call errquit(pname//"GA destroy failed",0, GA_ERR) + if (.not. ga_destroy(g_zcapmo)) + $ call errquit(pname//"GA destroy failed",0, GA_ERR) + endif + + + C C Extra checks, disabled for speed. C diff --git a/src/nwdft/rt_tddft/rtutils/GNUmakefile b/src/nwdft/rt_tddft/rtutils/GNUmakefile index 8379a6d11c..ea86f08438 100644 --- a/src/nwdft/rt_tddft/rtutils/GNUmakefile +++ b/src/nwdft/rt_tddft/rtutils/GNUmakefile @@ -15,7 +15,8 @@ rt_tddft_excite.o \ rt_tddft_checkpoint.o \ rt_tddft_zora_scale.o \ rt_tddft_project.o \ -rt_tddft_zdens_tot_movecs.o +rt_tddft_zdens_tot_movecs.o \ +rt_tddft_mocap.o OBJ_OPTIMIZE = diff --git a/src/nwdft/rt_tddft/rtutils/rt_tddft_project.F b/src/nwdft/rt_tddft/rtutils/rt_tddft_project.F index 6dfcb55b1b..05a81542a8 100644 --- a/src/nwdft/rt_tddft/rtutils/rt_tddft_project.F +++ b/src/nwdft/rt_tddft/rtutils/rt_tddft_project.F @@ -8,7 +8,8 @@ C where C' is the eigenvector matrix of the matrix B. C C XXX CHECK: only valid when B is the MO Fock matrix? C - subroutine rt_tddft_project (params, dir, g_za, g_zb, g_zaproj) + subroutine rt_tddft_project (params, dir, g_za, g_zb, + $ g_zaproj, lherm) implicit none #include "errquit.fh" @@ -26,6 +27,7 @@ C == Inputs == character, intent(in) :: dir !="F" for forward, "R" for reverse integer, intent(in) :: g_za integer, intent(in) :: g_zb + logical, intent(in) :: lherm !T= g_za is hermitian, F=g_zb is non hermitian C == Outputs == integer, intent(in) :: g_zaproj @@ -37,6 +39,12 @@ C == Variables == integer n integer ivals, lvals integer g_zevecs, g_zevecs_hconj, g_ztmp + integer g_zevecs_inv, g_zevecs_hconj_inv + integer me + double complex zval + integer i + + me = ga_nodeid() C XXX ASSUME SIZE: nmo @@ -52,39 +60,103 @@ C XXX ASSUME SIZE: nmo if (.not. ga_duplicate (g_za, g_zevecs_hconj, "zvecs_hconj")) $ call errquit (pname//"failed to create ztmp1", 0, GA_ERR) + if (.not. ga_duplicate (g_za, g_zevecs_hconj_inv, "zvecs_hconj")) + $ call errquit (pname//"failed to create ztmp1", 0, GA_ERR) + + if (.not. ga_duplicate (g_za, g_zevecs_inv, "zvecs_inv")) + $ call errquit (pname//"failed to create inv", 0, GA_ERR) + if (.not. ga_duplicate (g_za, g_ztmp, "ztmp")) $ call errquit (pname//"failed to create ztmp", 0, GA_ERR) if (.not.ma_push_get(mt_dcpl, params%ns_ao,'vals',lvals,ivals)) - & call errquit(pname//'cannot allocate vals',0, MA_ERR) + & call errquit(pname//'cannot allocate vals',0, MA_ERR) !xxxx size??? C Diagonalize B matrix to get C matrix and eigenvalues call ga_zero (g_zevecs) -C call zmat_diag (g_zb, g_zevecs, dcpl_mb(ivals), .true.) !true = reorder evals by energy - call zmat_diag (g_zb, g_zevecs, dcpl_mb(ivals), .false., .false.) !true = reorder evals by energy + call zmat_diag (g_zb, g_zevecs, dcpl_mb(ivals), .true., .false.) !true = reorder evals by energy, false = dont check call ga_zero (g_zevecs_hconj) - call mat_hermconj (g_zevecs, g_zevecs_hconj) - - if ( (dir.eq."F").or.(dir.eq."f")) then ! C^+ A C - call ga_zero (g_ztmp) - call ga_zgemm("N", "N", n, n, n, - $ z1, g_za, g_zevecs, z0, g_ztmp) - call ga_zgemm("N", "N", n, n, n, - $ z1, g_zevecs_hconj, g_ztmp, z0, g_zaproj) - - elseif ( (dir.eq."R").or.(dir.eq."r")) then ! C A C^+ - call ga_zero (g_ztmp) - call ga_zgemm("N", "N", n, n, n, - $ z1, g_za, g_zevecs_hconj, z0, g_ztmp) - call ga_zgemm("N", "N", n, n, n, - $ z1, g_zevecs, g_ztmp, z0, g_zaproj) - - else - call errquit (pname//"invalid flag: "//dir, 0,0) - endif + +C +C Print all eigenvalues to screen is turned off for now +C +c$$$ if (me.eq.0) then +c$$$ write(luout, *) "" +c$$$ write(luout, *) "Eigenvalues" +c$$$ do i = 1, params%ns_ao !size?? +c$$$ zval = dcpl_mb(ivals + i - 1) +c$$$ write(luout, "(1x,a,i8,3x,2e16.6)") +c$$$ $ "MO", i, dble(zval), aimag(zval) +c$$$ enddo +c$$$ endif + call ga_sync() + + if (lherm) then + if (.not. mat_is_unitary(g_zevecs, 1d-8)) then + + if (me.eq.0) then + write(luout, *) pname//"Eigenvector matrix non-unitary" + call halt() + endif + + else + if (me.eq.0) write(luout, *) + $ pname//"Eigenvector matrix is unitary. Good." + endif + endif + + if (lherm) then + call mat_hermconj (g_zevecs, g_zevecs_hconj) !this assumes eigenvector matrix is unitary: U^+ = U^-1 + + if ( (dir.eq."F").or.(dir.eq."f")) then ! C^+ A C + call ga_zero (g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_za, g_zevecs, z0, g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_zevecs_hconj, g_ztmp, z0, g_zaproj) + + elseif ( (dir.eq."R").or.(dir.eq."r")) then ! C A C^+ + call ga_zero (g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_za, g_zevecs_hconj, z0, g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_zevecs, g_ztmp, z0, g_zaproj) + + else + call errquit (pname//"invalid flag: "//dir, 0,0) + endif + + else ! non hermitian / non-unitary eigenvector matrix + + call mat_hermconj (g_zevecs, g_zevecs_hconj) ! = C^+ + call zmat_inv(g_zevecs_hconj, g_zevecs_hconj_inv) ! = (C^+)^-1 + call zmat_inv_check(g_zevecs_hconj, g_zevecs_hconj_inv) + + call zmat_inv(g_zevecs, g_zevecs_inv) ! = C^-1 + call zmat_inv_check(g_zevecs, g_zevecs_inv) ! = C^-1 + + if ( (dir.eq."F").or.(dir.eq."f")) then ! C^+ A C + call ga_zero (g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_za, g_zevecs, z0, g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_zevecs_hconj, g_ztmp, z0, g_zaproj) + + elseif ( (dir.eq."R").or.(dir.eq."r")) then ! (C^+)^-1 A C^-1 + call ga_zero (g_ztmp) + call ga_zgemm ("N", "N", n, n, n, + $ z1, g_za, g_zevecs_inv, z0, g_ztmp) + call ga_zgemm("N", "N", n, n, n, + $ z1, g_zevecs_hconj_inv, g_ztmp, z0, g_zaproj) + else ! + call errquit (pname//"invalid flag: "//dir, 0,0) + endif + + endif + if (.not. ma_chop_stack (lvals)) & call errquit(pname//'cannot chop stack',0, MA_ERR) @@ -95,6 +167,12 @@ C call zmat_diag (g_zb, g_zevecs, dcpl_mb(ivals), .true.) !true = reorder e if (.not. ga_destroy (g_zevecs_hconj)) $ call errquit (pname//"failed to destrory ztmp1", 0, GA_ERR) + if (.not. ga_destroy (g_zevecs_hconj_inv)) + $ call errquit (pname//"failed to destrory ztmp1", 0, GA_ERR) + + if (.not. ga_destroy (g_zevecs_inv)) + $ call errquit (pname//"failed to destrory inv", 0, GA_ERR) + if (.not. ga_destroy (g_ztmp)) $ call errquit (pname//"failed to destrory ztmp", 0, GA_ERR) @@ -105,7 +183,7 @@ C==================================================================== C C Check the projecting A->B and reversing yields A again. C - subroutine rt_tddft_project_check (params, g_za, g_zb) + subroutine rt_tddft_project_check (params, g_za, g_zb, lherm) implicit none #include "errquit.fh" @@ -122,6 +200,7 @@ C == Inputs == type (rt_params_t), intent(in) :: params integer, intent(in) :: g_za integer, intent(in) :: g_zb + logical, intent(in) :: lherm ! hermitian mats? C == Parameters == character(*),parameter :: pname = "rt_tddft_project_check: " @@ -139,8 +218,9 @@ C == Variables == call ga_zero (g_zaproj) - call rt_tddft_project (params, "F", g_za, g_zb, g_zaproj) - call rt_tddft_project (params, "R", g_zaproj, g_zb, g_zaback) + call rt_tddft_project (params, "F", g_za, g_zb, g_zaproj, lherm) + call rt_tddft_project (params, "R", + $ g_zaproj, g_zb, g_zaback, lherm) if (.not. mat_is_same (g_za, g_zaback, params%tol_zero)) $ call errquit (pname//"failed",0,0) @@ -305,4 +385,3 @@ C call ga_print (g_zaproj) $ call errquit (pname//"failed to destrory zaback", 0, GA_ERR) end subroutine -c $Id$ diff --git a/src/nwdft/rt_tddft/rtutils/rt_tddft_zdens_tot_movecs.F b/src/nwdft/rt_tddft/rtutils/rt_tddft_zdens_tot_movecs.F index fd0fba9896..1131f03bf5 100644 --- a/src/nwdft/rt_tddft/rtutils/rt_tddft_zdens_tot_movecs.F +++ b/src/nwdft/rt_tddft/rtutils/rt_tddft_zdens_tot_movecs.F @@ -184,10 +184,12 @@ C (make diag occup matrix) enddo C (project onto TD complex movecs) - call rt_tddft_project_check (params, g_ztmp3, g_zdens_mo) +C Note: only for Hermitian matrices (.true. flag) + call rt_tddft_project_check (params, g_ztmp3, g_zdens_mo, .true.) if (me.eq.0) write (luout,*) pname//"projection check passed" call ga_zero (g_ztmp1) - call rt_tddft_project (params, "R", g_ztmp3, g_zdens_mo, g_ztmp1) ! g_ztmp1 now has projected occup mask + call rt_tddft_project (params, "R", g_ztmp3, + $ g_zdens_mo, g_ztmp1, .true.) ! g_ztmp1 now has projected occup mask call ga_zero (g_ztmp4) call ga_elem_multiply (g_ztmp1, g_zevecs_ao, g_ztmp4) ! g_ztmp4 now holds masked movecs in AO basis