      subroutine cblat_init(iwf1,iwf2,iwb1,iwb2) ! Bernd Berg Dec 7 2007.
C MPI checkerboard lattice: Initialize number of lattice sites and links.
C                           Initialize pointer arrays.
C If lbcex=.true. (boundary exchange): Overwrite some of the checkerboard
C                                      ipf1, ipb1, ipf2, ipb2 arrays.
C Work arrays (not needed later): ix, iasc, iwf1,2, iwb1,2, 
C                                 ipfcnt1,2, ipbcnt1,2.
      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'
C Temporary arrays:
      dimension iwf1(ndmpi,msc),iwf2(ndmpi,msc),
     &          iwb1(ndmpi,msc),iwb2(ndmpi,msc)
      dimension ipfbcnt1(ndmpi),ipfbcnt2(ndmpi),
     &          ipbbcnt1(ndmpi),ipbbcnt2(ndmpi),ix(nd),iasc(ms)
      ltest=.true.
      ltest=.false.
      call mpi_comm_rank(mpi_comm_world,my_id,ierr)
C
      isc1=0
      isc2=0
      do is=1,ms
        ic=istoic(is,nla,nd,ix)
        if(ic.eq.1) then
          isc1=isc1+1
          iasc(is)=isc1
          iasc1(isc1)=is
        else
          isc2=isc2+1
          iasc(is)=isc2
          iasc2(isc2)=is
        endif
      end do
C
C Initialize checkerboard pointers:
      do is=1,ms
        call cpointer(is,iasc,ix) ! checkerboard pointers.
      end do
      if(ltest) then
        rewind iud2
        write(iud2,'(/,"cblat_init with ltest:",/)')
        write(iud2,'("ic isc ipf ipb",/)')
        do isc=1,msc
          write(iud2,'(" 1",i4,2(4x,4i4))') isc,(ipf1(id,isc),id=1,nd),
     &                                          (ipb1(id,isc),id=1,nd)
          write(iud2,'(" 2",i4,2(4x,4i4))') isc,(ipf2(id,isc),id=1,nd),
     &                                          (ipb2(id,isc),id=1,nd)
        enddo
      endif
C
      if(ltest.or.(ndmpi.gt.nd).or.(ndmpi.lt.1)) then
        if(ndmpi.gt.nd) write(iuo,'("Error ndmpi.gt.nd.")')
        if(ndmpi.lt.1) write(iuo,'("Error ndmpi.lt.1.")')
        if(my_id.eq.0) write(iuo,'("cblat_init stop: ltest.")')
        close(iud2)
        call mpi_finalize(ierr)
      stop
      endif
C
      if(.not.lbcex) return
C
C Initialize boundary pointers and change checkerboard pointers:
C
      do id=1,ndmpi
        do isc=1,msc
          iwf1(id,isc)=ipf1(id,isc)
          iwf2(id,isc)=ipf2(id,isc)
          iwb1(id,isc)=ipb1(id,isc)
          iwb2(id,isc)=ipb2(id,isc)
        enddo
        ipfbcnt1(id)=0
        ipfbcnt2(id)=0
        ipbbcnt1(id)=0
        ipbbcnt2(id)=0
      enddo
      do is=1,ms
        call ixcor(ix,nla,is,nd)
        ix_sum=0
        do id=1,nd
          ix_sum=ix_sum+ix(id)
        end do
        ic=1+mod(ix_sum,2)
        call cbpointer(ic,is,ix,iasc,iwf1,iwf2,iwb1,iwb2, 
     &                 ipfbcnt1,ipfbcnt2,ipbbcnt1,ipbbcnt2)
      end do
C
      lstop=.false.     
      do id=1,ndmpi
        if(ipfbcnt1(id).ne.mscb) lstop=.true.
        if(ipfbcnt2(id).ne.mscb) lstop=.true.
        if(ipbbcnt1(id).ne.mscb) lstop=.true.
        if(ipbbcnt2(id).ne.mscb) lstop=.true.
      enddo
      if(lstop) write(6,'(/,1x,"cblat_init:")')
      if(lstop) write(6,'(1x,"ipfbcnt1:",4I9)') ipfbcnt1
      if(lstop) write(6,'(1x,"ipfbcnt2:",4I9)') ipfbcnt2
      if(lstop) write(6,'(1x,"ipbbcnt1:",4I9)') ipbbcnt1
      if(lstop) write(6,'(1x,"ipbbcnt2:",4I9)') ipbbcnt2
      if(lstop) call mpi_finalize(ierr)
      if(lstop) stop "cblat_init: lstop."
C
C Only for LGT: call to cblgtpointer(iwf1,iwf2,iwb1,iwb2) follows.
C
      if(ltest) then
        write(iud2,'(/,"cblat_init: BC pointers my_id =",I8)') my_id
        write(iud2,'(/,2X,"ipfbcnt1:",I6,3I8)') ipfbcnt1 ! count 1 etc.
        do id=1,ndmpi
          write(iud2,'(2X,"id,ipfb1:",17I4)') id,(ipfb1(i,id),i=1,mscb)
        enddo
        write(iud2,'(/,2X,"ipfbcnt2:",I6,3I8)') ipfbcnt2
        do id=1,ndmpi
          write(iud2,'(2X,"id,ipfb2:",17I4)') id,(ipfb2(i,id),i=1,mscb)
        enddo
        write(iud2,'(/,2X,"ipbbcnt1:",I6,3I8)') ipbbcnt1
        do id=1,ndmpi
          write(iud2,'(2X,"id,ipbb1:",17I4)') id,(ipbb1(i,id),i=1,mscb)
        enddo
        write(iud2,'(/,2X,"ipbbcnt2:",I6,3I8)') ipbbcnt2
        do id=1,ndmpi
          write(iud2,'(2X,"id,ipbb2:",17I4)') id,(ipbb2(i,id),i=1,mscb)
        enddo
        write(iud2,'(/,"cblat_init: done.",/)') 
      endif
C
      return
      end 
