c------------------------------------------------------------------
      subroutine init_locks
c------------------------------------------------------------------
c     This version uses ATOMIC for atomic updates, 
c     but locks are still used in get_emo (mason.f).
c------------------------------------------------------------------

      include 'header.h'

      integer i

c.....initialize locks in parallel
c$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(i)
c$    do i=1,8*lelt
c$      call omp_init_lock(tlock(i))
c$    end do

      return
      end


c------------------------------------------------------------------
      subroutine transf(tmor,tx)
c------------------------------------------------------------------
c     Map values from mortar(tmor) to element(tx)
c------------------------------------------------------------------

      include 'header.h'

      double precision tmor(*),tx(*), tmp(lx1,lx1,2)
      integer ig1,ig2,ig3,ig4,ie,iface,il1,il2,il3,il4,
     &        nnje,ije1,ije2,col,i,j,ig,il


c.....zero out tx on element boundaries
      call col2(tx,tmult,ntot)     

c$OMP PARALLEL DO DEFAULT(SHARED) PRIVATE(il,j,ig,i,col,ije2,ije1,ig4,
c$OMP& ig3,ig2,ig1,nnje,il4,il3,il2,il1,iface,ie,tmp)
      do ie=1,nelt
        do iface=1,nsides

c.........get the collocation point index of the four local corners on the
c         face iface of element ie
          il1=idel(1,1,iface,ie)
          il2=idel(lx1,1,iface,ie)
          il3=idel(1,lx1,iface,ie)
          il4=idel(lx1,lx1,iface,ie)

c.........get the mortar indices of the four local corners
          ig1= idmo(1,  1  ,1,1,iface,ie)
          ig2= idmo(lx1,1  ,1,2,iface,ie)
          ig3= idmo(1,  lx1,2,1,iface,ie)
          ig4= idmo(lx1,lx1,2,2,iface,ie)
  
c.........copy the value from tmor to tx for these four local corners
          tx(il1) = tmor(ig1)
          tx(il2) = tmor(ig2)
          tx(il3) = tmor(ig3)
          tx(il4) = tmor(ig4)
 
c.........nnje=1 for conforming faces, nnje=2 for nonconforming faces
          if(cbc(iface,ie).eq.3) then
            nnje=2
          else
            nnje=1 
          end if

c.........for nonconforming faces
          if(nnje.eq.2) then

c...........nonconforming faces have four pieces of mortar, first map them to
c           two intermediate mortars, stored in tmp
            call r_init(tmp,lx1*lx1*2,0.d0)
   
            do ije1=1,nnje
              do ije2=1,nnje
                do col=1,lx1

c.................in each row col, when coloumn i=1 or lx1, the value
c                 in tmor is copied to tmp
                  i = v_end(ije2)
                  ig=idmo(i,col,ije1,ije2,iface,ie)
                  tmp(i,col,ije1)=tmor(ig)

c.................in each row col, value in the interior three collocation
c                 points is computed by apply mapping matrix qbnew to tmor
                  do i=2,lx1-1
                    il= idel(i,col,iface,ie)
                    do j=1,lx1
                      ig=idmo(j,col,ije1,ije2,iface,ie)
                      tmp(i,col,ije1) = tmp(i,col,ije1) + 
     &                qbnew(i-1,j,ije2)*tmor(ig)
                    end do
                  end do

                end do
              end do
            end do
      
c...........mapping from two pieces of intermediate mortar tmp to element 
c           face tx

            do ije1=1, nnje

c.............the first column, col=1, is an edge of face iface.
c             the value on the three interior collocation points, tx, is 
c             computed by applying mapping matrices qbnew to tmp.
c             the mapping result is divided by 2, because there will be 
c             duplicated contribution from another face sharing this edge.
              col=1
              do i=2,lx1-1
                il= idel(col,i,iface,ie)
                do j=1,lx1
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)*
     &                       tmp(col,j,ije1)*0.5d0
                end do 
              end do 

c.............for column 2 ~ lx-1 
              do col=2,lx1-1

