1      subroutine xc_sicinit(rtdb, test_sic, condfukui, exact_pot,
2     &                      l_degen, i_degen, noc, act_levels)
3      implicit none
4#include "errquit.fh"
5c
6c     $Id$
7c
8#include "rtdb.fh"
9#include "mafdecls.fh"
10#include "global.fh"
11#include "util.fh"
12      integer l_degen, i_degen(2), noc(2), tot_oc, act_levels
13      integer rtdb ! [in]
14      integer test_sic,condfukui,exact_pot ! [out]
15c
16c
17      if (.not. rtdb_get(rtdb, 'dft:test_sic', mt_int, 1,
18     &     test_sic))test_sic = 0
19      if (.not. rtdb_get(rtdb, 'dft:condfukui', mt_int, 1,
20     &   condfukui)) condfukui = 0
21      if (.not. rtdb_get(rtdb, 'dft:exact_pot', mt_int, 1,
22     &   exact_pot)) exact_pot = 0
23      if (test_sic.ne.0) then
24        if (.not. rtdb_get(rtdb, 'dft:act_levels', mt_int, 1,
25     &      act_levels)) act_levels = 10000
26        tot_oc = noc(1) + noc(2)
27        if (.not.MA_Push_Get(MT_Int, tot_oc, 'degen_homo',
28     &     l_degen, i_degen(1)))
29     &     call errquit('dft_scf: cannot allocate degen homo',0, MA_ERR)
30      end if
31      return
32      end
33      subroutine xc_sicdeg(i_degen, evals, n_levels, act_levels)
34      implicit none
35#include "mafdecls.fh"
36#include "cdft.fh"
37c
38      integer i_degen(2), evals(2), n_levels(2)
39c
40      integer isp, j, aux_levels, n_orbitals, act_levels
41      double precision start
42      do isp=1,ipol
43         if (isp.eq.2) i_degen(2) = i_degen(1) + noc(1)
44         if (noc(isp).ne.0) then
45           aux_levels = 1
46           n_orbitals = 1
47           Int_MB(i_degen(isp) + aux_levels - 1) = n_orbitals
48           do j = noc(isp),2,-1
49             start = (dbl_mb(evals(isp) + j - 1) -
50     &                dbl_mb(evals(isp) + j - 2))
51             if (start.le.1.0d-04) then
52               n_orbitals = n_orbitals + 1
53             else
54               n_orbitals = 1
55               aux_levels = aux_levels + 1
56             end if
57             Int_MB(i_degen(isp) + aux_levels - 1) = n_orbitals
58           end do
59           n_levels(isp) = aux_levels
60         else
61           n_levels(isp) = 0
62         end if
63      end do
64      do isp = 1, ipol
65        if (n_levels(isp).ne.0) then
66          if(n_levels(isp).gt.act_levels) n_levels(isp) = act_levels
67        end if
68      end do
69      return
70      end
71