1      Subroutine scat_mat(TT,T,Ni,Nj,mi,mj,ifirst,jfirst,ibf,jbf)
2
3C$Id$
4      implicit none
5
6#include "stdio.fh"
7
8      integer mi,mj,Ni,Nj
9      integer ifirst,jfirst
10      integer ibf(mi),jbf(mj)
11      double precision T(mi,mj),TT(Ni,Nj)
12c
13      integer i,j,jj
14c
15c     scatter into matrix
16c
17      call dfill(Ni*Nj,0.d0,TT,1)
18      do j = 1,mj
19        jj=jbf(j)-jfirst+1
20        do i =1,mi
21          TT((ibf(i)-ifirst+1),jj)=T(i,j)
22        enddo
23      enddo
24
25      return
26      end
27
28      subroutine scat_matup(TT,T,Ni,Nj,mi,mj,
29     I     ifirst,jfirst,ibf,jbf)
30      implicit none
31
32      integer mi,mj,Ni,Nj
33      integer ifirst,jfirst
34      integer ibf(mi),jbf(mj)
35      double precision T(mi,mj),TT(Ni,Nj)
36c
37      integer i,j,jj
38c
39c     scatter into matrix
40c     prepare for ga_symmetrize
41c
42      call dcopy(Ni*Nj,0.d0,0,TT,1)
43      if(ifirst.eq.jfirst) then
44         do j =1,mi
45            TT((ibf(j)-jfirst+1),
46     A           ibf(j)-jfirst+1)=T(j,j)
47            do i = j+1,mi
48               TT((ibf(i)-ifirst+1),
49     A              ibf(j)-jfirst+1)=T(i,j)*2d0
50            enddo
51         enddo
52      else
53         do j = 1,mj
54            jj=jbf(j)-jfirst+1
55            do i =1,mi
56               TT((ibf(i)-ifirst+1),jj)=T(i,j)*2d0
57            enddo
58         enddo
59      endif
60      return
61      end
62C
63      Subroutine transp_mat(TT,T,Ni,Nj)
64
65      implicit none
66      integer Ni,Nj
67      double precision T(Nj,Ni),TT(Ni,Nj)
68c
69      integer jj,ii
70
71c
72c     transpose a matrix
73c     input TT
74c     output T
75c
76!      do jj=1,Ni,2
77!      r1 = iand(max0(rows,0),3)
78!        do ii=1,Nj,2
79!          T(ii,jj)=TT(jj,ii)
80!          T(ii+1,jj)=TT(jj,ii+1)
81!          T(ii,jj+1)=TT(jj+1,ii)
82!          T(ii+1,jj+1)=TT(jj+1,ii+1)
83!        enddo
84!      enddo
85      do jj=1,Ni
86        do ii=1,Nj
87          T(ii,jj)=TT(jj,ii)
88        enddo
89      enddo
90
91      return
92      end
93C
94      Subroutine scat_mat3(n3d,i3d,
95     .     TT,T,Ni,Nj,mi,mj,ifirst,jfirst,ibf,jbf)
96      implicit none
97      integer n3d,i3d
98      integer mi,mj,Ni,Nj
99      integer ifirst,jfirst
100      integer ibf(mi),jbf(mj)
101      double precision T(mi,mj),TT(n3d,Ni,Nj)
102c
103      integer i,j,jj
104
105c
106c     scatter into matrix
107c
108      do j = 1,mj
109        jj=jbf(j)-jfirst+1
110        do i =1,mi
111          TT(i3d,(ibf(i)-ifirst+1),jj)=T(i,j)
112        enddo
113      enddo
114
115      return
116      end
117
118      Subroutine transp_mat3(n3d,TT,T,Ni,Nj)
119
120      implicit none
121      integer n3d
122      integer Ni,Nj
123      double precision T(n3d,Nj,Ni),TT(n3d,Ni,Nj)
124c
125      integer jj,ii,i3d
126
127c
128c     transpose a matrix
129c     input TT
130c     output T
131c
132      do jj=1,Ni
133        do ii=1,Nj
134           do i3d=1,n3d
135              T(i3d,ii,jj)=TT(i3d,jj,ii)
136           enddo
137        enddo
138      enddo
139
140      return
141      end
142