Sources Esope | Cast3M

rpelem
C RPELEM    SOURCE    CB215821  18/09/27    21:15:49     9936           
      SUBROUTINE RPELEM(NUELG,RPMAIL,
     $     NOSOUS,NOELEM,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : RPELEM
C DESCRIPTION : Numéro "global" d'un élément + liste d'entiers(inirpl)
C               => numéro de la partition + numéro "local" de
C               l'élément.
C
C               On donne un numéro d'élément NUELG d'un maillage MAIL
C               repéré par RPMAIL (construit avec inirpl.eso).
C               On sort : - NOSOUS : le numéro du LISOUS (peut être nul)
C                                    où se trouve NUELG.
C                         - NOELEM : le numéro de NUELG dans le LISOUS.
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES (ESOPE)  : OOOETA
C APPELE PAR       : PONBPO,
C***********************************************************************
C ENTREES            : NUELG,  RPMAIL
C SORTIES            : NOSOUS, NOELEM
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 12/05/99, version initiale
C HISTORIQUE : v1, 12/05/99, création
C HISTORIQUE : 05/01/00 : modif. algorithme de recherche du numéro de
C      partition : séquentiel (O(n)) -> Binary search (O(log n))
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      POINTEUR RPMAIL.MLENTI
*
      INTEGER RPETA
      INTEGER IMPR,IRET
 
*
      INTEGER NOELEM,NOSOUS
      INTEGER NUELG ,NBSOUS
      INTEGER NUMAX
      INTEGER IDX,IDXMIL,IDXINF,IDXSUP
      INTEGER VAL,VALMIL
*
* Executable statements
*
      IF (IMPR.GT.3) THEN
         WRITE(IOIMP,*) 'Entrée dans rpelem.eso'
      ENDIF
      CALL OOOETA(RPMAIL,RPETA,IMOD)
      IF (RPETA.NE.1) SEGACT RPMAIL
      NBSOUS=RPMAIL.LECT(/1)-1
      NUMAX=RPMAIL.LECT(NBSOUS+1)
      IF ((NUELG.GE.NUMAX).OR.(NUELG.LE.0)) THEN
         WRITE(IOIMP,*) 'NUELG=',NUELG,' trop grand ou trop petit'
         GOTO 9999
      ENDIF
      IF (NBSOUS.EQ.1) THEN
         NOSOUS=0
         NOELEM=NUELG
      ELSE
         VAL=NUELG
         IDX=-1
         IDXINF=1
         IDXSUP=NBSOUS
*
* Algorithme de recherche modifié (binary search)
* (cf. ifidic.eso)
*
 1       CONTINUE
         IF (IDXSUP.GE.IDXINF) THEN
            IDXMIL=(IDXINF+IDXSUP)/2
            VALMIL=RPMAIL.LECT(IDXMIL)
            IF (VAL.LT.VALMIL) THEN
               IDXSUP=IDXMIL-1
               GOTO 1
            ELSEIF (VAL.GT.VALMIL) THEN
               IDXINF=IDXMIL+1
               GOTO 1
            ELSE
               IDX=IDXMIL
            ENDIF
         ENDIF
         IF (IDX.NE.-1) THEN
            NOSOUS=IDX
            NOELEM=1
         ELSE
            NOSOUS=IDXSUP
            NOELEM=NUELG-RPMAIL.LECT(NOSOUS)+1
         ENDIF
      ENDIF
      IF (RPETA.NE.1) SEGDES RPMAIL
      IF (IMPR.GT.5) THEN
         WRITE(IOIMP,*) 'NOSOUS=',NOSOUS,' NOELEM=',NOELEM
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine rpelem'
      RETURN
*
* End of subroutine RPELEM
*
      END