9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-23 20:13:42 +01:00
qp2/plugins/local/tc_progs/tc_bi_ortho_prop.irp.f
2024-05-07 18:27:09 +02:00

53 lines
941 B
Fortran

! ---
program tc_bi_ortho_prop
BEGIN_DOC
! TODO : Put the documentation of the program here
END_DOC
implicit none
print *, 'Hello world'
my_grid_becke = .True.
PROVIDE tc_grid1_a tc_grid1_r
my_n_pt_r_grid = tc_grid1_r
my_n_pt_a_grid = tc_grid1_a
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
read_wf = .True.
touch read_wf
!call routine_diag
call test
end
! ---
subroutine test
implicit none
integer :: i
print*,'TC Dipole components'
do i= 1, 3
print*,tc_bi_ortho_dipole(i,1)
enddo
integer, allocatable :: occ(:,:)
integer :: n_occ_ab(2)
allocate(occ(N_int*bit_kind_size,2))
call bitstring_to_list_ab(ref_bitmask, occ, n_occ_ab, N_int)
integer :: ispin,j,jorb
double precision :: accu
accu = 0.d0
do ispin=1, 2
do i = 1, n_occ_ab(ispin)
jorb = occ(i,ispin)
accu += mo_bi_orth_bipole_z(jorb,jorb)
enddo
enddo
print*,'accu = ',accu
end