 SUBROUTINE psr(interdom,nb_dom,idomI,idomJ,ibI,ibJ,ipos_send,ipos_recv)
!=========================== DOCUMENTATION =============================
!DOCDEBh*    GEO/psr  *
!
!    NOM
!  psr (interdom,nb_bloc,nb_dom,idomI,idomJ,ibI,ibJ,ipos_send,ipos_recv)
!    DESCRIPTION  
!*
! Lecture de la liste des blocs de chaque cote de l interface entre les domaines
! pour chaque couple de domaine Di, Dj  i<j
! cree en position j-i+(i-1)*(2nb_dom-i)/2 
! une liste de 4 entiers:
! - numero du bloc du domaine Di
! - numero du bloc du domaine Dj
! - position cumule de la liste send pour les 2 blocs
! - position cumule de la liste recv 
!
! Reading the list of blocks on each side of the interface between domains
! for each pair of domains Di, Dj i<j
! create at position j-i+(i-1)*(2nb_dom-i)/2 
! a list of 4 integers:
! - domain Di block number
! - number of the block in the Dj domain
! - cumulative position of the send list for the 2 blocks
! - cumulative position of the recv list 
!*
!
!    ENTREES / INPUT
! interdom        : liste des blocs de chaque cote de l interface entre les domaines 
!                 / list of blocks on each side of the interface between domains
! nb_dom          : Nombre de domaines / Number of domains
! idomI           : Numero du domaine I considere / Number of domain I considered
! idomJ           : Numero du domaine J voisin / Number of neighbouring domain J
! ibI             : Numero du bloc du domaine idomI / Block number of domain idomI
! ibJ             : Numero du bloc du domaine idomJ / Block number of domain idomJ
!
!    SORTIES / OUTPUT
! ipos_send : position dans la liste list_send des cellules de idomI a envoyer a idomJ 
!           / position in the list_send list of idomI cells to send to idomJ
! ipos_recv : position dans la liste list_recv des cellules de idomI a recevoir de idomJ 
!           / position in the list_recv list of cells from idomI to be received from idomJ
!
!    SOURCE
! Ce logiciel est regi par la licence [CeCILL-B]
! This software is governed by the [CeCILL-B] license
!=========================== DECLARATIONS ==============================
!.1-----  Implicit, Use
  use geo_typ
  IMPLICIT NONE
!.2-----  Declaration
  integer, intent(in)                     :: nb_dom   !! Nombre de domaines / Number of domains
  integer, intent(in)                     :: idomI    !! Numero du domaine I considere / Number of domain I considered
  integer, intent(in)                     :: idomJ    !! Numero du domaine J voisin / Number of neighbouring domain J
  integer, intent(in)                     :: ibI      !! Numero du bloc du domaine idomI / Block number of domain idomI
  integer, intent(in)                     :: ibJ      !! Numero du bloc du domaine idomJ / Block number of domain idomJ
  integer, intent(out)                    :: ipos_send
! position dans la liste list_send des cellules de idomI a envoyer a idomJ 
! position in the list_send list of idomI cells to send to idomJ
  integer, intent(out)                    :: ipos_recv
!  position dans la liste list_recv des cellules de idomI a recevoir de idomJ 
!  position in the list_recv list of cells from idomI to be received from idomJ
  type(list_int),dimension(:), intent(in) :: interdom
! liste des blocs de chaque cote de l interface entre les domaines 
! list of blocks on each side of the interface between domains
  
  integer     ::   i,k
!====================== START OF THE EXECUTABLE CODE  ==================

!.1-----  Initialisation
  ipos_send=0
  ipos_recv=0

  IF (idomI.lt.idomJ) THEN
      k=idomJ-idomI+(idomI-1)*(2*nb_dom-idomI)/2 
      DO i=2,size(interdom(k)%L)/4
          IF (ibI.eq.interdom(k)%L((i-1)*4+1).and.ibJ.eq.interdom(k)%L((i-1)*4+2)) THEN
              ipos_send=interdom(k)%L(4*(i-1)-1)
              ipos_recv=interdom(k)%L(4*(i-1)-0)
          END IF
      END DO
  ELSE
      k=idomI-idomJ+(idomJ-1)*(2*nb_dom-idomJ)/2 
      DO i=2,size(interdom(k)%L)/4
          IF (ibJ.eq.interdom(k)%L((i-1)*4+1).and.ibI.eq.interdom(k)%L((i-1)*4+2)) THEN
              ipos_send=interdom(k)%L(4*(i-1)-0)
              ipos_recv=interdom(k)%L(4*(i-1)-1)
          END IF
      END DO
  END IF
  return
 !===========================   END OF THE SUBROUTINE    ====================
END SUBROUTINE psr
!DOCFIN
