      subroutine cblgtpnt2(iwf1,iwf2,iwb1,iwb2,my_id) 
C Bernd Berg May 30 2008. Set LGT pointers accross the border.
C Calling order: cblat_init (-> cpointer), cblgtpointer, cblgtpnt2.
      include '../../Libs/Fortran/implicit.sta'
      include 'mpif.h'
      include '../../Libs/Fortran/constants.par'
      include '../../Libs/Fortran_par/latmpi.par'
      include '../../Libs/Fortran_par/mc.par'
      include '../../Libs/MPI_par/common_cblat.f'
c     include '../../Libs/MPI_par/common_cbu1.f'
      include '../../Libs/MPI_par/common_mpi.f'
      dimension iwf1(ndmpi,msc),iwf2(ndmpi,msc),
     &          iwb1(ndmpi,msc),iwb2(ndmpi,msc)
      ltest=.true.
      ltest=.false.
C
      if(ltest) write(iud2,'(/,"  cblgtpnt2:",/)')
      ismpi=my_id+1
      iddmpi=0
      i1label=msc+mbcs ! Scatter label (to be iterated).
      i2label=msc+mbcs ! Scatter label (to be iterated).
      do id1mpi=1,ndmpi
        do id2mpi=1,ndmpi
        if(id1mpi.ne.id2mpi) then
          iddmpi=iddmpi+1
          if(iddmpi.gt.nddmpi) then
            write(iud2,'("Error: iddmpi.gt.nddmpi")')
            if(my_id.eq.0) write(iuo,'("Error: iddmpi.gt.nddmpi")')
          goto1
          endif
          isf1mpi=ipf_mpi(id1mpi,ismpi)
          isb2mpi=ipb_mpi(id2mpi,ismpi)
          if(ltest) write(iud2,'("  ismpi,id1mpi,id2mpi,iddmpi =",4I4)') 
     &                              ismpi,id1mpi,id2mpi,iddmpi
          icnt1=0
          icnt2=0
          do isc1=1,msc ! Local position in checkerboard 1.
            isc2f1=ipf1(id1mpi,isc1) ! id1mpi forward  to checkerboard 2.
            isc2b2=ipb1(id2mpi,isc1) ! id2mpi backward to checkerboard 2.
            if(isc2f1.gt.msc.and.isc2b2.gt.msc) then
              icnt1=icnt1+1
              if(icnt1.gt.ns1fbb) then
                write(iud2,'("Error: icnt1.gt.ns1fbb.")') 
                if(my_id.eq.0) write(iuo,'("Error: icnt1.gt.ns1fbb.")')
              goto 1
              endif
              i1label=i1label+1 ! Label for received variables.
              if(i1label.gt.msc+mbcs+nsfbb) then
                write(iud2,'(/,"cblgtpnt2: i1label too large.")')
              goto 1
              endif
              ipf2(id1mpi,isc2b2)=i1label ! DEFINE position as needed.
              iwc2f1=iwf1(id1mpi,isc1)
              iwc2b2=iwb1(id2mpi,isc1)
              isb2f1mpi=ipf_mpi(id1mpi,isb2mpi)
C For gather from sublattice isf1mpi:
              isc1f1b2=ipb2(id2mpi,iwc2f1) 
              igathbb1(icnt1,iddmpi)=isc1f1b2 ! DEFINE gather checkerb 1.
            endif
          enddo
          if(icnt1.ne.ns1fbb) then
             write(iud2,'("Error: icnt1.ne.ns1fbb.")') 
             if(my_id.eq.0) write(iuo,'("Error: icnt1.gt.ns1fbb.")')
          goto 1
          endif
          do isc2=1,msc ! Local position in checkerboard 2, etc.
            isc1f1=ipf2(id1mpi,isc2)
            isc1b2=ipb2(id2mpi,isc2)
            if(isc1f1.gt.msc.and.isc1b2.gt.msc) then
              icnt2=icnt2+1
              if(icnt2.gt.ns1fbb) then
                write(iud2,'("Error: icnt2.gt.,ns1fbb")') 
                if(my_id.eq.0) write(iuo,'("Error: icnt2.gt.ns1fbb.")')
              goto 1
              endif
              i2label=i2label+1 ! Label for received variables.
              ipf1(id1mpi,isc1b2)=i2label ! DEFINE position as needed.
              iwc1f1=iwf2(id1mpi,isc2)
              iwc1b2=iwb2(id2mpi,isc2)
C For gather from sublattice isf1mpi:
              isc2f1b2=ipb1(id2mpi,iwc1f1)
              igathbb2(icnt2,iddmpi)=isc2f1b2 ! DEFINE gather checkerb 2.
            endif
          enddo
          if(icnt2.ne.ns1fbb) then
             write(iud2,'("Error: icnt2.ne.ns1fbb.")') 
             if(my_id.eq.0) write(iuo,'("Error: icnt2.gt.ns1fbb.")')
          goto 1
          endif
        endif
        enddo
      enddo
C
      if(i1label.ne.msc+mbcs+nsfbb) then
        write(iud2,'(/,"cblgtpnt2: i1label false.")')
      goto 1
      endif
      if(i2label.ne.msc+mbcs+nsfbb) then
        write(iud2,'(/,"cblgtpnt2: i2label false.")')
      goto 1
      endif
C
      if(.not.ltest) return
C
C     rewind iud2
      if(ltest) then
        write(iud2,'(/,"cblgtpnt2: pointers.",/)')
        write(iud2,'(2X,"msc, msc+mscb, msc+mbcs =   ",3I6,/)')
     &                   msc,(msc+mscb),(msc+mbcs)
        write(iud2,'(2X,"msc+mbcs/2, msc+mbcs+nsfbb =",2I6,/)')
     &                 (msc+mbcs/2),(msc+mbcs+nsfbb)
        write(iud2,'(3X,"isc",6X,"ipf1",24X,"ipf2",/)')
        do isc=(msc+1),(msc+mbcs)
          write(iud2,'(I6,4X,4I6,4X,4I6)') isc,(ipf1(id,isc),id=1,nd),
     &                                         (ipf2(id,isc),id=1,nd)
        enddo
C
        if(my_id.eq.0) write(iuo,'(/," cblgtpnt2: stop ltest.",/)')
        write(iud2,'(/,"cblgtpnt2: stop ltest.")')
        close(iud2)
        call mpi_finalize(ierr)
      stop "cblgtpnt2: ltest."
      endif
C -----------------------------
C
1     continue
      if(my_id.eq.0) write(iuo,'(/," cblgtpnt2: error stop.")')
      write(iud2,'(/,"cblgtpnt2: error stop.")')
      close(iud2)
      call mpi_finalize(ierr)
      stop 
      end
