Télécharger la plaquette Cast3M


fr en

Télécharger s3sofa.eso

Retour à la liste

Numérotation des lignes : 

s3sofa

  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
  33.       CALL DSERRE(1,iarr,'S3SOFA',' TYPE D ELEMENT INCONNU')
  34.       GOTO 9999
  35. C        ==================
  36. C     --- CAS DU TETRAEDRE ---
  37. C        ==================
  38. C
  39.   100 S3SOFA = 3
  40.           DO 110 J=1,S3SOFA
  41.             IFAC(J) = IT3SF(J,I)
  42.   110     CONTINUE
  43.         GOTO 9999
  44. C        ==================
  45. C     --- CAS DE L'HEXAEDRE ---
  46. C        ==================
  47.   200 S3SOFA = 3
  48.           DO 210 J=1,S3SOFA
  49.             IFAC(J) = IQ3FS(J,I)
  50.   210     CONTINUE
  51.         GOTO 9999
  52. C
  53.  9999 END
  54.  
  55.  
  56.  
  57.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales