******************************************************************************** * * * 2DHF version 1-2003 * * Copyright (C) 1996 Jacek Kobus, Leif Laaksonen, Dage Sundholm * * * * This software may be used and distributed according to the terms * * of the GNU General Public License, see README and COPYING. * * * ******************************************************************************** c ### exocc ### c c Calculates the number of alpha and beta electrons for a given orbital. c subroutine exocc (iorb,ocup,ocdown) implicit integer*4 (i-n) implicit real*8 (a-h,o-z) character*8 alpha,beta include 'commons8.inc' data alpha,beta /'+','-'/ ocup =0.d0 ocdown=0.d0 ipe =mgx(6,iorb) ip=4*(iorb-1) if(ipe.eq.0) then iend=2 else iend=4 endif do i=1,iend if(spin(ip+i).ne.alpha.and.spin(ip+i).ne.beta) goto 10 if(spin(ip+i).eq.alpha) ocup =ocup+1.d0 if(spin(ip+i).eq.beta ) ocdown=ocdown+1.d0 00010 continue enddo return end