1 subroutine localt (global, rlocal, ien, n, code) 2c 3c---------------------------------------------------------------------- 4c 5c This subroutine performs a vector gather/scatter operation. This 6c is the transpose of local.f, i.e., recieves a global and returns 7c a transposed local, or the oposite. 8c 9c input: 10c global (nshg,n) : global array 11c rlocal (npro,n,nenl) : local array 12c ien (npro,nshl) : nodal connectivity 13c n : number of d.o.f.'s to be copied 14c code : the transfer code 15c .eq. 'gather ', from global to local 16c .eq. 'scatter ', add local to global 17c .eq. 'globaliz', from local to global 18c 19c 20c Zdenek Johan, Winter 1992. 21c---------------------------------------------------------------------- 22c 23 include "common.h" 24 25 dimension global(nshg,n), rlocal(npro,n,nshl), 26 & ien(npro,nshl) 27c 28 character*8 code 29c 30c.... ------------------------> 'localization ' <-------------------- 31c 32 if (code .eq. 'gather ') then 33c 34c.... set timer 35c 36 call timer ('Gather ') 37c 38c.... gather the data 39c 40 ttim(3) = ttim(3) - secs(0.0) 41 42 do j = 1, nshl 43 do i = 1, n 44 rlocal(:,i,j) = global(ien(:,j),i) 45 enddo 46 enddo 47 48 ttim(3) = ttim(3) + secs(0.0) 49 50c 51c.... transfer count 52c 53c gbytes = gbytes + n*nenl*npro 54c 55c.... return 56c 57 call timer ('Back ') 58 return 59 endif 60c 61c.... -------------------------> 'assembling ' <---------------------- 62c 63 if (code .eq. 'scatter ') then 64c 65c.... set timer 66c 67 call timer ('Scatter ') 68c 69c.... scatter the data (possible collisions) 70c 71 ttim(4) = ttim(4) - secs(0.0) 72 73 do j = 1, nshl 74 do i = 1, n 75 do nel = 1,npro 76 global(ien(nel,j),i) = global(ien(nel,j),i) 77 & + rlocal(nel,i,j) 78 enddo 79 enddo 80 enddo 81 82 ttim(4) = ttim(4) + secs(0.0) 83 84c 85c.... transfer and flop counts 86c 87c sbytes = sbytes + n*nenl*npro 88c flops = flops + n*nenl*npro 89c 90c.... return 91c 92 call timer ('Back ') 93 return 94 endif 95c 96c.... -------------------------> 'globalizing ' <---------------------- 97c 98 if (code .eq. 'globaliz') then 99c 100c.... scatter the data (possible collisions) 101c 102 do j = 1, nshl 103 do i = 1, n 104 do nel = 1,npro 105 global(ien(nel,j),i) = rlocal(nel,i,j) 106 enddo 107 enddo 108 enddo 109c 110c.... return 111c 112 call timer ('Back ') 113 return 114 endif 115c 116c.... ---------------------------> error <--------------------------- 117c 118 call error ('local ', code, 0) 119c 120c.... end 121c 122 end 123c 124c 125c 126 subroutine localtSclr (global, rlocal, ien, code) 127c 128c---------------------------------------------------------------------- 129c 130c This subroutine performs a vector gather/scatter operation. This 131c is the transpose of local.f, i.e., recieves a global and returns 132c a transposed local, or the oposite. 133c 134c input: 135c global (nshg) : global array 136c rlocal (npro,nshl) : local array 137c ien (npro,nshl) : nodal connectivity 138c n : number of d.o.f.'s to be copied 139c code : the transfer code 140c .eq. 'gather ', from global to local 141c .eq. 'scatter ', add local to global 142c .eq. 'globaliz', from local to global 143c 144c 145c Zdenek Johan, Winter 1992. 146c---------------------------------------------------------------------- 147c 148 include "common.h" 149 150 dimension global(nshg), rlocal(npro,nshl), 151 & ien(npro,nshl) 152c 153 character*8 code 154c 155c.... ------------------------> 'localization ' <-------------------- 156c 157 if (code .eq. 'gather ') then 158c 159c.... set timer 160c 161 call timer ('Gather ') 162c 163c.... gather the data 164c 165 ttim(3) = ttim(3) - tmr() 166 167 do j = 1, nshl 168 rlocal(:,j) = global(ien(:,j)) 169 enddo 170 171 ttim(3) = ttim(3) + tmr() 172 173c 174c.... transfer count 175c 176c gbytes = gbytes + n*nshl*npro 177c 178c.... return 179c 180 call timer ('Back ') 181 return 182 endif 183c 184c.... -------------------------> 'assembling ' <---------------------- 185c 186 if (code .eq. 'scatter ') then 187c 188c.... set timer 189c 190 call timer ('Scatter ') 191c 192c.... scatter the data (possible collisions) 193c 194 ttim(4) = ttim(4) - tmr() 195 196 do j = 1, nshl 197 do nel = 1,npro 198 global(ien(nel,j)) = global(ien(nel,j)) 199 & + rlocal(nel,j) 200 enddo 201 enddo 202 203 ttim(4) = ttim(4) + tmr() 204 205c 206c.... transfer and flop counts 207c 208c sbytes = sbytes + n*nshl*npro 209c flops = flops + n*nshl*npro 210c 211c.... return 212c 213 call timer ('Back ') 214 return 215 endif 216c 217c.... -------------------------> 'globalizing ' <---------------------- 218c 219 if (code .eq. 'globaliz') then 220c 221c.... scatter the data (possible collisions) 222c 223 do j = 1, nshl 224 do nel = 1,npro 225 global(ien(nel,j)) = rlocal(nel,j) 226 enddo 227 enddo 228c 229c.... return 230c 231 call timer ('Back ') 232 return 233 endif 234c 235c.... ---------------------------> error <--------------------------- 236c 237 call error ('local ', code, 0) 238c 239c.... end 240c 241 end 242c 243 244 245 246