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