 MODULE comcolig_mpi

!!======================================================================
!!                   ***  MODULE comcolig_mpi  ***
!!        !  2010-04  (T. Odaka) MPI2D (transpose_*, tr*_back)
!!        !  2010-07  (L. Debreu, F. Dumas) rewritting of ADI
!!
!!======================================================================
!! * Modules used

   USE parameters

!! * Accessibility

!! * Shared or public module variables

!! * Private variables
   REAL(kind=rlg),ALLOCATABLE,DIMENSION(:,:) :: caxe,cbxe,ccxe,cy2dxe
   REAL(kind=rsh),ALLOCATABLE,DIMENSION(:,:) :: cxeuv,rxeuv
   REAL(kind=rlg),ALLOCATABLE,DIMENSION(:,:) :: raxe,rbxe,rcxe,ry2dxe

 CONTAINS

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

  SUBROUTINE alloc_comcolig_mpi

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE alloc_comcolig_mpi  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE toolmpi, ONLY : ciminp2,cimaxm1
   USE toolmpi, ONLY : rjminp2,rjmaxm1

   IMPLICIT NONE

!! * Arguments

!! * Local declarations

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

   ALLOCATE(caxe(ciminp2:cimaxm1,jmin:jmax) )
   ALLOCATE(cbxe(ciminp2:cimaxm1,jmin:jmax) )
   ALLOCATE(ccxe(ciminp2:cimaxm1,jmin:jmax) )
   ALLOCATE(cy2dxe(ciminp2:cimaxm1,jmin:jmax) )
   ALLOCATE(cxeuv(ciminp2:cimaxm1,jmin:jmax) )
   caxe(:,:)=0.0_rlg;cbxe(:,:)=1.0_rlg;ccxe(:,:)=0.0_rlg;cy2dxe(:,:)=REAL(valmanq,rlg)
   cxeuv(:,:)=valmanq

   ALLOCATE(raxe(imin:imax,rjminp2:rjmaxm1) )
   ALLOCATE(rbxe(imin:imax,rjminp2:rjmaxm1) )
   ALLOCATE(rcxe(imin:imax,rjminp2:rjmaxm1) )
   ALLOCATE(ry2dxe(imin:imax,rjminp2:rjmaxm1) )
   ALLOCATE(rxeuv(imin:imax,rjminp2:rjmaxm1) )
   raxe(:,:)=0.0_rlg;rbxe(:,:)=1.0_rlg;rcxe(:,:)=0.0_rlg;ry2dxe(:,:)=REAL(valmanq,rlg)
   rxeuv(:,:)=valmanq

  END SUBROUTINE alloc_comcolig_mpi

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

  SUBROUTINE dealloc_comcolig_mpi

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE dealloc_comcolig_mpi  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   IMPLICIT NONE

!! * Arguments

!! * Local declarations

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

   DEALLOCATE(caxe,cbxe,ccxe,cy2dxe,cxeuv)
   DEALLOCATE(raxe,rbxe,rcxe,ry2dxe,rxeuv)

  END SUBROUTINE dealloc_comcolig_mpi

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

  SUBROUTINE transpose_col

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE transpose_col  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE parameters,ONLY: ljmin,ljmax
   USE toolmpi,   ONLY: give_ccount,get_ccount,sendrecv_rlg,mycproc,myIproc
   USE toolmpi,   ONLY: CI,LJ,ciminp2,cimaxm1,mincbudy,maxcbudy,cbudy
   USE toolmpi,   ONLY: mincproc,maxcproc
   USE toolmpi,   ONLY: proc
   USE comvars2d, ONLY: jb,jh
   USE comcolig2d,ONLY: y2dxe,axe,bxe,cxe
   IMPLICIT NONE

!! * Arguments

!! * Local declarations
   INTEGER :: x,y,i,j,k,nmove,size_give,size_get
   INTEGER :: dest
   REAL(kind=rlg),ALLOCATABLE,DIMENSION(:) :: give,get

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

   nmove=4

! mincbudy=0
! maxcbudy=nb de procs avec lesquels il faudra echanger pour completer la colonne
! numcbudy=maxcbudy+1 (+1 si besoin pour devenir, car echanges 2 a 2), nb de procs concernes sur toute la colonne
! mincproc = numero du 1er proc utile (dans le decoupage 2D) dans la colonne
! maxcproc = numero du dernier proc utile (dans le decoupage 2D) dans la colonne

