mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-23 03:53:29 +01:00
Hij in bimo added
This commit is contained in:
parent
ad01d2b2e4
commit
813f2c3601
@ -94,30 +94,40 @@ BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)]
|
|||||||
expos_slat_gauss_1_erf_x(2) = 0.756023d0
|
expos_slat_gauss_1_erf_x(2) = 0.756023d0
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x, (n_max_fit_slat)]
|
BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x, (n_max_fit_slat)]
|
||||||
&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x, (n_max_fit_slat)]
|
&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x, (n_max_fit_slat)]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! (1 - erf(mu*x)) = \sum_i coef_gauss_1_erf_x(i) * exp(-expo_gauss_1_erf_x(i) * x^2)
|
|
||||||
!
|
|
||||||
! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2)
|
|
||||||
!
|
|
||||||
! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians
|
|
||||||
!
|
|
||||||
! See Appendix 2 of JCP 154, 084119 (2021)
|
|
||||||
END_DOC
|
|
||||||
integer :: i
|
|
||||||
double precision :: expos(n_max_fit_slat),alpha,beta
|
|
||||||
alpha = expos_slat_gauss_1_erf_x(1) * mu_erf
|
|
||||||
call expo_fit_slater_gam(alpha,expos)
|
|
||||||
beta = expos_slat_gauss_1_erf_x(2) * mu_erf**2.d0
|
|
||||||
|
|
||||||
do i = 1, n_max_fit_slat
|
BEGIN_DOC
|
||||||
expo_gauss_1_erf_x(i) = expos(i) + beta
|
!
|
||||||
coef_gauss_1_erf_x(i) = coef_fit_slat_gauss(i)
|
! (1 - erf(mu*x)) = \sum_i coef_gauss_1_erf_x(i) * exp(-expo_gauss_1_erf_x(i) * x^2)
|
||||||
enddo
|
!
|
||||||
|
! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2)
|
||||||
|
!
|
||||||
|
! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians
|
||||||
|
!
|
||||||
|
! See Appendix 2 of JCP 154, 084119 (2021)
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i
|
||||||
|
double precision :: expos(n_max_fit_slat), alpha, beta
|
||||||
|
|
||||||
|
alpha = expos_slat_gauss_1_erf_x(1) * mu_erf
|
||||||
|
call expo_fit_slater_gam(alpha, expos)
|
||||||
|
beta = expos_slat_gauss_1_erf_x(2) * mu_erf * mu_erf
|
||||||
|
|
||||||
|
do i = 1, n_max_fit_slat
|
||||||
|
expo_gauss_1_erf_x(i) = expos(i) + beta
|
||||||
|
coef_gauss_1_erf_x(i) = coef_fit_slat_gauss(i)
|
||||||
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
double precision function fit_1_erf_x(x)
|
double precision function fit_1_erf_x(x)
|
||||||
implicit none
|
implicit none
|
||||||
double precision, intent(in) :: x
|
double precision, intent(in) :: x
|
||||||
|
@ -1,7 +1,7 @@
|
|||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
double precision function ao_two_e_integral(i,j,k,l)
|
double precision function ao_two_e_integral(i, j, k, l)
|
||||||
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! integral of the AO basis <ik|jl> or (ij|kl)
|
! integral of the AO basis <ik|jl> or (ij|kl)
|
||||||
@ -29,7 +29,7 @@ double precision function ao_two_e_integral(i,j,k,l)
|
|||||||
if(use_cosgtos) then
|
if(use_cosgtos) then
|
||||||
!print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
|
!print *, ' use_cosgtos for ao_two_e_integral ?', use_cosgtos
|
||||||
|
|
||||||
ao_two_e_integral = ao_two_e_integral_cosgtos(i,j,k,l)
|
ao_two_e_integral = ao_two_e_integral_cosgtos(i, j, k, l)
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
||||||
|
183
src/bi_ort_ints/biorthog_mo_for_h.irp.f
Normal file
183
src/bi_ort_ints/biorthog_mo_for_h.irp.f
Normal file
@ -0,0 +1,183 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, ao_two_e_coul, (ao_num, ao_num, ao_num, ao_num) ]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! ao_two_e_coul(k,i,l,j) = ( k i | 1/r12 | l j ) = < l k | 1/r12 | j i >
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
integer :: i, j, k, l
|
||||||
|
double precision :: integral
|
||||||
|
double precision, external :: get_ao_two_e_integral
|
||||||
|
|
||||||
|
PROVIDE ao_integrals_map
|
||||||
|
|
||||||
|
do j = 1, ao_num
|
||||||
|
do l = 1, ao_num
|
||||||
|
do i = 1, ao_num
|
||||||
|
do k = 1, ao_num
|
||||||
|
|
||||||
|
integral = get_ao_two_e_integral(i, j, k, l, ao_integrals_map)
|
||||||
|
|
||||||
|
ao_two_e_coul(k,i,l,j) = integral
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
double precision function bi_ortho_mo_coul_ints(l, k, j, i)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! < mo^L_k mo^L_l | 1/r12 | mo^R_i mo^R_j >
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
integer :: m, n, p, q
|
||||||
|
|
||||||
|
bi_ortho_mo_coul_ints = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do q = 1, ao_num
|
||||||
|
! p1h1p2h2 l1 l2 r1 r2
|
||||||
|
bi_ortho_mo_coul_ints += ao_two_e_coul(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end function bi_ortho_mo_coul_ints
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
! TODO :: transform into DEGEMM
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, mo_bi_ortho_coul_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! mo_bi_ortho_coul_e_chemist(k,i,l,j) = < k l | 1/r12 | i j > where i,j are right MOs and k,l are left MOs
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l, m, n, p, q
|
||||||
|
double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
|
||||||
|
|
||||||
|
allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
|
||||||
|
mo_tmp_1 = 0.d0
|
||||||
|
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do q = 1, ao_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! (k n|p m) = sum_q c_qk * (q n|p m)
|
||||||
|
mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_coul(q,n,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
|
||||||
|
mo_tmp_2 = 0.d0
|
||||||
|
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! (k i|p m) = sum_n c_ni * (k n|p m)
|
||||||
|
mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_1)
|
||||||
|
|
||||||
|
allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
|
||||||
|
mo_tmp_1 = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_2)
|
||||||
|
|
||||||
|
mo_bi_ortho_coul_e_chemist = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
mo_bi_ortho_coul_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_1)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, mo_bi_ortho_coul_e, (mo_num, mo_num, mo_num, mo_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! mo_bi_ortho_coul_e(k,l,i,j) = < k l | 1/r12 | i j > where i,j are right MOs and k,l are left MOs
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l
|
||||||
|
|
||||||
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! < k l | V12 | i j > (k i|l j)
|
||||||
|
mo_bi_ortho_coul_e(k,l,i,j) = mo_bi_ortho_coul_e_chemist(k,i,l,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [ double precision, mo_bi_ortho_one_e, (mo_num, mo_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! mo_bi_ortho_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
call ao_to_mo_bi_ortho( ao_one_e_integrals, ao_num &
|
||||||
|
, mo_bi_ortho_one_e , mo_num )
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
@ -24,12 +24,17 @@ BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
|
|||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! mo_bi_ortho_tc_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
|
!
|
||||||
END_DOC
|
! mo_bi_ortho_tc_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
|
||||||
integer :: i,k,p,q
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
|
call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
|
||||||
|
|
||||||
|
@ -1,138 +1,177 @@
|
|||||||
BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ]
|
|
||||||
integer :: i,j,k,l
|
|
||||||
BEGIN_DOC
|
|
||||||
! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = <lk| V^TC(r_12) |ji> where V^TC(r_12) is the total TC operator
|
|
||||||
!
|
|
||||||
! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION.
|
|
||||||
!
|
|
||||||
! WARNING :: non hermitian ! acts on "the right functions" (i,j)
|
|
||||||
END_DOC
|
|
||||||
double precision :: integral_sym, integral_nsym, get_ao_tc_sym_two_e_pot
|
|
||||||
PROVIDE ao_tc_sym_two_e_pot_in_map
|
|
||||||
do j = 1, ao_num
|
|
||||||
do l = 1, ao_num
|
|
||||||
do i = 1, ao_num
|
|
||||||
do k = 1, ao_num
|
|
||||||
integral_sym = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
|
|
||||||
! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis
|
|
||||||
integral_nsym = ao_non_hermit_term_chemist(k,i,l,j)
|
|
||||||
ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
END_PROVIDER
|
|
||||||
|
|
||||||
|
|
||||||
double precision function bi_ortho_mo_ints(l,k,j,i)
|
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! <mo^L_k mo^L_l | V^TC(r_12) | mo^R_i mo^R_j>
|
|
||||||
!
|
|
||||||
! WARNING :: very naive, super slow, only used to DEBUG.
|
|
||||||
END_DOC
|
|
||||||
integer, intent(in) :: i,j,k,l
|
|
||||||
integer :: m,n,p,q
|
|
||||||
bi_ortho_mo_ints = 0.d0
|
|
||||||
do m = 1, ao_num
|
|
||||||
do p = 1, ao_num
|
|
||||||
do n = 1, ao_num
|
|
||||||
do q = 1, ao_num
|
|
||||||
! p1h1p2h2 l1 l2 r1 r2
|
|
||||||
bi_ortho_mo_ints += ao_two_e_tc_tot(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
! ---
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
|
BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
|
||||||
! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) = <k l|V(r_12)|i j> where i,j are right MOs and k,l are left MOs
|
|
||||||
END_DOC
|
|
||||||
integer :: i,j,k,l,m,n,p,q
|
|
||||||
double precision, allocatable :: mo_tmp_1(:,:,:,:),mo_tmp_2(:,:,:,:),mo_tmp_3(:,:,:,:)
|
|
||||||
|
|
||||||
!! TODO :: transform into DEGEMM
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = <lk| V^TC(r_12) |ji> where V^TC(r_12) is the total TC operator
|
||||||
|
!
|
||||||
|
! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION.
|
||||||
|
!
|
||||||
|
! WARNING :: non hermitian ! acts on "the right functions" (i,j)
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
|
integer :: i, j, k, l
|
||||||
mo_tmp_1 = 0.d0
|
double precision :: integral_sym, integral_nsym
|
||||||
do m = 1, ao_num
|
double precision, external :: get_ao_tc_sym_two_e_pot
|
||||||
do p = 1, ao_num
|
|
||||||
do n = 1, ao_num
|
PROVIDE ao_tc_sym_two_e_pot_in_map
|
||||||
do q = 1, ao_num
|
|
||||||
do k = 1, mo_num
|
do j = 1, ao_num
|
||||||
! (k n|p m) = sum_q c_qk * (q n|p m)
|
do l = 1, ao_num
|
||||||
mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
do i = 1, ao_num
|
||||||
enddo
|
do k = 1, ao_num
|
||||||
|
|
||||||
|
integral_sym = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
|
||||||
|
|
||||||
|
! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis
|
||||||
|
integral_nsym = ao_non_hermit_term_chemist(k,i,l,j)
|
||||||
|
|
||||||
|
ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
|
|
||||||
mo_tmp_2 = 0.d0
|
|
||||||
do m = 1, ao_num
|
|
||||||
do p = 1, ao_num
|
|
||||||
do n = 1, ao_num
|
|
||||||
do i = 1, mo_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
! (k i|p m) = sum_n c_ni * (k n|p m)
|
|
||||||
mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
deallocate(mo_tmp_1)
|
|
||||||
allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
|
|
||||||
mo_tmp_1 = 0.d0
|
|
||||||
do m = 1, ao_num
|
|
||||||
do p = 1, ao_num
|
|
||||||
do l = 1, mo_num
|
|
||||||
do i = 1, mo_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
deallocate(mo_tmp_2)
|
|
||||||
mo_bi_ortho_tc_two_e_chemist = 0.d0
|
|
||||||
do m = 1, ao_num
|
|
||||||
do j = 1, mo_num
|
|
||||||
do l = 1, mo_num
|
|
||||||
do i = 1, mo_num
|
|
||||||
do k = 1, mo_num
|
|
||||||
mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
double precision function bi_ortho_mo_ints(l, k, j, i)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
! <mo^L_k mo^L_l | V^TC(r_12) | mo^R_i mo^R_j>
|
||||||
|
!
|
||||||
|
! WARNING :: very naive, super slow, only used to DEBUG.
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer, intent(in) :: i, j, k, l
|
||||||
|
integer :: m, n, p, q
|
||||||
|
|
||||||
|
bi_ortho_mo_ints = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do q = 1, ao_num
|
||||||
|
! p1h1p2h2 l1 l2 r1 r2
|
||||||
|
bi_ortho_mo_ints += ao_two_e_tc_tot(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
end function bi_ortho_mo_ints
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
! TODO :: transform into DEGEMM
|
||||||
|
|
||||||
|
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) = <k l|V(r_12)|i j> where i,j are right MOs and k,l are left MOs
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: i, j, k, l, m, n, p, q
|
||||||
|
double precision, allocatable :: mo_tmp_1(:,:,:,:), mo_tmp_2(:,:,:,:)
|
||||||
|
|
||||||
|
allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
|
||||||
|
mo_tmp_1 = 0.d0
|
||||||
|
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do q = 1, ao_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! (k n|p m) = sum_q c_qk * (q n|p m)
|
||||||
|
mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
|
||||||
|
mo_tmp_2 = 0.d0
|
||||||
|
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do n = 1, ao_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! (k i|p m) = sum_n c_ni * (k n|p m)
|
||||||
|
mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_1)
|
||||||
|
|
||||||
|
allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
|
||||||
|
mo_tmp_1 = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do p = 1, ao_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_2)
|
||||||
|
|
||||||
|
mo_bi_ortho_tc_two_e_chemist = 0.d0
|
||||||
|
do m = 1, ao_num
|
||||||
|
do j = 1, mo_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m) * mo_tmp_1(k,i,l,m)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
deallocate(mo_tmp_1)
|
||||||
|
|
||||||
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, mo_num)]
|
BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, mo_num)]
|
||||||
implicit none
|
|
||||||
BEGIN_DOC
|
BEGIN_DOC
|
||||||
! mo_bi_ortho_tc_two_e(k,l,i,j) = <k l| V(r_12) |i j> where i,j are right MOs and k,l are left MOs
|
!
|
||||||
!
|
! mo_bi_ortho_tc_two_e(k,l,i,j) = <k l| V(r_12) |i j> where i,j are right MOs and k,l are left MOs
|
||||||
! the potential V(r_12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN
|
!
|
||||||
END_DOC
|
! the potential V(r_12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN
|
||||||
integer :: i,j,k,l
|
!
|
||||||
do j = 1, mo_num
|
END_DOC
|
||||||
do i = 1, mo_num
|
|
||||||
do l = 1, mo_num
|
implicit none
|
||||||
do k = 1, mo_num
|
integer :: i, j, k, l
|
||||||
! (k i|l j) = <k l|V(r_12)|i j>
|
|
||||||
mo_bi_ortho_tc_two_e(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j)
|
do j = 1, mo_num
|
||||||
|
do i = 1, mo_num
|
||||||
|
do l = 1, mo_num
|
||||||
|
do k = 1, mo_num
|
||||||
|
! < k l | V12 | i j > (k i|l j)
|
||||||
|
mo_bi_ortho_tc_two_e(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
enddo
|
enddo
|
||||||
enddo
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
52
src/tc_bi_ortho/compute_deltamu_right.irp.f
Normal file
52
src/tc_bi_ortho/compute_deltamu_right.irp.f
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
program compute_deltamu_right
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
my_grid_becke = .True.
|
||||||
|
my_n_pt_r_grid = 30
|
||||||
|
my_n_pt_a_grid = 50
|
||||||
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
||||||
|
|
||||||
|
read_wf = .True.
|
||||||
|
touch read_wf
|
||||||
|
|
||||||
|
PROVIDE N_int
|
||||||
|
call delta_right()
|
||||||
|
|
||||||
|
end
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine delta_right()
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
integer :: k
|
||||||
|
double precision, allocatable :: delta(:,:)
|
||||||
|
|
||||||
|
print *, j1b_type
|
||||||
|
print *, j1b_pen
|
||||||
|
print *, mu_erf
|
||||||
|
|
||||||
|
allocate( delta(N_det,N_states) )
|
||||||
|
delta = 0.d0
|
||||||
|
|
||||||
|
do k = 1, N_states
|
||||||
|
!do k = 1, 1
|
||||||
|
|
||||||
|
! get < I_left | H_mu - H | psi_right >
|
||||||
|
call get_delta_bitc_right(psi_det, psi_r_coef_bi_ortho(:,k), N_det, N_int, delta(:,k))
|
||||||
|
|
||||||
|
! order as QMCCHEM
|
||||||
|
call dset_order(delta(:,k), psi_bilinear_matrix_order, N_det)
|
||||||
|
|
||||||
|
enddo
|
||||||
|
|
||||||
|
call ezfio_set_dmc_dress_dmc_delta_h(delta)
|
||||||
|
|
||||||
|
deallocate(delta)
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine delta_right
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
54
src/tc_bi_ortho/dressing_vectors_lr.irp.f
Normal file
54
src/tc_bi_ortho/dressing_vectors_lr.irp.f
Normal file
@ -0,0 +1,54 @@
|
|||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine get_delta_bitc_right(psidet, psicoef, ndet, Nint, delta)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! delta(I) = < I_left | H_TC - H | Psi_right >
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: ndet, Nint
|
||||||
|
double precision, intent(in) :: psicoef(ndet)
|
||||||
|
integer(bit_kind), intent(in) :: psidet(Nint,2,ndet)
|
||||||
|
double precision, intent(out) :: delta(ndet)
|
||||||
|
|
||||||
|
integer :: i, j
|
||||||
|
double precision :: h_mono, h_twoe, h_tot
|
||||||
|
double precision :: htc_mono, htc_twoe, htc_three, htc_tot
|
||||||
|
double precision :: delta_mat
|
||||||
|
|
||||||
|
i = 1
|
||||||
|
j = 1
|
||||||
|
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||||
|
call hmat_bi_ortho (psidet(1,1,i), psidet(1,1,j), Nint, h_mono , h_twoe , h_tot)
|
||||||
|
|
||||||
|
delta = 0.d0
|
||||||
|
!$OMP PARALLEL DO DEFAULT(NONE) SCHEDULE(dynamic,8) &
|
||||||
|
!$OMP SHARED(delta, ndet, psidet, psicoef, Nint) &
|
||||||
|
!$OMP PRIVATE(i, j, delta_mat, h_mono, h_twoe, h_tot, &
|
||||||
|
!$OMP htc_mono, htc_twoe, htc_three, htc_tot)
|
||||||
|
do i = 1, ndet
|
||||||
|
do j = 1, ndet
|
||||||
|
|
||||||
|
! < I | Htilde | J >
|
||||||
|
call htilde_mu_mat_bi_ortho(psidet(1,1,i), psidet(1,1,j), Nint, htc_mono, htc_twoe, htc_three, htc_tot)
|
||||||
|
! < I | H | J >
|
||||||
|
call hmat_bi_ortho (psidet(1,1,i), psidet(1,1,j), Nint, h_mono , h_twoe , h_tot)
|
||||||
|
|
||||||
|
delta_mat = htc_tot - h_tot
|
||||||
|
|
||||||
|
delta(i) = delta(i) + psicoef(j) * delta_mat
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
!$OMP END PARALLEL DO
|
||||||
|
|
||||||
|
end subroutine get_delta_bitc_right
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
249
src/tc_bi_ortho/h_biortho.irp.f
Normal file
249
src/tc_bi_ortho/h_biortho.irp.f
Normal file
@ -0,0 +1,249 @@
|
|||||||
|
|
||||||
|
! --
|
||||||
|
|
||||||
|
subroutine hmat_bi_ortho(key_j, key_i, Nint, hmono, htwoe, htot)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! <key_j | H | key_i > where | key_j > is developed on the LEFT basis and | key_i > is developed on the RIGHT basis
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2)
|
||||||
|
double precision, intent(out) :: hmono, htwoe, htot
|
||||||
|
|
||||||
|
integer :: degree
|
||||||
|
|
||||||
|
hmono = 0.d0
|
||||||
|
htwoe = 0.d0
|
||||||
|
htot = 0.d0
|
||||||
|
|
||||||
|
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||||
|
if(degree .gt. 2) return
|
||||||
|
|
||||||
|
if(degree == 0) then
|
||||||
|
|
||||||
|
call diag_hmat_bi_ortho(Nint, key_i, hmono, htwoe)
|
||||||
|
htot = htot + nuclear_repulsion
|
||||||
|
|
||||||
|
else if (degree == 1)then
|
||||||
|
|
||||||
|
call single_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe)
|
||||||
|
|
||||||
|
else if(degree == 2)then
|
||||||
|
|
||||||
|
call double_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
htot += hmono + htwoe
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine hmat_bi_ortho
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine diag_hmat_bi_ortho(Nint, key_i, hmono, htwoe)
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_i(Nint,2)
|
||||||
|
double precision, intent(out) :: hmono, htwoe
|
||||||
|
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
integer :: Ne(2), i, j, ii, jj, ispin, jspin, k, kk
|
||||||
|
integer(bit_kind) :: key_i_core(Nint,2)
|
||||||
|
|
||||||
|
hmono = 0.d0
|
||||||
|
htwoe = 0.d0
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
|
||||||
|
|
||||||
|
do ispin = 1, 2
|
||||||
|
do i = 1, Ne(ispin)
|
||||||
|
ii = occ(i,ispin)
|
||||||
|
hmono += mo_bi_ortho_one_e(ii,ii)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! alpha/beta two-body
|
||||||
|
ispin = 1
|
||||||
|
jspin = 2
|
||||||
|
do i = 1, Ne(ispin) ! electron 1
|
||||||
|
ii = occ(i,ispin)
|
||||||
|
do j = 1, Ne(jspin) ! electron 2
|
||||||
|
jj = occ(j,jspin)
|
||||||
|
htwoe += mo_bi_ortho_coul_e(jj,ii,jj,ii)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! alpha/alpha two-body
|
||||||
|
do i = 1, Ne(ispin)
|
||||||
|
ii = occ(i,ispin)
|
||||||
|
do j = i+1, Ne(ispin)
|
||||||
|
jj = occ(j,ispin)
|
||||||
|
htwoe += mo_bi_ortho_coul_e(ii,jj,ii,jj) - mo_bi_ortho_coul_e(ii,jj,jj,ii)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
! beta/beta two-body
|
||||||
|
do i = 1, Ne(jspin)
|
||||||
|
ii = occ(i,jspin)
|
||||||
|
do j = i+1, Ne(jspin)
|
||||||
|
jj = occ(j,jspin)
|
||||||
|
htwoe += mo_bi_ortho_coul_e(ii,jj,ii,jj) - mo_bi_ortho_coul_e(ii,jj,jj,ii)
|
||||||
|
enddo
|
||||||
|
enddo
|
||||||
|
|
||||||
|
return
|
||||||
|
end subroutine diag_hmat_bi_ortho
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine single_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! < key_j | H | key_i > for single excitation
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_j(Nint,2), key_i(Nint,2)
|
||||||
|
double precision, intent(out) :: hmono, htwoe
|
||||||
|
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
integer :: Ne(2), i, j, ii, jj, ispin, jspin, k, kk
|
||||||
|
integer :: degree,exc(0:2,2,2)
|
||||||
|
integer :: h1, p1, h2, p2, s1, s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
integer(bit_kind) :: key_j_core(Nint,2), key_i_core(Nint,2)
|
||||||
|
double precision :: phase
|
||||||
|
double precision :: direct_int, exchange_int_12, exchange_int_23, exchange_int_13
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
hmono = 0.d0
|
||||||
|
htwoe = 0.d0
|
||||||
|
|
||||||
|
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||||
|
if(degree .ne. 1) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
|
||||||
|
|
||||||
|
call get_single_excitation(key_i, key_j, exc, phase, Nint)
|
||||||
|
call decode_exc(exc, 1, h1, p1, h2, p2, s1, s2)
|
||||||
|
|
||||||
|
hmono = mo_bi_ortho_one_e(p1,h1) * phase
|
||||||
|
|
||||||
|
! alpha/beta two-body
|
||||||
|
ispin = other_spin(s1)
|
||||||
|
if(s1 == 1) then
|
||||||
|
|
||||||
|
! single alpha
|
||||||
|
do i = 1, Ne(ispin) ! electron 2
|
||||||
|
ii = occ(i,ispin)
|
||||||
|
htwoe += mo_bi_ortho_coul_e(ii,p1,ii,h1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
! single beta
|
||||||
|
do i = 1, Ne(ispin) ! electron 1
|
||||||
|
ii = occ(i,ispin)
|
||||||
|
htwoe += mo_bi_ortho_coul_e(p1,ii,h1,ii)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
! same spin two-body
|
||||||
|
do i = 1, Ne(s1)
|
||||||
|
ii = occ(i,s1)
|
||||||
|
! ( h1 p1 |ii ii ) - ( h1 ii | p1 ii )
|
||||||
|
htwoe += mo_bi_ortho_coul_e(ii,p1,ii,h1) - mo_bi_ortho_coul_e(p1,ii,ii,h1)
|
||||||
|
enddo
|
||||||
|
|
||||||
|
htwoe *= phase
|
||||||
|
|
||||||
|
end subroutine single_hmat_bi_ortho
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
subroutine double_hmat_bi_ortho(Nint, key_j, key_i, hmono, htwoe)
|
||||||
|
|
||||||
|
BEGIN_DOC
|
||||||
|
!
|
||||||
|
! < key_j | H | key_i> for double excitation
|
||||||
|
!
|
||||||
|
END_DOC
|
||||||
|
|
||||||
|
use bitmasks
|
||||||
|
|
||||||
|
implicit none
|
||||||
|
|
||||||
|
integer, intent(in) :: Nint
|
||||||
|
integer(bit_kind), intent(in) :: key_j(Nint,2), key_i(Nint,2)
|
||||||
|
double precision, intent(out) :: hmono, htwoe
|
||||||
|
|
||||||
|
integer :: occ(Nint*bit_kind_size,2)
|
||||||
|
integer :: Ne(2), i, j, ii, jj, ispin, jspin, k, kk
|
||||||
|
integer :: degree,exc(0:2,2,2)
|
||||||
|
integer :: h1, p1, h2, p2, s1, s2
|
||||||
|
integer :: other_spin(2)
|
||||||
|
integer(bit_kind) :: key_i_core(Nint,2)
|
||||||
|
double precision :: phase
|
||||||
|
|
||||||
|
other_spin(1) = 2
|
||||||
|
other_spin(2) = 1
|
||||||
|
|
||||||
|
call get_excitation_degree(key_i, key_j, degree, Nint)
|
||||||
|
|
||||||
|
hmono = 0.d0
|
||||||
|
htwoe = 0.d0
|
||||||
|
|
||||||
|
if(degree .ne. 2) then
|
||||||
|
return
|
||||||
|
endif
|
||||||
|
|
||||||
|
call bitstring_to_list_ab(key_i, occ, Ne, Nint)
|
||||||
|
|
||||||
|
call get_double_excitation(key_i, key_j, exc, phase, Nint)
|
||||||
|
call decode_exc(exc, 2, h1, p1, h2, p2, s1, s2)
|
||||||
|
|
||||||
|
if(s1.ne.s2) then
|
||||||
|
|
||||||
|
htwoe = mo_bi_ortho_coul_e(p2,p1,h2,h1)
|
||||||
|
|
||||||
|
else
|
||||||
|
|
||||||
|
! same spin two-body
|
||||||
|
|
||||||
|
! direct terms
|
||||||
|
htwoe = mo_bi_ortho_coul_e(p2,p1,h2,h1)
|
||||||
|
! exchange terms
|
||||||
|
htwoe -= mo_bi_ortho_coul_e(p1,p2,h2,h1)
|
||||||
|
|
||||||
|
endif
|
||||||
|
|
||||||
|
htwoe *= phase
|
||||||
|
|
||||||
|
end subroutine double_hmat_bi_ortho
|
||||||
|
|
||||||
|
! ---
|
||||||
|
|
||||||
|
|
@ -24,7 +24,7 @@ subroutine htilde_mu_mat_bi_ortho_tot(key_j, key_i, Nint, htot)
|
|||||||
call htilde_mu_mat_bi_ortho(key_j,key_i, Nint, hmono,htwoe,hthree,htot)
|
call htilde_mu_mat_bi_ortho(key_j,key_i, Nint, hmono,htwoe,hthree,htot)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
end subroutine htilde_mu_mat_tot
|
end subroutine htilde_mu_mat_bi_ortho_tot
|
||||||
|
|
||||||
! --
|
! --
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user