2023-02-06 19:26:58 +01:00
|
|
|
|
|
|
|
|
! ---
|
|
|
|
|
|
|
|
|
|
program tc_petermann_factor
|
|
|
|
|
|
|
|
|
|
BEGIN_DOC
|
|
|
|
|
! TODO : Put the documentation of the program here
|
|
|
|
|
END_DOC
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
my_grid_becke = .True.
|
2023-07-02 21:49:25 +02:00
|
|
|
PROVIDE tc_grid1_a tc_grid1_r
|
|
|
|
|
my_n_pt_r_grid = tc_grid1_r
|
|
|
|
|
my_n_pt_a_grid = tc_grid1_a
|
2023-02-06 19:26:58 +01:00
|
|
|
touch my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
|
|
|
|
|
|
|
|
|
|
call main()
|
|
|
|
|
|
|
|
|
|
end
|
|
|
|
|
|
|
|
|
|
! ---
|
|
|
|
|
|
|
|
|
|
subroutine main()
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
integer :: i, j
|
|
|
|
|
double precision :: Pf_diag_av
|
|
|
|
|
double precision, allocatable :: Sl(:,:), Sr(:,:), Pf(:,:)
|
|
|
|
|
|
|
|
|
|
allocate(Sl(mo_num,mo_num), Sr(mo_num,mo_num), Pf(mo_num,mo_num))
|
|
|
|
|
|
2023-09-22 16:26:58 +02:00
|
|
|
|
|
|
|
|
call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_r_coef, Sl)
|
|
|
|
|
!call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
|
|
|
|
|
! , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
|
|
|
|
! , 0.d0, Sl, size(Sl, 1) )
|
|
|
|
|
|
|
|
|
|
print *, ''
|
|
|
|
|
print *, ' left-right orthog matrix:'
|
|
|
|
|
do i = 1, mo_num
|
|
|
|
|
write(*,'(100(F8.4,X))') Sl(:,i)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
call LTxSxR(ao_num, mo_num, mo_l_coef, ao_overlap, mo_l_coef, Sl)
|
|
|
|
|
!call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
|
|
|
|
|
! , mo_l_coef, size(mo_l_coef, 1), mo_l_coef, size(mo_l_coef, 1) &
|
|
|
|
|
! , 0.d0, Sl, size(Sl, 1) )
|
2023-02-06 19:26:58 +01:00
|
|
|
|
|
|
|
|
print *, ''
|
|
|
|
|
print *, ' left-orthog matrix:'
|
|
|
|
|
do i = 1, mo_num
|
|
|
|
|
write(*,'(100(F8.4,X))') Sl(:,i)
|
|
|
|
|
enddo
|
|
|
|
|
|
2023-09-22 16:26:58 +02:00
|
|
|
call LTxSxR(ao_num, mo_num, mo_r_coef, ao_overlap, mo_r_coef, Sr)
|
|
|
|
|
! call dgemm( "T", "N", mo_num, mo_num, ao_num, 1.d0 &
|
|
|
|
|
! , mo_r_coef, size(mo_r_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
|
|
|
|
|
! , 0.d0, Sr, size(Sr, 1) )
|
2023-02-06 19:26:58 +01:00
|
|
|
|
|
|
|
|
print *, ''
|
|
|
|
|
print *, ' right-orthog matrix:'
|
|
|
|
|
do i = 1, mo_num
|
|
|
|
|
write(*,'(100(F8.4,X))') Sr(:,i)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
print *, ''
|
|
|
|
|
print *, ' Petermann matrix:'
|
|
|
|
|
do i = 1, mo_num
|
|
|
|
|
do j = 1, mo_num
|
|
|
|
|
Pf(j,i) = Sl(j,i) * Sr(j,i)
|
|
|
|
|
enddo
|
|
|
|
|
write(*,'(100(F8.4,X))') Pf(:,i)
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
|
Pf_diag_av = 0.d0
|
|
|
|
|
do i = 1, mo_num
|
|
|
|
|
Pf_diag_av = Pf_diag_av + Pf(i,i)
|
|
|
|
|
enddo
|
|
|
|
|
Pf_diag_av = Pf_diag_av / dble(mo_num)
|
|
|
|
|
|
|
|
|
|
print *, ''
|
|
|
|
|
print *, ' mean of the diagonal Petermann factor = ', Pf_diag_av
|
|
|
|
|
|
|
|
|
|
deallocate(Sl, Sr, Pf)
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
end subroutine
|
|
|
|
|
|
|
|
|
|
! ---
|
|
|
|
|
|