! myproc : proc qui appelle cette routine
! CI(1,y)=CI(1,myproc)=indice (dans tableau complet) de la cellule la plus a gauche concernee par la colonne. Soit limin si colonne situee a gauche
! dans domaine du proc en decoupage 2D
! CI(2,y)=CI(2,myproc)=indice (dans tableau complet) de la cellule la plus a droite concernee par la colonne. Soit limax si colonne situee a droite
! dans domaine du proc en decoupage 2D

   A:DO x=mincbudy,maxcbudy

! y copain avec lequel x (le proc actuel) va echanger (si pas lui-meme)
     y=cbudy(x)
     IF (y.LT.mincproc) CYCLE A    ! ne devrait pas servir a priori
     IF (y.GT.maxcproc) CYCLE A    ! ne devrait pas servir a priori

! x=y donc myproc a les infos et les copie a soi-meme
     IF (y.EQ.mycproc) THEN
       DO j=ljmin,ljmax
! quand la division n etait pas faite en repartissant de maniere homogene le nb de point mouilles
!       DO i=ciminp2,cimaxm1
         DO i=CI(1,y),CI(2,y)
           IF (j.LT.jb(i)) CYCLE
           IF (j.GT.jh(i)) CYCLE
           cy2dxe(i,j)=y2dxe(i,j)
           caxe(i,j)=axe(i,j)
           cbxe(i,j)=bxe(i,j)
           ccxe(i,j)=cxe(i,j)
         END DO
       END DO
       CYCLE A
     END IF

! y/=x donc echange avec le copain et myproc prepare sa partie a echanger et la sauvant dans give
     size_give=nmove*give_ccount(x)
     ALLOCATE(GIVE(size_give))
     k=0

     DO j=ljmin,ljmax
       DO i=CI(1,y),CI(2,y)
         IF (j.LT.jb(i)) CYCLE
         IF (j.GT.jh(i)) CYCLE
         k=k+1
         give(k)=y2dxe(i,j)
         k=k+1
         give(k)=axe(i,j)
         k=k+1
         give(k)=bxe(i,j)
         k=k+1
         give(k)=cxe(i,j)
       END DO
     END DO

     IF (k.NE.size_give) STOP   ! si un seul proc selon y, inutile d echanger

! echange avec le copain dans la colonne
!   - envoi d une partie a droite ou a gauche de la colonne traitee mais dans le domaine 2D du proc
!   - reception d une partie de la colonne depuis un proc situe plus au ou plus bas dans la colonne
     size_get=nmove*get_ccount(x)
     ALLOCATE(GET(size_get))
     dest=PROC(MYIPROC,Y)
     CALL sendrecv_rlg(dest,size_give,give,size_get,get)
     DEALLOCATE(GIVE)

! recopie de ce qui a ete recu depuis le copain
     k=0
     DO j=LJ(1,y),LJ(2,y)
       DO i=ciminp2,cimaxm1
         IF (j.LT.jb(i)) CYCLE  ! peut servir des que ljmin /= jb(i)
         IF (j.GT.jh(i)) CYCLE  ! peut servir des que ljmax /= jh(i)
         k=k+1
         cy2dxe(i,j)=get(k)
         k=k+1
         caxe(i,j)=get(k)
         k=k+1
         cbxe(i,j)=get(k)
         k=k+1
         ccxe(i,j)=get(k)
       END DO
     END DO

     IF (k.NE.size_get) STOP
     DEALLOCATE(GET)

   END DO A

  END SUBROUTINE transpose_col

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

  SUBROUTINE trback_col(A)

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE trback_col  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E       !  2011-11  (V. Garnier) Spatial extension of ssh(liminm2:limaxp2,ljminm2:ljmaxp2)
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE parameters,ONLY: ljmin,ljmax,imin,imax,jmin,jmax,limin,limax
   USE toolmpi,   ONLY: give_ccount,get_ccount,sendrecv_rsh,mycproc,myIPROC
   USE toolmpi,   ONLY: CI,LJ,ciminp2,cimaxm1,mincbudy,maxcbudy,cbudy
   USE toolmpi,   ONLY: mincproc,maxcproc,PROC
   USE comvars2d, ONLY: jb,jh,l_obc_cycl_y
   IMPLICIT NONE

!! * Arguments
   REAL(kind=rsh),DIMENSION(liminm2:limaxp2,ljminm2:ljmaxp2),INTENT(inout) :: A !xeuv=A

