subroutine get_s2(key_i,key_j,phase,Nint) implicit none BEGIN_DOC ! Returns END_DOC integer, intent(in) :: Nint integer, intent(in) :: key_i(Nint,2) integer, intent(in) :: key_j(Nint,2) double precision, intent(out) :: phase integer :: exc(0:2,2,2) integer :: degree double precision :: phase_spsm integer :: nup, i phase = 0.d0 !$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_spsm,Nint) if (exc(0,1,1) == 1) then ! Mono alpha + mono-beta if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then phase = -phase_spsm endif endif case(0) nup = 0 do i=1,Nint nup += popcnt(iand(xor(key_i(i,1),key_i(i,2)),key_i(i,1))) enddo phase = dble(nup) end select end