xref: /phasta/phSolver/incompressible/elmStats.f (revision 595995161822a203c8467e0e4a253d7bd7d6df32)

      subroutine elmStatsLhs( x,  iBC,   iper,  ilwork )
c-----------------------------------------------------------------------
c     compute the necessary terms for the statistics projection
c     matrices.
c-----------------------------------------------------------------------
      use     stats
      use     pointer_data

      include "common.h"

      real*8  x(numnp,3)
      integer iBC(nshg), iper(nshg), ilwork(nlwork)

      real*8, allocatable :: xl(:,:,:)
      real*8, allocatable :: lStsVec(:,:,:)

c
c.... loop over element blocks
c
      stsVec = zero

      do iblk = 1, nelblk
         iel    = lcblk(1,iblk)
         lcsyst = lcblk(3,iblk)
         nenl   = lcblk(5,iblk) ! no. of vertices per element
         nshl   = lcblk(10,iblk)
         ndofl  = lcblk(8,iblk)
         npro   = lcblk(1,iblk+1) - iel

         allocate ( xl(npro,nenl,3)             )
         allocate ( lStsVec(npro,nshl,nResDims) )
c
c.... localize needed data
c
         call localx ( x,    xl,  mien(iblk)%p, nsd,   'gather  ' )
c
c.... form the Lhs
c
         call e3StsLhs( xl, lStsVec )
c
c.... assemble
c
         call local (stsVec, lStsVec, mien(iblk)%p,
     &               nResDims, 'scatter ' )

         deallocate ( xl       )
         deallocate ( lStsVec  )
c
c.... end loop over element blocks
c
      enddo

      if (numpe > 1) then
        call commu (stsVec, ilwork, nResDims  , 'in ')
      endif
c
c.... local periodic boundary conditions (no communications)
c
      do j = 1,nshg
         if (btest(iBC(j),10)) then
            i = iper(j)
            stsVec(i,:) = stsVec(i,:) + stsVec(j,:)
         endif
      enddo
c
      do i = 1,nshg
         stsVec(i,:) = stsVec(iper(i),:)
      enddo
      if (numpe > 1) then
        call commu (stsVec, ilwork, nResDims  , 'out')
      endif

      return
      end

c-----------------------------------------------------------------------
c  Assemble the residual for the statistics
c-----------------------------------------------------------------------
      subroutine elmStatsRes( y,        ac,    x,      shp,     shgl,
     &                        shpb,     shglb,       iBC,     BC,
     &                        iper,     ilwork,      rowp,    colm,
     &                        lhsK,     lhsP )

      use     stats
      include "common.h"


      real*8  y(nshg,ndof),             ac(nshg,ndof), x(numnp,nsd),
     &        shp(MAXTOP,maxsh,MAXQPT),  shgl(MAXTOP,nsd,maxsh,MAXQPT),
     &        shpb(MAXTOP,maxsh,MAXQPT),
     &        shglb(MAXTOP,nsd,maxsh,MAXQPT),
     &        BC(nshg,ndofBC),          lhsK(9,nnz_tot),
     &        lhsP(4,nnz_tot),         res(nshg,ndof)

      integer iBC(nshg),                iper(nshg),
     &        ilwork(nlwork),           rowp(nshg,nnz),
     &        colm(nshg+1)


      lhs    = 0
      stsVec = zero

      stsResFlg = 1
      ierrcalctmp=ierrcalc ! save the current value of ierrcalc
      ierrcalc=0           ! set it to zero so that we don't calculate error
                           ! here (which would overflow memory around rjunk)
      call ElmGMR (y,         ac,         x,
     &             shp,       shgl,       iBC,
     &             BC,        shpb,       shglb,
     &             res,       iper,       ilwork,
     &             rowp,      colm,       lhsK,
     &             lhsP,      rjunk   )
      stsResFlg = 0
      ierrcalc=ierrcalctmp  ! reset it back to original value
      return
      end