TABLE OF CONTENTS

GEO/psr [ Modules ]

[ Top ] [ Modules ]

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