c...............when i=1 or lx1, the collocation points are also on an edge of
c               the face, so the mapping result also needs to be divided by 2
                i = v_end(ije1)
                il= idel(col,i,iface,ie)
                tx(il)=tx(il)+tmp(col,i,ije1)*0.5d0

c...............compute the value at interior collocation points in 
c               columns 2 ~ lx1
                do i=2,lx1-1
                  il= idel(col,i,iface,ie)
                  do j=1,lx1
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)* tmp(col,j,ije1)
                  end do 
                end do
              end do

c.............same as col=1
              col=lx1
              do  i=2,lx1-1
                il= idel(col,i,iface,ie)
                do j=1,lx1
                  tx(il) = tx(il) + qbnew(i-1,j,ije1)*
     &                     tmp(col,j,ije1)*0.5d0
                end do 
              end do
            end do

c.........for conforming faces
          else

c.........face interior
            do col=2,lx1-1
              do i=2,lx1-1  
                il= idel(i,col,iface,ie)
                ig= idmo(i,col,1,1,iface,ie)
                tx(il)=tmor(ig)
              end do
            end do

        
c...........edges of conforming faces

c...........if local edge 1 is a nonconforming edge
            if(idmo(lx1,1,1,1,iface,ie).ne.0)then
              do i=2,lx1-1               
                il= idel(i,1,iface,ie)
                do ije1=1,2
                  do j=1,lx1
                    ig=idmo(j,1,1,ije1,iface,ie)
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)*tmor(ig)*0.5d0
                  end do
                end do
              end do

c...........if local edge 1 is a conforming edge
            else
              do i=2,lx1-1
                il= idel(i,1,iface,ie)
                ig= idmo(i,1,1,1,iface,ie)
                tx(il)=tmor(ig)
              end do
            end if 

c...........if local edge 2 is a nonconforming edge
            if(idmo(lx1,2,1,2,iface,ie).ne.0)then
              do i=2,lx1-1               
                il= idel(lx1,i,iface,ie)
                do ije1=1,2
                  do j=1,lx1
                    ig=idmo(lx1,j,ije1,2,iface,ie)
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)*tmor(ig)*0.5d0
                  end do
                end do
              end do

c...........if local edge 2 is a conforming edge
            else
              do i=2,lx1-1
                il= idel(lx1,i,iface,ie)
                ig= idmo(lx1,i,1,1,iface,ie)
                tx(il)=tmor(ig)
              end do
            end if 

c...........if local edge 3 is a nonconforming edge
            if(idmo(2,lx1,2,1,iface,ie).ne.0)then
              do  i=2,lx1-1               
                il= idel(i,lx1,iface,ie)
                do ije1=1,2
                  do j=1,lx1
                    ig=idmo(j,lx1,2,ije1,iface,ie)
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)*tmor(ig)*0.5d0
                  end do
                end do
              end do

c...........if local edge 3 is a conforming edge
            else
              do i=2,lx1-1
                il= idel(i,lx1,iface,ie)
                ig= idmo(i,lx1,1,1,iface,ie)
                tx(il)=tmor(ig)
              end do
            end if 

c...........if local edge 4 is a nonconforming edge
            if(idmo(1,lx1,1,1,iface,ie).ne.0)then
              do i=2,lx1-1               
                il= idel(1,i,iface,ie)
                do ije1=1,2
                  do j=1,lx1
                    ig=idmo(1,j,ije1,1,iface,ie)
                    tx(il) = tx(il) + qbnew(i-1,j,ije1)*tmor(ig)*0.5d0
                  end do
                end do
              end do
c...........if local edge 4 is a conforming edge
            else
              do i=2,lx1-1
                il= idel(1,i,iface,ie)
                ig= idmo(1,i,1,1,iface,ie)
                tx(il)=tmor(ig)
              end do
            end if 
          end if
          
        end do
      end do
c$OMP END PARALLEL DO

      return
      end


c------------------------------------------------------------------
      subroutine transfb(tmor,tx)
