1      subroutine densid(dt,dold,dos,nsym,nosh,ncsh,nccup,c,damp,nconv,
2     x                 nbas,nitscf,tlarge)
3c.......................................................................
4c
5c     driver routine for density matrix processing
6c.......................................................................
7C$Id$
8      implicit none
9c
10      real *8 dt(*), dold(*), dos(*), c(*)
11      real *8 damp, tlarge
12      integer ncsh(*), nosh(*), nccup(*),  nbas(*)
13      integer nsym, nconv, nitscf
14c
15      real *8 vamp1, vamp2, occucl, occuop, ddiff
16      integer k, nstep1, nstep2, nbas1, icount
17      integer i, m, n, j
18c
19      nstep1 = 1
20      nstep2 = 1
21      k = 0
22      vamp1 = 1.0d0
23      vamp2 = 0.0d0
24      if (nitscf.gt.1 .and. nconv.eq.0) vamp1 = 1.0d0 - damp
25      if (nitscf.gt.1 .and. nconv.eq.0) vamp2 = damp
26      do i = 1 , nsym
27         occucl = 4*i - 2
28         occuop = nccup(i)
29         nbas1 = nbas(i)
30         do m = 1 , nbas1
31            do n = 1 , m
32               k = k + 1
33               dt(k) = 0.0d0
34               dos(k) = 0.0d0
35            enddo
36         enddo
37         if (ncsh(i).ne.0) call denmad(dt(nstep1),c(nstep2),ncsh(i),
38     +                                 nbas1,occucl,1)
39         if (nosh(i).ne.0) call denmad(dos(nstep1),c(nstep2),nosh(i),
40     +                                 nbas1,occuop,ncsh(i)+1)
41         nstep1 = nstep1 + nbas1*(nbas1+1)/2
42         nstep2 = nstep2 + nbas1**2
43      enddo
44      tlarge = 0.0d0
45      icount = 0
46      do i = 1 , nsym
47         do j = 1 , nbas(i)
48            do k = 1 , j
49               icount = icount + 1
50               dt(icount) = (dt(icount)+dos(icount))
51     +                      *vamp1 + dold(icount)*vamp2
52               ddiff = dabs(dt(icount)-dold(icount))
53               dold(icount) = dt(icount)
54               if (ddiff.gt.tlarge) then
55                  tlarge = ddiff
56               end if
57            enddo
58         enddo
59      enddo
60      return
61      end
62