      program cbsu3_dlta ! Berg Jan 11 2009. 
C MPI checkerboard for SU3 nhit with Cabibbo-Marinari. Perodic 
C boundary conditions and double-layered torus with two beta values.
C Version a: Plain    send/receive (mpia extensions).
C Version b: Buffered send/receive (replace mpia by mpib).
C Measurements of action, spacelike, timelike plaquettes. 
C Recalculation of action before each measurement is only 
C needed for nlat=2, lat2=.true.. 
      include '../../Libs/Fortran/implicit.08'
      include 'mpif.h'
      include '../../Libs/Fortran/constants.08'
      character cmy*4
      include 'latmpi.par'
      include 'mc.par'
      include '../../Libs/MPI_par/common_cblat.f'
      include '../../Libs/MPISU3/common_cbsu3.f'
      ltest=.true.
      ltest=.false.
      call mpi_init(ierr)
      call mpi_comm_rank(mpi_comm_world,my_id,ierr)
      if(my_id.eq.0) call 
     &  write_progress(iud1,"mpia: nreq,nequi,one:",nreq,nequi,one)
c
      if(my_id.eq.0) write(iuo,'(/,"MPI cbsu3_dlt: nlat,",
     &  "nhit,beta0,beta1 =",I2,I3,2F12.8)') nlat,nhit,beta0,beta1
      if(nhit.le.0.or.nhit.gt.3) ltest=.true.
c
      write(cmy,'(i4.4)') my_id
      if(lud2) open(iud2,file="MPI"//cmy//".d",form='formatted',
     &              status='unknown')
      call cbsu3_2init_mpi             ! Initialization.
      if(lud2) write(iud2,'(" cbsu3_dlt: cbsu3_2init_mpi done.")')
      if(ltest) then ! -------------------------------------------
        if(my_id.eq.0) write(iuo,'(/,"cbsu3_dlt_mpi: ltest",/)')
        if(lud2) write(iud2,'(/,"cbsu3_dlt_mpi: ltest.",/)')
        if(lud2) close(iud2) ! iud1 should already be closed.
        call mpi_finalize(ierr)
      stop "cbsu3_dlt: ltest."
      endif ! ----------------------------------------------------
      call cbsu3_actdif_mpi(actdif,actsum1,actsum2,my_id) 
      if(lud2) write(iud2,'(" cbsu3_dlt: actdif ok after start.")')
      if(my_id.eq.0) write(iuo,'(/,"  call write_act_mpi:")')
      call write_act_mpi(my_id,izero,acpt,actdif,actsum1,actsum2) 
      call mpi_barrier(mpi_comm_world,ierr)
c
      if(lud2) write(iud2,'(/," Equi: nreq, nequi =",2I10)') nreq,nequi
      if(my_id.eq.0) write(iuo,'(/," Equilibration started...")')
      do ireq=1,nreq
        if(my_id.eq.0) call 
     &    write_progress(iud1,"ireq,nreq,act:",ireq,nreq,act)
        do iequi=1,nequi ! Sweeps for reaching equilibrium.
          call cbsu3_2hbnhit_mpi(my_id) ! Heatbath DLT.
        end do ! Check action:
        call cbsu3_actdif_mpi(actdif,actsum1,actsum2,my_id) 
        acpt=acpt/a0prop
      end do
      call write_act_mpi(my_id,izero,acpt,actdif,actsum1,actsum2) 
      if(lud2) write(iud2,'(/," Equilibration done acpt =",F10.4)') acpt
      if(my_id.eq.0) write(iuo,'(/," Equilibration, actdif done,",
     &               " acpt, a0prop =",F10.4,G15.6)') acpt,a0prop
      if(lud2) write(iud2,'(" actdif,act1,act2:",3G15.6)') 
     &                        actdif,(actsum1/mpmpi),(actsum2/mpmpi)
      call mpi_barrier(mpi_comm_world,ierr)      
c
c Writing header information into file time series (action)
      open(iud1,file=cfln//cfile//".D",form="unformatted",
     &                                 status="unknown")
      write(iud1) beta0,beta1,nd,nlat,ms,mlink,nla,ndmpi,msmpi,nla_mpi,
     &            nreq,nequi,nrpt,nmeas,nsw
      close(iud1)
      if(my_id.eq.0) write(iuo,'(/,1X,"irpt,act,actdif,acpt,tsa(1),",
     &                      "tspr(1),tspi(1),tsk1r(1),tsk1i(1):",/)')
      if(lud2) write(iud2,
     &  '(/,5X,"irpt, action/mp, rounding error, acpt rate:",/)')
      do irpt=1,nrpt ! Repetitions.
        iact=nint(act)
        if(my_id.eq.0) call 
     &    write_progress(iud1,"irpt,iact,acpt:",irpt,iact,acpt)
        acpt=zero
        a_min=act
        a_max=act
        do imeas=1,nmeas  ! Measurements loop.
          do isw=1,nsw
            call cbsu3_2hbnhit_mpi(my_id) ! SU3 Cabbibo-Marinari.
          end do
          call cbsu3_actdif_mpi(actdif,actsum1,actsum2,my_id) 
          tsa(imeas)=act/mp ! Data collection (measurement).
          call cbsu3_wloops_mpi(imeas,my_id)            
        end do
        acpt=acpt/a0prop
        call cbsu3rw_meas(irpt,iud1,iud3,ione) ! Write measurements.
        if(lud2) write(iud2,'(I9,2G16.7,F9.3)') irpt,act/mp,actdif,acpt
        if(my_id.eq.0) then
          write(iuo,'(I6,4G15.6)') irpt,act,actdif,acpt,tsa(1)
          write(iuo,'(6X,4G15.6)') tspr(1),tspi(1),tsk1r(1),tsk1i(1)
        endif
        call mpi_barrier(mpi_comm_world,ierr)      
      end do
      call write_act_mpi(my_id,izero,acpt,actdif,actsum1,actsum2) 
