Esope source files

   1 : C LOCARA    SOURCE    CHAT      05/01/13    01:24:41     5004           
   2 : C LOCARA
   3 :       SUBROUTINE LOCARA(IDIM,NBNN,XEL,LCARAC)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 : C-----------------------------------------------------------------------
   7 : C     DESCRIPTION FONCTIONNELLE :
   8 : C     -------------------------
   9 : C     Calcul de la longueur caracteristique d'un element, determinee
  10 : C     comme la distance maximale entre deux noeuds de l'element
  11 : C
  12 : C     INTERFACE :
  13 : C     ---------
  14 : C     ENTREE : IDIM   : INTEGER, nombre de dimensions d'espace
  15 : C     ENTREE : NBNN   : INTEGER, nombre de noeuds de l'element
  16 : C     ENTREE : XEL    : tableau de REAL*8 de dimensions (3,NBNN),
  17 : C                       coordonnees des noeuds de l'element
  18 : C                       Ce tableau a ete rempli par la routine DOXE
  19 : C                       appelee au prealable
  20 : C     SORTIE : LCARAC : REAL*8, longueur caracteristique de l'element
  21 : C-----------------------------------------------------------------------
  22 : C     Arguments de l'interface
  23 : C
  24 :       INTEGER IDIM, NBNN
  25 :       REAL*8  XEL(3,NBNN), LCARAC
  26 : C
  27 : C     Variables locales
  28 : C
  29 :       INTEGER INO1, INO2, IX
  30 :       REAL*8  DIST
  31 : C-----------------------------------------------------------------------
  32 :       LCARAC=0.0D0
  33 : C
  34 :       IF (NBNN.GT.1) THEN
  35 : C
  36 : C        Determination de la distance maximale entre deux noeuds de
  37 : C        l'element
  38 :          DO 10 INO1=1,NBNN-1
  39 :             DO 11 INO2=INO1+1,NBNN
  40 :                DIST=0.0D0
  41 :                DO 12 IX=1,IDIM
  42 :                   DIST=DIST+(XEL(IX,INO2)-XEL(IX,INO1))**2.0D0
  43 :   12           CONTINUE
  44 :                DIST=SQRT(DIST)
  45 :                IF (DIST.GT.LCARAC) LCARAC=DIST
  46 :   11        CONTINUE
  47 :   10     CONTINUE
  48 : C
  49 :       ENDIF
  50 : C
  51 :       RETURN
  52 :       END
  53 :  
  54 :