c------------------------------------------------------------------
c     Map from element(tx) to mortar(tmor).
c     tmor sums contributions from all elements.
c------------------------------------------------------------------

      include 'header.h'

      double precision third
      parameter (third=1.d0/3.d0)
      integer shift

      double precision tmp,tmp1,tx(*),tmor(*),temp(lx1,lx1,2),
     &                 top(lx1,2)
      integer il1,il2,il3,il4,ig1,ig2,ig3,ig4,ie,iface,nnje,
     &        ije1,ije2,col,i,j,ije,ig,il

c$OMP PARALLEL DEFAULT(SHARED) PRIVATE(il,j,ig,i,col,ije2,ije1,ig4,
c$OMP& ig3,ig2,ig1,nnje,il4,il3,il2,il1,iface,ie,ije,
c$OMP& tmp,shift,temp,top,tmp1)

c$OMP DO
      do ie=1,nmor
        tmor(ie)=0.d0
      end do
c$OMP END DO

c$OMP DO
      do ie=1,nelt
        do iface=1,nsides
c.........nnje=1 for conforming faces, nnje=2 for nonconforming faces
          if(cbc(iface,ie).eq.3) then
            nnje=2
          else
            nnje=1 
          end if

c.........get collocation point index of four local corners on the face
          il1 = idel(1,  1,  iface,ie)
          il2 = idel(lx1,1,  iface,ie)
          il3 = idel(1,  lx1,iface,ie)
          il4 = idel(lx1,lx1,iface,ie)

c.........get the mortar indices of the four local corners
          ig1 = idmo(1,  1,  1,1,iface,ie)
          ig2 = idmo(lx1,1,  1,2,iface,ie)
          ig3 = idmo(1,  lx1,2,1,iface,ie )
          ig4 = idmo(lx1,lx1,2,2,iface,ie)

c.........sum the values from tx to tmor for these four local corners
c         only 1/3 of the value is summed, since there will be two duplicated
c         contributions from the other two faces sharing this vertex 
c$OMP ATOMIC
          tmor(ig1) = tmor(ig1)+tx(il1)*third
c$OMP ATOMIC
          tmor(ig2) = tmor(ig2)+tx(il2)*third
c$OMP ATOMIC
          tmor(ig3) = tmor(ig3)+tx(il3)*third
c$OMP ATOMIC
          tmor(ig4) = tmor(ig4)+tx(il4)*third

c.........for nonconforming faces
          if(nnje.eq.2) then       
            call r_init(temp,lx1*lx1*2,0.d0)

c...........nonconforming faces have four pieces of mortar, first map tx to
c           two intermediate mortars stored in temp

            do ije2 = 1, nnje
              shift = ije2-1
              do col=1,lx1
c...............For mortar points on face edge (top and bottom), copy the 
c               value from tx to temp
                il=idel(col,v_end(ije2),iface,ie)
                temp(col,v_end(ije2),ije2)=tx(il)

c...............For mortar points on face edge (top and bottom), calculate 
c               the interior points' contribution to them, i.e. top()
                j = v_end(ije2)
                tmp=0.d0
                do i=2,lx1-1 
                  il=idel(col,i,iface,ie)
                  tmp = tmp + qbnew(i-1,j,ije2)*tx(il)
                end do

                top(col,ije2)=tmp

c...............Use mapping matrices qbnew to map the value from tx to temp 
c               for mortar points not on the top bottom face edge.
                do j=2-shift,lx1-shift
                  tmp=0.d0
                  do i=2,lx1-1 
                    il=idel(col,i,iface,ie)
                    tmp = tmp + qbnew(i-1,j,ije2)*tx(il)
                  end do
                  temp(col,j,ije2) = tmp + temp(col,j,ije2)
                end do
              end do
            end do

c...........mapping from temp to tmor

            do ije1=1, nnje
              shift = ije1-1
              do ije2=1,nnje

c...............for each column of collocation points on a piece of mortar
                do col=2-shift,lx1-shift

