Esope source files

   1 : C S3SOFA    SOURCE    CHAT      06/03/29    21:33:00     5360           
   2 : C
   3 : C
   4 :       FUNCTION S3SOFA(I,N,IFAC)
   5 : C     ************************************************************
   6 : C     OBJET : K FACES AU SOMMET (INDICE RELATIF)
   7 : C     EN ENTREE:
   8 : C      I      :  L'INDICE DU SOMMET DE L'ELEMENT
   9 : C      N      :  (4) NOMBRE DE NOEUD DE L'ELEMENT 
  10 : C                 TETRA(4),PYRAM(5),PRISME(6),HEXA(8)
  11 : C     EN SORTIE: 
  12 : C      IFAC  :  INDICE DES FACES INCIDENTES AU NOEUD 
  13 : C     CONDITION D'APPLICATION : TETRAEDRE ET HEXAEDRE SEULEMENT
  14 : C     ************************************************************
  15 :       IMPLICIT INTEGER(I-N)
  16 :       INTEGER  S3SOFA
  17 :       INTEGER  I,N,IFAC(*)
  18 : C     
  19 :       COMMON /STRTET/ ITA2F(4,4),IT2FA(4,4),IT3SF(3,4)
  20 :       INTEGER ITA2F, IT2FA, IT3SF
  21 :       COMMON /STRHEX/ IQ4SF(4,6),IQ3FS(3,8)
  22 :       INTEGER IQ4SF,IQ3FS
  23 :       INTEGER J,iarr
  24 : C
  25 : C      write(6,*) 'INDICE DU SOMMET = ',I
  26 : C      write(6,*) 'NOMBRE DE NOEUDS = ',N
  27 :       GOTO (1,1,1,100,1,1,1,200) N
  28 : C        =====================
  29 : C     --- ELEMENT NON RECONNU ---
  30 : C        =====================
  31 :     1 S3SOFA = 0
  32 :       iarr = -1
  32 :       CALL DSERRE(1,iarr,'S3SOFA',' TYPE D ELEMENT INCONNU')
  33 :       GOTO 9999
  34 : C        ==================
  35 : C     --- CAS DU TETRAEDRE ---
  36 : C        ==================
  37 : C
  38 :   100 S3SOFA = 3
  39 :           DO 110 J=1,S3SOFA
  40 :             IFAC(J) = IT3SF(J,I)
  41 :   110     CONTINUE
  42 :         GOTO 9999
  43 : C        ==================
  44 : C     --- CAS DE L'HEXAEDRE ---
  45 : C        ==================
  46 :   200 S3SOFA = 3
  47 :           DO 210 J=1,S3SOFA
  48 :             IFAC(J) = IQ3FS(J,I)
  49 :   210     CONTINUE
  50 :         GOTO 9999
  51 : C
  52 :  9999 END
  53 :  
  54 :  
  55 :