      subroutine cpointer(is,iasc,ix) ! Bernd Berg Dec 8 2007.
C CHANGE to cbpointer.f.
C MPI Checkerboard forward and backward pointers.
C Pointers for boundary conditions: cbpointer (additional routine).
C Input:   is = number of lattice site, iasc array of isc labels.
C          ix auxiliary array for coordinates.
C Output:  ipf1,2, ipb1,2: forward and backward checkerboard pointers
C          on common_cblat.f
C 1 points from a site on checkerboard 1 to a site on checkerboard 2.
C 2 points from a site on checkerboard 2 to a site on checkerboard 1.
      include '../../Libs/Fortran/implicit.sta'
      include 'mpif.h'
      include '../../Libs/Fortran_par/latmpi.par'
      include '../../Libs/Fortran_par/mc.par' ! Defines unit iud2.
      include '../../Libs/MPI_par/common_cblat.f'
      dimension ix(nd),iasc(ms),nla2(nd)
      call mpi_comm_rank(mpi_comm_world,my_id,ierr)
      ltest=.true.
      ltest=.false.
C
      if(ltest.and.is.eq.1.and.my_id.eq.0)
     &  write(iuo,'(/,"cpointer with ltest=.true.: ",/)')
      ic=istoic(is,nla,nd,ix)
      isc=iasc(is)
      do id=1,nd ! Allow for distinct nlat=1 and nlat=2 lattices.
        nla2(id)=nla(id)
      enddo ! For nd we redefine on lattices 0,...,msmpi:
      if(my_id.lt.msmpi) nla2(nd)=nltau
C
      do id=1,nd ! Forward pointer (periodic bounday conditions):
        call ixcor(ix,nla,is,nd) ! Add zero unless nla2(id) is small:
        if(ltest) ixnd=ix(nd)
        ix(id)=mod(ix(id)+1,nla2(id))+(ix(id)/nla2(id))*nla2(id)
        if(ltest.and.id.eq.nd) then
          do i=1,nd-1
            if(ix(i).ne.0) goto 1
          enddo
          write(iud2,'("f:",5I4)') ic,isc,is,ixnd,ix(nd)
        endif
1       ipf=isfun(ix,nla,nd)
        iscf=iasc(ipf)
        if(ic.eq.1) ipf1(id,isc)=iscf
        if(ic.eq.2) ipf2(id,isc)=iscf
        if(ix(id).eq.nla(id)) stop "cpointer: error in ix/nla."
      enddo
C
      do id=1,nd ! Backward pointer (periodic boundary conditions):
        call ixcor(ix,nla,is,nd)
        if(ltest) ixnd=ix(nd)
        ix(id)=mod(ix(id)-1+nla2(id),nla2(id))+
     &    (ix(id)/nla2(id))*nla2(id) ! Adds zero unless nla2(id) is small.
        if(ltest.and.id.eq.nd) then
          do i=1,nd-1
            if(ix(i).ne.0) goto 2
          enddo
          write(iud2,'("b:",5I4)') ic,isc,is,ixnd,ix(nd)
        endif
2       ipb=isfun(ix,nla,nd)
        iscb=iasc(ipb)
        if(ic.eq.1) ipb1(id,isc)=iscb
        if(ic.eq.2) ipb2(id,isc)=iscb
      enddo
c     if(ltest.and.ic.eq.1.and.my_id.eq.0) write(iuo,'(2I4,2(4X,4I4))')
c    &  ic,isc,(ipf1(id,isc),id=1,nd),(ipb1(id,isc),id=1,nd)
c     if(ltest.and.ic.eq.2.and.my_id.eq.0) write(iuo,'(2I4,2(4X,4I4))')
c    &  ic,isc,(ipf2(id,isc),id=1,nd),(ipb2(id,isc),id=1,nd)
C
      if(ltest.and.is.eq.ms) then
        if(my_id.eq.0) write(iuo,'(/,"cpointer stop: ltest.",/)')
        close(iud2)
        call mpi_finalize(ierr)
      stop
      endif
      return
      end