c.................For the end point, which is on an edge (local edge 2,4), 
c                 the contribution is halved since there will be duplicated 
c                 contribution from another face sharing this edge.

                  ig=idmo(v_end(ije2),col,ije1,ije2,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+temp(v_end(ije2),col,ije1)*0.5d0

c.................In each row of collocation points on a piece of mortar, 
c                 sum the contributions from interior collocation points 
c                 (i=2,lx1-1)

                  do  j=1,lx1
                    tmp=0.d0
                    do i=2,lx1-1
                      tmp = tmp + qbnew(i-1,j,ije2) * temp(i,col,ije1)
                    end do
                    ig=idmo(j,col,ije1,ije2,iface,ie)
c$OMP ATOMIC
                    tmor(ig)=tmor(ig)+tmp
                  end do
                end do

c...............For tmor on local edge 1 and 3, tmp is the contribution from
c               an edge, so it is halved because of duplicated contribution
c               from another face sharing this edge. tmp1 is contribution 
c               from face interior. 

                col = v_end(ije1)
                ig=idmo(v_end(ije2),col,ije1,ije2,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+top(v_end(ije2),ije1)*0.5d0
                do  j=1,lx1
                  tmp=0.d0
                  tmp1=0.d0
                  do i=2,lx1-1
                    tmp  = tmp  + qbnew(i-1,j,ije2) * temp(i,col,ije1)
                    tmp1 = tmp1 + qbnew(i-1,j,ije2) * top(i,ije1)
                  end do
                  ig=idmo(j,col,ije1,ije2,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+tmp*0.5d0+tmp1 
                end do
              end do
            end do

c.........for conforming faces
          else

c.........face interior
            do col=2,lx1-1
              do j=2,lx1-1
                il=idel(j,col,iface,ie)
                ig=idmo(j,col,1,1,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+tx(il)
              end do
            end do

c...........edges of conforming faces

c...........if local edge 1 is a nonconforming edge
            if(idmo(lx1,1,1,1,iface,ie).ne.0)then
              do ije=1,2
                do j=1,lx1
                  tmp=0.d0
                  do i=2,lx1-1
                    il=idel(i,1,iface,ie)
                    tmp= tmp + qbnew(i-1,j,ije)*tx(il)
                  end do
                  ig=idmo(j,1,1,ije,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+tmp*0.5d0
                end do
              end do

c...........if local edge 1 is a conforming edge
            else
              do j=2,lx1-1
                il=idel(j,1,iface,ie)
                ig=idmo(j,1,1,1,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+tx(il)*0.5d0
              end do
            end if 

c...........if local edge 2 is a nonconforming edge
            if(idmo(lx1,2,1,2,iface,ie).ne.0)then
              do ije=1,2
                do j=1,lx1
                  tmp=0.d0
                  do i=2,lx1-1
                    il=idel(lx1,i,iface,ie)
                    tmp = tmp + qbnew(i-1,j,ije)*tx(il)
                  end do
                  ig=idmo(lx1,j,ije,2,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+tmp*0.5d0
                end do
              end do

c...........if local edge 2 is a conforming edge
            else
              do j=2,lx1-1
                il=idel(lx1,j,iface,ie)
                ig=idmo(lx1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+tx(il)*0.5d0
              end do
            end if 

c...........if local edge 3 is a nonconforming edge
            if(idmo(2,lx1,2,1,iface,ie).ne.0)then
              do ije=1,2
                do j=1,lx1
                  tmp=0.d0
                  do i=2,lx1-1
                    il=idel(i,lx1,iface,ie)
                    tmp = tmp + qbnew(i-1,j,ije)*tx(il)
                  end do
                  ig=idmo(j,lx1,2,ije,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+tmp*0.5d0
                end do
              end do

c...........if local edge 3 is a conforming edge
            else
              do j=2,lx1-1
                il=idel(j,lx1,iface,ie)
                ig=idmo(j,lx1,1,1,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+tx(il)*0.5d0
              end do
            end if 

c...........if local edge 4 is a nonconforming edge
            if(idmo(1,lx1,1,1,iface,ie).ne.0)then
              do ije=1,2
                do j=1,lx1
                  tmp=0.d0
                  do i=2,lx1-1
                    il=idel(1,i,iface,ie)
                    tmp = tmp + qbnew(i-1,j,ije)*tx(il)
                  end do
                  ig=idmo(1,j,ije,1,iface,ie)
c$OMP ATOMIC
                  tmor(ig)=tmor(ig)+tmp*0.5d0
                end do
              end do

c...........if local edge 4 is a conforming edge
            else
              do j=2,lx1-1
                il=idel(1,j,iface,ie)
                ig=idmo(1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmor(ig)=tmor(ig)+tx(il)*0.5d0
              end do
            end if 
          end if
        end do
      end do
c$OMP END DO NOWAIT
c$OMP END PARALLEL 

      return
      end


c--------------------------------------------------------------
      subroutine transfb_cor_e(n,tmor,tx)
c--------------------------------------------------------------
c     This subroutine performs the edge to mortar mapping and
c     calculates the mapping result on the mortar point at a vertex
c     under situation 1,2, or 3.
c     n refers to the configuration of three edges sharing a vertex, 
c     n = 1: only one edge is nonconforming
c     n = 2: two edges are nonconforming 
c     n = 3: three edges are nonconforming 
c-------------------------------------------------------------------

      include 'header.h'

      double precision tmor,tx(lx1,lx1,lx1),tmp
      integer i,n

      tmor=tx(1,1,1)

      do i=2,lx1-1
        tmor= tmor + qbnew(i-1,1,1)*tx(i,1,1)
      end do

      if(n.gt.1)then
        do i=2,lx1-1
          tmor= tmor + qbnew(i-1,1,1)*tx(1,i,1)
        end do
      end if

      if(n.eq.3)then
        do i=2,lx1-1
          tmor= tmor + qbnew(i-1,1,1)*tx(1,1,i)
        end do
      end if

      return
      end

c--------------------------------------------------------------
      subroutine transfb_cor_f(n,tmor,tx)
c--------------------------------------------------------------
c     This subroutine performs the mapping from face to mortar.
c     Output tmor is the mapping result on a mortar vertex
c     of situations of three edges and three faces sharing a vertex:
c     n=4: only one face is nonconforming 
c     n=5: one face and one edge are nonconforming
c     n=6: two faces are nonconforming 
c     n=7: three faces are nonconforming 
c--------------------------------------------------------------
      include 'header.h'

      double precision tx(lx1,lx1,lx1),tmor,temp(lx1)
      integer col,i,n

      call r_init(temp,lx1,0.d0)

      do col=1,lx1
        temp(col)=tx(col,1,1)
        do i=2,lx1-1
          temp(col) = temp(col) + qbnew(i-1,1,1)*tx(col,i,1)
        end do
      end do
      tmor=temp(1)

      do i=2,lx1-1
        tmor = tmor + qbnew(i-1,1,1) *temp(i)
      end do

      if(n.eq.5)then
        do i=2,lx1-1
          tmor = tmor + qbnew(i-1,1,1) *tx(1,1,i)
        end do
      end if
 
      if(n.ge.6)then
        call r_init(temp,lx1,0.d0)
        do col=1,lx1
          do i=2,lx1-1
            temp(col) = temp(col) + qbnew(i-1,1,1)*tx(col,1,i)
          end do
        end do
        tmor=tmor+temp(1)
        do i=2,lx1-1
          tmor = tmor +qbnew(i-1,1,1) *temp(i)
        end do
      end if
        
      if(n.eq.7)then
        call r_init(temp,lx1,0.d0)
        do col=2,lx1-1
          do i=2,lx1-1
            temp(col) = temp(col) + qbnew(i-1,1,1)*tx(1,col,i)
          end do
        end do
        do i=2,lx1-1
          tmor = tmor + qbnew(i-1,1,1) *temp(i)
        end do
      end if

      return
      end


c-------------------------------------------------------------------------
      subroutine transf_nc(tmor,tx)
c------------------------------------------------------------------------
c     Perform mortar to element mapping on a nonconforming face. 
c     This subroutin is used when all entries in tmor are zero except
c     one tmor(i,j)=1. So this routine is simplified. Only one piece of 
c     mortar  (tmor only has two indices) and one piece of intermediate 
c     mortar (tmp) are involved.
c------------------------------------------------------------------------

      include 'header.h'

      double precision tmor(lx1,lx1), tx(lx1,lx1), tmp(lx1,lx1)
      integer col,i,j

      call r_init(tmp,lx1*lx1,0.d0)
      do col=1,lx1
        i = 1
        tmp(i,col)=tmor(i,col)                           
        do i=2,lx1-1
          do j=1,lx1
            tmp(i,col) = tmp(i,col) + qbnew(i-1,j,1)*tmor(j,col)
          end do
        end do
      end do

      do col=1,lx1
        i = 1
        tx(col,i)   = tx(col,i)   + tmp(col,i)
        do i=2,lx1-1
          do j=1,lx1
            tx(col,i) = tx(col,i) + qbnew(i-1,j,1)*tmp(col,j)
          end do
        end do
      end do

      return                                                  
      end                                                     

c------------------------------------------------------------------------
      subroutine transfb_nc0(tmor,tx)
c------------------------------------------------------------------------
c     Performs mapping from element to mortar when the nonconforming 
c     edges are shared by two conforming faces of an element.
c------------------------------------------------------------------------

      include 'header.h'

      double precision tmor(lx1,lx1),tx(lx1,lx1,lx1)
      integer i,j

      call r_init(tmor,lx1*lx1,0.d0)
      do j=1,lx1
        do i=2,lx1-1
          tmor(j,1)= tmor(j,1) + qbnew(i-1,j  ,1)*tx(i,1,1)
        end do
      end do

      return
      end 

c------------------------------------------------------------------------
      subroutine transfb_nc2(tmor,tx)
c------------------------------------------------------------------------
c     Maps values from element to mortar when the nonconforming edges are
c     shared by two nonconforming faces of an element.
c     Although each face shall have four pieces of mortar, only value in
c     one piece (location (1,1)) is used in the calling routine so only
c     the value in the first mortar is calculated in this subroutine.
c------------------------------------------------------------------------

      include 'header.h'

      double precision tx(lx1,lx1),tmor(lx1,lx1),bottom(lx1),
     &                 temp(lx1,lx1)
      integer col,j,i

      call r_init(tmor,lx1*lx1,0.d0)
      call r_init(temp,lx1*lx1,0.d0)
      tmor(1,1)=tx(1,1)

c.....mapping from tx to intermediate mortar temp + bottom
      do col=1,lx1
        temp(col,1)=tx(col,1)
        j=1
        bottom(col)= 0.d0
        do i=2,lx1-1 
          bottom(col) = bottom(col) + qbnew(i-1,j,1)*tx(col,i)
        end do

        do j=2,lx1
          do i=2,lx1-1 
            temp(col,j) = temp(col,j) + qbnew(i-1,j,1)*tx(col,i)
          end do
        end do
      end do

c.....from intermediate mortar to mortar

c.....On the nonconforming edge, temp is divided by 2 as there will be
c     a duplicate contribution from another face sharing this edge
      col=1
      do j=1,lx1
        do i=2,lx1-1
          tmor(j,col)=tmor(j,col)+ qbnew(i-1,j,1) * bottom(i) +
     &                             qbnew(i-1,j,1) * temp(i,col) * 0.5d0 
        end do
      end do

      do col=2,lx1
        tmor(1,col)=tmor(1,col)+temp(1,col)
        do j=1,lx1
          do i=2,lx1-1
            tmor(j,col) = tmor(j,col) + qbnew(i-1,j,1) *temp(i,col)
          end do
        end do
      end do

      return
      end 


c------------------------------------------------------------------------
      subroutine transfb_nc1(tmor,tx)
c------------------------------------------------------------------------
c     Maps values from element to mortar when the nonconforming edges are
c     shared by a nonconforming face and a conforming face of an element
c------------------------------------------------------------------------

      include 'header.h'

      double precision tx(lx1,lx1),tmor(lx1,lx1),bottom(lx1),
     &                 temp(lx1,lx1)
      integer col,j,i

      call r_init(tmor,lx1*lx1,0.d0)
      call r_init(temp,lx1*lx1,0.d0)

      tmor(1,1)=tx(1,1)
c.....Contribution from the nonconforming faces
c     Since the calling subroutine is only interested in the value on the
c     mortar (location (1,1)), only this piece of mortar is calculated.

      do col=1,lx1
        temp(col,1)=tx(col,1)
        j = 1
        bottom(col)= 0.d0
        do i=2,lx1-1 
          bottom(col)=bottom(col) + qbnew(i-1,j,1)*tx(col,i)
        end do

        do j=2,lx1
          do i=2,lx1-1 
            temp(col,j) = temp(col,j) + qbnew(i-1,j,1)*tx(col,i)
          end do

        end do
      end do

      col=1
      tmor(1,col)=tmor(1,col)+bottom(1)
      do j=1,lx1
        do i=2,lx1-1

c.........temp is not divided by 2 here. It includes the contribution
c         from the other conforming face.

          tmor(j,col)=tmor(j,col) + qbnew(i-1,j,1) *bottom(i) +
     &                              qbnew(i-1,j,1) *temp(i,col) 
        end do
      end do

      do col=2,lx1
        tmor(1,col)=tmor(1,col)+temp(1,col)
        do j=1,lx1
          do i=2,lx1-1
            tmor(j,col) = tmor(j,col) + qbnew(i-1,j,1) *temp(i,col)
          end do
        end do
      end do

      return
      end


c-------------------------------------------------------------------
      subroutine transfb_c(tx)
c-------------------------------------------------------------------
c     Prepare initial guess for cg. All values from conforming 
c     boundary are copied and summed on tmor.
c-------------------------------------------------------------------

      include 'header.h'

      double precision third
      parameter (third = 1.d0/3.d0)
      double precision tx(*)
      integer il1,il2,il3,il4,ig1,ig2,ig3,ig4,ie,iface,col,j,ig,il

c$OMP PARALLEL DEFAULT(SHARED) PRIVATE(IE,IFACE,IL1,IL2,
c$OMP& IL3,IL4,IG1,IG2,IG3,IG4,COL,J,IG,IL) 

c$OMP DO
      do j=1,nmor
        tmort(j)=0.d0
      end do
c$OMP END DO

c$OMP DO
      do ie=1,nelt
        do iface=1,nsides
          if(cbc(iface,ie).ne.3)then
            il1 = idel(1,1,iface,ie)
            il2 = idel(lx1,1,iface,ie)
            il3 = idel(1,lx1,iface,ie)
            il4 = idel(lx1,lx1,iface,ie)
            ig1 = idmo(1,  1,  1,1,iface,ie)
            ig2 = idmo(lx1,1,  1,2,iface,ie)
            ig3 = idmo(1,  lx1,2,1,iface,ie)
            ig4 = idmo(lx1,lx1,2,2,iface,ie)

c$OMP ATOMIC
            tmort(ig1) = tmort(ig1)+tx(il1)*third
c$OMP ATOMIC
            tmort(ig2) = tmort(ig2)+tx(il2)*third
c$OMP ATOMIC
            tmort(ig3) = tmort(ig3)+tx(il3)*third
c$OMP ATOMIC
            tmort(ig4) = tmort(ig4)+tx(il4)*third

            do  col=2,lx1-1
              do j=2,lx1-1
                il=idel(j,col,iface,ie)
                ig=idmo(j,col,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)
              end do
            end do

            if(idmo(lx1,1,1,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(j,1,iface,ie)
                ig=idmo(j,1,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
              end do
            end if

            if(idmo(lx1,2,1,2,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(lx1,j,iface,ie)
                ig=idmo(lx1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
              end do
            end if

            if(idmo(2,lx1,2,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(j,lx1,iface,ie)
                ig=idmo(j,lx1,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
              end do
            end if

            if(idmo(1,lx1,1,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(1,j,iface,ie)
                ig=idmo(1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
              end do
            end if
          end if!
        end do
      end do
c$OMP END DO NOWAIT
c$OMP END PARALLEL
      return
      end

c-------------------------------------------------------------------
      subroutine transfb_c_2(tx)
c-------------------------------------------------------------------
c     Prepare initial guess for CG. All values from conforming 
c     boundary are copied and summed in tmort. 
c     mormult is multiplicity, which is used to average tmort.
c-------------------------------------------------------------------

      include 'header.h'

      double precision third
      parameter (third = 1.d0/3.d0)
      double precision tx(*)
      integer il1,il2,il3,il4,ig1,ig2,ig3,ig4,ie,iface,col,j,ig,il

c$OMP PARALLEL DEFAULT(SHARED) PRIVATE(IE,IFACE,IL1,IL2,
c$OMP& IL3,IL4,IG1,IG2,IG3,IG4,COL,J,IG,IL)

c$OMP DO     
      do j=1,nmor
        tmort(j)=0.d0
      end do
c$OMP END DO nowait
c$OMP DO
      do j=1,nmor
        mormult(j)=0.d0
      end do
c$OMP END DO

c$OMP DO 
      do ie=1,nelt
        do iface=1,nsides
          
          if(cbc(iface,ie).ne.3)then
            il1 = idel(1,  1,  iface,ie)
            il2 = idel(lx1,1,  iface,ie)
            il3 = idel(1,  lx1,iface,ie)
            il4 = idel(lx1,lx1,iface,ie)
            ig1 = idmo(1,  1,  1,1,iface,ie)
            ig2 = idmo(lx1,1,  1,2,iface,ie)
            ig3 = idmo(1,  lx1,2,1,iface,ie)
            ig4 = idmo(lx1,lx1,2,2,iface,ie)

c$OMP ATOMIC
            tmort(ig1) = tmort(ig1)+tx(il1)*third
c$OMP ATOMIC
            tmort(ig2) = tmort(ig2)+tx(il2)*third
c$OMP ATOMIC
            tmort(ig3) = tmort(ig3)+tx(il3)*third
c$OMP ATOMIC
            tmort(ig4) = tmort(ig4)+tx(il4)*third
c$OMP ATOMIC
            mormult(ig1) = mormult(ig1)+third
c$OMP ATOMIC
            mormult(ig2) = mormult(ig2)+third
c$OMP ATOMIC
            mormult(ig3) = mormult(ig3)+third
c$OMP ATOMIC
            mormult(ig4) = mormult(ig4)+third

            do  col=2,lx1-1
              do j=2,lx1-1
                il=idel(j,col,iface,ie)
                ig=idmo(j,col,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)
c$OMP ATOMIC
                mormult(ig)=mormult(ig)+1.d0
              end do
            end do

            if(idmo(lx1,1,1,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(j,1,iface,ie)
                ig=idmo(j,1,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
c$OMP ATOMIC
                mormult(ig)=mormult(ig)+0.5d0
              end do
            end if

            if(idmo(lx1,2,1,2,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(lx1,j,iface,ie)
                ig=idmo(lx1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
c$OMP ATOMIC
                mormult(ig)=mormult(ig)+0.5d0
              end do
            end if

            if(idmo(2,lx1,2,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(j,lx1,iface,ie)
                ig=idmo(j,lx1,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
c$OMP ATOMIC
                mormult(ig)=mormult(ig)+0.5d0
               end do
            end if

            if(idmo(1,lx1,1,1,iface,ie).eq.0)then
              do j=2,lx1-1
                il=idel(1,j,iface,ie)
                ig=idmo(1,j,1,1,iface,ie)
c$OMP ATOMIC
                tmort(ig)=tmort(ig)+tx(il)*0.5d0
c$OMP ATOMIC
                mormult(ig)=mormult(ig)+0.5d0
              end do
            end if
          end if!nnje=1
        end do
      end do
c$OMP END DO NOWAIT
c$OMP END PARALLEL

      return
      end