20
20
integer ma_type, dim1, dim2, n
21
21
integer i, j, ilo, ihi, jlo, jhi
22
22
double precision number
23
double complex znumber
25
26
call ga_inquire(g_a, ma_type, dim1, dim2)
26
if (ma_type.ne.mt_dbl) then
27
write(0,*) ' ma_type ',ma_type,' mt_dbl ',mt_dbl
27
if (ma_type.eq.mt_dbl) then
28
else if (ma_type.eq.mt_dcpl) then
30
write(0,*) ' ma_type ',ma_type,' mt_dbl ',mt_dbl
31
write(0,*) ' ma_type ',ma_type,' mt_dcpl ',mt_dcpl
29
$ ('ga_trace_diagonal: array is not real', g_a,0)
33
$ ('ga_trace_diagonal: array is not real nor complex ', g_a,0)
35
39
call ga_distribution(g_a, ga_nodeid(), ilo, ihi, jlo, jhi)
36
40
if (ilo.gt.0 .and. jlo.gt.0) then
39
call ga_get(g_a, i, i, j, j, number, 1)
40
number = number*vector(i)
41
call ga_put(g_a,i, i, j, j, number, 1)
41
if (ma_type.eq.MT_DBL) then
44
call ga_get(g_a, i, i, j, j, number, 1)
45
number = number*vector(i)
46
call ga_put(g_a,i, i, j, j, number, 1)
49
else if (ma_type.eq.MT_DCPL) then
52
call ga_get(g_a, i, i, j, j, znumber, 1)
53
znumber = znumber*vector(i)
54
call ga_put(g_a,i, i, j, j, znumber, 1)