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