c
      close(iud1)
      if(lud2) close(iud2)
      call mpi_finalize(ierr)
      stop
      end

      BLOCK DATA
      include '../../Libs/Fortran/implicit.08'
      include '../../Libs/Fortran/constants.08'
      include 'latmpi.par'
      parameter(npointer=nd*(msc+mbcsh))
      include '../../Libs/MPI_par/common_cblat.f'
      include 'latmpi.dat'
C For test purposes only:
      data ipf1/npointer*mione/, ipf2/npointer*mione/
      data ipb1/npointer*mione/, ipb2/npointer*mione/ 
      END


C Modular Fortran routines:
      include '../../Libs/Fortran/isfun.f'
      include '../../Libs/Fortran/ipointer.f'
      include '../../Libs/Fortran/ixcor.f'
      include '../../Libs/Fortran/lat_init.f'
      include '../../Libs/Fortran/nsfun.f'
      include '../../Libs/Fortran/razero.f'
      include '../../Libs/Fortran/ranmar.f'
      include '../../Libs/Fortran/rmafun.f'
      include '../../Libs/Fortran/rmaset.f'
      include '../../Libs/Fortran/rmasave.f'
      include '../../Libs/Fortran/sum_fun.f'
      include '../../Libs/Fortran/write_progress.f'
C LGT Checkerboard:
      include '../../Libs/Fortran/istoic.f' ! Checkerbord ic from is.
C SU2 routine:
      include '../../Libs/Fortran/su2_a0nhit.f'   ! Generates SU2 a0.

C SU3 modular routines:
      include '../../Libs/SU3/su3init0.f'     ! SU3 matrix put to 0.
      include '../../Libs/SU3/su3init1.f'     ! SU3 matrix put to 1.
      include '../../Libs/SU3/su3add_m_m.f'
      include '../../Libs/SU3/su3addb_m_m.f'
      include '../../Libs/SU3/su3copy_m_m.f'
      include '../../Libs/SU3/su3mult_mh_mh_m.f'
      include '../../Libs/SU3/su3mult_m_mh_m.f'
      include '../../Libs/SU3/su3mult_m_m_m.f'
      include '../../Libs/SU3/su3reunit.f'
      include '../../Libs/SU3/su3_b2nhitupdt.f' ! nhit update.
      include '../../Libs/SU3/csu3_start.f'     ! Start configuration.

C Modular MPI routines:
      include '../../Libs/MPI/lat2a_init.f' ! Double-layered torus: 
      include '../../Libs/MPI/lat2b_init.f' ! Couple lattice 1 and 2.

C LGT MPI checkerboard routines:
      include '../../Libs/MPI_par/cblat_init.f'
      include '../../Libs/MPI_par/cblgtpnt2.f'     ! Final LGT pointers.
      include '../../Libs/MPI_par/cblgtpointer.f'
      include '../../Libs/MPI_par/cbpointer.f'
      include '../../Libs/MPI_par/cpointer.f'
      include '../../Libs/MPI_par/isglobal.f'
      include '../../Libs/MPI_par/write_act_mpi.f' ! Write act.

C SU3 MPI checkerboard routines:
      include '../../Libs/MPISU3/cbsu3_act_mpi.f'   ! Calculate action.
      include '../../Libs/MPISU3/cbsu3_actdif_mpi.f'! Check action.
      include '../../Libs/MPISU3/cbsu3_bnd_mpi.f'   ! Gather boundary.
      include '../../Libs/MPISU3/cbsu3_bnd1a_mpia.f'! Gather boundary. 
      include '../../Libs/MPISU3/cbsu3_bnd1b_mpia.f'! Gather boundary.
      include '../../Libs/MPISU3/cbsu3_bnd2a_mpia.f'! Gather boundary.
      include '../../Libs/MPISU3/cbsu3_bnd2b_mpia.f'! Gather boundary.
      include '../../Libs/MPISU3/cbsu3_wloops_mpi.f'! Measures Wloops.
      include '../../Libs/MPISU3/cbsu3rw_meas.f'    ! R/W measurements.
C Double-layered torus SU3 routines:
      include '../../Libs/MPISU3/cbsu3_2init_mpi.f'  ! Initialize SU3.
      include '../../Libs/MPISU3/cbsu3_2hbnhit_mpi.f'! MCHB updating.
      include '../../Libs/MPISU3/cbsu3_bstaple1.f'   ! Staple checkb. 1.
      include '../../Libs/MPISU3/cbsu3_bstaple2.f'   ! Staple checkb. 2.
      include '../../Libs/MPISU3/cbsu3_iba_mpi.f'   ! Define iba arrays.
