 MODULE tooldebug

   !!======================================================================
   !!                   ***  MODULE toolmpi  ***
   !! 
   !! NPROCS= total no of procs using  =>MYPROCS
   !! NPROCJ= number of division on J direction =>MYPROCJ
   !! NPROCI= number of division on I direction =>MYPROCI
   !! IGROUNDPOINT= BLANK point, i.e. no mpi process is used for that local area
   !! NBBLANK=COUNT(PROC==IGROUDPOINT). i.e. total number of non-wet points
   !! IWETPOINT= wet point i.e. COUNT(PROC==IWETPOINT)==NPROCS
   !! NPROCI * NPROCJ=  NPROCS+NBBLANK
   !!
   !!======================================================================

#include "toolcpp.h"

   !! * Modules used
   USE parameters, ONLY : rsh,rlg, liminm2,limaxp2,ljminm2,ljmaxp2, kmax, limin, ljmin, limax, ljmax, imax, jmax, liminm1
#if defined key_MPI || defined key_MPI_2D
!   USE comvars2d,  ONLY : type_mpi_rsh, type_mpi_rlg
   USE toolmpi, ONLY : MPI_COMM_MARS
#endif

   IMPLICIT NONE

#if defined key_MPI_2D
   INCLUDE 'mpif.h'
#endif

   PRIVATE

   !! * Accessibility

   PUBLIC debug_ini,   &       ! called by main.F90
          check_tab3d, &       ! called throughout the code
          check_tab2d

   !! * Interfaces
   INTERFACE check_tab2d
     MODULE PROCEDURE check_tab2d_real,check_tab2d_dble
   END INTERFACE check_tab2d

   INTERFACE check_tab3d
     MODULE PROCEDURE check_tab3d_real,check_tab3d_dble
   END INTERFACE check_tab3d

   CONTAINS

   !!======================================================================

  subroutine debug_ini()

      ! open binary file
#ifdef key_MPI_2D
      open(107,file="check_file",form='unformatted',action="read")
#else
      open(107,file="check_file",form='unformatted',status="replace")
#endif

  end subroutine debug_ini

   !!======================================================================

  subroutine check_tab3d_real(tab,lbb,ubb,comment,locimin,locimax,locjmin,locjmax)

   !! * Arguments
   integer,dimension(3),INTENT(in) :: lbb, ubb
   integer,intent(in),optional     :: locimin,locimax,locjmin,locjmax
   real(KIND=4),dimension(lbb(1):ubb(1),lbb(2):ubb(2),lbb(3):ubb(3)),INTENT(in) :: tab
   character*(*) :: comment

   !! * Local declarations
   integer imaxseq,jmaxseq
   integer lb(3),ub(3)
   real,dimension(:,:,:),allocatable :: tabread
   integer i0,j0,k,i,j,i1,i2,j1,j2,k1,k2
   !integer iseq1, iseq2, jseq1, jseq2 
   logical mystop         
#if defined key_MPI_2D
   logical globstop
   integer ierr
#endif 

   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter CHECK_TAB3D_REAL routine'

#if ! defined key_MPI_2D
   write(107)imax,jmax
   write(107)lbound(tab)
   write(107)ubound(tab)
   write(107)tab
   print *,'WRITE ',comment,  & 
#ifdef key_agrif
         ' PASSED',' ON GRID ',Agrif_CFixed()
#else
         ' PASSED'
