1      subroutine ga_get_diagonal(g_a, diags)
2C$Id$
3      implicit none
4#include "errquit.fh"
5#include "global.fh"
6#include "mafdecls.fh"
7      integer g_a
8      double precision diags(*)
9c
10c     Extract out the diagonal elements of the
11c     real global array  in a 'scalable' fashion
12c
13c     Everyone ends up with the diagonal.
14c
15      integer ma_type, dim1, dim2, n
16      integer i, ilo, ihi, jlo, jhi
17c
18      call ga_sync
19c
20      call ga_inquire(g_a, ma_type, dim1, dim2)
21      if (ma_type.ne.mt_dbl .or. dim1.ne.dim2) call errquit
22     $     ('ga_get_diagonal: array is not square/real', g_a, GA_ERR)
23      n = dim1
24c
25      call dfill(n, 0.0d0, diags, 1)
26c
27c     Extract out the diags local to each process
28c
29      call ga_distribution(g_a, ga_nodeid(), ilo, ihi, jlo, jhi)
30      if (ilo.gt.0 .and. jlo.gt.0) then
31         ilo = max(ilo,jlo)
32         ihi = min(ihi,jhi)
33         do i = ilo,ihi
34            call ga_get(g_a, i, i, i, i, diags(i), 1)
35         enddo
36      endif
37c
38      call ga_dgop(333, diags, n, '+')
39c
40      end
41