!! * Local declarations
   INTEGER :: x,y,i,j,k,nmove,size_give,size_get,dest
   REAL(kind=rsh),ALLOCATABLE,DIMENSION(:) :: give,get

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

     nmove=1

     doA:DO x=mincbudy,maxcbudy

       y=cbudy(x)
       IF (y.LT.mincproc) CYCLE doA
       IF (y.GT.maxcproc) CYCLE doA
       IF (y.EQ.mycproc) THEN
       DO j=ljmin,ljmax
         doD:DO i=CI(1,y),CI(2,y)
           IF (j.LE.jb(i)) CYCLE doD
           IF (j.GE.jh(i)) CYCLE doD
!xeuv=A jb+1 -> jh -1
           A(i,j)=cxeuv(i,j)
         END DO doD
       END DO
       CYCLE doA
       END IF

       size_give=nmove*get_ccount(x)
       ALLOCATE(GIVE(size_give))
       k=0
       DO j=LJ(1,y),LJ(2,y)
         doB:DO i=ciminp2,cimaxm1
           IF (j.LT.jb(i)) CYCLE doB
           IF (j.GT.jh(i)) CYCLE doB
           k=k+1
           give(k)=cxeuv(i,j)
         END DO doB
       END DO

       IF (k.NE.size_give) STOP
       size_get=nmove*give_ccount(x)
       ALLOCATE(GET(size_get))
       dest=PROC(MYIPROC,Y)
       CALL sendrecv_rsh(dest,size_give,give,size_get,get)
       DEALLOCATE(GIVE)
       k=0

       DO j=ljmin,ljmax
         doC:DO i=CI(1,y),CI(2,y)
           IF (j.LT.jb(i)) CYCLE doC
           IF (j.GT.jh(i)) CYCLE doC
!xeuv=A jb+1 -> jh -1
!uv=B   jb   -> jh -1
           IF (j==jb(i)) THEN
             k=k+1
!         A(i,j)=get(k)
             CYCLE doC
           END IF
           IF (j==jh(i)) THEN
             k=k+1
             CYCLE doC
           END IF
           k=k+1
           A(i,j)=get(k)
         END DO doC
       END DO

       IF (k.NE.size_get) STOP
       DEALLOCATE(GET)

     END DO doA

  END SUBROUTINE trback_col

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

  SUBROUTINE transpose_row

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE transpose_row  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE parameters,ONLY: limin,limax
   USE toolmpi,   ONLY: give_rcount,get_rcount,sendrecv_rlg,myrproc,myjproc
   USE toolmpi,   ONLY: RJ,LI,rjminp2,rjmaxm1,minrbudy,maxrbudy,rbudy
   USE toolmpi,   ONLY: minrproc,maxrproc
   USE toolmpi,   ONLY: proc
   USE comvars2d, ONLY: id,ig
   USE comcolig2d,ONLY: y2dxe,axe,bxe,cxe,y2dv,av,bv,cv
   IMPLICIT NONE

!! * Arguments

!! * Local declarations
   INTEGER :: x,y,i,j,k,nmove,size_give,size_get
   INTEGER :: dest
   REAL(kind=rlg),ALLOCATABLE,DIMENSION(:) :: give,get

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

   nmove=4

   A:DO x=minrbudy,maxrbudy

     y=rbudy(x)
     IF (y.LT.minrproc) CYCLE A
     IF (y.GT.maxrproc) CYCLE A
     IF (y.EQ.myrproc) THEN
