psr.f90

### TABLE OF CONTENTS

- 1. GEO/psr

## 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