1C> \ingroup selci
2C> @{
3C>
4      subroutine selci_eijeji(e,odonly,i,j,ns,indbar,iocc,w1,w2,work)
5*
6* $Id$
7*
8#include "implicit.fh"
9#include "errquit.fh"
10#include "ciinfo.fh"
11      dimension e(*),indbar(*),iocc(*),work(*),
12     $     w1(nfmax,nfmax,nsmax),w2(nfmax2,nfmax,nsmax-1)
13      logical odonly
14c
15      parameter (maxtmp = 2001)
16      dimension tmp(maxtmp)
17c
18c     e(u,v) = <Iu|EijEji|Iv>, where u,v label the spin functions
19c     and the orbital occupation of I is specified by ns, iocc
20c     and indbar. Only for i.ne.j., and both i and j singly
21c     occupied.
22c
23c     if (odonly) only form the actual diagonal ... THE REST IS JUNK
24c     (this to optimize select)
25c
26c     e(u,v) = sum(q) <Iu|Eij|Sq><Sq|Eji|Iv>
27c
28c     work must be at least nf(ns)*nf(ns-2)
29c     e is at least nf(ns)*nf(ns)
30c
31      if (iocc(i).ne.1 .or. iocc(j).ne.1)
32     $     call errquit('eijeji: wrong occupancy',iocc(i)*10+iocc(j),
33     &       INPUT_ERR)
34c
35      call selci_eij(work,i,j,ns,indbar,iocc,w1,w2)
36c
37      numf = nf(ns)
38      numf2 = nf(ns-2)
39c
40      if (odonly) then
41         if (numf .gt. maxtmp) call errquit
42     $        ('eijeji: hard dim failed',maxtmp, CALC_ERR)
43         do k = 1, numf
44            tmp(k) = 0.0d0
45         enddo
46         mm = 0
47         do m = 1, numf2
48            do k = 1, numf
49               wkm = work(k+mm)
50               tmp(k) = tmp(k) + wkm*wkm
51            enddo
52            mm = mm + numf
53         enddo
54         kk = 1
55         numfp1 = numf + 1
56         do k = 1, numf
57            e(kk) = tmp(k)
58            kk = kk + numfp1
59         enddo
60      else
61         call selci_axbt(work,numf,work,numf,e,numf,numf,numf2,numf)
62      endif
63c
64      end
65C>
66C> @}
67