Esope source files

   1 : C RPELEM    SOURCE    CHAT      05/01/13    03:06:38     5004           
   2 :       SUBROUTINE RPELEM(NUELG,RPMAIL,
   3 :      $     NOSOUS,NOELEM,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : RPELEM
   9 : C DESCRIPTION : Numéro "global" d'un élément + liste d'entiers(inirpl)
  10 : C               => numéro de la partition + numéro "local" de
  11 : C               l'élément. 
  12 : C
  13 : C               On donne un numéro d'élément NUELG d'un maillage MAIL
  14 : C               repéré par RPMAIL (construit avec inirpl.eso).
  15 : C               On sort : - NOSOUS : le numéro du LISOUS (peut être nul)
  16 : C                                    où se trouve NUELG.
  17 : C                         - NOELEM : le numéro de NUELG dans le LISOUS.
  18 : C LANGAGE     : ESOPE
  19 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  20 : C               mél : gounand@semt2.smts.cea.fr
  21 : C***********************************************************************
  22 : C APPELES (ESOPE)  : OOOETA
  23 : C APPELE PAR       : PONBPO, 
  24 : C***********************************************************************
  25 : C ENTREES            : NUELG,  RPMAIL
  26 : C SORTIES            : NOSOUS, NOELEM
  27 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  28 : C***********************************************************************
  29 : C VERSION    : v1, 12/05/99, version initiale
  30 : C HISTORIQUE : v1, 12/05/99, création
  31 : C HISTORIQUE : 05/01/00 : modif. algorithme de recherche du numéro de
  32 : C      partition : séquentiel (O(n)) -> Binary search (O(log n))
  33 : C HISTORIQUE :
  34 : C HISTORIQUE :
  35 : C***********************************************************************
  36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  37 : C en cas de modification de ce sous-programme afin de faciliter
  38 : C la maintenance !
  39 : C***********************************************************************
  40 : -INC CCOPTIO
  41 : -INC SMLENTI
  42 :       POINTEUR RPMAIL.MLENTI
  43 : *
  44 :       INTEGER RPETA
  45 :       INTEGER IMPR,IRET
  46 : 
  47 : *
  48 :       INTEGER NOELEM,NOSOUS
  49 :       INTEGER NUELG ,NBSOUS
  50 :       INTEGER NUMAX
  51 :       INTEGER IDX,IDXMIL,IDXINF,IDXSUP
  52 :       INTEGER VAL,VALMIL
  53 : *     
  54 : * Executable statements
  55 : *
  56 :       IF (IMPR.GT.3) THEN
  57 :          WRITE(IOIMP,*) 'Entrée dans rpelem.eso'
  58 :       ENDIF
  58 :       CALL OOOETA(RPMAIL,RPETA)
  59 :       IF (RPETA.NE.1) SEGACT RPMAIL
  60 :       NBSOUS=RPMAIL.LECT(/1)-1
  61 :       NUMAX=RPMAIL.LECT(NBSOUS+1)
  62 :       IF ((NUELG.GE.NUMAX).OR.(NUELG.LE.0)) THEN
  63 :          WRITE(IOIMP,*) 'NUELG=',NUELG,' trop grand ou trop petit'
  64 :          GOTO 9999
  65 :       ENDIF
  66 :       IF (NBSOUS.EQ.1) THEN
  67 :          NOSOUS=0
  68 :          NOELEM=NUELG
  69 :       ELSE
  70 :          VAL=NUELG
  71 :          IDX=-1
  72 :          IDXINF=1
  73 :          IDXSUP=NBSOUS
  74 : *
  75 : * Algorithme de recherche modifié (binary search)
  76 : * (cf. ifidic.eso)
  77 : *
  78 :  1       CONTINUE
  79 :          IF (IDXSUP.GE.IDXINF) THEN
  80 :             IDXMIL=(IDXINF+IDXSUP)/2
  81 :             VALMIL=RPMAIL.LECT(IDXMIL)
  82 :             IF (VAL.LT.VALMIL) THEN
  83 :                IDXSUP=IDXMIL-1
  84 :                GOTO 1
  85 :             ELSEIF (VAL.GT.VALMIL) THEN
  86 :                IDXINF=IDXMIL+1
  87 :                GOTO 1
  88 :             ELSE
  89 :                IDX=IDXMIL
  90 :             ENDIF
  91 :          ENDIF
  92 :          IF (IDX.NE.-1) THEN
  93 :             NOSOUS=IDX
  94 :             NOELEM=1
  95 :          ELSE
  96 :             NOSOUS=IDXSUP
  97 :             NOELEM=NUELG-RPMAIL.LECT(NOSOUS)+1
  98 :          ENDIF
  99 :       ENDIF
 100 :       IF (RPETA.NE.1) SEGDES RPMAIL
 101 :       IF (IMPR.GT.5) THEN
 102 :          WRITE(IOIMP,*) 'NOSOUS=',NOSOUS,' NOELEM=',NOELEM
 103 :       ENDIF
 104 : *
 105 : * Normal termination
 106 : *
 107 :       IRET=0
 108 :       RETURN
 109 : *
 110 : * Format handling
 111 : *
 112 : *
 113 : * Error handling
 114 : *
 115 :  9999 CONTINUE
 116 :       IRET=1
 117 :       WRITE(IOIMP,*) 'An error was detected in subroutine rpelem'
 118 :       RETURN
 119 : *
 120 : * End of subroutine RPELEM
 121 : *
 122 :       END
 123 : 
 124 :  
 125 :  
 126 :