!bug ?       DO j=rjminp2,rjmaxm1
       DO j=RJ(1,y),RJ(2,y)
         DO i=limin,limax
           IF (i.LT.ig(j)) CYCLE
           IF (i.GT.id(j)) CYCLE
           ry2dxe(i,j)=y2dxe(i,j)
           raxe(i,j)=axe(i,j)
           rbxe(i,j)=bxe(i,j)
           rcxe(i,j)=cxe(i,j)
         END DO
       END DO
       CYCLE A
     END IF

     size_give=nmove*give_rcount(x)
     ALLOCATE(GIVE(size_give))
     k=0

     DO j=RJ(1,y),RJ(2,y)
       DO i=limin,limax
         IF (i.LT.ig(j)) CYCLE
         IF (i.GT.id(j)) CYCLE
         k=k+1
         give(k)=y2dxe(i,j)
         k=k+1
         give(k)=axe(i,j)
         k=k+1
         give(k)=bxe(i,j)
         k=k+1
         give(k)=cxe(i,j)
       END DO
     END DO

     IF (k.NE.size_give) STOP
     size_get=nmove*get_rcount(x)
     ALLOCATE(GET(size_get))
     dest=PROC(Y,MYJPROC)
     CALL sendrecv_rlg(dest,size_give,give,size_get,get)
     DEALLOCATE(GIVE)
     k=0

     DO j=rjminp2,rjmaxm1
       DO i=LI(1,Y),LI(2,Y)
         IF (i.LT.ig(j)) CYCLE
         IF (i.GT.id(j)) CYCLE
         k=k+1
         ry2dxe(i,j)=get(k)
         k=k+1
         raxe(i,j)=get(k)
         k=k+1
         rbxe(i,j)=get(k)
         k=k+1
         rcxe(i,j)=get(k)
       END DO
     END DO

     IF (k.NE.size_get) STOP
     DEALLOCATE(GET)

   END DO A

  END SUBROUTINE transpose_row

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

  SUBROUTINE trback_row(A)   !not tested yet

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE trback_row  ***
!&E
!&E ** Purpose :
!&E
!&E ** Description :
!&E
!&E ** Called by :
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays :
!&E
!&E ** Modified variables :
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !
!&E       !  2011-11  (V. Garnier) Spatial extension of ssh(liminm2:limaxp2,ljminm2:ljmaxp2)
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE parameters,ONLY: imin,imax,jmin,jmax,limin,limax,ljmin,ljmax
   USE toolmpi,   ONLY: give_rcount,get_rcount,sendrecv_rsh,myrproc,myjPROC
   USE toolmpi,   ONLY: RJ,LI,rjminp2,rjmaxm1,minrbudy,maxrbudy,rbudy
   USE toolmpi,   ONLY: minrproc,maxrproc,PROC
   USE comvars2d, ONLY: id,ig,l_obc_cycl_y
   IMPLICIT NONE

!! * Arguments

!! * Local declarations
   INTEGER :: x,y,i,j,k,nmove,size_give,size_get,dest
   REAL(kind=rsh),DIMENSION(liminm2:limaxp2,ljminm2:ljmaxp2),INTENT(inout) :: A !xeuv=A
   REAL(kind=rsh),ALLOCATABLE,DIMENSION(:) :: give,get

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

     nmove=1

     doA:DO x=minrbudy,maxrbudy

       y=rbudy(x)
       IF (y.LT.minrproc) CYCLE doA
       IF (y.GT.maxrproc) CYCLE doA

       IF (y.EQ.myrproc) THEN
          DO j=RJ(1,y),RJ(2,y)
          doD:DO i=limin,limax
          IF (i.LE.ig(j)) CYCLE doD
          IF (i.GE.id(j)) CYCLE doD
!xeuv=A jb+1 -> jh -1
!uv=B   jb   -> jh -1
           A(i,j)=rxeuv(i,j)
           END DO doD
          END DO
          CYCLE doA
       ENDIF

       size_give=nmove*get_rcount(x)
       ALLOCATE(GIVE(size_give))
       k=0
       DO j=rjminp2,rjmaxm1
         doB:DO i=LI(1,y),LI(2,y)
           IF (i.LT.ig(j)) CYCLE doB
           IF (i.GT.id(j)) CYCLE doB
           k=k+1
           give(k)=rxeuv(i,j)
         END DO doB
       END DO

       IF (k.NE.size_give) STOP
       size_get=nmove*give_rcount(x)
       ALLOCATE(GET(size_get))
       dest=PROC(Y,MYJPROC)
       CALL sendrecv_rsh(dest,size_give,give,size_get,get)
       DEALLOCATE(GIVE)
       k=0

       DO j=RJ(1,y),RJ(2,y)
         doC:DO i=limin,limax
           IF (i.LT.ig(j)) CYCLE doC
           IF (i.GT.id(j)) CYCLE doC
!xeuv=A jb+1 -> jh -1
!uv=B   jb   -> jh -1
           IF (i==ig(j)) THEN
             k=k+1
!         A(i,j)=get(k)
             CYCLE doC
           END IF
           IF (i==id(j)) THEN
             k=k+1
             CYCLE doC
           END IF
           k=k+1
           A(i,j)=get(k)
         END DO doC
       END DO

       IF (k.NE.size_get) STOP
       DEALLOCATE(GET)

     END DO doA

  END SUBROUTINE trback_row

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



  END MODULE comcolig_mpi
