Esope source files

   1 : C LONGCA    SOURCE    FANDEUR   12/04/16    21:15:13     7357           
   2 :       SUBROUTINE LONGCA(IPMAIL,IB,LCAR)
   3 : C 
   4 : C Declaration de variables
   5 : C
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 : C
   9 :       REAL*8 LCAR
  10 : C 
  11 : C Insertion des includes 
  12 : C Remarque : le segment MCOORD est toujours actif
  13 : C     
  14 : -INC CCOPTIO
  15 : -INC CCGEOME
  16 : -INC SMCOORD
  17 : -INC SMELEME
  18 : C
  19 :       IDIMP1 = IDIM+1
  20 : C---------------------------------------------------------------------
  21 : C         ************************************************************
  22 : C         *  CALCUL DE LA LONGUEUR CARACTERISTIQUE D'un ELEMENT      *
  23 : C         ************************************************************
  24 : C--------------------------------------------------------------------- 
  25 : C
  26 :       MELEME = IPMAIL
  27 : ******      SEGACT MELEME
  28 : C
  29 : C Adresse de la description des faces dans LDEL
  30 : C      
  31 :       IAD=LTEL(2,ITYPEL)
  32 : C
  33 : C Type de la face de l'élément courant
  34 : C       
  35 :       ITYP=LDEL(1,IAD)
  36 : C
  37 : C Nombre de point de la face
  38 : C      
  39 :       NPFAC=KDFAC(1,ITYP)
  40 : C
  41 : C Adresse de la face dans LFAC
  42 : C       
  43 :       JAD=LDEL(2,IAD)-1
  44 : C
  45 : C Adresse de description des triangles dans KFAC
  46 : C
  47 :       IDEP=KDFAC(2,ITYP)
  48 : C
  49 : C Initialisation 
  50 : C
  51 :       ABC = 0.
  52 : C
  53 : C Boucle sur les triangles
  54 : C       
  55 :       IFEP=IDEP+3*(KDFAC(3,ITYP)-1)
  56 : C
  57 :       DO 242 ITRIAN=IDEP,IFEP,3
  58 : C
  59 : C Extraction des trois noeuds du triangle courant
  60 : C       
  61 :          IAFA=LFAC(JAD+KFAC(ITRIAN))
  62 :          IBFA=LFAC(JAD+KFAC(ITRIAN+1))
  63 :          ICFA=LFAC(JAD+KFAC(ITRIAN+2))
  64 : C
  65 : C Numéro des trois noeuds dans le meleme / Position dans le MCOORD
  66 : C         
  67 :          NA = IDIMP1 * (NUM(IAFA,IB)-1)
  68 :          NB = IDIMP1 * (NUM(IBFA,IB)-1)
  69 :          NC = IDIMP1 * (NUM(ICFA,IB)-1)
  70 : C         
  71 : C Recherche des coordonées du point B et des vecteurs BA et BC
  72 : C
  73 :           XB=XCOOR(NB+1)
  74 :           YB=XCOOR(NB+2)
  75 :           ZB=XCOOR(NB+3)
  76 :           
  77 :           IF (IDIM.EQ.2) ZB=0.
  78 :           
  79 :           XBA=XCOOR(NA+1)-XB
  80 :           YBA=XCOOR(NA+2)-YB
  81 :           ZBA=XCOOR(NA+3)-ZB
  82 :           
  83 :           IF (IDIM.EQ.2) ZBA=0.
  84 :           
  85 :           XBC=XCOOR(NC+1)-XB
  86 :           YBC=XCOOR(NC+2)-YB
  87 :           ZBC=XCOOR(NC+3)-ZB
  88 :           
  89 :           IF (IDIM.EQ.2) ZBC=0.
  90 : C
  91 : C Calcul du produit vectoriel des vecteurs BA et BC
  92 : C          
  93 :           XV=YBA*ZBC-ZBA*YBC
  94 :           YV=ZBA*XBC-XBA*ZBC
  95 :           ZV=XBA*YBC-YBA*XBC
  96 : C
  97 : C Calcul de l'aire du triangle (norme du produit vectoriel divisée par 2)
  98 : C Nota : La division par 2 est effectuee une seule fois en sortie de boucle
  99 : 
 100 : C*        XS=XV/2
 101 : C*        YS=YV/2
 102 : C*        ZS=ZV/2
 103 : C*        ABC=ABC+SQRT(XS*XS+YS*YS+ZS*ZS)
 104 :           
 105 :           ABC = ABC+SQRT(XV*XV+YV*YV+ZV*ZV)
 106 :            
 107 :  242   CONTINUE
 108 : C
 109 : C Mise en facteur du 1/2 de l'aire de chaque triangle
 110 :           ABC = 0.5D0 * ABC
 111 : C 
 112 : C Calcul de la longueur caractéristique (d'après FEENSTRA, 1994)
 113 : C
 114 :        IF (KDEGRE(ITYPEL).EQ.2) THEN
 115 : C*     ALPHA=1.
 116 :          LCAR = SQRT(ABC)
 117 :        ELSE 
 118 : C*     ALPHA=SQRT(2.)
 119 :          LCAR=SQRT(2.D0*ABC)
 120 :        ENDIF       
 121 : C*     LCAR=ALPHA*SQRT(ABC)
 122 : C
 123 : C Desactivation du segment MELEME
 124 : C 
 125 : ******       SEGDES MELEME
 126 : 
 127 :        RETURN
 128 :        END
 129 : 
 130 :