xref: /phasta/phSolver/compressible/localt.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

        subroutine localt (global, rlocal, ien, n, code)
c
c----------------------------------------------------------------------
c
c This subroutine performs a vector gather/scatter operation. This
c is the transpose of local.f, i.e., recieves a global and returns
c a transposed local, or the oposite.
c
c input:
c  global (nshg,n)             : global array
c  rlocal (npro,n,nenl)         : local array
c  ien    (npro,nshape)      : nodal connectivity
c  n                            : number of d.o.f.'s to be copied
c  code                         : the transfer code
c                                  .eq. 'gather  ', from global to local
c                                  .eq. 'scatter ', add  local to global
c                                  .eq. 'globaliz', from local to global
c
c
c Zdenek Johan, Winter 1992.
c----------------------------------------------------------------------
c
        include "common.h"

        dimension global(nshg,n),           rlocal(npro,n,nshape),
     &            ien(npro,nshape)
c
        character*8 code
c
c.... ------------------------>  'localization  '  <--------------------
c
        if (code .eq. 'gather  ') then
c
c.... set timer
c
          call timer ('Gather  ')
c
c.... gather the data
c
          ttim(3) = ttim(3) - secs(0.0)

          do j = 1, nshape
            do i = 1, n
              rlocal(:,i,j) = global(ien(:,j),i)
            enddo
          enddo

	  ttim(3) = ttim(3) + secs(0.0)

c
c.... transfer count
c
c          gbytes = gbytes + n*nenl*npro
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... ------------------------->  'assembling '  <----------------------
c
        if (code .eq. 'scatter ') then
c
c.... set timer
c
          call timer ('Scatter ')
c
c.... scatter the data (possible collisions)
c
          ttim(4) = ttim(4) - secs(0.0)

          do j = 1, nshape
            do i = 1, n
              do nel = 1,npro
                global(ien(nel,j),i) = global(ien(nel,j),i)
     &                               + rlocal(nel,i,j)
              enddo
            enddo
          enddo

	  ttim(4) = ttim(4) + secs(0.0)

c
c.... transfer and flop counts
c
c          sbytes = sbytes + n*nenl*npro
c          flops  = flops  + n*nenl*npro
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... ------------------------->  'globalizing '  <----------------------
c
        if (code .eq. 'globaliz') then
c
c.... scatter the data (possible collisions)
c
          do j = 1, nshape
            do i = 1, n
              do nel = 1,npro
                global(ien(nel,j),i) = rlocal(nel,i,j)
              enddo
            enddo
          enddo
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... --------------------------->  error  <---------------------------
c
        call error ('local   ', code, 0)
c
c.... end
c
        end
c
c
c
        subroutine localtSclr (global, rlocal, ien, code)
c
c----------------------------------------------------------------------
c
c This subroutine performs a vector gather/scatter operation. This
c is the transpose of local.f, i.e., recieves a global and returns
c a transposed local, or the oposite.
c
c input:
c  global (nshg)              : global array
c  rlocal (npro,nshape)         : local array
c  ien    (npro,nshape)         : nodal connectivity
c  n                            : number of d.o.f.'s to be copied
c  code                         : the transfer code
c                                  .eq. 'gather  ', from global to local
c                                  .eq. 'scatter ', add  local to global
c                                  .eq. 'globaliz', from local to global
c
c
c Zdenek Johan, Winter 1992.
c----------------------------------------------------------------------
c
        include "common.h"

        dimension global(nshg),           rlocal(npro,nshape),
     &            ien(npro,nshape)
c
        character*8 code
c
c.... ------------------------>  'localization  '  <--------------------
c
        if (code .eq. 'gather  ') then
c
c.... set timer
c
          call timer ('Gather  ')
c
c.... gather the data
c
          ttim(3) = ttim(3) - tmr()

          do j = 1, nshape
              rlocal(:,j) = global(ien(:,j))
          enddo

	  ttim(3) = ttim(3) + tmr()

c
c.... transfer count
c
c          gbytes = gbytes + n*nshape*npro
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... ------------------------->  'assembling '  <----------------------
c
        if (code .eq. 'scatter ') then
c
c.... set timer
c
          call timer ('Scatter ')
c
c.... scatter the data (possible collisions)
c
          ttim(4) = ttim(4) - tmr()

          do j = 1, nshape
             do nel = 1,npro
                global(ien(nel,j)) = global(ien(nel,j))
     &               + rlocal(nel,j)
             enddo
          enddo

	  ttim(4) = ttim(4) + tmr()

c
c.... transfer and flop counts
c
c          sbytes = sbytes + n*nshape*npro
c          flops  = flops  + n*nshape*npro
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... ------------------------->  'globalizing '  <----------------------
c
        if (code .eq. 'globaliz') then
c
c.... scatter the data (possible collisions)
c
          do j = 1, nshape
              do nel = 1,npro
                global(ien(nel,j)) = rlocal(nel,j)
              enddo
          enddo
c
c.... return
c
          call timer ('Back    ')
          return
        endif
c
c.... --------------------------->  error  <---------------------------
c
        call error ('local   ', code, 0)
c
c.... end
c
        end
c