mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-16 22:48:32 +02:00
Compare commits
197 Commits
Author | SHA1 | Date | |
---|---|---|---|
![]() |
b41e556b9d | ||
![]() |
f32dc836a8 | ||
f011ca845e | |||
13995ab02b | |||
![]() |
b749313762 | ||
![]() |
cea311077c | ||
![]() |
b2a928f022 | ||
![]() |
1e2a8455d3 | ||
![]() |
338f9ca2f8 | ||
![]() |
5fee067556 | ||
![]() |
ee40465648 | ||
![]() |
1efe61efd0 | ||
![]() |
1277f78d72 | ||
![]() |
4a31254d6b | ||
![]() |
f17b36c3e4 | ||
![]() |
2845b1c8ea | ||
![]() |
9ddd8f5e7d | ||
![]() |
437846e4d2 | ||
![]() |
9fa523fe66 | ||
![]() |
e638a640f0 | ||
![]() |
92f321e594 | ||
![]() |
8c68369a3b | ||
![]() |
2371bdf9a3 | ||
![]() |
d0fe9aad4f | ||
![]() |
a0eb1d34db | ||
![]() |
380cbdcbb5 | ||
![]() |
84531d8021 | ||
![]() |
92294cf973 | ||
![]() |
70cfbbd631 | ||
![]() |
38337eb0dc | ||
![]() |
13f685722d | ||
![]() |
3ebad92f76 | ||
![]() |
c79240962c | ||
![]() |
8e615f6788 | ||
b3284c100e | |||
![]() |
072067c4fa | ||
![]() |
b547d97452 | ||
![]() |
922eeb24c0 | ||
![]() |
d504108a33 | ||
![]() |
25181963f8 | ||
![]() |
508fb9526d | ||
![]() |
a3195ae08a | ||
![]() |
82b6bccc37 | ||
![]() |
d44a22f3d8 | ||
![]() |
7be57b7a14 | ||
![]() |
120e421239 | ||
![]() |
01360efd84 | ||
![]() |
b0bf0c79d6 | ||
![]() |
f07bdee9cd | ||
![]() |
8411167e90 | ||
![]() |
c5726abb13 | ||
![]() |
7145a7d916 | ||
![]() |
8bfac5669a | ||
![]() |
bb8d52fc69 | ||
![]() |
046c71feca | ||
bc04139a54 | |||
df4c9431d0 | |||
717b35cf38 | |||
d19aee172c | |||
![]() |
d6fb0f63fe | ||
![]() |
5b214ac3c1 | ||
![]() |
10fc3a6fc4 | ||
![]() |
299243e2ce | ||
![]() |
17b9b423a9 | ||
![]() |
20d5bcd9d5 | ||
![]() |
47d27186dc | ||
![]() |
6b3593bf74 | ||
8594f26e45 | |||
cb0a9d2750 | |||
273200c829 | |||
![]() |
9ea4377f07 | ||
![]() |
102d930452 | ||
![]() |
f869d347b8 | ||
![]() |
5418ed0f1c | ||
![]() |
7e3e2b9db9 | ||
![]() |
f7a7ba2a3e | ||
![]() |
01d6d5acbc | ||
![]() |
338e793ed6 | ||
![]() |
3982ee4479 | ||
![]() |
dffd10375b | ||
![]() |
ed5a9fa404 | ||
![]() |
a2b662d795 | ||
![]() |
7d55f314a4 | ||
![]() |
6584bd46db | ||
![]() |
c2e1301f27 | ||
![]() |
953cf04616 | ||
![]() |
315ad54dc7 | ||
![]() |
7db223f6f3 | ||
![]() |
0ba82990ff | ||
![]() |
a59f1e9576 | ||
![]() |
29670d4729 | ||
![]() |
1fc25159a0 | ||
![]() |
0e31cfee7f | ||
![]() |
5ee3fc6e43 | ||
![]() |
156be3b1bb | ||
![]() |
6d12abf088 | ||
![]() |
702ba79af8 | ||
![]() |
bcf824cc18 | ||
![]() |
1c838a30d6 | ||
![]() |
5c66e4b99f | ||
![]() |
c0ee3714e6 | ||
![]() |
31e04c2ab6 | ||
![]() |
ce87a62086 | ||
![]() |
9843df68c4 | ||
![]() |
83d8ba91a8 | ||
![]() |
a81152ad7f | ||
![]() |
727ab502c5 | ||
![]() |
1c09b7dcbc | ||
![]() |
b3390f2fa3 | ||
![]() |
02c6539daa | ||
![]() |
3c0ef34836 | ||
![]() |
8794296f37 | ||
![]() |
c847d63f2c | ||
![]() |
07f09acd99 | ||
7e26342cfb | |||
![]() |
2cffbdcc9d | ||
![]() |
059efc649d | ||
![]() |
0b22e78da1 | ||
![]() |
d80fefe1ce | ||
![]() |
4374145954 | ||
![]() |
3ca3dc3061 | ||
![]() |
8472e71df4 | ||
![]() |
a28244e1d1 | ||
![]() |
4ded39470b | ||
![]() |
c4154c10ea | ||
![]() |
85f4ca3121 | ||
![]() |
f9ec0e9cff | ||
![]() |
df2295206f | ||
![]() |
a64be70911 | ||
![]() |
b1e14142c6 | ||
![]() |
f35c8f4f4c | ||
![]() |
91a86c3b2f | ||
![]() |
9ee697e567 | ||
![]() |
b3445bfa3f | ||
![]() |
0914a60d63 | ||
![]() |
7287312b73 | ||
![]() |
b39a7895f4 | ||
![]() |
9b91e53119 | ||
![]() |
f4de811310 | ||
![]() |
8b33c2b4b5 | ||
![]() |
a6a4e8ecac | ||
![]() |
3f0f71be22 | ||
![]() |
dd7b3131b8 | ||
![]() |
5e83a2a853 | ||
![]() |
0b0a7520af | ||
![]() |
af74694cab | ||
![]() |
559c17cfaa | ||
![]() |
d7bc608820 | ||
![]() |
5f37d50f23 | ||
![]() |
aac2c60971 | ||
![]() |
948b16d4c5 | ||
![]() |
240c58c84f | ||
![]() |
a632b6af56 | ||
![]() |
0722e12882 | ||
![]() |
cc840cdbc1 | ||
![]() |
b0d27f8503 | ||
![]() |
e64faf2845 | ||
![]() |
4e5cae41d2 | ||
![]() |
15f441819e | ||
![]() |
40abfb368a | ||
![]() |
c48654f550 | ||
![]() |
17ac52d2d5 | ||
![]() |
56cc1c6b40 | ||
![]() |
1f353e6ca0 | ||
![]() |
afdad3cdf9 | ||
![]() |
8bfcfe8f21 | ||
![]() |
a63ee551ef | ||
![]() |
e805c52cab | ||
![]() |
60ea669d06 | ||
![]() |
aa23ecc6a6 | ||
![]() |
1dc9c3ed0b | ||
![]() |
92c2a3961e | ||
![]() |
648e157db9 | ||
![]() |
25d041379b | ||
![]() |
73f24c3130 | ||
![]() |
79b75a11f7 | ||
![]() |
b950e40df4 | ||
![]() |
2a386ffa41 | ||
![]() |
b60262b062 | ||
![]() |
99d6826b89 | ||
![]() |
394b6ce404 | ||
![]() |
5eb1c17614 | ||
![]() |
a67497fba8 | ||
![]() |
7dfc072150 | ||
![]() |
c050f2859e | ||
![]() |
3b63d807fc | ||
![]() |
bcc23bf47f | ||
![]() |
4e93390632 | ||
![]() |
949ff3ce3a | ||
514b3172fc | |||
e53361ed97 | |||
![]() |
f65b7c0ead | ||
15ab29206c | |||
ff209ff451 | |||
eb3a8a679c | |||
46d61b4117 | |||
6d064b9bf0 |
11
REPLACE
11
REPLACE
@ -1,5 +1,4 @@
|
|||||||
# This file contains all the renamings that occured between qp1 and qp2.
|
# This file contains all the renamings that occured between qp1 and qp2.
|
||||||
#
|
|
||||||
qp_name aa_operator_bielec -r aa_operator_two_e
|
qp_name aa_operator_bielec -r aa_operator_two_e
|
||||||
qp_name ac_operator_bielec -r ac_operator_two_e
|
qp_name ac_operator_bielec -r ac_operator_two_e
|
||||||
qp_name ao_bi_elec_integral_alpha -r ao_two_e_integral_alpha
|
qp_name ao_bi_elec_integral_alpha -r ao_two_e_integral_alpha
|
||||||
@ -127,7 +126,6 @@ qp_name H_S2_u_0_bielec_nstates_openmp_work_3 -r H_S2_u_0_two_e_nstates_openmp_w
|
|||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work_4 -r H_S2_u_0_two_e_nstates_openmp_work_4
|
qp_name H_S2_u_0_bielec_nstates_openmp_work_4 -r H_S2_u_0_two_e_nstates_openmp_work_4
|
||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work_$N_int
|
qp_name H_S2_u_0_bielec_nstates_openmp_work_$N_int
|
||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work_$N_int -r "H_S2_u_0_two_e_nstates_openmp_work_$N_int"
|
qp_name H_S2_u_0_bielec_nstates_openmp_work_$N_int -r "H_S2_u_0_two_e_nstates_openmp_work_$N_int"
|
||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work_$N_int #-r "H_S2_u_0_two_e_nstates_openmp_work_$N_int"
|
|
||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work -r H_S2_u_0_two_e_nstates_openmp_work
|
qp_name H_S2_u_0_bielec_nstates_openmp_work -r H_S2_u_0_two_e_nstates_openmp_work
|
||||||
qp_name H_S2_u_0_bielec_nstates_openmp_work_ -r H_S2_u_0_two_e_nstates_openmp_work_
|
qp_name H_S2_u_0_bielec_nstates_openmp_work_ -r H_S2_u_0_two_e_nstates_openmp_work_
|
||||||
qp_name i_H_j_bielec -r i_H_j_two_e
|
qp_name i_H_j_bielec -r i_H_j_two_e
|
||||||
@ -223,6 +221,7 @@ qp_name potential_sr_xc_beta_ao_lda --rename=potential_xc_beta_ao_sr_lda
|
|||||||
qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe
|
qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe
|
||||||
qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe
|
qp_name potential_sr_xc_beta_ao_pbe --rename=potential_xc_beta_ao_sr_pbe
|
||||||
qp_name psi_energy_bielec -r psi_energy_two_e
|
qp_name psi_energy_bielec -r psi_energy_two_e
|
||||||
|
qp_name read_ao_integrals_e_n -r read_ao_integrals_n_e
|
||||||
qp_name read_ao_integrals --rename="read_ao_two_e_integrals"
|
qp_name read_ao_integrals --rename="read_ao_two_e_integrals"
|
||||||
qp_name read_ao_integrals --rename=read_ao_two_e_integrals
|
qp_name read_ao_integrals --rename=read_ao_two_e_integrals
|
||||||
qp_name read_mo_integrals_erf -r read_mo_two_e_integrals_erf
|
qp_name read_mo_integrals_erf -r read_mo_two_e_integrals_erf
|
||||||
@ -240,3 +239,11 @@ qp_name write_ao_integrals --rename=write_ao_two_e_integrals
|
|||||||
qp_name write_mo_integrals_erf -r write_mo_two_e_integrals_erf
|
qp_name write_mo_integrals_erf -r write_mo_two_e_integrals_erf
|
||||||
qp_name write_mo_integrals --rename="write_mo_two_e_integrals"
|
qp_name write_mo_integrals --rename="write_mo_two_e_integrals"
|
||||||
qp_name write_mo_integrals --rename=write_mo_two_e_integrals
|
qp_name write_mo_integrals --rename=write_mo_two_e_integrals
|
||||||
|
qp_name ao_ortho_canonical_coef_inv_complex -r ao_ortho_cano_coef_inv_cplx
|
||||||
|
qp_name fock_operator_closed_shell_ref_bitmask -r fock_op_cshell_ref_bitmask
|
||||||
|
qp_name fock_operator_closed_shell_ref_bitmask_complex -r fock_op_cshell_ref_bitmask_cplx
|
||||||
|
qp_name ao_ortho_canonical_coef_inv -r ao_ortho_cano_coef_inv
|
||||||
|
qp_name ao_ortho_cano_to_ao_complex -r ao_ortho_cano_to_ao_cplx
|
||||||
|
qp_name ao_ortho_lowdin_nucl_elec_integrals_complex -r ao_ortho_lowdin_n_e_ints_cplx
|
||||||
|
qp_name ao_ortho_canonical_nucl_elec_integrals_complex -r ao_ortho_cano_n_e_ints_cplx
|
||||||
|
qp_name ao_ortho_canonical_nucl_elec_integrals -r ao_ortho_cano_n_e_ints
|
||||||
|
@ -32,7 +32,7 @@ OPENMP : 1 ; Append OpenMP flags
|
|||||||
#
|
#
|
||||||
[OPT]
|
[OPT]
|
||||||
FC : -traceback
|
FC : -traceback
|
||||||
FCFLAGS : -xAVX -O2 -ip -ftz -g
|
FCFLAGS : -mavx -O2 -ip -ftz -g
|
||||||
|
|
||||||
# Profiling flags
|
# Profiling flags
|
||||||
#################
|
#################
|
||||||
|
2
configure
vendored
2
configure
vendored
@ -355,7 +355,6 @@ EOF
|
|||||||
EOF
|
EOF
|
||||||
fi
|
fi
|
||||||
|
|
||||||
|
|
||||||
elif [[ ${PACKAGE} = bse ]] ; then
|
elif [[ ${PACKAGE} = bse ]] ; then
|
||||||
|
|
||||||
download ${BSE_URL} "${QP_ROOT}"/external/bse.tar.gz
|
download ${BSE_URL} "${QP_ROOT}"/external/bse.tar.gz
|
||||||
@ -363,7 +362,6 @@ EOF
|
|||||||
cd "\${QP_ROOT}"/external
|
cd "\${QP_ROOT}"/external
|
||||||
tar --gunzip --extract --file bse.tar.gz
|
tar --gunzip --extract --file bse.tar.gz
|
||||||
pip install -e basis_set_exchange-*
|
pip install -e basis_set_exchange-*
|
||||||
EOF
|
|
||||||
elif [[ ${PACKAGE} = zlib ]] ; then
|
elif [[ ${PACKAGE} = zlib ]] ; then
|
||||||
|
|
||||||
download ${ZLIB_URL} "${QP_ROOT}"/external/zlib.tar.gz
|
download ${ZLIB_URL} "${QP_ROOT}"/external/zlib.tar.gz
|
||||||
|
@ -37,7 +37,9 @@ end = struct
|
|||||||
} [@@deriving sexp]
|
} [@@deriving sexp]
|
||||||
;;
|
;;
|
||||||
|
|
||||||
let get_default = Qpackage.get_ezfio_default "determinants";;
|
let get_default = Qpackage.get_ezfio_default "determinants"
|
||||||
|
|
||||||
|
let is_complex = lazy (Ezfio.get_nuclei_is_complex () )
|
||||||
|
|
||||||
let read_n_int () =
|
let read_n_int () =
|
||||||
if not (Ezfio.has_determinants_n_int()) then
|
if not (Ezfio.has_determinants_n_int()) then
|
||||||
@ -48,12 +50,12 @@ end = struct
|
|||||||
;
|
;
|
||||||
Ezfio.get_determinants_n_int ()
|
Ezfio.get_determinants_n_int ()
|
||||||
|> N_int_number.of_int
|
|> N_int_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
let write_n_int n =
|
let write_n_int n =
|
||||||
N_int_number.to_int n
|
N_int_number.to_int n
|
||||||
|> Ezfio.set_determinants_n_int
|
|> Ezfio.set_determinants_n_int
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let read_bit_kind () =
|
let read_bit_kind () =
|
||||||
@ -64,12 +66,12 @@ end = struct
|
|||||||
;
|
;
|
||||||
Ezfio.get_determinants_bit_kind ()
|
Ezfio.get_determinants_bit_kind ()
|
||||||
|> Bit_kind.of_int
|
|> Bit_kind.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
let write_bit_kind b =
|
let write_bit_kind b =
|
||||||
Bit_kind.to_int b
|
Bit_kind.to_int b
|
||||||
|> Ezfio.set_determinants_bit_kind
|
|> Ezfio.set_determinants_bit_kind
|
||||||
;;
|
|
||||||
|
|
||||||
let read_n_det () =
|
let read_n_det () =
|
||||||
if not (Ezfio.has_determinants_n_det ()) then
|
if not (Ezfio.has_determinants_n_det ()) then
|
||||||
@ -77,7 +79,7 @@ end = struct
|
|||||||
;
|
;
|
||||||
Ezfio.get_determinants_n_det ()
|
Ezfio.get_determinants_n_det ()
|
||||||
|> Det_number.of_int
|
|> Det_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
let read_n_det_qp_edit () =
|
let read_n_det_qp_edit () =
|
||||||
if not (Ezfio.has_determinants_n_det_qp_edit ()) then
|
if not (Ezfio.has_determinants_n_det_qp_edit ()) then
|
||||||
@ -87,18 +89,18 @@ end = struct
|
|||||||
end;
|
end;
|
||||||
Ezfio.get_determinants_n_det_qp_edit ()
|
Ezfio.get_determinants_n_det_qp_edit ()
|
||||||
|> Det_number.of_int
|
|> Det_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
let write_n_det n =
|
let write_n_det n =
|
||||||
Det_number.to_int n
|
Det_number.to_int n
|
||||||
|> Ezfio.set_determinants_n_det
|
|> Ezfio.set_determinants_n_det
|
||||||
;;
|
|
||||||
|
|
||||||
let write_n_det_qp_edit n =
|
let write_n_det_qp_edit n =
|
||||||
let n_det = read_n_det () |> Det_number.to_int in
|
let n_det = read_n_det () |> Det_number.to_int in
|
||||||
min n_det (Det_number.to_int n)
|
min n_det (Det_number.to_int n)
|
||||||
|> Ezfio.set_determinants_n_det_qp_edit
|
|> Ezfio.set_determinants_n_det_qp_edit
|
||||||
;;
|
|
||||||
|
|
||||||
let read_n_states () =
|
let read_n_states () =
|
||||||
if not (Ezfio.has_determinants_n_states ()) then
|
if not (Ezfio.has_determinants_n_states ()) then
|
||||||
@ -106,7 +108,7 @@ end = struct
|
|||||||
;
|
;
|
||||||
Ezfio.get_determinants_n_states ()
|
Ezfio.get_determinants_n_states ()
|
||||||
|> States_number.of_int
|
|> States_number.of_int
|
||||||
;;
|
|
||||||
|
|
||||||
let write_n_states n =
|
let write_n_states n =
|
||||||
let n_states =
|
let n_states =
|
||||||
@ -130,7 +132,7 @@ end = struct
|
|||||||
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
|
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
|
||||||
|> Ezfio.set_determinants_state_average_weight
|
|> Ezfio.set_determinants_state_average_weight
|
||||||
end
|
end
|
||||||
;;
|
|
||||||
|
|
||||||
let write_state_average_weight data =
|
let write_state_average_weight data =
|
||||||
let n_states =
|
let n_states =
|
||||||
@ -143,7 +145,7 @@ end = struct
|
|||||||
in
|
in
|
||||||
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
|
Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| n_states |] ~data
|
||||||
|> Ezfio.set_determinants_state_average_weight
|
|> Ezfio.set_determinants_state_average_weight
|
||||||
;;
|
|
||||||
|
|
||||||
let read_state_average_weight () =
|
let read_state_average_weight () =
|
||||||
let n_states =
|
let n_states =
|
||||||
@ -171,7 +173,7 @@ end = struct
|
|||||||
|> Array.map Positive_float.of_float
|
|> Array.map Positive_float.of_float
|
||||||
in
|
in
|
||||||
(write_state_average_weight data; data)
|
(write_state_average_weight data; data)
|
||||||
;;
|
|
||||||
|
|
||||||
let read_expected_s2 () =
|
let read_expected_s2 () =
|
||||||
if not (Ezfio.has_determinants_expected_s2 ()) then
|
if not (Ezfio.has_determinants_expected_s2 ()) then
|
||||||
@ -186,12 +188,12 @@ end = struct
|
|||||||
;
|
;
|
||||||
Ezfio.get_determinants_expected_s2 ()
|
Ezfio.get_determinants_expected_s2 ()
|
||||||
|> Positive_float.of_float
|
|> Positive_float.of_float
|
||||||
;;
|
|
||||||
|
|
||||||
let write_expected_s2 s2 =
|
let write_expected_s2 s2 =
|
||||||
Positive_float.to_float s2
|
Positive_float.to_float s2
|
||||||
|> Ezfio.set_determinants_expected_s2
|
|> Ezfio.set_determinants_expected_s2
|
||||||
;;
|
|
||||||
|
|
||||||
let read_psi_coef ~read_only () =
|
let read_psi_coef ~read_only () =
|
||||||
if not (Ezfio.has_determinants_psi_coef ()) then
|
if not (Ezfio.has_determinants_psi_coef ()) then
|
||||||
@ -200,19 +202,36 @@ end = struct
|
|||||||
read_n_states ()
|
read_n_states ()
|
||||||
|> States_number.to_int
|
|> States_number.to_int
|
||||||
in
|
in
|
||||||
|
(
|
||||||
|
if Lazy.force is_complex then
|
||||||
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |]
|
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| 1 ; n_states |]
|
||||||
~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. ))
|
~data:(List.init (2*n_states) (fun i -> if (i=0) then 1. else 0. ))
|
||||||
|> Ezfio.set_determinants_psi_coef
|
|> Ezfio.set_determinants_psi_coef
|
||||||
|
else
|
||||||
|
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; 1 ; n_states |]
|
||||||
|
~data:(List.init n_states (fun i -> if (i=0) then 1. else 0. ))
|
||||||
|
|> Ezfio.set_determinants_psi_coef_complex
|
||||||
|
)
|
||||||
end;
|
end;
|
||||||
begin
|
begin
|
||||||
if read_only then
|
if read_only then
|
||||||
|
begin
|
||||||
|
if Lazy.force is_complex then
|
||||||
|
Ezfio.get_determinants_psi_coef_complex_qp_edit ()
|
||||||
|
else
|
||||||
Ezfio.get_determinants_psi_coef_qp_edit ()
|
Ezfio.get_determinants_psi_coef_qp_edit ()
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if Lazy.force is_complex then
|
||||||
|
Ezfio.get_determinants_psi_coef_complex ()
|
||||||
else
|
else
|
||||||
Ezfio.get_determinants_psi_coef ()
|
Ezfio.get_determinants_psi_coef ()
|
||||||
end
|
end
|
||||||
|
end
|
||||||
|> Ezfio.flattened_ezfio
|
|> Ezfio.flattened_ezfio
|
||||||
|> Array.map Det_coef.of_float
|
|> Array.map Det_coef.of_float
|
||||||
;;
|
|
||||||
|
|
||||||
let write_psi_coef ~n_det ~n_states c =
|
let write_psi_coef ~n_det ~n_states c =
|
||||||
let n_det = Det_number.to_int n_det
|
let n_det = Det_number.to_int n_det
|
||||||
@ -222,12 +241,23 @@ end = struct
|
|||||||
and n_states =
|
and n_states =
|
||||||
States_number.to_int n_states
|
States_number.to_int n_states
|
||||||
in
|
in
|
||||||
|
if Lazy.force is_complex then
|
||||||
|
begin
|
||||||
|
let r =
|
||||||
|
Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; n_det ; n_states |] ~data:c
|
||||||
|
in
|
||||||
|
Ezfio.set_determinants_psi_coef_complex r;
|
||||||
|
Ezfio.set_determinants_psi_coef_complex_qp_edit r
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
let r =
|
let r =
|
||||||
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
|
Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c
|
||||||
in
|
in
|
||||||
Ezfio.set_determinants_psi_coef r;
|
Ezfio.set_determinants_psi_coef r;
|
||||||
Ezfio.set_determinants_psi_coef_qp_edit r
|
Ezfio.set_determinants_psi_coef_qp_edit r
|
||||||
;;
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
let read_psi_det ~read_only () =
|
let read_psi_det ~read_only () =
|
||||||
@ -276,7 +306,7 @@ end = struct
|
|||||||
|> Array.map (Determinant.of_int64_array
|
|> Array.map (Determinant.of_int64_array
|
||||||
~n_int:(N_int_number.of_int n_int)
|
~n_int:(N_int_number.of_int n_int)
|
||||||
~alpha:n_alpha ~beta:n_beta )
|
~alpha:n_alpha ~beta:n_beta )
|
||||||
;;
|
|
||||||
|
|
||||||
let write_psi_det ~n_int ~n_det d =
|
let write_psi_det ~n_int ~n_det d =
|
||||||
let data = Array.to_list d
|
let data = Array.to_list d
|
||||||
@ -288,7 +318,7 @@ end = struct
|
|||||||
in
|
in
|
||||||
Ezfio.set_determinants_psi_det r;
|
Ezfio.set_determinants_psi_det r;
|
||||||
Ezfio.set_determinants_psi_det_qp_edit r
|
Ezfio.set_determinants_psi_det_qp_edit r
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let read ?(full=true) () =
|
let read ?(full=true) () =
|
||||||
@ -316,7 +346,7 @@ end = struct
|
|||||||
else
|
else
|
||||||
(* No molecular orbitals, so no determinants *)
|
(* No molecular orbitals, so no determinants *)
|
||||||
None
|
None
|
||||||
;;
|
|
||||||
|
|
||||||
let write ?(force=false)
|
let write ?(force=false)
|
||||||
{ n_int ;
|
{ n_int ;
|
||||||
@ -341,7 +371,7 @@ end = struct
|
|||||||
write_psi_det ~n_int:n_int ~n_det:n_det psi_det
|
write_psi_det ~n_int:n_int ~n_det:n_det psi_det
|
||||||
end;
|
end;
|
||||||
write_state_average_weight state_average_weight
|
write_state_average_weight state_average_weight
|
||||||
;;
|
|
||||||
|
|
||||||
|
|
||||||
let to_rst b =
|
let to_rst b =
|
||||||
@ -557,10 +587,8 @@ psi_det = %s
|
|||||||
in
|
in
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Generic_input_of_rst.evaluate_sexp t_of_sexp s
|
Generic_input_of_rst.evaluate_sexp t_of_sexp s
|
||||||
;;
|
|
||||||
|
|
||||||
let update_ndet n_det_new =
|
let update_ndet n_det_new =
|
||||||
Printf.printf "Reducing n_det to %d\n" (Det_number.to_int n_det_new);
|
Printf.printf "Reducing n_det to %d\n" (Det_number.to_int n_det_new);
|
||||||
@ -596,7 +624,7 @@ psi_det = %s
|
|||||||
{ det with n_det = (Det_number.of_int n_det_new) }
|
{ det with n_det = (Det_number.of_int n_det_new) }
|
||||||
in
|
in
|
||||||
write ~force:true new_det
|
write ~force:true new_det
|
||||||
;;
|
|
||||||
|
|
||||||
let extract_state istate =
|
let extract_state istate =
|
||||||
Printf.printf "Extracting state %d\n" (States_number.to_int istate);
|
Printf.printf "Extracting state %d\n" (States_number.to_int istate);
|
||||||
@ -628,7 +656,7 @@ psi_det = %s
|
|||||||
{ det with n_states = (States_number.of_int 1) }
|
{ det with n_states = (States_number.of_int 1) }
|
||||||
in
|
in
|
||||||
write ~force:true new_det
|
write ~force:true new_det
|
||||||
;;
|
|
||||||
|
|
||||||
let extract_states range =
|
let extract_states range =
|
||||||
Printf.printf "Extracting states %s\n" (Range.to_string range);
|
Printf.printf "Extracting states %s\n" (Range.to_string range);
|
||||||
@ -673,7 +701,7 @@ psi_det = %s
|
|||||||
{ det with n_states = (States_number.of_int @@ List.length sorted_list) }
|
{ det with n_states = (States_number.of_int @@ List.length sorted_list) }
|
||||||
in
|
in
|
||||||
write ~force:true new_det
|
write ~force:true new_det
|
||||||
;;
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -2,7 +2,6 @@ open Qptypes
|
|||||||
open Qputils
|
open Qputils
|
||||||
open Sexplib.Std
|
open Sexplib.Std
|
||||||
|
|
||||||
|
|
||||||
module Mo_basis : sig
|
module Mo_basis : sig
|
||||||
type t =
|
type t =
|
||||||
{ mo_num : MO_number.t ;
|
{ mo_num : MO_number.t ;
|
||||||
@ -26,8 +25,11 @@ end = struct
|
|||||||
mo_coef : (MO_coef.t array) array;
|
mo_coef : (MO_coef.t array) array;
|
||||||
ao_md5 : MD5.t;
|
ao_md5 : MD5.t;
|
||||||
} [@@deriving sexp]
|
} [@@deriving sexp]
|
||||||
|
|
||||||
let get_default = Qpackage.get_ezfio_default "mo_basis"
|
let get_default = Qpackage.get_ezfio_default "mo_basis"
|
||||||
|
|
||||||
|
let is_complex = lazy (Ezfio.get_nuclei_is_complex () )
|
||||||
|
|
||||||
let read_mo_label () =
|
let read_mo_label () =
|
||||||
if not (Ezfio.has_mo_basis_mo_label ()) then
|
if not (Ezfio.has_mo_basis_mo_label ()) then
|
||||||
Ezfio.set_mo_basis_mo_label "None"
|
Ezfio.set_mo_basis_mo_label "None"
|
||||||
@ -37,8 +39,8 @@ end = struct
|
|||||||
|
|
||||||
|
|
||||||
let reorder b ordering =
|
let reorder b ordering =
|
||||||
{ b with mo_coef =
|
{ b with
|
||||||
Array.map (fun mo ->
|
mo_coef = Array.map (fun mo ->
|
||||||
Array.init (Array.length mo)
|
Array.init (Array.length mo)
|
||||||
(fun i -> mo.(ordering.(i)))
|
(fun i -> mo.(ordering.(i)))
|
||||||
) b.mo_coef
|
) b.mo_coef
|
||||||
@ -60,7 +62,10 @@ end = struct
|
|||||||
|> MD5.of_string
|
|> MD5.of_string
|
||||||
in
|
in
|
||||||
if (ao_md5 <> result) then
|
if (ao_md5 <> result) then
|
||||||
failwith "The current MOs don't correspond to the current AOs.";
|
begin
|
||||||
|
Printf.eprintf ":%s:\n:%s:\n%!" (MD5.to_string ao_md5) (MD5.to_string result);
|
||||||
|
failwith "The current MOs don't correspond to the current AOs."
|
||||||
|
end;
|
||||||
result
|
result
|
||||||
|
|
||||||
|
|
||||||
@ -111,7 +116,13 @@ end = struct
|
|||||||
|
|
||||||
|
|
||||||
let read_mo_coef () =
|
let read_mo_coef () =
|
||||||
let a = Ezfio.get_mo_basis_mo_coef ()
|
let a =
|
||||||
|
(
|
||||||
|
if Lazy.force is_complex then
|
||||||
|
Ezfio.get_mo_basis_mo_coef_complex ()
|
||||||
|
else
|
||||||
|
Ezfio.get_mo_basis_mo_coef ()
|
||||||
|
)
|
||||||
|> Ezfio.flattened_ezfio
|
|> Ezfio.flattened_ezfio
|
||||||
|> Array.map MO_coef.of_float
|
|> Array.map MO_coef.of_float
|
||||||
in
|
in
|
||||||
@ -244,12 +255,12 @@ mo_coef = %s
|
|||||||
let write_mo_num n =
|
let write_mo_num n =
|
||||||
MO_number.to_int n
|
MO_number.to_int n
|
||||||
|> Ezfio.set_mo_basis_mo_num
|
|> Ezfio.set_mo_basis_mo_num
|
||||||
;;
|
|
||||||
|
|
||||||
let write_mo_label a =
|
let write_mo_label a =
|
||||||
MO_label.to_string a
|
MO_label.to_string a
|
||||||
|> Ezfio.set_mo_basis_mo_label
|
|> Ezfio.set_mo_basis_mo_label
|
||||||
;;
|
|
||||||
|
|
||||||
let write_mo_class a =
|
let write_mo_class a =
|
||||||
let mo_num = Array.length a in
|
let mo_num = Array.length a in
|
||||||
@ -257,7 +268,7 @@ mo_coef = %s
|
|||||||
|> Array.to_list
|
|> Array.to_list
|
||||||
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|
||||||
|> Ezfio.set_mo_basis_mo_class
|
|> Ezfio.set_mo_basis_mo_class
|
||||||
;;
|
|
||||||
|
|
||||||
let write_mo_occ a =
|
let write_mo_occ a =
|
||||||
let mo_num = Array.length a in
|
let mo_num = Array.length a in
|
||||||
@ -265,24 +276,32 @@ mo_coef = %s
|
|||||||
|> Array.to_list
|
|> Array.to_list
|
||||||
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|
in Ezfio.ezfio_array_of_list ~rank:1 ~dim:[| mo_num |] ~data
|
||||||
|> Ezfio.set_mo_basis_mo_occ
|
|> Ezfio.set_mo_basis_mo_occ
|
||||||
;;
|
|
||||||
|
|
||||||
let write_md5 a =
|
let write_md5 a =
|
||||||
MD5.to_string a
|
MD5.to_string a
|
||||||
|> Ezfio.set_mo_basis_ao_md5
|
|> Ezfio.set_mo_basis_ao_md5
|
||||||
;;
|
|
||||||
|
|
||||||
let write_mo_coef a =
|
let write_mo_coef a =
|
||||||
let mo_num = Array.length a in
|
let mo_num = Array.length a in
|
||||||
let ao_num = Array.length a.(0) in
|
let ao_num =
|
||||||
|
let x = Array.length a.(0) in
|
||||||
|
if Lazy.force is_complex then x/2 else x
|
||||||
|
in
|
||||||
let data =
|
let data =
|
||||||
Array.map (fun mo -> Array.map MO_coef.to_float mo
|
Array.map (fun mo -> Array.map MO_coef.to_float mo
|
||||||
|> Array.to_list) a
|
|> Array.to_list) a
|
||||||
|> Array.to_list
|
|> Array.to_list
|
||||||
|> List.concat
|
|> List.concat
|
||||||
in Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; mo_num |] ~data
|
in
|
||||||
|> Ezfio.set_mo_basis_mo_coef
|
if Lazy.force is_complex then
|
||||||
;;
|
(Ezfio.ezfio_array_of_list ~rank:3 ~dim:[| 2 ; ao_num ; mo_num |] ~data
|
||||||
|
|> Ezfio.set_mo_basis_mo_coef_complex )
|
||||||
|
else
|
||||||
|
(Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| ao_num ; mo_num |] ~data
|
||||||
|
|> Ezfio.set_mo_basis_mo_coef )
|
||||||
|
|
||||||
|
|
||||||
let write
|
let write
|
||||||
{ mo_num : MO_number.t ;
|
{ mo_num : MO_number.t ;
|
||||||
@ -298,7 +317,7 @@ mo_coef = %s
|
|||||||
write_mo_occ mo_occ;
|
write_mo_occ mo_occ;
|
||||||
write_mo_coef mo_coef;
|
write_mo_coef mo_coef;
|
||||||
write_md5 ao_md5
|
write_md5 ao_md5
|
||||||
;;
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -885,7 +885,9 @@ let run ~port =
|
|||||||
|
|
||||||
Zmq.Socket.send pair_socket @@ string_of_pub_state Stopped;
|
Zmq.Socket.send pair_socket @@ string_of_pub_state Stopped;
|
||||||
Thread.join pub_thread;
|
Thread.join pub_thread;
|
||||||
Zmq.Socket.close rep_socket
|
Zmq.Socket.close pair_socket;
|
||||||
|
Zmq.Socket.close rep_socket;
|
||||||
|
Zmq.Context.terminate zmq_context
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -166,6 +166,7 @@ let input_ezfio = "
|
|||||||
|
|
||||||
|
|
||||||
let untouched = "
|
let untouched = "
|
||||||
|
|
||||||
module MO_guess : sig
|
module MO_guess : sig
|
||||||
type t [@@deriving sexp]
|
type t [@@deriving sexp]
|
||||||
val to_string : t -> string
|
val to_string : t -> string
|
||||||
|
@ -55,3 +55,9 @@ doc: If |true|, use |AOs| in Cartesian coordinates (6d,10f,...)
|
|||||||
interface: ezfio, provider
|
interface: ezfio, provider
|
||||||
default: false
|
default: false
|
||||||
|
|
||||||
|
[ao_num_per_kpt]
|
||||||
|
type: integer
|
||||||
|
doc: Number of |AOs| per kpt
|
||||||
|
default: =(ao_basis.ao_num/nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
7
src/ao_basis/aos_cplx.irp.f
Normal file
7
src/ao_basis/aos_cplx.irp.f
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
BEGIN_PROVIDER [ integer, ao_num_per_kpt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! number of aos per kpt.
|
||||||
|
END_DOC
|
||||||
|
ao_num_per_kpt = ao_num/kpt_num
|
||||||
|
END_PROVIDER
|
@ -1,10 +1,22 @@
|
|||||||
[ao_integrals_e_n]
|
[ao_integrals_n_e]
|
||||||
type: double precision
|
type: double precision
|
||||||
doc: Nucleus-electron integrals in |AO| basis set
|
doc: Nucleus-electron integrals in |AO| basis set
|
||||||
size: (ao_basis.ao_num,ao_basis.ao_num)
|
size: (ao_basis.ao_num,ao_basis.ao_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
[io_ao_integrals_e_n]
|
[ao_integrals_n_e_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex nucleus-electron integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num,ao_basis.ao_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_n_e_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex nucleus-electron integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[io_ao_integrals_n_e]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |AO| nucleus-electron attraction integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |AO| nucleus-electron attraction integrals from/to disk [ Write | Read | None ]
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
@ -17,6 +29,18 @@ doc: Kinetic energy integrals in |AO| basis set
|
|||||||
size: (ao_basis.ao_num,ao_basis.ao_num)
|
size: (ao_basis.ao_num,ao_basis.ao_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_kinetic_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex kinetic energy integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num,ao_basis.ao_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_kinetic_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex kinetic energy integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_ao_integrals_kinetic]
|
[io_ao_integrals_kinetic]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |AO| kinetic integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |AO| kinetic integrals from/to disk [ Write | Read | None ]
|
||||||
@ -30,6 +54,18 @@ doc: Pseudopotential integrals in |AO| basis set
|
|||||||
size: (ao_basis.ao_num,ao_basis.ao_num)
|
size: (ao_basis.ao_num,ao_basis.ao_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_pseudo_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex pseudopotential integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num,ao_basis.ao_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_pseudo_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex pseudopotential integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_ao_integrals_pseudo]
|
[io_ao_integrals_pseudo]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |AO| pseudopotential integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |AO| pseudopotential integrals from/to disk [ Write | Read | None ]
|
||||||
@ -43,6 +79,18 @@ doc: Overlap integrals in |AO| basis set
|
|||||||
size: (ao_basis.ao_num,ao_basis.ao_num)
|
size: (ao_basis.ao_num,ao_basis.ao_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_overlap_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex overlap integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num,ao_basis.ao_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_integrals_overlap_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex overlap integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_ao_integrals_overlap]
|
[io_ao_integrals_overlap]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |AO| overlap integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |AO| overlap integrals from/to disk [ Write | Read | None ]
|
||||||
@ -56,6 +104,18 @@ doc: Combined integrals in |AO| basis set
|
|||||||
size: (ao_basis.ao_num,ao_basis.ao_num)
|
size: (ao_basis.ao_num,ao_basis.ao_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_one_e_integrals_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex combined integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num,ao_basis.ao_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[ao_one_e_integrals_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex combined integrals in |AO| basis set
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_ao_one_e_integrals]
|
[io_ao_one_e_integrals]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |AO| one-electron integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |AO| one-electron integrals from/to disk [ Write | Read | None ]
|
||||||
|
@ -5,7 +5,10 @@
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! One-electron Hamiltonian in the |AO| basis.
|
! One-electron Hamiltonian in the |AO| basis.
|
||||||
END_DOC
|
END_DOC
|
||||||
|
if (is_complex) then
|
||||||
|
print*,"you shouldn't be here for complex",irp_here
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
IF (read_ao_one_e_integrals) THEN
|
IF (read_ao_one_e_integrals) THEN
|
||||||
call ezfio_get_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals)
|
call ezfio_get_ao_one_e_ints_ao_one_e_integrals(ao_one_e_integrals)
|
||||||
ELSE
|
ELSE
|
||||||
@ -27,3 +30,85 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ double precision, ao_one_e_integrals_imag,(ao_num,ao_num)]
|
||||||
|
! implicit none
|
||||||
|
! integer :: i,j,n,l
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! One-electron Hamiltonian in the |AO| basis.
|
||||||
|
! END_DOC
|
||||||
|
!
|
||||||
|
! IF (read_ao_one_e_integrals) THEN
|
||||||
|
! call ezfio_get_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag)
|
||||||
|
! ELSE
|
||||||
|
! ao_one_e_integrals_imag = ao_integrals_n_e_imag + ao_kinetic_integrals_imag
|
||||||
|
!
|
||||||
|
! IF (DO_PSEUDO) THEN
|
||||||
|
! ao_one_e_integrals_imag += ao_pseudo_integrals_imag
|
||||||
|
! ENDIF
|
||||||
|
! ENDIF
|
||||||
|
!
|
||||||
|
! IF (write_ao_one_e_integrals) THEN
|
||||||
|
! call ezfio_set_ao_one_e_ints_ao_one_e_integrals_imag(ao_one_e_integrals_imag)
|
||||||
|
! print *, 'AO one-e integrals written to disk'
|
||||||
|
! ENDIF
|
||||||
|
!
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_complex,(ao_num,ao_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_one_e_integrals_diag_complex,(ao_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,n,l
|
||||||
|
BEGIN_DOC
|
||||||
|
! One-electron Hamiltonian in the |AO| basis.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
IF (read_ao_one_e_integrals) THEN
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_one_e_integrals_complex(ao_one_e_integrals_complex)
|
||||||
|
ELSE
|
||||||
|
ao_one_e_integrals_complex = ao_integrals_n_e_complex + ao_kinetic_integrals_complex
|
||||||
|
|
||||||
|
IF (DO_PSEUDO) THEN
|
||||||
|
ao_one_e_integrals_complex += ao_pseudo_integrals_complex
|
||||||
|
ENDIF
|
||||||
|
ENDIF
|
||||||
|
|
||||||
|
DO j = 1, ao_num
|
||||||
|
ao_one_e_integrals_diag_complex(j) = dble(ao_one_e_integrals_complex(j,j))
|
||||||
|
ENDDO
|
||||||
|
|
||||||
|
IF (write_ao_one_e_integrals) THEN
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_one_e_integrals_complex(ao_one_e_integrals_complex)
|
||||||
|
print *, 'AO one-e integrals written to disk'
|
||||||
|
ENDIF
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_one_e_integrals_kpts,(ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ao_one_e_integrals_diag_kpts,(ao_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: j,k
|
||||||
|
BEGIN_DOC
|
||||||
|
! One-electron Hamiltonian in the |AO| basis.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (read_ao_one_e_integrals) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_one_e_integrals_kpts(ao_one_e_integrals_kpts)
|
||||||
|
else
|
||||||
|
ao_one_e_integrals_kpts = ao_integrals_n_e_kpts + ao_kinetic_integrals_kpts
|
||||||
|
|
||||||
|
if (do_pseudo) then
|
||||||
|
ao_one_e_integrals_kpts += ao_pseudo_integrals_kpts
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
do k = 1, kpt_num
|
||||||
|
do j = 1, ao_num_per_kpt
|
||||||
|
ao_one_e_integrals_diag_kpts(j,k) = dble(ao_one_e_integrals_kpts(j,j,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (write_ao_one_e_integrals) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_one_e_integrals_kpts(ao_one_e_integrals_kpts)
|
||||||
|
print *, 'AO one-e integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -84,13 +84,13 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef_inv, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_ortho_cano_coef_inv, (ao_num,ao_num)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! ao_ortho_canonical_coef^(-1)
|
! ao_ortho_canonical_coef^(-1)
|
||||||
END_DOC
|
END_DOC
|
||||||
call get_inverse(ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),&
|
call get_inverse(ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),&
|
||||||
ao_num, ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1))
|
ao_num, ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1))
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_ortho_canonical_coef, (ao_num,ao_num)]
|
121
src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f
Normal file
121
src/ao_one_e_ints/ao_ortho_cano_cplx.irp.f
Normal file
@ -0,0 +1,121 @@
|
|||||||
|
!todo: add kpts
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_complex, (ao_num,ao_cart_to_sphe_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! complex version of ao_cart_to_sphe_coef
|
||||||
|
END_DOC
|
||||||
|
call zlacp2('A',ao_num,ao_cart_to_sphe_num, &
|
||||||
|
ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
|
||||||
|
ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_complex, (ao_cart_to_sphe_num,ao_cart_to_sphe_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! AO overlap matrix in the spherical basis set
|
||||||
|
END_DOC
|
||||||
|
complex*16, allocatable :: S(:,:)
|
||||||
|
allocate (S(ao_cart_to_sphe_num,ao_num))
|
||||||
|
|
||||||
|
call zgemm('T','N',ao_cart_to_sphe_num,ao_num,ao_num, (1.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1), &
|
||||||
|
ao_overlap_complex,size(ao_overlap_complex,1), (0.d0,0.d0), &
|
||||||
|
S, size(S,1))
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_cart_to_sphe_num,ao_cart_to_sphe_num,ao_num, (1.d0,0.d0), &
|
||||||
|
S, size(S,1), &
|
||||||
|
ao_cart_to_sphe_coef_complex,size(ao_cart_to_sphe_coef_complex,1), (0.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_overlap_complex,size(ao_cart_to_sphe_overlap_complex,1))
|
||||||
|
|
||||||
|
deallocate(S)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_cplx, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! ao_ortho_canonical_coef_complex^(-1)
|
||||||
|
END_DOC
|
||||||
|
call get_inverse_complex(ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1),&
|
||||||
|
ao_num, ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_complex, (ao_num,ao_num)]
|
||||||
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_complex ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO: ao_ortho_canonical_num_complex should be the same as the real version
|
||||||
|
! maybe if the providers weren't linked we could avoid making a complex one?
|
||||||
|
! matrix of the coefficients of the mos generated by the
|
||||||
|
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
||||||
|
! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
ao_ortho_canonical_coef_complex = (0.d0,0.d0)
|
||||||
|
do i=1,ao_num
|
||||||
|
ao_ortho_canonical_coef_complex(i,i) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
|
||||||
|
!ao_ortho_canonical_num=ao_num
|
||||||
|
!return
|
||||||
|
|
||||||
|
if (ao_cartesian) then
|
||||||
|
|
||||||
|
ao_ortho_canonical_num_complex = ao_num
|
||||||
|
call ortho_canonical_complex(ao_overlap,size(ao_overlap,1), &
|
||||||
|
ao_num,ao_ortho_canonical_coef_complex,size(ao_ortho_canonical_coef_complex,1), &
|
||||||
|
ao_ortho_canonical_num_complex)
|
||||||
|
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
complex*16, allocatable :: S(:,:)
|
||||||
|
|
||||||
|
allocate(S(ao_cart_to_sphe_num,ao_cart_to_sphe_num))
|
||||||
|
S = (0.d0,0.d0)
|
||||||
|
do i=1,ao_cart_to_sphe_num
|
||||||
|
S(i,i) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ao_ortho_canonical_num_complex = ao_cart_to_sphe_num
|
||||||
|
call ortho_canonical_complex(ao_cart_to_sphe_overlap_complex, size(ao_cart_to_sphe_overlap_complex,1), &
|
||||||
|
ao_cart_to_sphe_num, S, size(S,1), ao_ortho_canonical_num_complex)
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, ao_ortho_canonical_num_complex, ao_cart_to_sphe_num, (1.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_coef_complex, size(ao_cart_to_sphe_coef_complex,1), &
|
||||||
|
S, size(S,1), &
|
||||||
|
(0.d0,0.d0), ao_ortho_canonical_coef_complex, size(ao_ortho_canonical_coef_complex,1))
|
||||||
|
|
||||||
|
deallocate(S)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_complex, (ao_ortho_canonical_num_complex,ao_ortho_canonical_num_complex)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! overlap matrix of the ao_ortho_canonical.
|
||||||
|
! Expected to be the Identity
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16 :: c
|
||||||
|
do j=1, ao_ortho_canonical_num_complex
|
||||||
|
do i=1, ao_ortho_canonical_num_complex
|
||||||
|
ao_ortho_canonical_overlap_complex(i,j) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do j=1, ao_ortho_canonical_num_complex
|
||||||
|
do k=1, ao_num
|
||||||
|
c = (0.d0,0.d0)
|
||||||
|
do l=1, ao_num
|
||||||
|
c += conjg(ao_ortho_canonical_coef_complex(l,j)) * ao_overlap_complex(l,k)
|
||||||
|
enddo
|
||||||
|
do i=1, ao_ortho_canonical_num_complex
|
||||||
|
ao_ortho_canonical_overlap_complex(i,j) += ao_ortho_canonical_coef_complex(k,i) * c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
196
src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f
Normal file
196
src/ao_one_e_ints/ao_ortho_cano_kpts.irp.f
Normal file
@ -0,0 +1,196 @@
|
|||||||
|
!todo: add kpts
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt)]
|
||||||
|
&BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Coefficients to go from cartesian to spherical coordinates in the current
|
||||||
|
! basis set
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
integer, external :: ao_power_index
|
||||||
|
integer :: ibegin,j,k
|
||||||
|
integer :: prev
|
||||||
|
prev = 0
|
||||||
|
ao_cart_to_sphe_coef_kpts(:,:) = (0.d0,0.d0)
|
||||||
|
! Assume order provided by ao_power_index
|
||||||
|
i = 1
|
||||||
|
ao_cart_to_sphe_num_per_kpt = 0
|
||||||
|
do while (i <= ao_num_per_kpt)
|
||||||
|
select case ( ao_l(i) )
|
||||||
|
case (0)
|
||||||
|
ao_cart_to_sphe_num_per_kpt += 1
|
||||||
|
ao_cart_to_sphe_coef_kpts(i,ao_cart_to_sphe_num_per_kpt) = (1.d0,0.d0)
|
||||||
|
i += 1
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
case ($SHELL)
|
||||||
|
if (ao_power(i,1) == $SHELL) then
|
||||||
|
do k=1,size(cart_to_sphe_$SHELL,2)
|
||||||
|
do j=1,size(cart_to_sphe_$SHELL,1)
|
||||||
|
ao_cart_to_sphe_coef_kpts(i+j-1,ao_cart_to_sphe_num_per_kpt+k) = dcmplx(cart_to_sphe_$SHELL(j,k),0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
i += size(cart_to_sphe_$SHELL,1)
|
||||||
|
ao_cart_to_sphe_num_per_kpt += size(cart_to_sphe_$SHELL,2)
|
||||||
|
endif
|
||||||
|
SUBST [ SHELL ]
|
||||||
|
1;;
|
||||||
|
2;;
|
||||||
|
3;;
|
||||||
|
4;;
|
||||||
|
5;;
|
||||||
|
6;;
|
||||||
|
7;;
|
||||||
|
8;;
|
||||||
|
9;;
|
||||||
|
END_TEMPLATE
|
||||||
|
case default
|
||||||
|
stop 'Error in ao_cart_to_sphe_kpts : angular momentum too high'
|
||||||
|
end select
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
!BEGIN_PROVIDER [ integer, ao_cart_to_sphe_num_per_kpt ]
|
||||||
|
! implicit none
|
||||||
|
! ao_cart_to_sphe_num_per_kpt = ao_cart_to_sphe_num / kpt_num
|
||||||
|
!END_PROVIDER
|
||||||
|
!
|
||||||
|
!BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_coef_kpts, (ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! complex version of ao_cart_to_sphe_coef for one k-point
|
||||||
|
! END_DOC
|
||||||
|
! call zlacp2('A',ao_num_per_kpt,ao_cart_to_sphe_num_per_kpt, &
|
||||||
|
! ao_cart_to_sphe_coef,size(ao_cart_to_sphe_coef,1), &
|
||||||
|
! ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1))
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_cart_to_sphe_overlap_kpts, (ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! AO overlap matrix in the spherical basis set
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
complex*16, allocatable :: S(:,:)
|
||||||
|
allocate (S(ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt))
|
||||||
|
|
||||||
|
!todo: call with (:,:,k) vs (1,1,k)? is there a difference? does one create a temporary array?
|
||||||
|
do k=1, kpt_num
|
||||||
|
|
||||||
|
call zgemm('T','N',ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), &
|
||||||
|
ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), (0.d0,0.d0), &
|
||||||
|
S, size(S,1))
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt,ao_num_per_kpt, (1.d0,0.d0), &
|
||||||
|
S, size(S,1), &
|
||||||
|
ao_cart_to_sphe_coef_kpts,size(ao_cart_to_sphe_coef_kpts,1), (0.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_overlap_kpts(:,:,k),size(ao_cart_to_sphe_overlap_kpts,1))
|
||||||
|
enddo
|
||||||
|
deallocate(S)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_ortho_cano_coef_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt, kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! ao_ortho_canonical_coef_complex^(-1)
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
do k=1, kpt_num
|
||||||
|
call get_inverse_complex(ao_ortho_canonical_coef_kpts,size(ao_ortho_canonical_coef_kpts,1),&
|
||||||
|
ao_num_per_kpt, ao_ortho_cano_coef_inv_kpts, size(ao_ortho_cano_coef_inv_kpts,1))
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_ortho_canonical_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt, (kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, ao_ortho_canonical_num_per_kpt_max ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO: ao_ortho_canonical_num_complex should be the same as the real version
|
||||||
|
! maybe if the providers weren't linked we could avoid making a complex one?
|
||||||
|
! matrix of the coefficients of the mos generated by the
|
||||||
|
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
||||||
|
! ao_ortho_canonical_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_canonical orbital
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
ao_ortho_canonical_coef_kpts = (0.d0,0.d0)
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,ao_num
|
||||||
|
ao_ortho_canonical_coef_kpts(i,i,k) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
!call ortho_lowdin(ao_overlap,size(ao_overlap,1),ao_num,ao_ortho_canonical_coef,size(ao_ortho_canonical_coef,1),ao_num)
|
||||||
|
!ao_ortho_canonical_num=ao_num
|
||||||
|
!return
|
||||||
|
|
||||||
|
if (ao_cartesian) then
|
||||||
|
|
||||||
|
ao_ortho_canonical_num_per_kpt = ao_num_per_kpt
|
||||||
|
do k=1,kpt_num
|
||||||
|
call ortho_canonical_complex(ao_overlap_kpts(:,:,k),size(ao_overlap_kpts,1), &
|
||||||
|
ao_num_per_kpt,ao_ortho_canonical_coef_kpts(:,:,k),size(ao_ortho_canonical_coef_kpts,1), &
|
||||||
|
ao_ortho_canonical_num_per_kpt(k))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
complex*16, allocatable :: S(:,:)
|
||||||
|
|
||||||
|
allocate(S(ao_cart_to_sphe_num_per_kpt,ao_cart_to_sphe_num_per_kpt))
|
||||||
|
do k=1,kpt_num
|
||||||
|
S = (0.d0,0.d0)
|
||||||
|
do i=1,ao_cart_to_sphe_num_per_kpt
|
||||||
|
S(i,i) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ao_ortho_canonical_num_per_kpt(k) = ao_cart_to_sphe_num_per_kpt
|
||||||
|
call ortho_canonical_complex(ao_cart_to_sphe_overlap_kpts, size(ao_cart_to_sphe_overlap_kpts,1), &
|
||||||
|
ao_cart_to_sphe_num_per_kpt, S, size(S,1), ao_ortho_canonical_num_per_kpt(k))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, ao_ortho_canonical_num_per_kpt(k), ao_cart_to_sphe_num_per_kpt, (1.d0,0.d0), &
|
||||||
|
ao_cart_to_sphe_coef_kpts, size(ao_cart_to_sphe_coef_kpts,1), &
|
||||||
|
S, size(S,1), &
|
||||||
|
(0.d0,0.d0), ao_ortho_canonical_coef_kpts(:,:,k), size(ao_ortho_canonical_coef_kpts,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(S)
|
||||||
|
endif
|
||||||
|
ao_ortho_canonical_num_per_kpt_max = maxval(ao_ortho_canonical_num_per_kpt)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_canonical_overlap_kpts, (ao_ortho_canonical_num_per_kpt_max,ao_ortho_canonical_num_per_kpt_max,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! overlap matrix of the ao_ortho_canonical.
|
||||||
|
! Expected to be the Identity
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l,kk
|
||||||
|
complex*16 :: c
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j=1, ao_ortho_canonical_num_per_kpt_max
|
||||||
|
do i=1, ao_ortho_canonical_num_per_kpt_max
|
||||||
|
ao_ortho_canonical_overlap_kpts(i,j,k) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do j=1, ao_ortho_canonical_num_per_kpt(kk)
|
||||||
|
do k=1, ao_num_per_kpt
|
||||||
|
c = (0.d0,0.d0)
|
||||||
|
do l=1, ao_num_per_kpt
|
||||||
|
c += conjg(ao_ortho_canonical_coef_kpts(l,j,kk)) * ao_overlap_kpts(l,k,kk)
|
||||||
|
enddo
|
||||||
|
do i=1, ao_ortho_canonical_num_per_kpt(kk)
|
||||||
|
ao_ortho_canonical_overlap_kpts(i,j,kk) += ao_ortho_canonical_coef_kpts(k,i,kk) * c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
@ -70,6 +70,59 @@
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ double precision, ao_overlap_imag, (ao_num, ao_num) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Imaginary part of the overlap
|
||||||
|
! END_DOC
|
||||||
|
! if (read_ao_integrals_overlap) then
|
||||||
|
! call ezfio_get_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num))
|
||||||
|
! print *, 'AO overlap integrals read from disk'
|
||||||
|
! else
|
||||||
|
! ao_overlap_imag = 0.d0
|
||||||
|
! endif
|
||||||
|
! if (write_ao_integrals_overlap) then
|
||||||
|
! call ezfio_set_ao_one_e_ints_ao_integrals_overlap_imag(ao_overlap_imag(1:ao_num, 1:ao_num))
|
||||||
|
! print *, 'AO overlap integrals written to disk'
|
||||||
|
! endif
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_overlap_complex, (ao_num, ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Overlap for complex AOs
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_overlap) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_overlap_complex(ao_overlap_complex)
|
||||||
|
print *, 'AO overlap integrals read from disk'
|
||||||
|
else
|
||||||
|
print*,'complex AO overlap ints must be provided',irp_here
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_overlap) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_overlap_complex(ao_overlap_complex)
|
||||||
|
print *, 'AO overlap integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_overlap_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Overlap for complex AOs
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_overlap) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_overlap_kpts(ao_overlap_kpts)
|
||||||
|
print *, 'AO overlap integrals read from disk'
|
||||||
|
else
|
||||||
|
print*,'complex AO overlap ints must be provided',irp_here
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_overlap) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_overlap_kpts(ao_overlap_kpts)
|
||||||
|
print *, 'AO overlap integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
@ -86,15 +139,27 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
|||||||
double precision :: A_center(3), B_center(3)
|
double precision :: A_center(3), B_center(3)
|
||||||
integer :: power_A(3), power_B(3)
|
integer :: power_A(3), power_B(3)
|
||||||
double precision :: lower_exp_val, dx
|
double precision :: lower_exp_val, dx
|
||||||
|
if (is_complex) then
|
||||||
|
ao_overlap_abs = 0.d0
|
||||||
|
integer :: k, ishift
|
||||||
|
do k=1,kpt_num
|
||||||
|
ishift = (k-1)*ao_num_per_kpt
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
do i= 1,ao_num_per_kpt
|
||||||
|
ao_overlap_abs(ishift+i,ishift+j)= cdabs(ao_overlap_kpts(i,j,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
dim1=100
|
dim1=100
|
||||||
lower_exp_val = 40.d0
|
lower_exp_val = 40.d0
|
||||||
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) &
|
||||||
!$OMP DEFAULT(NONE) &
|
!$OMP DEFAULT(NONE) &
|
||||||
!$OMP PRIVATE(A_center,B_center,power_A,power_B,&
|
!$OMP PRIVATE(A_center,B_center,power_A,power_B, &
|
||||||
!$OMP overlap_x,overlap_y, overlap_z, overlap, &
|
!$OMP overlap_x,overlap_y, overlap_z, overlap, &
|
||||||
!$OMP alpha, beta,i,j,dx) &
|
!$OMP alpha, beta,i,j,dx) &
|
||||||
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
!$OMP SHARED(nucl_coord,ao_power,ao_prim_num, &
|
||||||
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl, &
|
!$OMP ao_overlap_abs,ao_num,ao_coef_normalized_ordered_transp,ao_nucl,&
|
||||||
!$OMP ao_expo_ordered_transp,dim1,lower_exp_val)
|
!$OMP ao_expo_ordered_transp,dim1,lower_exp_val)
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
A_center(1) = nucl_coord( ao_nucl(j), 1 )
|
A_center(1) = nucl_coord( ao_nucl(j), 1 )
|
||||||
@ -124,6 +189,7 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num,ao_num) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
||||||
@ -134,6 +200,27 @@ BEGIN_PROVIDER [ double precision, S_inv,(ao_num,ao_num) ]
|
|||||||
call get_pseudo_inverse(ao_overlap,size(ao_overlap,1),ao_num,ao_num,S_inv,size(S_inv,1))
|
call get_pseudo_inverse(ao_overlap,size(ao_overlap,1),ao_num,ao_num,S_inv,size(S_inv,1))
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_inv_complex,(ao_num,ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Inverse of the overlap matrix
|
||||||
|
END_DOC
|
||||||
|
call get_pseudo_inverse_complex(ao_overlap_complex, &
|
||||||
|
size(ao_overlap_complex,1),ao_num,ao_num,S_inv_complex,size(S_inv_complex,1))
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_inv_kpts,(ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Inverse of the overlap matrix
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call get_pseudo_inverse_complex(ao_overlap_kpts(1,1,k), &
|
||||||
|
size(ao_overlap_kpts,1),ao_num_per_kpt,ao_num_per_kpt,S_inv_kpts(1,1,k),size(S_inv_kpts,1))
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]
|
BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -192,6 +279,125 @@ BEGIN_PROVIDER [ double precision, S_half_inv, (AO_num,AO_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_half_inv_complex, (AO_num,AO_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! :math:`X = S^{-1/2}` obtained by SVD
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_linear_dependencies
|
||||||
|
integer :: LDA, LDC
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: U(:,:),Vt(:,:)
|
||||||
|
integer :: info, i, j, k
|
||||||
|
double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6
|
||||||
|
|
||||||
|
LDA = size(AO_overlap_complex,1)
|
||||||
|
LDC = size(S_half_inv_complex,1)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
U(LDC,AO_num), &
|
||||||
|
Vt(LDA,AO_num), &
|
||||||
|
D(AO_num))
|
||||||
|
|
||||||
|
call svd_complex( &
|
||||||
|
ao_overlap_complex,LDA, &
|
||||||
|
U,LDC, &
|
||||||
|
D, &
|
||||||
|
Vt,LDA, &
|
||||||
|
AO_num,AO_num)
|
||||||
|
|
||||||
|
num_linear_dependencies = 0
|
||||||
|
do i=1,AO_num
|
||||||
|
print*,D(i)
|
||||||
|
if(abs(D(i)) <= threshold_overlap_AO_eigenvalues) then
|
||||||
|
D(i) = 0.d0
|
||||||
|
num_linear_dependencies += 1
|
||||||
|
else
|
||||||
|
ASSERT (D(i) > 0.d0)
|
||||||
|
D(i) = 1.d0/sqrt(D(i))
|
||||||
|
endif
|
||||||
|
do j=1,AO_num
|
||||||
|
S_half_inv_complex(j,i) = 0.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
write(*,*) 'linear dependencies',num_linear_dependencies
|
||||||
|
|
||||||
|
do k=1,AO_num
|
||||||
|
if(D(k) /= 0.d0) then
|
||||||
|
do j=1,AO_num
|
||||||
|
do i=1,AO_num
|
||||||
|
S_half_inv_complex(i,j) = S_half_inv_complex(i,j) + U(i,k)*D(k)*Vt(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_half_inv_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! :math:`X = S^{-1/2}` obtained by SVD
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: num_linear_dependencies
|
||||||
|
integer :: LDA, LDC
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: U(:,:),Vt(:,:)
|
||||||
|
integer :: info, i, j, k,kk
|
||||||
|
double precision, parameter :: threshold_overlap_AO_eigenvalues = 1.d-6
|
||||||
|
|
||||||
|
LDA = size(ao_overlap_kpts,1)
|
||||||
|
LDC = size(s_half_inv_kpts,1)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
U(LDC,ao_num_per_kpt), &
|
||||||
|
Vt(LDA,ao_num_per_kpt), &
|
||||||
|
D(ao_num_per_kpt))
|
||||||
|
|
||||||
|
do kk=1,kpt_num
|
||||||
|
call svd_complex( &
|
||||||
|
ao_overlap_kpts(1,1,kk),LDA, &
|
||||||
|
U,LDC, &
|
||||||
|
D, &
|
||||||
|
Vt,LDA, &
|
||||||
|
ao_num_per_kpt,ao_num_per_kpt)
|
||||||
|
|
||||||
|
num_linear_dependencies = 0
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
print*,D(i)
|
||||||
|
if(abs(D(i)) <= threshold_overlap_AO_eigenvalues) then
|
||||||
|
D(i) = 0.d0
|
||||||
|
num_linear_dependencies += 1
|
||||||
|
else
|
||||||
|
ASSERT (D(i) > 0.d0)
|
||||||
|
D(i) = 1.d0/sqrt(D(i))
|
||||||
|
endif
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
S_half_inv_kpts(j,i,kk) = 0.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
write(*,*) 'linear dependencies, k: ',num_linear_dependencies,', ',kk
|
||||||
|
|
||||||
|
do k=1,ao_num_per_kpt
|
||||||
|
if(D(k) /= 0.d0) then
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
S_half_inv_kpts(i,j,kk) = S_half_inv_kpts(i,j,kk) + U(i,k)*D(k)*Vt(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ]
|
||||||
implicit none
|
implicit none
|
||||||
@ -227,3 +433,73 @@ BEGIN_PROVIDER [ double precision, S_half, (ao_num,ao_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_half_complex, (ao_num,ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! :math:`S^{1/2}`
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
complex*16, allocatable :: U(:,:)
|
||||||
|
complex*16, allocatable :: Vt(:,:)
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
|
||||||
|
allocate(U(ao_num,ao_num),Vt(ao_num,ao_num),D(ao_num))
|
||||||
|
|
||||||
|
call svd_complex(ao_overlap_complex,size(ao_overlap_complex,1),U,size(U,1),D,Vt,size(Vt,1),ao_num,ao_num)
|
||||||
|
|
||||||
|
do i=1,ao_num
|
||||||
|
D(i) = dsqrt(D(i))
|
||||||
|
do j=1,ao_num
|
||||||
|
S_half_complex(j,i) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k=1,ao_num
|
||||||
|
do j=1,ao_num
|
||||||
|
do i=1,ao_num
|
||||||
|
S_half_complex(i,j) = S_half_complex(i,j) + U(i,k)*D(k)*Vt(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(U,Vt,D)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_half_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! :math:`S^{1/2}`
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,j,k,kk
|
||||||
|
complex*16, allocatable :: U(:,:)
|
||||||
|
complex*16, allocatable :: Vt(:,:)
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
|
||||||
|
allocate(U(ao_num_per_kpt,ao_num_per_kpt),Vt(ao_num_per_kpt,ao_num_per_kpt),D(ao_num_per_kpt))
|
||||||
|
|
||||||
|
do kk=1,kpt_num
|
||||||
|
call svd_complex(ao_overlap_kpts(1,1,k),size(ao_overlap_kpts,1),U,size(U,1),D,Vt,size(Vt,1),ao_num_per_kpt,ao_num_per_kpt)
|
||||||
|
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
D(i) = dsqrt(D(i))
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
S_half_kpts(j,i,kk) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k=1,ao_num_per_kpt
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
S_half_kpts(i,j,kk) = S_half_kpts(i,j,kk) + U(i,k)*D(k)*Vt(k,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(U,Vt,D)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -149,3 +149,66 @@ BEGIN_PROVIDER [double precision, ao_kinetic_integrals, (ao_num,ao_num)]
|
|||||||
endif
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [double precision, ao_kinetic_integrals_imag, (ao_num,ao_num)]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Kinetic energy integrals in the |AO| basis.
|
||||||
|
! !
|
||||||
|
! ! $\langle \chi_i |\hat{T}| \chi_j \rangle$
|
||||||
|
! !
|
||||||
|
! END_DOC
|
||||||
|
! integer :: i,j,k,l
|
||||||
|
!
|
||||||
|
! if (read_ao_integrals_kinetic) then
|
||||||
|
! call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag)
|
||||||
|
! print *, 'AO kinetic integrals read from disk'
|
||||||
|
! else
|
||||||
|
! print *, irp_here, ': Not yet implemented'
|
||||||
|
! endif
|
||||||
|
! if (write_ao_integrals_kinetic) then
|
||||||
|
! call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_imag(ao_kinetic_integrals_imag)
|
||||||
|
! print *, 'AO kinetic integrals written to disk'
|
||||||
|
! endif
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_complex, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the |AO| basis.
|
||||||
|
!
|
||||||
|
! $\langle \chi_i |\hat{T}| \chi_j \rangle$
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_kinetic) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_complex(ao_kinetic_integrals_complex)
|
||||||
|
print *, 'AO kinetic integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, irp_here, ': Not yet implemented'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_kinetic) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_complex(ao_kinetic_integrals_complex)
|
||||||
|
print *, 'AO kinetic integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_kinetic_integrals_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the |AO| basis.
|
||||||
|
!
|
||||||
|
! $\langle \chi_i |\hat{T}| \chi_j \rangle$
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_kinetic) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_kinetic_kpts(ao_kinetic_integrals_kpts)
|
||||||
|
print *, 'AO kinetic integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, irp_here, ': Not yet implemented'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_kinetic) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_kinetic_kpts(ao_kinetic_integrals_kpts)
|
||||||
|
print *, 'AO kinetic integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
@ -12,8 +12,8 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
integer :: i,j,k,l,n_pt_in,m
|
integer :: i,j,k,l,n_pt_in,m
|
||||||
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||||
|
|
||||||
if (read_ao_integrals_e_n) then
|
if (read_ao_integrals_n_e) then
|
||||||
call ezfio_get_ao_one_e_ints_ao_integrals_e_n(ao_integrals_n_e)
|
call ezfio_get_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||||
print *, 'AO N-e integrals read from disk'
|
print *, 'AO N-e integrals read from disk'
|
||||||
else
|
else
|
||||||
|
|
||||||
@ -76,13 +76,69 @@ BEGIN_PROVIDER [ double precision, ao_integrals_n_e, (ao_num,ao_num)]
|
|||||||
!$OMP END DO
|
!$OMP END DO
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
endif
|
endif
|
||||||
if (write_ao_integrals_e_n) then
|
if (write_ao_integrals_n_e) then
|
||||||
call ezfio_set_ao_one_e_ints_ao_integrals_e_n(ao_integrals_n_e)
|
call ezfio_set_ao_one_e_ints_ao_integrals_n_e(ao_integrals_n_e)
|
||||||
print *, 'AO N-e integrals written to disk'
|
print *, 'AO N-e integrals written to disk'
|
||||||
endif
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ double precision, ao_integrals_n_e_imag, (ao_num,ao_num)]
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Nucleus-electron interaction, in the |AO| basis set.
|
||||||
|
! !
|
||||||
|
! ! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
|
! END_DOC
|
||||||
|
! implicit none
|
||||||
|
! double precision :: alpha, beta, gama, delta
|
||||||
|
! integer :: num_A,num_B
|
||||||
|
! double precision :: A_center(3),B_center(3),C_center(3)
|
||||||
|
! integer :: power_A(3),power_B(3)
|
||||||
|
! integer :: i,j,k,l,n_pt_in,m
|
||||||
|
! double precision :: overlap_x,overlap_y,overlap_z,overlap,dx,NAI_pol_mult
|
||||||
|
!
|
||||||
|
! if (read_ao_integrals_n_e) then
|
||||||
|
! call ezfio_get_ao_one_e_ints_ao_integrals_n_e_imag(ao_integrals_n_e_imag)
|
||||||
|
! print *, 'AO N-e integrals read from disk'
|
||||||
|
! else
|
||||||
|
! print *, irp_here, ': Not yet implemented'
|
||||||
|
! endif
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_integrals_n_e_complex, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Nucleus-electron interaction, in the |AO| basis set.
|
||||||
|
!
|
||||||
|
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
|
END_DOC
|
||||||
|
print*,'error: ',irp_here
|
||||||
|
write(*,*) "test"
|
||||||
|
ao_integrals_n_e_complex(999,999) = 0.d0
|
||||||
|
call abort()
|
||||||
|
if (read_ao_integrals_n_e) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_n_e_complex(ao_integrals_n_e_complex)
|
||||||
|
print *, 'AO N-e integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, irp_here, ': Not yet implemented'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_integrals_n_e_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Nucleus-electron interaction, in the |AO| basis set.
|
||||||
|
!
|
||||||
|
! :math:`\langle \chi_i | -\sum_A \frac{1}{|r-R_A|} | \chi_j \rangle`
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_n_e) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_n_e_kpts(ao_integrals_n_e_kpts)
|
||||||
|
print *, 'AO N-e integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, irp_here, ': Not yet implemented'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)]
|
BEGIN_PROVIDER [ double precision, ao_integrals_n_e_per_atom, (ao_num,ao_num,nucl_num)]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Nucleus-electron interaction in the |AO| basis set, per atom A.
|
! Nucleus-electron interaction in the |AO| basis set, per atom A.
|
||||||
@ -166,7 +222,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
|||||||
double precision :: P_center(3)
|
double precision :: P_center(3)
|
||||||
double precision :: d(0:n_pt_in),pouet,coeff,rho,dist,const,pouet_2,p,p_inv,factor
|
double precision :: d(0:n_pt_in),pouet,coeff,rho,dist,const,pouet_2,p,p_inv,factor
|
||||||
double precision :: I_n_special_exact,integrate_bourrin,I_n_bibi
|
double precision :: I_n_special_exact,integrate_bourrin,I_n_bibi
|
||||||
double precision :: V_e_n,const_factor,dist_integral,tmp
|
double precision :: V_n_e,const_factor,dist_integral,tmp
|
||||||
double precision :: accu,epsilo,rint
|
double precision :: accu,epsilo,rint
|
||||||
integer :: n_pt_out,lmax
|
integer :: n_pt_out,lmax
|
||||||
include 'utils/constants.include.F'
|
include 'utils/constants.include.F'
|
||||||
@ -178,7 +234,7 @@ double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,b
|
|||||||
(A_center(3)/=C_center(3))) then
|
(A_center(3)/=C_center(3))) then
|
||||||
continue
|
continue
|
||||||
else
|
else
|
||||||
NAI_pol_mult = V_e_n(power_A(1),power_A(2),power_A(3), &
|
NAI_pol_mult = V_n_e(power_A(1),power_A(2),power_A(3), &
|
||||||
power_B(1),power_B(2),power_B(3),alpha,beta)
|
power_B(1),power_B(2),power_B(3),alpha,beta)
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
@ -476,7 +532,7 @@ recursive subroutine I_x2_pol_mult_one_e(c,R1x,R1xp,R2x,d,nd,dim)
|
|||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
double precision function V_e_n(a_x,a_y,a_z,b_x,b_y,b_z,alpha,beta)
|
double precision function V_n_e(a_x,a_y,a_z,b_x,b_y,b_z,alpha,beta)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Primitve nuclear attraction between the two primitves centered on the same atom.
|
! Primitve nuclear attraction between the two primitves centered on the same atom.
|
||||||
@ -489,9 +545,9 @@ double precision function V_e_n(a_x,a_y,a_z,b_x,b_y,b_z,alpha,beta)
|
|||||||
double precision :: alpha,beta
|
double precision :: alpha,beta
|
||||||
double precision :: V_r, V_phi, V_theta
|
double precision :: V_r, V_phi, V_theta
|
||||||
if(iand((a_x+b_x),1)==1.or.iand(a_y+b_y,1)==1.or.iand((a_z+b_z),1)==1)then
|
if(iand((a_x+b_x),1)==1.or.iand(a_y+b_y,1)==1.or.iand((a_z+b_z),1)==1)then
|
||||||
V_e_n = 0.d0
|
V_n_e = 0.d0
|
||||||
else
|
else
|
||||||
V_e_n = V_r(a_x+b_x+a_y+b_y+a_z+b_z+1,alpha+beta) &
|
V_n_e = V_r(a_x+b_x+a_y+b_y+a_z+b_z+1,alpha+beta) &
|
||||||
* V_phi(a_x+b_x,a_y+b_y) &
|
* V_phi(a_x+b_x,a_y+b_y) &
|
||||||
* V_theta(a_z+b_z,a_x+b_x+a_y+b_y+1)
|
* V_theta(a_z+b_z,a_x+b_x+a_y+b_y+1)
|
||||||
endif
|
endif
|
||||||
|
@ -27,6 +27,59 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integrals, (ao_num,ao_num)]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_imag, (ao_num, ao_num) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Imaginary part of the pseudo_integrals
|
||||||
|
! END_DOC
|
||||||
|
! if (read_ao_integrals_pseudo) then
|
||||||
|
! call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num))
|
||||||
|
! print *, 'AO pseudo_integrals integrals read from disk'
|
||||||
|
! else
|
||||||
|
! ao_pseudo_integrals_imag = 0.d0
|
||||||
|
! endif
|
||||||
|
! if (write_ao_integrals_pseudo) then
|
||||||
|
! call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_imag(ao_pseudo_integrals_imag(1:ao_num, 1:ao_num))
|
||||||
|
! print *, 'AO pseudo_integrals integrals written to disk'
|
||||||
|
! endif
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_complex, (ao_num, ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Overlap for complex AOs
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_pseudo) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_complex(ao_pseudo_integrals_complex)
|
||||||
|
print *, 'AO pseudo_integrals integrals read from disk'
|
||||||
|
else
|
||||||
|
print*,irp_here,'not implemented'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_pseudo) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_complex(ao_pseudo_integrals_complex)
|
||||||
|
print *, 'AO pseudo_integrals integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_pseudo_integrals_kpts, (ao_num_per_kpt, ao_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Overlap for complex AOs
|
||||||
|
END_DOC
|
||||||
|
if (read_ao_integrals_pseudo) then
|
||||||
|
call ezfio_get_ao_one_e_ints_ao_integrals_pseudo_kpts(ao_pseudo_integrals_kpts)
|
||||||
|
print *, 'AO pseudo_integrals integrals read from disk'
|
||||||
|
else
|
||||||
|
print*,irp_here,'not implemented'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
if (write_ao_integrals_pseudo) then
|
||||||
|
call ezfio_set_ao_one_e_ints_ao_integrals_pseudo_kpts(ao_pseudo_integrals_kpts)
|
||||||
|
print *, 'AO pseudo_integrals integrals written to disk'
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
BEGIN_PROVIDER [ double precision, ao_pseudo_integrals_local, (ao_num,ao_num)]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -18,3 +18,20 @@ interface: ezfio,provider,ocaml
|
|||||||
default: False
|
default: False
|
||||||
ezfio_name: direct
|
ezfio_name: direct
|
||||||
|
|
||||||
|
[df_num]
|
||||||
|
type: integer
|
||||||
|
doc: Size of df basis
|
||||||
|
interface: ezfio, provider
|
||||||
|
|
||||||
|
[io_df_ao_integrals]
|
||||||
|
type: Disk_access
|
||||||
|
doc: Read/Write df |AO| integrals from/to disk [ Write | Read | None ]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: None
|
||||||
|
|
||||||
|
[df_ao_integrals_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Real part of the df integrals over AOs
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,ao_basis.ao_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
233
src/ao_two_e_ints/df_ao_ints.irp.f
Normal file
233
src/ao_two_e_ints/df_ao_ints.irp.f
Normal file
@ -0,0 +1,233 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, df_ao_integrals_complex, (ao_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! df AO integrals
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
|
||||||
|
if (read_df_ao_integrals) then
|
||||||
|
call ezfio_get_ao_two_e_ints_df_ao_integrals_complex(df_ao_integrals_complex)
|
||||||
|
print *, 'df AO integrals read from disk'
|
||||||
|
else
|
||||||
|
print*,'df ao integrals must be provided',irp_here
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (write_df_ao_integrals) then
|
||||||
|
call ezfio_set_ao_two_e_ints_df_ao_integrals_complex(df_ao_integrals_complex)
|
||||||
|
print *, 'df AO integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_map_fill_from_df
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! fill ao bielec integral map using 3-index df integrals
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,k,j,l
|
||||||
|
integer :: ki,kk,kj,kl
|
||||||
|
integer :: ii,ik,ij,il
|
||||||
|
integer :: kikk2,kjkl2,jl2,ik2
|
||||||
|
integer :: i_ao,j_ao,i_df
|
||||||
|
|
||||||
|
complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:)
|
||||||
|
|
||||||
|
complex*16 :: integral
|
||||||
|
integer :: n_integrals_1, n_integrals_2
|
||||||
|
integer :: size_buffer
|
||||||
|
integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:)
|
||||||
|
real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:)
|
||||||
|
double precision :: tmp_re,tmp_im
|
||||||
|
integer :: ao_num_kpt_2
|
||||||
|
|
||||||
|
double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0
|
||||||
|
double precision :: map_mb
|
||||||
|
|
||||||
|
logical :: use_map1
|
||||||
|
integer(keY_kind) :: idx_tmp
|
||||||
|
double precision :: sign
|
||||||
|
|
||||||
|
ao_num_kpt_2 = ao_num_per_kpt * ao_num_per_kpt
|
||||||
|
|
||||||
|
size_buffer = min(ao_num_per_kpt*ao_num_per_kpt*ao_num_per_kpt,16000000)
|
||||||
|
print*, 'Providing the ao_bielec integrals from 3-index df integrals'
|
||||||
|
call write_time(6)
|
||||||
|
! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write')
|
||||||
|
! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals
|
||||||
|
|
||||||
|
call wall_time(wall_1)
|
||||||
|
call cpu_time(cpu_1)
|
||||||
|
|
||||||
|
allocate( ints_jl(ao_num_per_kpt,ao_num_per_kpt,df_num))
|
||||||
|
|
||||||
|
wall_0 = wall_1
|
||||||
|
do kl=1, kpt_num
|
||||||
|
do kj=1, kl
|
||||||
|
call idx2_tri_int(kj,kl,kjkl2)
|
||||||
|
if (kj < kl) then
|
||||||
|
do i_ao=1,ao_num_per_kpt
|
||||||
|
do j_ao=1,ao_num_per_kpt
|
||||||
|
do i_df=1,df_num
|
||||||
|
ints_jl(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kjkl2))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
ints_jl = df_ao_integrals_complex(:,:,:,kjkl2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, &
|
||||||
|
!$OMP ints_ik, ints_ikjl, i_ao, j_ao, i_df, &
|
||||||
|
!$OMP n_integrals_1, buffer_i_1, buffer_values_1, &
|
||||||
|
!$OMP n_integrals_2, buffer_i_2, buffer_values_2, &
|
||||||
|
!$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) &
|
||||||
|
!$OMP DEFAULT(NONE) &
|
||||||
|
!$OMP SHARED(size_buffer, kpt_num, df_num, ao_num_per_kpt, ao_num_kpt_2, &
|
||||||
|
!$OMP kl,kj,kjkl2,ints_jl, &
|
||||||
|
!$OMP kconserv, df_ao_integrals_complex, ao_integrals_threshold, ao_integrals_map, ao_integrals_map_2)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
ints_ik(ao_num_per_kpt,ao_num_per_kpt,df_num), &
|
||||||
|
ints_ikjl(ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt,ao_num_per_kpt), &
|
||||||
|
buffer_i_1(size_buffer), &
|
||||||
|
buffer_i_2(size_buffer), &
|
||||||
|
buffer_values_1(size_buffer), &
|
||||||
|
buffer_values_2(size_buffer) &
|
||||||
|
)
|
||||||
|
|
||||||
|
!$OMP DO SCHEDULE(guided)
|
||||||
|
do kk=1,kl
|
||||||
|
ki=kconserv(kl,kk,kj)
|
||||||
|
if (ki>kl) cycle
|
||||||
|
! if ((kl == kj) .and. (ki > kk)) cycle
|
||||||
|
call idx2_tri_int(ki,kk,kikk2)
|
||||||
|
! if (kikk2 > kjkl2) cycle
|
||||||
|
if (ki < kk) then
|
||||||
|
do i_ao=1,ao_num_per_kpt
|
||||||
|
do j_ao=1,ao_num_per_kpt
|
||||||
|
do i_df=1,df_num
|
||||||
|
ints_ik(i_ao,j_ao,i_df) = dconjg(df_ao_integrals_complex(j_ao,i_ao,i_df,kikk2))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/)))
|
||||||
|
else
|
||||||
|
ints_ik = df_ao_integrals_complex(:,:,:,kikk2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call zgemm('N','T', ao_num_kpt_2, ao_num_kpt_2, df_num, &
|
||||||
|
(1.d0,0.d0), ints_ik, ao_num_kpt_2, &
|
||||||
|
ints_jl, ao_num_kpt_2, &
|
||||||
|
(0.d0,0.d0), ints_ikjl, ao_num_kpt_2)
|
||||||
|
|
||||||
|
n_integrals_1=0
|
||||||
|
n_integrals_2=0
|
||||||
|
do il=1,ao_num_per_kpt
|
||||||
|
l=il+(kl-1)*ao_num_per_kpt
|
||||||
|
do ij=1,ao_num_per_kpt
|
||||||
|
j=ij+(kj-1)*ao_num_per_kpt
|
||||||
|
if (j>l) exit
|
||||||
|
call idx2_tri_int(j,l,jl2)
|
||||||
|
do ik=1,ao_num_per_kpt
|
||||||
|
k=ik+(kk-1)*ao_num_per_kpt
|
||||||
|
if (k>l) exit
|
||||||
|
do ii=1,ao_num_per_kpt
|
||||||
|
i=ii+(ki-1)*ao_num_per_kpt
|
||||||
|
if ((j==l) .and. (i>k)) exit
|
||||||
|
call idx2_tri_int(i,k,ik2)
|
||||||
|
if (ik2 > jl2) exit
|
||||||
|
integral = ints_ikjl(ii,ik,ij,il)
|
||||||
|
! print*,i,k,j,l,real(integral),imag(integral)
|
||||||
|
if (cdabs(integral) < ao_integrals_threshold) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign)
|
||||||
|
tmp_re = dble(integral)
|
||||||
|
tmp_im = dimag(integral)
|
||||||
|
if (use_map1) then
|
||||||
|
n_integrals_1 += 1
|
||||||
|
buffer_i_1(n_integrals_1)=idx_tmp
|
||||||
|
buffer_values_1(n_integrals_1)=tmp_re
|
||||||
|
if (sign.ne.0.d0) then
|
||||||
|
n_integrals_1 += 1
|
||||||
|
buffer_i_1(n_integrals_1)=idx_tmp+1
|
||||||
|
buffer_values_1(n_integrals_1)=tmp_im*sign
|
||||||
|
endif
|
||||||
|
if (n_integrals_1 >= size(buffer_i_1)-1) then
|
||||||
|
call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1)
|
||||||
|
n_integrals_1 = 0
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
n_integrals_2 += 1
|
||||||
|
buffer_i_2(n_integrals_2)=idx_tmp
|
||||||
|
buffer_values_2(n_integrals_2)=tmp_re
|
||||||
|
if (sign.ne.0.d0) then
|
||||||
|
n_integrals_2 += 1
|
||||||
|
buffer_i_2(n_integrals_2)=idx_tmp+1
|
||||||
|
buffer_values_2(n_integrals_2)=tmp_im*sign
|
||||||
|
endif
|
||||||
|
if (n_integrals_2 >= size(buffer_i_2)-1) then
|
||||||
|
call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2)
|
||||||
|
n_integrals_2 = 0
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo !ii
|
||||||
|
enddo !ik
|
||||||
|
enddo !ij
|
||||||
|
enddo !il
|
||||||
|
|
||||||
|
if (n_integrals_1 > 0) then
|
||||||
|
call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1)
|
||||||
|
endif
|
||||||
|
if (n_integrals_2 > 0) then
|
||||||
|
call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2)
|
||||||
|
endif
|
||||||
|
enddo !kk
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
deallocate( &
|
||||||
|
ints_ik, &
|
||||||
|
ints_ikjl, &
|
||||||
|
buffer_i_1, &
|
||||||
|
buffer_i_2, &
|
||||||
|
buffer_values_1, &
|
||||||
|
buffer_values_2 &
|
||||||
|
)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
enddo !kj
|
||||||
|
call wall_time(wall_2)
|
||||||
|
if (wall_2 - wall_0 > 1.d0) then
|
||||||
|
wall_0 = wall_2
|
||||||
|
print*, 100.*float(kl)/float(kpt_num), '% in ', &
|
||||||
|
wall_2-wall_1,'s',map_mb(ao_integrals_map),'+',map_mb(ao_integrals_map_2),'MB'
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo !kl
|
||||||
|
deallocate( ints_jl )
|
||||||
|
|
||||||
|
call map_sort(ao_integrals_map)
|
||||||
|
call map_unique(ao_integrals_map)
|
||||||
|
call map_sort(ao_integrals_map_2)
|
||||||
|
call map_unique(ao_integrals_map_2)
|
||||||
|
!call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map)
|
||||||
|
!call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2)
|
||||||
|
!call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
|
||||||
|
|
||||||
|
call wall_time(wall_2)
|
||||||
|
call cpu_time(cpu_2)
|
||||||
|
|
||||||
|
integer*8 :: get_ao_map_size, ao_map_size
|
||||||
|
ao_map_size = get_ao_map_size()
|
||||||
|
|
||||||
|
print*,'AO integrals provided:'
|
||||||
|
print*,' Size of AO map ', map_mb(ao_integrals_map),'+',map_mb(ao_integrals_map_2),'MB'
|
||||||
|
print*,' Number of AO integrals: ', ao_map_size
|
||||||
|
print*,' cpu time :',cpu_2 - cpu_1, 's'
|
||||||
|
print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')'
|
||||||
|
|
||||||
|
end subroutine ao_map_fill_from_df
|
||||||
|
|
@ -4,6 +4,7 @@ use map_module
|
|||||||
!! ======
|
!! ======
|
||||||
|
|
||||||
BEGIN_PROVIDER [ type(map_type), ao_integrals_map ]
|
BEGIN_PROVIDER [ type(map_type), ao_integrals_map ]
|
||||||
|
&BEGIN_PROVIDER [ type(map_type), ao_integrals_map_2 ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! AO integrals
|
! AO integrals
|
||||||
@ -11,9 +12,17 @@ BEGIN_PROVIDER [ type(map_type), ao_integrals_map ]
|
|||||||
integer(key_kind) :: key_max
|
integer(key_kind) :: key_max
|
||||||
integer(map_size_kind) :: sze
|
integer(map_size_kind) :: sze
|
||||||
call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
|
call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
|
||||||
|
if (is_complex) then
|
||||||
|
sze = key_max*2
|
||||||
|
call map_init(ao_integrals_map,sze)
|
||||||
|
call map_init(ao_integrals_map_2,sze)
|
||||||
|
print*, 'AO maps initialized (complex): ', 2*sze
|
||||||
|
else
|
||||||
sze = key_max
|
sze = key_max
|
||||||
call map_init(ao_integrals_map,sze)
|
call map_init(ao_integrals_map,sze)
|
||||||
|
call map_init(ao_integrals_map_2,1_map_size_kind)
|
||||||
print*, 'AO map initialized : ', sze
|
print*, 'AO map initialized : ', sze
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine two_e_integrals_index(i,j,k,l,i1)
|
subroutine two_e_integrals_index(i,j,k,l,i1)
|
||||||
@ -144,8 +153,11 @@ BEGIN_PROVIDER [ double precision, ao_integrals_cache, (0:64*64*64*64) ]
|
|||||||
END_DOC
|
END_DOC
|
||||||
PROVIDE ao_two_e_integrals_in_map
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
integer :: i,j,k,l,ii
|
integer :: i,j,k,l,ii
|
||||||
integer(key_kind) :: idx
|
integer(key_kind) :: idx, idx2
|
||||||
real(integral_kind) :: integral
|
real(integral_kind) :: integral
|
||||||
|
real(integral_kind) :: tmp_re, tmp_im
|
||||||
|
integer(key_kind) :: idx_re,idx_im
|
||||||
|
|
||||||
!$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral)
|
!$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral)
|
||||||
do l=ao_integrals_cache_min,ao_integrals_cache_max
|
do l=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
do k=ao_integrals_cache_min,ao_integrals_cache_max
|
do k=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
@ -165,7 +177,6 @@ BEGIN_PROVIDER [ double precision, ao_integrals_cache, (0:64*64*64*64) ]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -207,7 +218,6 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
|
|||||||
result = tmp
|
result = tmp
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
|
subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
|
||||||
use map_module
|
use map_module
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -237,6 +247,8 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int)
|
subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int)
|
||||||
use map_module
|
use map_module
|
||||||
implicit none
|
implicit none
|
||||||
@ -251,6 +263,10 @@ subroutine get_ao_two_e_integrals_non_zero(j,k,l,sze,out_val,out_val_index,non_z
|
|||||||
integer :: i
|
integer :: i
|
||||||
integer(key_kind) :: hash
|
integer(key_kind) :: hash
|
||||||
double precision :: thresh,tmp
|
double precision :: thresh,tmp
|
||||||
|
if(is_complex) then
|
||||||
|
print*,'not implemented for periodic:',irp_here
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
PROVIDE ao_two_e_integrals_in_map
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
thresh = ao_integrals_threshold
|
thresh = ao_integrals_threshold
|
||||||
|
|
||||||
@ -295,6 +311,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl(j,l,thresh,sze_max,sze,out_val,out
|
|||||||
integer(key_kind) :: hash
|
integer(key_kind) :: hash
|
||||||
double precision :: tmp
|
double precision :: tmp
|
||||||
|
|
||||||
|
if(is_complex) then
|
||||||
|
print*,'not implemented for periodic:',irp_here
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
PROVIDE ao_two_e_integrals_in_map
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
non_zero_int = 0
|
non_zero_int = 0
|
||||||
if (ao_overlap_abs(j,l) < thresh) then
|
if (ao_overlap_abs(j,l) < thresh) then
|
||||||
@ -341,6 +361,10 @@ subroutine get_ao_two_e_integrals_non_zero_jl_from_list(j,l,thresh,list,n_list,s
|
|||||||
integer(key_kind) :: hash
|
integer(key_kind) :: hash
|
||||||
double precision :: tmp
|
double precision :: tmp
|
||||||
|
|
||||||
|
if(is_complex) then
|
||||||
|
print*,'not implemented for periodic:',irp_here
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
PROVIDE ao_two_e_integrals_in_map
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
non_zero_int = 0
|
non_zero_int = 0
|
||||||
if (ao_overlap_abs(j,l) < thresh) then
|
if (ao_overlap_abs(j,l) < thresh) then
|
||||||
@ -379,7 +403,7 @@ function get_ao_map_size()
|
|||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Returns the number of elements in the AO map
|
! Returns the number of elements in the AO map
|
||||||
END_DOC
|
END_DOC
|
||||||
get_ao_map_size = ao_integrals_map % n_elements
|
get_ao_map_size = ao_integrals_map % n_elements + ao_integrals_map_2 % n_elements
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine clear_ao_map
|
subroutine clear_ao_map
|
||||||
@ -389,6 +413,9 @@ subroutine clear_ao_map
|
|||||||
END_DOC
|
END_DOC
|
||||||
call map_deinit(ao_integrals_map)
|
call map_deinit(ao_integrals_map)
|
||||||
FREE ao_integrals_map
|
FREE ao_integrals_map
|
||||||
|
call map_deinit(ao_integrals_map_2)
|
||||||
|
FREE ao_integrals_map_2
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -407,81 +434,3 @@ subroutine insert_into_ao_integrals_map(n_integrals,buffer_i, buffer_values)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine dump_ao_integrals(filename)
|
|
||||||
use map_module
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Save to disk the |AO| integrals
|
|
||||||
END_DOC
|
|
||||||
character*(*), intent(in) :: filename
|
|
||||||
integer(cache_key_kind), pointer :: key(:)
|
|
||||||
real(integral_kind), pointer :: val(:)
|
|
||||||
integer*8 :: i,j, n
|
|
||||||
if (.not.mpi_master) then
|
|
||||||
return
|
|
||||||
endif
|
|
||||||
call ezfio_set_work_empty(.False.)
|
|
||||||
open(unit=66,file=filename,FORM='unformatted')
|
|
||||||
write(66) integral_kind, key_kind
|
|
||||||
write(66) ao_integrals_map%sorted, ao_integrals_map%map_size, &
|
|
||||||
ao_integrals_map%n_elements
|
|
||||||
do i=0_8,ao_integrals_map%map_size
|
|
||||||
write(66) ao_integrals_map%map(i)%sorted, ao_integrals_map%map(i)%map_size,&
|
|
||||||
ao_integrals_map%map(i)%n_elements
|
|
||||||
enddo
|
|
||||||
do i=0_8,ao_integrals_map%map_size
|
|
||||||
key => ao_integrals_map%map(i)%key
|
|
||||||
val => ao_integrals_map%map(i)%value
|
|
||||||
n = ao_integrals_map%map(i)%n_elements
|
|
||||||
write(66) (key(j), j=1,n), (val(j), j=1,n)
|
|
||||||
enddo
|
|
||||||
close(66)
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
integer function load_ao_integrals(filename)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Read from disk the |AO| integrals
|
|
||||||
END_DOC
|
|
||||||
character*(*), intent(in) :: filename
|
|
||||||
integer*8 :: i
|
|
||||||
integer(cache_key_kind), pointer :: key(:)
|
|
||||||
real(integral_kind), pointer :: val(:)
|
|
||||||
integer :: iknd, kknd
|
|
||||||
integer*8 :: n, j
|
|
||||||
load_ao_integrals = 1
|
|
||||||
open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
|
|
||||||
read(66,err=98,end=98) iknd, kknd
|
|
||||||
if (iknd /= integral_kind) then
|
|
||||||
print *, 'Wrong integrals kind in file :', iknd
|
|
||||||
stop 1
|
|
||||||
endif
|
|
||||||
if (kknd /= key_kind) then
|
|
||||||
print *, 'Wrong key kind in file :', kknd
|
|
||||||
stop 1
|
|
||||||
endif
|
|
||||||
read(66,err=98,end=98) ao_integrals_map%sorted, ao_integrals_map%map_size,&
|
|
||||||
ao_integrals_map%n_elements
|
|
||||||
do i=0_8, ao_integrals_map%map_size
|
|
||||||
read(66,err=99,end=99) ao_integrals_map%map(i)%sorted, &
|
|
||||||
ao_integrals_map%map(i)%map_size, ao_integrals_map%map(i)%n_elements
|
|
||||||
call cache_map_reallocate(ao_integrals_map%map(i),ao_integrals_map%map(i)%map_size)
|
|
||||||
enddo
|
|
||||||
do i=0_8, ao_integrals_map%map_size
|
|
||||||
key => ao_integrals_map%map(i)%key
|
|
||||||
val => ao_integrals_map%map(i)%value
|
|
||||||
n = ao_integrals_map%map(i)%n_elements
|
|
||||||
read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
|
|
||||||
enddo
|
|
||||||
call map_sort(ao_integrals_map)
|
|
||||||
load_ao_integrals = 0
|
|
||||||
return
|
|
||||||
99 continue
|
|
||||||
call map_deinit(ao_integrals_map)
|
|
||||||
98 continue
|
|
||||||
stop 'Problem reading ao_integrals_map file in work/'
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
564
src/ao_two_e_ints/map_integrals_cplx.irp.f
Normal file
564
src/ao_two_e_ints/map_integrals_cplx.irp.f
Normal file
@ -0,0 +1,564 @@
|
|||||||
|
use map_module
|
||||||
|
|
||||||
|
|
||||||
|
subroutine idx2_tri_int(i,j,ij)
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
integer, intent(out) :: ij
|
||||||
|
integer :: p,q
|
||||||
|
p = max(i,j)
|
||||||
|
q = min(i,j)
|
||||||
|
ij = q+ishft(p*p-p,-1)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine idx2_tri_key(i,j,ij)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i,j
|
||||||
|
integer(key_kind), intent(out) :: ij
|
||||||
|
integer(key_kind) :: p,q
|
||||||
|
p = max(i,j)
|
||||||
|
q = min(i,j)
|
||||||
|
ij = q+ishft(p*p-p,-1)
|
||||||
|
end
|
||||||
|
subroutine two_e_integrals_index_complex(i,j,k,l,i1,p,q)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gives a unique index for i,j,k,l using permtuation symmetry.
|
||||||
|
! i <-> k, j <-> l, and (i,k) <-> (j,l)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
integer(key_kind), intent(out) :: i1
|
||||||
|
integer(key_kind) :: r,s,i2
|
||||||
|
integer(key_kind),intent(out) :: p,q
|
||||||
|
p = min(i,k)
|
||||||
|
r = max(i,k)
|
||||||
|
p = p+shiftr(r*r-r,1)
|
||||||
|
q = min(j,l)
|
||||||
|
s = max(j,l)
|
||||||
|
q = q+shiftr(s*s-s,1)
|
||||||
|
i1 = min(p,q)
|
||||||
|
i2 = max(p,q)
|
||||||
|
i1 = i1+shiftr(i2*i2-i2,1)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine two_e_integrals_index_reverse_complex_1(i,j,k,l,i1)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$.
|
||||||
|
! For 2 indices $i,j$ and $i \le j$, we have
|
||||||
|
! $p = i(i-1)/2 + j$.
|
||||||
|
! The key point is that because $j < i$,
|
||||||
|
! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving
|
||||||
|
! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$
|
||||||
|
! and $j = p - i(i-1)/2$.
|
||||||
|
! This rule is applied 3 times. First for the symmetry of the
|
||||||
|
! pairs (i,k) and (j,l), and then for the symmetry within each pair.
|
||||||
|
! always returns first set such that i<=k, j<=l, ik<=jl
|
||||||
|
END_DOC
|
||||||
|
integer, intent(out) :: i(4),j(4),k(4),l(4)
|
||||||
|
integer(key_kind), intent(in) :: i1
|
||||||
|
integer(key_kind) :: i2,i3
|
||||||
|
i = 0
|
||||||
|
i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0))
|
||||||
|
l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0))
|
||||||
|
i3 = i1 - shiftr(i2*i2-i2,1)
|
||||||
|
k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0))
|
||||||
|
j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4)
|
||||||
|
i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4)
|
||||||
|
|
||||||
|
!ijkl a+ib
|
||||||
|
i(2) = j(1) !jilk a+ib
|
||||||
|
j(2) = i(1)
|
||||||
|
k(2) = l(1)
|
||||||
|
l(2) = k(1)
|
||||||
|
|
||||||
|
i(3) = k(1) !klij a-ib
|
||||||
|
j(3) = l(1)
|
||||||
|
k(3) = i(1)
|
||||||
|
l(3) = j(1)
|
||||||
|
|
||||||
|
i(4) = l(1) !lkji a-ib
|
||||||
|
j(4) = k(1)
|
||||||
|
k(4) = j(1)
|
||||||
|
l(4) = i(1)
|
||||||
|
|
||||||
|
integer :: ii, jj
|
||||||
|
do ii=2,4
|
||||||
|
do jj=1,ii-1
|
||||||
|
if ( (i(ii) == i(jj)).and. &
|
||||||
|
(j(ii) == j(jj)).and. &
|
||||||
|
(k(ii) == k(jj)).and. &
|
||||||
|
(l(ii) == l(jj)) ) then
|
||||||
|
i(ii) = 0
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine two_e_integrals_index_reverse_complex_2(i,j,k,l,i1)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes the 4 indices $i,j,k,l$ from a unique index $i_1$.
|
||||||
|
! For 2 indices $i,j$ and $i \le j$, we have
|
||||||
|
! $p = i(i-1)/2 + j$.
|
||||||
|
! The key point is that because $j < i$,
|
||||||
|
! $i(i-1)/2 < p \le i(i+1)/2$. So $i$ can be found by solving
|
||||||
|
! $i^2 - i - 2p=0$. One obtains $i=1 + \sqrt{1+8p}/2$
|
||||||
|
! and $j = p - i(i-1)/2$.
|
||||||
|
! This rule is applied 3 times. First for the symmetry of the
|
||||||
|
! pairs (i,k) and (j,l), and then for the symmetry within each pair.
|
||||||
|
! always returns first set such that k<=i, j<=l, ik<=jl
|
||||||
|
END_DOC
|
||||||
|
integer, intent(out) :: i(4),j(4),k(4),l(4)
|
||||||
|
integer(key_kind), intent(in) :: i1
|
||||||
|
integer(key_kind) :: i2,i3
|
||||||
|
i = 0
|
||||||
|
i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0))
|
||||||
|
l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0))
|
||||||
|
i3 = i1 - shiftr(i2*i2-i2,1)
|
||||||
|
i(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0))
|
||||||
|
j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4)
|
||||||
|
k(1) = int(i3 - shiftr(i(1)*i(1)-i(1),1),4)
|
||||||
|
|
||||||
|
!kjil a+ib
|
||||||
|
i(2) = j(1) !jkli a+ib
|
||||||
|
j(2) = i(1)
|
||||||
|
k(2) = l(1)
|
||||||
|
l(2) = k(1)
|
||||||
|
|
||||||
|
i(3) = k(1) !ilkj a-ib
|
||||||
|
j(3) = l(1)
|
||||||
|
k(3) = i(1)
|
||||||
|
l(3) = j(1)
|
||||||
|
|
||||||
|
i(4) = l(1) !lijk a-ib
|
||||||
|
j(4) = k(1)
|
||||||
|
k(4) = j(1)
|
||||||
|
l(4) = i(1)
|
||||||
|
|
||||||
|
integer :: ii, jj
|
||||||
|
do ii=2,4
|
||||||
|
do jj=1,ii-1
|
||||||
|
if ( (i(ii) == i(jj)).and. &
|
||||||
|
(j(ii) == j(jj)).and. &
|
||||||
|
(k(ii) == k(jj)).and. &
|
||||||
|
(l(ii) == l(jj)) ) then
|
||||||
|
i(ii) = 0
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, ao_integrals_cache_complex, (0:64*64*64*64) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Cache of AO integrals for fast access
|
||||||
|
END_DOC
|
||||||
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
|
integer :: i,j,k,l,ii
|
||||||
|
integer(key_kind) :: idx1, idx2
|
||||||
|
real(integral_kind) :: tmp_re, tmp_im
|
||||||
|
integer(key_kind) :: idx_re,idx_im
|
||||||
|
complex(integral_kind) :: integral
|
||||||
|
integer(key_kind) :: p,q,r,s,ik,jl
|
||||||
|
logical :: ilek, jlel, iklejl
|
||||||
|
complex*16 :: get_ao_two_e_integral_complex_simple
|
||||||
|
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO PRIVATE (ilek,jlel,p,q,r,s, ik,jl,iklejl, &
|
||||||
|
!$OMP i,j,k,l,idx1,idx2,tmp_re,tmp_im,idx_re,idx_im,ii,integral)
|
||||||
|
do l=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
|
do k=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
|
do j=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
|
do i=ao_integrals_cache_min,ao_integrals_cache_max
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
integral = get_ao_two_e_integral_complex_simple(i,j,k,l,&
|
||||||
|
ao_integrals_map,ao_integrals_map_2)
|
||||||
|
|
||||||
|
ii = l-ao_integrals_cache_min
|
||||||
|
ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
|
||||||
|
ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
|
||||||
|
ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
|
||||||
|
ao_integrals_cache_complex(ii) = integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx,sign)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! get position of periodic AO integral <ij|kl>
|
||||||
|
! use_map1: true if integral is in first ao map, false if integral is in second ao map
|
||||||
|
! idx: position of real part of integral in map (imag part is at idx+1)
|
||||||
|
! sign: sign of imaginary part
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! for <ab|cd>, conditionals are [a<c, b<d, ac<bd]
|
||||||
|
! last two rows are real (ab==cd)
|
||||||
|
! +---------+---------+---------+---------+---------+---------+---------+---------+---------+
|
||||||
|
! | NEW | <ij|kl> | <ji|lk> | <kl|ij> | <lk|ji> | <kj|il> | <jk|li> | <il|kj> | <li|jk> |
|
||||||
|
! +---------+---------+---------+---------+---------+---------+---------+---------+---------+
|
||||||
|
! | | m1 | m1* | m2 | m2* |
|
||||||
|
! +---------+---------+---------+---------+---------+---------+---------+---------+---------+
|
||||||
|
! | <ij|kl> | TTT | TTF | FFT | FFF | FTT | TFF | TFT | FTF |
|
||||||
|
! | <ij|il> | 0TT | T0F | 0FT | F0F | | | | |
|
||||||
|
! | <ij|kj> | T0T | 0TF | F0T | 0FF | | | | |
|
||||||
|
! | <ii|jj> | TT0 | | FF0 | | FT0(r) | TF0(r) | | |
|
||||||
|
! +---------+---------+---------+---------+---------+---------+---------+---------+---------+
|
||||||
|
! | <ij|ij> | | | | | 00T(r) | 00F(r) | | |
|
||||||
|
! | <ii|ii> | | | | | 000 | | | |
|
||||||
|
! +---------+---------+---------+---------+---------+---------+---------+---------+---------+
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
integer(key_kind), intent(out) :: idx
|
||||||
|
logical, intent(out) :: use_map1
|
||||||
|
double precision, intent(out) :: sign
|
||||||
|
integer(key_kind) :: p,q,r,s,ik,jl,ij,kl
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call two_e_integrals_index_complex(i,j,k,l,idx,ik,jl)
|
||||||
|
p = min(i,j)
|
||||||
|
r = max(i,j)
|
||||||
|
ij = p+shiftr(r*r-r,1)
|
||||||
|
q = min(k,l)
|
||||||
|
s = max(k,l)
|
||||||
|
kl = q+shiftr(s*s-s,1)
|
||||||
|
|
||||||
|
idx = 2*idx-1
|
||||||
|
|
||||||
|
if (ij==kl) then !real, J -> map1, K -> map2
|
||||||
|
sign=0.d0
|
||||||
|
use_map1=.False.
|
||||||
|
else
|
||||||
|
if (ik.eq.jl) then
|
||||||
|
if (i.lt.k) then !TT0
|
||||||
|
sign=1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
else !FF0
|
||||||
|
sign=-1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
endif
|
||||||
|
else if (i.eq.k) then
|
||||||
|
if (j.lt.l) then !0T*
|
||||||
|
sign=1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
else !0F*
|
||||||
|
sign=-1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
endif
|
||||||
|
else if (j.eq.l) then
|
||||||
|
if (i.lt.k) then
|
||||||
|
sign=1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
else
|
||||||
|
sign=-1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
endif
|
||||||
|
else if ((i.lt.k).eqv.(j.lt.l)) then
|
||||||
|
if (i.lt.k) then
|
||||||
|
sign=1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
else
|
||||||
|
sign=-1.d0
|
||||||
|
use_map1=.True.
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
if ((j.lt.l).eqv.(ik.lt.jl)) then
|
||||||
|
sign=1.d0
|
||||||
|
use_map1=.False.
|
||||||
|
else
|
||||||
|
sign=-1.d0
|
||||||
|
use_map1=.False.
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
complex*16 function get_ao_two_e_integral_complex_simple(i,j,k,l,map,map2) result(result)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets one AO bi-electronic integral from the AO map
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
integer(key_kind) :: idx1,idx2,idx
|
||||||
|
real(integral_kind) :: tmp_re, tmp_im
|
||||||
|
integer(key_kind) :: idx_re,idx_im
|
||||||
|
type(map_type), intent(inout) :: map,map2
|
||||||
|
integer :: ii
|
||||||
|
complex(integral_kind) :: tmp
|
||||||
|
integer(key_kind) :: p,q,r,s,ik,jl
|
||||||
|
logical :: ilek, jlel, iklejl,use_map1
|
||||||
|
double precision :: sign
|
||||||
|
! a.le.c, b.le.d, tri(a,c).le.tri(b,d)
|
||||||
|
PROVIDE ao_two_e_integrals_in_map
|
||||||
|
call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx,sign)
|
||||||
|
if (use_map1) then
|
||||||
|
call map_get(map,idx,tmp_re)
|
||||||
|
call map_get(map,idx+1,tmp_im)
|
||||||
|
tmp_im *= sign
|
||||||
|
else
|
||||||
|
call map_get(map2,idx,tmp_re)
|
||||||
|
if (sign/=0.d0) then
|
||||||
|
call map_get(map2,idx+1,tmp_im)
|
||||||
|
tmp_im *= sign
|
||||||
|
else
|
||||||
|
tmp_im=0.d0
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
tmp = dcmplx(tmp_re,tmp_im)
|
||||||
|
result = tmp
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
complex*16 function get_ao_two_e_integral_complex(i,j,k,l,map,map2) result(result)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets one AO bi-electronic integral from the AO map
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i,j,k,l
|
||||||
|
integer(key_kind) :: idx1,idx2
|
||||||
|
real(integral_kind) :: tmp_re, tmp_im
|
||||||
|
integer(key_kind) :: idx_re,idx_im
|
||||||
|
type(map_type), intent(inout) :: map,map2
|
||||||
|
integer :: ii
|
||||||
|
complex(integral_kind) :: tmp
|
||||||
|
complex(integral_kind) :: get_ao_two_e_integral_complex_simple
|
||||||
|
integer(key_kind) :: p,q,r,s,ik,jl
|
||||||
|
logical :: ilek, jlel, iklejl
|
||||||
|
! a.le.c, b.le.d, tri(a,c).le.tri(b,d)
|
||||||
|
PROVIDE ao_two_e_integrals_in_map ao_integrals_cache_complex ao_integrals_cache_min
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
! if (ao_overlap_abs(i,k)*ao_overlap_abs(j,l) < ao_integrals_threshold ) then
|
||||||
|
! tmp = (0.d0,0.d0)
|
||||||
|
! else if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < ao_integrals_threshold) then
|
||||||
|
! tmp = (0.d0,0.d0)
|
||||||
|
! else
|
||||||
|
if (.True.) then
|
||||||
|
ii = l-ao_integrals_cache_min
|
||||||
|
ii = ior(ii, k-ao_integrals_cache_min)
|
||||||
|
ii = ior(ii, j-ao_integrals_cache_min)
|
||||||
|
ii = ior(ii, i-ao_integrals_cache_min)
|
||||||
|
if (iand(ii, -64) /= 0) then
|
||||||
|
tmp = get_ao_two_e_integral_complex_simple(i,j,k,l,map,map2)
|
||||||
|
else
|
||||||
|
ii = l-ao_integrals_cache_min
|
||||||
|
ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
|
||||||
|
ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
|
||||||
|
ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
|
||||||
|
tmp = ao_integrals_cache_complex(ii)
|
||||||
|
endif
|
||||||
|
result = tmp
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_ao_two_e_integrals_complex(j,k,l,sze,out_val)
|
||||||
|
use map_module
|
||||||
|
BEGIN_DOC
|
||||||
|
! Gets multiple AO bi-electronic integral from the AO map .
|
||||||
|
! All i are retrieved for j,k,l fixed.
|
||||||
|
! physicist convention : <ij|kl>
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: j,k,l, sze
|
||||||
|
complex*16, intent(out) :: out_val(sze)
|
||||||
|
|
||||||
|
integer :: i
|
||||||
|
integer(key_kind) :: hash
|
||||||
|
double precision :: thresh
|
||||||
|
PROVIDE ao_two_e_integrals_in_map ao_integrals_map
|
||||||
|
thresh = ao_integrals_threshold
|
||||||
|
|
||||||
|
if (ao_overlap_abs(j,l) < thresh) then
|
||||||
|
out_val = (0.d0,0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
complex*16 :: get_ao_two_e_integral_complex
|
||||||
|
do i=1,sze
|
||||||
|
out_val(i) = get_ao_two_e_integral_complex(i,j,k,l,ao_integrals_map,ao_integrals_map_2)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine get_ao_two_e_integrals_non_zero_complex(j,k,l,sze,out_val,out_val_index,non_zero_int)
|
||||||
|
print*,'not implemented for periodic',irp_here
|
||||||
|
stop -1
|
||||||
|
! use map_module
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Gets multiple AO bi-electronic integral from the AO map .
|
||||||
|
! ! All non-zero i are retrieved for j,k,l fixed.
|
||||||
|
! END_DOC
|
||||||
|
! integer, intent(in) :: j,k,l, sze
|
||||||
|
! real(integral_kind), intent(out) :: out_val(sze)
|
||||||
|
! integer, intent(out) :: out_val_index(sze),non_zero_int
|
||||||
|
!
|
||||||
|
! integer :: i
|
||||||
|
! integer(key_kind) :: hash
|
||||||
|
! double precision :: thresh,tmp
|
||||||
|
! if(is_complex) then
|
||||||
|
! print*,'not implemented for periodic:',irp_here
|
||||||
|
! stop -1
|
||||||
|
! endif
|
||||||
|
! PROVIDE ao_two_e_integrals_in_map
|
||||||
|
! thresh = ao_integrals_threshold
|
||||||
|
!
|
||||||
|
! non_zero_int = 0
|
||||||
|
! if (ao_overlap_abs(j,l) < thresh) then
|
||||||
|
! out_val = 0.d0
|
||||||
|
! return
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! non_zero_int = 0
|
||||||
|
! do i=1,sze
|
||||||
|
! integer, external :: ao_l4
|
||||||
|
! double precision, external :: ao_two_e_integral
|
||||||
|
! !DIR$ FORCEINLINE
|
||||||
|
! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
|
||||||
|
! cycle
|
||||||
|
! endif
|
||||||
|
! call two_e_integrals_index(i,j,k,l,hash)
|
||||||
|
! call map_get(ao_integrals_map, hash,tmp)
|
||||||
|
! if (dabs(tmp) < thresh ) cycle
|
||||||
|
! non_zero_int = non_zero_int+1
|
||||||
|
! out_val_index(non_zero_int) = i
|
||||||
|
! out_val(non_zero_int) = tmp
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_ao_two_e_integrals_non_zero_jl_complex(j,l,thresh,sze_max,sze,out_val,out_val_index,non_zero_int)
|
||||||
|
print*,'not implemented for periodic',irp_here
|
||||||
|
stop -1
|
||||||
|
! use map_module
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Gets multiple AO bi-electronic integral from the AO map .
|
||||||
|
! ! All non-zero i are retrieved for j,k,l fixed.
|
||||||
|
! END_DOC
|
||||||
|
! double precision, intent(in) :: thresh
|
||||||
|
! integer, intent(in) :: j,l, sze,sze_max
|
||||||
|
! real(integral_kind), intent(out) :: out_val(sze_max)
|
||||||
|
! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int
|
||||||
|
!
|
||||||
|
! integer :: i,k
|
||||||
|
! integer(key_kind) :: hash
|
||||||
|
! double precision :: tmp
|
||||||
|
!
|
||||||
|
! if(is_complex) then
|
||||||
|
! print*,'not implemented for periodic:',irp_here
|
||||||
|
! stop -1
|
||||||
|
! endif
|
||||||
|
! PROVIDE ao_two_e_integrals_in_map
|
||||||
|
! non_zero_int = 0
|
||||||
|
! if (ao_overlap_abs(j,l) < thresh) then
|
||||||
|
! out_val = 0.d0
|
||||||
|
! return
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! non_zero_int = 0
|
||||||
|
! do k = 1, sze
|
||||||
|
! do i = 1, sze
|
||||||
|
! integer, external :: ao_l4
|
||||||
|
! double precision, external :: ao_two_e_integral
|
||||||
|
! !DIR$ FORCEINLINE
|
||||||
|
! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
|
||||||
|
! cycle
|
||||||
|
! endif
|
||||||
|
! call two_e_integrals_index(i,j,k,l,hash)
|
||||||
|
! call map_get(ao_integrals_map, hash,tmp)
|
||||||
|
! if (dabs(tmp) < thresh ) cycle
|
||||||
|
! non_zero_int = non_zero_int+1
|
||||||
|
! out_val_index(1,non_zero_int) = i
|
||||||
|
! out_val_index(2,non_zero_int) = k
|
||||||
|
! out_val(non_zero_int) = tmp
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_ao_two_e_integrals_non_zero_jl_from_list_complex(j,l,thresh,list,n_list,sze_max,out_val,out_val_index,non_zero_int)
|
||||||
|
print*,'not implemented for periodic',irp_here
|
||||||
|
stop -1
|
||||||
|
! use map_module
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Gets multiple AO two-electron integrals from the AO map .
|
||||||
|
! ! All non-zero i are retrieved for j,k,l fixed.
|
||||||
|
! END_DOC
|
||||||
|
! double precision, intent(in) :: thresh
|
||||||
|
! integer, intent(in) :: sze_max
|
||||||
|
! integer, intent(in) :: j,l, n_list,list(2,sze_max)
|
||||||
|
! real(integral_kind), intent(out) :: out_val(sze_max)
|
||||||
|
! integer, intent(out) :: out_val_index(2,sze_max),non_zero_int
|
||||||
|
!
|
||||||
|
! integer :: i,k
|
||||||
|
! integer(key_kind) :: hash
|
||||||
|
! double precision :: tmp
|
||||||
|
!
|
||||||
|
! if(is_complex) then
|
||||||
|
! print*,'not implemented for periodic:',irp_here
|
||||||
|
! stop -1
|
||||||
|
! endif
|
||||||
|
! PROVIDE ao_two_e_integrals_in_map
|
||||||
|
! non_zero_int = 0
|
||||||
|
! if (ao_overlap_abs(j,l) < thresh) then
|
||||||
|
! out_val = 0.d0
|
||||||
|
! return
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
! non_zero_int = 0
|
||||||
|
! integer :: kk
|
||||||
|
! do kk = 1, n_list
|
||||||
|
! k = list(1,kk)
|
||||||
|
! i = list(2,kk)
|
||||||
|
! integer, external :: ao_l4
|
||||||
|
! double precision, external :: ao_two_e_integral
|
||||||
|
! !DIR$ FORCEINLINE
|
||||||
|
! if (ao_two_e_integral_schwartz(i,k)*ao_two_e_integral_schwartz(j,l) < thresh) then
|
||||||
|
! cycle
|
||||||
|
! endif
|
||||||
|
! call two_e_integrals_index(i,j,k,l,hash)
|
||||||
|
! call map_get(ao_integrals_map, hash,tmp)
|
||||||
|
! if (dabs(tmp) < thresh ) cycle
|
||||||
|
! non_zero_int = non_zero_int+1
|
||||||
|
! out_val_index(1,non_zero_int) = i
|
||||||
|
! out_val_index(2,non_zero_int) = k
|
||||||
|
! out_val(non_zero_int) = tmp
|
||||||
|
! enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine insert_into_ao_integrals_map_2(n_integrals,buffer_i, buffer_values)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Create new entry into AO map
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer, intent(in) :: n_integrals
|
||||||
|
integer(key_kind), intent(inout) :: buffer_i(n_integrals)
|
||||||
|
real(integral_kind), intent(inout) :: buffer_values(n_integrals)
|
||||||
|
|
||||||
|
call map_append(ao_integrals_map_2, buffer_i, buffer_values, n_integrals)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
@ -348,10 +348,28 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
|||||||
integer :: kk, m, j1, i1, lmax
|
integer :: kk, m, j1, i1, lmax
|
||||||
character*(64) :: fmt
|
character*(64) :: fmt
|
||||||
|
|
||||||
integral = ao_two_e_integral(1,1,1,1)
|
|
||||||
|
|
||||||
double precision :: map_mb
|
double precision :: map_mb
|
||||||
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals
|
PROVIDE read_ao_two_e_integrals io_ao_two_e_integrals
|
||||||
|
if (is_complex) then
|
||||||
|
if (read_ao_two_e_integrals) then
|
||||||
|
print*,'Reading the AO integrals (periodic)'
|
||||||
|
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_complex_1',ao_integrals_map)
|
||||||
|
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints_complex_2',ao_integrals_map_2)
|
||||||
|
print*, 'AO integrals provided (periodic)'
|
||||||
|
ao_two_e_integrals_in_map = .True.
|
||||||
|
return
|
||||||
|
else if (read_df_ao_integrals) then
|
||||||
|
call ao_map_fill_from_df
|
||||||
|
print*, 'AO integrals provided from 3-index ao ints (periodic)'
|
||||||
|
ao_two_e_integrals_in_map = .True.
|
||||||
|
return
|
||||||
|
else
|
||||||
|
print*,'calculation of periodic AOs not implemented'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
else
|
||||||
if (read_ao_two_e_integrals) then
|
if (read_ao_two_e_integrals) then
|
||||||
print*,'Reading the AO integrals'
|
print*,'Reading the AO integrals'
|
||||||
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
call map_load_from_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
||||||
@ -360,6 +378,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
|||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
integral = ao_two_e_integral(1,1,1,1)
|
||||||
print*, 'Providing the AO integrals'
|
print*, 'Providing the AO integrals'
|
||||||
call wall_time(wall_0)
|
call wall_time(wall_0)
|
||||||
call wall_time(wall_1)
|
call wall_time(wall_1)
|
||||||
@ -418,7 +437,7 @@ BEGIN_PROVIDER [ logical, ao_two_e_integrals_in_map ]
|
|||||||
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
call map_save_to_disk(trim(ezfio_filename)//'/work/ao_ints',ao_integrals_map)
|
||||||
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
|
call ezfio_set_ao_two_e_ints_io_ao_two_e_integrals('Read')
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
BEGIN_PROVIDER [ double precision, ao_two_e_integral_schwartz,(ao_num,ao_num) ]
|
||||||
|
@ -80,9 +80,23 @@ BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask, (N_int,2)]
|
|||||||
integer :: occ(elec_alpha_num)
|
integer :: occ(elec_alpha_num)
|
||||||
|
|
||||||
HF_bitmask = 0_bit_kind
|
HF_bitmask = 0_bit_kind
|
||||||
|
if (is_complex) then
|
||||||
|
integer :: kpt,korb
|
||||||
|
kpt=1
|
||||||
|
korb=1
|
||||||
|
do i=1,elec_alpha_num
|
||||||
|
occ(i) = korb + (kpt-1) * mo_num_per_kpt
|
||||||
|
kpt += 1
|
||||||
|
if (kpt > kpt_num) then
|
||||||
|
kpt = 1
|
||||||
|
korb += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,elec_alpha_num
|
do i=1,elec_alpha_num
|
||||||
occ(i) = i
|
occ(i) = i
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
call list_to_bitstring( HF_bitmask(1,1), occ, elec_alpha_num, N_int)
|
call list_to_bitstring( HF_bitmask(1,1), occ, elec_alpha_num, N_int)
|
||||||
! elec_alpha_num <= elec_beta_num, so occ is already OK.
|
! elec_alpha_num <= elec_beta_num, so occ is already OK.
|
||||||
call list_to_bitstring( HF_bitmask(1,2), occ, elec_beta_num, N_int)
|
call list_to_bitstring( HF_bitmask(1,2), occ, elec_beta_num, N_int)
|
||||||
@ -240,3 +254,252 @@ BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask, (N_int,2)]
|
|||||||
closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),act_bitmask(i,2))
|
closed_shell_ref_bitmask(i,2) = ior(ref_bitmask(i,2),act_bitmask(i,2))
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask, (N_int) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Bitmask to include all possible MOs
|
||||||
|
! END_DOC
|
||||||
|
!
|
||||||
|
! integer :: i,j,k
|
||||||
|
! k=0
|
||||||
|
! do j=1,N_int
|
||||||
|
! full_ijkl_bitmask(j) = 0_bit_kind
|
||||||
|
! do i=0,bit_kind_size-1
|
||||||
|
! k=k+1
|
||||||
|
! if (mo_class(k) /= 'Deleted') then
|
||||||
|
! full_ijkl_bitmask(j) = ibset(full_ijkl_bitmask(j),i)
|
||||||
|
! endif
|
||||||
|
! if (k == mo_num) exit
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!END_PROVIDER
|
||||||
|
!
|
||||||
|
!BEGIN_PROVIDER [ integer(bit_kind), full_ijkl_bitmask_4, (N_int,4) ]
|
||||||
|
! implicit none
|
||||||
|
! integer :: i
|
||||||
|
! do i=1,N_int
|
||||||
|
! full_ijkl_bitmask_4(i,1) = full_ijkl_bitmask(i)
|
||||||
|
! full_ijkl_bitmask_4(i,2) = full_ijkl_bitmask(i)
|
||||||
|
! full_ijkl_bitmask_4(i,3) = full_ijkl_bitmask(i)
|
||||||
|
! full_ijkl_bitmask_4(i,4) = full_ijkl_bitmask(i)
|
||||||
|
! enddo
|
||||||
|
!END_PROVIDER
|
||||||
|
!
|
||||||
|
!BEGIN_PROVIDER [ integer(bit_kind), core_inact_act_bitmask_4, (N_int,4) ]
|
||||||
|
! implicit none
|
||||||
|
! integer :: i
|
||||||
|
! do i=1,N_int
|
||||||
|
! core_inact_act_bitmask_4(i,1) = reunion_of_core_inact_act_bitmask(i,1)
|
||||||
|
! core_inact_act_bitmask_4(i,2) = reunion_of_core_inact_act_bitmask(i,1)
|
||||||
|
! core_inact_act_bitmask_4(i,3) = reunion_of_core_inact_act_bitmask(i,1)
|
||||||
|
! core_inact_act_bitmask_4(i,4) = reunion_of_core_inact_act_bitmask(i,1)
|
||||||
|
! enddo
|
||||||
|
!END_PROVIDER
|
||||||
|
!
|
||||||
|
!BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask_4, (N_int,4) ]
|
||||||
|
! implicit none
|
||||||
|
! integer :: i
|
||||||
|
! do i=1,N_int
|
||||||
|
! virt_bitmask_4(i,1) = virt_bitmask(i,1)
|
||||||
|
! virt_bitmask_4(i,2) = virt_bitmask(i,1)
|
||||||
|
! virt_bitmask_4(i,3) = virt_bitmask(i,1)
|
||||||
|
! virt_bitmask_4(i,4) = virt_bitmask(i,1)
|
||||||
|
! enddo
|
||||||
|
!END_PROVIDER
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
!
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), HF_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Hartree Fock bit mask
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
|
||||||
|
hf_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
hf_bitmask_kpts(i,1,k) = iand(hf_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
hf_bitmask_kpts(i,2,k) = iand(hf_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), ref_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reference bit mask, used in Slater rules, chosen as Hartree-Fock bitmask
|
||||||
|
END_DOC
|
||||||
|
ref_bitmask_kpts = HF_bitmask_kpts
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!BEGIN_PROVIDER [ integer(bit_kind), generators_bitmask, (N_int,2,6) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Bitmasks for generator determinants.
|
||||||
|
! ! (N_int, alpha/beta, hole/particle, generator).
|
||||||
|
! !
|
||||||
|
! ! 3rd index is :
|
||||||
|
! !
|
||||||
|
! ! * 1 : hole for single exc
|
||||||
|
! !
|
||||||
|
! ! * 2 : particle for single exc
|
||||||
|
! !
|
||||||
|
! ! * 3 : hole for 1st exc of double
|
||||||
|
! !
|
||||||
|
! ! * 4 : particle for 1st exc of double
|
||||||
|
! !
|
||||||
|
! ! * 5 : hole for 2nd exc of double
|
||||||
|
! !
|
||||||
|
! ! * 6 : particle for 2nd exc of double
|
||||||
|
! !
|
||||||
|
! END_DOC
|
||||||
|
! logical :: exists
|
||||||
|
! PROVIDE ezfio_filename full_ijkl_bitmask
|
||||||
|
!
|
||||||
|
! integer :: ispin, i
|
||||||
|
! do ispin=1,2
|
||||||
|
! do i=1,N_int
|
||||||
|
! generators_bitmask(i,ispin,s_hole ) = reunion_of_inact_act_bitmask(i,ispin)
|
||||||
|
! generators_bitmask(i,ispin,s_part ) = reunion_of_act_virt_bitmask(i,ispin)
|
||||||
|
! generators_bitmask(i,ispin,d_hole1) = reunion_of_inact_act_bitmask(i,ispin)
|
||||||
|
! generators_bitmask(i,ispin,d_part1) = reunion_of_act_virt_bitmask(i,ispin)
|
||||||
|
! generators_bitmask(i,ispin,d_hole2) = reunion_of_inact_act_bitmask(i,ispin)
|
||||||
|
! generators_bitmask(i,ispin,d_part2) = reunion_of_act_virt_bitmask(i,ispin)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_core_inact_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the core and inactive and virtual bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
reunion_of_core_inact_bitmask_kpts(i,1,k) = ior(core_bitmask_kpts(i,1,k),inact_bitmask_kpts(i,1,k))
|
||||||
|
reunion_of_core_inact_bitmask_kpts(i,2,k) = ior(core_bitmask_kpts(i,2,k),inact_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer(bit_kind), reunion_of_inact_act_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the inactive and active bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
reunion_of_inact_act_bitmask_kpts(i,1,k) = ior(inact_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k))
|
||||||
|
reunion_of_inact_act_bitmask_kpts(i,2,k) = ior(inact_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer(bit_kind), reunion_of_act_virt_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the inactive and active bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
reunion_of_act_virt_bitmask_kpts(i,1,k) = ior(virt_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k))
|
||||||
|
reunion_of_act_virt_bitmask_kpts(i,2,k) = ior(virt_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer(bit_kind), reunion_of_core_inact_act_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the core, inactive and active bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
reunion_of_core_inact_act_bitmask_kpts(i,1,k) = ior(reunion_of_core_inact_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k))
|
||||||
|
reunion_of_core_inact_act_bitmask_kpts(i,2,k) = ior(reunion_of_core_inact_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), reunion_of_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the inactive, active and virtual bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
reunion_of_bitmask_kpts(i,1,k) = ior(ior(act_bitmask_kpts(i,1,k),inact_bitmask_kpts(i,1,k)),virt_bitmask_kpts(i,1,k))
|
||||||
|
reunion_of_bitmask_kpts(i,2,k) = ior(ior(act_bitmask_kpts(i,2,k),inact_bitmask_kpts(i,2,k)),virt_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), inact_virt_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
&BEGIN_PROVIDER [ integer(bit_kind), core_inact_virt_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Reunion of the inactive and virtual bitmasks
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
inact_virt_bitmask_kpts(i,1,k) = ior(inact_bitmask_kpts(i,1,k),virt_bitmask_kpts(i,1,k))
|
||||||
|
inact_virt_bitmask_kpts(i,2,k) = ior(inact_bitmask_kpts(i,2,k),virt_bitmask_kpts(i,2,k))
|
||||||
|
core_inact_virt_bitmask_kpts(i,1,k) = ior(core_bitmask_kpts(i,1,k),inact_virt_bitmask_kpts(i,1,k))
|
||||||
|
core_inact_virt_bitmask_kpts(i,2,k) = ior(core_bitmask_kpts(i,2,k),inact_virt_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), unpaired_alpha_electrons_kpts, (N_int,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask reprenting the unpaired alpha electrons in the HF_bitmask
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
unpaired_alpha_electrons_kpts = 0_bit_kind
|
||||||
|
do k = 1, kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
unpaired_alpha_electrons_kpts(i,k) = xor(HF_bitmask_kpts(i,1,k),HF_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer(bit_kind), closed_shell_ref_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
|
||||||
|
closed_shell_ref_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
closed_shell_ref_bitmask_kpts(i,1,k) = ior(ref_bitmask_kpts(i,1,k),act_bitmask_kpts(i,1,k))
|
||||||
|
closed_shell_ref_bitmask_kpts(i,2,k) = ior(ref_bitmask_kpts(i,2,k),act_bitmask_kpts(i,2,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -214,6 +214,37 @@ subroutine print_spindet(string,Nint)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine debug_single_spindet(string,Nint)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Subroutine to print the content of a determinant in '+-' notation and
|
||||||
|
! hexadecimal representation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: string(Nint)
|
||||||
|
character*(2048) :: output(1)
|
||||||
|
call bitstring_to_hexa( output(1), string(1), Nint )
|
||||||
|
print *, trim(output(1))
|
||||||
|
call print_single_spindet(string,Nint)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine print_single_spindet(string,Nint)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Subroutine to print the content of a determinant using the '+-' notation
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: string(Nint)
|
||||||
|
character*(2048) :: output(1)
|
||||||
|
|
||||||
|
call bitstring_to_str( output(1), string(1), Nint )
|
||||||
|
print *, trim(output(1))
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
logical function is_integer_in_string(bite,string,Nint)
|
logical function is_integer_in_string(bite,string,Nint)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -413,3 +413,514 @@ END_PROVIDER
|
|||||||
print *, list_inact_act(1:n_inact_act_orb)
|
print *, list_inact_act(1:n_inact_act_orb)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), kpts_bitmask , (N_int,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying each kpt
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i,di
|
||||||
|
integer :: tmp_mo_list(mo_num_per_kpt)
|
||||||
|
kpts_bitmask = 0_bit_kind
|
||||||
|
print*,'kpts bitmask'
|
||||||
|
do k=1,kpt_num
|
||||||
|
di=(k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
tmp_mo_list(i) = i+di
|
||||||
|
enddo
|
||||||
|
call list_to_bitstring( kpts_bitmask(1,k), tmp_mo_list, mo_num_per_kpt, N_int)
|
||||||
|
!debugging
|
||||||
|
print*,'k = ',k
|
||||||
|
call debug_single_spindet(kpts_bitmask(1,k),N_int)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_core_orb_kpts, (kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of core MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,kshift
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_core_orb_kpts(k) = 0
|
||||||
|
kshift = (1-k)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+kshift) == 'Core')then
|
||||||
|
n_core_orb_kpts(k) += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call write_int(6,n_core_orb, 'Number of core MOs')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_inact_orb_kpts, (kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of inactive MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,kshift
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_inact_orb_kpts(k) = 0
|
||||||
|
kshift = (1-k)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+kshift) == 'Inactive')then
|
||||||
|
n_inact_orb_kpts(k) += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call write_int(6,n_inact_orb, 'Number of inactive MOs')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_act_orb_kpts, (kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of active MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,kshift
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_act_orb_kpts(k) = 0
|
||||||
|
kshift = (1-k)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+kshift) == 'Active')then
|
||||||
|
n_act_orb_kpts(k) += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call write_int(6,n_act_orb, 'Number of active MOs')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_virt_orb_kpts, (kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of virtual MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,kshift
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_virt_orb_kpts(k) = 0
|
||||||
|
kshift = (1-k)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+kshift) == 'Virtual')then
|
||||||
|
n_virt_orb_kpts(k) += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call write_int(6,n_virt_orb, 'Number of virtual MOs')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_del_orb_kpts, (kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of deleted MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k,kshift
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_del_orb_kpts(k) = 0
|
||||||
|
kshift = (1-k)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+kshift) == 'Deleted')then
|
||||||
|
n_del_orb_kpts(k) += 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! call write_int(6,n_del_orb, 'Number of deleted MOs')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, n_core_inact_orb_kpts, (kpt_num) ]
|
||||||
|
!todo: finish implementation for kpts (will need kpts_bitmask)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! n_core + n_inact
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_core_inact_orb_kpts(k) = 0
|
||||||
|
do i = 1, N_int
|
||||||
|
n_core_inact_orb_kpts(k) += popcnt(iand(kpts_bitmask(i,k),reunion_of_core_inact_bitmask(i,1)))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, n_inact_act_orb_kpts, (kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! n_inact + n_act
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_inact_act_orb_kpts(k) = (n_inact_orb_kpts(k)+n_act_orb_kpts(k))
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_core_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_core.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_core_orb_kpts = max(maxval(n_core_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_inact_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_inact.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_inact_orb_kpts = max(maxval(n_inact_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_core_inact_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_core.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_core_inact_orb_kpts = max(maxval(n_core_inact_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_act_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_act.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_act_orb_kpts = max(maxval(n_act_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_virt_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_virt.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_virt_orb_kpts = max(maxval(n_virt_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_del_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_del.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_del_orb_kpts = max(maxval(n_del_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_core_inact_act_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_core_inact_act.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_core_inact_act_orb_kpts = max(maxval(n_core_inact_act_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, dim_list_inact_act_orb_kpts]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! dimensions for the allocation of list_inact_act.
|
||||||
|
! it is at least 1
|
||||||
|
END_DOC
|
||||||
|
dim_list_inact_act_orb_kpts = max(maxval(n_inact_act_orb_kpts),1)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer, n_core_inact_act_orb_kpts, (kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Number of core inactive and active MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
n_core_inact_act_orb_kpts(k) = (n_core_orb_kpts(k) + n_inact_orb_kpts(k) + n_act_orb_kpts(k))
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), core_bitmask_kpts , (N_int,2,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying the core MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i
|
||||||
|
core_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
core_bitmask_kpts(i,1,k) = iand(core_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
core_bitmask_kpts(i,2,k) = iand(core_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), inact_bitmask_kpts , (N_int,2,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying the inactive MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i
|
||||||
|
inact_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
inact_bitmask_kpts(i,1,k) = iand(inact_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
inact_bitmask_kpts(i,2,k) = iand(inact_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), act_bitmask_kpts , (N_int,2,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying the active MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i
|
||||||
|
act_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
act_bitmask_kpts(i,1,k) = iand(act_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
act_bitmask_kpts(i,2,k) = iand(act_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), virt_bitmask_kpts , (N_int,2,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying the virtual MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i
|
||||||
|
virt_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
virt_bitmask_kpts(i,1,k) = iand(virt_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
virt_bitmask_kpts(i,2,k) = iand(virt_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), del_bitmask_kpts , (N_int,2,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Bitmask identifying the deleted MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: k,i
|
||||||
|
del_bitmask_kpts = 0_bit_kind
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,N_int
|
||||||
|
del_bitmask_kpts(i,1,k) = iand(del_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
del_bitmask_kpts(i,2,k) = iand(del_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_core_kpts , (dim_list_core_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_core_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of MO indices which are in the core.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, n,k,di
|
||||||
|
list_core_kpts = 0
|
||||||
|
list_core_kpts_reverse = 0
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n=0
|
||||||
|
di = (k-1)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+di) == 'Core')then
|
||||||
|
n += 1
|
||||||
|
list_core_kpts(n,k) = i
|
||||||
|
list_core_kpts_reverse(i,k) = n
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print *, 'Core MOs: ',k
|
||||||
|
print *, list_core_kpts(1:n_core_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_inact_kpts , (dim_list_inact_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_inact_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of MO indices which are inactive.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, n,k,di
|
||||||
|
list_inact_kpts = 0
|
||||||
|
list_inact_kpts_reverse = 0
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n=0
|
||||||
|
di = (k-1)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+di) == 'Inactive')then
|
||||||
|
n += 1
|
||||||
|
list_inact_kpts(n,k) = i
|
||||||
|
list_inact_kpts_reverse(i,k) = n
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print *, 'Inactive MOs: ',k
|
||||||
|
print *, list_inact_kpts(1:n_inact_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_virt_kpts , (dim_list_virt_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_virt_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of MO indices which are virtual.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, n,k,di
|
||||||
|
list_virt_kpts = 0
|
||||||
|
list_virt_kpts_reverse = 0
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n=0
|
||||||
|
di = (k-1)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+di) == 'Virtual')then
|
||||||
|
n += 1
|
||||||
|
list_virt_kpts(n,k) = i
|
||||||
|
list_virt_kpts_reverse(i,k) = n
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print *, 'Virtual MOs: ',k
|
||||||
|
print *, list_virt_kpts(1:n_virt_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_del_kpts , (dim_list_del_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_del_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of MO indices which are deleted.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, n,k,di
|
||||||
|
list_del_kpts = 0
|
||||||
|
list_del_kpts_reverse = 0
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n=0
|
||||||
|
di = (k-1)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+di) == 'Deleted')then
|
||||||
|
n += 1
|
||||||
|
list_del_kpts(n,k) = i
|
||||||
|
list_del_kpts_reverse(i,k) = n
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print *, 'Deleted MOs: ',k
|
||||||
|
print *, list_del_kpts(1:n_del_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_act_kpts , (dim_list_act_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of MO indices which are active.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, n,k,di
|
||||||
|
list_act_kpts = 0
|
||||||
|
list_act_kpts_reverse = 0
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
n=0
|
||||||
|
di = (k-1)*mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
if(mo_class(i+di) == 'Active')then
|
||||||
|
n += 1
|
||||||
|
list_act_kpts(n,k) = i
|
||||||
|
list_act_kpts_reverse(i,k) = n
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
print *, 'Active MOs: ',k
|
||||||
|
print *, list_act_kpts(1:n_act_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!todo: finish below for kpts
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_core_inact_kpts , (dim_list_core_inact_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_core_inact_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of indices of the core and inactive MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,itmp,k
|
||||||
|
list_core_inact_kpts_reverse = 0
|
||||||
|
do k=1,kpt_num
|
||||||
|
!call bitstring_to_list(reunion_of_core_inact_bitmask(1,1), list_core_inact, itmp, N_int)
|
||||||
|
call bitstring_to_list(reunion_of_core_inact_bitmask_kpts(1,1,k), list_core_inact_kpts(1,k), itmp, N_int)
|
||||||
|
ASSERT (itmp == n_core_inact_orb_kpts(k))
|
||||||
|
do i = 1, n_core_inact_orb_kpts(k)
|
||||||
|
list_core_inact_kpts_reverse(list_core_inact_kpts(i,k),k) = i
|
||||||
|
enddo
|
||||||
|
print *, 'Core and Inactive MOs: ',k
|
||||||
|
print *, list_core_inact_kpts(1:n_core_inact_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_core_inact_act_kpts , (dim_list_core_inact_act_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_core_inact_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of indices of the core inactive and active MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,itmp,k
|
||||||
|
list_core_inact_act_kpts_reverse = 0
|
||||||
|
do k=1,kpt_num
|
||||||
|
!call bitstring_to_list(reunion_of_core_inact_act_bitmask(1,1), list_core_inact_act, itmp, N_int)
|
||||||
|
call bitstring_to_list(reunion_of_core_inact_act_bitmask_kpts(1,1,k), list_core_inact_act_kpts(1,k), itmp, N_int)
|
||||||
|
ASSERT (itmp == n_core_inact_act_orb_kpts(k))
|
||||||
|
do i = 1, n_core_inact_act_orb_kpts(k)
|
||||||
|
list_core_inact_act_kpts_reverse(list_core_inact_act_kpts(i,k),k) = i
|
||||||
|
enddo
|
||||||
|
print *, 'Core, Inactive and Active MOs: ',k
|
||||||
|
print *, list_core_inact_act_kpts(1:n_core_inact_act_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, list_inact_act_kpts , (dim_list_inact_act_orb_kpts,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, list_inact_act_kpts_reverse, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! List of indices of the inactive and active MOs
|
||||||
|
END_DOC
|
||||||
|
integer :: i,itmp,k
|
||||||
|
list_inact_act_kpts_reverse = 0
|
||||||
|
do k=1,kpt_num
|
||||||
|
call bitstring_to_list(reunion_of_inact_act_bitmask_kpts(1,1,k), list_inact_act_kpts(1,k), itmp, N_int)
|
||||||
|
ASSERT (itmp == n_inact_act_orb_kpts(k))
|
||||||
|
do i = 1, n_inact_act_orb_kpts(k)
|
||||||
|
list_inact_act_kpts_reverse(list_inact_act_kpts(i,k),k) = i
|
||||||
|
enddo
|
||||||
|
print *, 'Inactive and Active MOs: ',k
|
||||||
|
print *, list_inact_act_kpts(1:n_inact_act_orb_kpts(k),k)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
154
src/bitmask/track_orb.irp.f
Normal file
154
src/bitmask/track_orb.irp.f
Normal file
@ -0,0 +1,154 @@
|
|||||||
|
BEGIN_PROVIDER [ double precision, mo_coef_begin_iteration, (ao_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration
|
||||||
|
!
|
||||||
|
! Useful to track some orbitals
|
||||||
|
END_DOC
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_begin_iteration_complex, (ao_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration
|
||||||
|
!
|
||||||
|
! Useful to track some orbitals
|
||||||
|
END_DOC
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_begin_iteration_kpts, (ao_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration
|
||||||
|
!
|
||||||
|
! Useful to track some orbitals
|
||||||
|
END_DOC
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine initialize_mo_coef_begin_iteration
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef`
|
||||||
|
END_DOC
|
||||||
|
if (is_complex) then
|
||||||
|
!mo_coef_begin_iteration_complex = mo_coef_complex
|
||||||
|
mo_coef_begin_iteration_kpts = mo_coef_kpts
|
||||||
|
else
|
||||||
|
mo_coef_begin_iteration = mo_coef
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine reorder_core_orb
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! TODO: test for complex
|
||||||
|
! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration`
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,iorb
|
||||||
|
integer :: k,l
|
||||||
|
integer, allocatable :: index_core_orb(:),iorder(:)
|
||||||
|
double precision, allocatable :: accu(:)
|
||||||
|
integer :: i1,i2
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16, allocatable :: accu_c(:)
|
||||||
|
!allocate(accu(mo_num),accu_c(mo_num),index_core_orb(n_core_orb),iorder(mo_num))
|
||||||
|
!do i = 1, n_core_orb
|
||||||
|
! iorb = list_core(i)
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! accu(j) = 0.d0
|
||||||
|
! accu_c(j) = (0.d0,0.d0)
|
||||||
|
! iorder(j) = j
|
||||||
|
! do k = 1, ao_num
|
||||||
|
! do l = 1, ao_num
|
||||||
|
! accu_c(j) += dconjg(mo_coef_begin_iteration_complex(k,iorb)) * &
|
||||||
|
! mo_coef_complex(l,j) * ao_overlap_complex(k,l)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! accu(j) = -cdabs(accu_c(j))
|
||||||
|
! enddo
|
||||||
|
! call dsort(accu,iorder,mo_num)
|
||||||
|
! index_core_orb(i) = iorder(1)
|
||||||
|
!enddo
|
||||||
|
|
||||||
|
!complex*16 :: x_c
|
||||||
|
!do j = 1, n_core_orb
|
||||||
|
! i1 = list_core(j)
|
||||||
|
! i2 = index_core_orb(j)
|
||||||
|
! do i=1,ao_num
|
||||||
|
! x_c = mo_coef_complex(i,i1)
|
||||||
|
! mo_coef_complex(i,i1) = mo_coef_complex(i,i2)
|
||||||
|
! mo_coef_complex(i,i2) = x_c
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
!!call loc_cele_routine
|
||||||
|
|
||||||
|
!deallocate(accu,accu_c,index_core_orb, iorder)
|
||||||
|
allocate(accu(mo_num_per_kpt),accu_c(mo_num_per_kpt),index_core_orb(n_core_orb),iorder(mo_num_per_kpt))
|
||||||
|
integer :: kk
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do i = 1, n_core_orb_kpts(kk)
|
||||||
|
iorb = list_core_kpts(i,kk)
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
accu(j) = 0.d0
|
||||||
|
accu_c(j) = (0.d0,0.d0)
|
||||||
|
iorder(j) = j
|
||||||
|
do k = 1, ao_num_per_kpt
|
||||||
|
do l = 1, ao_num_per_kpt
|
||||||
|
accu_c(j) += dconjg(mo_coef_begin_iteration_kpts(k,iorb,kk)) * &
|
||||||
|
mo_coef_kpts(l,j,kk) * ao_overlap_kpts(k,l,kk)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
accu(j) = -cdabs(accu_c(j))
|
||||||
|
enddo
|
||||||
|
call dsort(accu,iorder,mo_num_per_kpt)
|
||||||
|
index_core_orb(i) = iorder(1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
complex*16 :: x_c
|
||||||
|
do j = 1, n_core_orb
|
||||||
|
i1 = list_core_kpts(j,kk)
|
||||||
|
i2 = index_core_orb(j)
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
x_c = mo_coef_kpts(i,i1,kk)
|
||||||
|
mo_coef_kpts(i,i1,kk) = mo_coef_kpts(i,i2,kk)
|
||||||
|
mo_coef_kpts(i,i2,kk) = x_c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!call loc_cele_routine
|
||||||
|
enddo
|
||||||
|
deallocate(accu,accu_c,index_core_orb, iorder)
|
||||||
|
else
|
||||||
|
allocate(accu(mo_num),index_core_orb(n_core_orb),iorder(mo_num))
|
||||||
|
|
||||||
|
do i = 1, n_core_orb
|
||||||
|
iorb = list_core(i)
|
||||||
|
do j = 1, mo_num
|
||||||
|
accu(j) = 0.d0
|
||||||
|
iorder(j) = j
|
||||||
|
do k = 1, ao_num
|
||||||
|
do l = 1, ao_num
|
||||||
|
accu(j) += mo_coef_begin_iteration(k,iorb) * mo_coef(l,j) * ao_overlap(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
accu(j) = -dabs(accu(j))
|
||||||
|
enddo
|
||||||
|
call dsort(accu,iorder,mo_num)
|
||||||
|
index_core_orb(i) = iorder(1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
double precision :: x
|
||||||
|
do j = 1, n_core_orb
|
||||||
|
i1 = list_core(j)
|
||||||
|
i2 = index_core_orb(j)
|
||||||
|
do i=1,ao_num
|
||||||
|
x = mo_coef(i,i1)
|
||||||
|
mo_coef(i,i1) = mo_coef(i,i2)
|
||||||
|
mo_coef(i,i2) = x
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!call loc_cele_routine
|
||||||
|
|
||||||
|
deallocate(accu,index_core_orb, iorder)
|
||||||
|
endif
|
||||||
|
end
|
@ -20,7 +20,7 @@ subroutine run_cipsi
|
|||||||
logical :: has
|
logical :: has
|
||||||
double precision :: relative_error
|
double precision :: relative_error
|
||||||
|
|
||||||
PROVIDE H_apply_buffer_allocated
|
PROVIDE h_apply_buffer_allocated
|
||||||
|
|
||||||
relative_error=PT2_relative_error
|
relative_error=PT2_relative_error
|
||||||
|
|
||||||
@ -33,25 +33,39 @@ subroutine run_cipsi
|
|||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
call make_s2_eigenfunction
|
call make_s2_eigenfunction
|
||||||
endif
|
endif
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
|
|
||||||
call ezfio_has_hartree_fock_energy(has)
|
call ezfio_has_hartree_fock_energy(has)
|
||||||
if (has) then
|
if (has) then
|
||||||
call ezfio_get_hartree_fock_energy(hf_energy_ref)
|
call ezfio_get_hartree_fock_energy(hf_energy_ref)
|
||||||
else
|
else
|
||||||
hf_energy_ref = ref_bitmask_energy
|
hf_energy_ref = ref_bitmask_energy_with_nucl_rep
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (N_det > N_det_max) then
|
if (N_det > N_det_max) then
|
||||||
psi_det = psi_det_sorted
|
psi_det = psi_det_sorted
|
||||||
|
if (is_complex) then
|
||||||
|
psi_coef_complex = psi_coef_sorted_complex
|
||||||
|
N_det = N_det_max
|
||||||
|
soft_touch N_det psi_det psi_coef_complex
|
||||||
|
else
|
||||||
psi_coef = psi_coef_sorted
|
psi_coef = psi_coef_sorted
|
||||||
N_det = N_det_max
|
N_det = N_det_max
|
||||||
soft_touch N_det psi_det psi_coef
|
soft_touch N_det psi_det psi_coef
|
||||||
|
endif
|
||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
call make_s2_eigenfunction
|
call make_s2_eigenfunction
|
||||||
endif
|
endif
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_CI_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -80,8 +94,13 @@ subroutine run_cipsi
|
|||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
threshold_generators = 1.d0
|
threshold_generators = 1.d0
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
! if (is_complex) then
|
||||||
|
! call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||||
|
! norm, 0) ! Stochastic PT2
|
||||||
|
! else
|
||||||
|
call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||||
norm, 0) ! Stochastic PT2
|
norm, 0) ! Stochastic PT2
|
||||||
|
! endif
|
||||||
threshold_generators = threshold_generators_save
|
threshold_generators = threshold_generators_save
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
endif
|
endif
|
||||||
@ -108,13 +127,22 @@ subroutine run_cipsi
|
|||||||
n_det_before = N_det
|
n_det_before = N_det
|
||||||
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
to_select = int(sqrt(dble(N_states))*dble(N_det)*selection_factor)
|
||||||
to_select = max(N_states_diag, to_select)
|
to_select = max(N_states_diag, to_select)
|
||||||
call ZMQ_selection(to_select, pt2, variance, norm)
|
call zmq_selection(to_select, pt2, variance, norm)
|
||||||
|
if (is_complex) then
|
||||||
|
! call zmq_selection_complex(to_select, pt2, variance, norm)
|
||||||
|
PROVIDE psi_coef_complex
|
||||||
|
else
|
||||||
|
! call zmq_selection(to_select, pt2, variance, norm)
|
||||||
PROVIDE psi_coef
|
PROVIDE psi_coef
|
||||||
|
endif
|
||||||
PROVIDE psi_det
|
PROVIDE psi_det
|
||||||
PROVIDE psi_det_sorted
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||||
if (qp_stop()) exit
|
if (qp_stop()) exit
|
||||||
@ -126,7 +154,11 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max)
|
|||||||
|
|
||||||
if (.not.qp_stop()) then
|
if (.not.qp_stop()) then
|
||||||
if (N_det < N_det_max) then
|
if (N_det < N_det_max) then
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||||
endif
|
endif
|
||||||
@ -137,8 +169,13 @@ print *, (correlation_energy_ratio <= correlation_energy_ratio_max)
|
|||||||
norm(:) = 0.d0
|
norm(:) = 0.d0
|
||||||
threshold_generators = 1d0
|
threshold_generators = 1d0
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
|
! if (is_complex) then
|
||||||
|
! call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||||
|
! norm,0) ! Stochastic PT2
|
||||||
|
! else
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||||
norm,0) ! Stochastic PT2
|
norm,0) ! Stochastic PT2
|
||||||
|
! endif
|
||||||
SOFT_TOUCH threshold_generators
|
SOFT_TOUCH threshold_generators
|
||||||
endif
|
endif
|
||||||
print *, 'N_det = ', N_det
|
print *, 'N_det = ', N_det
|
||||||
|
@ -17,7 +17,11 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ]
|
|||||||
pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
|
pt2_E0_denominator(1:N_states) = psi_energy(1:N_states)
|
||||||
else if (h0_type == "HF") then
|
else if (h0_type == "HF") then
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
|
if (is_complex) then
|
||||||
|
j = maxloc(cdabs(psi_coef_complex(:,i)),1)
|
||||||
|
else
|
||||||
j = maxloc(abs(psi_coef(:,i)),1)
|
j = maxloc(abs(psi_coef(:,i)),1)
|
||||||
|
endif
|
||||||
pt2_E0_denominator(i) = psi_det_hii(j)
|
pt2_E0_denominator(i) = psi_det_hii(j)
|
||||||
enddo
|
enddo
|
||||||
else if (h0_type == "Barycentric") then
|
else if (h0_type == "Barycentric") then
|
||||||
|
@ -63,11 +63,19 @@ logical function testTeethBuilding(minF, N)
|
|||||||
|
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
double precision :: norm
|
double precision :: norm
|
||||||
|
if (is_complex) then
|
||||||
|
do i=N_det_generators,1,-1
|
||||||
|
tilde_w(i) = cdabs(psi_coef_sorted_gen_complex(i,pt2_stoch_istate) * &
|
||||||
|
psi_coef_sorted_gen_complex(i,pt2_stoch_istate))
|
||||||
|
norm = norm + tilde_w(i)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=N_det_generators,1,-1
|
do i=N_det_generators,1,-1
|
||||||
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * &
|
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate) * &
|
||||||
psi_coef_sorted_gen(i,pt2_stoch_istate)
|
psi_coef_sorted_gen(i,pt2_stoch_istate)
|
||||||
norm = norm + tilde_w(i)
|
norm = norm + tilde_w(i)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
f = 1.d0/norm
|
f = 1.d0/norm
|
||||||
tilde_w(:) = tilde_w(:) * f
|
tilde_w(:) = tilde_w(:) * f
|
||||||
@ -115,6 +123,7 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
|||||||
|
|
||||||
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||||
integer, intent(in) :: N_in
|
integer, intent(in) :: N_in
|
||||||
|
! integer, intent(inout) :: N_in
|
||||||
double precision, intent(in) :: relative_error, E(N_states)
|
double precision, intent(in) :: relative_error, E(N_states)
|
||||||
double precision, intent(out) :: pt2(N_states),error(N_states)
|
double precision, intent(out) :: pt2(N_states),error(N_states)
|
||||||
double precision, intent(out) :: variance(N_states),norm(N_states)
|
double precision, intent(out) :: variance(N_states),norm(N_states)
|
||||||
@ -126,21 +135,29 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
|||||||
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
integer(ZMQ_PTR), external :: new_zmq_to_qp_run_socket
|
||||||
type(selection_buffer) :: b
|
type(selection_buffer) :: b
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp_complex psi_det_sorted
|
||||||
|
PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||||
|
else
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted
|
PROVIDE psi_bilinear_matrix_transp_order psi_selectors_coef_transp psi_det_sorted
|
||||||
PROVIDE psi_det_hii selection_weight pseudo_sym
|
PROVIDE psi_det_hii selection_weight pseudo_sym
|
||||||
|
endif
|
||||||
|
|
||||||
if (h0_type == 'SOP') then
|
if (h0_type == 'SOP') then
|
||||||
PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
PROVIDE psi_occ_pattern_hii det_to_occ_pattern
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (N_det <= max(4,N_states)) then
|
if (N_det <= max(4,N_states) .or. pt2_N_teeth < 2) then
|
||||||
pt2=0.d0
|
pt2=0.d0
|
||||||
variance=0.d0
|
variance=0.d0
|
||||||
norm=0.d0
|
norm=0.d0
|
||||||
call ZMQ_selection(N_in, pt2, variance, norm)
|
call zmq_selection(N_in, pt2, variance, norm)
|
||||||
error(:) = 0.d0
|
error(:) = 0.d0
|
||||||
else
|
else
|
||||||
|
|
||||||
@ -159,8 +176,16 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
|||||||
state_average_weight(pt2_stoch_istate) = 1.d0
|
state_average_weight(pt2_stoch_istate) = 1.d0
|
||||||
TOUCH state_average_weight pt2_stoch_istate selection_weight
|
TOUCH state_average_weight pt2_stoch_istate selection_weight
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
!todo: psi_selectors isn't linked to psi_selectors_coef anymore; should we provide both?
|
||||||
|
!PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_complex pt2_w
|
||||||
|
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals_kpts pt2_w
|
||||||
|
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
||||||
|
else
|
||||||
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
|
PROVIDE nproc pt2_F mo_two_e_integrals_in_map mo_one_e_integrals pt2_w
|
||||||
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
PROVIDE psi_selectors pt2_u pt2_J pt2_R
|
||||||
|
endif
|
||||||
|
|
||||||
call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
call new_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'pt2')
|
||||||
|
|
||||||
integer, external :: zmq_put_psi
|
integer, external :: zmq_put_psi
|
||||||
@ -272,6 +297,10 @@ subroutine ZMQ_pt2(E, pt2,relative_error, error, variance, norm, N_in)
|
|||||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||||
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
||||||
) / 1024.d0**3
|
) / 1024.d0**3
|
||||||
|
if (is_complex) then
|
||||||
|
! mat is complex
|
||||||
|
mem = mem + (nproc_target*8.d0*(N_states*mo_num* mo_num)) / 1024.d0**3
|
||||||
|
endif
|
||||||
|
|
||||||
if (nproc_target == 0) then
|
if (nproc_target == 0) then
|
||||||
call check_mem(mem,irp_here)
|
call check_mem(mem,irp_here)
|
||||||
@ -752,9 +781,15 @@ END_PROVIDER
|
|||||||
|
|
||||||
tilde_cW(0) = 0d0
|
tilde_cW(0) = 0d0
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_det_generators
|
||||||
|
tilde_w(i) = cdabs(psi_coef_sorted_gen_complex(i,pt2_stoch_istate))**2 !+ 1.d-20
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,N_det_generators
|
do i=1,N_det_generators
|
||||||
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
|
tilde_w(i) = psi_coef_sorted_gen(i,pt2_stoch_istate)**2 !+ 1.d-20
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
double precision :: norm
|
double precision :: norm
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
@ -773,7 +808,7 @@ END_PROVIDER
|
|||||||
pt2_n_0(1) = 0
|
pt2_n_0(1) = 0
|
||||||
do
|
do
|
||||||
pt2_u_0 = tilde_cW(pt2_n_0(1))
|
pt2_u_0 = tilde_cW(pt2_n_0(1))
|
||||||
r = tilde_cW(pt2_n_0(1) + pt2_minDetInFirstTeeth)
|
r = tilde_cW(pt2_n_0(1) + pt2_mindetinfirstteeth)
|
||||||
pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth)
|
pt2_W_T = (1d0 - pt2_u_0) / dble(pt2_N_teeth)
|
||||||
if(pt2_W_T >= r - pt2_u_0) then
|
if(pt2_W_T >= r - pt2_u_0) then
|
||||||
exit
|
exit
|
||||||
@ -799,7 +834,7 @@ END_PROVIDER
|
|||||||
endif
|
endif
|
||||||
ASSERT(tooth_width > 0.d0)
|
ASSERT(tooth_width > 0.d0)
|
||||||
do i=pt2_n_0(t)+1, pt2_n_0(t+1)
|
do i=pt2_n_0(t)+1, pt2_n_0(t+1)
|
||||||
pt2_w(i) = tilde_w(i) * pt2_W_T / tooth_width
|
pt2_w(i) = tilde_w(i) * pt2_w_t / tooth_width
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
|
||||||
@ -813,6 +848,3 @@ END_PROVIDER
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -22,11 +22,16 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
double precision :: variance(N_states)
|
double precision :: variance(N_states)
|
||||||
double precision :: norm(N_states)
|
double precision :: norm(N_states)
|
||||||
|
|
||||||
|
!todo: check for providers that are now unlinked for real/complex
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
PROVIDE psi_bilinear_matrix_transp_rows_loc psi_bilinear_matrix_transp_columns
|
||||||
PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym
|
PROVIDE psi_bilinear_matrix_transp_order N_int pt2_F pseudo_sym
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_selectors_coef_transp_complex psi_det_sorted weight_selection
|
||||||
|
else
|
||||||
PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection
|
PROVIDE psi_selectors_coef_transp psi_det_sorted weight_selection
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
@ -99,6 +104,17 @@ subroutine run_selection_slave(thread,iproc,energy)
|
|||||||
ctask = ctask + 1
|
ctask = ctask + 1
|
||||||
end do
|
end do
|
||||||
|
|
||||||
|
if(ctask > 0) then
|
||||||
|
call sort_selection_buffer(buf)
|
||||||
|
! call merge_selection_buffers(buf,buf2)
|
||||||
|
call push_selection_results(zmq_socket_push, pt2, variance, norm, buf, task_id(1), ctask)
|
||||||
|
! buf%mini = buf2%mini
|
||||||
|
pt2(:) = 0d0
|
||||||
|
variance(:) = 0d0
|
||||||
|
norm(:) = 0d0
|
||||||
|
buf%cur = 0
|
||||||
|
end if
|
||||||
|
ctask = 0
|
||||||
|
|
||||||
integer, external :: disconnect_from_taskserver
|
integer, external :: disconnect_from_taskserver
|
||||||
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -14,10 +14,17 @@ subroutine run_slave_cipsi
|
|||||||
end
|
end
|
||||||
|
|
||||||
subroutine provide_everything
|
subroutine provide_everything
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
|
||||||
|
PROVIDE pt2_e0_denominator mo_num_per_kpt N_int ci_energy mpi_master zmq_state zmq_context
|
||||||
|
PROVIDE psi_det psi_coef_complex threshold_generators state_average_weight
|
||||||
|
PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym
|
||||||
|
else
|
||||||
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
|
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators psi_det_sorted_bit psi_selectors n_det_generators n_states generators_bitmask zmq_context N_states_diag
|
||||||
PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
|
PROVIDE pt2_e0_denominator mo_num N_int ci_energy mpi_master zmq_state zmq_context
|
||||||
PROVIDE psi_det psi_coef threshold_generators state_average_weight
|
PROVIDE psi_det psi_coef threshold_generators state_average_weight
|
||||||
PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym
|
PROVIDE N_det_selectors pt2_stoch_istate N_det selection_weight pseudo_sym
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine run_slave_main
|
subroutine run_slave_main
|
||||||
@ -51,9 +58,15 @@ subroutine run_slave_main
|
|||||||
|
|
||||||
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_det psi_coef_complex threshold_generators state_average_weight mpi_master
|
||||||
|
PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator
|
||||||
|
PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank
|
||||||
|
else
|
||||||
PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master
|
PROVIDE psi_det psi_coef threshold_generators state_average_weight mpi_master
|
||||||
PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator
|
PROVIDE zmq_state N_det_selectors pt2_stoch_istate N_det pt2_e0_denominator
|
||||||
PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank
|
PROVIDE N_det_generators N_states N_states_diag pt2_e0_denominator mpi_rank
|
||||||
|
endif
|
||||||
|
|
||||||
IRP_IF MPI
|
IRP_IF MPI
|
||||||
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
@ -268,6 +281,10 @@ subroutine run_slave_main
|
|||||||
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
+ 2.0d0*(N_int*2*ii) & ! minilist, fullminilist
|
||||||
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
+ 1.0d0*(N_states*mo_num*mo_num) & ! mat
|
||||||
) / 1024.d0**3
|
) / 1024.d0**3
|
||||||
|
if (is_complex) then
|
||||||
|
! mat is complex
|
||||||
|
mem = mem + (nproc_target * 8.d0 * (n_states*mo_num*mo_num)) / 1024.d0**3
|
||||||
|
endif
|
||||||
|
|
||||||
if (nproc_target == 0) then
|
if (nproc_target == 0) then
|
||||||
call check_mem(mem,irp_here)
|
call check_mem(mem,irp_here)
|
||||||
|
@ -36,25 +36,39 @@ subroutine run_stochastic_cipsi
|
|||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
call make_s2_eigenfunction
|
call make_s2_eigenfunction
|
||||||
endif
|
endif
|
||||||
call diagonalize_CI
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
|
call diagonalize_ci
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
|
|
||||||
call ezfio_has_hartree_fock_energy(has)
|
call ezfio_has_hartree_fock_energy(has)
|
||||||
if (has) then
|
if (has) then
|
||||||
call ezfio_get_hartree_fock_energy(hf_energy_ref)
|
call ezfio_get_hartree_fock_energy(hf_energy_ref)
|
||||||
else
|
else
|
||||||
hf_energy_ref = ref_bitmask_energy
|
hf_energy_ref = ref_bitmask_energy_with_nucl_rep
|
||||||
endif
|
endif
|
||||||
|
|
||||||
if (N_det > N_det_max) then
|
if (N_det > N_det_max) then
|
||||||
psi_det = psi_det_sorted
|
psi_det = psi_det_sorted
|
||||||
|
if (is_complex) then
|
||||||
|
psi_coef_complex = psi_coef_sorted_complex
|
||||||
|
N_det = N_det_max
|
||||||
|
soft_touch N_det psi_det psi_coef_complex
|
||||||
|
else
|
||||||
psi_coef = psi_coef_sorted
|
psi_coef = psi_coef_sorted
|
||||||
N_det = N_det_max
|
N_det = N_det_max
|
||||||
soft_touch N_det psi_det psi_coef
|
soft_touch N_det psi_det psi_coef
|
||||||
|
endif
|
||||||
if (s2_eig) then
|
if (s2_eig) then
|
||||||
call make_s2_eigenfunction
|
call make_s2_eigenfunction
|
||||||
endif
|
endif
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@ -78,8 +92,13 @@ subroutine run_stochastic_cipsi
|
|||||||
pt2 = 0.d0
|
pt2 = 0.d0
|
||||||
variance = 0.d0
|
variance = 0.d0
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
! if (is_complex) then
|
||||||
|
! call zmq_pt2_complex(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||||
|
! norm, to_select) ! Stochastic PT2 and selection
|
||||||
|
! else
|
||||||
|
call zmq_pt2(psi_energy_with_nucl_rep,pt2,relative_error,error, variance, &
|
||||||
norm, to_select) ! Stochastic PT2 and selection
|
norm, to_select) ! Stochastic PT2 and selection
|
||||||
|
! endif
|
||||||
|
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
rpt2(k) = pt2(k)/(1.d0 + norm(k))
|
rpt2(k) = pt2(k)/(1.d0 + norm(k))
|
||||||
@ -91,6 +110,7 @@ subroutine run_stochastic_cipsi
|
|||||||
|
|
||||||
call write_double(6,correlation_energy_ratio, 'Correlation ratio')
|
call write_double(6,correlation_energy_ratio, 'Correlation ratio')
|
||||||
call print_summary(psi_energy_with_nucl_rep,pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2)
|
call print_summary(psi_energy_with_nucl_rep,pt2,error,variance,norm,N_det,N_occ_pattern,N_states,psi_s2)
|
||||||
|
!call print_debug_fci()
|
||||||
|
|
||||||
call save_energy(psi_energy_with_nucl_rep, rpt2)
|
call save_energy(psi_energy_with_nucl_rep, rpt2)
|
||||||
|
|
||||||
@ -101,14 +121,22 @@ subroutine run_stochastic_cipsi
|
|||||||
if (qp_stop()) exit
|
if (qp_stop()) exit
|
||||||
|
|
||||||
! Add selected determinants
|
! Add selected determinants
|
||||||
call copy_H_apply_buffer_to_wf()
|
call copy_h_apply_buffer_to_wf()
|
||||||
! call save_wavefunction
|
! call save_wavefunction
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_coef_complex
|
||||||
|
else
|
||||||
PROVIDE psi_coef
|
PROVIDE psi_coef
|
||||||
|
endif
|
||||||
PROVIDE psi_det
|
PROVIDE psi_det
|
||||||
PROVIDE psi_det_sorted
|
PROVIDE psi_det_sorted
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||||
if (qp_stop()) exit
|
if (qp_stop()) exit
|
||||||
@ -116,7 +144,11 @@ subroutine run_stochastic_cipsi
|
|||||||
|
|
||||||
if (.not.qp_stop()) then
|
if (.not.qp_stop()) then
|
||||||
if (N_det < N_det_max) then
|
if (N_det < N_det_max) then
|
||||||
|
if (is_complex) then
|
||||||
|
call diagonalize_ci_complex
|
||||||
|
else
|
||||||
call diagonalize_CI
|
call diagonalize_CI
|
||||||
|
endif
|
||||||
call save_wavefunction
|
call save_wavefunction
|
||||||
call save_energy(psi_energy_with_nucl_rep, zeros)
|
call save_energy(psi_energy_with_nucl_rep, zeros)
|
||||||
endif
|
endif
|
||||||
@ -124,8 +156,13 @@ subroutine run_stochastic_cipsi
|
|||||||
pt2(:) = 0.d0
|
pt2(:) = 0.d0
|
||||||
variance(:) = 0.d0
|
variance(:) = 0.d0
|
||||||
norm(:) = 0.d0
|
norm(:) = 0.d0
|
||||||
|
! if (is_complex) then
|
||||||
|
! call zmq_pt2_complex(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||||
|
! norm,0) ! Stochastic PT2
|
||||||
|
! else
|
||||||
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
call ZMQ_pt2(psi_energy_with_nucl_rep, pt2,relative_error,error,variance, &
|
||||||
norm,0) ! Stochastic PT2
|
norm,0) ! Stochastic PT2
|
||||||
|
! endif
|
||||||
|
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
rpt2(k) = pt2(k)/(1.d0 + norm(k))
|
rpt2(k) = pt2(k)/(1.d0 + norm(k))
|
||||||
|
@ -17,6 +17,7 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
|
|||||||
|
|
||||||
N = max(N_in,1)
|
N = max(N_in,1)
|
||||||
if (.True.) then
|
if (.True.) then
|
||||||
|
!todo: some providers have become unlinked for real/complex (det/coef); do these need to be provided?
|
||||||
PROVIDE pt2_e0_denominator nproc
|
PROVIDE pt2_e0_denominator nproc
|
||||||
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
PROVIDE psi_bilinear_matrix_columns_loc psi_det_alpha_unique psi_det_beta_unique
|
||||||
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
PROVIDE psi_bilinear_matrix_rows psi_det_sorted_order psi_bilinear_matrix_order
|
||||||
@ -105,10 +106,17 @@ subroutine ZMQ_selection(N_in, pt2, variance, norm)
|
|||||||
f(:) = 1.d0
|
f(:) = 1.d0
|
||||||
if (.not.do_pt2) then
|
if (.not.do_pt2) then
|
||||||
double precision :: f(N_states), u_dot_u
|
double precision :: f(N_states), u_dot_u
|
||||||
|
if (is_complex) then
|
||||||
|
double precision :: u_dot_u_complex
|
||||||
|
do k=1,min(N_det,N_states)
|
||||||
|
f(k) = 1.d0 / u_dot_u_complex(psi_selectors_coef_complex(1,k), N_det_selectors)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k=1,min(N_det,N_states)
|
do k=1,min(N_det,N_states)
|
||||||
f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors)
|
f(k) = 1.d0 / u_dot_u(psi_selectors_coef(1,k), N_det_selectors)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1)
|
!$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2, variance, norm) PRIVATE(i) NUM_THREADS(nproc_target+1)
|
||||||
i = omp_get_thread_num()
|
i = omp_get_thread_num()
|
||||||
@ -224,3 +232,4 @@ subroutine selection_collector(zmq_socket_pull, b, N, pt2, variance, norm)
|
|||||||
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
@ -89,21 +89,97 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
character*(512) :: msg
|
character*(512) :: msg
|
||||||
integer :: imin, imax, ishift, istep
|
integer :: imin, imax, ishift, istep
|
||||||
|
|
||||||
integer, allocatable :: psi_det_read(:,:,:)
|
|
||||||
double precision, allocatable :: v_t(:,:), s_t(:,:), u_t(:,:)
|
|
||||||
|
|
||||||
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t, v_t, s_t
|
|
||||||
|
|
||||||
! Get wave function (u_t)
|
|
||||||
! -----------------------
|
|
||||||
|
|
||||||
integer :: rc, ni, nj
|
integer :: rc, ni, nj
|
||||||
integer*8 :: rc8
|
integer*8 :: rc8
|
||||||
integer :: N_states_read, N_det_read, psi_det_size_read
|
integer :: N_states_read, N_det_read, psi_det_size_read
|
||||||
integer :: N_det_selectors_read, N_det_generators_read
|
integer :: N_det_selectors_read, N_det_generators_read
|
||||||
|
|
||||||
integer, external :: zmq_get_dvector
|
integer, allocatable :: psi_det_read(:,:,:)
|
||||||
|
logical :: sending
|
||||||
|
integer, external :: get_task_from_taskserver
|
||||||
|
integer, external :: task_done_to_taskserver
|
||||||
|
integer :: k
|
||||||
|
integer :: ierr
|
||||||
|
|
||||||
|
|
||||||
|
! integer, external :: zmq_get_dvector
|
||||||
integer, external :: zmq_get_dmatrix
|
integer, external :: zmq_get_dmatrix
|
||||||
|
integer, external :: zmq_get_cdmatrix
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16, allocatable :: v_tc(:,:), s_tc(:,:), u_tc(:,:)
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_tc, v_tc, s_tc
|
||||||
|
|
||||||
|
|
||||||
|
! Get wave function (u_tc)
|
||||||
|
! -----------------------
|
||||||
|
|
||||||
|
PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_values_complex psi_bilinear_matrix_values_complex psi_bilinear_matrix_columns_loc
|
||||||
|
PROVIDE ref_bitmask_energy nproc
|
||||||
|
PROVIDE mpi_initialized
|
||||||
|
|
||||||
|
allocate(u_tc(N_st,N_det))
|
||||||
|
|
||||||
|
!todo: resize for complex? (should be okay)
|
||||||
|
! Warning : dimensions are modified for efficiency, It is OK since we get the
|
||||||
|
! full matrix
|
||||||
|
if (size(u_tc,kind=8) < 8388608_8) then
|
||||||
|
ni = size(u_tc)
|
||||||
|
nj = 1
|
||||||
|
else
|
||||||
|
ni = 8388608
|
||||||
|
nj = int(size(u_tc,kind=8)/8388608_8,4) + 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
do while (zmq_get_cdmatrix(zmq_to_qp_run_socket, worker_id, 'u_tc', u_tc, ni, nj, size(u_tc,kind=8)) == -1)
|
||||||
|
print *, 'mpi_rank, N_states_diag, N_det'
|
||||||
|
print *, mpi_rank, N_states_diag, N_det
|
||||||
|
stop 'u_tc'
|
||||||
|
enddo
|
||||||
|
|
||||||
|
IRP_IF MPI
|
||||||
|
! include 'mpif.h'
|
||||||
|
call broadcast_chunks_complex_double(u_tc,size(u_tc,kind=8))
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
! Run tasks
|
||||||
|
! ---------
|
||||||
|
|
||||||
|
sending=.False.
|
||||||
|
|
||||||
|
allocate(v_tc(N_st,N_det), s_tc(N_st,N_det))
|
||||||
|
do
|
||||||
|
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
if(task_id == 0) exit
|
||||||
|
read (msg,*) imin, imax, ishift, istep
|
||||||
|
do k=imin,imax
|
||||||
|
v_tc(:,k) = (0.d0,0.d0)
|
||||||
|
s_tc(:,k) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
call h_s2_u_0_nstates_openmp_work_complex(v_tc,s_tc,u_tc,N_st,N_det,imin,imax,ishift,istep)
|
||||||
|
if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
|
||||||
|
print *, irp_here, 'Unable to send task_done'
|
||||||
|
endif
|
||||||
|
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
||||||
|
call davidson_push_results_async_send_complex(zmq_socket_push, v_tc, s_tc, imin, imax, task_id, sending)
|
||||||
|
end do
|
||||||
|
deallocate(u_tc,v_tc, s_tc)
|
||||||
|
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
||||||
|
else
|
||||||
|
double precision, allocatable :: v_t(:,:), s_t(:,:), u_t(:,:)
|
||||||
|
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t, v_t, s_t
|
||||||
|
|
||||||
|
|
||||||
|
! Get wave function (u_t)
|
||||||
|
! -----------------------
|
||||||
|
|
||||||
PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique
|
PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique
|
||||||
PROVIDE psi_bilinear_matrix_transp_values psi_bilinear_matrix_values psi_bilinear_matrix_columns_loc
|
PROVIDE psi_bilinear_matrix_transp_values psi_bilinear_matrix_values psi_bilinear_matrix_columns_loc
|
||||||
@ -129,29 +205,22 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
IRP_IF MPI
|
IRP_IF MPI
|
||||||
include 'mpif.h'
|
!include 'mpif.h'
|
||||||
integer :: ierr
|
|
||||||
|
|
||||||
call broadcast_chunks_double(u_t,size(u_t,kind=8))
|
call broadcast_chunks_double(u_t,size(u_t,kind=8))
|
||||||
|
|
||||||
IRP_ENDIF
|
IRP_ENDIF
|
||||||
|
|
||||||
! Run tasks
|
! Run tasks
|
||||||
! ---------
|
! ---------
|
||||||
|
|
||||||
logical :: sending
|
|
||||||
sending=.False.
|
sending=.False.
|
||||||
|
|
||||||
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
||||||
do
|
do
|
||||||
integer, external :: get_task_from_taskserver
|
|
||||||
integer, external :: task_done_to_taskserver
|
|
||||||
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then
|
if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, msg) == -1) then
|
||||||
exit
|
exit
|
||||||
endif
|
endif
|
||||||
if(task_id == 0) exit
|
if(task_id == 0) exit
|
||||||
read (msg,*) imin, imax, ishift, istep
|
read (msg,*) imin, imax, ishift, istep
|
||||||
integer :: k
|
|
||||||
do k=imin,imax
|
do k=imin,imax
|
||||||
v_t(:,k) = 0.d0
|
v_t(:,k) = 0.d0
|
||||||
s_t(:,k) = 0.d0
|
s_t(:,k) = 0.d0
|
||||||
@ -165,7 +234,7 @@ subroutine davidson_slave_work(zmq_to_qp_run_socket, zmq_socket_push, N_st, sze,
|
|||||||
end do
|
end do
|
||||||
deallocate(u_t,v_t, s_t)
|
deallocate(u_t,v_t, s_t)
|
||||||
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
call davidson_push_results_async_recv(zmq_socket_push, sending)
|
||||||
|
endif
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
@ -533,6 +602,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,N_st,sze)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer, nthreads_davidson ]
|
BEGIN_PROVIDER [ integer, nthreads_davidson ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -643,3 +713,360 @@ integer function zmq_get_N_states_diag(zmq_to_qp_run_socket, worker_id)
|
|||||||
IRP_ENDIF
|
IRP_ENDIF
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
subroutine davidson_push_results_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push the results of $H | U \rangle$ from a worker to the master.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push
|
||||||
|
integer ,intent(in) :: task_id, imin, imax
|
||||||
|
complex*16 ,intent(in) :: v_t(N_states_diag,N_det)
|
||||||
|
complex*16 ,intent(in) :: s_t(N_states_diag,N_det)
|
||||||
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_complex failed to push task_id'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_complex failed to push imin'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_complex failed to push imax'
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE)
|
||||||
|
if(rc8 /= 8_8*sz*2) then
|
||||||
|
print*,irp_here,' rc8 = ',rc8
|
||||||
|
print*,irp_here,' sz = ',sz
|
||||||
|
print*,'rc8 /= sz*8'
|
||||||
|
stop 'davidson_push_results_complex failed to push vt'
|
||||||
|
endif
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
|
if(rc8 /= 8_8*sz*2) stop 'davidson_push_results_complex failed to push st'
|
||||||
|
|
||||||
|
! Activate is zmq_socket_push is a REQ
|
||||||
|
IRP_IF ZMQ_PUSH
|
||||||
|
IRP_ELSE
|
||||||
|
character*(2) :: ok
|
||||||
|
rc = f77_zmq_recv( zmq_socket_push, ok, 2, 0)
|
||||||
|
if ((rc /= 2).and.(ok(1:2)/='ok')) then
|
||||||
|
print *, irp_here, ': f77_zmq_recv( zmq_socket_push, ok, 2, 0)'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
subroutine davidson_push_results_async_send_complex(zmq_socket_push, v_t, s_t, imin, imax, task_id,sending)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Push the results of $H | U \rangle$ from a worker to the master.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) ,intent(in) :: zmq_socket_push
|
||||||
|
integer ,intent(in) :: task_id, imin, imax
|
||||||
|
complex*16 ,intent(in) :: v_t(N_states_diag,N_det)
|
||||||
|
complex*16 ,intent(in) :: s_t(N_states_diag,N_det)
|
||||||
|
logical ,intent(inout) :: sending
|
||||||
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
|
if (sending) then
|
||||||
|
print *, irp_here, ': sending=true'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
sending = .True.
|
||||||
|
|
||||||
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, task_id, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push task_id'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imin, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push imin'
|
||||||
|
|
||||||
|
rc = f77_zmq_send( zmq_socket_push, imax, 4, ZMQ_SNDMORE)
|
||||||
|
if(rc /= 4) stop 'davidson_push_results_async_send_complex failed to push imax'
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, v_t(1,imin), 8_8*sz*2, ZMQ_SNDMORE)
|
||||||
|
if(rc8 /= 8_8*sz*2) then
|
||||||
|
print*,irp_here,' rc8 = ',rc8
|
||||||
|
print*,irp_here,' sz = ',sz
|
||||||
|
print*,'rc8 /= sz*8'
|
||||||
|
stop 'davidson_push_results_async_send_complex failed to push vt'
|
||||||
|
endif
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_send8( zmq_socket_push, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
|
if(rc8 /= 8_8*sz*2) stop 'davidson_push_results_async_send_complex failed to push st'
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Pull the results of $H | U \rangle$ on the master.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR) ,intent(in) :: zmq_socket_pull
|
||||||
|
integer ,intent(out) :: task_id, imin, imax
|
||||||
|
complex*16 ,intent(out) :: v_t(N_states_diag,N_det)
|
||||||
|
complex*16 ,intent(out) :: s_t(N_states_diag,N_det)
|
||||||
|
|
||||||
|
integer :: rc, sz
|
||||||
|
integer*8 :: rc8
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
|
||||||
|
if(rc /= 4) stop 'davidson_pull_results failed to pull task_id'
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, imin, 4, 0)
|
||||||
|
if(rc /= 4) stop 'davidson_pull_results failed to pull imin'
|
||||||
|
|
||||||
|
rc = f77_zmq_recv( zmq_socket_pull, imax, 4, 0)
|
||||||
|
if(rc /= 4) stop 'davidson_pull_results failed to pull imax'
|
||||||
|
|
||||||
|
sz = (imax-imin+1)*N_states_diag
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_recv8( zmq_socket_pull, v_t(1,imin), 8_8*sz*2, 0)
|
||||||
|
if(rc8 /= 8*sz*2) stop 'davidson_pull_results_complex failed to pull v_t'
|
||||||
|
|
||||||
|
!todo: double sz for complex? (done)
|
||||||
|
rc8 = f77_zmq_recv8( zmq_socket_pull, s_t(1,imin), 8_8*sz*2, 0)
|
||||||
|
if(rc8 /= 8*sz*2) stop 'davidson_pull_results_complex failed to pull s_t'
|
||||||
|
|
||||||
|
! Activate if zmq_socket_pull is a REP
|
||||||
|
IRP_IF ZMQ_PUSH
|
||||||
|
IRP_ELSE
|
||||||
|
rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0)
|
||||||
|
if (rc /= 2) then
|
||||||
|
print *, irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
subroutine davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v0, s0, sze, N_st)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Routine collecting the results of the workers in Davidson's algorithm.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_socket_pull
|
||||||
|
integer, intent(in) :: sze, N_st
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
|
||||||
|
complex*16 ,intent(inout) :: v0(sze, N_st)
|
||||||
|
complex*16 ,intent(inout) :: s0(sze, N_st)
|
||||||
|
|
||||||
|
integer :: more, task_id, imin, imax
|
||||||
|
|
||||||
|
complex*16, allocatable :: v_t(:,:), s_t(:,:)
|
||||||
|
logical :: sending
|
||||||
|
integer :: i,j
|
||||||
|
integer, external :: zmq_delete_task_async_send
|
||||||
|
integer, external :: zmq_delete_task_async_recv
|
||||||
|
|
||||||
|
allocate(v_t(N_st,N_det), s_t(N_st,N_det))
|
||||||
|
v0 = (0.d0,0.d0)
|
||||||
|
s0 = (0.d0,0.d0)
|
||||||
|
more = 1
|
||||||
|
sending = .False.
|
||||||
|
do while (more == 1)
|
||||||
|
call davidson_pull_results_complex(zmq_socket_pull, v_t, s_t, imin, imax, task_id)
|
||||||
|
if (zmq_delete_task_async_send(zmq_to_qp_run_socket,task_id,sending) == -1) then
|
||||||
|
stop 'davidson: Unable to delete task (send)'
|
||||||
|
endif
|
||||||
|
do j=1,N_st
|
||||||
|
do i=imin,imax
|
||||||
|
v0(i,j) = v0(i,j) + v_t(j,i)
|
||||||
|
s0(i,j) = s0(i,j) + s_t(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if (zmq_delete_task_async_recv(zmq_to_qp_run_socket,more,sending) == -1) then
|
||||||
|
stop 'davidson: Unable to delete task (recv)'
|
||||||
|
endif
|
||||||
|
end do
|
||||||
|
deallocate(v_t,s_t)
|
||||||
|
|
||||||
|
end subroutine
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine h_s2_u_0_nstates_zmq_complex(v_0,s_0,u_0,N_st,sze)
|
||||||
|
!todo: maybe make separate zmq_put_psi_complex?
|
||||||
|
!print*,irp_here,' not implemented for complex'
|
||||||
|
!stop -1
|
||||||
|
use omp_lib
|
||||||
|
use bitmasks
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $v_0 = H | u_0\rangle$ and $s_0 = S^2 | u_0\rangle$
|
||||||
|
!
|
||||||
|
! n : number of determinants
|
||||||
|
!
|
||||||
|
! H_jj : array of $\langle j | H | j \rangle$
|
||||||
|
!
|
||||||
|
! S2_jj : array of $\langle j | S^2 | j \rangle$
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: N_st, sze
|
||||||
|
complex*16, intent(out) :: v_0(sze,N_st), s_0(sze,N_st)
|
||||||
|
complex*16, intent(inout) :: u_0(sze,N_st)
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: ithread
|
||||||
|
complex*16, allocatable :: u_tc(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_tc
|
||||||
|
integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
|
||||||
|
PROVIDE psi_det_beta_unique psi_bilinear_matrix_order_transp_reverse psi_det_alpha_unique
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_values_complex psi_bilinear_matrix_values_complex psi_bilinear_matrix_columns_loc
|
||||||
|
PROVIDE ref_bitmask_energy nproc
|
||||||
|
PROVIDE mpi_initialized
|
||||||
|
|
||||||
|
call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'davidson')
|
||||||
|
|
||||||
|
! integer :: N_states_diag_save
|
||||||
|
! N_states_diag_save = N_states_diag
|
||||||
|
! N_states_diag = N_st
|
||||||
|
if (zmq_put_N_states_diag(zmq_to_qp_run_socket, 1) == -1) then
|
||||||
|
stop 'Unable to put N_states_diag on ZMQ server'
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (zmq_put_psi(zmq_to_qp_run_socket,1) == -1) then
|
||||||
|
stop 'Unable to put psi on ZMQ server'
|
||||||
|
endif
|
||||||
|
energy = 0.d0
|
||||||
|
if (zmq_put_dvector(zmq_to_qp_run_socket,1,'energy',energy,size(energy)) == -1) then
|
||||||
|
stop 'Unable to put energy on ZMQ server'
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
! Create tasks
|
||||||
|
! ============
|
||||||
|
|
||||||
|
integer :: istep, imin, imax, ishift, ipos
|
||||||
|
integer, external :: add_task_to_taskserver
|
||||||
|
integer, parameter :: tasksize=10000
|
||||||
|
character*(100000) :: task
|
||||||
|
istep=1
|
||||||
|
ishift=0
|
||||||
|
imin=1
|
||||||
|
|
||||||
|
|
||||||
|
ipos=1
|
||||||
|
do imin=1,N_det,tasksize
|
||||||
|
imax = min(N_det,imin-1+tasksize)
|
||||||
|
do ishift=0,istep-1
|
||||||
|
write(task(ipos:ipos+50),'(4(I11,1X),1X,1A)') imin, imax, ishift, istep, '|'
|
||||||
|
ipos = ipos+50
|
||||||
|
if (ipos > 100000-50) then
|
||||||
|
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
|
||||||
|
stop 'Unable to add task'
|
||||||
|
endif
|
||||||
|
ipos=1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (ipos > 1) then
|
||||||
|
if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos))) == -1) then
|
||||||
|
stop 'Unable to add task'
|
||||||
|
endif
|
||||||
|
ipos=1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(u_tc(N_st,N_det))
|
||||||
|
do k=1,N_st
|
||||||
|
call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call cdtranspose( &
|
||||||
|
u_0, &
|
||||||
|
size(u_0, 1), &
|
||||||
|
u_tc, &
|
||||||
|
size(u_tc, 1), &
|
||||||
|
N_det, N_st)
|
||||||
|
|
||||||
|
|
||||||
|
ASSERT (N_st == N_states_diag)
|
||||||
|
ASSERT (sze >= N_det)
|
||||||
|
|
||||||
|
integer :: rc, ni, nj
|
||||||
|
integer*8 :: rc8
|
||||||
|
double precision :: energy(N_st)
|
||||||
|
|
||||||
|
integer, external :: zmq_put_dvector, zmq_put_psi, zmq_put_N_states_diag
|
||||||
|
integer, external :: zmq_put_cdmatrix
|
||||||
|
if (size(u_tc,kind=8) < 8388608_8) then
|
||||||
|
ni = size(u_tc)
|
||||||
|
nj = 1
|
||||||
|
else
|
||||||
|
ni = 8388608
|
||||||
|
nj = int(size(u_tc,kind=8)/8388608_8,4) + 1
|
||||||
|
endif
|
||||||
|
! Warning : dimensions are modified for efficiency, It is OK since we get the
|
||||||
|
! full matrix
|
||||||
|
if (zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, 'u_tc', u_tc, ni, nj, size(u_tc,kind=8)) == -1) then
|
||||||
|
stop 'Unable to put u_tc on ZMQ server'
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate(u_tc)
|
||||||
|
|
||||||
|
integer, external :: zmq_set_running
|
||||||
|
if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
|
||||||
|
print *, irp_here, ': Failed in zmq_set_running'
|
||||||
|
endif
|
||||||
|
|
||||||
|
call omp_set_nested(.True.)
|
||||||
|
!$OMP PARALLEL DEFAULT(shared) NUM_THREADS(2) PRIVATE(ithread)
|
||||||
|
ithread = omp_get_thread_num()
|
||||||
|
if (ithread == 0 ) then
|
||||||
|
call davidson_collector_complex(zmq_to_qp_run_socket, zmq_socket_pull, v_0, s_0, N_det, N_st)
|
||||||
|
else
|
||||||
|
call davidson_slave_inproc(1)
|
||||||
|
endif
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'davidson')
|
||||||
|
|
||||||
|
!$OMP PARALLEL
|
||||||
|
!$OMP SINGLE
|
||||||
|
do k=1,N_st
|
||||||
|
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||||
|
call cdset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
!$OMP END TASK
|
||||||
|
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||||
|
call cdset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
!$OMP END TASK
|
||||||
|
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(k,N_det)
|
||||||
|
call cdset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
!$OMP END TASK
|
||||||
|
enddo
|
||||||
|
!$OMP END SINGLE
|
||||||
|
!$OMP TASKWAIT
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
! N_states_diag = N_states_diag_save
|
||||||
|
! SOFT_TOUCH N_states_diag
|
||||||
|
end
|
||||||
|
|
||||||
|
@ -33,9 +33,16 @@ BEGIN_PROVIDER [ integer, dressed_column_idx, (N_states) ]
|
|||||||
integer :: i
|
integer :: i
|
||||||
double precision :: tmp
|
double precision :: tmp
|
||||||
integer, external :: idamax
|
integer, external :: idamax
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_states
|
||||||
|
!todo: check for complex
|
||||||
|
dressed_column_idx(i) = idamax(N_det, cdabs(psi_coef_complex(1,i)), 1)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
dressed_column_idx(i) = idamax(N_det, psi_coef(1,i), 1)
|
dressed_column_idx(i) = idamax(N_det, psi_coef(1,i), 1)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged)
|
subroutine davidson_diag_hs2(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged)
|
||||||
@ -721,7 +728,730 @@ end
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
subroutine davidson_diag_hs2_complex(dets_in,u_in,s2_out,dim_in,energies,sze,N_st,N_st_diag,Nint,dressing_state,converged)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Davidson diagonalization.
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, N_st_diag, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
complex*16, intent(inout) :: u_in(dim_in,N_st_diag)
|
||||||
|
double precision, intent(out) :: energies(N_st_diag), s2_out(N_st_diag)
|
||||||
|
integer, intent(in) :: dressing_state
|
||||||
|
logical, intent(out) :: converged
|
||||||
|
double precision, allocatable :: H_jj(:)
|
||||||
|
|
||||||
|
double precision, external :: diag_H_mat_elem, diag_S_mat_elem
|
||||||
|
integer :: i,k
|
||||||
|
ASSERT (N_st > 0)
|
||||||
|
ASSERT (sze > 0)
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
PROVIDE mo_two_e_integrals_in_map
|
||||||
|
allocate(H_jj(sze))
|
||||||
|
|
||||||
|
H_jj(1) = diag_h_mat_elem(dets_in(1,1,1),Nint)
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP SHARED(sze,H_jj, dets_in,Nint) &
|
||||||
|
!$OMP PRIVATE(i)
|
||||||
|
!$OMP DO SCHEDULE(static)
|
||||||
|
do i=2,sze
|
||||||
|
H_jj(i) = diag_H_mat_elem(dets_in(1,1,i),Nint)
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
if (dressing_state > 0) then
|
||||||
|
!todo: implement for complex
|
||||||
|
print*,irp_here,' not implemented for complex if dressing_state > 0'
|
||||||
|
stop -1
|
||||||
|
do k=1,N_st
|
||||||
|
do i=1,sze
|
||||||
|
H_jj(i) += dble(u_in(i,k) * dressing_column_h(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
call davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,S2_out,energies,dim_in,sze,N_st,N_st_diag,Nint,dressing_state,converged)
|
||||||
|
deallocate (H_jj)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine davidson_diag_hjj_sjj_complex(dets_in,u_in,H_jj,s2_out,energies,dim_in,sze,N_st,N_st_diag_in,Nint,dressing_state,converged)
|
||||||
|
use bitmasks
|
||||||
|
use mmap_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Davidson diagonalization with specific diagonal elements of the H matrix
|
||||||
|
!
|
||||||
|
! H_jj : specific diagonal H matrix elements to diagonalize de Davidson
|
||||||
|
!
|
||||||
|
! S2_out : Output : s^2
|
||||||
|
!
|
||||||
|
! dets_in : bitmasks corresponding to determinants
|
||||||
|
!
|
||||||
|
! u_in : guess coefficients on the various states. Overwritten
|
||||||
|
! on exit
|
||||||
|
!
|
||||||
|
! dim_in : leftmost dimension of u_in
|
||||||
|
!
|
||||||
|
! sze : Number of determinants
|
||||||
|
!
|
||||||
|
! N_st : Number of eigenstates
|
||||||
|
!
|
||||||
|
! N_st_diag_in : Number of states in which H is diagonalized. Assumed > sze
|
||||||
|
!
|
||||||
|
! Initial guess vectors are not necessarily orthonormal
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: dim_in, sze, N_st, N_st_diag_in, Nint
|
||||||
|
integer(bit_kind), intent(in) :: dets_in(Nint,2,sze)
|
||||||
|
double precision, intent(in) :: H_jj(sze)
|
||||||
|
integer, intent(in) :: dressing_state
|
||||||
|
double precision, intent(inout) :: s2_out(N_st_diag_in)
|
||||||
|
complex*16, intent(inout) :: u_in(dim_in,N_st_diag_in)
|
||||||
|
double precision, intent(out) :: energies(N_st_diag_in)
|
||||||
|
|
||||||
|
integer :: iter, N_st_diag
|
||||||
|
integer :: i,j,k,l,m
|
||||||
|
logical, intent(inout) :: converged
|
||||||
|
|
||||||
|
double precision, external :: u_dot_u_complex
|
||||||
|
complex*16, external :: u_dot_v_complex
|
||||||
|
|
||||||
|
integer :: k_pairs, kl
|
||||||
|
|
||||||
|
integer :: iter2, itertot
|
||||||
|
double precision, allocatable :: lambda(:), s2(:)
|
||||||
|
complex*16, allocatable :: y(:,:), h(:,:), h_p(:,:)
|
||||||
|
complex*8, allocatable :: y_s(:,:)
|
||||||
|
complex*16, allocatable :: s_(:,:), s_tmp(:,:)
|
||||||
|
double precision :: diag_h_mat_elem
|
||||||
|
double precision, allocatable :: residual_norm(:)
|
||||||
|
character*(16384) :: write_buffer
|
||||||
|
double precision :: to_print(3,N_st)
|
||||||
|
double precision :: cpu, wall
|
||||||
|
integer :: shift, shift2, itermax, istate
|
||||||
|
double precision :: r1, r2, alpha
|
||||||
|
logical :: state_ok(N_st_diag_in*davidson_sze_max)
|
||||||
|
integer :: nproc_target
|
||||||
|
integer :: order(N_st_diag_in)
|
||||||
|
double precision :: cmax
|
||||||
|
double precision, allocatable :: overlap(:,:)
|
||||||
|
complex*16, allocatable :: y_tmp(:,:)
|
||||||
|
complex*16, allocatable :: S_d(:,:)
|
||||||
|
complex*16, allocatable :: U(:,:)
|
||||||
|
complex*16, pointer :: W(:,:)
|
||||||
|
complex*8, pointer :: S(:,:)
|
||||||
|
logical :: disk_based
|
||||||
|
double precision :: energy_shift(N_st_diag_in*davidson_sze_max)
|
||||||
|
|
||||||
|
include 'constants.include.F'
|
||||||
|
|
||||||
|
N_st_diag = N_st_diag_in
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, W, S, y, y_s, S_d, h, lambda
|
||||||
|
if (N_st_diag*3 > sze) then
|
||||||
|
print *, 'error in Davidson :'
|
||||||
|
print *, 'Increase n_det_max_full to ', N_st_diag*3
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
|
||||||
|
itermax = max(2,min(davidson_sze_max, sze/N_st_diag))+1
|
||||||
|
itertot = 0
|
||||||
|
|
||||||
|
if (state_following) then
|
||||||
|
allocate(overlap(N_st_diag*itermax, N_st_diag*itermax), &
|
||||||
|
y_tmp(N_st_diag*itermax, N_st_diag*itermax))
|
||||||
|
else
|
||||||
|
allocate(overlap(1,1),y_tmp(1,1)) ! avoid 'if' for deallocate
|
||||||
|
endif
|
||||||
|
overlap = 0.d0
|
||||||
|
y_tmp = (0.d0,0.d0)
|
||||||
|
|
||||||
|
!todo: provide psi_bilinear_matrix_values? (unlinked now)
|
||||||
|
PROVIDE nuclear_repulsion expected_s2 psi_bilinear_matrix_order psi_bilinear_matrix_order_reverse threshold_davidson_pt2
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
write(6,'(A)') ''
|
||||||
|
write(6,'(A)') 'Davidson Diagonalization'
|
||||||
|
write(6,'(A)') '------------------------'
|
||||||
|
write(6,'(A)') ''
|
||||||
|
|
||||||
|
! Find max number of cores to fit in memory
|
||||||
|
! -----------------------------------------
|
||||||
|
|
||||||
|
nproc_target = nproc
|
||||||
|
double precision :: rss
|
||||||
|
integer :: maxab
|
||||||
|
maxab = max(N_det_alpha_unique, N_det_beta_unique)+1
|
||||||
|
|
||||||
|
m=1
|
||||||
|
disk_based = .False.
|
||||||
|
call resident_memory(rss)
|
||||||
|
do
|
||||||
|
!r1 = 8.d0 * &! bytes
|
||||||
|
! ( dble(sze)*(N_st_diag*itermax) &! U
|
||||||
|
! + 1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S
|
||||||
|
! + 1.d0*dble(sze)*(N_st_diag) &! S_d
|
||||||
|
! + 4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp
|
||||||
|
! + 2.d0*(N_st_diag*itermax) &! s2,lambda
|
||||||
|
! + 1.d0*(N_st_diag) &! residual_norm
|
||||||
|
! ! In H_S2_u_0_nstates_zmq
|
||||||
|
! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector
|
||||||
|
! + 3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave
|
||||||
|
! + 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_*
|
||||||
|
! + nproc_target * &! In OMP section
|
||||||
|
! ( 1.d0*(N_int*maxab) &! buffer
|
||||||
|
! + 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx
|
||||||
|
! ) / 1024.d0**3
|
||||||
|
r1 = 8.d0 * &! bytes
|
||||||
|
( 2*dble(sze)*(N_st_diag*itermax) &! U
|
||||||
|
+ 2*1.5d0*dble(sze*m)*(N_st_diag*itermax) &! W,S
|
||||||
|
+ 2*1.d0*dble(sze)*(N_st_diag) &! S_d
|
||||||
|
+ 2*4.5d0*(N_st_diag*itermax)**2 &! h,y,y_s,s_,s_tmp
|
||||||
|
+ 2.d0*(N_st_diag*itermax) &! s2,lambda
|
||||||
|
+ 1.d0*(N_st_diag) &! residual_norm
|
||||||
|
! In H_S2_u_0_nstates_zmq
|
||||||
|
+ 2*3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on collector
|
||||||
|
+ 2*3.d0*(N_st_diag*N_det) &! u_t, v_t, s_t on slave
|
||||||
|
+ 0.5d0*maxab &! idx0 in H_S2_u_0_nstates_openmp_work_*
|
||||||
|
+ nproc_target * &! In OMP section
|
||||||
|
( 1.d0*(N_int*maxab) &! buffer
|
||||||
|
+ 3.5d0*(maxab) ) &! singles_a, singles_b, doubles, idx
|
||||||
|
) / 1024.d0**3
|
||||||
|
|
||||||
|
if (nproc_target == 0) then
|
||||||
|
call check_mem(r1,irp_here)
|
||||||
|
nproc_target = 1
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (r1+rss < qp_max_mem) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (itermax > 4) then
|
||||||
|
itermax = itermax - 1
|
||||||
|
else if (m==1.and.disk_based_davidson) then
|
||||||
|
m=0
|
||||||
|
disk_based = .True.
|
||||||
|
itermax = 6
|
||||||
|
else
|
||||||
|
nproc_target = nproc_target - 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo
|
||||||
|
nthreads_davidson = nproc_target
|
||||||
|
TOUCH nthreads_davidson
|
||||||
|
call write_int(6,N_st,'Number of states')
|
||||||
|
call write_int(6,N_st_diag,'Number of states in diagonalization')
|
||||||
|
call write_int(6,sze,'Number of determinants')
|
||||||
|
call write_int(6,nproc_target,'Number of threads for diagonalization')
|
||||||
|
call write_double(6, r1, 'Memory(Gb)')
|
||||||
|
if (disk_based) then
|
||||||
|
print *, 'Using swap space to reduce RAM'
|
||||||
|
endif
|
||||||
|
|
||||||
|
!---------------
|
||||||
|
|
||||||
|
write(6,'(A)') ''
|
||||||
|
write_buffer = '====='
|
||||||
|
do i=1,N_st
|
||||||
|
write_buffer = trim(write_buffer)//' ================ =========== ==========='
|
||||||
|
enddo
|
||||||
|
write(6,'(A)') write_buffer(1:6+41*N_st)
|
||||||
|
write_buffer = 'Iter'
|
||||||
|
do i=1,N_st
|
||||||
|
write_buffer = trim(write_buffer)//' Energy S^2 Residual '
|
||||||
|
enddo
|
||||||
|
write(6,'(A)') write_buffer(1:6+41*N_st)
|
||||||
|
write_buffer = '====='
|
||||||
|
do i=1,N_st
|
||||||
|
write_buffer = trim(write_buffer)//' ================ =========== ==========='
|
||||||
|
enddo
|
||||||
|
write(6,'(A)') write_buffer(1:6+41*N_st)
|
||||||
|
|
||||||
|
!todo: already resized, but do we need to change c_f_pointer for complex?
|
||||||
|
if (disk_based) then
|
||||||
|
! Create memory-mapped files for W and S
|
||||||
|
type(c_ptr) :: ptr_w, ptr_s
|
||||||
|
integer :: fd_s, fd_w
|
||||||
|
call mmap(trim(ezfio_work_dir)//'davidson_w', (/int(sze,8),int(N_st_diag*itermax,8)/),&
|
||||||
|
8*2, fd_w, .False., ptr_w)
|
||||||
|
call mmap(trim(ezfio_work_dir)//'davidson_s', (/int(sze,8),int(N_st_diag*itermax,8)/),&
|
||||||
|
4*2, fd_s, .False., ptr_s)
|
||||||
|
call c_f_pointer(ptr_w, w, (/sze,N_st_diag*itermax/))
|
||||||
|
call c_f_pointer(ptr_s, s, (/sze,N_st_diag*itermax/))
|
||||||
|
else
|
||||||
|
allocate(W(sze,N_st_diag*itermax), S(sze,N_st_diag*itermax))
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
! Large
|
||||||
|
U(sze,N_st_diag*itermax), &
|
||||||
|
S_d(sze,N_st_diag), &
|
||||||
|
|
||||||
|
! Small
|
||||||
|
h(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
h_p(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
y(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
s_(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
s_tmp(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
residual_norm(N_st_diag), &
|
||||||
|
s2(N_st_diag*itermax), &
|
||||||
|
y_s(N_st_diag*itermax,N_st_diag*itermax), &
|
||||||
|
lambda(N_st_diag*itermax))
|
||||||
|
|
||||||
|
h = (0.d0,0.d0)
|
||||||
|
U = (0.d0,0.d0)
|
||||||
|
y = (0.d0,0.d0)
|
||||||
|
s_ = (0.d0,0.d0)
|
||||||
|
s_tmp = (0.d0,0.d0)
|
||||||
|
|
||||||
|
|
||||||
|
ASSERT (N_st > 0)
|
||||||
|
ASSERT (N_st_diag >= N_st)
|
||||||
|
ASSERT (sze > 0)
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
|
||||||
|
! Davidson iterations
|
||||||
|
! ===================
|
||||||
|
|
||||||
|
converged = .False.
|
||||||
|
|
||||||
|
do k=N_st+1,N_st_diag
|
||||||
|
u_in(k,k) = (10.d0,0.d0)
|
||||||
|
do i=1,sze
|
||||||
|
call random_number(r1)
|
||||||
|
call random_number(r2)
|
||||||
|
r1 = dsqrt(-2.d0*dlog(r1))
|
||||||
|
r2 = dtwo_pi*r2
|
||||||
|
!todo: real or complex? rescale for complex? sqrt(2)?
|
||||||
|
u_in(i,k) = dcmplx(r1*dcos(r2),0.d0)
|
||||||
|
!u_in(i,k) = dcmplx(r1*dcos(r2),r1*dsin(r2))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k=1,N_st_diag
|
||||||
|
call normalize_complex(u_in(1,k),sze)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
U(i,k) = u_in(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
do while (.not.converged)
|
||||||
|
itertot = itertot+1
|
||||||
|
if (itertot == 8) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
do iter=1,itermax-1
|
||||||
|
|
||||||
|
shift = N_st_diag*(iter-1)
|
||||||
|
shift2 = N_st_diag*iter
|
||||||
|
|
||||||
|
if ((iter > 1).or.(itertot == 1)) then
|
||||||
|
! Compute |W_k> = \sum_i |i><i|H|u_k>
|
||||||
|
! -----------------------------------
|
||||||
|
|
||||||
|
if (disk_based) then
|
||||||
|
call ortho_qr_unblocked_complex(U,size(U,1),sze,shift2)
|
||||||
|
call ortho_qr_unblocked_complex(U,size(U,1),sze,shift2)
|
||||||
|
else
|
||||||
|
call ortho_qr_complex(U,size(U,1),sze,shift2)
|
||||||
|
call ortho_qr_complex(U,size(U,1),sze,shift2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! |W> = H|U>
|
||||||
|
! |S_d> = S^2|U>
|
||||||
|
if ((sze > 100000).and.distributed_davidson) then
|
||||||
|
call h_s2_u_0_nstates_zmq_complex(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze)
|
||||||
|
else
|
||||||
|
call h_s2_u_0_nstates_openmp_complex(W(1,shift+1),S_d,U(1,shift+1),N_st_diag,sze)
|
||||||
|
endif
|
||||||
|
S(1:sze,shift+1:shift+N_st_diag) = cmplx(S_d(1:sze,1:N_st_diag))
|
||||||
|
else
|
||||||
|
! Already computed in update below
|
||||||
|
continue
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (dressing_state > 0) then
|
||||||
|
!todo: implement for complex
|
||||||
|
print*,irp_here,' not implemented for complex (dressed)'
|
||||||
|
stop -1
|
||||||
|
!
|
||||||
|
! if (N_st == 1) then
|
||||||
|
!
|
||||||
|
! l = dressed_column_idx(1)
|
||||||
|
! complex*16 :: f
|
||||||
|
! !todo: check for complex
|
||||||
|
! f = (1.0d0,0.d0)/psi_coef(l,1)
|
||||||
|
! do istate=1,N_st_diag
|
||||||
|
! do i=1,sze
|
||||||
|
! !todo: conjugate?
|
||||||
|
! W(i,shift+istate) += dressing_column_h_complex(i,1) *f * U(l,shift+istate)
|
||||||
|
! W(l,shift+istate) += dressing_column_h_complex(i,1) *f * U(i,shift+istate)
|
||||||
|
! S(i,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(l,shift+istate))
|
||||||
|
! S(l,shift+istate) += cmplx(dressing_column_s_complex(i,1) *f * U(i,shift+istate))
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! else
|
||||||
|
!
|
||||||
|
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
|
||||||
|
! psi_coef, size(psi_coef,1), &
|
||||||
|
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||||
|
!
|
||||||
|
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||||
|
! dressing_column_h, size(dressing_column_h,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 1.d0, W(1,shift+1), size(W,1))
|
||||||
|
!
|
||||||
|
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||||
|
! dressing_column_s, size(dressing_column_s,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 1.d0, S_d, size(S_d,1))
|
||||||
|
!
|
||||||
|
!
|
||||||
|
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
|
||||||
|
! dressing_column_h, size(dressing_column_h,1), &
|
||||||
|
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||||
|
!
|
||||||
|
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||||
|
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 1.d0, W(1,shift+1), size(W,1))
|
||||||
|
!
|
||||||
|
! call dgemm('T','N', N_st, N_st_diag, sze, 1.d0, &
|
||||||
|
! dressing_column_s, size(dressing_column_s,1), &
|
||||||
|
! U(1,shift+1), size(U,1), 0.d0, s_tmp, size(s_tmp,1))
|
||||||
|
!
|
||||||
|
! call dgemm('N','N', sze, N_st_diag, N_st, 1.0d0, &
|
||||||
|
! psi_coef, size(psi_coef,1), s_tmp, size(s_tmp,1), &
|
||||||
|
! 1.d0, S_d, size(S_d,1))
|
||||||
|
!
|
||||||
|
! endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Compute s_kl = <u_k | S_l> = <u_k| S2 |u_l>
|
||||||
|
! -------------------------------------------
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,j,k) COLLAPSE(2)
|
||||||
|
do j=1,shift2
|
||||||
|
do i=1,shift2
|
||||||
|
s_(i,j) = (0.d0,0.d0)
|
||||||
|
do k=1,sze
|
||||||
|
s_(i,j) = s_(i,j) + dconjg(U(k,i)) * cmplx(S(k,j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
! Compute h_kl = <u_k | W_l> = <u_k| H |u_l>
|
||||||
|
! -------------------------------------------
|
||||||
|
|
||||||
|
!todo: why not size(h,1)?
|
||||||
|
call zgemm('C','N', shift2, shift2, sze, &
|
||||||
|
(1.d0,0.d0), U, size(U,1), W, size(W,1), &
|
||||||
|
(0.d0,0.d0), h, size(h_p,1))
|
||||||
|
|
||||||
|
! Penalty method
|
||||||
|
! --------------
|
||||||
|
|
||||||
|
if (s2_eig) then
|
||||||
|
h_p = s_
|
||||||
|
do k=1,shift2
|
||||||
|
h_p(k,k) = h_p(k,k) + (S_z2_Sz - expected_s2)
|
||||||
|
enddo
|
||||||
|
if (only_expected_s2) then
|
||||||
|
alpha = 0.1d0
|
||||||
|
h_p = h + alpha*h_p
|
||||||
|
else
|
||||||
|
alpha = 0.0001d0
|
||||||
|
h_p = h + alpha*h_p
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
h_p = h
|
||||||
|
alpha = 0.d0
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Diagonalize h_p
|
||||||
|
! ---------------
|
||||||
|
|
||||||
|
call lapack_diag_complex(lambda,y,h_p,size(h_p,1),shift2)
|
||||||
|
|
||||||
|
! Compute Energy for each eigenvector
|
||||||
|
! -----------------------------------
|
||||||
|
|
||||||
|
call zgemm('N','N',shift2,shift2,shift2, &
|
||||||
|
(1.d0,0.d0), h, size(h,1), y, size(y,1), &
|
||||||
|
(0.d0,0.d0), s_tmp, size(s_tmp,1))
|
||||||
|
|
||||||
|
call zgemm('C','N',shift2,shift2,shift2, &
|
||||||
|
(1.d0,0.d0), y, size(y,1), s_tmp, size(s_tmp,1), &
|
||||||
|
(0.d0,0.d0), h, size(h,1))
|
||||||
|
|
||||||
|
do k=1,shift2
|
||||||
|
lambda(k) = dble(h(k,k))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Compute S2 for each eigenvector
|
||||||
|
! -------------------------------
|
||||||
|
|
||||||
|
call zgemm('N','N',shift2,shift2,shift2, &
|
||||||
|
(1.d0,0.d0), s_, size(s_,1), y, size(y,1), &
|
||||||
|
(0.d0,0.d0), s_tmp, size(s_tmp,1))
|
||||||
|
|
||||||
|
call zgemm('C','N',shift2,shift2,shift2, &
|
||||||
|
(1.d0,0.d0), y, size(y,1), s_tmp, size(s_tmp,1), &
|
||||||
|
(0.d0,0.d0), s_, size(s_,1))
|
||||||
|
|
||||||
|
do k=1,shift2
|
||||||
|
s2(k) = dble(s_(k,k)) + S_z2_Sz
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (only_expected_s2) then
|
||||||
|
do k=1,shift2
|
||||||
|
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do k=1,size(state_ok)
|
||||||
|
state_ok(k) = .True.
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
do k=1,shift2
|
||||||
|
if (.not. state_ok(k)) then
|
||||||
|
do l=k+1,shift2
|
||||||
|
if (state_ok(l)) then
|
||||||
|
call zswap(shift2, y(1,k), 1, y(1,l), 1)
|
||||||
|
call dswap(1, s2(k), 1, s2(l), 1)
|
||||||
|
call dswap(1, lambda(k), 1, lambda(l), 1)
|
||||||
|
state_ok(k) = .True.
|
||||||
|
state_ok(l) = .False.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (state_following) then
|
||||||
|
|
||||||
|
overlap = -1.d0
|
||||||
|
do k=1,shift2
|
||||||
|
do i=1,shift2
|
||||||
|
overlap(k,i) = cdabs(y(k,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
cmax = -1.d0
|
||||||
|
do i=1,N_st
|
||||||
|
if (overlap(i,k) > cmax) then
|
||||||
|
cmax = overlap(i,k)
|
||||||
|
order(k) = i
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do i=1,N_st_diag
|
||||||
|
overlap(order(k),i) = -1.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
y_tmp = y
|
||||||
|
do k=1,N_st
|
||||||
|
l = order(k)
|
||||||
|
if (k /= l) then
|
||||||
|
y(1:shift2,k) = y_tmp(1:shift2,l)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
overlap(k,1) = lambda(k)
|
||||||
|
overlap(k,2) = s2(k)
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
l = order(k)
|
||||||
|
if (k /= l) then
|
||||||
|
lambda(k) = overlap(l,1)
|
||||||
|
s2(k) = overlap(l,2)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
! Express eigenvectors of h in the determinant basis
|
||||||
|
! --------------------------------------------------
|
||||||
|
!todo: check for complex
|
||||||
|
call zgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
|
(1.d0,0.d0), U, size(U,1), y, size(y,1), (0.d0,0.d0), U(1,shift2+1), size(U,1))
|
||||||
|
call zgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
|
(1.d0,0.d0), W, size(W,1), y, size(y,1), (0.d0,0.d0), W(1,shift2+1), size(W,1))
|
||||||
|
|
||||||
|
y_s(:,:) = cmplx(y(:,:))
|
||||||
|
call cgemm('N','N', sze, N_st_diag, shift2, &
|
||||||
|
(1.e0,0.e0), S, size(S,1), y_s, size(y_s,1), (0.e0,0.e0), S(1,shift2+1), size(S,1))
|
||||||
|
|
||||||
|
! Compute residual vector and davidson step
|
||||||
|
! -----------------------------------------
|
||||||
|
|
||||||
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i,k)
|
||||||
|
do k=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
U(i,shift2+k) = &
|
||||||
|
(lambda(k) * U(i,shift2+k) - W(i,shift2+k) ) &
|
||||||
|
/max(H_jj(i) - lambda (k),1.d-2)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (k <= N_st) then
|
||||||
|
residual_norm(k) = u_dot_u_complex(U(1,shift2+k),sze)
|
||||||
|
to_print(1,k) = lambda(k) + nuclear_repulsion
|
||||||
|
to_print(2,k) = s2(k)
|
||||||
|
to_print(3,k) = residual_norm(k)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
|
||||||
|
if ((itertot>1).and.(iter == 1)) then
|
||||||
|
!don't print
|
||||||
|
continue
|
||||||
|
else
|
||||||
|
write(*,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter-1, to_print(1:3,1:N_st)
|
||||||
|
endif
|
||||||
|
|
||||||
|
! Check convergence
|
||||||
|
if (iter > 1) then
|
||||||
|
converged = dabs(maxval(residual_norm(1:N_st))) < threshold_davidson_pt2
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
do k=1,N_st
|
||||||
|
if (residual_norm(k) > 1.e8) then
|
||||||
|
print *, 'Davidson failed'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (converged) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
logical, external :: qp_stop
|
||||||
|
if (qp_stop()) then
|
||||||
|
converged = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Re-contract U and update S and W
|
||||||
|
! --------------------------------
|
||||||
|
|
||||||
|
call cgemm('N','N', sze, N_st_diag, shift2, (1.e0,0.e0), &
|
||||||
|
S, size(S,1), y_s, size(y_s,1), (0.e0,0.e0), S(1,shift2+1), size(S,1))
|
||||||
|
do k=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
S(i,k) = S(i,shift2+k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call zgemm('N','N', sze, N_st_diag, shift2, (1.d0,0.d0), &
|
||||||
|
W, size(W,1), y, size(y,1), (0.d0,0.d0), u_in, size(u_in,1))
|
||||||
|
do k=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
W(i,k) = u_in(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call zgemm('N','N', sze, N_st_diag, shift2, (1.d0,0.d0), &
|
||||||
|
U, size(U,1), y, size(y,1), (0.d0,0.d0), u_in, size(u_in,1))
|
||||||
|
do k=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
U(i,k) = u_in(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if (disk_based) then
|
||||||
|
call ortho_qr_unblocked_complex(U,size(U,1),sze,N_st_diag)
|
||||||
|
call ortho_qr_unblocked_complex(U,size(U,1),sze,N_st_diag)
|
||||||
|
else
|
||||||
|
call ortho_qr_complex(U,size(U,1),sze,N_st_diag)
|
||||||
|
call ortho_qr_complex(U,size(U,1),sze,N_st_diag)
|
||||||
|
endif
|
||||||
|
do j=1,N_st_diag
|
||||||
|
k=1
|
||||||
|
do while ((k<sze).and.(U(k,j) == (0.d0,0.d0)))
|
||||||
|
k = k+1
|
||||||
|
enddo
|
||||||
|
!if (U(k,j) * u_in(k,j) < 0.d0) then
|
||||||
|
!todo: complex! maybe change criterion here?
|
||||||
|
! if U is close to u_in, then arg(conjg(U)*u_in) will be near zero
|
||||||
|
if (dble(dconjg(U(k,j)) * u_in(k,j)) < 0.d0) then
|
||||||
|
do i=1,sze
|
||||||
|
W(i,j) = -W(i,j)
|
||||||
|
S(i,j) = -S(i,j)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do j=1,N_st_diag
|
||||||
|
do i=1,sze
|
||||||
|
S_d(i,j) = cmplx(S(i,j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k=1,N_st_diag
|
||||||
|
energies(k) = lambda(k)
|
||||||
|
s2_out(k) = s2(k)
|
||||||
|
enddo
|
||||||
|
write_buffer = '======'
|
||||||
|
do i=1,N_st
|
||||||
|
write_buffer = trim(write_buffer)//' ================ =========== ==========='
|
||||||
|
enddo
|
||||||
|
write(6,'(A)') trim(write_buffer)
|
||||||
|
write(6,'(A)') ''
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
if (disk_based)then
|
||||||
|
! Remove temp files
|
||||||
|
integer, external :: getUnitAndOpen
|
||||||
|
call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 2*8, fd_w, ptr_w )
|
||||||
|
fd_w = getUnitAndOpen(trim(ezfio_work_dir)//'davidson_w','r')
|
||||||
|
close(fd_w,status='delete')
|
||||||
|
call munmap( (/int(sze,8),int(N_st_diag*itermax,8)/), 2*4, fd_s, ptr_s )
|
||||||
|
fd_s = getUnitAndOpen(trim(ezfio_work_dir)//'davidson_s','r')
|
||||||
|
close(fd_s,status='delete')
|
||||||
|
else
|
||||||
|
deallocate(W,S)
|
||||||
|
endif
|
||||||
|
|
||||||
|
deallocate ( &
|
||||||
|
residual_norm, &
|
||||||
|
U, overlap, y_tmp, &
|
||||||
|
h, y_s, S_d, &
|
||||||
|
y, s_, s_tmp, &
|
||||||
|
lambda &
|
||||||
|
)
|
||||||
|
FREE nthreads_davidson
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -20,8 +20,21 @@ BEGIN_PROVIDER [ double precision, CI_energy, (N_states_diag) ]
|
|||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, CI_electronic_energy, (N_states_diag) ]
|
BEGIN_PROVIDER [ double precision, CI_electronic_energy, (N_states_diag) ]
|
||||||
&BEGIN_PROVIDER [ double precision, CI_eigenvectors, (N_det,N_states_diag) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, CI_s2, (N_states_diag) ]
|
&BEGIN_PROVIDER [ double precision, CI_s2, (N_states_diag) ]
|
||||||
|
implicit none
|
||||||
|
if (is_complex) then
|
||||||
|
ci_s2(1:N_states_diag) = ci_s2_complex(1:N_states_diag)
|
||||||
|
ci_electronic_energy(1:N_states_diag) = ci_electronic_energy_complex(1:N_states_diag)
|
||||||
|
else
|
||||||
|
ci_s2(1:N_states_diag) = ci_s2_real(1:N_states_diag)
|
||||||
|
ci_electronic_energy(1:N_states_diag) = ci_electronic_energy_real(1:N_states_diag)
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, CI_electronic_energy_real, (N_states_diag) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, CI_eigenvectors, (N_det,N_states_diag) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, CI_s2_real, (N_states_diag) ]
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Eigenvectors/values of the |CI| matrix
|
! Eigenvectors/values of the |CI| matrix
|
||||||
END_DOC
|
END_DOC
|
||||||
@ -57,8 +70,8 @@ END_PROVIDER
|
|||||||
|
|
||||||
if (diag_algorithm == "Davidson") then
|
if (diag_algorithm == "Davidson") then
|
||||||
|
|
||||||
call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_s2, &
|
call davidson_diag_HS2(psi_det,CI_eigenvectors, CI_s2_real, &
|
||||||
size(CI_eigenvectors,1),CI_electronic_energy, &
|
size(CI_eigenvectors,1),CI_electronic_energy_real, &
|
||||||
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
||||||
|
|
||||||
integer :: N_states_diag_save
|
integer :: N_states_diag_save
|
||||||
@ -75,17 +88,17 @@ END_PROVIDER
|
|||||||
allocate (CI_eigenvectors_tmp (N_det,N_states_diag) )
|
allocate (CI_eigenvectors_tmp (N_det,N_states_diag) )
|
||||||
allocate (CI_s2_tmp (N_states_diag) )
|
allocate (CI_s2_tmp (N_states_diag) )
|
||||||
|
|
||||||
CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy(1:N_states_diag_save)
|
CI_electronic_energy_tmp(1:N_states_diag_save) = CI_electronic_energy_real(1:N_states_diag_save)
|
||||||
CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors(1:N_det,1:N_states_diag_save)
|
CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = CI_eigenvectors(1:N_det,1:N_states_diag_save)
|
||||||
CI_s2_tmp(1:N_states_diag_save) = CI_s2(1:N_states_diag_save)
|
CI_s2_tmp(1:N_states_diag_save) = CI_s2_real(1:N_states_diag_save)
|
||||||
|
|
||||||
call davidson_diag_HS2(psi_det,CI_eigenvectors_tmp, CI_s2_tmp, &
|
call davidson_diag_HS2(psi_det,CI_eigenvectors_tmp, CI_s2_tmp, &
|
||||||
size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp, &
|
size(CI_eigenvectors_tmp,1),CI_electronic_energy_tmp, &
|
||||||
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
||||||
|
|
||||||
CI_electronic_energy(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save)
|
CI_electronic_energy_real(1:N_states_diag_save) = CI_electronic_energy_tmp(1:N_states_diag_save)
|
||||||
CI_eigenvectors(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save)
|
CI_eigenvectors(1:N_det,1:N_states_diag_save) = CI_eigenvectors_tmp(1:N_det,1:N_states_diag_save)
|
||||||
CI_s2(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save)
|
CI_s2_real(1:N_states_diag_save) = CI_s2_tmp(1:N_states_diag_save)
|
||||||
|
|
||||||
deallocate (CI_electronic_energy_tmp)
|
deallocate (CI_electronic_energy_tmp)
|
||||||
deallocate (CI_eigenvectors_tmp)
|
deallocate (CI_eigenvectors_tmp)
|
||||||
@ -110,7 +123,7 @@ END_PROVIDER
|
|||||||
H_prime(j,j) = H_prime(j,j) + alpha*(S_z2_Sz - expected_s2)
|
H_prime(j,j) = H_prime(j,j) + alpha*(S_z2_Sz - expected_s2)
|
||||||
enddo
|
enddo
|
||||||
call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det)
|
call lapack_diag(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det)
|
||||||
CI_electronic_energy(:) = 0.d0
|
CI_electronic_energy_real(:) = 0.d0
|
||||||
i_state = 0
|
i_state = 0
|
||||||
allocate (s2_eigvalues(N_det))
|
allocate (s2_eigvalues(N_det))
|
||||||
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
||||||
@ -141,8 +154,8 @@ END_PROVIDER
|
|||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j))
|
CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j))
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(index_good_state_array(j))
|
CI_electronic_energy_real(j) = eigenvalues(index_good_state_array(j))
|
||||||
CI_s2(j) = s2_eigvalues(index_good_state_array(j))
|
CI_s2_real(j) = s2_eigvalues(index_good_state_array(j))
|
||||||
enddo
|
enddo
|
||||||
i_other_state = 0
|
i_other_state = 0
|
||||||
do j = 1, N_det
|
do j = 1, N_det
|
||||||
@ -154,8 +167,8 @@ END_PROVIDER
|
|||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j)
|
CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(i_state+i_other_state) = eigenvalues(j)
|
CI_electronic_energy_real(i_state+i_other_state) = eigenvalues(j)
|
||||||
CI_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
CI_s2_real(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
else
|
else
|
||||||
@ -172,8 +185,8 @@ END_PROVIDER
|
|||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(j)
|
CI_electronic_energy_real(j) = eigenvalues(j)
|
||||||
CI_s2(j) = s2_eigvalues(j)
|
CI_s2_real(j) = s2_eigvalues(j)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
deallocate(index_good_state_array,good_state_array)
|
deallocate(index_good_state_array,good_state_array)
|
||||||
@ -181,22 +194,22 @@ END_PROVIDER
|
|||||||
else
|
else
|
||||||
call lapack_diag(eigenvalues,eigenvectors, &
|
call lapack_diag(eigenvalues,eigenvectors, &
|
||||||
H_matrix_all_dets,size(H_matrix_all_dets,1),N_det)
|
H_matrix_all_dets,size(H_matrix_all_dets,1),N_det)
|
||||||
CI_electronic_energy(:) = 0.d0
|
CI_electronic_energy_real(:) = 0.d0
|
||||||
call u_0_S2_u_0(CI_s2,eigenvectors,N_det,psi_det,N_int,&
|
call u_0_S2_u_0(CI_s2_real,eigenvectors,N_det,psi_det,N_int,&
|
||||||
min(N_det,N_states_diag),size(eigenvectors,1))
|
min(N_det,N_states_diag),size(eigenvectors,1))
|
||||||
! Select the "N_states_diag" states of lowest energy
|
! Select the "N_states_diag" states of lowest energy
|
||||||
do j=1,min(N_det,N_states_diag)
|
do j=1,min(N_det,N_states_diag)
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
CI_eigenvectors(i,j) = eigenvectors(i,j)
|
||||||
enddo
|
enddo
|
||||||
CI_electronic_energy(j) = eigenvalues(j)
|
CI_electronic_energy_real(j) = eigenvalues(j)
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
do k=1,N_states_diag
|
do k=1,N_states_diag
|
||||||
CI_electronic_energy(k) = 0.d0
|
CI_electronic_energy_real(k) = 0.d0
|
||||||
do j=1,N_det
|
do j=1,N_det
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
CI_electronic_energy(k) += &
|
CI_electronic_energy_real(k) += &
|
||||||
CI_eigenvectors(i,k) * CI_eigenvectors(j,k) * &
|
CI_eigenvectors(i,k) * CI_eigenvectors(j,k) * &
|
||||||
H_matrix_all_dets(i,j)
|
H_matrix_all_dets(i,j)
|
||||||
enddo
|
enddo
|
||||||
@ -207,6 +220,215 @@ END_PROVIDER
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, CI_electronic_energy_complex, (N_states_diag) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, CI_eigenvectors_complex, (N_det,N_states_diag) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, CI_s2_complex, (N_states_diag) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! Eigenvectors/values of the |CI| matrix
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
double precision :: ovrlp
|
||||||
|
complex*16 :: u_dot_v_complex
|
||||||
|
integer :: i_good_state
|
||||||
|
integer, allocatable :: index_good_state_array(:)
|
||||||
|
logical, allocatable :: good_state_array(:)
|
||||||
|
double precision, allocatable :: s2_values_tmp(:)
|
||||||
|
integer :: i_other_state
|
||||||
|
double precision, allocatable :: eigenvalues(:)
|
||||||
|
complex*16, allocatable :: eigenvectors(:,:), H_prime(:,:)
|
||||||
|
integer :: i_state
|
||||||
|
double precision :: e_0
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision, allocatable :: s2_eigvalues(:)
|
||||||
|
double precision, allocatable :: e_array(:)
|
||||||
|
integer, allocatable :: iorder(:)
|
||||||
|
logical :: converged
|
||||||
|
|
||||||
|
PROVIDE threshold_davidson nthreads_davidson
|
||||||
|
! Guess values for the "N_states" states of the |CI| eigenvectors
|
||||||
|
do j=1,min(N_states,N_det)
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,j) = psi_coef_complex(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j=min(N_states,N_det)+1,N_states_diag
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,j) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (diag_algorithm == "Davidson") then
|
||||||
|
|
||||||
|
call davidson_diag_hs2_complex(psi_det,ci_eigenvectors_complex, ci_s2_complex, &
|
||||||
|
size(ci_eigenvectors_complex,1),ci_electronic_energy_complex, &
|
||||||
|
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
||||||
|
|
||||||
|
integer :: N_states_diag_save
|
||||||
|
N_states_diag_save = N_states_diag
|
||||||
|
do while (.not.converged)
|
||||||
|
double precision, allocatable :: ci_electronic_energy_tmp (:)
|
||||||
|
complex*16, allocatable :: ci_eigenvectors_tmp (:,:)
|
||||||
|
double precision, allocatable :: ci_s2_tmp (:)
|
||||||
|
|
||||||
|
N_states_diag *= 2
|
||||||
|
TOUCH N_states_diag
|
||||||
|
|
||||||
|
allocate (ci_electronic_energy_tmp (N_states_diag) )
|
||||||
|
allocate (ci_eigenvectors_tmp (N_det,N_states_diag) )
|
||||||
|
allocate (ci_s2_tmp (N_states_diag) )
|
||||||
|
|
||||||
|
ci_electronic_energy_tmp(1:N_states_diag_save) = ci_electronic_energy_complex(1:N_states_diag_save)
|
||||||
|
ci_eigenvectors_tmp(1:N_det,1:N_states_diag_save) = ci_eigenvectors_complex(1:N_det,1:N_states_diag_save)
|
||||||
|
ci_s2_tmp(1:N_states_diag_save) = ci_s2_complex(1:N_states_diag_save)
|
||||||
|
|
||||||
|
call davidson_diag_hs2_complex(psi_det,ci_eigenvectors_tmp, ci_s2_tmp, &
|
||||||
|
size(ci_eigenvectors_tmp,1),ci_electronic_energy_tmp, &
|
||||||
|
N_det,min(N_det,N_states),min(N_det,N_states_diag),N_int,0,converged)
|
||||||
|
|
||||||
|
ci_electronic_energy_complex(1:N_states_diag_save) = ci_electronic_energy_tmp(1:N_states_diag_save)
|
||||||
|
ci_eigenvectors_complex(1:N_det,1:N_states_diag_save) = ci_eigenvectors_tmp(1:N_det,1:N_states_diag_save)
|
||||||
|
ci_s2_complex(1:N_states_diag_save) = ci_s2_tmp(1:N_states_diag_save)
|
||||||
|
|
||||||
|
deallocate (ci_electronic_energy_tmp)
|
||||||
|
deallocate (ci_eigenvectors_tmp)
|
||||||
|
deallocate (ci_s2_tmp)
|
||||||
|
enddo
|
||||||
|
if (N_states_diag > N_states_diag_save) then
|
||||||
|
N_states_diag = N_states_diag_save
|
||||||
|
TOUCH N_states_diag
|
||||||
|
endif
|
||||||
|
|
||||||
|
else if (diag_algorithm == "Lapack") then
|
||||||
|
|
||||||
|
print *, 'Diagonalization of H using Lapack'
|
||||||
|
allocate (eigenvectors(size(h_matrix_all_dets_complex,1),N_det))
|
||||||
|
allocate (eigenvalues(N_det))
|
||||||
|
if (s2_eig) then
|
||||||
|
double precision, parameter :: alpha = 0.1d0
|
||||||
|
allocate (H_prime(N_det,N_det) )
|
||||||
|
H_prime(1:N_det,1:N_det) = h_matrix_all_dets_complex(1:N_det,1:N_det) + &
|
||||||
|
alpha * s2_matrix_all_dets(1:N_det,1:N_det)
|
||||||
|
do j=1,N_det
|
||||||
|
H_prime(j,j) = H_prime(j,j) + alpha*(s_z2_sz - expected_s2)
|
||||||
|
enddo
|
||||||
|
call lapack_diag_complex(eigenvalues,eigenvectors,H_prime,size(H_prime,1),N_det)
|
||||||
|
ci_electronic_energy_complex(:) = (0.d0,0.d0)
|
||||||
|
i_state = 0
|
||||||
|
allocate (s2_eigvalues(N_det))
|
||||||
|
allocate(index_good_state_array(N_det),good_state_array(N_det))
|
||||||
|
good_state_array = .False.
|
||||||
|
call u_0_s2_u_0_complex(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,&
|
||||||
|
N_det,size(eigenvectors,1))
|
||||||
|
if (only_expected_s2) then
|
||||||
|
do j=1,N_det
|
||||||
|
! Select at least n_states states with S^2 values closed to "expected_s2"
|
||||||
|
if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then
|
||||||
|
i_state +=1
|
||||||
|
index_good_state_array(i_state) = j
|
||||||
|
good_state_array(j) = .True.
|
||||||
|
endif
|
||||||
|
if(i_state.eq.N_states) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do j=1,N_det
|
||||||
|
index_good_state_array(j) = j
|
||||||
|
good_state_array(j) = .True.
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if(i_state .ne.0)then
|
||||||
|
! Fill the first "i_state" states that have a correct S^2 value
|
||||||
|
do j = 1, i_state
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,j) = eigenvectors(i,index_good_state_array(j))
|
||||||
|
enddo
|
||||||
|
ci_electronic_energy_complex(j) = eigenvalues(index_good_state_array(j))
|
||||||
|
ci_s2_complex(j) = s2_eigvalues(index_good_state_array(j))
|
||||||
|
enddo
|
||||||
|
i_other_state = 0
|
||||||
|
do j = 1, N_det
|
||||||
|
if(good_state_array(j))cycle
|
||||||
|
i_other_state +=1
|
||||||
|
if(i_state+i_other_state.gt.n_states_diag)then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,i_state+i_other_state) = eigenvectors(i,j)
|
||||||
|
enddo
|
||||||
|
ci_electronic_energy_complex(i_state+i_other_state) = eigenvalues(j)
|
||||||
|
ci_s2_complex(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
print*,''
|
||||||
|
print*,'!!!!!!!! WARNING !!!!!!!!!'
|
||||||
|
print*,' Within the ',N_det,'determinants selected'
|
||||||
|
print*,' and the ',N_states_diag,'states requested'
|
||||||
|
print*,' We did not find any state with S^2 values close to ',expected_s2
|
||||||
|
print*,' We will then set the first N_states eigenvectors of the H matrix'
|
||||||
|
print*,' as the ci_eigenvectors_complex'
|
||||||
|
print*,' You should consider more states and maybe ask for s2_eig to be .True. or just enlarge the CI space'
|
||||||
|
print*,''
|
||||||
|
do j=1,min(N_states_diag,N_det)
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,j) = eigenvectors(i,j)
|
||||||
|
enddo
|
||||||
|
ci_electronic_energy_complex(j) = eigenvalues(j)
|
||||||
|
ci_s2_complex(j) = s2_eigvalues(j)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
deallocate(index_good_state_array,good_state_array)
|
||||||
|
deallocate(s2_eigvalues)
|
||||||
|
else
|
||||||
|
call lapack_diag_complex(eigenvalues,eigenvectors, &
|
||||||
|
H_matrix_all_dets_complex,size(H_matrix_all_dets,1),N_det)
|
||||||
|
ci_electronic_energy_complex(:) = 0.d0
|
||||||
|
call u_0_S2_u_0_complex(ci_s2_complex,eigenvectors,N_det,psi_det,N_int,&
|
||||||
|
min(N_det,N_states_diag),size(eigenvectors,1))
|
||||||
|
! Select the "N_states_diag" states of lowest energy
|
||||||
|
do j=1,min(N_det,N_states_diag)
|
||||||
|
do i=1,N_det
|
||||||
|
ci_eigenvectors_complex(i,j) = eigenvectors(i,j)
|
||||||
|
enddo
|
||||||
|
ci_electronic_energy_complex(j) = eigenvalues(j)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
do k=1,N_states_diag
|
||||||
|
ci_electronic_energy_complex(k) = 0.d0
|
||||||
|
do j=1,N_det
|
||||||
|
do i=1,N_det
|
||||||
|
!todo: accumulate imag parts to test? (should sum to zero)
|
||||||
|
ci_electronic_energy_complex(k) += &
|
||||||
|
dble(dconjg(ci_eigenvectors_complex(i,k)) * ci_eigenvectors_complex(j,k) * &
|
||||||
|
H_matrix_all_dets_complex(i,j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(eigenvectors,eigenvalues)
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine diagonalize_CI_complex
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Replace the coefficients of the |CI| states by the coefficients of the
|
||||||
|
! eigenstates of the |CI| matrix.
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
do j=1,N_states
|
||||||
|
do i=1,N_det
|
||||||
|
psi_coef_complex(i,j) = ci_eigenvectors_complex(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
|
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||||
|
!todo: touch ci_{s2,electronic_energy}?
|
||||||
|
SOFT_TOUCH psi_coef_complex CI_electronic_energy_complex ci_energy CI_eigenvectors_complex CI_s2_complex psi_energy psi_s2
|
||||||
|
end
|
||||||
|
|
||||||
subroutine diagonalize_CI
|
subroutine diagonalize_CI
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -222,5 +444,6 @@ subroutine diagonalize_CI
|
|||||||
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
psi_energy(1:N_states) = CI_electronic_energy(1:N_states)
|
||||||
psi_s2(1:N_states) = CI_s2(1:N_states)
|
psi_s2(1:N_states) = CI_s2(1:N_states)
|
||||||
|
|
||||||
SOFT_TOUCH psi_coef CI_electronic_energy CI_energy CI_eigenvectors CI_s2 psi_energy psi_s2
|
!todo: touch ci_{s2,electronic_energy}?
|
||||||
|
SOFT_TOUCH psi_coef CI_electronic_energy_real ci_energy CI_eigenvectors CI_s2_real psi_energy psi_s2
|
||||||
end
|
end
|
||||||
|
@ -5,7 +5,8 @@ subroutine print_energy_components()
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer, save :: ifirst = 0
|
integer, save :: ifirst = 0
|
||||||
double precision :: Vee, Ven, Vnn, Vecp, T, f
|
double precision :: Vee, Ven, Vnn, Vecp, T, f
|
||||||
integer :: i,j,k
|
complex*16 :: fc
|
||||||
|
integer :: i,j,k,kk
|
||||||
|
|
||||||
Vnn = nuclear_repulsion
|
Vnn = nuclear_repulsion
|
||||||
|
|
||||||
@ -18,6 +19,22 @@ subroutine print_energy_components()
|
|||||||
Vecp = 0.d0
|
Vecp = 0.d0
|
||||||
T = 0.d0
|
T = 0.d0
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do j=1,mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
!fc = one_e_dm_mo_alpha_complex(i,j,k) + one_e_dm_mo_beta_complex(i,j,k)
|
||||||
|
!Ven = Ven + dble(fc * mo_integrals_n_e_complex(j,i))
|
||||||
|
!Vecp = Vecp + dble(fc * mo_pseudo_integrals_complex(j,i))
|
||||||
|
!T = T + dble(fc * mo_kinetic_integrals_complex(j,i))
|
||||||
|
fc = one_e_dm_mo_alpha_kpts(i,j,kk,k) + one_e_dm_mo_beta_kpts(i,j,kk,k)
|
||||||
|
Ven = Ven + dble(fc * mo_integrals_n_e_kpts(j,i,kk))
|
||||||
|
Vecp = Vecp + dble(fc * mo_pseudo_integrals_kpts(j,i,kk))
|
||||||
|
T = T + dble(fc * mo_kinetic_integrals_kpts(j,i,kk))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do j=1,mo_num
|
do j=1,mo_num
|
||||||
do i=1,mo_num
|
do i=1,mo_num
|
||||||
f = one_e_dm_mo_alpha(i,j,k) + one_e_dm_mo_beta(i,j,k)
|
f = one_e_dm_mo_alpha(i,j,k) + one_e_dm_mo_beta(i,j,k)
|
||||||
@ -26,6 +43,7 @@ subroutine print_energy_components()
|
|||||||
T = T + f * mo_kinetic_integrals(i,j)
|
T = T + f * mo_kinetic_integrals(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
Vee = psi_energy(k) - Ven - Vecp - T
|
Vee = psi_energy(k) - Ven - Vecp - T
|
||||||
|
|
||||||
if (ifirst == 0) then
|
if (ifirst == 0) then
|
||||||
|
@ -5,8 +5,13 @@
|
|||||||
! psi_energy(i) = $\langle \Psi_i | H | \Psi_i \rangle$
|
! psi_energy(i) = $\langle \Psi_i | H | \Psi_i \rangle$
|
||||||
!
|
!
|
||||||
! psi_s2(i) = $\langle \Psi_i | S^2 | \Psi_i \rangle$
|
! psi_s2(i) = $\langle \Psi_i | S^2 | \Psi_i \rangle$
|
||||||
|
! real and complex
|
||||||
END_DOC
|
END_DOC
|
||||||
|
if (is_complex) then
|
||||||
|
call u_0_h_u_0_complex(psi_energy,psi_s2,psi_coef_complex,N_det,psi_det,N_int,N_states,psi_det_size)
|
||||||
|
else
|
||||||
call u_0_H_u_0(psi_energy,psi_s2,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size)
|
call u_0_H_u_0(psi_energy,psi_s2,psi_coef,N_det,psi_det,N_int,N_states,psi_det_size)
|
||||||
|
endif
|
||||||
integer :: i
|
integer :: i
|
||||||
do i=N_det+1,N_states
|
do i=N_det+1,N_states
|
||||||
psi_energy(i) = 0.d0
|
psi_energy(i) = 0.d0
|
||||||
@ -708,3 +713,702 @@ N_int;;
|
|||||||
END_TEMPLATE
|
END_TEMPLATE
|
||||||
|
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
subroutine u_0_H_u_0_complex(e_0,s_0,u_0,n,keys_tmp,Nint,N_st,sze)
|
||||||
|
!todo: check normalization for complex
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $E_0 = \frac{\langle u_0 | H | u_0 \rangle}{\langle u_0 | u_0 \rangle}$
|
||||||
|
!
|
||||||
|
! and $S_0 = \frac{\langle u_0 | S^2 | u_0 \rangle}{\langle u_0 | u_0 \rangle}$
|
||||||
|
!
|
||||||
|
! n : number of determinants
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n,Nint, N_st, sze
|
||||||
|
double precision, intent(out) :: e_0(N_st),s_0(N_st)
|
||||||
|
complex*16, intent(inout) :: u_0(sze,N_st)
|
||||||
|
integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
|
||||||
|
|
||||||
|
complex*16, allocatable :: v_0(:,:), s_vec(:,:), u_1(:,:)
|
||||||
|
double precision :: u_dot_u_complex,diag_H_mat_elem
|
||||||
|
complex*16 :: u_dot_v_complex
|
||||||
|
integer :: i,j, istate
|
||||||
|
|
||||||
|
if ((n > 100000).and.distributed_davidson) then
|
||||||
|
allocate (v_0(n,N_states_diag),s_vec(n,N_states_diag), u_1(n,N_states_diag))
|
||||||
|
u_1(:,:) = (0.d0,0.d0)
|
||||||
|
u_1(1:n,1:N_st) = u_0(1:n,1:N_st)
|
||||||
|
call h_s2_u_0_nstates_zmq_complex(v_0,s_vec,u_1,N_states_diag,n)
|
||||||
|
else if (n < n_det_max_full) then
|
||||||
|
allocate (v_0(n,N_st),s_vec(n,N_st), u_1(n,N_st))
|
||||||
|
v_0(:,:) = (0.d0,0.d0)
|
||||||
|
u_1(:,:) = (0.d0,0.d0)
|
||||||
|
s_vec(:,:) = (0.d0,0.d0)
|
||||||
|
u_1(1:n,1:N_st) = u_0(1:n,1:N_st)
|
||||||
|
do istate = 1,N_st
|
||||||
|
do j=1,n
|
||||||
|
do i=1,n
|
||||||
|
v_0(i,istate) = v_0(i,istate) + h_matrix_all_dets_complex(i,j) * u_0(j,istate)
|
||||||
|
s_vec(i,istate) = s_vec(i,istate) + S2_matrix_all_dets(i,j) * u_0(j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
allocate (v_0(n,N_st),s_vec(n,N_st),u_1(n,N_st))
|
||||||
|
u_1(:,:) = (0.d0,0.d0)
|
||||||
|
u_1(1:n,1:N_st) = u_0(1:n,1:N_st)
|
||||||
|
call h_s2_u_0_nstates_openmp_complex(v_0,s_vec,u_1,N_st,n)
|
||||||
|
endif
|
||||||
|
u_0(1:n,1:N_st) = u_1(1:n,1:N_st)
|
||||||
|
deallocate(u_1)
|
||||||
|
double precision :: norm
|
||||||
|
!$OMP PARALLEL DO PRIVATE(i,norm) DEFAULT(SHARED)
|
||||||
|
do i=1,N_st
|
||||||
|
norm = u_dot_u_complex(u_0(1,i),n)
|
||||||
|
if (norm /= 0.d0) then
|
||||||
|
!todo: should these be normalized? is u_0 already normalized? (if so, where?)
|
||||||
|
e_0(i) = dble(u_dot_v_complex(v_0(1,i),u_0(1,i),n))
|
||||||
|
s_0(i) = dble(u_dot_v_complex(s_vec(1,i),u_0(1,i),n))
|
||||||
|
else
|
||||||
|
e_0(i) = 0.d0
|
||||||
|
s_0(i) = 0.d0
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
deallocate (s_vec, v_0)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine H_S2_u_0_nstates_openmp_complex(v_0,s_0,u_0,N_st,sze)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $v_0 = H | u_0\rangle$ and $s_0 = S^2 | u_0\rangle$.
|
||||||
|
!
|
||||||
|
! Assumes that the determinants are in psi_det
|
||||||
|
!
|
||||||
|
! istart, iend, ishift, istep are used in ZMQ parallelization.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: N_st,sze
|
||||||
|
complex*16, intent(inout) :: v_0(sze,N_st), s_0(sze,N_st), u_0(sze,N_st)
|
||||||
|
integer :: k
|
||||||
|
complex*16, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: u_t
|
||||||
|
allocate(u_t(N_st,N_det),v_t(N_st,N_det),s_t(N_st,N_det))
|
||||||
|
|
||||||
|
do k=1,N_st
|
||||||
|
call cdset_order(u_0(1,k),psi_bilinear_matrix_order,N_det)
|
||||||
|
enddo
|
||||||
|
v_t = (0.d0,0.d0)
|
||||||
|
s_t = (0.d0,0.d0)
|
||||||
|
call cdtranspose( &
|
||||||
|
u_0, &
|
||||||
|
size(u_0, 1), &
|
||||||
|
u_t, &
|
||||||
|
size(u_t, 1), &
|
||||||
|
N_det, N_st)
|
||||||
|
|
||||||
|
call h_s2_u_0_nstates_openmp_work_complex(v_t,s_t,u_t,N_st,sze,1,N_det,0,1)
|
||||||
|
deallocate(u_t)
|
||||||
|
|
||||||
|
call cdtranspose( &
|
||||||
|
v_t, &
|
||||||
|
size(v_t, 1), &
|
||||||
|
v_0, &
|
||||||
|
size(v_0, 1), &
|
||||||
|
N_st, N_det)
|
||||||
|
call cdtranspose( &
|
||||||
|
s_t, &
|
||||||
|
size(s_t, 1), &
|
||||||
|
s_0, &
|
||||||
|
size(s_0, 1), &
|
||||||
|
N_st, N_det)
|
||||||
|
deallocate(v_t,s_t)
|
||||||
|
|
||||||
|
do k=1,N_st
|
||||||
|
call cdset_order(v_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
call cdset_order(s_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
call cdset_order(u_0(1,k),psi_bilinear_matrix_order_reverse,N_det)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end
|
||||||
|
subroutine h_s2_u_0_nstates_openmp_work_complex(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $v_t = H | u_t\rangle$ and $s_t = S^2 | u_t\rangle$
|
||||||
|
!
|
||||||
|
! Default should be 1,N_det,0,1
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: N_st,sze,istart,iend,ishift,istep
|
||||||
|
complex*16, intent(in) :: u_t(N_st,N_det)
|
||||||
|
complex*16, intent(out) :: v_t(N_st,sze), s_t(N_st,sze)
|
||||||
|
|
||||||
|
|
||||||
|
PROVIDE ref_bitmask_energy N_int
|
||||||
|
|
||||||
|
select case (N_int)
|
||||||
|
case (1)
|
||||||
|
call H_S2_u_0_nstates_openmp_work_complex_1(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
case (2)
|
||||||
|
call H_S2_u_0_nstates_openmp_work_complex_2(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
case (3)
|
||||||
|
call H_S2_u_0_nstates_openmp_work_complex_3(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
case (4)
|
||||||
|
call H_S2_u_0_nstates_openmp_work_complex_4(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
case default
|
||||||
|
call H_S2_u_0_nstates_openmp_work_complex_N_int(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
|
||||||
|
subroutine H_S2_u_0_nstates_openmp_work_complex_$N_int(v_t,s_t,u_t,N_st,sze,istart,iend,ishift,istep)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $v_t = H | u_t \\rangle$ and $s_t = S^2 | u_t\\rangle$
|
||||||
|
!
|
||||||
|
! Default should be 1,N_det,0,1
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: N_st,sze,istart,iend,ishift,istep
|
||||||
|
complex*16, intent(in) :: u_t(N_st,N_det)
|
||||||
|
complex*16, intent(out) :: v_t(N_st,sze), s_t(N_st,sze)
|
||||||
|
|
||||||
|
complex*16 :: hij, sij
|
||||||
|
integer :: i,j,k,l,kk
|
||||||
|
integer :: k_a, k_b, l_a, l_b, m_a, m_b
|
||||||
|
integer :: istate
|
||||||
|
integer :: krow, kcol, krow_b, kcol_b
|
||||||
|
integer :: lrow, lcol
|
||||||
|
integer :: mrow, mcol
|
||||||
|
integer(bit_kind) :: spindet($N_int)
|
||||||
|
integer(bit_kind) :: tmp_det($N_int,2)
|
||||||
|
integer(bit_kind) :: tmp_det2($N_int,2)
|
||||||
|
integer(bit_kind) :: tmp_det3($N_int,2)
|
||||||
|
integer(bit_kind), allocatable :: buffer(:,:)
|
||||||
|
integer :: n_doubles
|
||||||
|
integer, allocatable :: doubles(:)
|
||||||
|
integer, allocatable :: singles_a(:)
|
||||||
|
integer, allocatable :: singles_b(:)
|
||||||
|
integer, allocatable :: idx(:), idx0(:)
|
||||||
|
integer :: maxab, n_singles_a, n_singles_b, kcol_prev
|
||||||
|
integer*8 :: k8
|
||||||
|
logical :: compute_singles
|
||||||
|
integer*8 :: last_found, left, right, right_max
|
||||||
|
double precision :: rss, mem, ratio
|
||||||
|
complex*16, allocatable :: utl(:,:)
|
||||||
|
integer, parameter :: block_size=128
|
||||||
|
|
||||||
|
! call resident_memory(rss)
|
||||||
|
! mem = dble(singles_beta_csc_size) / 1024.d0**3
|
||||||
|
!
|
||||||
|
! compute_singles = (mem+rss > qp_max_mem)
|
||||||
|
!
|
||||||
|
! if (.not.compute_singles) then
|
||||||
|
! provide singles_beta_csc
|
||||||
|
! endif
|
||||||
|
compute_singles=.True.
|
||||||
|
|
||||||
|
maxab = max(N_det_alpha_unique, N_det_beta_unique)+1
|
||||||
|
allocate(idx0(maxab))
|
||||||
|
|
||||||
|
do i=1,maxab
|
||||||
|
idx0(i) = i
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Prepare the array of all alpha single excitations
|
||||||
|
! -------------------------------------------------
|
||||||
|
|
||||||
|
PROVIDE N_int nthreads_davidson
|
||||||
|
!$OMP PARALLEL DEFAULT(SHARED) NUM_THREADS(nthreads_davidson) &
|
||||||
|
!$OMP SHARED(psi_bilinear_matrix_rows, N_det, &
|
||||||
|
!$OMP psi_bilinear_matrix_columns, &
|
||||||
|
!$OMP psi_det_alpha_unique, psi_det_beta_unique, &
|
||||||
|
!$OMP n_det_alpha_unique, n_det_beta_unique, N_int, &
|
||||||
|
!$OMP psi_bilinear_matrix_transp_rows, &
|
||||||
|
!$OMP psi_bilinear_matrix_transp_columns, &
|
||||||
|
!$OMP psi_bilinear_matrix_transp_order, N_st, &
|
||||||
|
!$OMP psi_bilinear_matrix_order_transp_reverse, &
|
||||||
|
!$OMP psi_bilinear_matrix_columns_loc, &
|
||||||
|
!$OMP psi_bilinear_matrix_transp_rows_loc, &
|
||||||
|
!$OMP istart, iend, istep, irp_here, v_t, s_t, &
|
||||||
|
!$OMP ishift, idx0, u_t, maxab, compute_singles, &
|
||||||
|
!$OMP singles_alpha_csc,singles_alpha_csc_idx, &
|
||||||
|
!$OMP singles_beta_csc,singles_beta_csc_idx) &
|
||||||
|
!$OMP PRIVATE(krow, kcol, tmp_det, spindet, k_a, k_b, i, &
|
||||||
|
!$OMP lcol, lrow, l_a, l_b, utl, kk, &
|
||||||
|
!$OMP buffer, doubles, n_doubles, &
|
||||||
|
!$OMP tmp_det2, hij, sij, idx, l, kcol_prev, &
|
||||||
|
!$OMP singles_a, n_singles_a, singles_b, ratio, &
|
||||||
|
!$OMP n_singles_b, k8, last_found,left,right,right_max)
|
||||||
|
|
||||||
|
! Alpha/Beta double excitations
|
||||||
|
! =============================
|
||||||
|
|
||||||
|
allocate( buffer($N_int,maxab), &
|
||||||
|
singles_a(maxab), &
|
||||||
|
singles_b(maxab), &
|
||||||
|
doubles(maxab), &
|
||||||
|
idx(maxab), utl(N_st,block_size))
|
||||||
|
|
||||||
|
kcol_prev=-1
|
||||||
|
|
||||||
|
ASSERT (iend <= N_det)
|
||||||
|
ASSERT (istart > 0)
|
||||||
|
ASSERT (istep > 0)
|
||||||
|
|
||||||
|
!$OMP DO SCHEDULE(guided,64)
|
||||||
|
do k_a=istart+ishift,iend,istep
|
||||||
|
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
|
||||||
|
|
||||||
|
if (kcol /= kcol_prev) then
|
||||||
|
tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
|
||||||
|
if (compute_singles) then
|
||||||
|
call get_all_spin_singles_$N_int( &
|
||||||
|
psi_det_beta_unique, idx0, &
|
||||||
|
tmp_det(1,2), N_det_beta_unique, &
|
||||||
|
singles_b, n_singles_b)
|
||||||
|
else
|
||||||
|
n_singles_b = 0
|
||||||
|
!DIR$ LOOP COUNT avg(1000)
|
||||||
|
do k8=singles_beta_csc_idx(kcol),singles_beta_csc_idx(kcol+1)-1
|
||||||
|
n_singles_b = n_singles_b+1
|
||||||
|
singles_b(n_singles_b) = singles_beta_csc(k8)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
kcol_prev = kcol
|
||||||
|
|
||||||
|
! Loop over singly excited beta columns
|
||||||
|
! -------------------------------------
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT avg(1000)
|
||||||
|
do i=1,n_singles_b
|
||||||
|
lcol = singles_b(i)
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,2) = psi_det_beta_unique(1:$N_int, lcol)
|
||||||
|
|
||||||
|
!---
|
||||||
|
! if (compute_singles) then
|
||||||
|
|
||||||
|
l_a = psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
!DIR$ UNROLL(8)
|
||||||
|
!DIR$ LOOP COUNT avg(50000)
|
||||||
|
do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
buffer(1:$N_int,j) = psi_det_alpha_unique(1:$N_int, lrow) ! hot spot
|
||||||
|
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
idx(j) = l_a
|
||||||
|
l_a = l_a+1
|
||||||
|
enddo
|
||||||
|
j = j-1
|
||||||
|
|
||||||
|
call get_all_spin_singles_$N_int( &
|
||||||
|
buffer, idx, tmp_det(1,1), j, &
|
||||||
|
singles_a, n_singles_a )
|
||||||
|
|
||||||
|
!-----
|
||||||
|
! else
|
||||||
|
!
|
||||||
|
! ! Search for singles
|
||||||
|
!
|
||||||
|
!call cpu_time(time0)
|
||||||
|
! ! Right boundary
|
||||||
|
! l_a = psi_bilinear_matrix_columns_loc(lcol+1)-1
|
||||||
|
! ASSERT (l_a <= N_det)
|
||||||
|
! do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
! lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
! ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
!
|
||||||
|
! left = singles_alpha_csc_idx(krow)
|
||||||
|
! right_max = -1_8
|
||||||
|
! right = singles_alpha_csc_idx(krow+1)
|
||||||
|
! do while (right-left>0_8)
|
||||||
|
! k8 = shiftr(right+left,1)
|
||||||
|
! if (singles_alpha_csc(k8) > lrow) then
|
||||||
|
! right = k8
|
||||||
|
! else if (singles_alpha_csc(k8) < lrow) then
|
||||||
|
! left = k8 + 1_8
|
||||||
|
! else
|
||||||
|
! right_max = k8+1_8
|
||||||
|
! exit
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! if (right_max > 0_8) exit
|
||||||
|
! l_a = l_a-1
|
||||||
|
! enddo
|
||||||
|
! if (right_max < 0_8) right_max = singles_alpha_csc_idx(krow)
|
||||||
|
!
|
||||||
|
! ! Search
|
||||||
|
! n_singles_a = 0
|
||||||
|
! l_a = psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
! ASSERT (l_a <= N_det)
|
||||||
|
!
|
||||||
|
! last_found = singles_alpha_csc_idx(krow)
|
||||||
|
! do j=1,psi_bilinear_matrix_columns_loc(lcol+1) - psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
! lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
! ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
!
|
||||||
|
! left = last_found
|
||||||
|
! right = right_max
|
||||||
|
! do while (right-left>0_8)
|
||||||
|
! k8 = shiftr(right+left,1)
|
||||||
|
! if (singles_alpha_csc(k8) > lrow) then
|
||||||
|
! right = k8
|
||||||
|
! else if (singles_alpha_csc(k8) < lrow) then
|
||||||
|
! left = k8 + 1_8
|
||||||
|
! else
|
||||||
|
! n_singles_a += 1
|
||||||
|
! singles_a(n_singles_a) = l_a
|
||||||
|
! last_found = k8+1_8
|
||||||
|
! exit
|
||||||
|
! endif
|
||||||
|
! enddo
|
||||||
|
! l_a = l_a+1
|
||||||
|
! enddo
|
||||||
|
! j = j-1
|
||||||
|
!
|
||||||
|
! endif
|
||||||
|
!-----
|
||||||
|
|
||||||
|
! Loop over alpha singles
|
||||||
|
! -----------------------
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT avg(1000)
|
||||||
|
do k = 1,n_singles_a,block_size
|
||||||
|
! Prefetch u_t(:,l_a)
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (k+kk > n_singles_a) exit
|
||||||
|
l_a = singles_a(k+kk)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
do l=1,N_st
|
||||||
|
utl(l,kk+1) = u_t(l,l_a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (k+kk > n_singles_a) exit
|
||||||
|
l_a = singles_a(k+kk)
|
||||||
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
call i_h_j_double_alpha_beta_complex(tmp_det,tmp_det2,$N_int,hij)
|
||||||
|
call get_s2(tmp_det,tmp_det2,$N_int,sij)
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
|
s_t(l,k_a) = s_t(l,k_a) + sij * utl(l,kk+1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO
|
||||||
|
|
||||||
|
!$OMP DO SCHEDULE(guided,64)
|
||||||
|
do k_a=istart+ishift,iend,istep
|
||||||
|
|
||||||
|
|
||||||
|
! Single and double alpha excitations
|
||||||
|
! ===================================
|
||||||
|
|
||||||
|
|
||||||
|
! Initial determinant is at k_a in alpha-major representation
|
||||||
|
! -----------------------------------------------------------------------
|
||||||
|
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
|
||||||
|
tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
|
||||||
|
|
||||||
|
! Initial determinant is at k_b in beta-major representation
|
||||||
|
! ----------------------------------------------------------------------
|
||||||
|
|
||||||
|
k_b = psi_bilinear_matrix_order_transp_reverse(k_a)
|
||||||
|
ASSERT (k_b <= N_det)
|
||||||
|
|
||||||
|
spindet(1:$N_int) = tmp_det(1:$N_int,1)
|
||||||
|
|
||||||
|
! Loop inside the beta column to gather all the connected alphas
|
||||||
|
lcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
l_a = psi_bilinear_matrix_columns_loc(lcol)
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT avg(200000)
|
||||||
|
do i=1,N_det_alpha_unique
|
||||||
|
if (l_a > N_det) exit
|
||||||
|
lcol = psi_bilinear_matrix_columns(l_a)
|
||||||
|
if (lcol /= kcol) exit
|
||||||
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
buffer(1:$N_int,i) = psi_det_alpha_unique(1:$N_int, lrow) ! Hot spot
|
||||||
|
idx(i) = l_a
|
||||||
|
l_a = l_a+1
|
||||||
|
enddo
|
||||||
|
i = i-1
|
||||||
|
|
||||||
|
call get_all_spin_singles_and_doubles_$N_int( &
|
||||||
|
buffer, idx, spindet, i, &
|
||||||
|
singles_a, doubles, n_singles_a, n_doubles )
|
||||||
|
|
||||||
|
! Compute Hij for all alpha singles
|
||||||
|
! ----------------------------------
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
|
||||||
|
!DIR$ LOOP COUNT avg(1000)
|
||||||
|
do i=1,n_singles_a,block_size
|
||||||
|
! Prefetch u_t(:,l_a)
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_singles_a) exit
|
||||||
|
l_a = singles_a(i+kk)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
do l=1,N_st
|
||||||
|
utl(l,kk+1) = u_t(l,l_a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_singles_a) exit
|
||||||
|
l_a = singles_a(i+kk)
|
||||||
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
|
! single => sij = 0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
! Compute Hij for all alpha doubles
|
||||||
|
! ----------------------------------
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT avg(50000)
|
||||||
|
do i=1,n_doubles,block_size
|
||||||
|
! Prefetch u_t(:,l_a)
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_doubles) exit
|
||||||
|
l_a = doubles(i+kk)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
do l=1,N_st
|
||||||
|
utl(l,kk+1) = u_t(l,l_a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_doubles) exit
|
||||||
|
l_a = doubles(i+kk)
|
||||||
|
lrow = psi_bilinear_matrix_rows(l_a)
|
||||||
|
ASSERT (lrow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
call i_h_j_double_spin_complex( tmp_det(1,1), psi_det_alpha_unique(1, lrow), $N_int, hij)
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
|
! same spin => sij = 0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
! Single and double beta excitations
|
||||||
|
! ==================================
|
||||||
|
|
||||||
|
|
||||||
|
! Initial determinant is at k_a in alpha-major representation
|
||||||
|
! -----------------------------------------------------------------------
|
||||||
|
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
|
||||||
|
tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
|
||||||
|
tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
|
||||||
|
|
||||||
|
spindet(1:$N_int) = tmp_det(1:$N_int,2)
|
||||||
|
|
||||||
|
! Initial determinant is at k_b in beta-major representation
|
||||||
|
! -----------------------------------------------------------------------
|
||||||
|
|
||||||
|
k_b = psi_bilinear_matrix_order_transp_reverse(k_a)
|
||||||
|
ASSERT (k_b <= N_det)
|
||||||
|
|
||||||
|
! Loop inside the alpha row to gather all the connected betas
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(k_b)
|
||||||
|
l_b = psi_bilinear_matrix_transp_rows_loc(lrow)
|
||||||
|
!DIR$ LOOP COUNT avg(200000)
|
||||||
|
do i=1,N_det_beta_unique
|
||||||
|
if (l_b > N_det) exit
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l_b)
|
||||||
|
if (lrow /= krow) exit
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
|
ASSERT (lcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
buffer(1:$N_int,i) = psi_det_beta_unique(1:$N_int, lcol)
|
||||||
|
idx(i) = l_b
|
||||||
|
l_b = l_b+1
|
||||||
|
enddo
|
||||||
|
i = i-1
|
||||||
|
|
||||||
|
call get_all_spin_singles_and_doubles_$N_int( &
|
||||||
|
buffer, idx, spindet, i, &
|
||||||
|
singles_b, doubles, n_singles_b, n_doubles )
|
||||||
|
|
||||||
|
! Compute Hij for all beta singles
|
||||||
|
! ----------------------------------
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
|
||||||
|
!DIR$ LOOP COUNT avg(1000)
|
||||||
|
do i=1,n_singles_b,block_size
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_singles_b) exit
|
||||||
|
l_b = singles_b(i+kk)
|
||||||
|
ASSERT (l_b <= N_det)
|
||||||
|
|
||||||
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
do l=1,N_st
|
||||||
|
utl(l,kk+1) = u_t(l,l_a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_singles_b) exit
|
||||||
|
l_b = singles_b(i+kk)
|
||||||
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
|
ASSERT (lcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol)
|
||||||
|
call i_h_j_single_spin_complex( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
|
! single => sij = 0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! Compute Hij for all beta doubles
|
||||||
|
! ----------------------------------
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT avg(50000)
|
||||||
|
do i=1,n_doubles,block_size
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_doubles) exit
|
||||||
|
l_b = doubles(i+kk)
|
||||||
|
ASSERT (l_b <= N_det)
|
||||||
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
ASSERT (l_a <= N_det)
|
||||||
|
|
||||||
|
do l=1,N_st
|
||||||
|
utl(l,kk+1) = u_t(l,l_a)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do kk=0,block_size-1
|
||||||
|
if (i+kk > n_doubles) exit
|
||||||
|
l_b = doubles(i+kk)
|
||||||
|
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l_b)
|
||||||
|
ASSERT (lcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
call i_h_j_double_spin_complex( tmp_det(1,2), psi_det_beta_unique(1, lcol), $N_int, hij)
|
||||||
|
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
!todo: check arg order conjg/noconjg (should be okay)
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * utl(l,kk+1)
|
||||||
|
! same spin => sij = 0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
! Diagonal contribution
|
||||||
|
! =====================
|
||||||
|
|
||||||
|
|
||||||
|
! Initial determinant is at k_a in alpha-major representation
|
||||||
|
! -----------------------------------------------------------------------
|
||||||
|
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, krow)
|
||||||
|
tmp_det(1:$N_int,2) = psi_det_beta_unique (1:$N_int, kcol)
|
||||||
|
|
||||||
|
double precision, external :: diag_H_mat_elem, diag_S_mat_elem
|
||||||
|
|
||||||
|
hij = dcmplx(diag_H_mat_elem(tmp_det,$N_int),0.d0)
|
||||||
|
sij = dcmplx(diag_S_mat_elem(tmp_det,$N_int),0.d0)
|
||||||
|
!DIR$ LOOP COUNT AVG(4)
|
||||||
|
do l=1,N_st
|
||||||
|
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,k_a)
|
||||||
|
s_t(l,k_a) = s_t(l,k_a) + sij * u_t(l,k_a)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end do
|
||||||
|
!$OMP END DO
|
||||||
|
deallocate(buffer, singles_a, singles_b, doubles, idx, utl)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
SUBST [ N_int ]
|
||||||
|
|
||||||
|
1;;
|
||||||
|
2;;
|
||||||
|
3;;
|
||||||
|
4;;
|
||||||
|
N_int;;
|
||||||
|
|
||||||
|
END_TEMPLATE
|
||||||
|
|
||||||
|
|
||||||
|
@ -84,6 +84,12 @@ doc: Coefficients of the wave function
|
|||||||
type: double precision
|
type: double precision
|
||||||
size: (determinants.n_det,determinants.n_states)
|
size: (determinants.n_det,determinants.n_states)
|
||||||
|
|
||||||
|
[psi_coef_complex]
|
||||||
|
interface: ezfio
|
||||||
|
doc: Coefficients of the wave function
|
||||||
|
type: double precision
|
||||||
|
size: (2,determinants.n_det,determinants.n_states)
|
||||||
|
|
||||||
[psi_det]
|
[psi_det]
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
doc: Determinants of the variational space
|
doc: Determinants of the variational space
|
||||||
@ -96,6 +102,12 @@ doc: Coefficients of the wave function
|
|||||||
type: double precision
|
type: double precision
|
||||||
size: (determinants.n_det_qp_edit,determinants.n_states)
|
size: (determinants.n_det_qp_edit,determinants.n_states)
|
||||||
|
|
||||||
|
[psi_coef_complex_qp_edit]
|
||||||
|
interface: ezfio
|
||||||
|
doc: Coefficients of the wave function
|
||||||
|
type: double precision
|
||||||
|
size: (2,determinants.n_det_qp_edit,determinants.n_states)
|
||||||
|
|
||||||
[psi_det_qp_edit]
|
[psi_det_qp_edit]
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
doc: Determinants of the variational space
|
doc: Determinants of the variational space
|
||||||
|
@ -80,6 +80,33 @@ subroutine build_singly_excited_wavefunction(i_hole,i_particle,ispin,det_out,coe
|
|||||||
enddo
|
enddo
|
||||||
end
|
end
|
||||||
|
|
||||||
|
subroutine build_singly_excited_wavefunction_complex(i_hole,i_particle,ispin,det_out,coef_out)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Applies the single excitation operator : a^{dager}_(i_particle) a_(i_hole) of
|
||||||
|
! spin = ispin to the current wave function (psi_det, psi_coef)
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: i_hole,i_particle,ispin
|
||||||
|
integer(bit_kind), intent(out) :: det_out(N_int,2,N_det)
|
||||||
|
complex*16, intent(out) :: coef_out(N_det,N_states)
|
||||||
|
|
||||||
|
integer :: k
|
||||||
|
integer :: i_ok
|
||||||
|
double precision :: phase
|
||||||
|
do k=1,N_det
|
||||||
|
coef_out(k,:) = psi_coef(k,:)
|
||||||
|
det_out(:,:,k) = psi_det(:,:,k)
|
||||||
|
call do_single_excitation(det_out(1,1,k),i_hole,i_particle,ispin,i_ok)
|
||||||
|
if (i_ok == 1) then
|
||||||
|
call get_phase(psi_det(1,1,k), det_out(1,1,k),phase,N_int)
|
||||||
|
coef_out(k,:) = phase * coef_out(k,:)
|
||||||
|
else
|
||||||
|
coef_out(k,:) = (0.d0,0.d0)
|
||||||
|
det_out(:,:,k) = psi_det(:,:,k)
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
logical function is_spin_flip_possible(key_in,i_flip,ispin)
|
logical function is_spin_flip_possible(key_in,i_flip,ispin)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -257,7 +257,35 @@ subroutine set_natural_mos
|
|||||||
double precision, allocatable :: tmp(:,:)
|
double precision, allocatable :: tmp(:,:)
|
||||||
|
|
||||||
label = "Natural"
|
label = "Natural"
|
||||||
integer :: i,j,iorb,jorb
|
integer :: i,j,iorb,jorb,k
|
||||||
|
if (is_complex) then
|
||||||
|
|
||||||
|
!todo: implement for kpts
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i = 1, n_virt_orb_kpts(k)
|
||||||
|
iorb = list_virt_kpts(i,k)
|
||||||
|
do j = 1, n_core_inact_act_orb_kpts(k)
|
||||||
|
jorb = list_core_inact_act_kpts(j,k)
|
||||||
|
if(cdabs(one_e_dm_mo_kpts(iorb,jorb,k)).ne. 0.d0)then
|
||||||
|
print*,'AHAHAH'
|
||||||
|
print*,iorb,jorb,k,one_e_dm_mo_kpts(iorb,jorb,k)
|
||||||
|
stop
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!print*,'1RDM'
|
||||||
|
!do k=1,kpt_num
|
||||||
|
! do j=1,mo_num_per_kpt
|
||||||
|
! do i=1,mo_num_per_kpt
|
||||||
|
! print'(3(I5),2(E25.15))',i,j,k,one_e_dm_mo_kpts(i,j,k)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
! call mo_as_svd_vectors_of_mo_matrix_eig_complex(one_e_dm_mo_complex,size(one_e_dm_mo_complex,1),mo_num,mo_num,mo_occ,label)
|
||||||
|
call mo_as_svd_vectors_of_mo_matrix_eig_kpts(one_e_dm_mo_kpts,size(one_e_dm_mo_kpts,1),mo_num_per_kpt,mo_num_per_kpt,kpt_num,mo_occ_kpts,label)
|
||||||
|
soft_touch mo_occ_kpts
|
||||||
|
else
|
||||||
do i = 1, n_virt_orb
|
do i = 1, n_virt_orb
|
||||||
iorb = list_virt(i)
|
iorb = list_virt(i)
|
||||||
do j = 1, n_core_inact_act_orb
|
do j = 1, n_core_inact_act_orb
|
||||||
@ -271,6 +299,7 @@ subroutine set_natural_mos
|
|||||||
enddo
|
enddo
|
||||||
call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)
|
call mo_as_svd_vectors_of_mo_matrix_eig(one_e_dm_mo,size(one_e_dm_mo,1),mo_num,mo_num,mo_occ,label)
|
||||||
soft_touch mo_occ
|
soft_touch mo_occ
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
subroutine save_natural_mos
|
subroutine save_natural_mos
|
||||||
@ -292,11 +321,19 @@ BEGIN_PROVIDER [ double precision, c0_weight, (N_states) ]
|
|||||||
if (N_states > 1) then
|
if (N_states > 1) then
|
||||||
integer :: i
|
integer :: i
|
||||||
double precision :: c
|
double precision :: c
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_states
|
||||||
|
c0_weight(i) = 1.d-31
|
||||||
|
c = maxval(cdabs(psi_coef_complex(:,i) * psi_coef_complex(:,i)))
|
||||||
|
c0_weight(i) = 1.d0/(c+1.d-20)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
c0_weight(i) = 1.d-31
|
c0_weight(i) = 1.d-31
|
||||||
c = maxval(psi_coef(:,i) * psi_coef(:,i))
|
c = maxval(psi_coef(:,i) * psi_coef(:,i))
|
||||||
c0_weight(i) = 1.d0/(c+1.d-20)
|
c0_weight(i) = 1.d0/(c+1.d-20)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
c = 1.d0/minval(c0_weight(:))
|
c = 1.d0/minval(c0_weight(:))
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
c0_weight(i) = c0_weight(i) * c
|
c0_weight(i) = c0_weight(i) * c
|
||||||
@ -398,8 +435,23 @@ subroutine get_occupation_from_dets(istate,occupation)
|
|||||||
ASSERT (istate <= N_states)
|
ASSERT (istate <= N_states)
|
||||||
|
|
||||||
occupation = 0.d0
|
occupation = 0.d0
|
||||||
double precision, external :: u_dot_u
|
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
double precision, external :: u_dot_u_complex
|
||||||
|
norm_2 = 1.d0/u_dot_u_complex(psi_coef_complex(1,istate),N_det)
|
||||||
|
|
||||||
|
do i=1,N_det
|
||||||
|
c = cdabs(psi_coef_complex(i,istate)*psi_coef_complex(i,istate))*norm_2
|
||||||
|
call bitstring_to_list_ab(psi_det(1,1,i), list, n_elements, N_int)
|
||||||
|
do ispin=1,2
|
||||||
|
do j=1,n_elements(ispin)
|
||||||
|
ASSERT ( list(j,ispin) < mo_num )
|
||||||
|
occupation( list(j,ispin) ) += c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
double precision, external :: u_dot_u
|
||||||
norm_2 = 1.d0/u_dot_u(psi_coef(1,istate),N_det)
|
norm_2 = 1.d0/u_dot_u(psi_coef(1,istate),N_det)
|
||||||
|
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -412,5 +464,6 @@ subroutine get_occupation_from_dets(istate,occupation)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
694
src/determinants/density_matrix_cplx.irp.f
Normal file
694
src/determinants/density_matrix_cplx.irp.f
Normal file
@ -0,0 +1,694 @@
|
|||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_average_complex, (mo_num,mo_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_average_complex, (mo_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\alpha$ and $\beta$ one-body density matrix for each state
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
one_e_dm_mo_alpha_average_complex = (0.d0,0.d0)
|
||||||
|
one_e_dm_mo_beta_average_complex = (0.d0,0.d0)
|
||||||
|
do i = 1,N_states
|
||||||
|
one_e_dm_mo_alpha_average_complex(:,:) += one_e_dm_mo_alpha_complex(:,:,i) * state_average_weight(i)
|
||||||
|
one_e_dm_mo_beta_average_complex(:,:) += one_e_dm_mo_beta_complex(:,:,i) * state_average_weight(i)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_diff_complex, (mo_num,mo_num,2:N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Difference of the one-body density matrix with respect to the ground state
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j, istate
|
||||||
|
|
||||||
|
do istate=2,N_states
|
||||||
|
do j=1,mo_num
|
||||||
|
do i=1,mo_num
|
||||||
|
one_e_dm_mo_diff_complex(i,j,istate) = &
|
||||||
|
one_e_dm_mo_alpha_complex(i,j,istate) - one_e_dm_mo_alpha_complex(i,j,1) +&
|
||||||
|
one_e_dm_mo_beta_complex (i,j,istate) - one_e_dm_mo_beta_complex (i,j,1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_spin_index_complex, (mo_num,mo_num,N_states,2) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,ispin,istate
|
||||||
|
ispin = 1
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
one_e_dm_mo_spin_index_complex(i,j,istate,ispin) = one_e_dm_mo_alpha_complex(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ispin = 2
|
||||||
|
do istate = 1, N_states
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
one_e_dm_mo_spin_index_complex(i,j,istate,ispin) = one_e_dm_mo_beta_complex(i,j,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_dagger_mo_spin_index_complex, (mo_num,mo_num,N_states,2) ]
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
! implicit none
|
||||||
|
! integer :: i,j,ispin,istate
|
||||||
|
! ispin = 1
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_alpha(j,j,istate)
|
||||||
|
! do i = j+1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate)
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! ispin = 2
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_beta(j,j,istate)
|
||||||
|
! do i = j+1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_beta(i,j,istate)
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_beta(i,j,istate)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_complex, (mo_num,mo_num,N_states) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_complex, (mo_num,mo_num,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\alpha$ and $\beta$ one-body density matrix for each state
|
||||||
|
! $\gamma_{\mu\nu} = \langle\Psi|a_{\nu}^{\dagger}a_{\mu}|\Psi\rangle$
|
||||||
|
! $\gamma_{\mu\nu} = \langle a_{\nu} \Psi|a_{\mu} \Psi\rangle$
|
||||||
|
! $\gamma_{\mu\nu} = \sum_{IJ} c^*_J c_I \langle a_{\nu} I|a_{\mu} J\rangle$
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: j,k,l,m,k_a,k_b
|
||||||
|
integer :: occ(N_int*bit_kind_size,2)
|
||||||
|
complex*16 :: ck, cl, ckl
|
||||||
|
double precision :: phase
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2, degree
|
||||||
|
integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int)
|
||||||
|
integer :: exc(0:2,2),n_occ(2)
|
||||||
|
complex*16, allocatable :: tmp_a(:,:,:), tmp_b(:,:,:)
|
||||||
|
integer :: krow, kcol, lrow, lcol
|
||||||
|
|
||||||
|
PROVIDE psi_det psi_coef_complex
|
||||||
|
|
||||||
|
one_e_dm_mo_alpha_complex = (0.d0,0.d0)
|
||||||
|
one_e_dm_mo_beta_complex = (0.d0,0.d0)
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(j,k,k_a,k_b,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,&
|
||||||
|
!$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)&
|
||||||
|
!$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states,elec_alpha_num, &
|
||||||
|
!$OMP elec_beta_num,one_e_dm_mo_alpha_complex,one_e_dm_mo_beta_complex,N_det,&
|
||||||
|
!$OMP mo_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns,&
|
||||||
|
!$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns,&
|
||||||
|
!$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique,&
|
||||||
|
!$OMP psi_bilinear_matrix_values_complex, psi_bilinear_matrix_transp_values_complex,&
|
||||||
|
!$OMP N_det_alpha_unique,N_det_beta_unique,irp_here)
|
||||||
|
allocate(tmp_a(mo_num,mo_num,N_states), tmp_b(mo_num,mo_num,N_states) )
|
||||||
|
tmp_a = (0.d0,0.d0)
|
||||||
|
!$OMP DO SCHEDULE(dynamic,64)
|
||||||
|
do k_a=1,N_det
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||||
|
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||||
|
|
||||||
|
! Diagonal part
|
||||||
|
! -------------
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int)
|
||||||
|
do m=1,N_states
|
||||||
|
ck = cdabs(psi_bilinear_matrix_values_complex(k_a,m)*psi_bilinear_matrix_values_complex(k_a,m))
|
||||||
|
do l=1,elec_alpha_num
|
||||||
|
j = occ(l,1)
|
||||||
|
tmp_a(j,j,m) += ck
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (k_a == N_det) cycle
|
||||||
|
l = k_a+1
|
||||||
|
lrow = psi_bilinear_matrix_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_columns(l)
|
||||||
|
! Fix beta determinant, loop over alphas
|
||||||
|
do while ( lcol == kcol )
|
||||||
|
tmp_det2(:) = psi_det_alpha_unique(:, lrow)
|
||||||
|
call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int)
|
||||||
|
if (degree == 1) then
|
||||||
|
exc = 0
|
||||||
|
call get_single_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int)
|
||||||
|
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||||
|
! h1 occ in k
|
||||||
|
! p1 occ in l
|
||||||
|
do m=1,N_states
|
||||||
|
ckl = dconjg(psi_bilinear_matrix_values_complex(k_a,m))*psi_bilinear_matrix_values_complex(l,m) * phase
|
||||||
|
tmp_a(h1,p1,m) += dconjg(ckl)
|
||||||
|
tmp_a(p1,h1,m) += ckl
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
l = l+1
|
||||||
|
if (l>N_det) exit
|
||||||
|
lrow = psi_bilinear_matrix_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_columns(l)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
one_e_dm_mo_alpha_complex(:,:,:) = one_e_dm_mo_alpha_complex(:,:,:) + tmp_a(:,:,:)
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
deallocate(tmp_a)
|
||||||
|
|
||||||
|
tmp_b = (0.d0,0.d0)
|
||||||
|
!$OMP DO SCHEDULE(dynamic,64)
|
||||||
|
do k_b=1,N_det
|
||||||
|
krow = psi_bilinear_matrix_transp_rows(k_b)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_transp_columns(k_b)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||||
|
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||||
|
|
||||||
|
! Diagonal part
|
||||||
|
! -------------
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int)
|
||||||
|
do m=1,N_states
|
||||||
|
ck = cdabs(psi_bilinear_matrix_transp_values_complex(k_b,m)*psi_bilinear_matrix_transp_values_complex(k_b,m))
|
||||||
|
do l=1,elec_beta_num
|
||||||
|
j = occ(l,2)
|
||||||
|
tmp_b(j,j,m) += ck
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (k_b == N_det) cycle
|
||||||
|
l = k_b+1
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||||
|
! Fix beta determinant, loop over alphas
|
||||||
|
do while ( lrow == krow )
|
||||||
|
tmp_det2(:) = psi_det_beta_unique(:, lcol)
|
||||||
|
call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int)
|
||||||
|
if (degree == 1) then
|
||||||
|
exc = 0
|
||||||
|
call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int)
|
||||||
|
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||||
|
do m=1,N_states
|
||||||
|
ckl = dconjg(psi_bilinear_matrix_transp_values_complex(k_b,m))*psi_bilinear_matrix_transp_values_complex(l,m) * phase
|
||||||
|
tmp_b(h1,p1,m) += dconjg(ckl)
|
||||||
|
tmp_b(p1,h1,m) += ckl
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
l = l+1
|
||||||
|
if (l>N_det) exit
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
!$OMP CRITICAL
|
||||||
|
one_e_dm_mo_beta_complex(:,:,:) = one_e_dm_mo_beta_complex(:,:,:) + tmp_b(:,:,:)
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
deallocate(tmp_b)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_complex, (mo_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! One-body density matrix
|
||||||
|
END_DOC
|
||||||
|
one_e_dm_mo_complex = one_e_dm_mo_alpha_average_complex + one_e_dm_mo_beta_average_complex
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_spin_density_mo_complex, (mo_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\rho(\alpha) - \rho(\beta)$
|
||||||
|
END_DOC
|
||||||
|
one_e_spin_density_mo_complex = one_e_dm_mo_alpha_average_complex - one_e_dm_mo_beta_average_complex
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_spin_density_ao_complex, (ao_num,ao_num) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! One body spin density matrix on the |AO| basis : $\rho_{AO}(\alpha) - \rho_{AO}(\beta)$
|
||||||
|
! todo: verify that this is correct for complex
|
||||||
|
! equivalent to using mo_to_ao_no_overlap?
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16 :: dm_mo
|
||||||
|
|
||||||
|
one_e_spin_density_ao_complex = (0.d0,0.d0)
|
||||||
|
do k = 1, ao_num
|
||||||
|
do l = 1, ao_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
dm_mo = one_e_spin_density_mo_complex(j,i)
|
||||||
|
! if(dabs(dm_mo).le.1.d-10)cycle
|
||||||
|
one_e_spin_density_ao_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * dm_mo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_ao_alpha_complex, (ao_num,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_ao_beta_complex, (ao_num,ao_num) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$.
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16 :: mo_alpha,mo_beta
|
||||||
|
|
||||||
|
one_e_dm_ao_alpha_complex = (0.d0,0.d0)
|
||||||
|
one_e_dm_ao_beta_complex = (0.d0,0.d0)
|
||||||
|
do k = 1, ao_num
|
||||||
|
do l = 1, ao_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
mo_alpha = one_e_dm_mo_alpha_average_complex(j,i)
|
||||||
|
mo_beta = one_e_dm_mo_beta_average_complex(j,i)
|
||||||
|
! if(dabs(dm_mo).le.1.d-10)cycle
|
||||||
|
one_e_dm_ao_alpha_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * mo_alpha
|
||||||
|
one_e_dm_ao_beta_complex(l,k) += dconjg(mo_coef_complex(k,i)) * mo_coef_complex(l,j) * mo_beta
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_average_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_average_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\alpha$ and $\beta$ one-body density matrix for each state
|
||||||
|
END_DOC
|
||||||
|
integer :: i,k
|
||||||
|
one_e_dm_mo_alpha_average_kpts = (0.d0,0.d0)
|
||||||
|
one_e_dm_mo_beta_average_kpts = (0.d0,0.d0)
|
||||||
|
do i = 1,N_states
|
||||||
|
do k=1,kpt_num
|
||||||
|
one_e_dm_mo_alpha_average_kpts(:,:,k) += one_e_dm_mo_alpha_kpts(:,:,k,i) * state_average_weight(i)
|
||||||
|
one_e_dm_mo_beta_average_kpts(:,:,k) += one_e_dm_mo_beta_kpts(:,:,k,i) * state_average_weight(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_diff_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,2:N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Difference of the one-body density matrix with respect to the ground state
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j, istate,k
|
||||||
|
|
||||||
|
do istate=2,N_states
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j=1,mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
one_e_dm_mo_diff_kpts(i,j,k,istate) = &
|
||||||
|
one_e_dm_mo_alpha_kpts(i,j,k,istate) - one_e_dm_mo_alpha_kpts(i,j,k,1) +&
|
||||||
|
one_e_dm_mo_beta_kpts (i,j,k,istate) - one_e_dm_mo_beta_kpts (i,j,k,1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_spin_index_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states,2) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,ispin,istate
|
||||||
|
ispin = 1
|
||||||
|
do istate = 1, N_states
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
one_e_dm_mo_spin_index_kpts(i,j,k,istate,ispin) = one_e_dm_mo_alpha_kpts(i,j,k,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
ispin = 2
|
||||||
|
do istate = 1, N_states
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
one_e_dm_mo_spin_index_kpts(i,j,k,istate,ispin) = one_e_dm_mo_beta_kpts(i,j,k,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_dagger_mo_spin_index_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states,2) ]
|
||||||
|
print*,irp_here,' not implemented for kpts'
|
||||||
|
stop -1
|
||||||
|
! implicit none
|
||||||
|
! integer :: i,j,ispin,istate
|
||||||
|
! ispin = 1
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_alpha(j,j,istate)
|
||||||
|
! do i = j+1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate)
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_alpha(i,j,istate)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! ispin = 2
|
||||||
|
! do istate = 1, N_states
|
||||||
|
! do j = 1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,j,istate,ispin) = 1 - one_e_dm_mo_beta(j,j,istate)
|
||||||
|
! do i = j+1, mo_num
|
||||||
|
! one_e_dm_dagger_mo_spin_index(i,j,istate,ispin) = -one_e_dm_mo_beta(i,j,istate)
|
||||||
|
! one_e_dm_dagger_mo_spin_index(j,i,istate,ispin) = -one_e_dm_mo_beta(i,j,istate)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_alpha_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_mo_beta_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\alpha$ and $\beta$ one-body density matrix for each state
|
||||||
|
! $\gamma_{\mu\nu} = \langle\Psi|a_{\nu}^{\dagger}a_{\mu}|\Psi\rangle$
|
||||||
|
! $\gamma_{\mu\nu} = \langle a_{\nu} \Psi|a_{\mu} \Psi\rangle$
|
||||||
|
! $\gamma_{\mu\nu} = \sum_{IJ} c^*_J c_I \langle a_{\nu} I|a_{\mu} J\rangle$
|
||||||
|
END_DOC
|
||||||
|
!todo: implement for kpts
|
||||||
|
integer :: j,k,l,m,k_a,k_b
|
||||||
|
integer :: occ(N_int*bit_kind_size,2)
|
||||||
|
complex*16 :: ck, cl, ckl
|
||||||
|
double precision :: phase
|
||||||
|
integer :: h1,h2,p1,p2,s1,s2, degree
|
||||||
|
integer :: ih1,ip1,kh1,kp1,kk,k_shft,ii
|
||||||
|
integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int)
|
||||||
|
integer(bit_kind) :: tmp_det_kpts(N_int,2)
|
||||||
|
integer :: exc(0:2,2),n_occ(2)
|
||||||
|
complex*16, allocatable :: tmp_a(:,:,:,:), tmp_b(:,:,:,:)
|
||||||
|
integer :: krow, kcol, lrow, lcol
|
||||||
|
|
||||||
|
PROVIDE psi_det psi_coef_complex
|
||||||
|
|
||||||
|
one_e_dm_mo_alpha_kpts = (0.d0,0.d0)
|
||||||
|
one_e_dm_mo_beta_kpts = (0.d0,0.d0)
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(j,k,k_a,k_b,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc,&
|
||||||
|
!$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2,ih1,ip1,kh1,kp1,kk,&
|
||||||
|
!$OMP tmp_det_kpts,k_shft,ii)&
|
||||||
|
!$OMP SHARED(psi_det,psi_coef_complex,N_int,N_states,elec_alpha_num_kpts, &
|
||||||
|
!$OMP elec_beta_num_kpts,one_e_dm_mo_alpha_kpts,one_e_dm_mo_beta_kpts,N_det,&
|
||||||
|
!$OMP mo_num_per_kpt,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns,&
|
||||||
|
!$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns,&
|
||||||
|
!$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique,&
|
||||||
|
!$OMP psi_bilinear_matrix_values_complex, psi_bilinear_matrix_transp_values_complex,&
|
||||||
|
!$OMP N_det_alpha_unique,N_det_beta_unique,irp_here,kpt_num,kpts_bitmask)
|
||||||
|
allocate(tmp_a(mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states), tmp_b(mo_num_per_kpt,mo_num_per_kpt,kpt_num,N_states) )
|
||||||
|
tmp_a = (0.d0,0.d0)
|
||||||
|
!$OMP DO SCHEDULE(dynamic,64)
|
||||||
|
do k_a=1,N_det
|
||||||
|
krow = psi_bilinear_matrix_rows(k_a)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_columns(k_a)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||||
|
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||||
|
|
||||||
|
! Diagonal part
|
||||||
|
! -------------
|
||||||
|
|
||||||
|
do kk=1,kpt_num
|
||||||
|
k_shft = (kk-1)*mo_num_per_kpt
|
||||||
|
do ii=1,N_int
|
||||||
|
tmp_det_kpts(ii,1) = iand(tmp_det(ii,1),kpts_bitmask(ii,kk))
|
||||||
|
tmp_det_kpts(ii,2) = iand(tmp_det(ii,2),kpts_bitmask(ii,kk))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(tmp_det_kpts, occ, n_occ, N_int)
|
||||||
|
do m=1,N_states
|
||||||
|
ck = cdabs(psi_bilinear_matrix_values_complex(k_a,m)*psi_bilinear_matrix_values_complex(k_a,m))
|
||||||
|
!do l=1,elec_alpha_num_kpts(kk)
|
||||||
|
do l=1,n_occ(1)
|
||||||
|
j = occ(l,1) - k_shft
|
||||||
|
tmp_a(j,j,kk,m) += ck
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (k_a == N_det) cycle
|
||||||
|
l = k_a+1
|
||||||
|
lrow = psi_bilinear_matrix_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_columns(l)
|
||||||
|
! Fix beta determinant, loop over alphas
|
||||||
|
do while ( lcol == kcol )
|
||||||
|
tmp_det2(:) = psi_det_alpha_unique(:, lrow)
|
||||||
|
call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int)
|
||||||
|
if (degree == 1) then
|
||||||
|
exc = 0
|
||||||
|
call get_single_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int)
|
||||||
|
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||||
|
! h1 occ in k
|
||||||
|
! p1 occ in l
|
||||||
|
ih1 = mod(h1-1,mo_num_per_kpt)+1
|
||||||
|
ip1 = mod(p1-1,mo_num_per_kpt)+1
|
||||||
|
kh1 = (h1-1)/mo_num_per_kpt + 1
|
||||||
|
kp1 = (p1-1)/mo_num_per_kpt + 1
|
||||||
|
if (kh1.ne.kp1) then
|
||||||
|
print *,'problem in: ',irp_here,'a'
|
||||||
|
print *,' h1 = ',h1
|
||||||
|
print *,' p1 = ',p1
|
||||||
|
print *,'ih1 = ',ih1
|
||||||
|
print *,'ip1 = ',ip1
|
||||||
|
print *,'kh1 = ',kh1
|
||||||
|
print *,'kp1 = ',kp1
|
||||||
|
!call debug_det(tmp_det,N_int)
|
||||||
|
call debug_single_spindet(tmp_det(1,1),N_int)
|
||||||
|
call debug_single_spindet(tmp_det2,N_int)
|
||||||
|
call debug_single_spindet(tmp_det(1,2),N_int)
|
||||||
|
!call print_spindet(tmp_det2,N_int)
|
||||||
|
stop -2
|
||||||
|
endif
|
||||||
|
do m=1,N_states
|
||||||
|
ckl = dconjg(psi_bilinear_matrix_values_complex(k_a,m))*psi_bilinear_matrix_values_complex(l,m) * phase
|
||||||
|
tmp_a(ih1,ip1,kh1,m) += dconjg(ckl)
|
||||||
|
tmp_a(ip1,ih1,kh1,m) += ckl
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
l = l+1
|
||||||
|
if (l>N_det) exit
|
||||||
|
lrow = psi_bilinear_matrix_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_columns(l)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
|
||||||
|
!$OMP CRITICAL
|
||||||
|
one_e_dm_mo_alpha_kpts(:,:,:,:) = one_e_dm_mo_alpha_kpts(:,:,:,:) + tmp_a(:,:,:,:)
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
deallocate(tmp_a)
|
||||||
|
|
||||||
|
tmp_b = (0.d0,0.d0)
|
||||||
|
!$OMP DO SCHEDULE(dynamic,64)
|
||||||
|
do k_b=1,N_det
|
||||||
|
krow = psi_bilinear_matrix_transp_rows(k_b)
|
||||||
|
ASSERT (krow <= N_det_alpha_unique)
|
||||||
|
|
||||||
|
kcol = psi_bilinear_matrix_transp_columns(k_b)
|
||||||
|
ASSERT (kcol <= N_det_beta_unique)
|
||||||
|
|
||||||
|
tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow)
|
||||||
|
tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int,kcol)
|
||||||
|
|
||||||
|
! Diagonal part
|
||||||
|
! -------------
|
||||||
|
|
||||||
|
do kk=1,kpt_num
|
||||||
|
k_shft = (kk-1)*mo_num_per_kpt
|
||||||
|
do ii=1,N_int
|
||||||
|
tmp_det_kpts(ii,1) = iand(tmp_det(ii,1),kpts_bitmask(ii,kk))
|
||||||
|
tmp_det_kpts(ii,2) = iand(tmp_det(ii,2),kpts_bitmask(ii,kk))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(tmp_det_kpts, occ, n_occ, N_int)
|
||||||
|
do m=1,N_states
|
||||||
|
ck = cdabs(psi_bilinear_matrix_transp_values_complex(k_b,m)*psi_bilinear_matrix_transp_values_complex(k_b,m))
|
||||||
|
do l=1,n_occ(2)
|
||||||
|
j = occ(l,2) - k_shft
|
||||||
|
tmp_b(j,j,kk,m) += ck
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (k_b == N_det) cycle
|
||||||
|
l = k_b+1
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||||
|
! Fix beta determinant, loop over alphas
|
||||||
|
do while ( lrow == krow )
|
||||||
|
tmp_det2(:) = psi_det_beta_unique(:, lcol)
|
||||||
|
call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int)
|
||||||
|
if (degree == 1) then
|
||||||
|
exc = 0
|
||||||
|
call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int)
|
||||||
|
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||||
|
ih1 = mod(h1-1,mo_num_per_kpt)+1
|
||||||
|
ip1 = mod(p1-1,mo_num_per_kpt)+1
|
||||||
|
kh1 = (h1-1)/mo_num_per_kpt + 1
|
||||||
|
kp1 = (p1-1)/mo_num_per_kpt + 1
|
||||||
|
if (kh1.ne.kp1) then
|
||||||
|
print *,'problem in: ',irp_here,'b'
|
||||||
|
print *,' h1 = ',h1
|
||||||
|
print *,' p1 = ',p1
|
||||||
|
print *,'ih1 = ',ih1
|
||||||
|
print *,'ip1 = ',ip1
|
||||||
|
print *,'kh1 = ',kh1
|
||||||
|
print *,'kp1 = ',kp1
|
||||||
|
call debug_single_spindet(tmp_det(1,2),N_int)
|
||||||
|
call debug_single_spindet(tmp_det2,N_int)
|
||||||
|
call debug_single_spindet(tmp_det(1,1),N_int)
|
||||||
|
stop -3
|
||||||
|
endif
|
||||||
|
do m=1,N_states
|
||||||
|
ckl = dconjg(psi_bilinear_matrix_transp_values_complex(k_b,m))*psi_bilinear_matrix_transp_values_complex(l,m) * phase
|
||||||
|
tmp_b(ih1,ip1,kh1,m) += dconjg(ckl)
|
||||||
|
tmp_b(ip1,ih1,kh1,m) += ckl
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
l = l+1
|
||||||
|
if (l>N_det) exit
|
||||||
|
lrow = psi_bilinear_matrix_transp_rows(l)
|
||||||
|
lcol = psi_bilinear_matrix_transp_columns(l)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
!$OMP CRITICAL
|
||||||
|
one_e_dm_mo_beta_kpts(:,:,:,:) = one_e_dm_mo_beta_kpts(:,:,:,:) + tmp_b(:,:,:,:)
|
||||||
|
!$OMP END CRITICAL
|
||||||
|
|
||||||
|
deallocate(tmp_b)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_mo_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! One-body density matrix
|
||||||
|
END_DOC
|
||||||
|
one_e_dm_mo_kpts = one_e_dm_mo_alpha_average_kpts + one_e_dm_mo_beta_average_kpts
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_spin_density_mo_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! $\rho(\alpha) - \rho(\beta)$
|
||||||
|
END_DOC
|
||||||
|
one_e_spin_density_mo_kpts = one_e_dm_mo_alpha_average_kpts - one_e_dm_mo_beta_average_kpts
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_spin_density_ao_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! One body spin density matrix on the |AO| basis : $\rho_{AO}(\alpha) - \rho_{AO}(\beta)$
|
||||||
|
! todo: verify that this is correct for complex
|
||||||
|
! equivalent to using mo_to_ao_no_overlap?
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l,kk
|
||||||
|
complex*16 :: dm_mo
|
||||||
|
|
||||||
|
one_e_spin_density_ao_kpts = (0.d0,0.d0)
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do k = 1, ao_num_per_kpt
|
||||||
|
do l = 1, ao_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
dm_mo = one_e_spin_density_mo_kpts(j,i,kk)
|
||||||
|
! if(dabs(dm_mo).le.1.d-10)cycle
|
||||||
|
one_e_spin_density_ao_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * dm_mo
|
||||||
|
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, one_e_dm_ao_alpha_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, one_e_dm_ao_beta_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
BEGIN_DOC
|
||||||
|
! One body density matrix on the |AO| basis : $\rho_{AO}(\alpha), \rho_{AO}(\beta)$.
|
||||||
|
END_DOC
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l,kk
|
||||||
|
complex*16 :: mo_alpha,mo_beta
|
||||||
|
|
||||||
|
one_e_dm_ao_alpha_kpts = (0.d0,0.d0)
|
||||||
|
one_e_dm_ao_beta_kpts = (0.d0,0.d0)
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do k = 1, ao_num_per_kpt
|
||||||
|
do l = 1, ao_num_per_kpt
|
||||||
|
do i = 1, mo_num_per_kpt
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
mo_alpha = one_e_dm_mo_alpha_average_kpts(j,i,kk)
|
||||||
|
mo_beta = one_e_dm_mo_beta_average_kpts(j,i,kk)
|
||||||
|
! if(dabs(dm_mo).le.1.d-10)cycle
|
||||||
|
one_e_dm_ao_alpha_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * mo_alpha
|
||||||
|
one_e_dm_ao_beta_kpts(l,k,kk) += dconjg(mo_coef_kpts(k,i,kk)) * mo_coef_kpts(l,j,kk) * mo_beta
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
@ -113,7 +113,12 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ]
|
|||||||
logical :: exists
|
logical :: exists
|
||||||
character*(64) :: label
|
character*(64) :: label
|
||||||
|
|
||||||
PROVIDE read_wf N_det mo_label ezfio_filename HF_bitmask mo_coef
|
PROVIDE read_wf N_det mo_label ezfio_filename HF_bitmask
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE mo_coef_complex
|
||||||
|
else
|
||||||
|
PROVIDE mo_coef
|
||||||
|
endif
|
||||||
psi_det = 0_bit_kind
|
psi_det = 0_bit_kind
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
if (read_wf) then
|
if (read_wf) then
|
||||||
@ -244,12 +249,21 @@ BEGIN_PROVIDER [ double precision, psi_average_norm_contrib, (psi_det_size) ]
|
|||||||
double precision :: f
|
double precision :: f
|
||||||
|
|
||||||
psi_average_norm_contrib(:) = 0.d0
|
psi_average_norm_contrib(:) = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,N_states
|
||||||
|
do i=1,N_det
|
||||||
|
psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + &
|
||||||
|
cdabs(psi_coef_complex(i,k)*psi_coef_complex(i,k))*state_average_weight(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + &
|
psi_average_norm_contrib(i) = psi_average_norm_contrib(i) + &
|
||||||
psi_coef(i,k)*psi_coef(i,k)*state_average_weight(k)
|
psi_coef(i,k)*psi_coef(i,k)*state_average_weight(k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
f = 1.d0/sum(psi_average_norm_contrib(1:N_det))
|
f = 1.d0/sum(psi_average_norm_contrib(1:N_det))
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
psi_average_norm_contrib(i) = psi_average_norm_contrib(i)*f
|
psi_average_norm_contrib(i) = psi_average_norm_contrib(i)*f
|
||||||
@ -266,7 +280,6 @@ END_PROVIDER
|
|||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted, (N_int,2,psi_det_size) ]
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted, (N_int,2,psi_det_size) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted, (psi_det_size) ]
|
&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted, (psi_det_size) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_det_sorted_order, (psi_det_size) ]
|
&BEGIN_PROVIDER [ integer, psi_det_sorted_order, (psi_det_size) ]
|
||||||
implicit none
|
implicit none
|
||||||
@ -288,9 +301,6 @@ END_PROVIDER
|
|||||||
psi_det_sorted(j,1,i) = psi_det(j,1,iorder(i))
|
psi_det_sorted(j,1,i) = psi_det(j,1,iorder(i))
|
||||||
psi_det_sorted(j,2,i) = psi_det(j,2,iorder(i))
|
psi_det_sorted(j,2,i) = psi_det(j,2,iorder(i))
|
||||||
enddo
|
enddo
|
||||||
do k=1,N_states
|
|
||||||
psi_coef_sorted(i,k) = psi_coef(iorder(i),k)
|
|
||||||
enddo
|
|
||||||
psi_average_norm_contrib_sorted(i) = -psi_average_norm_contrib_sorted(i)
|
psi_average_norm_contrib_sorted(i) = -psi_average_norm_contrib_sorted(i)
|
||||||
enddo
|
enddo
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -298,29 +308,74 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
|
|
||||||
psi_det_sorted(:,:,N_det+1:psi_det_size) = 0_bit_kind
|
psi_det_sorted(:,:,N_det+1:psi_det_size) = 0_bit_kind
|
||||||
psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0
|
|
||||||
psi_average_norm_contrib_sorted(N_det+1:psi_det_size) = 0.d0
|
psi_average_norm_contrib_sorted(N_det+1:psi_det_size) = 0.d0
|
||||||
psi_det_sorted_order(N_det+1:psi_det_size) = 0
|
psi_det_sorted_order(N_det+1:psi_det_size) = 0
|
||||||
|
|
||||||
deallocate(iorder)
|
deallocate(iorder)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
BEGIN_PROVIDER [ double precision, psi_coef_sorted, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
do i=1,N_det
|
||||||
|
j=psi_det_sorted_order(i)
|
||||||
|
do k=1,N_states
|
||||||
|
psi_coef_sorted(j,k) = psi_coef(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
psi_coef_sorted(N_det+1:psi_det_size,:) = 0.d0
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ]
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ]
|
&BEGIN_PROVIDER [ integer, psi_det_sorted_bit_order, (psi_det_size) ]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
integer :: i,j
|
||||||
! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation.
|
integer*8, allocatable :: bit_tmp(:)
|
||||||
! They are sorted by determinants interpreted as integers. Useful
|
integer*8, external :: det_search_key
|
||||||
! to accelerate the search of a random determinant in the wave
|
|
||||||
! function.
|
|
||||||
END_DOC
|
|
||||||
|
|
||||||
call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), &
|
allocate(bit_tmp(N_det))
|
||||||
psi_det_sorted_bit, psi_coef_sorted_bit, N_states)
|
|
||||||
|
|
||||||
|
do i=1,N_det
|
||||||
|
psi_det_sorted_bit_order(i) = i
|
||||||
|
!$DIR FORCEINLINE
|
||||||
|
bit_tmp(i) = det_search_key(psi_det(1,1,i),N_int)
|
||||||
|
enddo
|
||||||
|
call i8sort(bit_tmp,psi_det_sorted_bit_order,N_det)
|
||||||
|
do i=1,N_det
|
||||||
|
do j=1,N_int
|
||||||
|
psi_det_sorted_bit(j,1,i) = psi_det(j,1,psi_det_sorted_bit_order(i))
|
||||||
|
psi_det_sorted_bit(j,2,i) = psi_det(j,2,psi_det_sorted_bit_order(i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(bit_tmp)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
do i=1,N_det
|
||||||
|
do k=1,N_states
|
||||||
|
psi_coef_sorted_bit(i,k) = psi_coef(psi_det_sorted_bit_order(i),k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_bit, (N_int,2,psi_det_size) ]
|
||||||
|
!&BEGIN_PROVIDER [ double precision, psi_coef_sorted_bit, (psi_det_size,N_states) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Determinants on which we apply $\langle i|H|psi \rangle$ for perturbation.
|
||||||
|
! ! They are sorted by determinants interpreted as integers. Useful
|
||||||
|
! ! to accelerate the search of a random determinant in the wave
|
||||||
|
! ! function.
|
||||||
|
! END_DOC
|
||||||
|
!
|
||||||
|
! call sort_dets_by_det_search_key(N_det, psi_det, psi_coef, size(psi_coef,1), &
|
||||||
|
! psi_det_sorted_bit, psi_coef_sorted_bit, N_states)
|
||||||
|
!
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st)
|
subroutine sort_dets_by_det_search_key(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
@ -369,24 +424,46 @@ end
|
|||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ]
|
BEGIN_PROVIDER [ double precision, psi_coef_max, (N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ]
|
&BEGIN_PROVIDER [ double precision, psi_coef_min, (N_states) ]
|
||||||
&BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ]
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Max and min values of the coefficients
|
! Max and min values of the coefficients
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i
|
integer :: i
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
do i=1,N_states
|
do i=1,N_states
|
||||||
psi_coef_min(i) = minval(psi_coef(:,i))
|
psi_coef_min(i) = minval(psi_coef(:,i))
|
||||||
psi_coef_max(i) = maxval(psi_coef(:,i))
|
psi_coef_max(i) = maxval(psi_coef(:,i))
|
||||||
abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) )
|
|
||||||
abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) )
|
|
||||||
call write_double(6,psi_coef_max(i), 'Max coef')
|
call write_double(6,psi_coef_max(i), 'Max coef')
|
||||||
call write_double(6,psi_coef_min(i), 'Min coef')
|
call write_double(6,psi_coef_min(i), 'Min coef')
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, abs_psi_coef_max, (N_states) ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, abs_psi_coef_min, (N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Max and min magnitudes of the coefficients
|
||||||
|
END_DOC
|
||||||
|
integer :: i
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_states
|
||||||
|
abs_psi_coef_min(i) = minval( cdabs(psi_coef_complex(:,i)) )
|
||||||
|
abs_psi_coef_max(i) = maxval( cdabs(psi_coef_complex(:,i)) )
|
||||||
call write_double(6,abs_psi_coef_max(i), 'Max abs coef')
|
call write_double(6,abs_psi_coef_max(i), 'Max abs coef')
|
||||||
call write_double(6,abs_psi_coef_min(i), 'Min abs coef')
|
call write_double(6,abs_psi_coef_min(i), 'Min abs coef')
|
||||||
enddo
|
enddo
|
||||||
|
else
|
||||||
|
do i=1,N_states
|
||||||
|
abs_psi_coef_min(i) = minval( dabs(psi_coef(:,i)) )
|
||||||
|
abs_psi_coef_max(i) = maxval( dabs(psi_coef(:,i)) )
|
||||||
|
call write_double(6,abs_psi_coef_max(i), 'Max abs coef')
|
||||||
|
call write_double(6,abs_psi_coef_min(i), 'Min abs coef')
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
@ -442,10 +519,17 @@ end
|
|||||||
subroutine save_ref_determinant
|
subroutine save_ref_determinant
|
||||||
implicit none
|
implicit none
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16 :: buffer_c(1,N_states)
|
||||||
|
buffer_c = (0.d0,0.d0)
|
||||||
|
buffer_c(1,1) = (1.d0,0.d0)
|
||||||
|
call save_wavefunction_general_complex(1,N_states,ref_bitmask,1,buffer_c)
|
||||||
|
else
|
||||||
double precision :: buffer(1,N_states)
|
double precision :: buffer(1,N_states)
|
||||||
buffer = 0.d0
|
buffer = 0.d0
|
||||||
buffer(1,1) = 1.d0
|
buffer(1,1) = 1.d0
|
||||||
call save_wavefunction_general(1,N_states,ref_bitmask,1,buffer)
|
call save_wavefunction_general(1,N_states,ref_bitmask,1,buffer)
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -467,8 +551,13 @@ subroutine save_wavefunction_truncated(thr)
|
|||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
|
if (is_complex) then
|
||||||
|
call save_wavefunction_general_complex(N_det_save,min(N_states,N_det_save),&
|
||||||
|
psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex)
|
||||||
|
else
|
||||||
call save_wavefunction_general(N_det_save,min(N_states,N_det_save),psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
call save_wavefunction_general(N_det_save,min(N_states,N_det_save),psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine save_wavefunction
|
subroutine save_wavefunction
|
||||||
@ -485,8 +574,13 @@ subroutine save_wavefunction
|
|||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
|
if (is_complex) then
|
||||||
|
call save_wavefunction_general_complex(N_det,N_states,&
|
||||||
|
psi_det_sorted,size(psi_coef_sorted_complex,1),psi_coef_sorted_complex)
|
||||||
|
else
|
||||||
call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
call save_wavefunction_general(N_det,N_states,psi_det_sorted,size(psi_coef_sorted,1),psi_coef_sorted)
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -497,8 +591,13 @@ subroutine save_wavefunction_unsorted
|
|||||||
! Save the wave function into the |EZFIO| file
|
! Save the wave function into the |EZFIO| file
|
||||||
END_DOC
|
END_DOC
|
||||||
if (mpi_master) then
|
if (mpi_master) then
|
||||||
|
if (is_complex) then
|
||||||
|
call save_wavefunction_general_complex(N_det,min(N_states,N_det),&
|
||||||
|
psi_det,size(psi_coef_complex,1),psi_coef_complex)
|
||||||
|
else
|
||||||
call save_wavefunction_general(N_det,min(N_states,N_det),psi_det,size(psi_coef,1),psi_coef)
|
call save_wavefunction_general(N_det,min(N_states,N_det),psi_det,size(psi_coef,1),psi_coef)
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
subroutine save_wavefunction_general(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||||
|
350
src/determinants/determinants_cplx.irp.f
Normal file
350
src/determinants/determinants_cplx.irp.f
Normal file
@ -0,0 +1,350 @@
|
|||||||
|
use bitmasks
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! The wave function coefficients. Initialized with Hartree-Fock if the |EZFIO| file
|
||||||
|
! is empty.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,k, N_int2
|
||||||
|
logical :: exists
|
||||||
|
character*(64) :: label
|
||||||
|
|
||||||
|
PROVIDE read_wf N_det mo_label ezfio_filename
|
||||||
|
psi_coef_complex = (0.d0,0.d0)
|
||||||
|
do i=1,min(N_states,psi_det_size)
|
||||||
|
psi_coef_complex(i,i) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
if (read_wf) then
|
||||||
|
call ezfio_has_determinants_psi_coef_complex(exists)
|
||||||
|
if (exists) then
|
||||||
|
call ezfio_has_determinants_mo_label(exists)
|
||||||
|
if (exists) then
|
||||||
|
call ezfio_get_determinants_mo_label(label)
|
||||||
|
exists = (label == mo_label)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (exists) then
|
||||||
|
|
||||||
|
complex*16, allocatable :: psi_coef_read(:,:)
|
||||||
|
allocate (psi_coef_read(N_det,N_states))
|
||||||
|
print *, 'Read psi_coef_complex', N_det, N_states
|
||||||
|
call ezfio_get_determinants_psi_coef_complex(psi_coef_read)
|
||||||
|
do k=1,N_states
|
||||||
|
do i=1,N_det
|
||||||
|
psi_coef_complex(i,k) = psi_coef_read(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(psi_coef_read)
|
||||||
|
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
IRP_IF MPI_DEBUG
|
||||||
|
print *, irp_here, mpi_rank
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_BCAST( psi_coef_complex, size(psi_coef_complex), MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read psi_coef_complex with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Sorting providers !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k
|
||||||
|
do i=1,N_det
|
||||||
|
j=psi_det_sorted_order(i)
|
||||||
|
do k=1,N_states
|
||||||
|
psi_coef_sorted_complex(j,k) = psi_coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!!TODO: implement for complex (new psi_det_sorted? reuse? combine complex provider with real?)
|
||||||
|
! BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_complex, (N_int,2,psi_det_size) ]
|
||||||
|
!&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_complex, (psi_det_size,N_states) ]
|
||||||
|
!&BEGIN_PROVIDER [ double precision, psi_average_norm_contrib_sorted_complex, (psi_det_size) ]
|
||||||
|
!&BEGIN_PROVIDER [ integer, psi_det_sorted_order_complex, (psi_det_size) ]
|
||||||
|
! implicit none
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! Wave function sorted by determinants contribution to the norm (state-averaged)
|
||||||
|
! !
|
||||||
|
! ! psi_det_sorted_order(i) -> k : index in psi_det
|
||||||
|
! END_DOC
|
||||||
|
! integer :: i,j,k
|
||||||
|
! integer, allocatable :: iorder(:)
|
||||||
|
! allocate ( iorder(N_det) )
|
||||||
|
! do i=1,N_det
|
||||||
|
! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib(i)
|
||||||
|
! iorder(i) = i
|
||||||
|
! enddo
|
||||||
|
! call dsort(psi_average_norm_contrib_sorted_complex,iorder,N_det)
|
||||||
|
! do i=1,N_det
|
||||||
|
! do j=1,N_int
|
||||||
|
! psi_det_sorted_complex(j,1,i) = psi_det(j,1,iorder(i))
|
||||||
|
! psi_det_sorted_complex(j,2,i) = psi_det(j,2,iorder(i))
|
||||||
|
! enddo
|
||||||
|
! do k=1,N_states
|
||||||
|
! psi_coef_sorted_complex(i,k) = psi_coef_complex(iorder(i),k)
|
||||||
|
! enddo
|
||||||
|
! psi_average_norm_contrib_sorted_complex(i) = -psi_average_norm_contrib_sorted_complex(i)
|
||||||
|
! enddo
|
||||||
|
! do i=1,N_det
|
||||||
|
! psi_det_sorted_order_complex(iorder(i)) = i
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! psi_det_sorted_complex(:,:,N_det+1:psi_det_size) = 0_bit_kind
|
||||||
|
! psi_coef_sorted_complex(N_det+1:psi_det_size,:) = (0.d0,0.d0)
|
||||||
|
! psi_average_norm_contrib_sorted_complex(N_det+1:psi_det_size) = 0.d0
|
||||||
|
! psi_det_sorted_order_complex(N_det+1:psi_det_size) = 0
|
||||||
|
!
|
||||||
|
! deallocate(iorder)
|
||||||
|
!
|
||||||
|
!END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_sorted_bit_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
do i=1,N_det
|
||||||
|
do k=1,N_states
|
||||||
|
psi_coef_sorted_bit_complex(i,k) = psi_coef_complex(psi_det_sorted_bit_order(i),k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine sort_dets_by_det_search_key_complex(Ndet, det_in, coef_in, sze, det_out, coef_out, N_st)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: Ndet, N_st, sze
|
||||||
|
integer(bit_kind), intent(in) :: det_in (N_int,2,sze)
|
||||||
|
complex*16 , intent(in) :: coef_in(sze,N_st)
|
||||||
|
integer(bit_kind), intent(out) :: det_out (N_int,2,sze)
|
||||||
|
complex*16 , intent(out) :: coef_out(sze,N_st)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Determinants are sorted according to their :c:func:`det_search_key`.
|
||||||
|
! Useful to accelerate the search of a random determinant in the wave
|
||||||
|
! function.
|
||||||
|
!
|
||||||
|
! /!\ The first dimension of coef_out and coef_in need to be psi_det_size
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
integer, allocatable :: iorder(:)
|
||||||
|
integer*8, allocatable :: bit_tmp(:)
|
||||||
|
integer*8, external :: det_search_key
|
||||||
|
|
||||||
|
allocate ( iorder(Ndet), bit_tmp(Ndet) )
|
||||||
|
|
||||||
|
do i=1,Ndet
|
||||||
|
iorder(i) = i
|
||||||
|
!$DIR FORCEINLINE
|
||||||
|
bit_tmp(i) = det_search_key(det_in(1,1,i),N_int)
|
||||||
|
enddo
|
||||||
|
call i8sort(bit_tmp,iorder,Ndet)
|
||||||
|
!DIR$ IVDEP
|
||||||
|
do i=1,Ndet
|
||||||
|
do j=1,N_int
|
||||||
|
det_out(j,1,i) = det_in(j,1,iorder(i))
|
||||||
|
det_out(j,2,i) = det_in(j,2,iorder(i))
|
||||||
|
enddo
|
||||||
|
do k=1,N_st
|
||||||
|
coef_out(i,k) = coef_in(iorder(i),k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(iorder, bit_tmp)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Read/write routines !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine save_wavefunction_general_complex(ndet,nstates,psidet,dim_psicoef,psicoef)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Save the wave function into the |EZFIO| file
|
||||||
|
END_DOC
|
||||||
|
use bitmasks
|
||||||
|
include 'constants.include.F'
|
||||||
|
integer, intent(in) :: ndet,nstates,dim_psicoef
|
||||||
|
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
|
||||||
|
complex*16, intent(in) :: psicoef(dim_psicoef,nstates)
|
||||||
|
integer*8, allocatable :: psi_det_save(:,:,:)
|
||||||
|
complex*16, allocatable :: psi_coef_save(:,:)
|
||||||
|
|
||||||
|
double precision :: accu_norm
|
||||||
|
integer :: i,j,k, ndet_qp_edit
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
ndet_qp_edit = min(ndet,N_det_qp_edit)
|
||||||
|
|
||||||
|
call ezfio_set_determinants_N_int(N_int)
|
||||||
|
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||||
|
call ezfio_set_determinants_N_det(ndet)
|
||||||
|
call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit)
|
||||||
|
call ezfio_set_determinants_n_states(nstates)
|
||||||
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
|
allocate (psi_det_save(N_int,2,ndet))
|
||||||
|
do i=1,ndet
|
||||||
|
do j=1,2
|
||||||
|
do k=1,N_int
|
||||||
|
psi_det_save(k,j,i) = transfer(psidet(k,j,i),1_8)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||||
|
call ezfio_set_determinants_psi_det_qp_edit(psi_det_save)
|
||||||
|
deallocate (psi_det_save)
|
||||||
|
|
||||||
|
allocate (psi_coef_save(ndet,nstates))
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndet
|
||||||
|
psi_coef_save(i,k) = psicoef(i,k)
|
||||||
|
enddo
|
||||||
|
call normalize_complex(psi_coef_save(1,k),ndet)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_determinants_psi_coef_complex(psi_coef_save)
|
||||||
|
deallocate (psi_coef_save)
|
||||||
|
|
||||||
|
allocate (psi_coef_save(ndet_qp_edit,nstates))
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndet_qp_edit
|
||||||
|
psi_coef_save(i,k) = psicoef(i,k)
|
||||||
|
enddo
|
||||||
|
call normalize_complex(psi_coef_save(1,k),ndet_qp_edit)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_determinants_psi_coef_complex_qp_edit(psi_coef_save)
|
||||||
|
deallocate (psi_coef_save)
|
||||||
|
|
||||||
|
call write_int(6,ndet,'Saved determinants')
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine save_wavefunction_specified_complex(ndet,nstates,psidet,psicoef,ndetsave,index_det_save)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Save the wave function into the |EZFIO| file
|
||||||
|
END_DOC
|
||||||
|
use bitmasks
|
||||||
|
integer, intent(in) :: ndet,nstates
|
||||||
|
integer(bit_kind), intent(in) :: psidet(N_int,2,ndet)
|
||||||
|
complex*16, intent(in) :: psicoef(ndet,nstates)
|
||||||
|
integer, intent(in) :: index_det_save(ndet)
|
||||||
|
integer, intent(in) :: ndetsave
|
||||||
|
integer*8, allocatable :: psi_det_save(:,:,:)
|
||||||
|
complex*16, allocatable :: psi_coef_save(:,:)
|
||||||
|
integer*8 :: det_8(100)
|
||||||
|
integer(bit_kind) :: det_bk((100*8)/bit_kind)
|
||||||
|
integer :: N_int2
|
||||||
|
equivalence (det_8, det_bk)
|
||||||
|
|
||||||
|
integer :: i,j,k, ndet_qp_edit
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
ndet_qp_edit = min(ndetsave,N_det_qp_edit)
|
||||||
|
call ezfio_set_determinants_N_int(N_int)
|
||||||
|
call ezfio_set_determinants_bit_kind(bit_kind)
|
||||||
|
call ezfio_set_determinants_N_det(ndetsave)
|
||||||
|
call ezfio_set_determinants_N_det_qp_edit(ndet_qp_edit)
|
||||||
|
call ezfio_set_determinants_n_states(nstates)
|
||||||
|
call ezfio_set_determinants_mo_label(mo_label)
|
||||||
|
|
||||||
|
N_int2 = (N_int*bit_kind)/8
|
||||||
|
allocate (psi_det_save(N_int2,2,ndetsave))
|
||||||
|
do i=1,ndetsave
|
||||||
|
do k=1,N_int
|
||||||
|
det_bk(k) = psidet(k,1,index_det_save(i))
|
||||||
|
enddo
|
||||||
|
do k=1,N_int2
|
||||||
|
psi_det_save(k,1,i) = det_8(k)
|
||||||
|
enddo
|
||||||
|
do k=1,N_int
|
||||||
|
det_bk(k) = psidet(k,2,index_det_save(i))
|
||||||
|
enddo
|
||||||
|
do k=1,N_int2
|
||||||
|
psi_det_save(k,2,i) = det_8(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_determinants_psi_det(psi_det_save)
|
||||||
|
call ezfio_set_determinants_psi_det_qp_edit(psi_det_save)
|
||||||
|
deallocate (psi_det_save)
|
||||||
|
|
||||||
|
allocate (psi_coef_save(ndetsave,nstates))
|
||||||
|
double precision :: accu_norm(nstates)
|
||||||
|
accu_norm = 0.d0
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndetsave
|
||||||
|
accu_norm(k) = accu_norm(k) + cdabs(psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k))
|
||||||
|
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k = 1, nstates
|
||||||
|
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
|
||||||
|
enddo
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndetsave
|
||||||
|
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_determinants_psi_coef_complex(psi_coef_save)
|
||||||
|
deallocate (psi_coef_save)
|
||||||
|
|
||||||
|
allocate (psi_coef_save(ndet_qp_edit,nstates))
|
||||||
|
accu_norm = 0.d0
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndet_qp_edit
|
||||||
|
accu_norm(k) = accu_norm(k) + cdabs(psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k))
|
||||||
|
psi_coef_save(i,k) = psicoef(index_det_save(i),k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k = 1, nstates
|
||||||
|
accu_norm(k) = 1.d0/dsqrt(accu_norm(k))
|
||||||
|
enddo
|
||||||
|
do k=1,nstates
|
||||||
|
do i=1,ndet_qp_edit
|
||||||
|
psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!TODO: should this be psi_coef_complex_qp_edit?
|
||||||
|
call ezfio_set_determinants_psi_coef_complex(psi_coef_save)
|
||||||
|
deallocate (psi_coef_save)
|
||||||
|
|
||||||
|
call write_int(6,ndet,'Saved determinants')
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
@ -21,11 +21,19 @@ BEGIN_PROVIDER [ double precision, barycentric_electronic_energy, (N_states) ]
|
|||||||
|
|
||||||
barycentric_electronic_energy(:) = 0.d0
|
barycentric_electronic_energy(:) = 0.d0
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
do istate=1,N_states
|
||||||
|
do i=1,N_det
|
||||||
|
barycentric_electronic_energy(istate) += cdabs(psi_coef_complex(i,istate)*psi_coef_complex(i,istate))*diagonal_H_matrix_on_psi_det(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do istate=1,N_states
|
do istate=1,N_states
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
barycentric_electronic_energy(istate) += psi_coef(i,istate)*psi_coef(i,istate)*diagonal_H_matrix_on_psi_det(i)
|
barycentric_electronic_energy(istate) += psi_coef(i,istate)*psi_coef(i,istate)*diagonal_H_matrix_on_psi_det(i)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -33,8 +33,8 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
|
|||||||
! Occupied MOs
|
! Occupied MOs
|
||||||
do ii=1,elec_alpha_num
|
do ii=1,elec_alpha_num
|
||||||
i = occ(ii,1)
|
i = occ(ii,1)
|
||||||
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i)
|
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i)
|
||||||
E0 = E0 + mo_one_e_integrals(i,i)
|
E0 = E0 + mo_one_e_integrals_diag(i)
|
||||||
do jj=1,elec_alpha_num
|
do jj=1,elec_alpha_num
|
||||||
j = occ(jj,1)
|
j = occ(jj,1)
|
||||||
if (i==j) cycle
|
if (i==j) cycle
|
||||||
@ -49,8 +49,8 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
|
|||||||
enddo
|
enddo
|
||||||
do ii=1,elec_beta_num
|
do ii=1,elec_beta_num
|
||||||
i = occ(ii,2)
|
i = occ(ii,2)
|
||||||
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i)
|
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i)
|
||||||
E0 = E0 + mo_one_e_integrals(i,i)
|
E0 = E0 + mo_one_e_integrals_diag(i)
|
||||||
do jj=1,elec_beta_num
|
do jj=1,elec_beta_num
|
||||||
j = occ(jj,2)
|
j = occ(jj,2)
|
||||||
if (i==j) cycle
|
if (i==j) cycle
|
||||||
@ -66,7 +66,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
|
|||||||
! Virtual MOs
|
! Virtual MOs
|
||||||
do i=1,mo_num
|
do i=1,mo_num
|
||||||
if (fock_diag_tmp(1,i) /= 0.d0) cycle
|
if (fock_diag_tmp(1,i) /= 0.d0) cycle
|
||||||
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals(i,i)
|
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_one_e_integrals_diag(i)
|
||||||
do jj=1,elec_alpha_num
|
do jj=1,elec_alpha_num
|
||||||
j = occ(jj,1)
|
j = occ(jj,1)
|
||||||
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j)
|
fock_diag_tmp(1,i) = fock_diag_tmp(1,i) + mo_two_e_integrals_jj_anti(i,j)
|
||||||
@ -78,7 +78,7 @@ subroutine build_fock_tmp(fock_diag_tmp,det_ref,Nint)
|
|||||||
enddo
|
enddo
|
||||||
do i=1,mo_num
|
do i=1,mo_num
|
||||||
if (fock_diag_tmp(2,i) /= 0.d0) cycle
|
if (fock_diag_tmp(2,i) /= 0.d0) cycle
|
||||||
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals(i,i)
|
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_one_e_integrals_diag(i)
|
||||||
do jj=1,elec_beta_num
|
do jj=1,elec_beta_num
|
||||||
j = occ(jj,2)
|
j = occ(jj,2)
|
||||||
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j)
|
fock_diag_tmp(2,i) = fock_diag_tmp(2,i) + mo_two_e_integrals_jj_anti(i,j)
|
||||||
|
@ -6,6 +6,7 @@ type H_apply_buffer_type
|
|||||||
integer :: sze
|
integer :: sze
|
||||||
integer(bit_kind), pointer :: det(:,:,:)
|
integer(bit_kind), pointer :: det(:,:,:)
|
||||||
double precision , pointer :: coef(:,:)
|
double precision , pointer :: coef(:,:)
|
||||||
|
complex*16 , pointer :: coef_complex(:,:)
|
||||||
double precision , pointer :: e2(:,:)
|
double precision , pointer :: e2(:,:)
|
||||||
end type H_apply_buffer_type
|
end type H_apply_buffer_type
|
||||||
|
|
||||||
@ -26,17 +27,22 @@ type(H_apply_buffer_type), pointer :: H_apply_buffer(:)
|
|||||||
allocate(H_apply_buffer(0:nproc-1))
|
allocate(H_apply_buffer(0:nproc-1))
|
||||||
iproc = 0
|
iproc = 0
|
||||||
!$OMP PARALLEL PRIVATE(iproc) DEFAULT(NONE) &
|
!$OMP PARALLEL PRIVATE(iproc) DEFAULT(NONE) &
|
||||||
!$OMP SHARED(H_apply_buffer,N_int,sze,N_states,H_apply_buffer_lock)
|
!$OMP SHARED(H_apply_buffer,N_int,sze,N_states,H_apply_buffer_lock,is_complex)
|
||||||
!$ iproc = omp_get_thread_num()
|
!$ iproc = omp_get_thread_num()
|
||||||
H_apply_buffer(iproc)%N_det = 0
|
H_apply_buffer(iproc)%N_det = 0
|
||||||
H_apply_buffer(iproc)%sze = sze
|
H_apply_buffer(iproc)%sze = sze
|
||||||
allocate ( &
|
allocate ( &
|
||||||
H_apply_buffer(iproc)%det(N_int,2,sze), &
|
H_apply_buffer(iproc)%det(N_int,2,sze), &
|
||||||
H_apply_buffer(iproc)%coef(sze,N_states), &
|
|
||||||
H_apply_buffer(iproc)%e2(sze,N_states) &
|
H_apply_buffer(iproc)%e2(sze,N_states) &
|
||||||
)
|
)
|
||||||
H_apply_buffer(iproc)%det = 0_bit_kind
|
if (is_complex) then
|
||||||
|
allocate(H_apply_buffer(iproc)%coef_complex(sze,N_states))
|
||||||
|
H_apply_buffer(iproc)%coef_complex = (0.d0,0.d0)
|
||||||
|
else
|
||||||
|
allocate(H_apply_buffer(iproc)%coef(sze,N_states))
|
||||||
H_apply_buffer(iproc)%coef = 0.d0
|
H_apply_buffer(iproc)%coef = 0.d0
|
||||||
|
endif
|
||||||
|
H_apply_buffer(iproc)%det = 0_bit_kind
|
||||||
H_apply_buffer(iproc)%e2 = 0.d0
|
H_apply_buffer(iproc)%e2 = 0.d0
|
||||||
call omp_init_lock(H_apply_buffer_lock(1,iproc))
|
call omp_init_lock(H_apply_buffer_lock(1,iproc))
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
@ -59,6 +65,7 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
|||||||
integer, intent(in) :: new_size, iproc
|
integer, intent(in) :: new_size, iproc
|
||||||
integer(bit_kind), pointer :: buffer_det(:,:,:)
|
integer(bit_kind), pointer :: buffer_det(:,:,:)
|
||||||
double precision, pointer :: buffer_coef(:,:)
|
double precision, pointer :: buffer_coef(:,:)
|
||||||
|
complex*16, pointer :: buffer_coef_complex(:,:)
|
||||||
double precision, pointer :: buffer_e2(:,:)
|
double precision, pointer :: buffer_e2(:,:)
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
integer :: Ndet
|
integer :: Ndet
|
||||||
@ -74,9 +81,14 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
|||||||
ASSERT (iproc < nproc)
|
ASSERT (iproc < nproc)
|
||||||
|
|
||||||
allocate ( buffer_det(N_int,2,new_size), &
|
allocate ( buffer_det(N_int,2,new_size), &
|
||||||
buffer_coef(new_size,N_states), &
|
|
||||||
buffer_e2(new_size,N_states) )
|
buffer_e2(new_size,N_states) )
|
||||||
|
if (is_complex) then
|
||||||
|
allocate(buffer_coef_complex(new_size,N_states))
|
||||||
|
buffer_coef_complex = (0.d0,0.d0)
|
||||||
|
else
|
||||||
|
allocate(buffer_coef(new_size,N_states))
|
||||||
buffer_coef = 0.d0
|
buffer_coef = 0.d0
|
||||||
|
endif
|
||||||
buffer_e2 = 0.d0
|
buffer_e2 = 0.d0
|
||||||
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
||||||
do k=1,N_int
|
do k=1,N_int
|
||||||
@ -89,6 +101,15 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
|||||||
deallocate(H_apply_buffer(iproc)%det)
|
deallocate(H_apply_buffer(iproc)%det)
|
||||||
H_apply_buffer(iproc)%det => buffer_det
|
H_apply_buffer(iproc)%det => buffer_det
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,N_states
|
||||||
|
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
||||||
|
buffer_coef_complex(i,k) = H_apply_buffer(iproc)%coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(H_apply_buffer(iproc)%coef_complex)
|
||||||
|
H_apply_buffer(iproc)%coef_complex => buffer_coef_complex
|
||||||
|
else
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
||||||
buffer_coef(i,k) = H_apply_buffer(iproc)%coef(i,k)
|
buffer_coef(i,k) = H_apply_buffer(iproc)%coef(i,k)
|
||||||
@ -96,6 +117,7 @@ subroutine resize_H_apply_buffer(new_size,iproc)
|
|||||||
enddo
|
enddo
|
||||||
deallocate(H_apply_buffer(iproc)%coef)
|
deallocate(H_apply_buffer(iproc)%coef)
|
||||||
H_apply_buffer(iproc)%coef => buffer_coef
|
H_apply_buffer(iproc)%coef => buffer_coef
|
||||||
|
endif
|
||||||
|
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
do i=1,min(new_size,H_apply_buffer(iproc)%N_det)
|
||||||
@ -119,6 +141,7 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer(bit_kind), allocatable :: buffer_det(:,:,:)
|
integer(bit_kind), allocatable :: buffer_det(:,:,:)
|
||||||
double precision, allocatable :: buffer_coef(:,:)
|
double precision, allocatable :: buffer_coef(:,:)
|
||||||
|
complex*16, allocatable :: buffer_coef_complex(:,:)
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
integer :: N_det_old
|
integer :: N_det_old
|
||||||
|
|
||||||
@ -128,7 +151,12 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
ASSERT (N_int > 0)
|
ASSERT (N_int > 0)
|
||||||
ASSERT (N_det > 0)
|
ASSERT (N_det > 0)
|
||||||
|
|
||||||
allocate ( buffer_det(N_int,2,N_det), buffer_coef(N_det,N_states) )
|
allocate ( buffer_det(N_int,2,N_det))
|
||||||
|
if (is_complex) then
|
||||||
|
allocate(buffer_coef_complex(N_det,N_states))
|
||||||
|
else
|
||||||
|
allocate(buffer_coef(N_det,N_states))
|
||||||
|
endif
|
||||||
|
|
||||||
! Backup determinants
|
! Backup determinants
|
||||||
j=0
|
j=0
|
||||||
@ -142,6 +170,17 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
N_det_old = j
|
N_det_old = j
|
||||||
|
|
||||||
! Backup coefficients
|
! Backup coefficients
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,N_states
|
||||||
|
j=0
|
||||||
|
do i=1,N_det
|
||||||
|
if (pruned(i)) cycle ! Pruned determinants
|
||||||
|
j += 1
|
||||||
|
buffer_coef_complex(j,k) = psi_coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
ASSERT ( j == N_det_old )
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
j=0
|
j=0
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -151,6 +190,7 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
enddo
|
enddo
|
||||||
ASSERT ( j == N_det_old )
|
ASSERT ( j == N_det_old )
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
! Update N_det
|
! Update N_det
|
||||||
N_det = N_det_old
|
N_det = N_det_old
|
||||||
@ -170,13 +210,56 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
ASSERT (sum(popcnt(psi_det(:,1,i))) == elec_alpha_num)
|
ASSERT (sum(popcnt(psi_det(:,1,i))) == elec_alpha_num)
|
||||||
ASSERT (sum(popcnt(psi_det(:,2,i))) == elec_beta_num )
|
ASSERT (sum(popcnt(psi_det(:,2,i))) == elec_beta_num )
|
||||||
enddo
|
enddo
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,N_states
|
||||||
|
do i=1,N_det_old
|
||||||
|
psi_coef_complex(i,k) = buffer_coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
do i=1,N_det_old
|
do i=1,N_det_old
|
||||||
psi_coef(i,k) = buffer_coef(i,k)
|
psi_coef(i,k) = buffer_coef(i,k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
! Copy new buffers
|
! Copy new buffers
|
||||||
|
logical :: found_duplicates
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||||
|
!$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) &
|
||||||
|
!$OMP SHARED(N_int,H_apply_buffer,psi_det,psi_coef_complex,N_states,psi_det_size)
|
||||||
|
j=0
|
||||||
|
!$ j=omp_get_thread_num()
|
||||||
|
do k=0,j-1
|
||||||
|
N_det_old += H_apply_buffer(k)%N_det
|
||||||
|
enddo
|
||||||
|
do i=1,H_apply_buffer(j)%N_det
|
||||||
|
do k=1,N_int
|
||||||
|
psi_det(k,1,i+N_det_old) = H_apply_buffer(j)%det(k,1,i)
|
||||||
|
psi_det(k,2,i+N_det_old) = H_apply_buffer(j)%det(k,2,i)
|
||||||
|
enddo
|
||||||
|
ASSERT (sum(popcnt(psi_det(:,1,i+N_det_old))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(psi_det(:,2,i+N_det_old))) == elec_beta_num )
|
||||||
|
enddo
|
||||||
|
do k=1,N_states
|
||||||
|
do i=1,H_apply_buffer(j)%N_det
|
||||||
|
psi_coef_complex(i+N_det_old,k) = H_apply_buffer(j)%coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP BARRIER
|
||||||
|
H_apply_buffer(j)%N_det = 0
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
SOFT_TOUCH N_det psi_det psi_coef_complex
|
||||||
|
|
||||||
|
call remove_duplicates_in_psi_det(found_duplicates)
|
||||||
|
do k=1,N_states
|
||||||
|
call normalize(psi_coef_complex(1,k),N_det)
|
||||||
|
enddo
|
||||||
|
SOFT_TOUCH N_det psi_det psi_coef_complex
|
||||||
|
else
|
||||||
|
|
||||||
!$OMP PARALLEL DEFAULT(SHARED) &
|
!$OMP PARALLEL DEFAULT(SHARED) &
|
||||||
!$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) &
|
!$OMP PRIVATE(j,k,i) FIRSTPRIVATE(N_det_old) &
|
||||||
@ -204,13 +287,13 @@ subroutine copy_H_apply_buffer_to_wf
|
|||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
SOFT_TOUCH N_det psi_det psi_coef
|
SOFT_TOUCH N_det psi_det psi_coef
|
||||||
|
|
||||||
logical :: found_duplicates
|
|
||||||
call remove_duplicates_in_psi_det(found_duplicates)
|
call remove_duplicates_in_psi_det(found_duplicates)
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
call normalize(psi_coef(1,k),N_det)
|
call normalize(psi_coef(1,k),N_det)
|
||||||
enddo
|
enddo
|
||||||
SOFT_TOUCH N_det psi_det psi_coef
|
SOFT_TOUCH N_det psi_det psi_coef
|
||||||
|
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine remove_duplicates_in_psi_det(found_duplicates)
|
subroutine remove_duplicates_in_psi_det(found_duplicates)
|
||||||
@ -275,6 +358,29 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
|
|||||||
!$OMP END DO
|
!$OMP END DO
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
if (found_duplicates) then
|
||||||
|
k=0
|
||||||
|
do i=1,N_det
|
||||||
|
if (.not.duplicate(i)) then
|
||||||
|
k += 1
|
||||||
|
psi_det(:,:,k) = psi_det_sorted_bit (:,:,i)
|
||||||
|
psi_coef_complex(k,:) = psi_coef_sorted_bit_complex(i,:)
|
||||||
|
else
|
||||||
|
if (sum(cdabs(psi_coef_sorted_bit_complex(i,:))) /= 0.d0 ) then
|
||||||
|
psi_coef_complex(k,:) = psi_coef_sorted_bit_complex(i,:)
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
N_det = k
|
||||||
|
psi_det_sorted_bit(:,:,1:N_det) = psi_det(:,:,1:N_det)
|
||||||
|
psi_coef_sorted_bit_complex(1:N_det,:) = psi_coef_complex(1:N_det,:)
|
||||||
|
TOUCH N_det psi_det psi_coef_complex psi_det_sorted_bit psi_coef_sorted_bit_complex c0_weight
|
||||||
|
endif
|
||||||
|
psi_det = psi_det_sorted
|
||||||
|
psi_coef_complex = psi_coef_sorted_complex
|
||||||
|
SOFT_TOUCH psi_det psi_coef_complex psi_det_sorted_bit psi_coef_sorted_bit_complex
|
||||||
|
else
|
||||||
if (found_duplicates) then
|
if (found_duplicates) then
|
||||||
k=0
|
k=0
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
@ -296,6 +402,7 @@ subroutine remove_duplicates_in_psi_det(found_duplicates)
|
|||||||
psi_det = psi_det_sorted
|
psi_det = psi_det_sorted
|
||||||
psi_coef = psi_coef_sorted
|
psi_coef = psi_coef_sorted
|
||||||
SOFT_TOUCH psi_det psi_coef psi_det_sorted_bit psi_coef_sorted_bit
|
SOFT_TOUCH psi_det psi_coef psi_det_sorted_bit psi_coef_sorted_bit
|
||||||
|
endif
|
||||||
deallocate (duplicate,bit_tmp)
|
deallocate (duplicate,bit_tmp)
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -329,11 +436,19 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
|||||||
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num)
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i+H_apply_buffer(iproc)%N_det)) )== elec_alpha_num)
|
||||||
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num)
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,2,i+H_apply_buffer(iproc)%N_det))) == elec_beta_num)
|
||||||
enddo
|
enddo
|
||||||
|
if (is_complex) then
|
||||||
|
do j=1,N_states
|
||||||
|
do i=1,N_selected
|
||||||
|
H_apply_buffer(iproc)%coef_complex(i+H_apply_buffer(iproc)%N_det,j) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do j=1,N_states
|
do j=1,N_states
|
||||||
do i=1,N_selected
|
do i=1,N_selected
|
||||||
H_apply_buffer(iproc)%coef(i+H_apply_buffer(iproc)%N_det,j) = 0.d0
|
H_apply_buffer(iproc)%coef(i+H_apply_buffer(iproc)%N_det,j) = 0.d0
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
H_apply_buffer(iproc)%N_det = new_size
|
H_apply_buffer(iproc)%N_det = new_size
|
||||||
do i=1,H_apply_buffer(iproc)%N_det
|
do i=1,H_apply_buffer(iproc)%N_det
|
||||||
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
|
ASSERT (sum(popcnt(H_apply_buffer(iproc)%det(:,1,i)) )== elec_alpha_num)
|
||||||
@ -341,4 +456,3 @@ subroutine fill_H_apply_buffer_no_selection(n_selected,det_buffer,Nint,iproc)
|
|||||||
enddo
|
enddo
|
||||||
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
|
call omp_unset_lock(H_apply_buffer_lock(1,iproc))
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -17,8 +17,11 @@ subroutine $subroutine($params_main)
|
|||||||
double precision, allocatable :: fock_diag_tmp(:,:)
|
double precision, allocatable :: fock_diag_tmp(:,:)
|
||||||
|
|
||||||
$initialization
|
$initialization
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators_complex
|
||||||
|
else
|
||||||
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators
|
PROVIDE H_apply_buffer_allocated mo_two_e_integrals_in_map psi_det_generators psi_coef_generators
|
||||||
|
endif
|
||||||
|
|
||||||
call wall_time(wall_0)
|
call wall_time(wall_0)
|
||||||
|
|
||||||
|
@ -401,12 +401,21 @@ BEGIN_PROVIDER [ double precision, weight_occ_pattern, (N_occ_pattern,N_states)
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
weight_occ_pattern = 0.d0
|
weight_occ_pattern = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_det
|
||||||
|
j = det_to_occ_pattern(i)
|
||||||
|
do k=1,N_states
|
||||||
|
weight_occ_pattern(j,k) += cdabs(psi_coef_complex(i,k) * psi_coef_complex(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
j = det_to_occ_pattern(i)
|
j = det_to_occ_pattern(i)
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
weight_occ_pattern(j,k) += psi_coef(i,k) * psi_coef(i,k)
|
weight_occ_pattern(j,k) += psi_coef(i,k) * psi_coef(i,k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, weight_occ_pattern_average, (N_occ_pattern) ]
|
BEGIN_PROVIDER [ double precision, weight_occ_pattern_average, (N_occ_pattern) ]
|
||||||
@ -416,12 +425,21 @@ BEGIN_PROVIDER [ double precision, weight_occ_pattern_average, (N_occ_pattern) ]
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k
|
integer :: i,j,k
|
||||||
weight_occ_pattern_average(:) = 0.d0
|
weight_occ_pattern_average(:) = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
do i=1,N_det
|
||||||
|
j = det_to_occ_pattern(i)
|
||||||
|
do k=1,N_states
|
||||||
|
weight_occ_pattern_average(j) += cdabs(psi_coef_complex(i,k) * psi_coef_complex(i,k)) * state_average_weight(k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i=1,N_det
|
do i=1,N_det
|
||||||
j = det_to_occ_pattern(i)
|
j = det_to_occ_pattern(i)
|
||||||
do k=1,N_states
|
do k=1,N_states
|
||||||
weight_occ_pattern_average(j) += psi_coef(i,k) * psi_coef(i,k) * state_average_weight(k)
|
weight_occ_pattern_average(j) += psi_coef(i,k) * psi_coef(i,k) * state_average_weight(k)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_occ_pattern_sorted, (N_int,2,N_occ_pattern) ]
|
BEGIN_PROVIDER [ integer(bit_kind), psi_occ_pattern_sorted, (N_int,2,N_occ_pattern) ]
|
||||||
@ -495,7 +513,7 @@ subroutine make_s2_eigenfunction
|
|||||||
N_det_new += 1
|
N_det_new += 1
|
||||||
det_buffer(:,:,N_det_new) = d(:,:,j)
|
det_buffer(:,:,N_det_new) = d(:,:,j)
|
||||||
if (N_det_new == bufsze) then
|
if (N_det_new == bufsze) then
|
||||||
call fill_H_apply_buffer_no_selection(bufsze,det_buffer,N_int,ithread)
|
call fill_h_apply_buffer_no_selection(bufsze,det_buffer,N_int,ithread)
|
||||||
N_det_new = 0
|
N_det_new = 0
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
@ -510,9 +528,13 @@ subroutine make_s2_eigenfunction
|
|||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
if (update) then
|
if (update) then
|
||||||
call copy_H_apply_buffer_to_wf
|
call copy_h_apply_buffer_to_wf
|
||||||
|
if (is_complex) then
|
||||||
|
TOUCH N_det psi_coef_complex psi_det psi_occ_pattern N_occ_pattern
|
||||||
|
else
|
||||||
TOUCH N_det psi_coef psi_det psi_occ_pattern N_occ_pattern
|
TOUCH N_det psi_coef psi_det psi_occ_pattern N_occ_pattern
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
call write_time(6)
|
call write_time(6)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
@ -150,7 +150,20 @@ END_PROVIDER
|
|||||||
double precision :: hij,norm,u_dot_v
|
double precision :: hij,norm,u_dot_v
|
||||||
psi_cas_energy = 0.d0
|
psi_cas_energy = 0.d0
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16 :: hij_c
|
||||||
|
do k = 1, N_states
|
||||||
|
norm = 0.d0
|
||||||
|
do i = 1, N_det_cas_complex
|
||||||
|
norm += cdabs(psi_cas_coef_complex(i,k) * psi_cas_coef_complex(i,k))
|
||||||
|
do j = 1, N_det_cas_complex
|
||||||
|
!TODO: accum imag parts to ensure that sum is zero?
|
||||||
|
psi_cas_energy(k) += dble(dconjg(psi_cas_coef_complex(i,k)) * psi_cas_coef_complex(j,k) * H_matrix_cas_complex(i,j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
psi_cas_energy(k) = psi_cas_energy(k) /norm
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k = 1, N_states
|
do k = 1, N_states
|
||||||
norm = 0.d0
|
norm = 0.d0
|
||||||
do i = 1, N_det_cas
|
do i = 1, N_det_cas
|
||||||
@ -161,6 +174,7 @@ END_PROVIDER
|
|||||||
enddo
|
enddo
|
||||||
psi_cas_energy(k) = psi_cas_energy(k) /norm
|
psi_cas_energy(k) = psi_cas_energy(k) /norm
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
145
src/determinants/psi_cas_cplx.irp.f
Normal file
145
src/determinants/psi_cas_cplx.irp.f
Normal file
@ -0,0 +1,145 @@
|
|||||||
|
use bitmasks
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), psi_cas_complex, (N_int,2,psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, psi_cas_coef_complex, (psi_det_size,n_states) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, idx_cas_complex, (psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, N_det_cas_complex ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |CAS| wave function, defined from the application of the |CAS| bitmask on the
|
||||||
|
! determinants. idx_cas gives the indice of the |CAS| determinant in psi_det.
|
||||||
|
END_DOC
|
||||||
|
integer :: i, k, l
|
||||||
|
logical :: good
|
||||||
|
n_det_cas_complex = 0
|
||||||
|
do i=1,N_det
|
||||||
|
do l = 1, N_states
|
||||||
|
psi_cas_coef_complex(i,l) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
good = .True.
|
||||||
|
do k=1,N_int
|
||||||
|
good = good .and. ( &
|
||||||
|
iand(not(act_bitmask(k,1)), psi_det(k,1,i)) == &
|
||||||
|
iand(not(act_bitmask(k,1)), hf_bitmask(k,1)) ) .and. ( &
|
||||||
|
iand(not(act_bitmask(k,2)), psi_det(k,2,i)) == &
|
||||||
|
iand(not(act_bitmask(k,2)), hf_bitmask(k,2)) )
|
||||||
|
enddo
|
||||||
|
if (good) then
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
if (good) then
|
||||||
|
n_det_cas_complex = n_det_cas_complex+1
|
||||||
|
do k=1,N_int
|
||||||
|
psi_cas_complex(k,1,n_det_cas_complex) = psi_det(k,1,i)
|
||||||
|
psi_cas_complex(k,2,n_det_cas_complex) = psi_det(k,2,i)
|
||||||
|
enddo
|
||||||
|
idx_cas(n_det_cas_complex) = i
|
||||||
|
do k=1,N_states
|
||||||
|
psi_cas_coef_complex(n_det_cas_complex,k) = psi_coef_complex(i,k)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
call write_int(6,n_det_cas_complex, 'Number of determinants in the CAS')
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), psi_cas_sorted_bit_complex, (N_int,2,psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, psi_cas_coef_sorted_bit_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |CAS| determinants sorted to accelerate the search of a random determinant in the wave
|
||||||
|
! function.
|
||||||
|
END_DOC
|
||||||
|
call sort_dets_by_det_search_key_complex(n_det_cas_complex, psi_cas_complex, psi_cas_coef_complex, size(psi_cas_coef_complex,1), &
|
||||||
|
psi_cas_sorted_bit_complex, psi_cas_coef_sorted_bit_complex, N_states)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_complex, (N_int,2,psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef_complex, (psi_det_size,n_states) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, idx_non_cas_complex, (psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, N_det_non_cas_complex ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Set of determinants which are not part of the |CAS|, defined from the application
|
||||||
|
! of the |CAS| bitmask on the determinants.
|
||||||
|
! idx_non_cas gives the indice of the determinant in psi_det.
|
||||||
|
END_DOC
|
||||||
|
integer :: i_non_cas,j,k
|
||||||
|
integer :: degree
|
||||||
|
logical :: in_cas
|
||||||
|
i_non_cas =0
|
||||||
|
do k=1,N_det
|
||||||
|
in_cas = .False.
|
||||||
|
do j=1,N_det_cas_complex
|
||||||
|
call get_excitation_degree(psi_cas_complex(1,1,j), psi_det(1,1,k), degree, N_int)
|
||||||
|
if (degree == 0) then
|
||||||
|
in_cas = .True.
|
||||||
|
exit
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
if (.not.in_cas) then
|
||||||
|
double precision :: hij
|
||||||
|
i_non_cas += 1
|
||||||
|
do j=1,N_int
|
||||||
|
psi_non_cas_complex(j,1,i_non_cas) = psi_det(j,1,k)
|
||||||
|
psi_non_cas_complex(j,2,i_non_cas) = psi_det(j,2,k)
|
||||||
|
enddo
|
||||||
|
do j=1,N_states
|
||||||
|
psi_non_cas_coef_complex(i_non_cas,j) = psi_coef_complex(k,j)
|
||||||
|
enddo
|
||||||
|
idx_non_cas_complex(i_non_cas) = k
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
N_det_non_cas_complex = i_non_cas
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer(bit_kind), psi_non_cas_sorted_bit_complex, (N_int,2,psi_det_size) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, psi_non_cas_coef_sorted_bit_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |CAS| determinants sorted to accelerate the search of a random determinant in the wave
|
||||||
|
! function.
|
||||||
|
END_DOC
|
||||||
|
!TODO: should this be n_det_non_cas_complex?
|
||||||
|
call sort_dets_by_det_search_key_complex(N_det_cas_complex, psi_non_cas_complex, psi_non_cas_coef_complex, size(psi_non_cas_coef_complex,1), &
|
||||||
|
psi_non_cas_sorted_bit_complex, psi_non_cas_coef_sorted_bit_complex, N_states)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, H_matrix_cas_complex, (N_det_cas_complex,N_det_cas_complex)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j
|
||||||
|
complex*16 :: hij
|
||||||
|
do i = 1, N_det_cas_complex
|
||||||
|
do j = 1, N_det_cas_complex
|
||||||
|
call i_h_j_complex(psi_cas_complex(1,1,i),psi_cas_complex(1,1,j),N_int,hij)
|
||||||
|
H_matrix_cas_complex(i,j) = hij
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, psi_coef_cas_diagonalized_complex, (N_det_cas_complex,N_states)]
|
||||||
|
&BEGIN_PROVIDER [double precision, psi_cas_energy_diagonalized_complex, (N_states)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j
|
||||||
|
double precision, allocatable :: eigenvalues(:)
|
||||||
|
complex*16, allocatable :: eigenvectors(:,:)
|
||||||
|
allocate (eigenvectors(size(H_matrix_cas,1),N_det_cas))
|
||||||
|
allocate (eigenvalues(N_det_cas))
|
||||||
|
call lapack_diag_complex(eigenvalues,eigenvectors, &
|
||||||
|
H_matrix_cas_complex,size(H_matrix_cas_complex,1),N_det_cas_complex)
|
||||||
|
do i = 1, N_states
|
||||||
|
psi_cas_energy_diagonalized_complex(i) = eigenvalues(i)
|
||||||
|
do j = 1, N_det_cas_complex
|
||||||
|
psi_coef_cas_diagonalized_complex(j,i) = eigenvectors(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -9,7 +9,26 @@
|
|||||||
! computed using the :c:data:`one_e_dm_mo_alpha` +
|
! computed using the :c:data:`one_e_dm_mo_alpha` +
|
||||||
! :c:data:`one_e_dm_mo_beta` and :c:data:`mo_one_e_integrals`
|
! :c:data:`one_e_dm_mo_beta` and :c:data:`mo_one_e_integrals`
|
||||||
END_DOC
|
END_DOC
|
||||||
|
double precision :: accu
|
||||||
psi_energy_h_core = 0.d0
|
psi_energy_h_core = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
do i = 1, N_states
|
||||||
|
do j = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
psi_energy_h_core(i) += dble(mo_one_e_integrals_complex(k,j) * &
|
||||||
|
(one_e_dm_mo_alpha_complex(j,k,i) + one_e_dm_mo_beta_complex(j,k,i)))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do i = 1, N_states
|
||||||
|
accu = 0.d0
|
||||||
|
do j = 1, mo_num
|
||||||
|
accu += dble(one_e_dm_mo_alpha_complex(j,j,i) + one_e_dm_mo_beta_complex(j,j,i))
|
||||||
|
enddo
|
||||||
|
accu = (elec_alpha_num + elec_beta_num ) / accu
|
||||||
|
psi_energy_h_core(i) = psi_energy_h_core(i) * accu
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i = 1, N_states
|
do i = 1, N_states
|
||||||
do j = 1, mo_num
|
do j = 1, mo_num
|
||||||
do k = 1, mo_num
|
do k = 1, mo_num
|
||||||
@ -17,7 +36,6 @@
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
double precision :: accu
|
|
||||||
do i = 1, N_states
|
do i = 1, N_states
|
||||||
accu = 0.d0
|
accu = 0.d0
|
||||||
do j = 1, mo_num
|
do j = 1, mo_num
|
||||||
@ -26,4 +44,5 @@
|
|||||||
accu = (elec_alpha_num + elec_beta_num ) / accu
|
accu = (elec_alpha_num + elec_beta_num ) / accu
|
||||||
psi_energy_h_core(i) = psi_energy_h_core(i) * accu
|
psi_energy_h_core(i) = psi_energy_h_core(i) * accu
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -6,6 +6,7 @@
|
|||||||
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_ab ]
|
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_ab ]
|
||||||
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_bb ]
|
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_bb ]
|
||||||
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_aa ]
|
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_aa ]
|
||||||
|
&BEGIN_PROVIDER [ double precision, ref_bitmask_energy_with_nucl_rep ]
|
||||||
|
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
@ -27,15 +28,15 @@
|
|||||||
ref_bitmask_two_e_energy = 0.d0
|
ref_bitmask_two_e_energy = 0.d0
|
||||||
|
|
||||||
do i = 1, elec_beta_num
|
do i = 1, elec_beta_num
|
||||||
ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1)) + mo_one_e_integrals(occ(i,2),occ(i,2))
|
ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1)) + mo_one_e_integrals_diag(occ(i,2))
|
||||||
ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1)) + mo_kinetic_integrals(occ(i,2),occ(i,2))
|
ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1)) + mo_kinetic_integrals_diag(occ(i,2))
|
||||||
ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1)) + mo_integrals_n_e(occ(i,2),occ(i,2))
|
ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1)) + mo_integrals_n_e_diag(occ(i,2))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do i = elec_beta_num+1,elec_alpha_num
|
do i = elec_beta_num+1,elec_alpha_num
|
||||||
ref_bitmask_energy += mo_one_e_integrals(occ(i,1),occ(i,1))
|
ref_bitmask_energy += mo_one_e_integrals_diag(occ(i,1))
|
||||||
ref_bitmask_kinetic_energy += mo_kinetic_integrals(occ(i,1),occ(i,1))
|
ref_bitmask_kinetic_energy += mo_kinetic_integrals_diag(occ(i,1))
|
||||||
ref_bitmask_n_e_energy += mo_integrals_n_e(occ(i,1),occ(i,1))
|
ref_bitmask_n_e_energy += mo_integrals_n_e_diag(occ(i,1))
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
do j= 1, elec_alpha_num
|
do j= 1, elec_alpha_num
|
||||||
@ -80,7 +81,7 @@
|
|||||||
enddo
|
enddo
|
||||||
ref_bitmask_energy_bb = ref_bitmask_energy_bb * 0.5d0
|
ref_bitmask_energy_bb = ref_bitmask_energy_bb * 0.5d0
|
||||||
|
|
||||||
|
ref_bitmask_energy_with_nucl_rep = ref_bitmask_energy + nuclear_repulsion
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -98,7 +98,11 @@ BEGIN_PROVIDER [ double precision, s2_values, (N_states) ]
|
|||||||
! array of the averaged values of the S^2 operator on the various states
|
! array of the averaged values of the S^2 operator on the various states
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i
|
integer :: i
|
||||||
|
if (is_complex) then
|
||||||
|
call u_0_S2_u_0_complex(s2_values,psi_coef_complex,n_det,psi_det,N_int,N_states,psi_det_size)
|
||||||
|
else
|
||||||
call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size)
|
call u_0_S2_u_0(s2_values,psi_coef,n_det,psi_det,N_int,N_states,psi_det_size)
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
288
src/determinants/s2_cplx.irp.f
Normal file
288
src/determinants/s2_cplx.irp.f
Normal file
@ -0,0 +1,288 @@
|
|||||||
|
subroutine u_0_S2_u_0_complex(e_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes e_0 = <u_0|S2|u_0>/<u_0|u_0>
|
||||||
|
!
|
||||||
|
! n : number of determinants
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n,Nint, N_st, sze_8
|
||||||
|
double precision, intent(out) :: e_0(N_st)
|
||||||
|
complex*16, intent(in) :: u_0(sze_8,N_st)
|
||||||
|
integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
|
||||||
|
|
||||||
|
complex*16, allocatable :: v_0(:,:)
|
||||||
|
double precision :: u_dot_u_complex
|
||||||
|
complex*16 :: u_dot_v_complex
|
||||||
|
integer :: i,j
|
||||||
|
allocate (v_0(sze_8,N_st))
|
||||||
|
|
||||||
|
call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
|
||||||
|
do i=1,N_st
|
||||||
|
e_0(i) = dble(u_dot_v_complex(u_0(1,i),v_0(1,i),n))/u_dot_u_complex(u_0(1,i),n) + S_z2_Sz
|
||||||
|
enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine S2_u_0_complex(v_0,u_0,n,keys_tmp,Nint)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes v_0 = S^2|u_0>
|
||||||
|
!
|
||||||
|
! n : number of determinants
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: n,Nint
|
||||||
|
complex*16, intent(out) :: v_0(n)
|
||||||
|
complex*16, intent(in) :: u_0(n)
|
||||||
|
integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
|
||||||
|
call s2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,1,n)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine S2_u_0_nstates_complex(v_0,u_0,n,keys_tmp,Nint,N_st,sze_8)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes v_0 = S^2|u_0>
|
||||||
|
!
|
||||||
|
! n : number of determinants
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: N_st,n,Nint, sze_8
|
||||||
|
complex*16, intent(out) :: v_0(sze_8,N_st)
|
||||||
|
complex*16, intent(in) :: u_0(sze_8,N_st)
|
||||||
|
integer(bit_kind),intent(in) :: keys_tmp(Nint,2,n)
|
||||||
|
double precision :: s2_tmp
|
||||||
|
complex*16, allocatable :: vt(:,:)
|
||||||
|
integer :: i,j,k,l, jj,ii
|
||||||
|
integer :: i0, j0
|
||||||
|
|
||||||
|
integer, allocatable :: shortcut(:,:), sort_idx(:,:)
|
||||||
|
integer(bit_kind), allocatable :: sorted(:,:,:), version(:,:,:)
|
||||||
|
integer(bit_kind) :: sorted_i(Nint)
|
||||||
|
|
||||||
|
integer :: sh, sh2, ni, exa, ext, org_i, org_j, endi, istate
|
||||||
|
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (n>0)
|
||||||
|
PROVIDE ref_bitmask_energy
|
||||||
|
|
||||||
|
allocate (shortcut(0:n+1,2), sort_idx(n,2), sorted(Nint,n,2), version(Nint,n,2))
|
||||||
|
v_0 = (0.d0,0.d0)
|
||||||
|
|
||||||
|
call sort_dets_ab_v(keys_tmp, sorted(1,1,1), sort_idx(1,1), shortcut(0,1), version(1,1,1), n, Nint)
|
||||||
|
call sort_dets_ba_v(keys_tmp, sorted(1,1,2), sort_idx(1,2), shortcut(0,2), version(1,1,2), n, Nint)
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,s2_tmp,j,k,jj,vt,ii,sh,sh2,ni,exa,ext,org_i,org_j,endi,sorted_i,istate)&
|
||||||
|
!$OMP SHARED(n,u_0,keys_tmp,Nint,v_0,sorted,shortcut,sort_idx,version,N_st,sze_8)
|
||||||
|
allocate(vt(sze_8,N_st))
|
||||||
|
vt = (0.d0,0.d0)
|
||||||
|
|
||||||
|
do sh=1,shortcut(0,1)
|
||||||
|
!$OMP DO SCHEDULE(static,1)
|
||||||
|
do sh2=sh,shortcut(0,1)
|
||||||
|
exa = 0
|
||||||
|
do ni=1,Nint
|
||||||
|
exa = exa + popcnt(xor(version(ni,sh,1), version(ni,sh2,1)))
|
||||||
|
end do
|
||||||
|
if(exa > 2) then
|
||||||
|
cycle
|
||||||
|
end if
|
||||||
|
|
||||||
|
do i=shortcut(sh,1),shortcut(sh+1,1)-1
|
||||||
|
org_i = sort_idx(i,1)
|
||||||
|
if(sh==sh2) then
|
||||||
|
endi = i-1
|
||||||
|
else
|
||||||
|
endi = shortcut(sh2+1,1)-1
|
||||||
|
end if
|
||||||
|
do ni=1,Nint
|
||||||
|
sorted_i(ni) = sorted(ni,i,1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do j=shortcut(sh2,1),endi
|
||||||
|
org_j = sort_idx(j,1)
|
||||||
|
ext = exa
|
||||||
|
do ni=1,Nint
|
||||||
|
ext = ext + popcnt(xor(sorted_i(ni), sorted(ni,j,1)))
|
||||||
|
end do
|
||||||
|
if(ext <= 4) then
|
||||||
|
call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp)
|
||||||
|
do istate=1,N_st
|
||||||
|
vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate)
|
||||||
|
vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do sh=1,shortcut(0,2)
|
||||||
|
!$OMP DO
|
||||||
|
do i=shortcut(sh,2),shortcut(sh+1,2)-1
|
||||||
|
org_i = sort_idx(i,2)
|
||||||
|
do j=shortcut(sh,2),i-1
|
||||||
|
org_j = sort_idx(j,2)
|
||||||
|
ext = 0
|
||||||
|
do ni=1,Nint
|
||||||
|
ext = ext + popcnt(xor(sorted(ni,i,2), sorted(ni,j,2)))
|
||||||
|
end do
|
||||||
|
if(ext == 4) then
|
||||||
|
call get_s2(keys_tmp(1,1,org_i),keys_tmp(1,1,org_j),Nint,s2_tmp)
|
||||||
|
do istate=1,N_st
|
||||||
|
vt (org_i,istate) = vt (org_i,istate) + s2_tmp*u_0(org_j,istate)
|
||||||
|
vt (org_j,istate) = vt (org_j,istate) + s2_tmp*u_0(org_i,istate)
|
||||||
|
enddo
|
||||||
|
end if
|
||||||
|
end do
|
||||||
|
end do
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
enddo
|
||||||
|
!$OMP BARRIER
|
||||||
|
|
||||||
|
do istate=1,N_st
|
||||||
|
do i=n,1,-1
|
||||||
|
!$OMP ATOMIC
|
||||||
|
v_0(i,istate) = v_0(i,istate) + vt(i,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(vt)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
|
||||||
|
do i=1,n
|
||||||
|
call get_s2(keys_tmp(1,1,i),keys_tmp(1,1,i),Nint,s2_tmp)
|
||||||
|
do istate=1,N_st
|
||||||
|
v_0(i,istate) += s2_tmp * u_0(i,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate (shortcut, sort_idx, sorted, version)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine get_uJ_s2_uI_complex(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_keys,s2,nstates)
|
||||||
|
!todo: modify/implement for complex
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
! implicit none
|
||||||
|
! use bitmasks
|
||||||
|
! integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates
|
||||||
|
! integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys)
|
||||||
|
! complex*16, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates)
|
||||||
|
! complex*16, intent(out) :: s2(nstates,nstates)
|
||||||
|
! double precision :: s2_tmp
|
||||||
|
! complex*16 :: accu
|
||||||
|
! integer :: i,j,l,jj,ll,kk
|
||||||
|
! integer, allocatable :: idx(:)
|
||||||
|
! BEGIN_DOC
|
||||||
|
! ! returns the matrix elements of S^2 "s2(i,j)" between the "nstates" states
|
||||||
|
! ! psi_coefs_tmp(:,i) and psi_coefs_tmp(:,j)
|
||||||
|
! END_DOC
|
||||||
|
! s2 = (0.d0,0.d0)
|
||||||
|
! do ll = 1, nstates
|
||||||
|
! do jj = 1, nstates
|
||||||
|
! accu = (0.d0,0.d0)
|
||||||
|
! !$OMP PARALLEL DEFAULT(NONE) &
|
||||||
|
! !$OMP PRIVATE (i,j,kk,idx,s2_tmp) &
|
||||||
|
! !$OMP SHARED (ll,jj,psi_keys_tmp,psi_coefs_tmp,N_int,n,nstates)&
|
||||||
|
! !$OMP REDUCTION(+:accu)
|
||||||
|
! allocate(idx(0:n))
|
||||||
|
! !$OMP DO SCHEDULE(dynamic)
|
||||||
|
! do i = n,1,-1 ! Better OMP scheduling
|
||||||
|
! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,i),N_int,s2_tmp)
|
||||||
|
! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(i,jj)
|
||||||
|
! call filter_connected(psi_keys_tmp,psi_keys_tmp(1,1,i),N_int,i-1,idx)
|
||||||
|
! do kk=1,idx(0)
|
||||||
|
! j = idx(kk)
|
||||||
|
! call get_s2(psi_keys_tmp(1,1,i),psi_keys_tmp(1,1,j),N_int,s2_tmp)
|
||||||
|
! accu += dconjg(psi_coefs_tmp(i,ll)) * s2_tmp * psi_coefs_tmp(j,jj) + psi_coefs_tmp(i,jj) * s2_tmp * psi_coefs_tmp(j,ll)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! !$OMP END DO
|
||||||
|
! deallocate(idx)
|
||||||
|
! !$OMP END PARALLEL
|
||||||
|
! s2(ll,jj) += accu
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! do i = 1, nstates
|
||||||
|
! do j =i+1,nstates
|
||||||
|
! accu = 0.5d0 * (s2(i,j) + s2(j,i))
|
||||||
|
! s2(i,j) = accu
|
||||||
|
! s2(j,i) = accu
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_S2_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_S2_psi_array)
|
||||||
|
!todo: modify/implement for complex
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
! use bitmasks
|
||||||
|
! implicit none
|
||||||
|
! integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist
|
||||||
|
! integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
|
||||||
|
! integer(bit_kind), intent(in) :: key(Nint,2)
|
||||||
|
! double precision, intent(in) :: coef(Ndet_max,Nstate)
|
||||||
|
! double precision, intent(out) :: i_S2_psi_array(Nstate)
|
||||||
|
!
|
||||||
|
! integer :: i, ii,j, i_in_key, i_in_coef
|
||||||
|
! double precision :: phase
|
||||||
|
! integer :: exc(0:2,2,2)
|
||||||
|
! double precision :: s2ij
|
||||||
|
! integer :: idx(0:Ndet)
|
||||||
|
! BEGIN_DOC
|
||||||
|
!! Computes $\langle i|S^2|\Psi \rangle = \sum_J c_J \langle i|S^2|J \rangle$.
|
||||||
|
!!
|
||||||
|
!! Uses filter_connected_i_H_psi0 to get all the $|J\rangle$ to which $|i\rangle$
|
||||||
|
!! is connected. The $|J\rangle$ are searched in short pre-computed lists.
|
||||||
|
! END_DOC
|
||||||
|
!
|
||||||
|
! ASSERT (Nint > 0)
|
||||||
|
! ASSERT (N_int == Nint)
|
||||||
|
! ASSERT (Nstate > 0)
|
||||||
|
! ASSERT (Ndet > 0)
|
||||||
|
! ASSERT (Ndet_max >= Ndet)
|
||||||
|
! i_S2_psi_array = 0.d0
|
||||||
|
!
|
||||||
|
! call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx)
|
||||||
|
! if (Nstate == 1) then
|
||||||
|
!
|
||||||
|
! do ii=1,idx(0)
|
||||||
|
! i_in_key = idx(ii)
|
||||||
|
! i_in_coef = idx_key(idx(ii))
|
||||||
|
! !DIR$ FORCEINLINE
|
||||||
|
! call get_s2(keys(1,1,i_in_key),key,Nint,s2ij)
|
||||||
|
! ! TODO : Cache misses
|
||||||
|
! i_S2_psi_array(1) = i_S2_psi_array(1) + coef(i_in_coef,1)*s2ij
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! else
|
||||||
|
!
|
||||||
|
! do ii=1,idx(0)
|
||||||
|
! i_in_key = idx(ii)
|
||||||
|
! i_in_coef = idx_key(idx(ii))
|
||||||
|
! !DIR$ FORCEINLINE
|
||||||
|
! call get_s2(keys(1,1,i_in_key),key,Nint,s2ij)
|
||||||
|
! do j = 1, Nstate
|
||||||
|
! i_S2_psi_array(j) = i_S2_psi_array(j) + coef(i_in_coef,j)*s2ij
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
!
|
||||||
|
! endif
|
||||||
|
!
|
||||||
|
end
|
@ -133,4 +133,138 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine single_excitation_wee_complex(det_1,det_2,h,p,spin,phase,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: h,p,spin
|
||||||
|
double precision, intent(in) :: phase
|
||||||
|
integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
integer(bit_kind) :: differences(N_int,2)
|
||||||
|
integer(bit_kind) :: hole(N_int,2)
|
||||||
|
integer(bit_kind) :: partcl(N_int,2)
|
||||||
|
integer :: occ_hole(N_int*bit_kind_size,2)
|
||||||
|
integer :: occ_partcl(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2)
|
||||||
|
integer :: i0,i
|
||||||
|
do i = 1, N_int
|
||||||
|
differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
partcl(i,1) = iand(differences(i,1),det_1(i,1))
|
||||||
|
partcl(i,2) = iand(differences(i,2),det_1(i,2))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int)
|
||||||
|
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int)
|
||||||
|
hij = fock_wee_closed_shell_complex(h,p)
|
||||||
|
! holes :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(1)
|
||||||
|
i = occ_hole(i0,1)
|
||||||
|
hij -= big_array_coulomb_integrals_complex(i,h,p) ! get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_hole(2)
|
||||||
|
i = occ_hole(i0,2)
|
||||||
|
hij -= big_array_coulomb_integrals_complex(i,h,p) !get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! holes :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(spin)
|
||||||
|
i = occ_hole(i0,spin)
|
||||||
|
hij += big_array_exchange_integrals_complex(i,h,p) ! get_mo_two_e_integral_schwartz(h,i,i,p,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(1)
|
||||||
|
i = occ_partcl(i0,1)
|
||||||
|
hij += big_array_coulomb_integrals_complex(i,h,p)!get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_partcl(2)
|
||||||
|
i = occ_partcl(i0,2)
|
||||||
|
hij += big_array_coulomb_integrals_complex(i,h,p) !get_mo_two_e_integral_schwartz(h,i,p,i,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(spin)
|
||||||
|
i = occ_partcl(i0,spin)
|
||||||
|
hij -= big_array_exchange_integrals_complex(i,h,p)!get_mo_two_e_integral_schwartz(h,i,i,p,mo_integrals_map)
|
||||||
|
enddo
|
||||||
|
hij = hij * phase
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, fock_wee_closed_shell_complex, (mo_num, mo_num) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i0,j0,i,j,k0,k
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
integer :: occ(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_occ_ab_virt(2)
|
||||||
|
integer :: occ_virt(N_int*bit_kind_size,2)
|
||||||
|
integer(bit_kind) :: key_test(N_int)
|
||||||
|
integer(bit_kind) :: key_virt(N_int,2)
|
||||||
|
complex*16 :: accu
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int)
|
||||||
|
do i = 1, N_int
|
||||||
|
key_virt(i,1) = full_ijkl_bitmask(i)
|
||||||
|
key_virt(i,2) = full_ijkl_bitmask(i)
|
||||||
|
key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
enddo
|
||||||
|
complex*16 :: array_coulomb(mo_num),array_exchange(mo_num)
|
||||||
|
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int)
|
||||||
|
! docc ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1)
|
||||||
|
i=occ(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_wee_closed_shell_complex(i,j) = accu
|
||||||
|
fock_wee_closed_shell_complex(j,i) = dconjg(accu)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! virt ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab_virt(1)
|
||||||
|
i=occ_virt(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_wee_closed_shell_complex(i,j) = accu
|
||||||
|
fock_wee_closed_shell_complex(j,i) = dconjg(accu)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! docc ---> docc single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1)
|
||||||
|
i=occ(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab(1)
|
||||||
|
j = occ(j0,1)
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_wee_closed_shell_complex(i,j) = accu
|
||||||
|
fock_wee_closed_shell_complex(j,i) = dconjg(accu)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
use bitmasks
|
use bitmasks
|
||||||
BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)]
|
BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)]
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i,i0
|
integer :: i,i0,k
|
||||||
integer :: n_occ_ab(2)
|
integer :: n_occ_ab(2)
|
||||||
integer :: occ(N_int*bit_kind_size,2)
|
integer :: occ(N_int*bit_kind_size,2)
|
||||||
call bitstring_to_list_ab(ref_bitmask, occ, n_occ_ab, N_int)
|
call bitstring_to_list_ab(ref_bitmask, occ, n_occ_ab, N_int)
|
||||||
@ -10,16 +10,24 @@ BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask, (N_int,2)]
|
|||||||
ref_closed_shell_bitmask(i,1) = ref_bitmask(i,1)
|
ref_closed_shell_bitmask(i,1) = ref_bitmask(i,1)
|
||||||
ref_closed_shell_bitmask(i,2) = ref_bitmask(i,2)
|
ref_closed_shell_bitmask(i,2) = ref_bitmask(i,2)
|
||||||
enddo
|
enddo
|
||||||
|
if (is_complex) then
|
||||||
|
!todo: check this
|
||||||
|
do k=1,kpt_num
|
||||||
|
call bitstring_to_list_ab(ref_bitmask_kpts(1,1,k),occ,n_occ_ab,N_int)
|
||||||
|
do i0=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k)
|
||||||
|
i=occ(i0,1)
|
||||||
|
call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do i0 = elec_beta_num+1, elec_alpha_num
|
do i0 = elec_beta_num+1, elec_alpha_num
|
||||||
i=occ(i0,1)
|
i=occ(i0,1)
|
||||||
call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int)
|
call clear_bit_to_integer(i,ref_closed_shell_bitmask(1,1),N_int)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, fock_op_cshell_ref_bitmask, (mo_num, mo_num) ]
|
||||||
BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_num, mo_num) ]
|
|
||||||
implicit none
|
implicit none
|
||||||
integer :: i0,j0,i,j,k0,k
|
integer :: i0,j0,i,j,k0,k
|
||||||
integer :: n_occ_ab(2)
|
integer :: n_occ_ab(2)
|
||||||
@ -52,8 +60,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
|||||||
k = occ(k0,1)
|
k = occ(k0,1)
|
||||||
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
enddo
|
enddo
|
||||||
fock_operator_closed_shell_ref_bitmask(i,j) = accu + mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(i,j) = accu + mo_one_e_integrals(i,j)
|
||||||
fock_operator_closed_shell_ref_bitmask(j,i) = accu + mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(j,i) = accu + mo_one_e_integrals(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -69,8 +77,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
|||||||
k = occ(k0,1)
|
k = occ(k0,1)
|
||||||
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
enddo
|
enddo
|
||||||
fock_operator_closed_shell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j)
|
||||||
fock_operator_closed_shell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -86,8 +94,8 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
|||||||
k = occ(k0,1)
|
k = occ(k0,1)
|
||||||
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
enddo
|
enddo
|
||||||
fock_operator_closed_shell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(i,j) = accu+ mo_one_e_integrals(i,j)
|
||||||
fock_operator_closed_shell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j)
|
fock_op_cshell_ref_bitmask(j,i) = accu+ mo_one_e_integrals(i,j)
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
deallocate(array_coulomb,array_exchange)
|
deallocate(array_coulomb,array_exchange)
|
||||||
@ -123,7 +131,7 @@ subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij)
|
|||||||
enddo
|
enddo
|
||||||
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int)
|
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int)
|
||||||
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int)
|
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int)
|
||||||
hij = fock_operator_closed_shell_ref_bitmask(h,p)
|
hij = fock_op_cshell_ref_bitmask(h,p)
|
||||||
! holes :: direct terms
|
! holes :: direct terms
|
||||||
do i0 = 1, n_occ_ab_hole(1)
|
do i0 = 1, n_occ_ab_hole(1)
|
||||||
i = occ_hole(i0,1)
|
i = occ_hole(i0,1)
|
||||||
@ -159,3 +167,349 @@ subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! complex !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_cplx, (mo_num, mo_num) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i0,j0,i,j,k0,k
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
integer :: occ(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_occ_ab_virt(2)
|
||||||
|
integer :: occ_virt(N_int*bit_kind_size,2)
|
||||||
|
integer(bit_kind) :: key_test(N_int)
|
||||||
|
integer(bit_kind) :: key_virt(N_int,2)
|
||||||
|
complex*16 :: accu
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(ref_closed_shell_bitmask, occ, n_occ_ab, N_int)
|
||||||
|
do i = 1, N_int
|
||||||
|
key_virt(i,1) = full_ijkl_bitmask(i)
|
||||||
|
key_virt(i,2) = full_ijkl_bitmask(i)
|
||||||
|
key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
enddo
|
||||||
|
complex*16, allocatable :: array_coulomb(:),array_exchange(:)
|
||||||
|
allocate (array_coulomb(mo_num),array_exchange(mo_num))
|
||||||
|
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int)
|
||||||
|
! docc ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1)
|
||||||
|
i=occ(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
! <ia|ja>
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
! <ia|aj>
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(i,j) = accu + mo_one_e_integrals_complex(i,j)
|
||||||
|
!fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i)
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(fock_op_cshell_ref_bitmask_cplx(i,j))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! virt ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab_virt(1)
|
||||||
|
i=occ_virt(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j)
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! docc ---> docc single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1)
|
||||||
|
i=occ(i0,1)
|
||||||
|
do j0 = 1, n_occ_ab(1)
|
||||||
|
j = occ(j0,1)
|
||||||
|
call get_mo_two_e_integrals_coulomb_ii_complex(i,j,mo_num,array_coulomb,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
call get_mo_two_e_integrals_exch_ii_complex(i,j,mo_num,array_exchange,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do k0 = 1, n_occ_ab(1)
|
||||||
|
k = occ(k0,1)
|
||||||
|
accu += 2.d0 * array_coulomb(k) - array_exchange(k)
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(i,j) = accu+ mo_one_e_integrals_complex(i,j)
|
||||||
|
fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu)+ mo_one_e_integrals_complex(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(array_coulomb,array_exchange)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine get_single_excitation_from_fock_complex(det_1,det_2,h,p,spin,phase,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: h,p,spin
|
||||||
|
double precision, intent(in) :: phase
|
||||||
|
integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
integer(bit_kind) :: differences(N_int,2)
|
||||||
|
integer(bit_kind) :: hole(N_int,2)
|
||||||
|
integer(bit_kind) :: partcl(N_int,2)
|
||||||
|
integer :: occ_hole(N_int*bit_kind_size,2)
|
||||||
|
integer :: occ_partcl(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2)
|
||||||
|
integer :: i0,i
|
||||||
|
complex*16 :: buffer_c(mo_num),buffer_x(mo_num)
|
||||||
|
do i=1, mo_num
|
||||||
|
buffer_c(i) = big_array_coulomb_integrals_complex(i,h,p)
|
||||||
|
buffer_x(i) = big_array_exchange_integrals_complex(i,h,p)
|
||||||
|
enddo
|
||||||
|
do i = 1, N_int
|
||||||
|
differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask(i,1))
|
||||||
|
hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask(i,2))
|
||||||
|
partcl(i,1) = iand(differences(i,1),det_1(i,1))
|
||||||
|
partcl(i,2) = iand(differences(i,2),det_1(i,2))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int)
|
||||||
|
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int)
|
||||||
|
hij = fock_op_cshell_ref_bitmask_cplx(h,p)
|
||||||
|
! holes :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(1)
|
||||||
|
i = occ_hole(i0,1)
|
||||||
|
hij -= buffer_c(i)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_hole(2)
|
||||||
|
i = occ_hole(i0,2)
|
||||||
|
hij -= buffer_c(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! holes :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(spin)
|
||||||
|
i = occ_hole(i0,spin)
|
||||||
|
hij += buffer_x(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(1)
|
||||||
|
i = occ_partcl(i0,1)
|
||||||
|
hij += buffer_c(i)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_partcl(2)
|
||||||
|
i = occ_partcl(i0,2)
|
||||||
|
hij += buffer_c(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(spin)
|
||||||
|
i = occ_partcl(i0,spin)
|
||||||
|
hij -= buffer_x(i)
|
||||||
|
enddo
|
||||||
|
hij = hij * phase
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [integer(bit_kind), ref_closed_shell_bitmask_kpts, (N_int,2,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,k
|
||||||
|
do k = 1, kpt_num
|
||||||
|
do i = 1, N_int
|
||||||
|
ref_closed_shell_bitmask_kpts(i,1,k) = iand(ref_closed_shell_bitmask(i,1),kpts_bitmask(i,k))
|
||||||
|
ref_closed_shell_bitmask_kpts(i,2,k) = iand(ref_closed_shell_bitmask(i,2),kpts_bitmask(i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, fock_op_cshell_ref_bitmask_kpts, (mo_num_per_kpt, mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
integer :: i0,j0,i,j,k0,k,kblock,kvirt
|
||||||
|
integer :: i_i, i_j, i_k, kocc
|
||||||
|
integer :: n_occ_ab(2,kpt_num)
|
||||||
|
integer :: occ(N_int*bit_kind_size,2,kpt_num)
|
||||||
|
integer :: n_occ_ab_virt(2)
|
||||||
|
integer :: occ_virt(N_int*bit_kind_size,2)
|
||||||
|
integer(bit_kind) :: key_test(N_int)
|
||||||
|
integer(bit_kind) :: key_virt(N_int,2)
|
||||||
|
complex*16 :: accu
|
||||||
|
complex*16, allocatable :: array_coulomb(:),array_exchange(:)
|
||||||
|
|
||||||
|
do kblock = 1,kpt_num
|
||||||
|
call bitstring_to_list_ab(ref_closed_shell_bitmask_kpts(1,1,kblock), &
|
||||||
|
occ(1,1,kblock), n_occ_ab(1,kblock), N_int)
|
||||||
|
enddo
|
||||||
|
allocate (array_coulomb(mo_num_per_kpt),array_exchange(mo_num_per_kpt))
|
||||||
|
do kblock = 1,kpt_num
|
||||||
|
! get virt orbs for this kpt
|
||||||
|
do i = 1, N_int
|
||||||
|
key_virt(i,1) = iand(full_ijkl_bitmask(i),kpts_bitmask(i,kblock))
|
||||||
|
key_virt(i,2) = iand(full_ijkl_bitmask(i),kpts_bitmask(i,kblock))
|
||||||
|
key_virt(i,1) = xor(key_virt(i,1),ref_closed_shell_bitmask_kpts(i,1,kblock))
|
||||||
|
key_virt(i,2) = xor(key_virt(i,2),ref_closed_shell_bitmask_kpts(i,2,kblock))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int)
|
||||||
|
! docc ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1,kblock)
|
||||||
|
i=occ(i0,1,kblock)
|
||||||
|
i_i = mod(i-1,mo_num_per_kpt)+1
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
i_j = mod(j-1,mo_num_per_kpt)+1
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do kocc = 1,kpt_num
|
||||||
|
! <ia|ja>
|
||||||
|
array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
! <ia|aj>
|
||||||
|
array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
do k0 = 1, n_occ_ab(1,kocc)
|
||||||
|
k = occ(k0,1,kocc)
|
||||||
|
i_k = mod(k-1,mo_num_per_kpt)+1
|
||||||
|
accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock)
|
||||||
|
!fock_op_cshell_ref_bitmask_cplx(j,i) = dconjg(accu) + mo_one_e_integrals_complex(j,i)
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! virt ---> virt single excitations
|
||||||
|
do i0 = 1, n_occ_ab_virt(1)
|
||||||
|
i=occ_virt(i0,1)
|
||||||
|
i_i = mod(i-1,mo_num_per_kpt)+1
|
||||||
|
do j0 = 1, n_occ_ab_virt(1)
|
||||||
|
j = occ_virt(j0,1)
|
||||||
|
i_j = mod(j-1,mo_num_per_kpt)+1
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do kocc = 1,kpt_num
|
||||||
|
array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
do k0 = 1, n_occ_ab(1,kocc)
|
||||||
|
k = occ(k0,1,kocc)
|
||||||
|
i_k = mod(k-1,mo_num_per_kpt)+1
|
||||||
|
accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock)
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! docc ---> docc single excitations
|
||||||
|
do i0 = 1, n_occ_ab(1,kblock)
|
||||||
|
i=occ(i0,1,kblock)
|
||||||
|
i_i = mod(i-1,mo_num_per_kpt)+1
|
||||||
|
do j0 = 1, n_occ_ab(1,kblock)
|
||||||
|
j = occ(j0,1,kblock)
|
||||||
|
i_j = mod(j-1,mo_num_per_kpt)+1
|
||||||
|
accu = (0.d0,0.d0)
|
||||||
|
do kocc = 1,kpt_num
|
||||||
|
array_coulomb(1:mo_num_per_kpt) = big_array_coulomb_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
array_exchange(1:mo_num_per_kpt) = big_array_exchange_integrals_kpts(1:mo_num_per_kpt,kocc,i_i,i_j,kblock)
|
||||||
|
do k0 = 1, n_occ_ab(1,kocc)
|
||||||
|
k = occ(k0,1,kocc)
|
||||||
|
i_k = mod(k-1,mo_num_per_kpt)+1
|
||||||
|
accu += 2.d0 * array_coulomb(i_k) - array_exchange(i_k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock) = accu + mo_one_e_integrals_kpts(i_i,i_j,kblock)
|
||||||
|
fock_op_cshell_ref_bitmask_kpts(i_j,i_i,kblock) = dconjg(fock_op_cshell_ref_bitmask_kpts(i_i,i_j,kblock))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(array_coulomb,array_exchange)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine get_single_excitation_from_fock_kpts(det_1,det_2,ih,ip,spin,phase,hij)
|
||||||
|
use bitmasks
|
||||||
|
!called by i_h_j{,_s2,_single_spin}_complex
|
||||||
|
! ih, ip are indices in total mo list (not per kpt)
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: ih,ip,spin
|
||||||
|
double precision, intent(in) :: phase
|
||||||
|
integer(bit_kind), intent(in) :: det_1(N_int,2), det_2(N_int,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
integer(bit_kind) :: differences(N_int,2)
|
||||||
|
integer(bit_kind) :: hole(N_int,2)
|
||||||
|
integer(bit_kind) :: partcl(N_int,2)
|
||||||
|
integer :: occ_hole(N_int*bit_kind_size,2)
|
||||||
|
integer :: occ_partcl(N_int*bit_kind_size,2)
|
||||||
|
integer :: n_occ_ab_hole(2),n_occ_ab_partcl(2)
|
||||||
|
integer :: i0,i,h,p
|
||||||
|
integer :: ki,khp
|
||||||
|
complex*16 :: buffer_c(mo_num_per_kpt),buffer_x(mo_num_per_kpt)
|
||||||
|
khp = (ip-1)/mo_num_per_kpt+1
|
||||||
|
p = mod(ip-1,mo_num_per_kpt)+1
|
||||||
|
h = mod(ih-1,mo_num_per_kpt)+1
|
||||||
|
!todo: omp kpts
|
||||||
|
do ki=1,kpt_num
|
||||||
|
do i=1, mo_num_per_kpt
|
||||||
|
!<hi|pi>
|
||||||
|
buffer_c(i) = big_array_coulomb_integrals_kpts(i,ki,h,p,khp)
|
||||||
|
!<hi|ip>
|
||||||
|
buffer_x(i) = big_array_exchange_integrals_kpts(i,ki,h,p,khp)
|
||||||
|
enddo
|
||||||
|
do i = 1, N_int
|
||||||
|
!holes in ref, not in det1
|
||||||
|
!part in det1, not in ref
|
||||||
|
differences(i,1) = iand(xor(det_1(i,1),ref_closed_shell_bitmask(i,1)),kpts_bitmask(i,ki))
|
||||||
|
differences(i,2) = iand(xor(det_1(i,2),ref_closed_shell_bitmask(i,2)),kpts_bitmask(i,ki))
|
||||||
|
!differences(i,1) = xor(det_1(i,1),ref_closed_shell_bitmask_kpts(i,1,ki))
|
||||||
|
!differences(i,2) = xor(det_1(i,2),ref_closed_shell_bitmask_kpts(i,2,ki))
|
||||||
|
hole(i,1) = iand(differences(i,1),ref_closed_shell_bitmask_kpts(i,1,ki))
|
||||||
|
hole(i,2) = iand(differences(i,2),ref_closed_shell_bitmask_kpts(i,2,ki))
|
||||||
|
partcl(i,1) = iand(differences(i,1),det_1(i,1))
|
||||||
|
partcl(i,2) = iand(differences(i,2),det_1(i,2))
|
||||||
|
enddo
|
||||||
|
call bitstring_to_list_ab(hole, occ_hole, n_occ_ab_hole, N_int)
|
||||||
|
call bitstring_to_list_ab(partcl, occ_partcl, n_occ_ab_partcl, N_int)
|
||||||
|
hij = fock_op_cshell_ref_bitmask_kpts(h,p,khp)
|
||||||
|
! holes :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(1)
|
||||||
|
i = occ_hole(i0,1) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij -= buffer_c(i)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_hole(2)
|
||||||
|
i = occ_hole(i0,2) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij -= buffer_c(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! holes :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_hole(spin)
|
||||||
|
i = occ_hole(i0,spin) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij += buffer_x(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: direct terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(1)
|
||||||
|
i = occ_partcl(i0,1) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij += buffer_c(i)
|
||||||
|
enddo
|
||||||
|
do i0 = 1, n_occ_ab_partcl(2)
|
||||||
|
i = occ_partcl(i0,2) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij += buffer_c(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! particles :: exchange terms
|
||||||
|
do i0 = 1, n_occ_ab_partcl(spin)
|
||||||
|
i = occ_partcl(i0,spin) - (ki-1)*mo_num_per_kpt
|
||||||
|
hij -= buffer_x(i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
hij = hij * phase
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
@ -1581,8 +1581,6 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
|||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
|
double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Nint)
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
@ -1745,7 +1743,7 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb)
|
|||||||
call bitstring_to_list_ab(key, occ, tmp, Nint)
|
call bitstring_to_list_ab(key, occ, tmp, Nint)
|
||||||
na = na-1
|
na = na-1
|
||||||
|
|
||||||
hjj = hjj - mo_one_e_integrals(iorb,iorb)
|
hjj = hjj - mo_one_e_integrals_diag(iorb)
|
||||||
|
|
||||||
! Same spin
|
! Same spin
|
||||||
do i=1,na
|
do i=1,na
|
||||||
@ -1803,7 +1801,7 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb)
|
|||||||
key(k,ispin) = ibset(key(k,ispin),l)
|
key(k,ispin) = ibset(key(k,ispin),l)
|
||||||
other_spin = iand(ispin,1)+1
|
other_spin = iand(ispin,1)+1
|
||||||
|
|
||||||
hjj = hjj + mo_one_e_integrals(iorb,iorb)
|
hjj = hjj + mo_one_e_integrals_diag(iorb)
|
||||||
|
|
||||||
! Same spin
|
! Same spin
|
||||||
do i=1,na
|
do i=1,na
|
||||||
@ -2292,3 +2290,607 @@ subroutine connected_to_hf(key_i,yes_no)
|
|||||||
yes_no = .True.
|
yes_no = .True.
|
||||||
endif
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_s2_complex(key_i,key_j,Nint,hij,s2)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ and $\langle i|S^2|j \rangle$
|
||||||
|
! where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
double precision, intent(out) :: s2
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
integer :: degree
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
integer :: m,n,p,q
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
double precision :: diag_h_mat_elem, phase
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num)
|
||||||
|
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
s2 = 0.d0
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
integer :: spin
|
||||||
|
select case (degree)
|
||||||
|
case (2)
|
||||||
|
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
! Single alpha, single beta
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then
|
||||||
|
s2 = -phase
|
||||||
|
endif
|
||||||
|
if(exc(1,1,1) == exc(1,2,2) )then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||||
|
else if (exc(1,2,1) ==exc(1,1,2))then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2))
|
||||||
|
else
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
endif
|
||||||
|
! Double alpha
|
||||||
|
else if (exc(0,1,1) == 2) then
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(2,2,1), &
|
||||||
|
exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
! Double beta
|
||||||
|
else if (exc(0,1,2) == 2) then
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(1,2,2), &
|
||||||
|
exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(2,2,2), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
endif
|
||||||
|
case (1)
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||||
|
! Single alpha
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
spin = 1
|
||||||
|
! Single beta
|
||||||
|
else
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
spin = 2
|
||||||
|
endif
|
||||||
|
call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij)
|
||||||
|
|
||||||
|
case (0)
|
||||||
|
double precision, external :: diag_S_mat_elem
|
||||||
|
s2 = diag_S_mat_elem(key_i,Nint)
|
||||||
|
hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_complex(key_i,key_j,Nint,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
integer :: degree
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
integer :: m,n,p,q
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: ih1,ih2,ip1,ip2,kh1,kh2,kp1,kp2
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
double precision :: diag_H_mat_elem, phase
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
logical :: is_allowed
|
||||||
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num)
|
||||||
|
|
||||||
|
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
integer :: spin
|
||||||
|
select case (degree)
|
||||||
|
case (2)
|
||||||
|
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
call double_allowed_mo_kpts(exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2),is_allowed)
|
||||||
|
if (.not.is_allowed) then
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
! Single alpha, single beta
|
||||||
|
if(exc(1,1,1) == exc(1,2,2) )then
|
||||||
|
ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1
|
||||||
|
ih2 = mod(exc(1,1,2)-1,mo_num_per_kpt)+1
|
||||||
|
kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1
|
||||||
|
kh2 = (exc(1,1,2)-1)/mo_num_per_kpt+1
|
||||||
|
ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1
|
||||||
|
kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1
|
||||||
|
if(kp1.ne.kh2) then
|
||||||
|
print*,'problem with hij kpts: ',irp_here
|
||||||
|
print*,is_allowed
|
||||||
|
print*,exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2)
|
||||||
|
print*,ih1,kh1,ih2,kh2,ip1,kp1
|
||||||
|
stop -4
|
||||||
|
endif
|
||||||
|
hij = phase * big_array_exchange_integrals_kpts(ih1,kh1,ih2,ip1,kp1)
|
||||||
|
!hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||||
|
else if (exc(1,2,1) ==exc(1,1,2))then
|
||||||
|
ih1 = mod(exc(1,1,1)-1,mo_num_per_kpt)+1
|
||||||
|
kh1 = (exc(1,1,1)-1)/mo_num_per_kpt+1
|
||||||
|
ip1 = mod(exc(1,2,1)-1,mo_num_per_kpt)+1
|
||||||
|
kp1 = (exc(1,2,1)-1)/mo_num_per_kpt+1
|
||||||
|
ip2 = mod(exc(1,2,2)-1,mo_num_per_kpt)+1
|
||||||
|
kp2 = (exc(1,2,2)-1)/mo_num_per_kpt+1
|
||||||
|
if(kp2.ne.kh1) then
|
||||||
|
print*,'problem with hij kpts: ',irp_here
|
||||||
|
print*,is_allowed
|
||||||
|
print*,exc(1,1,1),exc(1,1,2),exc(1,2,1),exc(1,2,2)
|
||||||
|
print*,ip1,kp1,ip2,kp2,ih1,kh1
|
||||||
|
stop -5
|
||||||
|
endif
|
||||||
|
hij = phase * big_array_exchange_integrals_kpts(ip1,kp1,ih1,ip2,kp2)
|
||||||
|
!hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2))
|
||||||
|
else
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
endif
|
||||||
|
else if (exc(0,1,1) == 2) then
|
||||||
|
call double_allowed_mo_kpts(exc(1,1,1),exc(2,1,1),exc(1,2,1),exc(2,2,1),is_allowed)
|
||||||
|
if (.not.is_allowed) then
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
! Double alpha
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(2,2,1), &
|
||||||
|
exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
else if (exc(0,1,2) == 2) then
|
||||||
|
call double_allowed_mo_kpts(exc(1,1,2),exc(2,1,2),exc(1,2,2),exc(2,2,2),is_allowed)
|
||||||
|
if (.not.is_allowed) then
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
! Double beta
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(1,2,2), &
|
||||||
|
exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(2,2,2), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
endif
|
||||||
|
case (1)
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Single alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
spin = 1
|
||||||
|
else
|
||||||
|
! Single beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
spin = 2
|
||||||
|
endif
|
||||||
|
!if m,p not from same kpt, single not allowed
|
||||||
|
if (int((m-1)/mo_num_per_kpt + 1).ne.int((p-1)/mo_num_per_kpt + 1)) then
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
!call get_single_excitation_from_fock_complex(key_i,key_j,m,p,spin,phase,hij)
|
||||||
|
call get_single_excitation_from_fock_kpts(key_i,key_j,m,p,spin,phase,hij)
|
||||||
|
|
||||||
|
case (0)
|
||||||
|
hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_verbose_complex(key_i,key_j,Nint,hij,hmono,hdouble,phase)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij,hmono,hdouble
|
||||||
|
double precision, intent(out) :: phase
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
integer :: degree
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
integer :: m,n,p,q
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
double precision :: diag_H_mat_elem
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
logical :: has_mipi(Nint*bit_kind_size)
|
||||||
|
complex*16 :: mipi(Nint*bit_kind_size), miip(Nint*bit_kind_size)
|
||||||
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_map
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num)
|
||||||
|
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
hmono = (0.d0,0.d0)
|
||||||
|
hdouble = (0.d0,0.d0)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
select case (degree)
|
||||||
|
case (2)
|
||||||
|
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Single alpha, single beta
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
else if (exc(0,1,1) == 2) then
|
||||||
|
! Double alpha
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(2,2,1), &
|
||||||
|
exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
|
||||||
|
else if (exc(0,1,2) == 2) then
|
||||||
|
! Double beta
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(1,2,2), &
|
||||||
|
exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(2,2,2), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
endif
|
||||||
|
case (1)
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||||
|
has_mipi = .False.
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Single alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
do k = 1, elec_alpha_num
|
||||||
|
i = occ(k,1)
|
||||||
|
if (.not.has_mipi(i)) then
|
||||||
|
mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
miip(i) = get_two_e_integral_complex(m,i,i,p,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
has_mipi(i) = .True.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do k = 1, elec_beta_num
|
||||||
|
i = occ(k,2)
|
||||||
|
if (.not.has_mipi(i)) then
|
||||||
|
mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
has_mipi(i) = .True.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k = 1, elec_alpha_num
|
||||||
|
hdouble = hdouble + mipi(occ(k,1)) - miip(occ(k,1))
|
||||||
|
enddo
|
||||||
|
do k = 1, elec_beta_num
|
||||||
|
hdouble = hdouble + mipi(occ(k,2))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
! Single beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
do k = 1, elec_beta_num
|
||||||
|
i = occ(k,2)
|
||||||
|
if (.not.has_mipi(i)) then
|
||||||
|
mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
miip(i) = get_two_e_integral_complex(m,i,i,p,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
has_mipi(i) = .True.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do k = 1, elec_alpha_num
|
||||||
|
i = occ(k,1)
|
||||||
|
if (.not.has_mipi(i)) then
|
||||||
|
mipi(i) = get_two_e_integral_complex(m,i,p,i,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
has_mipi(i) = .True.
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
do k = 1, elec_alpha_num
|
||||||
|
hdouble = hdouble + mipi(occ(k,1))
|
||||||
|
enddo
|
||||||
|
do k = 1, elec_beta_num
|
||||||
|
hdouble = hdouble + mipi(occ(k,2)) - miip(occ(k,2))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
hmono = mo_one_e_integrals_complex(m,p)
|
||||||
|
hij = phase*(hdouble + hmono)
|
||||||
|
|
||||||
|
case (0)
|
||||||
|
phase = 1.d0
|
||||||
|
hij = dcmplx(diag_H_mat_elem(key_i,Nint),0.d0)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_psi_complex(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $\langle i|H|Psi \rangle = \sum_J c_J \langle i | H | J \rangle$.
|
||||||
|
!
|
||||||
|
! Uses filter_connected_i_H_psi0 to get all the $|J \rangle$ to which $|i \rangle$
|
||||||
|
! is connected.
|
||||||
|
! The i_H_psi_minilist is much faster but requires to build the
|
||||||
|
! minilists.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate
|
||||||
|
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
|
||||||
|
integer(bit_kind), intent(in) :: key(Nint,2)
|
||||||
|
complex*16, intent(in) :: coef(Ndet_max,Nstate)
|
||||||
|
complex*16, intent(out) :: i_H_psi_array(Nstate)
|
||||||
|
|
||||||
|
integer :: i, ii,j
|
||||||
|
double precision :: phase
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
complex*16 :: hij
|
||||||
|
integer, allocatable :: idx(:)
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (N_int == Nint)
|
||||||
|
ASSERT (Nstate > 0)
|
||||||
|
ASSERT (Ndet > 0)
|
||||||
|
ASSERT (Ndet_max >= Ndet)
|
||||||
|
allocate(idx(0:Ndet))
|
||||||
|
|
||||||
|
i_H_psi_array = (0.d0,0.d0)
|
||||||
|
|
||||||
|
call filter_connected_i_h_psi0(keys,key,Nint,Ndet,idx)
|
||||||
|
if (Nstate == 1) then
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i = idx(ii)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_h_j_complex(key,keys(1,1,i),Nint,hij)
|
||||||
|
i_H_psi_array(1) = i_H_psi_array(1) + coef(i,1)*hij
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i = idx(ii)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_h_j_complex(key,keys(1,1,i),Nint,hij)
|
||||||
|
do j = 1, Nstate
|
||||||
|
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_psi_minilist_complex(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist
|
||||||
|
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
|
||||||
|
integer(bit_kind), intent(in) :: key(Nint,2)
|
||||||
|
complex*16, intent(in) :: coef(Ndet_max,Nstate)
|
||||||
|
complex*16, intent(out) :: i_H_psi_array(Nstate)
|
||||||
|
|
||||||
|
integer :: i, ii,j, i_in_key, i_in_coef
|
||||||
|
double precision :: phase
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
complex*16 :: hij
|
||||||
|
integer, allocatable :: idx(:)
|
||||||
|
BEGIN_DOC
|
||||||
|
! Computes $\langle i|H|\Psi \rangle = \sum_J c_J \langle i|H|J\rangle$.
|
||||||
|
!
|
||||||
|
! Uses filter_connected_i_H_psi0 to get all the $|J \rangle$ to which $|i \rangle$
|
||||||
|
! is connected. The $|J\rangle$ are searched in short pre-computed lists.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (N_int == Nint)
|
||||||
|
ASSERT (Nstate > 0)
|
||||||
|
ASSERT (Ndet > 0)
|
||||||
|
ASSERT (Ndet_max >= Ndet)
|
||||||
|
allocate(idx(0:Ndet))
|
||||||
|
i_H_psi_array = 0.d0
|
||||||
|
|
||||||
|
call filter_connected_i_h_psi0(keys,key,Nint,N_minilist,idx)
|
||||||
|
if (Nstate == 1) then
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i_in_key = idx(ii)
|
||||||
|
i_in_coef = idx_key(idx(ii))
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_h_j_complex(key,keys(1,1,i_in_key),Nint,hij)
|
||||||
|
! TODO : Cache misses
|
||||||
|
i_H_psi_array(1) = i_H_psi_array(1) + coef(i_in_coef,1)*hij
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
do ii=1,idx(0)
|
||||||
|
i_in_key = idx(ii)
|
||||||
|
i_in_coef = idx_key(idx(ii))
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call i_h_j_complex(key,keys(1,1,i_in_key),Nint,hij)
|
||||||
|
do j = 1, Nstate
|
||||||
|
i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_single_spin_complex(key_i,key_j,Nint,spin,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by
|
||||||
|
! a single excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, spin
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
!PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map
|
||||||
|
PROVIDE big_array_exchange_integrals_kpts mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
|
!call get_single_excitation_from_fock_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||||
|
call get_single_excitation_from_fock_kpts(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_double_spin_complex(key_i,key_j,Nint,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by
|
||||||
|
! a same-spin double excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
complex*16, external :: get_two_e_integral_complex
|
||||||
|
|
||||||
|
PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map
|
||||||
|
call get_double_excitation_spin(key_i,key_j,exc,phase,Nint)
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1), &
|
||||||
|
exc(2,1), &
|
||||||
|
exc(1,2), &
|
||||||
|
exc(2,2), mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1), &
|
||||||
|
exc(2,1), &
|
||||||
|
exc(2,2), &
|
||||||
|
exc(1,2), mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_double_alpha_beta_complex(key_i,key_j,Nint,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by
|
||||||
|
! an opposite-spin double excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
double precision :: phase, phase2
|
||||||
|
complex*16, external :: get_two_e_integral_complex
|
||||||
|
|
||||||
|
PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint)
|
||||||
|
call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint)
|
||||||
|
phase = phase*phase2
|
||||||
|
if (exc(1,1,1) == exc(1,2,2)) then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||||
|
else if (exc(1,2,1) == exc(1,1,2)) then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2))
|
||||||
|
else
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
@ -225,7 +225,7 @@ double precision function diag_H_mat_elem_one_e(det_in,Nint)
|
|||||||
call bitstring_to_list_ab(det_in, occ_particle, tmp, Nint)
|
call bitstring_to_list_ab(det_in, occ_particle, tmp, Nint)
|
||||||
do ispin = 1,2
|
do ispin = 1,2
|
||||||
do i = 1, tmp(ispin)
|
do i = 1, tmp(ispin)
|
||||||
diag_H_mat_elem_one_e += mo_one_e_integrals(occ_particle(i,ispin),occ_particle(i,ispin))
|
diag_H_mat_elem_one_e += mo_one_e_integrals_diag(occ_particle(i,ispin))
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
@ -361,3 +361,180 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
|
|||||||
end select
|
end select
|
||||||
end
|
end
|
||||||
|
|
||||||
|
!==============================================================================!
|
||||||
|
! !
|
||||||
|
! Complex !
|
||||||
|
! !
|
||||||
|
!==============================================================================!
|
||||||
|
|
||||||
|
subroutine i_Wee_j_single_complex(key_i,key_j,Nint,spin,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by a
|
||||||
|
! single excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, spin
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
PROVIDE big_array_exchange_integrals_complex mo_two_e_integrals_in_map
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
|
call single_excitation_wee_complex(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine i_H_j_mono_spin_one_e_complex(key_i,key_j,Nint,spin,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants differing by
|
||||||
|
! a single excitation.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint, spin
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||||
|
integer :: m,p
|
||||||
|
m = exc(1,1)
|
||||||
|
p = exc(1,2)
|
||||||
|
hij = phase * mo_one_e_integrals_complex(m,p)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_one_e_complex(key_i,key_j,Nint,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: degree,m,p
|
||||||
|
double precision :: diag_h_mat_elem_one_e,phase
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
if(degree>1)then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
if(degree==0)then
|
||||||
|
hij = dcmplx(diag_h_mat_elem_one_e(key_i,N_int),0.d0)
|
||||||
|
else
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
else
|
||||||
|
! Mono beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
endif
|
||||||
|
hij = phase * mo_one_e_integrals_complex(m,p)
|
||||||
|
endif
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine i_H_j_two_e_complex(key_i,key_j,Nint,hij)
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Returns $\langle i|H|j \rangle$ where $i$ and $j$ are determinants.
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
complex*16, intent(out) :: hij
|
||||||
|
|
||||||
|
integer :: exc(0:2,2,2)
|
||||||
|
integer :: degree
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
integer :: m,n,p,q
|
||||||
|
integer :: i,j,k
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
double precision :: diag_H_mat_elem, phase,phase_2
|
||||||
|
integer :: n_occ_ab(2)
|
||||||
|
PROVIDE mo_two_e_integrals_in_map mo_integrals_map big_array_exchange_integrals_complex ref_bitmask_two_e_energy
|
||||||
|
|
||||||
|
ASSERT (Nint > 0)
|
||||||
|
ASSERT (Nint == N_int)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_i(:,2))) == elec_beta_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,1))) == elec_alpha_num)
|
||||||
|
ASSERT (sum(popcnt(key_j(:,2))) == elec_beta_num)
|
||||||
|
|
||||||
|
hij = (0.d0,0.d0)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call get_excitation_degree(key_i,key_j,degree,Nint)
|
||||||
|
integer :: spin
|
||||||
|
select case (degree)
|
||||||
|
case (2)
|
||||||
|
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha, mono beta
|
||||||
|
if(exc(1,1,1) == exc(1,2,2) )then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||||
|
else if (exc(1,2,1) ==exc(1,1,2))then
|
||||||
|
hij = phase * big_array_exchange_integrals_complex(exc(1,2,1),exc(1,1,1),exc(1,2,2))
|
||||||
|
else
|
||||||
|
hij = phase*get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
endif
|
||||||
|
else if (exc(0,1,1) == 2) then
|
||||||
|
! Double alpha
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(1,2,1), &
|
||||||
|
exc(2,2,1) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,1), &
|
||||||
|
exc(2,1,1), &
|
||||||
|
exc(2,2,1), &
|
||||||
|
exc(1,2,1) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
else if (exc(0,1,2) == 2) then
|
||||||
|
! Double beta
|
||||||
|
hij = phase*(get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(1,2,2), &
|
||||||
|
exc(2,2,2) ,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex( &
|
||||||
|
exc(1,1,2), &
|
||||||
|
exc(2,1,2), &
|
||||||
|
exc(2,2,2), &
|
||||||
|
exc(1,2,2) ,mo_integrals_map,mo_integrals_map_2) )
|
||||||
|
endif
|
||||||
|
case (1)
|
||||||
|
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||||
|
!DIR$ FORCEINLINE
|
||||||
|
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||||
|
if (exc(0,1,1) == 1) then
|
||||||
|
! Mono alpha
|
||||||
|
m = exc(1,1,1)
|
||||||
|
p = exc(1,2,1)
|
||||||
|
spin = 1
|
||||||
|
else
|
||||||
|
! Mono beta
|
||||||
|
m = exc(1,1,2)
|
||||||
|
p = exc(1,2,2)
|
||||||
|
spin = 2
|
||||||
|
endif
|
||||||
|
call single_excitation_wee_complex(key_i,key_j,m,p,spin,phase,hij)
|
||||||
|
case (0)
|
||||||
|
double precision :: diag_wee_mat_elem
|
||||||
|
hij = dcmplx(diag_wee_mat_elem(key_i,Nint),0.d0)
|
||||||
|
end select
|
||||||
|
end
|
||||||
|
@ -10,6 +10,7 @@ spindeterminants
|
|||||||
psi_coef_matrix_rows integer (spindeterminants_n_det)
|
psi_coef_matrix_rows integer (spindeterminants_n_det)
|
||||||
psi_coef_matrix_columns integer (spindeterminants_n_det)
|
psi_coef_matrix_columns integer (spindeterminants_n_det)
|
||||||
psi_coef_matrix_values double precision (spindeterminants_n_det,spindeterminants_n_states)
|
psi_coef_matrix_values double precision (spindeterminants_n_det,spindeterminants_n_states)
|
||||||
|
psi_coef_matrix_values_complex double precision (2,spindeterminants_n_det,spindeterminants_n_states)
|
||||||
n_svd_coefs integer
|
n_svd_coefs integer
|
||||||
psi_svd_alpha double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states)
|
psi_svd_alpha double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states)
|
||||||
psi_svd_beta double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states)
|
psi_svd_beta double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states)
|
||||||
|
@ -307,8 +307,12 @@ integer function get_index_in_psi_det_beta_unique(key,Nint)
|
|||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine write_spindeterminants
|
subroutine write_spindeterminants
|
||||||
|
!todo: modify for complex (not called anywhere?)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
integer(8), allocatable :: tmpdet(:,:)
|
integer(8), allocatable :: tmpdet(:,:)
|
||||||
@ -350,7 +354,11 @@ subroutine write_spindeterminants
|
|||||||
call ezfio_set_spindeterminants_psi_det_beta(psi_det_beta_unique)
|
call ezfio_set_spindeterminants_psi_det_beta(psi_det_beta_unique)
|
||||||
deallocate(tmpdet)
|
deallocate(tmpdet)
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
call ezfio_set_spindeterminants_psi_coef_matrix_values_complex(psi_bilinear_matrix_values_complex)
|
||||||
|
else
|
||||||
call ezfio_set_spindeterminants_psi_coef_matrix_values(psi_bilinear_matrix_values)
|
call ezfio_set_spindeterminants_psi_coef_matrix_values(psi_bilinear_matrix_values)
|
||||||
|
endif
|
||||||
call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_bilinear_matrix_rows)
|
call ezfio_set_spindeterminants_psi_coef_matrix_rows(psi_bilinear_matrix_rows)
|
||||||
call ezfio_set_spindeterminants_psi_coef_matrix_columns(psi_bilinear_matrix_columns)
|
call ezfio_set_spindeterminants_psi_coef_matrix_columns(psi_bilinear_matrix_columns)
|
||||||
|
|
||||||
@ -370,6 +378,18 @@ end
|
|||||||
|
|
||||||
det_alpha_norm = 0.d0
|
det_alpha_norm = 0.d0
|
||||||
det_beta_norm = 0.d0
|
det_beta_norm = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,N_det
|
||||||
|
i = psi_bilinear_matrix_rows(k)
|
||||||
|
j = psi_bilinear_matrix_columns(k)
|
||||||
|
f = 0.d0
|
||||||
|
do l=1,N_states
|
||||||
|
f += cdabs(psi_bilinear_matrix_values_complex(k,l)*psi_bilinear_matrix_values_complex(k,l)) * state_average_weight(l)
|
||||||
|
enddo
|
||||||
|
det_alpha_norm(i) += f
|
||||||
|
det_beta_norm(j) += f
|
||||||
|
enddo
|
||||||
|
else
|
||||||
do k=1,N_det
|
do k=1,N_det
|
||||||
i = psi_bilinear_matrix_rows(k)
|
i = psi_bilinear_matrix_rows(k)
|
||||||
j = psi_bilinear_matrix_columns(k)
|
j = psi_bilinear_matrix_columns(k)
|
||||||
@ -380,6 +400,7 @@ end
|
|||||||
det_alpha_norm(i) += f
|
det_alpha_norm(i) += f
|
||||||
det_beta_norm(j) += f
|
det_beta_norm(j) += f
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
det_alpha_norm = det_alpha_norm
|
det_alpha_norm = det_alpha_norm
|
||||||
det_beta_norm = det_beta_norm
|
det_beta_norm = det_beta_norm
|
||||||
|
|
||||||
@ -392,8 +413,37 @@ END_PROVIDER
|
|||||||
! !
|
! !
|
||||||
!==============================================================================!
|
!==============================================================================!
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ]
|
BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows , (N_det) ]
|
use bitmasks
|
||||||
|
PROVIDE psi_bilinear_matrix_rows
|
||||||
|
integer :: k,l
|
||||||
|
do k=1,N_det
|
||||||
|
do l=1,N_states
|
||||||
|
psi_bilinear_matrix_values(k,l) = psi_coef(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do l=1,N_states
|
||||||
|
call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_values_complex, (N_det,N_states) ]
|
||||||
|
use bitmasks
|
||||||
|
PROVIDE psi_bilinear_matrix_rows
|
||||||
|
integer :: k,l
|
||||||
|
do k=1,N_det
|
||||||
|
do l=1,N_states
|
||||||
|
psi_bilinear_matrix_values_complex(k,l) = psi_coef_complex(k,l)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do l=1,N_states
|
||||||
|
call cdset_order(psi_bilinear_matrix_values_complex(1,l),psi_bilinear_matrix_order,N_det)
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows , (N_det) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns, (N_det) ]
|
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns, (N_det) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order , (N_det) ]
|
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order , (N_det) ]
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -408,10 +458,13 @@ END_PROVIDER
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k, l
|
integer :: i,j,k, l
|
||||||
integer(bit_kind) :: tmp_det(N_int,2)
|
integer(bit_kind) :: tmp_det(N_int,2)
|
||||||
integer, external :: get_index_in_psi_det_sorted_bit
|
! integer, external :: get_index_in_psi_det_sorted_bit
|
||||||
|
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_coef_sorted_bit_complex
|
||||||
|
else
|
||||||
PROVIDE psi_coef_sorted_bit
|
PROVIDE psi_coef_sorted_bit
|
||||||
|
endif
|
||||||
|
|
||||||
integer*8, allocatable :: to_sort(:)
|
integer*8, allocatable :: to_sort(:)
|
||||||
integer, external :: get_index_in_psi_det_alpha_unique
|
integer, external :: get_index_in_psi_det_alpha_unique
|
||||||
@ -427,9 +480,6 @@ END_PROVIDER
|
|||||||
ASSERT (j>0)
|
ASSERT (j>0)
|
||||||
ASSERT (j<=N_det_beta_unique)
|
ASSERT (j<=N_det_beta_unique)
|
||||||
|
|
||||||
do l=1,N_states
|
|
||||||
psi_bilinear_matrix_values(k,l) = psi_coef(k,l)
|
|
||||||
enddo
|
|
||||||
psi_bilinear_matrix_rows(k) = i
|
psi_bilinear_matrix_rows(k) = i
|
||||||
psi_bilinear_matrix_columns(k) = j
|
psi_bilinear_matrix_columns(k) = j
|
||||||
to_sort(k) = int(N_det_alpha_unique,8) * int(j-1,8) + int(i,8)
|
to_sort(k) = int(N_det_alpha_unique,8) * int(j-1,8) + int(i,8)
|
||||||
@ -445,11 +495,6 @@ END_PROVIDER
|
|||||||
!$OMP SINGLE
|
!$OMP SINGLE
|
||||||
call iset_order(psi_bilinear_matrix_columns,psi_bilinear_matrix_order,N_det)
|
call iset_order(psi_bilinear_matrix_columns,psi_bilinear_matrix_order,N_det)
|
||||||
!$OMP END SINGLE
|
!$OMP END SINGLE
|
||||||
!$OMP DO
|
|
||||||
do l=1,N_states
|
|
||||||
call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det)
|
|
||||||
enddo
|
|
||||||
!$OMP END DO
|
|
||||||
!$OMP END PARALLEL
|
!$OMP END PARALLEL
|
||||||
deallocate(to_sort)
|
deallocate(to_sort)
|
||||||
ASSERT (minval(psi_bilinear_matrix_rows) == 1)
|
ASSERT (minval(psi_bilinear_matrix_rows) == 1)
|
||||||
@ -514,8 +559,71 @@ BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns_loc, (N_det_beta_unique+1)
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ]
|
BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows , (N_det) ]
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transpose of :c:data:`psi_bilinear_matrix`
|
||||||
|
!
|
||||||
|
! $D_\beta^\dagger.C^\dagger.D_\alpha$
|
||||||
|
!
|
||||||
|
! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major
|
||||||
|
! format.
|
||||||
|
END_DOC
|
||||||
|
integer :: k,l
|
||||||
|
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_rows
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l)
|
||||||
|
do l=1,N_states
|
||||||
|
!$OMP DO
|
||||||
|
do k=1,N_det
|
||||||
|
psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l)
|
||||||
|
enddo
|
||||||
|
!$OMP ENDDO NOWAIT
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l)
|
||||||
|
do l=1,N_states
|
||||||
|
call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det)
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_transp_values_complex, (N_det,N_states) ]
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transpose of :c:data:`psi_bilinear_matrix`
|
||||||
|
!
|
||||||
|
! $D_\beta^\dagger.C^\dagger.D_\alpha$
|
||||||
|
!
|
||||||
|
! Rows are $\alpha$ determinants and columns are $\beta$, but the matrix is stored in row major
|
||||||
|
! format.
|
||||||
|
END_DOC
|
||||||
|
integer :: k,l
|
||||||
|
|
||||||
|
PROVIDE psi_bilinear_matrix_transp_rows
|
||||||
|
|
||||||
|
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(k,l)
|
||||||
|
do l=1,N_states
|
||||||
|
!$OMP DO
|
||||||
|
do k=1,N_det
|
||||||
|
psi_bilinear_matrix_transp_values_complex (k,l) = psi_bilinear_matrix_values_complex (k,l)
|
||||||
|
enddo
|
||||||
|
!$OMP ENDDO NOWAIT
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l)
|
||||||
|
do l=1,N_states
|
||||||
|
call cdset_order(psi_bilinear_matrix_transp_values_complex(1,l),psi_bilinear_matrix_transp_order,N_det)
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows , (N_det) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_columns, (N_det) ]
|
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_columns, (N_det) ]
|
||||||
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_order , (N_det) ]
|
&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_order , (N_det) ]
|
||||||
use bitmasks
|
use bitmasks
|
||||||
@ -530,18 +638,15 @@ END_PROVIDER
|
|||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j,k,l
|
integer :: i,j,k,l
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_coef_sorted_bit_complex
|
||||||
|
else
|
||||||
PROVIDE psi_coef_sorted_bit
|
PROVIDE psi_coef_sorted_bit
|
||||||
|
endif
|
||||||
|
|
||||||
integer*8, allocatable :: to_sort(:)
|
integer*8, allocatable :: to_sort(:)
|
||||||
allocate(to_sort(N_det))
|
allocate(to_sort(N_det))
|
||||||
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l)
|
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(i,j,k,l)
|
||||||
do l=1,N_states
|
|
||||||
!$OMP DO
|
|
||||||
do k=1,N_det
|
|
||||||
psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l)
|
|
||||||
enddo
|
|
||||||
!$OMP ENDDO NOWAIT
|
|
||||||
enddo
|
|
||||||
!$OMP DO
|
!$OMP DO
|
||||||
do k=1,N_det
|
do k=1,N_det
|
||||||
psi_bilinear_matrix_transp_columns(k) = psi_bilinear_matrix_columns(k)
|
psi_bilinear_matrix_transp_columns(k) = psi_bilinear_matrix_columns(k)
|
||||||
@ -563,11 +668,6 @@ END_PROVIDER
|
|||||||
call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1)
|
call i8radix_sort(to_sort, psi_bilinear_matrix_transp_order, N_det,-1)
|
||||||
call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det)
|
call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det)
|
||||||
call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det)
|
call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det)
|
||||||
!$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(l)
|
|
||||||
do l=1,N_states
|
|
||||||
call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det)
|
|
||||||
enddo
|
|
||||||
!$OMP END PARALLEL DO
|
|
||||||
deallocate(to_sort)
|
deallocate(to_sort)
|
||||||
ASSERT (minval(psi_bilinear_matrix_transp_columns) == 1)
|
ASSERT (minval(psi_bilinear_matrix_transp_columns) == 1)
|
||||||
ASSERT (minval(psi_bilinear_matrix_transp_rows) == 1)
|
ASSERT (minval(psi_bilinear_matrix_transp_rows) == 1)
|
||||||
@ -641,7 +741,30 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix, (N_det_alpha_unique,N_de
|
|||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_bilinear_matrix_complex, (N_det_alpha_unique,N_det_beta_unique,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Coefficient matrix if the wave function is expressed in a bilinear form :
|
||||||
|
!
|
||||||
|
! $D_\alpha^\dagger.C.D_\beta$
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,istate
|
||||||
|
psi_bilinear_matrix_complex = (0.d0,0.d0)
|
||||||
|
do k=1,N_det
|
||||||
|
i = psi_bilinear_matrix_rows(k)
|
||||||
|
j = psi_bilinear_matrix_columns(k)
|
||||||
|
do istate=1,N_states
|
||||||
|
psi_bilinear_matrix_complex(i,j,istate) = psi_bilinear_matrix_values_complex(k,istate)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
subroutine create_wf_of_psi_bilinear_matrix(truncate)
|
subroutine create_wf_of_psi_bilinear_matrix(truncate)
|
||||||
|
!todo: modify for complex (not called anywhere?)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -713,6 +836,11 @@ subroutine create_wf_of_psi_bilinear_matrix(truncate)
|
|||||||
end
|
end
|
||||||
|
|
||||||
subroutine generate_all_alpha_beta_det_products
|
subroutine generate_all_alpha_beta_det_products
|
||||||
|
!todo: modify for complex (only used by create_wf_of_psi_bilinear_matrix?)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Creates a wave function from all possible $\alpha \times \beta$ determinants
|
! Creates a wave function from all possible $\alpha \times \beta$ determinants
|
||||||
@ -856,6 +984,11 @@ end
|
|||||||
|
|
||||||
|
|
||||||
subroutine copy_psi_bilinear_to_psi(psi, isize)
|
subroutine copy_psi_bilinear_to_psi(psi, isize)
|
||||||
|
!todo: modify for complex (not called anywhere?)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Overwrites :c:data:`psi_det` and :c:data:`psi_coef` with the wave function
|
! Overwrites :c:data:`psi_det` and :c:data:`psi_coef` with the wave function
|
||||||
@ -1292,6 +1425,11 @@ END_TEMPLATE
|
|||||||
|
|
||||||
|
|
||||||
subroutine wf_of_psi_bilinear_matrix(truncate)
|
subroutine wf_of_psi_bilinear_matrix(truncate)
|
||||||
|
!todo: modify for complex (not called anywhere?)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here,' not implemented for complex'
|
||||||
|
stop -1
|
||||||
|
endif
|
||||||
use bitmasks
|
use bitmasks
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
|
@ -20,6 +20,28 @@ BEGIN_PROVIDER [ double precision, H_matrix_all_dets,(N_det,N_det) ]
|
|||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, h_matrix_all_dets_complex,(N_det,N_det) ]
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |H| matrix on the basis of the Slater determinants defined by psi_det
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k
|
||||||
|
complex*16 :: hij
|
||||||
|
integer :: degree(N_det),idx(0:N_det)
|
||||||
|
call i_h_j_complex(psi_det(1,1,1),psi_det(1,1,1),N_int,hij)
|
||||||
|
!$OMP PARALLEL DO SCHEDULE(GUIDED) DEFAULT(NONE) PRIVATE(i,j,hij,degree,idx,k) &
|
||||||
|
!$OMP SHARED (N_det, psi_det, N_int,h_matrix_all_dets_complex)
|
||||||
|
do i =1,N_det
|
||||||
|
do j = i, N_det
|
||||||
|
call i_h_j_complex(psi_det(1,1,i),psi_det(1,1,j),N_int,hij)
|
||||||
|
H_matrix_all_dets_complex(i,j) = hij
|
||||||
|
H_matrix_all_dets_complex(j,i) = dconjg(hij)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ]
|
BEGIN_PROVIDER [ double precision, S2_matrix_all_dets,(N_det,N_det) ]
|
||||||
use bitmasks
|
use bitmasks
|
||||||
|
@ -13,6 +13,7 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id)
|
|||||||
integer, external :: zmq_put_psi_det_size
|
integer, external :: zmq_put_psi_det_size
|
||||||
integer*8, external :: zmq_put_psi_det
|
integer*8, external :: zmq_put_psi_det
|
||||||
integer*8, external :: zmq_put_psi_coef
|
integer*8, external :: zmq_put_psi_coef
|
||||||
|
integer*8, external :: zmq_put_psi_coef_complex
|
||||||
|
|
||||||
zmq_put_psi = 0
|
zmq_put_psi = 0
|
||||||
if (zmq_put_N_states(zmq_to_qp_run_socket, worker_id) == -1) then
|
if (zmq_put_N_states(zmq_to_qp_run_socket, worker_id) == -1) then
|
||||||
@ -31,11 +32,17 @@ integer function zmq_put_psi(zmq_to_qp_run_socket,worker_id)
|
|||||||
zmq_put_psi = -1
|
zmq_put_psi = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
if (is_complex) then
|
||||||
|
if (zmq_put_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1) then
|
||||||
|
zmq_put_psi = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
else
|
||||||
if (zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id) == -1) then
|
if (zmq_put_psi_coef(zmq_to_qp_run_socket, worker_id) == -1) then
|
||||||
zmq_put_psi = -1
|
zmq_put_psi = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -54,6 +61,7 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
|
|||||||
integer, external :: zmq_get_psi_det_size
|
integer, external :: zmq_get_psi_det_size
|
||||||
integer*8, external :: zmq_get_psi_det
|
integer*8, external :: zmq_get_psi_det
|
||||||
integer*8, external :: zmq_get_psi_coef
|
integer*8, external :: zmq_get_psi_coef
|
||||||
|
integer*8, external :: zmq_get_psi_coef_complex
|
||||||
|
|
||||||
zmq_get_psi_notouch = 0
|
zmq_get_psi_notouch = 0
|
||||||
|
|
||||||
@ -75,19 +83,34 @@ integer function zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
|
|||||||
allocate(psi_det(N_int,2,psi_det_size))
|
allocate(psi_det(N_int,2,psi_det_size))
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
if (size(psi_coef_complex,kind=8) /= psi_det_size*N_states) then
|
||||||
|
deallocate(psi_coef_complex)
|
||||||
|
allocate(psi_coef_complex(psi_det_size,N_states))
|
||||||
|
endif
|
||||||
|
else
|
||||||
if (size(psi_coef,kind=8) /= psi_det_size*N_states) then
|
if (size(psi_coef,kind=8) /= psi_det_size*N_states) then
|
||||||
deallocate(psi_coef)
|
deallocate(psi_coef)
|
||||||
allocate(psi_coef(psi_det_size,N_states))
|
allocate(psi_coef(psi_det_size,N_states))
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
if (zmq_get_psi_det(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
zmq_get_psi_notouch = -1
|
zmq_get_psi_notouch = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
if (zmq_get_psi_coef_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
|
zmq_get_psi_notouch = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
else
|
||||||
if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
if (zmq_get_psi_coef(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
zmq_get_psi_notouch = -1
|
zmq_get_psi_notouch = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -102,8 +125,11 @@ integer function zmq_get_psi(zmq_to_qp_run_socket, worker_id)
|
|||||||
integer, intent(in) :: worker_id
|
integer, intent(in) :: worker_id
|
||||||
integer, external :: zmq_get_psi_notouch
|
integer, external :: zmq_get_psi_notouch
|
||||||
zmq_get_psi = zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
|
zmq_get_psi = zmq_get_psi_notouch(zmq_to_qp_run_socket, worker_id)
|
||||||
|
if (is_complex) then
|
||||||
|
SOFT_TOUCH psi_det psi_coef_complex psi_det_size N_det N_states
|
||||||
|
else
|
||||||
SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states
|
SOFT_TOUCH psi_det psi_coef psi_det_size N_det N_states
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
@ -147,11 +173,19 @@ integer function zmq_put_psi_bilinear(zmq_to_qp_run_socket,worker_id)
|
|||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer*8, external :: zmq_put_psi_bilinear_matrix_values_complex
|
||||||
|
if (zmq_put_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1) then
|
||||||
|
zmq_put_psi_bilinear = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
else
|
||||||
integer*8, external :: zmq_put_psi_bilinear_matrix_values
|
integer*8, external :: zmq_put_psi_bilinear_matrix_values
|
||||||
if (zmq_put_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1) then
|
if (zmq_put_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1) then
|
||||||
zmq_put_psi_bilinear = -1
|
zmq_put_psi_bilinear = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
integer, external :: zmq_put_N_det_alpha_unique
|
integer, external :: zmq_put_N_det_alpha_unique
|
||||||
if (zmq_put_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
|
if (zmq_put_N_det_alpha_unique(zmq_to_qp_run_socket,worker_id) == -1) then
|
||||||
@ -197,10 +231,17 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
|
|||||||
|
|
||||||
zmq_get_psi_bilinear= 0
|
zmq_get_psi_bilinear= 0
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
if (size(psi_bilinear_matrix_values_complex,kind=8) /= N_det*N_states) then
|
||||||
|
deallocate(psi_bilinear_matrix_values_complex)
|
||||||
|
allocate(psi_bilinear_matrix_values_complex(N_det,N_states))
|
||||||
|
endif
|
||||||
|
else
|
||||||
if (size(psi_bilinear_matrix_values,kind=8) /= N_det*N_states) then
|
if (size(psi_bilinear_matrix_values,kind=8) /= N_det*N_states) then
|
||||||
deallocate(psi_bilinear_matrix_values)
|
deallocate(psi_bilinear_matrix_values)
|
||||||
allocate(psi_bilinear_matrix_values(N_det,N_states))
|
allocate(psi_bilinear_matrix_values(N_det,N_states))
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
if (size(psi_bilinear_matrix_rows,kind=8) /= N_det) then
|
if (size(psi_bilinear_matrix_rows,kind=8) /= N_det) then
|
||||||
deallocate(psi_bilinear_matrix_rows)
|
deallocate(psi_bilinear_matrix_rows)
|
||||||
@ -217,11 +258,19 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
|
|||||||
allocate(psi_bilinear_matrix_order(N_det))
|
allocate(psi_bilinear_matrix_order(N_det))
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer*8, external :: zmq_get_psi_bilinear_matrix_values_complex
|
||||||
|
if (zmq_get_psi_bilinear_matrix_values_complex(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
|
zmq_get_psi_bilinear = -1
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
else
|
||||||
integer*8, external :: zmq_get_psi_bilinear_matrix_values
|
integer*8, external :: zmq_get_psi_bilinear_matrix_values
|
||||||
if (zmq_get_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
if (zmq_get_psi_bilinear_matrix_values(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
zmq_get_psi_bilinear = -1
|
zmq_get_psi_bilinear = -1
|
||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
integer*8, external :: zmq_get_psi_bilinear_matrix_rows
|
integer*8, external :: zmq_get_psi_bilinear_matrix_rows
|
||||||
if (zmq_get_psi_bilinear_matrix_rows(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
if (zmq_get_psi_bilinear_matrix_rows(zmq_to_qp_run_socket, worker_id) == -1_8) then
|
||||||
@ -266,7 +315,11 @@ integer function zmq_get_psi_bilinear(zmq_to_qp_run_socket, worker_id)
|
|||||||
return
|
return
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
SOFT_TOUCH psi_bilinear_matrix_values_complex psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef_complex psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique
|
||||||
|
else
|
||||||
SOFT_TOUCH psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique
|
SOFT_TOUCH psi_bilinear_matrix_values psi_bilinear_matrix_rows psi_bilinear_matrix_columns psi_bilinear_matrix_order psi_det psi_coef psi_det_size N_det N_states psi_det_beta_unique psi_det_alpha_unique N_det_beta_unique N_det_alpha_unique
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -563,6 +616,69 @@ psi_bilinear_matrix_values ;;
|
|||||||
|
|
||||||
END_TEMPLATE
|
END_TEMPLATE
|
||||||
|
|
||||||
|
BEGIN_TEMPLATE
|
||||||
|
|
||||||
|
integer*8 function zmq_put_$X(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Put $X on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer*8 :: rc8
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
zmq_put_$X = 0
|
||||||
|
|
||||||
|
integer*8 :: zmq_put_cdmatrix
|
||||||
|
integer :: ni, nj
|
||||||
|
|
||||||
|
if (size($X,kind=8) <= 8388608_8) then
|
||||||
|
ni = size($X,kind=4)
|
||||||
|
nj = 1
|
||||||
|
else
|
||||||
|
ni = 8388608
|
||||||
|
nj = int(size($X,kind=8)/8388608_8,4) + 1
|
||||||
|
endif
|
||||||
|
rc8 = zmq_put_cdmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) )
|
||||||
|
zmq_put_$X = rc8
|
||||||
|
end
|
||||||
|
|
||||||
|
integer*8 function zmq_get_$X(zmq_to_qp_run_socket,worker_id)
|
||||||
|
use f77_zmq
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! get $X on the qp_run scheduler
|
||||||
|
END_DOC
|
||||||
|
integer(ZMQ_PTR), intent(in) :: zmq_to_qp_run_socket
|
||||||
|
integer, intent(in) :: worker_id
|
||||||
|
integer*8 :: rc8
|
||||||
|
character*(256) :: msg
|
||||||
|
|
||||||
|
zmq_get_$X = 0_8
|
||||||
|
|
||||||
|
integer*8 :: zmq_get_cdmatrix
|
||||||
|
integer :: ni, nj
|
||||||
|
|
||||||
|
if (size($X,kind=8) <= 8388608_8) then
|
||||||
|
ni = size($X,kind=4)
|
||||||
|
nj = 1
|
||||||
|
else
|
||||||
|
ni = 8388608
|
||||||
|
nj = int(size($X,kind=8)/8388608_8,4) + 1
|
||||||
|
endif
|
||||||
|
rc8 = zmq_get_cdmatrix(zmq_to_qp_run_socket, 1, '$X', $X, ni, nj, size($X,kind=8) )
|
||||||
|
zmq_get_$X = rc8
|
||||||
|
end
|
||||||
|
|
||||||
|
SUBST [ X ]
|
||||||
|
|
||||||
|
psi_coef_complex ;;
|
||||||
|
psi_bilinear_matrix_values_complex ;;
|
||||||
|
|
||||||
|
END_TEMPLATE
|
||||||
|
|
||||||
|
|
||||||
!---------------------------------------------------------------------------
|
!---------------------------------------------------------------------------
|
||||||
|
|
||||||
|
@ -37,7 +37,11 @@ program fci
|
|||||||
END_DOC
|
END_DOC
|
||||||
|
|
||||||
if (.not.is_zmq_slave) then
|
if (.not.is_zmq_slave) then
|
||||||
|
if (is_complex) then
|
||||||
|
PROVIDE psi_det psi_coef_complex mo_two_e_integrals_in_map
|
||||||
|
else
|
||||||
PROVIDE psi_det psi_coef mo_two_e_integrals_in_map
|
PROVIDE psi_det psi_coef mo_two_e_integrals_in_map
|
||||||
|
endif
|
||||||
|
|
||||||
if (do_pt2) then
|
if (do_pt2) then
|
||||||
call run_stochastic_cipsi
|
call run_stochastic_cipsi
|
||||||
|
@ -82,3 +82,39 @@ BEGIN_PROVIDER [ double precision, select_max, (size_select_max) ]
|
|||||||
select_max = huge(1.d0)
|
select_max = huge(1.d0)
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_generators_complex, (psi_det_size,N_states) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, psi_coef_sorted_gen_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! For Single reference wave functions, the generator is the
|
||||||
|
! Hartree-Fock determinant
|
||||||
|
END_DOC
|
||||||
|
integer :: i, k, l, m
|
||||||
|
logical :: good
|
||||||
|
integer, external :: number_of_holes,number_of_particles
|
||||||
|
integer, allocatable :: nongen(:)
|
||||||
|
integer :: inongen
|
||||||
|
|
||||||
|
allocate(nongen(N_det))
|
||||||
|
|
||||||
|
inongen = 0
|
||||||
|
m=0
|
||||||
|
do i=1,N_det
|
||||||
|
good = ( number_of_holes(psi_det_sorted(1,1,i)) ==0).and.(number_of_particles(psi_det_sorted(1,1,i))==0 )
|
||||||
|
if (good) then
|
||||||
|
m = m+1
|
||||||
|
psi_coef_generators_complex(m,:) = psi_coef_sorted_complex(i,:)
|
||||||
|
else
|
||||||
|
inongen += 1
|
||||||
|
nongen(inongen) = i
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
ASSERT (m == N_det_generators)
|
||||||
|
|
||||||
|
psi_coef_sorted_gen_complex(:N_det_generators, :) = psi_coef_generators_complex(:N_det_generators, :)
|
||||||
|
do i=1,inongen
|
||||||
|
psi_coef_sorted_gen_complex(N_det_generators+i, :) = psi_coef_sorted_complex(nongen(i),:)
|
||||||
|
end do
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -22,20 +22,35 @@ BEGIN_PROVIDER [ integer, N_det_generators ]
|
|||||||
call write_int(6,N_det_generators,'Number of generators')
|
call write_int(6,N_det_generators,'Number of generators')
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,psi_det_size) ]
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_generators, (N_int,2,psi_det_size) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_generators, (psi_det_size,N_states) ]
|
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! For Single reference wave functions, the generator is the
|
! For Single reference wave functions, the generator is the
|
||||||
! Hartree-Fock determinant
|
! Hartree-Fock determinant
|
||||||
END_DOC
|
END_DOC
|
||||||
psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted(1:N_int,1:2,1:N_det)
|
psi_det_generators(1:N_int,1:2,1:N_det) = psi_det_sorted(1:N_int,1:2,1:N_det)
|
||||||
psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted(1:N_det,1:N_states)
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, psi_coef_generators, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! For Single reference wave functions, the generator is the
|
||||||
|
! Hartree-Fock determinant
|
||||||
|
END_DOC
|
||||||
|
psi_coef_generators(1:N_det,1:N_states) = psi_coef_sorted(1:N_det,1:N_states)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_generators_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! For Single reference wave functions, the generator is the
|
||||||
|
! Hartree-Fock determinant
|
||||||
|
END_DOC
|
||||||
|
psi_coef_generators_complex(1:N_det,1:N_states) = psi_coef_sorted_complex(1:N_det,1:N_states)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_gen, (N_int,2,psi_det_size) ]
|
BEGIN_PROVIDER [ integer(bit_kind), psi_det_sorted_gen, (N_int,2,psi_det_size) ]
|
||||||
&BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ]
|
|
||||||
&BEGIN_PROVIDER [ integer, psi_det_sorted_gen_order, (psi_det_size) ]
|
&BEGIN_PROVIDER [ integer, psi_det_sorted_gen_order, (psi_det_size) ]
|
||||||
|
|
||||||
implicit none
|
implicit none
|
||||||
@ -44,10 +59,26 @@ END_PROVIDER
|
|||||||
! Hartree-Fock determinant
|
! Hartree-Fock determinant
|
||||||
END_DOC
|
END_DOC
|
||||||
psi_det_sorted_gen = psi_det_sorted
|
psi_det_sorted_gen = psi_det_sorted
|
||||||
psi_coef_sorted_gen = psi_coef_sorted
|
|
||||||
psi_det_sorted_gen_order = psi_det_sorted_order
|
psi_det_sorted_gen_order = psi_det_sorted_order
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, psi_coef_sorted_gen, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! For Single reference wave functions, the generator is the
|
||||||
|
! Hartree-Fock determinant
|
||||||
|
END_DOC
|
||||||
|
psi_coef_sorted_gen = psi_coef_sorted
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, psi_coef_sorted_gen_complex, (psi_det_size,N_states) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! For Single reference wave functions, the generator is the
|
||||||
|
! Hartree-Fock determinant
|
||||||
|
END_DOC
|
||||||
|
psi_coef_sorted_gen_complex = psi_coef_sorted_complex
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [integer, degree_max_generators]
|
BEGIN_PROVIDER [integer, degree_max_generators]
|
||||||
implicit none
|
implicit none
|
||||||
|
@ -11,24 +11,52 @@ BEGIN_PROVIDER [double precision, extra_e_contrib_density]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, HF_energy]
|
BEGIN_PROVIDER [ double precision, hf_energy]
|
||||||
&BEGIN_PROVIDER [ double precision, HF_two_electron_energy]
|
&BEGIN_PROVIDER [ double precision, hf_two_electron_energy]
|
||||||
&BEGIN_PROVIDER [ double precision, HF_one_electron_energy]
|
&BEGIN_PROVIDER [ double precision, hf_one_electron_energy]
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! Hartree-Fock energy containing the nuclear repulsion, and its one- and two-body components.
|
! Hartree-Fock energy containing the nuclear repulsion, and its one- and two-body components.
|
||||||
END_DOC
|
END_DOC
|
||||||
integer :: i,j
|
integer :: i,j,k
|
||||||
HF_energy = nuclear_repulsion
|
hf_energy = nuclear_repulsion
|
||||||
HF_two_electron_energy = 0.d0
|
hf_two_electron_energy = 0.d0
|
||||||
HF_one_electron_energy = 0.d0
|
hf_one_electron_energy = 0.d0
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16 :: hf_1e_tmp, hf_2e_tmp
|
||||||
|
hf_1e_tmp = (0.d0,0.d0)
|
||||||
|
hf_2e_tmp = (0.d0,0.d0)
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
hf_2e_tmp += 0.5d0 * ( ao_two_e_integral_alpha_kpts(i,j,k) * scf_density_matrix_ao_alpha_kpts(j,i,k) &
|
||||||
|
+ao_two_e_integral_beta_kpts(i,j,k) * scf_density_matrix_ao_beta_kpts(j,i,k) )
|
||||||
|
hf_1e_tmp += ao_one_e_integrals_kpts(i,j,k) * (scf_density_matrix_ao_alpha_kpts(j,i,k) &
|
||||||
|
+ scf_density_matrix_ao_beta_kpts (j,i,k) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
if (dabs(dimag(hf_2e_tmp)).gt.1.d-10) then
|
||||||
|
print*,'HF_2e energy should be real:',irp_here
|
||||||
|
stop -1
|
||||||
|
else
|
||||||
|
hf_two_electron_energy = dble(hf_2e_tmp)
|
||||||
|
endif
|
||||||
|
if (dabs(dimag(hf_1e_tmp)).gt.1.d-10) then
|
||||||
|
print*,'HF_1e energy should be real:',irp_here
|
||||||
|
stop -1
|
||||||
|
else
|
||||||
|
hf_one_electron_energy = dble(hf_1e_tmp)
|
||||||
|
endif
|
||||||
|
else
|
||||||
do j=1,ao_num
|
do j=1,ao_num
|
||||||
do i=1,ao_num
|
do i=1,ao_num
|
||||||
HF_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * SCF_density_matrix_ao_alpha(i,j) &
|
hf_two_electron_energy += 0.5d0 * ( ao_two_e_integral_alpha(i,j) * scf_density_matrix_ao_alpha(i,j) &
|
||||||
+ao_two_e_integral_beta(i,j) * SCF_density_matrix_ao_beta(i,j) )
|
+ao_two_e_integral_beta(i,j) * scf_density_matrix_ao_beta(i,j) )
|
||||||
HF_one_electron_energy += ao_one_e_integrals(i,j) * (SCF_density_matrix_ao_alpha(i,j) + SCF_density_matrix_ao_beta (i,j) )
|
hf_one_electron_energy += ao_one_e_integrals(i,j) * (scf_density_matrix_ao_alpha(i,j) + scf_density_matrix_ao_beta (i,j) )
|
||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
HF_energy += HF_two_electron_energy + HF_one_electron_energy
|
endif
|
||||||
|
hf_energy += hf_two_electron_energy + hf_one_electron_energy
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
19
src/hartree_fock/print_e_scf.irp.f
Normal file
19
src/hartree_fock/print_e_scf.irp.f
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
program print_e_scf
|
||||||
|
call run
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine run
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call print_debug_scf_complex
|
||||||
|
|
||||||
|
print*,'hf 1e,2e,total energy'
|
||||||
|
print*,hf_one_electron_energy
|
||||||
|
print*,hf_two_electron_energy
|
||||||
|
print*,hf_energy
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
@ -45,9 +45,27 @@ subroutine create_guess
|
|||||||
END_DOC
|
END_DOC
|
||||||
logical :: exists
|
logical :: exists
|
||||||
PROVIDE ezfio_filename
|
PROVIDE ezfio_filename
|
||||||
|
if (is_complex) then
|
||||||
|
! call ezfio_has_mo_basis_mo_coef_complex(exists)
|
||||||
|
call ezfio_has_mo_basis_mo_coef_kpts(exists)
|
||||||
|
else
|
||||||
call ezfio_has_mo_basis_mo_coef(exists)
|
call ezfio_has_mo_basis_mo_coef(exists)
|
||||||
|
endif
|
||||||
if (.not.exists) then
|
if (.not.exists) then
|
||||||
if (mo_guess_type == "HCore") then
|
if (mo_guess_type == "HCore") then
|
||||||
|
if (is_complex) then
|
||||||
|
!mo_coef_complex = ao_ortho_lowdin_coef_complex
|
||||||
|
mo_coef_kpts = ao_ortho_lowdin_coef_kpts
|
||||||
|
TOUCH mo_coef_kpts
|
||||||
|
mo_label = 'Guess'
|
||||||
|
!call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_kpts, &
|
||||||
|
call mo_as_eigvectors_of_mo_matrix_kpts(mo_one_e_integrals_kpts, &
|
||||||
|
size(mo_one_e_integrals_kpts,1), &
|
||||||
|
size(mo_one_e_integrals_kpts,2), &
|
||||||
|
size(mo_one_e_integrals_kpts,3), &
|
||||||
|
mo_label,1,.false.)
|
||||||
|
SOFT_TOUCH mo_coef_kpts mo_label
|
||||||
|
else
|
||||||
mo_coef = ao_ortho_lowdin_coef
|
mo_coef = ao_ortho_lowdin_coef
|
||||||
TOUCH mo_coef
|
TOUCH mo_coef
|
||||||
mo_label = 'Guess'
|
mo_label = 'Guess'
|
||||||
@ -56,8 +74,14 @@ subroutine create_guess
|
|||||||
size(mo_one_e_integrals,2), &
|
size(mo_one_e_integrals,2), &
|
||||||
mo_label,1,.false.)
|
mo_label,1,.false.)
|
||||||
SOFT_TOUCH mo_coef mo_label
|
SOFT_TOUCH mo_coef mo_label
|
||||||
|
endif
|
||||||
else if (mo_guess_type == "Huckel") then
|
else if (mo_guess_type == "Huckel") then
|
||||||
|
if (is_complex) then
|
||||||
|
!call huckel_guess_complex
|
||||||
|
call huckel_guess_kpts
|
||||||
|
else
|
||||||
call huckel_guess
|
call huckel_guess
|
||||||
|
endif
|
||||||
else
|
else
|
||||||
print *, 'Unrecognized MO guess type : '//mo_guess_type
|
print *, 'Unrecognized MO guess type : '//mo_guess_type
|
||||||
stop 1
|
stop 1
|
||||||
@ -77,9 +101,17 @@ subroutine run
|
|||||||
integer :: i_it, i, j, k
|
integer :: i_it, i, j, k
|
||||||
|
|
||||||
mo_label = "Orthonormalized"
|
mo_label = "Orthonormalized"
|
||||||
|
if (is_complex) then
|
||||||
call Roothaan_Hall_SCF
|
!call roothaan_hall_scf_complex
|
||||||
|
call roothaan_hall_scf_kpts
|
||||||
|
else
|
||||||
|
call roothaan_hall_scf
|
||||||
|
endif
|
||||||
call ezfio_set_hartree_fock_energy(SCF_energy)
|
call ezfio_set_hartree_fock_energy(SCF_energy)
|
||||||
|
print*,'hf 1e,2e,total energy'
|
||||||
|
print*,hf_one_electron_energy
|
||||||
|
print*,hf_two_electron_energy
|
||||||
|
print*,hf_energy
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -102,3 +102,15 @@ subroutine print_summary(e_,pt2_,error_,variance_,norm_,n_det_,n_occ_pattern_,n_
|
|||||||
|
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
subroutine print_debug_fci
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
do i=1,n_det
|
||||||
|
print'(2((F25.15),2X))',psi_coef_complex(i,1)
|
||||||
|
call debug_det(psi_det(1,1,i),n_int)
|
||||||
|
enddo
|
||||||
|
print*,'hamiltonian'
|
||||||
|
do i=1,n_det
|
||||||
|
print '(1000(F25.15))',h_matrix_all_dets_complex(i,:)
|
||||||
|
enddo
|
||||||
|
end subroutine
|
||||||
|
@ -9,6 +9,18 @@ doc: Coefficient of the i-th |AO| on the j-th |MO|
|
|||||||
interface: ezfio
|
interface: ezfio
|
||||||
size: (ao_basis.ao_num,mo_basis.mo_num)
|
size: (ao_basis.ao_num,mo_basis.mo_num)
|
||||||
|
|
||||||
|
[mo_coef_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex MO coefficient of the i-th |AO| on the j-th |MO|
|
||||||
|
interface: ezfio
|
||||||
|
size: (2,ao_basis.ao_num,mo_basis.mo_num)
|
||||||
|
|
||||||
|
[mo_coef_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex MO coefficient of the i-th |AO| on the j-th |MO|
|
||||||
|
interface: ezfio
|
||||||
|
size: (2,ao_basis.ao_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
|
||||||
[mo_label]
|
[mo_label]
|
||||||
type: character*(64)
|
type: character*(64)
|
||||||
doc: Label characterizing the MOS (Local, Canonical, Natural, *etc*)
|
doc: Label characterizing the MOS (Local, Canonical, Natural, *etc*)
|
||||||
@ -20,6 +32,12 @@ doc: |MO| occupation numbers
|
|||||||
interface: ezfio
|
interface: ezfio
|
||||||
size: (mo_basis.mo_num)
|
size: (mo_basis.mo_num)
|
||||||
|
|
||||||
|
[mo_occ_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: |MO| occupation numbers
|
||||||
|
interface: ezfio
|
||||||
|
size: (mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
|
||||||
[mo_class]
|
[mo_class]
|
||||||
type: MO_class
|
type: MO_class
|
||||||
doc: [ Core | Inactive | Active | Virtual | Deleted ], as defined by :ref:`qp_set_mo_class`
|
doc: [ Core | Inactive | Active | Virtual | Deleted ], as defined by :ref:`qp_set_mo_class`
|
||||||
@ -31,3 +49,9 @@ type: character*(32)
|
|||||||
doc: MD5 checksum characterizing the |AO| basis set.
|
doc: MD5 checksum characterizing the |AO| basis set.
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_num_per_kpt]
|
||||||
|
type: integer
|
||||||
|
doc: Number of |MOs| per kpt
|
||||||
|
default: =(mo_basis.mo_num/nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
@ -1,3 +1,3 @@
|
|||||||
ao_basis
|
ao_basis
|
||||||
ao_one_e_ints
|
|
||||||
electrons
|
electrons
|
||||||
|
ao_one_e_ints
|
||||||
|
@ -101,7 +101,7 @@ BEGIN_PROVIDER [ double precision, mo_coef_in_ao_ortho_basis, (ao_num, mo_num) ]
|
|||||||
! $C^{-1}.C_{mo}$
|
! $C^{-1}.C_{mo}$
|
||||||
END_DOC
|
END_DOC
|
||||||
call dgemm('N','N',ao_num,mo_num,ao_num,1.d0, &
|
call dgemm('N','N',ao_num,mo_num,ao_num,1.d0, &
|
||||||
ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1),&
|
ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1),&
|
||||||
mo_coef, size(mo_coef,1), 0.d0, &
|
mo_coef, size(mo_coef,1), 0.d0, &
|
||||||
mo_coef_in_ao_ortho_basis, size(mo_coef_in_ao_ortho_basis,1))
|
mo_coef_in_ao_ortho_basis, size(mo_coef_in_ao_ortho_basis,1))
|
||||||
|
|
||||||
@ -242,28 +242,43 @@ subroutine mix_mo_jk(j,k)
|
|||||||
! by convention, the '+' |MO| is in the lowest index (min(j,k))
|
! by convention, the '+' |MO| is in the lowest index (min(j,k))
|
||||||
! by convention, the '-' |MO| is in the highest index (max(j,k))
|
! by convention, the '-' |MO| is in the highest index (max(j,k))
|
||||||
END_DOC
|
END_DOC
|
||||||
double precision :: array_tmp(ao_num,2),dsqrt_2
|
|
||||||
if(j==k)then
|
if(j==k)then
|
||||||
print*,'You want to mix two orbitals that are the same !'
|
print*,'You want to mix two orbitals that are the same !'
|
||||||
print*,'It does not make sense ... '
|
print*,'It does not make sense ... '
|
||||||
print*,'Stopping ...'
|
print*,'Stopping ...'
|
||||||
stop
|
stop
|
||||||
endif
|
endif
|
||||||
array_tmp = 0.d0
|
double precision :: dsqrt_2
|
||||||
dsqrt_2 = 1.d0/dsqrt(2.d0)
|
dsqrt_2 = 1.d0/dsqrt(2.d0)
|
||||||
|
i_plus = min(j,k)
|
||||||
|
i_minus = max(j,k)
|
||||||
|
if (is_complex) then
|
||||||
|
complex*16 :: array_tmp_c(ao_num,2)
|
||||||
|
array_tmp_c = (0.d0,0.d0)
|
||||||
|
do i = 1, ao_num
|
||||||
|
array_tmp_c(i,1) = dsqrt_2 * (mo_coef_complex(i,j) + mo_coef_complex(i,k))
|
||||||
|
array_tmp_c(i,2) = dsqrt_2 * (mo_coef_complex(i,j) - mo_coef_complex(i,k))
|
||||||
|
enddo
|
||||||
|
do i = 1, ao_num
|
||||||
|
mo_coef_complex(i,i_plus) = array_tmp_c(i,1)
|
||||||
|
mo_coef_complex(i,i_minus) = array_tmp_c(i,2)
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
double precision :: array_tmp(ao_num,2)
|
||||||
|
array_tmp = 0.d0
|
||||||
do i = 1, ao_num
|
do i = 1, ao_num
|
||||||
array_tmp(i,1) = dsqrt_2 * (mo_coef(i,j) + mo_coef(i,k))
|
array_tmp(i,1) = dsqrt_2 * (mo_coef(i,j) + mo_coef(i,k))
|
||||||
array_tmp(i,2) = dsqrt_2 * (mo_coef(i,j) - mo_coef(i,k))
|
array_tmp(i,2) = dsqrt_2 * (mo_coef(i,j) - mo_coef(i,k))
|
||||||
enddo
|
enddo
|
||||||
i_plus = min(j,k)
|
|
||||||
i_minus = max(j,k)
|
|
||||||
do i = 1, ao_num
|
do i = 1, ao_num
|
||||||
mo_coef(i,i_plus) = array_tmp(i,1)
|
mo_coef(i,i_plus) = array_tmp(i,1)
|
||||||
mo_coef(i,i_minus) = array_tmp(i,2)
|
mo_coef(i,i_minus) = array_tmp(i,2)
|
||||||
enddo
|
enddo
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA)
|
subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA)
|
||||||
implicit none
|
implicit none
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
@ -280,13 +295,13 @@ subroutine ao_ortho_cano_to_ao(A_ao,LDA_ao,A,LDA)
|
|||||||
|
|
||||||
call dgemm('T','N', ao_num, ao_num, ao_num, &
|
call dgemm('T','N', ao_num, ao_num, ao_num, &
|
||||||
1.d0, &
|
1.d0, &
|
||||||
ao_ortho_canonical_coef_inv, size(ao_ortho_canonical_coef_inv,1),&
|
ao_ortho_cano_coef_inv, size(ao_ortho_cano_coef_inv,1),&
|
||||||
A_ao,size(A_ao,1), &
|
A_ao,size(A_ao,1), &
|
||||||
0.d0, T, size(T,1))
|
0.d0, T, size(T,1))
|
||||||
|
|
||||||
call dgemm('N','N', ao_num, ao_num, ao_num, 1.d0, &
|
call dgemm('N','N', ao_num, ao_num, ao_num, 1.d0, &
|
||||||
T, size(T,1), &
|
T, size(T,1), &
|
||||||
ao_ortho_canonical_coef_inv,size(ao_ortho_canonical_coef_inv,1),&
|
ao_ortho_cano_coef_inv,size(ao_ortho_cano_coef_inv,1),&
|
||||||
0.d0, A, size(A,1))
|
0.d0, A, size(A,1))
|
||||||
|
|
||||||
deallocate(T)
|
deallocate(T)
|
||||||
|
481
src/mo_basis/mos_cplx.irp.f
Normal file
481
src/mo_basis/mos_cplx.irp.f
Normal file
@ -0,0 +1,481 @@
|
|||||||
|
BEGIN_PROVIDER [ integer, mo_num_per_kpt ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! number of mos per kpt.
|
||||||
|
END_DOC
|
||||||
|
mo_num_per_kpt = mo_num/kpt_num
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_complex, (ao_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Molecular orbital coefficients on |AO| basis set
|
||||||
|
!
|
||||||
|
! mo_coef_imag(i,j) = coefficient of the i-th |AO| on the jth |MO|
|
||||||
|
!
|
||||||
|
! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc)
|
||||||
|
END_DOC
|
||||||
|
integer :: i, j
|
||||||
|
logical :: exists
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
! Coefs
|
||||||
|
call ezfio_has_mo_basis_mo_coef_complex(exists)
|
||||||
|
endif
|
||||||
|
IRP_IF MPI_DEBUG
|
||||||
|
print *, irp_here, mpi_rank
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read mo_coef_complex with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
if (exists) then
|
||||||
|
if (mpi_master) then
|
||||||
|
call ezfio_get_mo_basis_mo_coef_complex(mo_coef_complex)
|
||||||
|
write(*,*) 'Read mo_coef_complex'
|
||||||
|
endif
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BCAST( mo_coef_complex, mo_num*ao_num, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read mo_coef_complex with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
else
|
||||||
|
! Orthonormalized AO basis
|
||||||
|
do i=1,mo_num
|
||||||
|
do j=1,ao_num
|
||||||
|
mo_coef_complex(j,i) = ao_ortho_canonical_coef_complex(j,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_complex, (ao_num, mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |MO| coefficients in orthogonalized |AO| basis
|
||||||
|
!
|
||||||
|
! $C^{-1}.C_{mo}$
|
||||||
|
END_DOC
|
||||||
|
call zgemm('N','N',ao_num,mo_num,ao_num,(1.d0,0.d0), &
|
||||||
|
ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1),&
|
||||||
|
mo_coef_complex, size(mo_coef_complex,1), (0.d0,0.d0), &
|
||||||
|
mo_coef_in_ao_ortho_basis_complex, size(mo_coef_in_ao_ortho_basis_complex,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_complex_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! nonzero blocks of |MO| coefficients
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k, mo_shft, ao_shft
|
||||||
|
mo_coef_complex_kpts = (0.d0,0.d0)
|
||||||
|
|
||||||
|
! do k=1,kpt_num
|
||||||
|
! mo_shft = (k-1)*mo_num_per_kpt
|
||||||
|
! ao_shft = (k-1)*ao_num_per_kpt
|
||||||
|
! do i=1,mo_num_per_kpt
|
||||||
|
! do j=1,ao_num_per_kpt
|
||||||
|
! mo_coef_complex_kpts(j,i,k) = mo_coef_complex(j+ao_shft,i+mo_shft)
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
! enddo
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
mo_coef_complex_kpts(j,i,k) = mo_coef_kpts(j,i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex, (mo_num,ao_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, mo_coef_transp_complex_conjg, (mo_num,ao_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |MO| coefficients on |AO| basis set
|
||||||
|
END_DOC
|
||||||
|
integer :: i, j
|
||||||
|
|
||||||
|
do j=1,ao_num
|
||||||
|
do i=1,mo_num
|
||||||
|
mo_coef_transp_complex(i,j) = mo_coef_complex(j,i)
|
||||||
|
mo_coef_transp_complex_conjg(i,j) = dconjg(mo_coef_complex(j,i))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine ao_to_mo_complex(A_ao,LDA_ao,A_mo,LDA_mo)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO basis to the MO basis
|
||||||
|
! where A is complex in the AO basis
|
||||||
|
!
|
||||||
|
! C^\dagger.A_ao.C
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,ao_num)
|
||||||
|
complex*16, intent(out) :: A_mo(LDA_mo,mo_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num,mo_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, mo_num, ao_num, &
|
||||||
|
(1.d0,0.d0), A_ao,LDA_ao, &
|
||||||
|
mo_coef_complex, size(mo_coef_complex,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('C','N', mo_num, mo_num, ao_num, &
|
||||||
|
(1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), &
|
||||||
|
T, ao_num, &
|
||||||
|
(0.d0,0.d0), A_mo, size(A_mo,1))
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine ao_to_mo_noconjg_complex(A_ao,LDA_ao,A_mo,LDA_mo)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO basis to the MO basis
|
||||||
|
! where A is complex in the AO basis
|
||||||
|
!
|
||||||
|
! C^T.A_ao.C
|
||||||
|
! needed for 4idx tranform in four_idx_novvvv
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,ao_num)
|
||||||
|
complex*16, intent(out) :: A_mo(LDA_mo,mo_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num,mo_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, mo_num, ao_num, &
|
||||||
|
(1.d0,0.d0), A_ao,LDA_ao, &
|
||||||
|
mo_coef_complex, size(mo_coef_complex,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('T','N', mo_num, mo_num, ao_num, &
|
||||||
|
(1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), &
|
||||||
|
T, ao_num, &
|
||||||
|
(0.d0,0.d0), A_mo, size(A_mo,1))
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_ortho_cano_to_ao_cplx(A_ao,LDA_ao,A,LDA)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the |AO| basis to the orthogonal |AO| basis
|
||||||
|
!
|
||||||
|
! $C^{-1}.A_{ao}.C^{\dagger-1}$
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,*)
|
||||||
|
complex*16, intent(out) :: A(LDA,*)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num,ao_num) )
|
||||||
|
|
||||||
|
call zgemm('C','N', ao_num, ao_num, ao_num, &
|
||||||
|
(1.d0,0.d0), &
|
||||||
|
ao_ortho_cano_coef_inv_cplx, size(ao_ortho_cano_coef_inv_cplx,1),&
|
||||||
|
A_ao,size(A_ao,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, ao_num, ao_num, (1.d0,0.d0), &
|
||||||
|
T, size(T,1), &
|
||||||
|
ao_ortho_cano_coef_inv_cplx,size(ao_ortho_cano_coef_inv_cplx,1),&
|
||||||
|
(0.d0,0.d0), A, size(A,1))
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Molecular orbital coefficients on |AO| basis set
|
||||||
|
!
|
||||||
|
! mo_coef_kpts(i,j,k) = coefficient of the i-th |AO| on the jth |MO| in kth kpt
|
||||||
|
!
|
||||||
|
! mo_label : Label characterizing the |MOs| (local, canonical, natural, etc)
|
||||||
|
END_DOC
|
||||||
|
integer :: i, j, k
|
||||||
|
logical :: exists
|
||||||
|
PROVIDE ezfio_filename
|
||||||
|
|
||||||
|
if (mpi_master) then
|
||||||
|
! Coefs
|
||||||
|
call ezfio_has_mo_basis_mo_coef_kpts(exists)
|
||||||
|
endif
|
||||||
|
IRP_IF MPI_DEBUG
|
||||||
|
print *, irp_here, mpi_rank
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read mo_coef_kpts with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
if (exists) then
|
||||||
|
if (mpi_master) then
|
||||||
|
call ezfio_get_mo_basis_mo_coef_kpts(mo_coef_kpts)
|
||||||
|
write(*,*) 'Read mo_coef_kpts'
|
||||||
|
endif
|
||||||
|
IRP_IF MPI
|
||||||
|
call MPI_BCAST( mo_coef_kpts, kpt_num*mo_num_per_kpt*ao_num_per_kpt, MPI_DOUBLE_COMPLEX, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read mo_coef_kpts with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
else
|
||||||
|
! Orthonormalized AO basis
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
mo_coef_kpts(j,i,k) = ao_ortho_canonical_coef_kpts(j,i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_in_ao_ortho_basis_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |MO| coefficients in orthogonalized |AO| basis
|
||||||
|
!
|
||||||
|
! $C^{-1}.C_{mo}$
|
||||||
|
END_DOC
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num_per_kpt,mo_num_per_kpt,ao_num_per_kpt,(1.d0,0.d0), &
|
||||||
|
ao_ortho_cano_coef_inv_kpts(:,:,k), size(ao_ortho_cano_coef_inv_kpts,1),&
|
||||||
|
mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), (0.d0,0.d0), &
|
||||||
|
mo_coef_in_ao_ortho_basis_kpts(:,:,k), size(mo_coef_in_ao_ortho_basis_kpts,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_coef_transp_kpts, (mo_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ complex*16, mo_coef_transp_kpts_conjg, (mo_num_per_kpt,ao_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |MO| coefficients on |AO| basis set
|
||||||
|
END_DOC
|
||||||
|
integer :: i, j, k
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j=1,ao_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_coef_transp_kpts(i,j,k) = mo_coef_kpts(j,i,k)
|
||||||
|
mo_coef_transp_kpts_conjg(i,j,k) = dconjg(mo_coef_kpts(j,i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine ao_to_mo_kpts(A_ao,LDA_ao,A_mo,LDA_mo)
|
||||||
|
implicit none
|
||||||
|
!todo: check this
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO basis to the MO basis
|
||||||
|
! where A is complex in the AO basis
|
||||||
|
!
|
||||||
|
! C^\dagger.A_ao.C
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, intent(out) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num_per_kpt,mo_num_per_kpt) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
integer :: k
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), A_ao(:,:,k),LDA_ao, &
|
||||||
|
mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('C','N', mo_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), &
|
||||||
|
T, ao_num_per_kpt, &
|
||||||
|
(0.d0,0.d0), A_mo(:,:,k), size(A_mo,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine ao_to_mo_noconjg_kpts(A_ao,LDA_ao,A_mo,LDA_mo)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the AO basis to the MO basis
|
||||||
|
! where A is complex in the AO basis
|
||||||
|
!
|
||||||
|
! C^T.A_ao.C
|
||||||
|
! needed for 4idx tranform in four_idx_novvvv
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, intent(out) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num_per_kpt,mo_num_per_kpt) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), A_ao,LDA_ao, &
|
||||||
|
mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('T','N', mo_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), &
|
||||||
|
T, ao_num_per_kpt, &
|
||||||
|
(0.d0,0.d0), A_mo(:,:,k), size(A_mo,1))
|
||||||
|
enddo
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine ao_ortho_cano_to_ao_kpts(A_ao,LDA_ao,A,LDA)
|
||||||
|
implicit none
|
||||||
|
!todo: check this; no longer using assumed-size arrays
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the |AO| basis to the orthogonal |AO| basis
|
||||||
|
!
|
||||||
|
! $C^{-1}.A_{ao}.C^{\dagger-1}$
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA
|
||||||
|
complex*16, intent(in) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, intent(out) :: A(LDA,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(ao_num_per_kpt,ao_num_per_kpt) )
|
||||||
|
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('C','N', ao_num_per_kpt, ao_num_per_kpt, ao_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), &
|
||||||
|
ao_ortho_cano_coef_inv_kpts(:,:,k), size(ao_ortho_cano_coef_inv_kpts,1),&
|
||||||
|
A_ao(:,:,k),size(A_ao,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, ao_num_per_kpt, (1.d0,0.d0), &
|
||||||
|
T, size(T,1), &
|
||||||
|
ao_ortho_cano_coef_inv_kpts(:,:,k),size(ao_ortho_cano_coef_inv_kpts,1),&
|
||||||
|
(0.d0,0.d0), A(:,:,k), size(A,1))
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! elec kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ integer, elec_alpha_num_kpts, (kpt_num) ]
|
||||||
|
&BEGIN_PROVIDER [ integer, elec_beta_num_kpts, (kpt_num) ]
|
||||||
|
!todo: reorder? if not integer multiple, use some list of kpts to determine filling order
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer :: i,k,kpt
|
||||||
|
|
||||||
|
PROVIDE elec_alpha_num elec_beta_num
|
||||||
|
|
||||||
|
do k=1,kpt_num
|
||||||
|
elec_alpha_num_kpts(k) = 0
|
||||||
|
elec_beta_num_kpts(k) = 0
|
||||||
|
enddo
|
||||||
|
kpt=1
|
||||||
|
do i=1,elec_beta_num
|
||||||
|
elec_alpha_num_kpts(kpt) += 1
|
||||||
|
elec_beta_num_kpts(kpt) += 1
|
||||||
|
kpt += 1
|
||||||
|
if (kpt > kpt_num) then
|
||||||
|
kpt = 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
do i=elec_beta_num+1,elec_alpha_num
|
||||||
|
elec_alpha_num_kpts(kpt) += 1
|
||||||
|
kpt += 1
|
||||||
|
if (kpt > kpt_num) then
|
||||||
|
kpt = 1
|
||||||
|
endif
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_occ_kpts, (mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! |MO| occupation numbers
|
||||||
|
END_DOC
|
||||||
|
PROVIDE ezfio_filename elec_beta_num_kpts elec_alpha_num_kpts
|
||||||
|
if (mpi_master) then
|
||||||
|
logical :: exists
|
||||||
|
call ezfio_has_mo_basis_mo_occ_kpts(exists)
|
||||||
|
if (exists) then
|
||||||
|
call ezfio_get_mo_basis_mo_occ_kpts(mo_occ_kpts)
|
||||||
|
else
|
||||||
|
mo_occ_kpts = 0.d0
|
||||||
|
integer :: i,k
|
||||||
|
do k=1,kpt_num
|
||||||
|
do i=1,elec_beta_num_kpts(k)
|
||||||
|
mo_occ_kpts(i,k) = 2.d0
|
||||||
|
enddo
|
||||||
|
do i=elec_beta_num_kpts(k)+1,elec_alpha_num_kpts(k)
|
||||||
|
mo_occ_kpts(i,k) = 1.d0
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
write(*,*) 'Read mo_occ_kpts'
|
||||||
|
endif
|
||||||
|
IRP_IF MPI_DEBUG
|
||||||
|
print *, irp_here, mpi_rank
|
||||||
|
call MPI_BARRIER(MPI_COMM_WORLD, ierr)
|
||||||
|
IRP_ENDIF
|
||||||
|
IRP_IF MPI
|
||||||
|
include 'mpif.h'
|
||||||
|
integer :: ierr
|
||||||
|
call MPI_BCAST( mo_occ_kpts, mo_num_per_kpt*kpt_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
|
||||||
|
if (ierr /= MPI_SUCCESS) then
|
||||||
|
stop 'Unable to read mo_occ_kpts with MPI'
|
||||||
|
endif
|
||||||
|
IRP_ENDIF
|
||||||
|
|
||||||
|
END_PROVIDER
|
@ -1,62 +0,0 @@
|
|||||||
BEGIN_PROVIDER [ double precision, mo_coef_begin_iteration, (ao_num,mo_num) ]
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! Void provider to store the coefficients of the |MO| basis at the beginning of the SCF iteration
|
|
||||||
!
|
|
||||||
! Usefull to track some orbitals
|
|
||||||
END_DOC
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
subroutine initialize_mo_coef_begin_iteration
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
!
|
|
||||||
! Initialize :c:data:`mo_coef_begin_iteration` to the current :c:data:`mo_coef`
|
|
||||||
END_DOC
|
|
||||||
mo_coef_begin_iteration = mo_coef
|
|
||||||
end
|
|
||||||
|
|
||||||
subroutine reorder_core_orb
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! routines that takes the current :c:data:`mo_coef` and reorder the core orbitals (see :c:data:`list_core` and :c:data:`n_core_orb`) according to the overlap with :c:data:`mo_coef_begin_iteration`
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,iorb
|
|
||||||
integer :: k,l
|
|
||||||
double precision, allocatable :: accu(:)
|
|
||||||
integer, allocatable :: index_core_orb(:),iorder(:)
|
|
||||||
double precision, allocatable :: mo_coef_tmp(:,:)
|
|
||||||
allocate(accu(mo_num),index_core_orb(n_core_orb),iorder(mo_num))
|
|
||||||
allocate(mo_coef_tmp(ao_num,mo_num))
|
|
||||||
|
|
||||||
do i = 1, n_core_orb
|
|
||||||
iorb = list_core(i)
|
|
||||||
do j = 1, mo_num
|
|
||||||
accu(j) = 0.d0
|
|
||||||
iorder(j) = j
|
|
||||||
do k = 1, ao_num
|
|
||||||
do l = 1, ao_num
|
|
||||||
accu(j) += mo_coef_begin_iteration(k,iorb) * mo_coef(l,j) * ao_overlap(k,l)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
accu(j) = -dabs(accu(j))
|
|
||||||
enddo
|
|
||||||
call dsort(accu,iorder,mo_num)
|
|
||||||
index_core_orb(i) = iorder(1)
|
|
||||||
enddo
|
|
||||||
|
|
||||||
double precision :: x
|
|
||||||
integer :: i1,i2
|
|
||||||
do j = 1, n_core_orb
|
|
||||||
i1 = list_core(j)
|
|
||||||
i2 = index_core_orb(j)
|
|
||||||
do i=1,ao_num
|
|
||||||
x = mo_coef(i,i1)
|
|
||||||
mo_coef(i,i1) = mo_coef(i,i2)
|
|
||||||
mo_coef(i,i2) = x
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!call loc_cele_routine
|
|
||||||
|
|
||||||
deallocate(accu,index_core_orb, iorder)
|
|
||||||
end
|
|
@ -1,12 +1,52 @@
|
|||||||
subroutine save_mos
|
subroutine save_mos
|
||||||
implicit none
|
implicit none
|
||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
integer :: i,j
|
complex*16, allocatable :: buffer_c(:,:),buffer_k(:,:,:)
|
||||||
|
integer :: i,j,k,ishft,jshft
|
||||||
|
!TODO: change this for periodic?
|
||||||
|
! save real/imag parts of mo_coef_complex
|
||||||
|
! otherwise need to make sure mo_coef and mo_coef_imag
|
||||||
|
! are updated whenever mo_coef_complex changes
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
call ezfio_set_mo_basis_mo_num(mo_num)
|
call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
call ezfio_set_mo_basis_mo_label(mo_label)
|
call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
|
if (is_complex) then
|
||||||
|
allocate ( buffer_c(ao_num,mo_num))
|
||||||
|
allocate ( buffer_k(ao_num_per_kpt,mo_num_per_kpt,kpt_num))
|
||||||
|
buffer_k = (0.d0,0.d0)
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j = 1, mo_num_per_kpt
|
||||||
|
do i = 1, ao_num_per_kpt
|
||||||
|
buffer_k(i,j,k) = mo_coef_kpts(i,j,k)
|
||||||
|
!print*,i,j,k,buffer_k(i,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
buffer_c = (0.d0,0.d0)
|
||||||
|
do k=1,kpt_num
|
||||||
|
ishft = (k-1)*ao_num_per_kpt
|
||||||
|
jshft = (k-1)*mo_num_per_kpt
|
||||||
|
do j=1,mo_num_per_kpt
|
||||||
|
do i=1,ao_num_per_kpt
|
||||||
|
buffer_c(i+ishft,j+jshft) = buffer_k(i,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_mo_basis_mo_coef_kpts(buffer_k)
|
||||||
|
call ezfio_set_mo_basis_mo_coef_complex(buffer_c)
|
||||||
|
|
||||||
|
deallocate (buffer_k,buffer_c)
|
||||||
|
mo_occ = 0.d0
|
||||||
|
do k=1,kpt_num
|
||||||
|
ishft=(k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_occ(i+ishft)=mo_occ_kpts(i,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_mo_basis_mo_occ_kpts(mo_occ_kpts)
|
||||||
|
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
||||||
|
else
|
||||||
allocate ( buffer(ao_num,mo_num) )
|
allocate ( buffer(ao_num,mo_num) )
|
||||||
buffer = 0.d0
|
buffer = 0.d0
|
||||||
do j = 1, mo_num
|
do j = 1, mo_num
|
||||||
@ -15,9 +55,10 @@ subroutine save_mos
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call ezfio_set_mo_basis_mo_coef(buffer)
|
call ezfio_set_mo_basis_mo_coef(buffer)
|
||||||
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
|
||||||
call ezfio_set_mo_basis_mo_class(mo_class)
|
|
||||||
deallocate (buffer)
|
deallocate (buffer)
|
||||||
|
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
||||||
|
endif
|
||||||
|
call ezfio_set_mo_basis_mo_class(mo_class)
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -25,12 +66,26 @@ end
|
|||||||
subroutine save_mos_no_occ
|
subroutine save_mos_no_occ
|
||||||
implicit none
|
implicit none
|
||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
|
complex*16, allocatable :: buffer_c(:,:)
|
||||||
integer :: i,j
|
integer :: i,j
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
!call ezfio_set_mo_basis_mo_num(mo_num)
|
!call ezfio_set_mo_basis_mo_num(mo_num)
|
||||||
!call ezfio_set_mo_basis_mo_label(mo_label)
|
!call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
!call ezfio_set_mo_basis_ao_md5(ao_md5)
|
!call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here, ' not implemented for kpts'
|
||||||
|
stop -1
|
||||||
|
allocate ( buffer_c(ao_num,mo_num))
|
||||||
|
buffer_c = (0.d0,0.d0)
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
buffer_c(i,j) = mo_coef_complex(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_mo_basis_mo_coef_complex(buffer_c)
|
||||||
|
deallocate (buffer_c)
|
||||||
|
else
|
||||||
allocate ( buffer(ao_num,mo_num) )
|
allocate ( buffer(ao_num,mo_num) )
|
||||||
buffer = 0.d0
|
buffer = 0.d0
|
||||||
do j = 1, mo_num
|
do j = 1, mo_num
|
||||||
@ -40,12 +95,14 @@ subroutine save_mos_no_occ
|
|||||||
enddo
|
enddo
|
||||||
call ezfio_set_mo_basis_mo_coef(buffer)
|
call ezfio_set_mo_basis_mo_coef(buffer)
|
||||||
deallocate (buffer)
|
deallocate (buffer)
|
||||||
|
endif
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
subroutine save_mos_truncated(n)
|
subroutine save_mos_truncated(n)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, allocatable :: buffer(:,:)
|
double precision, allocatable :: buffer(:,:)
|
||||||
|
complex*16, allocatable :: buffer_c(:,:)
|
||||||
integer :: i,j,n
|
integer :: i,j,n
|
||||||
|
|
||||||
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
call system('$QP_ROOT/scripts/save_current_mos.sh '//trim(ezfio_filename))
|
||||||
@ -53,6 +110,19 @@ subroutine save_mos_truncated(n)
|
|||||||
call ezfio_set_mo_basis_mo_num(n)
|
call ezfio_set_mo_basis_mo_num(n)
|
||||||
call ezfio_set_mo_basis_mo_label(mo_label)
|
call ezfio_set_mo_basis_mo_label(mo_label)
|
||||||
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
call ezfio_set_mo_basis_ao_md5(ao_md5)
|
||||||
|
if (is_complex) then
|
||||||
|
print*,irp_here, ' not implemented for kpts'
|
||||||
|
stop -1
|
||||||
|
allocate ( buffer_c(ao_num,mo_num))
|
||||||
|
buffer_c = (0.d0,0.d0)
|
||||||
|
do j = 1, n
|
||||||
|
do i = 1, ao_num
|
||||||
|
buffer_c(i,j) = mo_coef_complex(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call ezfio_set_mo_basis_mo_coef_complex(buffer_c)
|
||||||
|
deallocate (buffer_c)
|
||||||
|
else
|
||||||
allocate ( buffer(ao_num,n) )
|
allocate ( buffer(ao_num,n) )
|
||||||
buffer = 0.d0
|
buffer = 0.d0
|
||||||
do j = 1, n
|
do j = 1, n
|
||||||
@ -61,9 +131,10 @@ subroutine save_mos_truncated(n)
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
call ezfio_set_mo_basis_mo_coef(buffer)
|
call ezfio_set_mo_basis_mo_coef(buffer)
|
||||||
|
deallocate (buffer)
|
||||||
|
endif
|
||||||
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
call ezfio_set_mo_basis_mo_occ(mo_occ)
|
||||||
call ezfio_set_mo_basis_mo_class(mo_class)
|
call ezfio_set_mo_basis_mo_class(mo_class)
|
||||||
deallocate (buffer)
|
|
||||||
|
|
||||||
end
|
end
|
||||||
|
|
||||||
|
531
src/mo_basis/utils_cplx.irp.f
Normal file
531
src/mo_basis/utils_cplx.irp.f
Normal file
@ -0,0 +1,531 @@
|
|||||||
|
subroutine mo_as_eigvectors_of_mo_matrix_complex(matrix,n,m,label,sign,output)
|
||||||
|
!TODO: test this
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: n,m, sign
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(n,m)
|
||||||
|
logical, intent(in) :: output
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision, allocatable :: eigvalues(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), R(:,:), A(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
allocate(A(n,m),R(n,m),mo_coef_new(ao_num,m),eigvalues(m))
|
||||||
|
if (sign == -1) then
|
||||||
|
do j=1,m
|
||||||
|
do i=1,n
|
||||||
|
A(i,j) = -matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do j=1,m
|
||||||
|
do i=1,n
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
mo_coef_new = mo_coef_complex
|
||||||
|
|
||||||
|
call lapack_diag_complex(eigvalues,R,A,n,m)
|
||||||
|
if (output) then
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================'
|
||||||
|
endif
|
||||||
|
if (sign == -1) then
|
||||||
|
do i=1,m
|
||||||
|
eigvalues(i) = -eigvalues(i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if (output) then
|
||||||
|
do i=1,m
|
||||||
|
write (6,'(I8,1X,F16.10)') i,eigvalues(i)
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
!write (6,'(A)') 'Fock Matrix'
|
||||||
|
!write (6,'(A)') '-----------'
|
||||||
|
!do i=1,n
|
||||||
|
! write(*,'(200(E24.15))') A(i,:)
|
||||||
|
!enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1))
|
||||||
|
deallocate(A,mo_coef_new,R,eigvalues)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine mo_as_svd_vectors_of_mo_matrix_complex(matrix,lda,m,n,label)
|
||||||
|
!TODO: test this
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(lda,n)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_new = mo_coef_complex
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1))
|
||||||
|
deallocate(A,mo_coef_new,U,Vt,D)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine mo_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,eig,label)
|
||||||
|
!TODO: test this
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(lda,n)
|
||||||
|
double precision, intent(out) :: eig(m)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:), work(:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_new = mo_coef_complex
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1))
|
||||||
|
|
||||||
|
do i=1,m
|
||||||
|
eig(i) = D(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(A,mo_coef_new,U,Vt,D)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine mo_coef_new_as_svd_vectors_of_mo_matrix_eig_complex(matrix,lda,m,n,mo_coef_before,eig,mo_coef_new)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! You enter with matrix in the MO basis defined with the mo_coef_before.
|
||||||
|
!
|
||||||
|
! You SVD the matrix and set the eigenvectors as mo_coef_new ordered by increasing singular values
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
complex*16, intent(in) :: matrix(lda,n),mo_coef_before(ao_num,m)
|
||||||
|
double precision, intent(out) :: eig(m)
|
||||||
|
complex*16, intent(out) :: mo_coef_new(ao_num,m)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_tmp(:,:), U(:,:), A(:,:), Vt(:,:), work(:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_tmp = mo_coef_before
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_new,size(mo_coef_new,1))
|
||||||
|
|
||||||
|
do i=1,m
|
||||||
|
eig(i) = D(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(A,U,Vt,D,mo_coef_tmp)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
subroutine mo_as_eigvectors_of_mo_matrix_kpts(matrix,n,m,nk,label,sign,output)
|
||||||
|
!TODO: test this
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: n,m,nk, sign
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(n,m,nk)
|
||||||
|
logical, intent(in) :: output
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision, allocatable :: eigvalues(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), R(:,:), A(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, R
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num_per_kpt) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num_per_kpt'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
if (nk /= kpt_num) then
|
||||||
|
print *, irp_here, ': Error : nk/= kpt_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
allocate(A(n,m),R(n,m),mo_coef_new(ao_num_per_kpt,m),eigvalues(m))
|
||||||
|
do k=1,nk
|
||||||
|
if (sign == -1) then
|
||||||
|
do j=1,m
|
||||||
|
do i=1,n
|
||||||
|
A(i,j) = -matrix(i,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
do j=1,m
|
||||||
|
do i=1,n
|
||||||
|
A(i,j) = matrix(i,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
mo_coef_new = mo_coef_kpts(:,:,k)
|
||||||
|
|
||||||
|
call lapack_diag_complex(eigvalues,R,A,n,m)
|
||||||
|
if (sign == -1) then
|
||||||
|
do i=1,m
|
||||||
|
eigvalues(i) = -eigvalues(i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
if (output) then
|
||||||
|
do i=1,m
|
||||||
|
write (6,'(2(I8),1X,F16.10)') k,i,eigvalues(i)
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
!write (6,'(A)') 'Fock Matrix'
|
||||||
|
!write (6,'(A)') '-----------'
|
||||||
|
!do i=1,n
|
||||||
|
! write(*,'(200(E24.15))') A(i,:)
|
||||||
|
!enddo
|
||||||
|
endif
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num_per_kpt,m,m,(1.d0,0.d0), &
|
||||||
|
mo_coef_new,size(mo_coef_new,1),R,size(R,1),(0.d0,0.d0), &
|
||||||
|
mo_coef_kpts(:,:,k),size(mo_coef_kpts,1))
|
||||||
|
enddo
|
||||||
|
deallocate(A,mo_coef_new,R,eigvalues)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
if (output) then
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================'
|
||||||
|
endif
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine mo_as_svd_vectors_of_mo_matrix_kpts(matrix,lda,m,n,label)
|
||||||
|
!TODO: implement
|
||||||
|
print *, irp_here, ' not implemented for kpts'
|
||||||
|
stop 1
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(lda,n)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num,m),D(m),Vt(lda,n))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_new = mo_coef_complex
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_complex,size(mo_coef_complex,1))
|
||||||
|
deallocate(A,mo_coef_new,U,Vt,D)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine mo_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,nk,eig,label)
|
||||||
|
!TODO: implement
|
||||||
|
!print *, irp_here, ' not implemented for kpts'
|
||||||
|
!stop 1
|
||||||
|
implicit none
|
||||||
|
integer,intent(in) :: lda,m,n,nk
|
||||||
|
character*(64), intent(in) :: label
|
||||||
|
complex*16, intent(in) :: matrix(lda,n,nk)
|
||||||
|
double precision, intent(out) :: eig(m,nk)
|
||||||
|
|
||||||
|
integer :: i,j,k
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_new(:,:), U(:,:), A(:,:), Vt(:,:), work(:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num_per_kpt) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num_per_kpt'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),mo_coef_new(ao_num_per_kpt,m),D(m),Vt(lda,n))
|
||||||
|
|
||||||
|
do k=1,nk
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_new(1:ao_num_per_kpt,1:m) = mo_coef_kpts(1:ao_num_per_kpt,1:m,k)
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num_per_kpt,m,m, &
|
||||||
|
(1.d0,0.d0),mo_coef_new,size(mo_coef_new,1),U,size(U,1),&
|
||||||
|
(0.d0,0.d0),mo_coef_kpts(1,1,k),size(mo_coef_kpts,1))
|
||||||
|
|
||||||
|
do i=1,m
|
||||||
|
eig(i,k) = D(i)
|
||||||
|
enddo
|
||||||
|
!do j=1,mo_num_per_kpt
|
||||||
|
! do i=1,mo_num_per_kpt
|
||||||
|
! print'(3(I5),2(E25.15))',i,j,k,mo_coef_kpts(i,j,k)
|
||||||
|
! enddo
|
||||||
|
!enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(A,mo_coef_new,U,Vt,D)
|
||||||
|
|
||||||
|
write (6,'(A)') 'MOs are now **'//trim(label)//'**'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues '
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
do k=1,nk
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + eig(i,k)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,eig(i,k), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '-------- ---------------- ----------------'
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
mo_label = label
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
|
||||||
|
subroutine mo_coef_new_as_svd_vectors_of_mo_matrix_eig_kpts(matrix,lda,m,n,mo_coef_before,eig,mo_coef_new)
|
||||||
|
!TODO: implement
|
||||||
|
print *, irp_here, ' not implemented for kpts'
|
||||||
|
stop 1
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! You enter with matrix in the MO basis defined with the mo_coef_before.
|
||||||
|
!
|
||||||
|
! You SVD the matrix and set the eigenvectors as mo_coef_new ordered by increasing singular values
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: lda,m,n
|
||||||
|
complex*16, intent(in) :: matrix(lda,n),mo_coef_before(ao_num,m)
|
||||||
|
double precision, intent(out) :: eig(m)
|
||||||
|
complex*16, intent(out) :: mo_coef_new(ao_num,m)
|
||||||
|
|
||||||
|
integer :: i,j
|
||||||
|
double precision :: accu
|
||||||
|
double precision, allocatable :: D(:)
|
||||||
|
complex*16, allocatable :: mo_coef_tmp(:,:), U(:,:), A(:,:), Vt(:,:), work(:)
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: U, Vt, A
|
||||||
|
|
||||||
|
call write_time(6)
|
||||||
|
if (m /= mo_num) then
|
||||||
|
print *, irp_here, ': Error : m/= mo_num'
|
||||||
|
stop 1
|
||||||
|
endif
|
||||||
|
|
||||||
|
allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num))
|
||||||
|
|
||||||
|
do j=1,n
|
||||||
|
do i=1,m
|
||||||
|
A(i,j) = matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
mo_coef_tmp = mo_coef_before
|
||||||
|
|
||||||
|
call svd_complex(A,lda,U,lda,D,Vt,lda,m,n)
|
||||||
|
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') 'Eigenvalues'
|
||||||
|
write (6,'(A)') '-----------'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ' MO Eigenvalue Cumulative '
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
|
||||||
|
accu = 0.d0
|
||||||
|
do i=1,m
|
||||||
|
accu = accu + D(i)
|
||||||
|
write (6,'(I8,1X,F16.10,1X,F16.10)') i,D(i), accu
|
||||||
|
enddo
|
||||||
|
write (6,'(A)') '======== ================ ================'
|
||||||
|
write (6,'(A)') ''
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num,m,m,(1.d0,0.d0),mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),(0.d0,0.d0),mo_coef_new,size(mo_coef_new,1))
|
||||||
|
|
||||||
|
do i=1,m
|
||||||
|
eig(i) = D(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate(A,U,Vt,D,mo_coef_tmp)
|
||||||
|
call write_time(6)
|
||||||
|
|
||||||
|
end
|
||||||
|
|
@ -5,9 +5,18 @@ subroutine hcore_guess
|
|||||||
implicit none
|
implicit none
|
||||||
character*(64) :: label
|
character*(64) :: label
|
||||||
label = "Guess"
|
label = "Guess"
|
||||||
|
if (is_complex) then
|
||||||
|
call mo_as_eigvectors_of_mo_matrix_complex(mo_one_e_integrals_complex, &
|
||||||
|
size(mo_one_e_integrals_complex,1), &
|
||||||
|
size(mo_one_e_integrals_complex,2),label,1,.false.)
|
||||||
|
call save_mos
|
||||||
|
SOFT_TOUCH mo_coef_complex mo_label
|
||||||
|
|
||||||
|
else
|
||||||
call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, &
|
call mo_as_eigvectors_of_mo_matrix(mo_one_e_integrals, &
|
||||||
size(mo_one_e_integrals,1), &
|
size(mo_one_e_integrals,1), &
|
||||||
size(mo_one_e_integrals,2),label,1,.false.)
|
size(mo_one_e_integrals,2),label,1,.false.)
|
||||||
call save_mos
|
call save_mos
|
||||||
SOFT_TOUCH mo_coef mo_label
|
SOFT_TOUCH mo_coef mo_label
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
109
src/mo_guess/mo_ortho_lowdin_cplx.irp.f
Normal file
109
src/mo_guess/mo_ortho_lowdin_cplx.irp.f
Normal file
@ -0,0 +1,109 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_complex, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! matrix of the coefficients of the mos generated by the
|
||||||
|
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
||||||
|
! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16, allocatable :: tmp_matrix(:,:)
|
||||||
|
allocate (tmp_matrix(ao_num,ao_num))
|
||||||
|
tmp_matrix(:,:) = (0.d0,0.d0)
|
||||||
|
do j=1, ao_num
|
||||||
|
tmp_matrix(j,j) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
call ortho_lowdin_complex(ao_overlap_complex,ao_num,ao_num,tmp_matrix,ao_num,ao_num)
|
||||||
|
do i=1, ao_num
|
||||||
|
do j=1, ao_num
|
||||||
|
ao_ortho_lowdin_coef_complex(j,i) = tmp_matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(tmp_matrix)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_complex, (ao_num,ao_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! overlap matrix of the ao_ortho_lowdin
|
||||||
|
! supposed to be the Identity
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16 :: c
|
||||||
|
do j=1, ao_num
|
||||||
|
do i=1, ao_num
|
||||||
|
ao_ortho_lowdin_overlap_complex(i,j) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do k=1, ao_num
|
||||||
|
do j=1, ao_num
|
||||||
|
c = (0.d0,0.d0)
|
||||||
|
do l=1, ao_num
|
||||||
|
c += dconjg(ao_ortho_lowdin_coef_complex(j,l)) * ao_overlap_complex(k,l)
|
||||||
|
enddo
|
||||||
|
do i=1, ao_num
|
||||||
|
ao_ortho_lowdin_overlap_complex(i,j) += ao_ortho_lowdin_coef_complex(i,k) * c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_coef_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! matrix of the coefficients of the mos generated by the
|
||||||
|
! orthonormalization by the S^{-1/2} canonical transformation of the aos
|
||||||
|
! ao_ortho_lowdin_coef(i,j) = coefficient of the ith ao on the jth ao_ortho_lowdin orbital
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
complex*16, allocatable :: tmp_matrix(:,:)
|
||||||
|
allocate (tmp_matrix(ao_num,ao_num))
|
||||||
|
do k=1,kpt_num
|
||||||
|
tmp_matrix(:,:) = (0.d0,0.d0)
|
||||||
|
do j=1, ao_num
|
||||||
|
tmp_matrix(j,j) = (1.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
call ortho_lowdin_complex(ao_overlap_kpts(:,:,k),ao_num_per_kpt,ao_num_per_kpt,tmp_matrix,ao_num_per_kpt,ao_num_per_kpt)
|
||||||
|
do i=1, ao_num_per_kpt
|
||||||
|
do j=1, ao_num_per_kpt
|
||||||
|
ao_ortho_lowdin_coef_kpts(j,i,k) = tmp_matrix(i,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(tmp_matrix)
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_overlap_kpts, (ao_num_per_kpt,ao_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! overlap matrix of the ao_ortho_lowdin
|
||||||
|
! supposed to be the Identity
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l,kk
|
||||||
|
complex*16 :: c
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do j=1, ao_num_per_kpt
|
||||||
|
do i=1, ao_num_per_kpt
|
||||||
|
ao_ortho_lowdin_overlap_kpts(i,j,kk) = (0.d0,0.d0)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do kk=1,kpt_num
|
||||||
|
do k=1, ao_num_per_kpt
|
||||||
|
do j=1, ao_num_per_kpt
|
||||||
|
c = (0.d0,0.d0)
|
||||||
|
do l=1, ao_num_per_kpt
|
||||||
|
c += dconjg(ao_ortho_lowdin_coef_kpts(j,l,kk)) * ao_overlap_kpts(k,l,kk)
|
||||||
|
enddo
|
||||||
|
do i=1, ao_num_per_kpt
|
||||||
|
ao_ortho_lowdin_overlap_kpts(i,j,kk) += ao_ortho_lowdin_coef_kpts(i,k,kk) * c
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
52
src/mo_guess/pot_mo_ortho_cano_ints.irp.f
Normal file
52
src/mo_guess/pot_mo_ortho_cano_ints.irp.f
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
BEGIN_PROVIDER [double precision, ao_ortho_cano_n_e_ints, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i1,j1,i,j
|
||||||
|
double precision :: c_i1,c_j1
|
||||||
|
|
||||||
|
ao_ortho_cano_n_e_ints = 0.d0
|
||||||
|
!$OMP PARALLEL DO DEFAULT(none) &
|
||||||
|
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
||||||
|
!$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef, &
|
||||||
|
!$OMP ao_ortho_cano_n_e_ints, ao_integrals_n_e)
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i1 = 1,ao_num
|
||||||
|
c_i1 = ao_ortho_canonical_coef(i1,i)
|
||||||
|
do j1 = 1,ao_num
|
||||||
|
c_j1 = c_i1*ao_ortho_canonical_coef(j1,j)
|
||||||
|
ao_ortho_cano_n_e_ints(j,i) = ao_ortho_cano_n_e_ints(j,i) + &
|
||||||
|
c_j1 * ao_integrals_n_e(j1,i1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_cano_n_e_ints_cplx, (mo_num,mo_num)]
|
||||||
|
!todo: kpts
|
||||||
|
implicit none
|
||||||
|
integer :: i1,j1,i,j
|
||||||
|
complex*16 :: c_i1,c_j1
|
||||||
|
|
||||||
|
ao_ortho_cano_n_e_ints_cplx = (0.d0,0.d0)
|
||||||
|
!$OMP PARALLEL DO DEFAULT(none) &
|
||||||
|
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
||||||
|
!$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef_complex, &
|
||||||
|
!$OMP ao_ortho_cano_n_e_ints_cplx, ao_integrals_n_e_complex)
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i1 = 1,ao_num
|
||||||
|
c_i1 = ao_ortho_canonical_coef_complex(i1,i)
|
||||||
|
do j1 = 1,ao_num
|
||||||
|
c_j1 = c_i1*dconjg(ao_ortho_canonical_coef_complex(j1,j))
|
||||||
|
ao_ortho_cano_n_e_ints_cplx(j,i) = &
|
||||||
|
ao_ortho_cano_n_e_ints_cplx(j,i) + &
|
||||||
|
c_j1 * ao_integrals_n_e_complex(j1,i1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -1,25 +0,0 @@
|
|||||||
BEGIN_PROVIDER [double precision, ao_ortho_canonical_nucl_elec_integrals, (mo_num,mo_num)]
|
|
||||||
implicit none
|
|
||||||
integer :: i1,j1,i,j
|
|
||||||
double precision :: c_i1,c_j1
|
|
||||||
|
|
||||||
ao_ortho_canonical_nucl_elec_integrals = 0.d0
|
|
||||||
!$OMP PARALLEL DO DEFAULT(none) &
|
|
||||||
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
|
||||||
!$OMP SHARED(mo_num,ao_num,ao_ortho_canonical_coef, &
|
|
||||||
!$OMP ao_ortho_canonical_nucl_elec_integrals, ao_integrals_n_e)
|
|
||||||
do i = 1, mo_num
|
|
||||||
do j = 1, mo_num
|
|
||||||
do i1 = 1,ao_num
|
|
||||||
c_i1 = ao_ortho_canonical_coef(i1,i)
|
|
||||||
do j1 = 1,ao_num
|
|
||||||
c_j1 = c_i1*ao_ortho_canonical_coef(j1,j)
|
|
||||||
ao_ortho_canonical_nucl_elec_integrals(j,i) = ao_ortho_canonical_nucl_elec_integrals(j,i) + &
|
|
||||||
c_j1 * ao_integrals_n_e(j1,i1)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
!$OMP END PARALLEL DO
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
@ -23,3 +23,29 @@ BEGIN_PROVIDER [double precision, ao_ortho_lowdin_nucl_elec_integrals, (mo_num,m
|
|||||||
!$OMP END PARALLEL DO
|
!$OMP END PARALLEL DO
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, ao_ortho_lowdin_n_e_ints_cplx, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i1,j1,i,j
|
||||||
|
complex*16 :: c_i1,c_j1
|
||||||
|
|
||||||
|
ao_ortho_lowdin_nucl_elec_integrals = (0.d0,0.d0)
|
||||||
|
!$OMP PARALLEL DO DEFAULT(none) &
|
||||||
|
!$OMP PRIVATE(i,j,i1,j1,c_j1,c_i1) &
|
||||||
|
!$OMP SHARED(mo_num,ao_num,ao_ortho_lowdin_coef_complex, &
|
||||||
|
!$OMP ao_ortho_lowdin_n_e_ints_cplx, ao_integrals_n_e_complex)
|
||||||
|
do i = 1, mo_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i1 = 1,ao_num
|
||||||
|
c_i1 = ao_ortho_lowdin_coef_complex(i1,i)
|
||||||
|
do j1 = 1,ao_num
|
||||||
|
c_j1 = c_i1*dconjg(ao_ortho_lowdin_coef_complex(j1,j))
|
||||||
|
ao_ortho_lowdin_n_e_ints_cplx(j,i) = &
|
||||||
|
ao_ortho_lowdin_n_e_ints_cplx(j,i) + &
|
||||||
|
c_j1 * ao_integrals_n_e_complex(j1,i1)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -4,6 +4,18 @@ doc: Nucleus-electron integrals in |MO| basis set
|
|||||||
size: (mo_basis.mo_num,mo_basis.mo_num)
|
size: (mo_basis.mo_num,mo_basis.mo_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_e_n_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex nucleus-electron integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num,mo_basis.mo_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_e_n_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex nucleus-electron integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_mo_integrals_e_n]
|
[io_mo_integrals_e_n]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |MO| electron-nucleus attraction integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |MO| electron-nucleus attraction integrals from/to disk [ Write | Read | None ]
|
||||||
@ -17,12 +29,35 @@ doc: Kinetic energy integrals in |MO| basis set
|
|||||||
size: (mo_basis.mo_num,mo_basis.mo_num)
|
size: (mo_basis.mo_num,mo_basis.mo_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_kinetic_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex kinetic energy integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num,mo_basis.mo_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_kinetic_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex kinetic energy integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_mo_integrals_kinetic]
|
[io_mo_integrals_kinetic]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |MO| one-electron kinetic integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |MO| one-electron kinetic integrals from/to disk [ Write | Read | None ]
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: None
|
default: None
|
||||||
|
|
||||||
|
[mo_integrals_overlap_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex overlap integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[io_mo_integrals_overlap]
|
||||||
|
type: Disk_access
|
||||||
|
doc: Read/Write |MO| one-electron overlap integrals from/to disk [ Write | Read | None ]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: None
|
||||||
|
|
||||||
|
|
||||||
[mo_integrals_pseudo]
|
[mo_integrals_pseudo]
|
||||||
@ -31,18 +66,43 @@ doc: Pseudopotential integrals in |MO| basis set
|
|||||||
size: (mo_basis.mo_num,mo_basis.mo_num)
|
size: (mo_basis.mo_num,mo_basis.mo_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_pseudo_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex pseudopotential integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num,mo_basis.mo_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_integrals_pseudo_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex pseudopotential integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_mo_integrals_pseudo]
|
[io_mo_integrals_pseudo]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |MO| pseudopotential integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |MO| pseudopotential integrals from/to disk [ Write | Read | None ]
|
||||||
interface: ezfio,provider,ocaml
|
interface: ezfio,provider,ocaml
|
||||||
default: None
|
default: None
|
||||||
|
|
||||||
|
|
||||||
[mo_one_e_integrals]
|
[mo_one_e_integrals]
|
||||||
type: double precision
|
type: double precision
|
||||||
doc: One-electron integrals in |MO| basis set
|
doc: One-electron integrals in |MO| basis set
|
||||||
size: (mo_basis.mo_num,mo_basis.mo_num)
|
size: (mo_basis.mo_num,mo_basis.mo_num)
|
||||||
interface: ezfio
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_one_e_integrals_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex one-electron integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num,mo_basis.mo_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
[mo_one_e_integrals_kpts]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex one-electron integrals in |MO| basis set
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,nuclei.kpt_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
[io_mo_one_e_integrals]
|
[io_mo_one_e_integrals]
|
||||||
type: Disk_access
|
type: Disk_access
|
||||||
doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ]
|
doc: Read/Write |MO| one-electron integrals from/to disk [ Write | Read | None ]
|
||||||
|
@ -63,4 +63,3 @@ BEGIN_PROVIDER [ double precision, S_mo_coef, (ao_num, mo_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
|
||||||
|
146
src/mo_one_e_ints/ao_to_mo_cplx.irp.f
Normal file
146
src/mo_one_e_ints/ao_to_mo_cplx.irp.f
Normal file
@ -0,0 +1,146 @@
|
|||||||
|
subroutine mo_to_ao_complex(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the MO basis to the AO basis
|
||||||
|
!
|
||||||
|
! (S.C).A_mo.(S.C)t
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_mo(LDA_mo,mo_num)
|
||||||
|
complex*16, intent(out) :: A_ao(LDA_ao,ao_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(mo_num,ao_num) )
|
||||||
|
|
||||||
|
call zgemm('N','C', mo_num, ao_num, mo_num, &
|
||||||
|
(1.d0,0.d0), A_mo,size(A_mo,1), &
|
||||||
|
S_mo_coef_complex, size(S_mo_coef_complex,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, ao_num, mo_num, &
|
||||||
|
(1.d0,0.d0), S_mo_coef_complex, size(S_mo_coef_complex,1), &
|
||||||
|
T, size(T,1), &
|
||||||
|
(0.d0,0.d0), A_ao, size(A_ao,1))
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine mo_to_ao_no_overlap_complex(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the MO basis to the S^-1 AO basis
|
||||||
|
! Useful for density matrix
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_mo(LDA_mo,mo_num)
|
||||||
|
complex*16, intent(out) :: A_ao(LDA_ao,ao_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(mo_num,ao_num) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
|
||||||
|
call zgemm('N','C', mo_num, ao_num, mo_num, &
|
||||||
|
(1.d0,0.d0), A_mo,size(A_mo,1), &
|
||||||
|
mo_coef_complex, size(mo_coef_complex,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num, ao_num, mo_num, &
|
||||||
|
(1.d0,0.d0), mo_coef_complex,size(mo_coef_complex,1), &
|
||||||
|
T, size(T,1), &
|
||||||
|
(0.d0,0.d0), A_ao, size(A_ao,1))
|
||||||
|
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_mo_coef_complex, (ao_num, mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
call zgemm('N','N',ao_num, mo_num, ao_num, (1.d0,0.d0), &
|
||||||
|
ao_overlap_complex, size(ao_overlap_complex,1), &
|
||||||
|
mo_coef_complex, size(mo_coef_complex,1), &
|
||||||
|
(0.d0,0.d0), &
|
||||||
|
S_mo_coef_complex, size(S_mo_coef_complex,1))
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
subroutine mo_to_ao_kpts(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the MO basis to the AO basis
|
||||||
|
!
|
||||||
|
! (S.C).A_mo.(S.C)t
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num)
|
||||||
|
complex*16, intent(out) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(mo_num_per_kpt,ao_num_per_kpt) )
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('N','C', mo_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), A_mo(:,:,k),size(A_mo,1), &
|
||||||
|
S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1), &
|
||||||
|
T, size(T,1), &
|
||||||
|
(0.d0,0.d0), A_ao(:,:,k), size(A_ao,1))
|
||||||
|
enddo
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
subroutine mo_to_ao_no_overlap_kpts(A_mo,LDA_mo,A_ao,LDA_ao)
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Transform A from the MO basis to the S^-1 AO basis
|
||||||
|
! Useful for density matrix
|
||||||
|
END_DOC
|
||||||
|
integer, intent(in) :: LDA_ao,LDA_mo
|
||||||
|
complex*16, intent(in) :: A_mo(LDA_mo,mo_num_per_kpt,kpt_num)
|
||||||
|
complex*16, intent(out) :: A_ao(LDA_ao,ao_num_per_kpt,kpt_num)
|
||||||
|
complex*16, allocatable :: T(:,:)
|
||||||
|
|
||||||
|
allocate ( T(mo_num_per_kpt,ao_num_per_kpt) )
|
||||||
|
!DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('N','C', mo_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), A_mo(:,:,k),size(A_mo,1), &
|
||||||
|
mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), &
|
||||||
|
(0.d0,0.d0), T, size(T,1))
|
||||||
|
|
||||||
|
call zgemm('N','N', ao_num_per_kpt, ao_num_per_kpt, mo_num_per_kpt, &
|
||||||
|
(1.d0,0.d0), mo_coef_kpts(:,:,k),size(mo_coef_kpts,1), &
|
||||||
|
T, size(T,1), &
|
||||||
|
(0.d0,0.d0), A_ao(:,:,k), size(A_ao,1))
|
||||||
|
enddo
|
||||||
|
deallocate(T)
|
||||||
|
end
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, S_mo_coef_kpts, (ao_num_per_kpt, mo_num_per_kpt, kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Product S.C where S is the overlap matrix in the AO basis and C the mo_coef matrix.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: k
|
||||||
|
do k=1,kpt_num
|
||||||
|
call zgemm('N','N',ao_num_per_kpt, mo_num_per_kpt, ao_num_per_kpt, (1.d0,0.d0), &
|
||||||
|
ao_overlap_kpts(:,:,k), size(ao_overlap_kpts,1), &
|
||||||
|
mo_coef_kpts(:,:,k), size(mo_coef_kpts,1), &
|
||||||
|
(0.d0,0.d0), &
|
||||||
|
S_mo_coef_kpts(:,:,k), size(S_mo_coef_kpts,1))
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -22,3 +22,26 @@ BEGIN_PROVIDER [double precision, mo_kinetic_integrals, (mo_num,mo_num)]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_kinetic_integrals_diag,(mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! diagonal elements of mo_kinetic_integrals or mo_kinetic_integrals_complex
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer :: k,i_shft
|
||||||
|
PROVIDE mo_kinetic_integrals_kpts
|
||||||
|
do k=1,kpt_num
|
||||||
|
i_shft = (k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_kinetic_integrals_diag(i+i_shft) = dble(mo_kinetic_integrals_kpts(i,i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
PROVIDE mo_kinetic_integrals
|
||||||
|
do i=1,mo_num
|
||||||
|
mo_kinetic_integrals_diag(i) = mo_kinetic_integrals(i,i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
60
src/mo_one_e_ints/kin_mo_ints_cplx.irp.f
Normal file
60
src/mo_one_e_ints/kin_mo_ints_cplx.irp.f
Normal file
@ -0,0 +1,60 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_complex, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the MO basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
print *, 'Providing MO kinetic integrals'
|
||||||
|
if (read_mo_integrals_kinetic) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_complex(mo_kinetic_integrals_complex)
|
||||||
|
print *, 'MO kinetic integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, 'Providing MO kinetic integrals from AO kinetic integrals'
|
||||||
|
call ao_to_mo_complex( &
|
||||||
|
ao_kinetic_integrals_complex, &
|
||||||
|
size(ao_kinetic_integrals_complex,1), &
|
||||||
|
mo_kinetic_integrals_complex, &
|
||||||
|
size(mo_kinetic_integrals_complex,1) &
|
||||||
|
)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_kinetic) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_complex(mo_kinetic_integrals_complex)
|
||||||
|
print *, 'MO kinetic integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, mo_kinetic_integrals_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the MO basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
print *, 'Providing MO kinetic integrals'
|
||||||
|
if (read_mo_integrals_kinetic) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_kinetic_kpts(mo_kinetic_integrals_kpts)
|
||||||
|
print *, 'MO kinetic integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, 'Providing MO kinetic integrals from AO kinetic integrals'
|
||||||
|
call ao_to_mo_kpts( &
|
||||||
|
ao_kinetic_integrals_kpts, &
|
||||||
|
size(ao_kinetic_integrals_kpts,1), &
|
||||||
|
mo_kinetic_integrals_kpts, &
|
||||||
|
size(mo_kinetic_integrals_kpts,1) &
|
||||||
|
)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_kinetic) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_kinetic_kpts(mo_kinetic_integrals_kpts)
|
||||||
|
print *, 'MO kinetic integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
@ -24,3 +24,27 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)]
|
|||||||
ENDIF
|
ENDIF
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_one_e_integrals_diag,(mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! diagonal elements of mo_one_e_integrals or mo_one_e_integrals_complex
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer :: k,i_shft
|
||||||
|
PROVIDE mo_one_e_integrals_kpts
|
||||||
|
do k=1,kpt_num
|
||||||
|
i_shft = (k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_one_e_integrals_diag(i+i_shft) = dble(mo_one_e_integrals_kpts(i,i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
PROVIDE mo_one_e_integrals
|
||||||
|
do i=1,mo_num
|
||||||
|
mo_one_e_integrals_diag(i) = mo_one_e_integrals(i,i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
61
src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f
Normal file
61
src/mo_one_e_ints/mo_one_e_ints_cplx.irp.f
Normal file
@ -0,0 +1,61 @@
|
|||||||
|
BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_complex,(mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,n,l
|
||||||
|
BEGIN_DOC
|
||||||
|
! array of the one-electron Hamiltonian on the |MO| basis :
|
||||||
|
! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed)
|
||||||
|
END_DOC
|
||||||
|
print*,'Providing the one-electron integrals'
|
||||||
|
|
||||||
|
IF (read_mo_one_e_integrals) THEN
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_one_e_integrals_complex(mo_one_e_integrals_complex)
|
||||||
|
ELSE
|
||||||
|
mo_one_e_integrals_complex = mo_integrals_n_e_complex + mo_kinetic_integrals_complex
|
||||||
|
|
||||||
|
IF (do_pseudo) THEN
|
||||||
|
mo_one_e_integrals_complex += mo_pseudo_integrals_complex
|
||||||
|
ENDIF
|
||||||
|
|
||||||
|
ENDIF
|
||||||
|
|
||||||
|
IF (write_mo_one_e_integrals) THEN
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_one_e_integrals_complex(mo_one_e_integrals_complex)
|
||||||
|
print *, 'MO one-e integrals written to disk'
|
||||||
|
ENDIF
|
||||||
|
print*,'Provided the one-electron integrals'
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_one_e_integrals_kpts,(mo_num_per_kpt,mo_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,n,l
|
||||||
|
BEGIN_DOC
|
||||||
|
! array of the one-electron Hamiltonian on the |MO| basis :
|
||||||
|
! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed)
|
||||||
|
END_DOC
|
||||||
|
print*,'Providing the one-electron integrals'
|
||||||
|
|
||||||
|
IF (read_mo_one_e_integrals) THEN
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_one_e_integrals_kpts(mo_one_e_integrals_kpts)
|
||||||
|
ELSE
|
||||||
|
mo_one_e_integrals_kpts = mo_integrals_n_e_kpts + mo_kinetic_integrals_kpts
|
||||||
|
|
||||||
|
IF (do_pseudo) THEN
|
||||||
|
mo_one_e_integrals_kpts += mo_pseudo_integrals_kpts
|
||||||
|
ENDIF
|
||||||
|
|
||||||
|
ENDIF
|
||||||
|
|
||||||
|
IF (write_mo_one_e_integrals) THEN
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_one_e_integrals_kpts(mo_one_e_integrals_kpts)
|
||||||
|
print *, 'MO one-e integrals written to disk'
|
||||||
|
ENDIF
|
||||||
|
print*,'Provided the one-electron integrals'
|
||||||
|
|
||||||
|
END_PROVIDER
|
@ -37,3 +37,94 @@ BEGIN_PROVIDER [ double precision, mo_overlap,(mo_num,mo_num) ]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_overlap_complex,(mo_num,mo_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Provider to check that the MOs are indeed orthonormal.
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,n,l
|
||||||
|
integer :: lmax
|
||||||
|
|
||||||
|
|
||||||
|
lmax = (ao_num/4) * 4
|
||||||
|
!$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,j,n,l) &
|
||||||
|
!$OMP SHARED(mo_overlap_complex,mo_coef_complex,ao_overlap_complex, &
|
||||||
|
!$OMP mo_num,ao_num,lmax)
|
||||||
|
do j=1,mo_num
|
||||||
|
do i= 1,mo_num
|
||||||
|
mo_overlap_complex(i,j) = (0.d0,0.d0)
|
||||||
|
do n = 1, lmax,4
|
||||||
|
do l = 1, ao_num
|
||||||
|
mo_overlap_complex(i,j) = mo_overlap_complex(i,j) + dconjg(mo_coef_complex(l,i)) * &
|
||||||
|
( mo_coef_complex(n ,j) * ao_overlap_complex(l,n ) &
|
||||||
|
+ mo_coef_complex(n+1,j) * ao_overlap_complex(l,n+1) &
|
||||||
|
+ mo_coef_complex(n+2,j) * ao_overlap_complex(l,n+2) &
|
||||||
|
+ mo_coef_complex(n+3,j) * ao_overlap_complex(l,n+3) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do n = lmax+1, ao_num
|
||||||
|
do l = 1, ao_num
|
||||||
|
mo_overlap_complex(i,j) = mo_overlap_complex(i,j) + mo_coef_complex(n,j) * dconjg(mo_coef_complex(l,i)) * ao_overlap_complex(l,n)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ complex*16, mo_overlap_kpts,(mo_num_per_kpt,mo_num_per_kpt,kpt_num) ]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Provider to check that the MOs are indeed orthonormal.
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,n,l,k
|
||||||
|
integer :: lmax
|
||||||
|
|
||||||
|
print *, 'Providing MO overlap integrals'
|
||||||
|
if (read_mo_integrals_overlap) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_overlap_kpts(mo_overlap_kpts)
|
||||||
|
print *, 'MO overlap integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, 'Providing MO overlap integrals from AO overlap integrals'
|
||||||
|
! call ao_to_mo_kpts( &
|
||||||
|
! ao_kinetic_integrals_kpts, &
|
||||||
|
! size(ao_kinetic_integrals_kpts,1), &
|
||||||
|
! mo_kinetic_integrals_kpts, &
|
||||||
|
! size(mo_kinetic_integrals_kpts,1) &
|
||||||
|
! )
|
||||||
|
!endif
|
||||||
|
|
||||||
|
|
||||||
|
lmax = (ao_num_per_kpt/4) * 4
|
||||||
|
!$OMP PARALLEL DO SCHEDULE(STATIC) DEFAULT(NONE) &
|
||||||
|
!$OMP PRIVATE(i,j,n,l,k) &
|
||||||
|
!$OMP SHARED(mo_overlap_kpts,mo_coef_kpts,ao_overlap_kpts, &
|
||||||
|
!$OMP mo_num_per_kpt,ao_num_per_kpt,lmax,kpt_num)
|
||||||
|
do k=1,kpt_num
|
||||||
|
do j=1,mo_num_per_kpt
|
||||||
|
do i= 1,mo_num_per_kpt
|
||||||
|
mo_overlap_kpts(i,j,k) = (0.d0,0.d0)
|
||||||
|
do n = 1, lmax,4
|
||||||
|
do l = 1, ao_num_per_kpt
|
||||||
|
mo_overlap_kpts(i,j,k) = mo_overlap_kpts(i,j,k) + dconjg(mo_coef_kpts(l,i,k)) * &
|
||||||
|
( mo_coef_kpts(n ,j,k) * ao_overlap_kpts(l,n ,k) &
|
||||||
|
+ mo_coef_kpts(n+1,j,k) * ao_overlap_kpts(l,n+1,k) &
|
||||||
|
+ mo_coef_kpts(n+2,j,k) * ao_overlap_kpts(l,n+2,k) &
|
||||||
|
+ mo_coef_kpts(n+3,j,k) * ao_overlap_kpts(l,n+3,k) )
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
do n = lmax+1, ao_num_per_kpt
|
||||||
|
do l = 1, ao_num_per_kpt
|
||||||
|
mo_overlap_kpts(i,j,k) = mo_overlap_kpts(i,j,k) + mo_coef_kpts(n,j,k) * &
|
||||||
|
dconjg(mo_coef_kpts(l,i,k)) * ao_overlap_kpts(l,n,k)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
@ -1,11 +1,21 @@
|
|||||||
subroutine orthonormalize_mos
|
subroutine orthonormalize_mos
|
||||||
implicit none
|
implicit none
|
||||||
integer :: m,p,s
|
integer :: m,p,s,k
|
||||||
|
if (is_complex) then
|
||||||
|
do k=1,kpt_num
|
||||||
|
m = size(mo_coef_kpts,1)
|
||||||
|
p = size(mo_overlap_kpts,1)
|
||||||
|
call ortho_lowdin_complex(mo_overlap_kpts(1,1,k),p,mo_num_per_kpt,mo_coef_kpts(1,1,k),m,ao_num_per_kpt)
|
||||||
|
enddo
|
||||||
|
mo_label = 'Orthonormalized'
|
||||||
|
SOFT_TOUCH mo_coef_kpts mo_label
|
||||||
|
else
|
||||||
m = size(mo_coef,1)
|
m = size(mo_coef,1)
|
||||||
p = size(mo_overlap,1)
|
p = size(mo_overlap,1)
|
||||||
call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num)
|
call ortho_lowdin(mo_overlap,p,mo_num,mo_coef,m,ao_num)
|
||||||
mo_label = 'Orthonormalized'
|
mo_label = 'Orthonormalized'
|
||||||
SOFT_TOUCH mo_coef mo_label
|
SOFT_TOUCH mo_coef mo_label
|
||||||
|
endif
|
||||||
end
|
end
|
||||||
|
|
||||||
|
|
||||||
|
@ -44,3 +44,26 @@ BEGIN_PROVIDER [double precision, mo_integrals_n_e_per_atom, (mo_num,mo_num,nucl
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_integrals_n_e_diag,(mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! diagonal elements of mo_integrals_n_e or mo_integrals_n_e_complex
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer :: k,i_shft
|
||||||
|
PROVIDE mo_integrals_n_e_kpts
|
||||||
|
do k=1,kpt_num
|
||||||
|
i_shft = (k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_integrals_n_e_diag(i+i_shft) = dble(mo_integrals_n_e_kpts(i,i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
PROVIDE mo_integrals_n_e
|
||||||
|
do i=1,mo_num
|
||||||
|
mo_integrals_n_e_diag(i) = mo_integrals_n_e(i,i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
59
src/mo_one_e_ints/pot_mo_ints_cplx.irp.f
Normal file
59
src/mo_one_e_ints/pot_mo_ints_cplx.irp.f
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, mo_integrals_n_e_complex, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the MO basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
print *, 'Providing MO N-e integrals'
|
||||||
|
if (read_mo_integrals_e_n) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex)
|
||||||
|
print *, 'MO N-e integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, 'Providing MO N-e integrals from AO N-e integrals'
|
||||||
|
call ao_to_mo_complex( &
|
||||||
|
ao_integrals_n_e_complex, &
|
||||||
|
size(ao_integrals_n_e_complex,1), &
|
||||||
|
mo_integrals_n_e_complex, &
|
||||||
|
size(mo_integrals_n_e_complex,1) &
|
||||||
|
)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_e_n) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_e_n_complex(mo_integrals_n_e_complex)
|
||||||
|
print *, 'MO N-e integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, mo_integrals_n_e_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Kinetic energy integrals in the MO basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
print *, 'Providing MO N-e integrals'
|
||||||
|
if (read_mo_integrals_e_n) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts)
|
||||||
|
print *, 'MO N-e integrals read from disk'
|
||||||
|
else
|
||||||
|
print *, 'Providing MO N-e integrals from AO N-e integrals'
|
||||||
|
call ao_to_mo_kpts( &
|
||||||
|
ao_integrals_n_e_kpts, &
|
||||||
|
size(ao_integrals_n_e_kpts,1), &
|
||||||
|
mo_integrals_n_e_kpts, &
|
||||||
|
size(mo_integrals_n_e_kpts,1) &
|
||||||
|
)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_e_n) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_e_n_kpts(mo_integrals_n_e_kpts)
|
||||||
|
print *, 'MO N-e integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
@ -25,4 +25,27 @@ BEGIN_PROVIDER [double precision, mo_pseudo_integrals, (mo_num,mo_num)]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_pseudo_integrals_diag,(mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
BEGIN_DOC
|
||||||
|
! diagonal elements of mo_pseudo_integrals or mo_pseudo_integrals_complex
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
if (is_complex) then
|
||||||
|
integer :: k,i_shft
|
||||||
|
PROVIDE mo_pseudo_integrals_kpts
|
||||||
|
do k=1,kpt_num
|
||||||
|
i_shft = (k-1)*mo_num_per_kpt
|
||||||
|
do i=1,mo_num_per_kpt
|
||||||
|
mo_pseudo_integrals_diag(i+i_shft) = dble(mo_pseudo_integrals_kpts(i,i,k))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
PROVIDE mo_pseudo_integrals
|
||||||
|
do i=1,mo_num
|
||||||
|
mo_pseudo_integrals_diag(i) = mo_pseudo_integrals(i,i)
|
||||||
|
enddo
|
||||||
|
endif
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
59
src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f
Normal file
59
src/mo_one_e_ints/pot_mo_pseudo_ints_cplx.irp.f
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_complex, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Pseudopotential integrals in |MO| basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
if (read_mo_integrals_pseudo) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_complex(mo_pseudo_integrals_complex)
|
||||||
|
print *, 'MO pseudopotential integrals read from disk'
|
||||||
|
else if (do_pseudo) then
|
||||||
|
call ao_to_mo_complex( &
|
||||||
|
ao_pseudo_integrals_complex, &
|
||||||
|
size(ao_pseudo_integrals_complex,1), &
|
||||||
|
mo_pseudo_integrals_complex, &
|
||||||
|
size(mo_pseudo_integrals_complex,1) &
|
||||||
|
)
|
||||||
|
else
|
||||||
|
mo_pseudo_integrals_complex = (0.d0,0.d0)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_pseudo) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_complex(mo_pseudo_integrals_complex)
|
||||||
|
print *, 'MO pseudopotential integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
!============================================!
|
||||||
|
! !
|
||||||
|
! kpts !
|
||||||
|
! !
|
||||||
|
!============================================!
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, mo_pseudo_integrals_kpts, (mo_num_per_kpt,mo_num_per_kpt,kpt_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! Pseudopotential integrals in |MO| basis
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j
|
||||||
|
|
||||||
|
if (read_mo_integrals_pseudo) then
|
||||||
|
call ezfio_get_mo_one_e_ints_mo_integrals_pseudo_kpts(mo_pseudo_integrals_kpts)
|
||||||
|
print *, 'MO pseudopotential integrals read from disk'
|
||||||
|
else if (do_pseudo) then
|
||||||
|
call ao_to_mo_kpts( &
|
||||||
|
ao_pseudo_integrals_kpts, &
|
||||||
|
size(ao_pseudo_integrals_kpts,1), &
|
||||||
|
mo_pseudo_integrals_kpts, &
|
||||||
|
size(mo_pseudo_integrals_kpts,1) &
|
||||||
|
)
|
||||||
|
else
|
||||||
|
mo_pseudo_integrals_kpts = (0.d0,0.d0)
|
||||||
|
endif
|
||||||
|
if (write_mo_integrals_pseudo) then
|
||||||
|
call ezfio_set_mo_one_e_ints_mo_integrals_pseudo_kpts(mo_pseudo_integrals_kpts)
|
||||||
|
print *, 'MO pseudopotential integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
@ -11,3 +11,15 @@ interface: ezfio,provider,ocaml
|
|||||||
default: 1.e-15
|
default: 1.e-15
|
||||||
ezfio_name: threshold_mo
|
ezfio_name: threshold_mo
|
||||||
|
|
||||||
|
[io_df_mo_integrals]
|
||||||
|
type: Disk_access
|
||||||
|
doc: Read/Write df |MO| integrals from/to disk [ Write | Read | None ]
|
||||||
|
interface: ezfio,provider,ocaml
|
||||||
|
default: None
|
||||||
|
|
||||||
|
[df_mo_integrals_complex]
|
||||||
|
type: double precision
|
||||||
|
doc: Complex df integrals over MOs
|
||||||
|
size: (2,mo_basis.mo_num_per_kpt,mo_basis.mo_num_per_kpt,ao_two_e_ints.df_num,nuclei.kpt_pair_num)
|
||||||
|
interface: ezfio
|
||||||
|
|
||||||
|
@ -7,7 +7,7 @@ BEGIN_PROVIDER [double precision, core_energy]
|
|||||||
core_energy = 0.d0
|
core_energy = 0.d0
|
||||||
do i = 1, n_core_orb
|
do i = 1, n_core_orb
|
||||||
j = list_core(i)
|
j = list_core(i)
|
||||||
core_energy += 2.d0 * mo_one_e_integrals(j,j) + mo_two_e_integrals_jj(j,j)
|
core_energy += 2.d0 * mo_one_e_integrals_diag(j) + mo_two_e_integrals_jj(j,j)
|
||||||
do k = i+1, n_core_orb
|
do k = i+1, n_core_orb
|
||||||
l = list_core(k)
|
l = list_core(k)
|
||||||
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
|
core_energy += 2.d0 * (2.d0 * mo_two_e_integrals_jj(j,l) - mo_two_e_integrals_jj_exchange(j,l))
|
||||||
@ -36,3 +36,25 @@ BEGIN_PROVIDER [double precision, core_fock_operator, (mo_num,mo_num)]
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [complex*16, core_fock_operator_complex, (mo_num,mo_num)]
|
||||||
|
implicit none
|
||||||
|
integer :: i,j,k,l,m,n
|
||||||
|
complex*16 :: get_two_e_integral_complex
|
||||||
|
BEGIN_DOC
|
||||||
|
! this is the contribution to the Fock operator from the core electrons
|
||||||
|
END_DOC
|
||||||
|
core_fock_operator_complex = (0.d0,0.d0)
|
||||||
|
do i = 1, n_act_orb
|
||||||
|
j = list_act(i)
|
||||||
|
do k = 1, n_act_orb
|
||||||
|
l = list_act(k)
|
||||||
|
do m = 1, n_core_orb
|
||||||
|
n = list_core(m)
|
||||||
|
core_fock_operator_complex(j,l) += 2.d0 * &
|
||||||
|
get_two_e_integral_complex(j,n,l,n,mo_integrals_map,mo_integrals_map_2) - &
|
||||||
|
get_two_e_integral_complex(j,n,n,l,mo_integrals_map,mo_integrals_map_2)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
END_PROVIDER
|
||||||
|
295
src/mo_two_e_ints/df_mo_ints.irp.f
Normal file
295
src/mo_two_e_ints/df_mo_ints.irp.f
Normal file
@ -0,0 +1,295 @@
|
|||||||
|
BEGIN_PROVIDER [complex*16, df_mo_integrals_complex, (mo_num_per_kpt,mo_num_per_kpt,df_num,kpt_pair_num)]
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! df MO integrals
|
||||||
|
END_DOC
|
||||||
|
integer :: i,j,k,l
|
||||||
|
|
||||||
|
if (read_df_mo_integrals) then
|
||||||
|
call ezfio_get_mo_two_e_ints_df_mo_integrals_complex(df_mo_integrals_complex)
|
||||||
|
print *, 'df MO integrals read from disk'
|
||||||
|
else
|
||||||
|
call df_mo_from_df_ao(df_mo_integrals_complex,df_ao_integrals_complex,mo_num_per_kpt,ao_num_per_kpt,df_num,kpt_pair_num)
|
||||||
|
endif
|
||||||
|
|
||||||
|
if (write_df_mo_integrals) then
|
||||||
|
call ezfio_set_mo_two_e_ints_df_mo_integrals_complex(df_mo_integrals_complex)
|
||||||
|
print *, 'df MO integrals written to disk'
|
||||||
|
endif
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
subroutine mo_map_fill_from_df
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! fill mo bielec integral map using 3-index df integrals
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i,k,j,l
|
||||||
|
integer :: ki,kk,kj,kl
|
||||||
|
integer :: ii,ik,ij,il
|
||||||
|
integer :: kikk2,kjkl2,jl2,ik2
|
||||||
|
integer :: i_mo,j_mo,i_df
|
||||||
|
|
||||||
|
complex*16,allocatable :: ints_ik(:,:,:), ints_jl(:,:,:), ints_ikjl(:,:,:,:)
|
||||||
|
|
||||||
|
complex*16 :: integral
|
||||||
|
integer :: n_integrals_1, n_integrals_2
|
||||||
|
integer :: size_buffer
|
||||||
|
integer(key_kind),allocatable :: buffer_i_1(:), buffer_i_2(:)
|
||||||
|
real(integral_kind),allocatable :: buffer_values_1(:), buffer_values_2(:)
|
||||||
|
double precision :: tmp_re,tmp_im
|
||||||
|
integer :: mo_num_kpt_2
|
||||||
|
|
||||||
|
double precision :: cpu_1, cpu_2, wall_1, wall_2, wall_0
|
||||||
|
double precision :: map_mb
|
||||||
|
|
||||||
|
logical :: use_map1
|
||||||
|
integer(keY_kind) :: idx_tmp
|
||||||
|
double precision :: sign
|
||||||
|
|
||||||
|
mo_num_kpt_2 = mo_num_per_kpt * mo_num_per_kpt
|
||||||
|
|
||||||
|
size_buffer = min(mo_num_per_kpt*mo_num_per_kpt*mo_num_per_kpt,16000000)
|
||||||
|
print*, 'Providing the mo_bielec integrals from 3-index df integrals'
|
||||||
|
call write_time(6)
|
||||||
|
! call ezfio_set_integrals_bielec_disk_access_mo_integrals('Write')
|
||||||
|
! TOUCH read_mo_integrals read_ao_integrals write_mo_integrals write_ao_integrals
|
||||||
|
|
||||||
|
call wall_time(wall_1)
|
||||||
|
call cpu_time(cpu_1)
|
||||||
|
|
||||||
|
allocate( ints_jl(mo_num_per_kpt,mo_num_per_kpt,df_num))
|
||||||
|
|
||||||
|
wall_0 = wall_1
|
||||||
|
do kl=1, kpt_num
|
||||||
|
do kj=1, kl
|
||||||
|
call idx2_tri_int(kj,kl,kjkl2)
|
||||||
|
if (kj < kl) then
|
||||||
|
do i_mo=1,mo_num_per_kpt
|
||||||
|
do j_mo=1,mo_num_per_kpt
|
||||||
|
do i_df=1,df_num
|
||||||
|
ints_jl(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kjkl2))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
else
|
||||||
|
ints_jl = df_mo_integrals_complex(:,:,:,kjkl2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
!$OMP PARALLEL PRIVATE(i,k,j,l,ki,kk,ii,ik,ij,il,kikk2,jl2,ik2, &
|
||||||
|
!$OMP ints_ik, ints_ikjl, i_mo, j_mo, i_df, &
|
||||||
|
!$OMP n_integrals_1, buffer_i_1, buffer_values_1, &
|
||||||
|
!$OMP n_integrals_2, buffer_i_2, buffer_values_2, &
|
||||||
|
!$OMP idx_tmp, tmp_re, tmp_im, integral,sign,use_map1) &
|
||||||
|
!$OMP DEFAULT(NONE) &
|
||||||
|
!$OMP SHARED(size_buffer, kpt_num, df_num, mo_num_per_kpt, mo_num_kpt_2, &
|
||||||
|
!$OMP kl,kj,kjkl2,ints_jl, &
|
||||||
|
!$OMP kconserv, df_mo_integrals_complex, mo_integrals_threshold, mo_integrals_map, mo_integrals_map_2)
|
||||||
|
|
||||||
|
allocate( &
|
||||||
|
ints_ik(mo_num_per_kpt,mo_num_per_kpt,df_num), &
|
||||||
|
ints_ikjl(mo_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt,mo_num_per_kpt), &
|
||||||
|
buffer_i_1(size_buffer), &
|
||||||
|
buffer_i_2(size_buffer), &
|
||||||
|
buffer_values_1(size_buffer), &
|
||||||
|
buffer_values_2(size_buffer) &
|
||||||
|
)
|
||||||
|
|
||||||
|
!$OMP DO SCHEDULE(guided)
|
||||||
|
do kk=1,kl
|
||||||
|
ki=kconserv(kl,kk,kj)
|
||||||
|
if (ki>kl) cycle
|
||||||
|
! if ((kl == kj) .and. (ki > kk)) cycle
|
||||||
|
call idx2_tri_int(ki,kk,kikk2)
|
||||||
|
! if (kikk2 > kjkl2) cycle
|
||||||
|
if (ki < kk) then
|
||||||
|
do i_mo=1,mo_num_per_kpt
|
||||||
|
do j_mo=1,mo_num_per_kpt
|
||||||
|
do i_df=1,df_num
|
||||||
|
ints_ik(i_mo,j_mo,i_df) = dconjg(df_mo_integrals_complex(j_mo,i_mo,i_df,kikk2))
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
! ints_ik = conjg(reshape(df_mo_integral_array(:,:,:,kikk2),(/mo_num_per_kpt,mo_num_per_kpt,df_num/),order=(/2,1,3/)))
|
||||||
|
else
|
||||||
|
ints_ik = df_mo_integrals_complex(:,:,:,kikk2)
|
||||||
|
endif
|
||||||
|
|
||||||
|
call zgemm('N','T', mo_num_kpt_2, mo_num_kpt_2, df_num, &
|
||||||
|
(1.d0,0.d0), ints_ik, mo_num_kpt_2, &
|
||||||
|
ints_jl, mo_num_kpt_2, &
|
||||||
|
(0.d0,0.d0), ints_ikjl, mo_num_kpt_2)
|
||||||
|
|
||||||
|
n_integrals_1=0
|
||||||
|
n_integrals_2=0
|
||||||
|
do il=1,mo_num_per_kpt
|
||||||
|
l=il+(kl-1)*mo_num_per_kpt
|
||||||
|
do ij=1,mo_num_per_kpt
|
||||||
|
j=ij+(kj-1)*mo_num_per_kpt
|
||||||
|
if (j>l) exit
|
||||||
|
call idx2_tri_int(j,l,jl2)
|
||||||
|
do ik=1,mo_num_per_kpt
|
||||||
|
k=ik+(kk-1)*mo_num_per_kpt
|
||||||
|
if (k>l) exit
|
||||||
|
do ii=1,mo_num_per_kpt
|
||||||
|
i=ii+(ki-1)*mo_num_per_kpt
|
||||||
|
if ((j==l) .and. (i>k)) exit
|
||||||
|
call idx2_tri_int(i,k,ik2)
|
||||||
|
if (ik2 > jl2) exit
|
||||||
|
integral = ints_ikjl(ii,ik,ij,il)
|
||||||
|
! print*,i,k,j,l,real(integral),imag(integral)
|
||||||
|
if (cdabs(integral) < mo_integrals_threshold) then
|
||||||
|
cycle
|
||||||
|
endif
|
||||||
|
call ao_two_e_integral_complex_map_idx_sign(i,j,k,l,use_map1,idx_tmp,sign)
|
||||||
|
tmp_re = dble(integral)
|
||||||
|
tmp_im = dimag(integral)
|
||||||
|
if (use_map1) then
|
||||||
|
n_integrals_1 += 1
|
||||||
|
buffer_i_1(n_integrals_1)=idx_tmp
|
||||||
|
buffer_values_1(n_integrals_1)=tmp_re
|
||||||
|
if (sign.ne.0.d0) then
|
||||||
|
n_integrals_1 += 1
|
||||||
|
buffer_i_1(n_integrals_1)=idx_tmp+1
|
||||||
|
buffer_values_1(n_integrals_1)=tmp_im*sign
|
||||||
|
endif
|
||||||
|
if (n_integrals_1 >= size(buffer_i_1)-1) then
|
||||||
|
call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1)
|
||||||
|
!call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1)
|
||||||
|
n_integrals_1 = 0
|
||||||
|
endif
|
||||||
|
else
|
||||||
|
n_integrals_2 += 1
|
||||||
|
buffer_i_2(n_integrals_2)=idx_tmp
|
||||||
|
buffer_values_2(n_integrals_2)=tmp_re
|
||||||
|
if (sign.ne.0.d0) then
|
||||||
|
n_integrals_2 += 1
|
||||||
|
buffer_i_2(n_integrals_2)=idx_tmp+1
|
||||||
|
buffer_values_2(n_integrals_2)=tmp_im*sign
|
||||||
|
endif
|
||||||
|
if (n_integrals_2 >= size(buffer_i_2)-1) then
|
||||||
|
call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2)
|
||||||
|
!call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2)
|
||||||
|
n_integrals_2 = 0
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo !ii
|
||||||
|
enddo !ik
|
||||||
|
enddo !ij
|
||||||
|
enddo !il
|
||||||
|
|
||||||
|
if (n_integrals_1 > 0) then
|
||||||
|
call map_append(mo_integrals_map, buffer_i_1, buffer_values_1, n_integrals_1)
|
||||||
|
!call insert_into_ao_integrals_map(n_integrals_1,buffer_i_1,buffer_values_1)
|
||||||
|
endif
|
||||||
|
if (n_integrals_2 > 0) then
|
||||||
|
call map_append(mo_integrals_map_2, buffer_i_2, buffer_values_2, n_integrals_2)
|
||||||
|
!call insert_into_ao_integrals_map_2(n_integrals_2,buffer_i_2,buffer_values_2)
|
||||||
|
endif
|
||||||
|
enddo !kk
|
||||||
|
!$OMP END DO NOWAIT
|
||||||
|
deallocate( &
|
||||||
|
ints_ik, &
|
||||||
|
ints_ikjl, &
|
||||||
|
buffer_i_1, &
|
||||||
|
buffer_i_2, &
|
||||||
|
buffer_values_1, &
|
||||||
|
buffer_values_2 &
|
||||||
|
)
|
||||||
|
!$OMP END PARALLEL
|
||||||
|
enddo !kj
|
||||||
|
call wall_time(wall_2)
|
||||||
|
if (wall_2 - wall_0 > 1.d0) then
|
||||||
|
wall_0 = wall_2
|
||||||
|
print*, 100.*float(kl)/float(kpt_num), '% in ', &
|
||||||
|
wall_2-wall_1,'s',map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB'
|
||||||
|
endif
|
||||||
|
|
||||||
|
enddo !kl
|
||||||
|
deallocate( ints_jl )
|
||||||
|
|
||||||
|
call map_sort(mo_integrals_map)
|
||||||
|
call map_unique(mo_integrals_map)
|
||||||
|
call map_sort(mo_integrals_map_2)
|
||||||
|
call map_unique(mo_integrals_map_2)
|
||||||
|
!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_1',mo_integrals_map)
|
||||||
|
!call map_save_to_disk(trim(ezfio_filename)//'/work/mo_ints_complex_2',mo_integrals_map_2)
|
||||||
|
!call ezfio_set_mo_two_e_ints_io_mo_two_e_integrals('Read')
|
||||||
|
|
||||||
|
call wall_time(wall_2)
|
||||||
|
call cpu_time(cpu_2)
|
||||||
|
|
||||||
|
integer*8 :: get_mo_map_size, mo_map_size
|
||||||
|
mo_map_size = get_mo_map_size()
|
||||||
|
|
||||||
|
print*,'MO integrals provided:'
|
||||||
|
print*,' Size of MO map ', map_mb(mo_integrals_map),'+',map_mb(mo_integrals_map_2),'MB'
|
||||||
|
print*,' Number of MO integrals: ', mo_map_size
|
||||||
|
print*,' cpu time :',cpu_2 - cpu_1, 's'
|
||||||
|
print*,' wall time :',wall_2 - wall_1, 's ( x ', (cpu_2-cpu_1)/(wall_2-wall_1), ')'
|
||||||
|
|
||||||
|
end subroutine mo_map_fill_from_df
|
||||||
|
|
||||||
|
subroutine df_mo_from_df_ao(df_mo,df_ao,n_mo,n_ao,n_df,n_k_pairs)
|
||||||
|
use map_module
|
||||||
|
implicit none
|
||||||
|
BEGIN_DOC
|
||||||
|
! create 3-idx mo ints from 3-idx ao ints
|
||||||
|
END_DOC
|
||||||
|
integer,intent(in) :: n_mo,n_ao,n_df,n_k_pairs
|
||||||
|
complex*16,intent(out) :: df_mo(n_mo,n_mo,n_df,n_k_pairs)
|
||||||
|
complex*16,intent(in) :: df_ao(n_ao,n_ao,n_df,n_k_pairs)
|
||||||
|
integer :: kl,kj,kjkl2,mu,p,q
|
||||||
|
complex*16,allocatable :: coef_l(:,:), coef_j(:,:), ints_jl(:,:), ints_tmp(:,:)
|
||||||
|
double precision :: wall_1,wall_2,cpu_1,cpu_2
|
||||||
|
|
||||||
|
print*,'providing 3-index MO integrals from 3-index AO integrals'
|
||||||
|
|
||||||
|
call wall_time(wall_1)
|
||||||
|
call cpu_time(cpu_1)
|
||||||
|
allocate( &
|
||||||
|
coef_l(n_ao,n_mo),&
|
||||||
|
coef_j(n_ao,n_mo),&
|
||||||
|
ints_jl(n_ao,n_ao),&
|
||||||
|
ints_tmp(n_mo,n_ao)&
|
||||||
|
)
|
||||||
|
|
||||||
|
do kl=1, kpt_num
|
||||||
|
coef_l = mo_coef_complex_kpts(:,:,kl)
|
||||||
|
do kj=1, kl
|
||||||
|
coef_j = mo_coef_complex_kpts(:,:,kj)
|
||||||
|
kjkl2 = kj+shiftr(kl*kl-kl,1)
|
||||||
|
do mu=1, df_num
|
||||||
|
ints_jl = df_ao(:,:,mu,kjkl2)
|
||||||
|
call zgemm('C','N',n_mo,n_ao,n_ao, &
|
||||||
|
(1.d0,0.d0), coef_l, n_ao, &
|
||||||
|
ints_jl, n_ao, &
|
||||||
|
(0.d0,0.d0), ints_tmp, n_mo)
|
||||||
|
|
||||||
|
call zgemm('N','N',n_mo,n_mo,n_ao, &
|
||||||
|
(1.d0,0.d0), ints_tmp, n_mo, &
|
||||||
|
coef_j, n_ao, &
|
||||||
|
(0.d0,0.d0), df_mo(:,:,mu,kjkl2), n_mo)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
call wall_time(wall_2)
|
||||||
|
print*,100.*float(kl*(kl+1))/(2.*n_k_pairs), '% in ', &
|
||||||
|
wall_2-wall_1, 's'
|
||||||
|
enddo
|
||||||
|
|
||||||
|
deallocate( &
|
||||||
|
coef_l, &
|
||||||
|
coef_j, &
|
||||||
|
ints_jl, &
|
||||||
|
ints_tmp &
|
||||||
|
)
|
||||||
|
call wall_time(wall_2)
|
||||||
|
call cpu_time(cpu_2)
|
||||||
|
print*,' 3-idx MO provided'
|
||||||
|
print*,' cpu time:',cpu_2-cpu_1,'s'
|
||||||
|
print*,' wall time:',wall_2-wall_1,'s ( x ',(cpu_2-cpu_1)/(wall_2-wall_1),')'
|
||||||
|
|
||||||
|
end subroutine df_mo_from_df_ao
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user