Sources Esope | Cast3M

r2rch
C R2RCH     SOURCE    CHAT      05/01/13    02:43:58     5004
      SUBROUTINE R2RCH(IDIMC,ITRNOE,NBNMAX,NBE,COORD,SPH,
     >                      NBSMAX,IT,XPT,COEF,IERR)
C     **********************************************************************
C     OBJET : RECHERCHE DE L'ELEMENT A RAFINER
C     EN ENTREE  :
C       COORD          : COORDONNEES DES POINTS
C       IDIMC          : DIMENSION DE L'ESPACE
C       ITRNOE,NBNMAX : SOMMETS DES ELEMENTS
C       NBE            : NOMBRE D'ELEMENTS
C       SPH,NBSMAX     : CERCLES CIRCONSCRITS AUX ELEMENTS
C
C     EN SORTIE  :
C       IT             : L'ELEMENT A REFFINER
C       XPT            : LE POINT A AJOUTER
C       COEF           : LA VALEUR DU RAFFINEMENT [0-1]
C                        PLUS COEF EST PETIT PLUS ON RAFFINE
C       IERR           : CODE D'ERREUR (INUTILISE)
C     **********************************************************************
      IMPLICIT INTEGER(I-N)
      REAL*8       COORD(*),SPH(*)
      INTEGER    IDIMC,ITRNOE(*),NBNMAX,NBE,NBSMAX,IT,IERR
      REAL*8       COEF,XPT(*)
C
      INTEGER  I,NUMP3
      REAL*8     CLRC,LRCMIN,XDEMI
C
      LRCMIN = 1.0D0
      XDEMI = 0.5D0
      IT = 0
      DO 10 I=1,NBE
        CLRC = SPH((I-1)*NBSMAX+3)
        IF( CLRC .LT. LRCMIN )THEN
          IT = I
          LRCMIN = CLRC
        ENDIF
   10 CONTINUE
C
      IF( IT.EQ. 0 )THEN
        COEF = 1.D0
        GOTO 999
      ENDIF
C     --- CENTRE = PT3 + SPH / 2 ------------------
      CALL MUSCVE(SPH((IT-1)*NBSMAX+1),XDEMI,IDIMC,XPT)
      NUMP3 = ITRNOE((IT-1)*NBNMAX+3)
      CALL SOMMVE(COORD((NUMP3-1)*IDIMC+1),XPT,IDIMC,XPT)
C
      COEF = LRCMIN
  999 END