1 subroutine localy (global, rlocal, ientmp, n, code) 2c 3c---------------------------------------------------------------------- 4c 5c This subroutine performs a vector gather/scatter operation. 6c 7c input: 8c global (nshg,n) : global array 9c rlocal (npro,nshl,n) : local array 10c ien (npro,nshl) : nodal connectivity 11c n : number of d.o.f.'s to be copied 12c code : the transfer code 13c .eq. 'gather ', from global to local 14c .eq. 'scatter ', add local to global 15c .eq. 'globaliz', from local to global 16c 17c 18c Zdenek Johan, Winter 1992. 19c---------------------------------------------------------------------- 20c 21 include "common.h" 22 23 dimension global(nshg,n), rlocal(npro,nshl,n), 24 & ien(npro,nshl), ientmp(npro,nshl) 25c 26 character*8 code 27 28c 29c.... cubic basis has negatives in ien 30c 31 if (ipord > 2) then 32 ien = abs(ientmp) 33 else 34 ien = ientmp 35 endif 36c 37c.... ------------------------> 'localization ' <-------------------- 38c 39 if (code .eq. 'gather ') then 40c 41c.... set timer 42c 43c call timer ('Gather ') 44c 45c.... gather the data to the current block 46c 47 48CAD rlocal = yl={P, u, v, w, T, scalar1, ...} 49CAD global = y = {u, v, w, P, T, scalar1, ...} 50 51CAD Put u,v,w in the slots 2,3,4 of yl 52 53 do j = 1, 3 54 do i = 1, nshl 55 rlocal(:,i,j+1) = global(ien(:,i),j) 56 enddo 57 enddo 58 59CAD Put Pressure in the first slot of yl 60 61 do i = 1, nshl 62 rlocal(:,i,1) = global(ien(:,i),4) 63 enddo 64 65CAD Fill in the remaining slots with T, and additional scalars 66 67 if(n.gt.4) then 68 do j = 5, n 69 do i = 1, nshl 70 rlocal(:,i,j) = global(ien(:,i),j) 71 enddo 72 enddo 73 endif 74c 75c.... transfer count 76c 77 gbytes = gbytes + n*nshl*npro 78c 79c.... return 80c 81c call timer ('Back ') 82 return 83 endif 84c 85c.... -------------------------> 'assembling ' <---------------------- 86c 87 if (code .eq. 'scatter ') then 88 write(*,*) 'do not use localy here' 89 endif 90c 91c.... -------------------------> 'globalizing ' <---------------------- 92c 93 if (code .eq. 'globaliz') then 94 write(*,*) 'do not use localy here' 95 endif 96c 97c.... ---------------------------> error <--------------------------- 98c 99 call error ('local ', code, 0) 100c 101c.... end 102c 103 end 104