#endif    
#else
   read(107)imaxseq,jmaxseq
   read(107)lb
   read(107)ub
   allocate(tabread(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
   read(107)tabread

   k1 = lbb(1)
   k2 = ubb(1)

   IF (PRESENT(locimin)) THEN
     i1=locimin
   ELSE
     i1=lbb(2)
   END IF

   IF (PRESENT(locimax)) THEN
     i2=locimax
   ELSE
     i2=ubb(2)
   END IF

   IF (PRESENT(locjmin)) THEN
     j1=locjmin
   ELSE
     j1=lbb(3)
   END IF

   IF (PRESENT(locjmax)) THEN
     j2=locjmax
   ELSE
     j2=ubb(3)
   END IF

   !iseq1 = 0
   !iseq2 = imaxseq
   !jseq1 = 0
   !jseq2 = jmaxseq
      
   mystop =.false.
   DebugExit : do k=1,kmax
 !               do j=max(j1,jseq1-jminmpi+1),min(j2,jseq2-jminmpi+1)
 !                j0 = j+jminmpi-1
 !               do i=max(i1,iseq1-iminmpi+1),min(i2,iseq2-iminmpi+1)     
 !                   i0 = i+iminmpi-1
                 do j=j1,j2
                   do i=i1,i2
                     if (tabread(k,i,j)/=tab(k,i,j)) then
                       write(*,'(A,A,2x,3i4,3e20.12)')'BUGBIN = ',   &
                                                       comment,    &
                                                       k,i,j,      &
                                                       tabread(k,i,j),tab(k,i,j),    &
                                                       abs(tabread(k,i,j)-tab(k,i,j))
#ifdef key_agrif
                       print *,'GRID# ',Agrif_CFixed()
#endif    
                       mystop=.true.
                       exit DebugExit
                     endif
                   enddo
                 enddo
               enddo DebugExit
#if defined key_MPI_2D
   call MPI_allreduce(mystop,globstop,1,  &
                      MPI_LOGICAL,MPI_LOR,MPI_COMM_MARS,ierr)
   mystop=globstop
#endif
   if (mystop) stop

   deallocate(tabread)
#endif
#if defined key_MPI_2D
   call MPI_Barrier(MPI_COMM_MARS,ierr)
#endif
#if defined key_MPI_2D
   print *,' CHECK ',comment,  & 
#ifdef key_agrif
           ' PASSED',' ON GRID ',Agrif_CFixed()
#else
           ' PASSED'
#endif    
#endif

   PRINT_DBG*, 'exit CHECK_TAB3D_REAL routine'

  END subroutine check_tab3d_real

   !!======================================================================

  subroutine check_tab3d_dble(tab,lbb,ubb,comment,locimin,locimax,locjmin,locjmax)

   !! * Arguments
   integer,dimension(3),INTENT(in) :: lbb, ubb
   integer,intent(in),optional     :: locimin,locimax,locjmin,locjmax
   real(KIND=8),dimension(lbb(1):ubb(1),lbb(2):ubb(2),lbb(3):ubb(3)),INTENT(in) :: tab
   character*(*) :: comment

   !! * Local declarations
   integer imaxseq,jmaxseq
   integer lb(3),ub(3)
   real,dimension(:,:,:),allocatable :: tabread
   integer i0,j0,k,i,j,i1,i2,j1,j2,k1,k2
   !integer iseq1, iseq2, jseq1, jseq2 
   logical mystop         
#if defined key_MPI_2D
   logical globstop
   integer ierr
#endif 

   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter CHECK_TAB3D_DBLE routine'

#if ! defined key_MPI_2D
   write(107)imax,jmax
   write(107)lbound(tab)
   write(107)ubound(tab)
   write(107)tab
   print *,'WRITE ',comment,  & 
#ifdef key_agrif
         ' PASSED',' ON GRID ',Agrif_CFixed()
#else
         ' PASSED'
#endif    
#else
   read(107)imaxseq,jmaxseq
   read(107)lb
   read(107)ub
   allocate(tabread(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
   read(107)tabread

   k1 = lbb(1)
   k2 = ubb(1)

   IF (PRESENT(locimin)) THEN
     i1=locimin
   ELSE
     i1=lbb(2)
   END IF

   IF (PRESENT(locimax)) THEN
     i2=locimax
   ELSE
     i2=ubb(2)
   END IF

   IF (PRESENT(locjmin)) THEN
     j1=locjmin
   ELSE
     j1=lbb(3)
   END IF

   IF (PRESENT(locjmax)) THEN
     j2=locjmax
   ELSE
     j2=ubb(3)
   END IF

   !iseq1 = 0
   !iseq2 = imaxseq
   !jseq1 = 0
   !jseq2 = jmaxseq
      
   mystop =.false.
   DebugExit : do k=1,kmax
 !               do j=max(j1,jseq1-jminmpi+1),min(j2,jseq2-jminmpi+1)
 !                j0 = j+jminmpi-1
 !               do i=max(i1,iseq1-iminmpi+1),min(i2,iseq2-iminmpi+1)     
 !                   i0 = i+iminmpi-1
                 do j=j1,j2
                   do i=i1,i2
                     if (tabread(k,i,j)/=tab(k,i,j)) then
                       write(*,'(A,A,2x,3i4,3e20.12)')'BUGBIN = ',   &
                                                       comment,    &
                                                       k,i,j,      &
                                                       tabread(k,i,j),tab(k,i,j),    &
                                                       abs(tabread(k,i,j)-tab(k,i,j))
#ifdef key_agrif
                       print *,'GRID# ',Agrif_CFixed()
#endif    
                       mystop=.true.
                       exit DebugExit
                     endif
                   enddo
                 enddo
               enddo DebugExit
#if defined key_MPI_2D
   call MPI_allreduce(mystop,globstop,1,  &
                      MPI_LOGICAL,MPI_LOR,MPI_COMM_MARS,ierr)
   mystop=globstop
#endif
   if (mystop) stop

   deallocate(tabread)
#endif
#if defined key_MPI_2D
   call MPI_Barrier(MPI_COMM_MARS,ierr)
#endif
#if defined key_MPI_2D
   print *,' CHECK ',comment,  & 
#ifdef key_agrif
           ' PASSED',' ON GRID ',Agrif_CFixed()
#else
           ' PASSED'
#endif    
#endif

   PRINT_DBG*, 'exit CHECK_TAB3D_DBLE routine'

  END subroutine check_tab3d_dble

   !!======================================================================

  subroutine check_tab2d_real(tab,lbb,ubb,comment,locimin,locimax,locjmin,locjmax)

   !! * Arguments
   integer,dimension(2),INTENT(in) :: lbb, ubb
   integer,intent(in),optional     :: locimin,locimax,locjmin,locjmax
   real(KIND=4),dimension(lbb(1):ubb(1),lbb(2):ubb(2)),INTENT(in) :: tab
   character*(*) :: comment

   !! * Local declarations
   integer imaxseq,jmaxseq
   integer lb(2),ub(2)
   real,dimension(:,:),allocatable :: tabread
   integer i0,j0,k,i,j,i1,i2,j1,j2
   logical mystop         
#if defined key_MPI_2D
   logical globstop
   integer ierr
#endif 

   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter CHECK_TAB2D_REAL routine'

#if ! defined key_MPI_2D
   write(107)imax,jmax
   write(107)lbound(tab)
   write(107)ubound(tab)
   write(107)tab
   print *,'WRITE ',comment,  & 
#ifdef key_agrif
         ' PASSED',' ON GRID ',Agrif_CFixed()
#else
         ' PASSED'
#endif    
#else
   read(107)imaxseq,jmaxseq
   read(107)lb
   read(107)ub
   allocate(tabread(lb(1):ub(1),lb(2):ub(2)))
   read(107)tabread

   IF (PRESENT(locimin)) THEN
     print*,'locimin'
     i1=locimin
   ELSE
     i1=lbb(1)
   END IF

   IF (PRESENT(locimax)) THEN
     i2=locimax
   ELSE
     i2=ubb(1)
   END IF

   IF (PRESENT(locjmin)) THEN
     j1=locjmin
   ELSE
     j1=lbb(2)
   END IF

   IF (PRESENT(locjmax)) THEN
     j2=locjmax
   ELSE
     j2=ubb(2)
   END IF

   mystop =.false.
   DebugExit : do j=j1,j2
                 do i=i1,i2
                   if (tabread(i,j)/=tab(i,j)) then
                     write(*,'(A,A,2x,2i4,3e20.12)')'BUGBIN = ',   &
                                                     comment,    &
                                                     i,j,        &
                                                     tabread(i,j),tab(i,j),    &
                                                     abs(tabread(i,j)-tab(i,j))
#ifdef key_agrif
                     print *,'GRID# ',Agrif_CFixed()
#endif
                     mystop=.true.
                     exit DebugExit
                   endif
                 enddo
               enddo DebugExit
#if defined key_MPI_2D
   call MPI_allreduce(mystop,globstop,1,  &
                      MPI_LOGICAL,MPI_LOR,MPI_COMM_MARS,ierr)
   mystop=globstop
#endif
   if (mystop) stop

   deallocate(tabread)
#endif
#if defined key_MPI_2D
   call MPI_Barrier(MPI_COMM_MARS,ierr)
#endif
#if defined key_MPI_2D
   print *,' CHECK ',comment,  & 
#ifdef key_agrif
           ' PASSED',' ON GRID ',Agrif_CFixed()
#else
           ' PASSED'
#endif    
#endif

   PRINT_DBG*, 'exit CHECK_TAB2D_REAL routine'

  END subroutine check_tab2d_real

   !!======================================================================

  subroutine check_tab2d_dble(tab,lbb,ubb,comment,locimin,locimax,locjmin,locjmax)

   !! * Arguments
   integer,dimension(2),INTENT(in) :: lbb, ubb
   integer,intent(in),optional     :: locimin,locimax,locjmin,locjmax
   real(KIND=8),dimension(lbb(1):ubb(1),lbb(2):ubb(2)),INTENT(in) :: tab
   character*(*) :: comment

   !! * Local declarations
   integer imaxseq,jmaxseq
   integer lb(2),ub(2)
   real,dimension(:,:),allocatable :: tabread
   integer i0,j0,k,i,j,i1,i2,j1,j2
   logical mystop         
#if defined key_MPI_2D
   logical globstop
   integer ierr
#endif 

   !!----------------------------------------------------------------------
   !! * Executable part

   PRINT_DBG*, 'enter CHECK_TAB2D_REAL routine'

#if ! defined key_MPI_2D
   write(107)imax,jmax
   write(107)lbound(tab)
   write(107)ubound(tab)
   write(107)tab
   print *,'WRITE ',comment,  & 
#ifdef key_agrif
         ' PASSED',' ON GRID ',Agrif_CFixed()
#else
         ' PASSED'
#endif    
#else
   read(107)imaxseq,jmaxseq
   read(107)lb
   read(107)ub
   allocate(tabread(lb(1):ub(1),lb(2):ub(2)))
   read(107)tabread

   IF (PRESENT(locimin)) THEN
     i1=locimin
   ELSE
     i1=lbb(1)
   END IF

   IF (PRESENT(locimax)) THEN
     i2=locimax
   ELSE
     i2=ubb(1)
   END IF

   IF (PRESENT(locjmin)) THEN
     j1=locjmin
   ELSE
     j1=lbb(2)
   END IF

   IF (PRESENT(locjmax)) THEN
     j2=locjmax
   ELSE
     j2=ubb(2)
   END IF

   mystop =.false.
   DebugExit : do j=j1,j2
                 do i=i1,i2
                   if (tabread(i,j)/=tab(i,j)) then
                     write(*,'(A,A,2x,2i4,3e20.12)')'BUGBIN = ',   &
                                                     comment,    &
                                                     i,j,        &
                                                     tabread(i,j),tab(i,j),    &
                                                     abs(tabread(i,j)-tab(i,j))
#ifdef key_agrif
                     print *,'GRID# ',Agrif_CFixed()
#endif
                     mystop=.true.
                     exit DebugExit
                   endif
                 enddo
               enddo DebugExit
#if defined key_MPI_2D
   call MPI_allreduce(mystop,globstop,1,  &
                      MPI_LOGICAL,MPI_LOR,MPI_COMM_MARS,ierr)
   mystop=globstop
#endif
   if (mystop) stop

   deallocate(tabread)
#endif
#if defined key_MPI_2D
   call MPI_Barrier(MPI_COMM_MARS,ierr)
#endif
#if defined key_MPI_2D
   print *,' CHECK ',comment,  & 
#ifdef key_agrif
           ' PASSED',' ON GRID ',Agrif_CFixed()
#else
           ' PASSED'
#endif    
#endif

   PRINT_DBG*, 'exit CHECK_TAB2D_DBLE routine'

  END subroutine check_tab2d_dble

   !!======================================================================

END MODULE tooldebug
