BEGIN_PROVIDER [ integer, det_num ] implicit none BEGIN_DOC ! Number of determinants END_DOC det_num = 1 call get_determinants_det_num(det_num) if (det_num < 1) then call abrt(irp_here,'det_num should be > 0') endif END_PROVIDER BEGIN_PROVIDER [ integer, det, (elec_alpha_num-mo_closed_num,det_num,2) ] &BEGIN_PROVIDER [ real, det_coef, (det_num) ] implicit none BEGIN_DOC ! det : Description of the active orbitals of the determinants ! det_coef : Determinant coefficients END_DOC if (elec_alpha_num > mo_closed_num) then det = 0 call get_determinants_det_occ(det) endif det_coef = 0. det_coef(1) = 1. call get_determinants_det_coef(det_coef) END_PROVIDER BEGIN_PROVIDER [ integer, det_exc, (det_num, det_num, 3) ] implicit none BEGIN_DOC ! Degree of excitation between two determinants. The sign is the phase. END_DOC integer :: p do p=1,2 integer :: k, l do l=1,det_num det_exc(l,l,p) = 0 do k=l+1,det_num det_exc(k,l,p) = 0 ! Excitation degree integer :: i, j do i=1,elec_num_2(p)-mo_closed_num logical :: found found = .False. do j=1,elec_num_2(p)-mo_closed_num if (det(j,l,p) == det(i,k,p)) then found = .True. exit endif enddo if (.not.found) then det_exc(k,l,p) += 1 endif enddo det_exc(l,k,p) = det_exc(k,l,p) enddo enddo enddo do l=1,det_num do k=l+1,det_num det_exc(k,l,3) = det_exc(k,l,1) + det_exc(k,l,2) enddo enddo ! Phase do p=1,2 do i=mo_closed_num,mo_num integer :: det_pos(det_num) do k=1,det_num det_pos(k) = 0 do j=1,elec_num_2(p)-mo_closed_num if (det(j,k,p) == i) then det_pos(k) = j endif enddo enddo do k=1,det_num do l=k+1,det_num det_exc(k,l,3) *= -2*mod( (det_pos(k)+det_pos(l)), 2 )+1 enddo enddo enddo enddo do l=1,det_num do k=l+1,det_num det_exc(l,k,3) = det_exc(k,l,3) enddo enddo END_PROVIDER subroutine get_single_excitation(k,l,m,n,p) implicit none integer, intent(in) :: k, l ! determinant indices integer, intent(out) :: m, n ! m->n excitation integer, intent(in) :: p ! spin logical :: found integer :: i,j m=0 n=0 do j=1,elec_num_2(p)-mo_closed_num found = .False. do i=1,elec_num_2(p)-mo_closed_num if (det(j,k,p) == det(i,l,p)) then found = .True. exit endif enddo if (.not.found) then m = det(j,k,p) exit endif enddo do i=1,elec_num_2(p)-mo_closed_num found = .False. do j=1,elec_num_2(p)-mo_closed_num if (det(i,k,p) == det(i,l,p)) then found = .True. exit endif enddo if (.not.found) then n = det(i,l,p) exit endif enddo end subroutine get_double_excitation(k,l,m,n,r,s,p) implicit none integer, intent(in) :: k, l ! determinant indices integer, intent(out) :: m, n ! m->n excitation integer, intent(out) :: r, s ! r->s excitation integer, intent(in) :: p ! spin logical :: found integer :: i,j m=0 n=0 r=0 s=0 do j=1,elec_num_2(p)-mo_closed_num found = .False. do i=1,elec_num_2(p)-mo_closed_num if (det(j,k,p) == det(i,l,p)) then found = .True. exit endif enddo if (.not.found) then if (m == 0) then m = det(j,k,p) else r = det(j,k,p) exit endif endif enddo do i=1,elec_num_2(p)-mo_closed_num found = .False. do j=1,elec_num_2(p)-mo_closed_num if (det(i,k,p) == det(i,l,p)) then found = .True. exit endif enddo if (.not.found) then if (n == 0) then n = det(i,l,p) else s = det(i,l,p) exit endif endif enddo end