Esope source files

   1 : C R2RCH     SOURCE    CHAT      05/01/13    02:43:58     5004           
   2 :       SUBROUTINE R2RCH(IDIMC,ITRNOE,NBNMAX,NBE,COORD,SPH,
   3 :      >                      NBSMAX,IT,XPT,COEF,IERR)
   4 : C     **********************************************************************
   5 : C     OBJET : RECHERCHE DE L'ELEMENT A RAFINER
   6 : C     EN ENTREE  :
   7 : C       COORD          : COORDONNEES DES POINTS 
   8 : C       IDIMC          : DIMENSION DE L'ESPACE
   9 : C       ITRNOE,NBNMAX : SOMMETS DES ELEMENTS
  10 : C       NBE            : NOMBRE D'ELEMENTS
  11 : C       SPH,NBSMAX     : CERCLES CIRCONSCRITS AUX ELEMENTS
  12 : C
  13 : C     EN SORTIE  : 
  14 : C       IT             : L'ELEMENT A REFFINER
  15 : C       XPT            : LE POINT A AJOUTER
  16 : C       COEF           : LA VALEUR DU RAFFINEMENT [0-1]
  17 : C                        PLUS COEF EST PETIT PLUS ON RAFFINE
  18 : C       IERR           : CODE D'ERREUR (INUTILISE)
  19 : C     **********************************************************************
  20 :       IMPLICIT INTEGER(I-N)
  21 :       REAL*8       COORD(*),SPH(*)
  22 :       INTEGER    IDIMC,ITRNOE(*),NBNMAX,NBE,NBSMAX,IT,IERR
  23 :       REAL*8       COEF,XPT(*)
  24 : C
  25 :       INTEGER  I,NUMP3
  26 :       REAL*8     CLRC,LRCMIN,XDEMI
  27 : C
  28 :       LRCMIN = 1.0D0
  29 :       XDEMI = 0.5D0
  30 :       IT = 0
  31 :       DO 10 I=1,NBE 
  32 :         CLRC = SPH((I-1)*NBSMAX+3)
  33 :         IF( CLRC .LT. LRCMIN )THEN
  34 :           IT = I
  35 :           LRCMIN = CLRC 
  36 :         ENDIF
  37 :    10 CONTINUE
  38 : C
  39 :       IF( IT.EQ. 0 )THEN
  40 :         COEF = 1.D0
  41 :         GOTO 999
  42 :       ENDIF
  43 : C     --- CENTRE = PT3 + SPH / 2 ------------------
  43 :       CALL MUSCVE(SPH((IT-1)*NBSMAX+1),XDEMI,IDIMC,XPT)
  44 :       NUMP3 = ITRNOE((IT-1)*NBNMAX+3) 
  44 :       CALL SOMMVE(COORD((NUMP3-1)*IDIMC+1),XPT,IDIMC,XPT)
  45 : C
  46 :       COEF = LRCMIN
  47 :   999 END
  48 :  
  49 :