!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!                                                                      *
! Copyright (C) 1996-2006, Thorstein Thorsteinsson                     *
!               1996-2006, David L. Cooper                             *
!***********************************************************************

subroutine projspn_cvb(bikcof,nel,nalf,nbet,ndet,ifns)

use stdalloc, only: mma_allocate, mma_deallocate
use Constants, only: One
use Definitions, only: wp, iwp

implicit none
integer(kind=iwp), intent(in) :: nel, nalf, nbet, ndet, ifns
real(kind=wp), intent(inout) :: bikcof(ndet,ifns)
integer(kind=iwp) :: i, inddet, indx, iorb, iswp, rc
logical(kind=iwp) :: done, first
integer(kind=iwp), allocatable :: ialfa(:), iw(:), lnocca(:), lnoswp(:), locca(:), locswp(:), maxalf(:), maxspn(:), minalf(:), &
                                  minspn(:), nkalf(:), nkspn(:), xdet(:,:), xspin(:)
real(kind=wp), allocatable :: detphase(:)
integer(kind=iwp), external :: minind_cvb

call mma_allocate(minalf,[0,nel],label='minalf')
call mma_allocate(maxalf,[0,nel],label='maxalf')
call mma_allocate(nkalf,[0,nel],label='nkalf')
call mma_allocate(minspn,[0,nel],label='minspn')
call mma_allocate(maxspn,[0,nel],label='maxspn')
call mma_allocate(nkspn,[0,nel],label='nkspn')
call mma_allocate(locswp,2*nbet,label='locswp')
call mma_allocate(lnoswp,2*nbet,label='lnoswp')
call mma_allocate(locca,nel,label='locca')
call mma_allocate(lnocca,nel,label='lnocca')
call mma_allocate(ialfa,nalf,label='ialfa')
call mma_allocate(xdet,[0,nel],[0,nalf],label='xdet')
call mma_allocate(xspin,(nel+1)*(nalf+1),label='xspin')
call mma_allocate(iw,nel,label='iw')
call mma_allocate(detphase,ndet,label='detphase')

! Phase factors between alpha-beta separated determinants
! and determinants with ascending orbital numbers
detphase(:) = One
call asc2ab_cvb(detphase,1,nel,nalf)

! Projected spin functions (generated by orbital permutations on the first Kotani function)

! Set up maximum and minimum of spin functions:
do iorb=0,nel
  minspn(iorb) = iorb-min(iorb/2,nbet)
  maxspn(iorb) = min(iorb,nalf)
end do
call weight_cvb(xspin,minspn,maxspn,nalf,nel)

nkspn(:) = maxspn(:)
call occupy_cvb(nkspn,nel,iw,iw(nalf+1))
! Set up maximum and minimum for determinants:
do iorb=0,nel
  minalf(iorb) = max(iorb-nbet,0)
  maxalf(iorb) = min(iorb,nalf)
end do
call weight_cvb(xdet,minalf,maxalf,nalf,nel)
nkalf(:) = maxalf(:)
call occupy_cvb(nkalf,nel,locca,lnocca)
call mma_deallocate(locca)
call mma_deallocate(lnocca)
! Loop:
indx = 1
first = .true.
do
  ! Skip first function
  if (first) then
    first = .false.
  else
    inddet = 1
    ! MAXSPN contains same elements as MAXALF
    nkalf(:) = maxspn(:)
    call occupy_cvb(nkalf,nel,locswp,lnoswp)
    do
      do i=1,nalf
        ialfa(i) = iw(locswp(i))
      end do
      do
        done = .false.
        do i=2,nalf
          if (ialfa(i) < ialfa(i-1)) then
            iswp = ialfa(i-1)
            ialfa(i-1) = ialfa(i)
            ialfa(i) = iswp
            done = .true.
            exit
          end if
        end do
        if (.not. done) exit
      end do
      bikcof(minind_cvb(ialfa,nalf,nel,xdet),indx) = bikcof(inddet,1)*detphase(inddet)*detphase(minind_cvb(ialfa,nalf,nel,xdet))
      call loind_cvb(nel,nalf,nkalf,minalf,maxalf,locswp,lnoswp,inddet,xdet,rc)
      if (rc == 0) exit
    end do
  end if
  call loind_cvb(nel,nalf,nkspn,minspn,maxspn,iw,iw(nalf+1),indx,xspin,rc)
  if (rc == 0) exit
end do

call mma_deallocate(minalf)
call mma_deallocate(maxalf)
call mma_deallocate(nkalf)
call mma_deallocate(minspn)
call mma_deallocate(maxspn)
call mma_deallocate(nkspn)
call mma_deallocate(locswp)
call mma_deallocate(lnoswp)
call mma_deallocate(ialfa)
call mma_deallocate(xdet)
call mma_deallocate(xspin)
call mma_deallocate(iw)
call mma_deallocate(detphase)

return

end subroutine projspn_cvb
