************************************************************************
* 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, T. Thorsteinsson and D. L. Cooper           *
************************************************************************
      subroutine projspn_cvb(bikcof,
     > nel,nalf,nbet,ndet,ifns,
     > minalf,maxalf,nkalf,minspn,maxspn,nkspn,
     > locswp,lnoswp,locca,lnocca,ialfa,
     > xdet,xspin,iwork,detphase)
      implicit real*8 (a-h,o-w,y-z),integer(x)
      dimension bikcof(ndet,ifns)
      dimension minalf(0:nel), maxalf(0:nel), nkalf(0:nel)
      dimension minspn(0:nel), maxspn(0:nel), nkspn(0:nel)
      dimension locswp(2*nbet), lnoswp(2*nbet), locca(nel), lnocca(nel)
      dimension ialfa(nalf),xdet(0:nel,0:nalf),xspin((nel+1)*(nalf+1))
      dimension iwork(nel),detphase(ndet)

c  Phase factors between alpha-beta separated determinants
c  and determinants with ascending orbital numbers
      call dfill(ndet,1d0,detphase,1)
      call asc2ab_cvb(detphase,1,nel,nalf)
c
c Projected spin functions (generated by orbital permutations
c                           on the first Kotani function)
c
c Set up maximum and minimum of spin functions:
      do 2000 iorb=0,nel
      minspn(iorb)=iorb-min(iorb/2,nbet)
2000  maxspn(iorb)=min(iorb,nalf)
      call weight_cvb(xspin,minspn,maxspn,nalf,nel)

      call imove_cvb(maxspn,nkspn,nel+1)
      call occupy_cvb(nkspn,nel,iwork,iwork(nalf+1))
c Set up maximum and minimum for determinants :
      do 2100 iorb=0,nel
      minalf(iorb)=max(iorb-nbet,0)
2100  maxalf(iorb)=min(iorb,nalf)
      call weight_cvb(xdet,minalf,maxalf,nalf,nel)
      call imove_cvb(maxalf,nkalf,nel+1)
      call occupy_cvb(nkalf,nel,locca,lnocca)
c Loop:
      index=1
c  Skip first function
      goto 2200
2300  inddet=1
c MAXSPN contains same elements as MAXALF
      call imove_cvb(maxspn,nkalf,nel+1)
      call occupy_cvb(nkalf,nel,locswp,lnoswp)
2400  continue
      do 2500 i=1,nalf
2500  ialfa(i)=iwork(locswp(i))
2600  continue
      do 2700 i=2,nalf
        if(ialfa(i).lt.ialfa(i-1))then
          iswp=ialfa(i-1)
          ialfa(i-1)=ialfa(i)
          ialfa(i)=iswp
          goto 2600
        endif
2700  continue
      bikcof(minind_cvb(ialfa,nalf,nel,xdet),index)=bikcof(inddet,1)
     >  *detphase(inddet)*detphase(minind_cvb(ialfa,nalf,nel,xdet))
      call loind_cvb(nel,nalf,nkalf,minalf,maxalf,
     >                     locswp,lnoswp,inddet,xdet,*2400)
2200  call loind_cvb(nel,nalf,nkspn,minspn,maxspn,
     >                     iwork,iwork(nalf+1),index,xspin,*2300)
      return
      end
