Sources Esope | Cast3M

tshape
C TSHAPE    SOURCE    OF166741  23/12/05    21:15:08     11801          
 
C=======================================================================
C=                            T S H A P E                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=  Calcul des fonctions de forme et de leurs derivees soit aux noeuds =
C=  soit aux points de Gauss d'un element fini MASSIF a integration    =
C=  numerique (branchement vers les sous-programmes adequats).         =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   NEF     (E)  Numero de l'ELEMENT FINI dans NOMTP (cf. CCHAMP)     =
C=   POINTS  (E)  Chaine de caracteres indiquant si l'on souhaite les  =
C=                valeurs aux noeuds (='NOEUD'), aux points de Gauss   =
C=                (='GAUSS') ou au centre de gravite (='GRAVITE') de   =
C=                l'element fini considere                             =
C=   IPINTE  (S)  Pointeur sur le segment MINTE (ACTIF en S)           =
C=                                                                     =
C=  Remarque : Il s'agit des derivees par rapport aux coordonnees de   =
C=  ---------- l'element de reference (Eta,Qsi,Dzeta).                 =
C=======================================================================
      SUBROUTINE TSHAPE (NEF,POINTS,IPINTE)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
c-INC PPARAM
c-INC CCOPTIO
 
-INC SMINTE
 
      PARAMETER (NELSTH = 20, NTINTE = 3, NEFMAX = 33)
      PARAMETER (NINTEG = NELSTH * NTINTE)
 
C  Nom des EF :     SEG2  RAC2  COQ2  BARRe T1D2  TUY2  SEG3  RAC3 
C  (voir NOMTP)     T1D3  TUY3  TRI3  LIA3  COQ3  TRI6  LIA6  QUA4
C                   LIA4  QUA8  LIA8  CUB8  CU20  PRI6  PR15  TET4
C                   TE10  PYR5  PY13  COQ4  COQ8  COQ6  POI1  POI1
C                   JOI1  
 
C  Liste des Elements Finis (NEF) traites ici (voir NUMGEO)
      INTEGER LISNEF(NEFMAX)
      SAVE LISNEF
      DATA LISNEF /    2,   12,   44,   46,  191,  269,    3,   13,
     &               192,  270,    4,   18,   27,    6,   20,    8,
     &                19,   10,   21,   14,   15,   16,   17,   23,
     &                24,   25,   26,   49,   41,   56,    1,   45,
     &               265 /
 
C   Element Support THermique associe a chaque Element Fini
      INTEGER LELSTH(NEFMAX)
      SAVE LELSTH
      DATA LELSTH /    1,    1,    1,    1,    1,    1,    2,    2,
     &                 2,    2,    3,    3,    3,    4,    4,    5,
     &                 5,    6,    6,    7,    8,    9,   10,   11,
     &                12,   13,   14,   15,   16,   17,   18,   18,
     &                19 /
 
C  Tableau des pointeurs MINTE pour chaque ELement Support THermique 
C  et chaque Support (&lt;0 si non defini, 0 si non utile et >0 sinon)
      INTEGER IPINTH(NELSTH,NTINTE)
      SAVE IPINTH
      DATA IPINTH / NINTEG * -3 /
 
      CHARACTER*(*) POINTS
 
C 1 - Les valeurs ne peuvent etre donnees qu'aux noeuds, aux points 
C === d'integration (Gauss) ou au centre de gravite.
      ITINTE = 0
      IF      ( POINTS(1:5).EQ.'NOEUD'   ) THEN
        ITINTE = 1
      ELSE IF ( POINTS(1:5).EQ.'GAUSS'   ) THEN
        ITINTE = 2
      ELSE IF ( POINTS(1:7).EQ.'GRAVITE' ) THEN
        ITINTE = 3
      ELSE
        CALL ERREUR(19)
        RETURN
      ENDIF
c      if (itinte .gt. ntinte) then
c        write(ioimp,*) 'TSHAPE : redimensionner NTINTE'
c        call erreur(5)
c        return
c      endif
 
C 2 - Determination de l'element support thermique pour l'ELEMENT FINI
C ===
      IELSTH = 0
      CALL PLACE2(LISNEF,NEFMAX,ielsth,NEF)
      IF (ielsth.EQ.0) THEN
        CALL ERREUR(19)
        RETURN
      ENDIF
      IELSTH = LELSTH(ielsth)
c      if (ielsth.gt. nelsth) then
c        write(ioimp,*) 'TSHAPE : redimensionner NELSTH'
c        call erreur(5)
c      endif
 
C 3 - Recuperation/Construction du segment SMINTE demande
C ===
C- Si pointeur deja construit, on le recupere, on l'active et retour.
      IPINTE = IPINTH(IELSTH,ITINTE)
      IF (IPINTE.GE.0) THEN
        IF (IPINTE.NE.0) THEN
          MINTE = IPINTE
          SEGACT,MINTE*NOMOD
        ENDIF
        RETURN
      ENDIF
 
C- Sinon il faut l'evaluer via le sousprogramme associe a l'element.
      IPINTE = -3
      IF      ( IELSTH .EQ. 1 ) THEN
        CALL TSEG2F(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 2) THEN
        CALL TSEG3(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 3) THEN
        CALL TTRI3F(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 4) THEN
        CALL TTRI6(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 5) THEN
        CALL TQUA4(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 6) THEN
        CALL TQUA8(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 7) THEN
        CALL TCUB8(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 8) THEN
        CALL TCU20(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 9) THEN
        CALL TPRI6(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 10) THEN
        CALL TPR15(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 11) THEN
        CALL TTET4F(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 12) THEN
        CALL TTE10(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 13) THEN
        CALL TPYR5(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 14) THEN
        CALL TPY13(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 15) THEN
        CALL TCOQ4(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 16) THEN
        CALL TCOQ8(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 17) THEN
        CALL TCOQ6(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 18) THEN
        CALL TPOI1(ITINTE,IPINTE)
      ELSE IF ( IELSTH .EQ. 19) THEN
        IPINTE = 0
      ELSE
C- ERREUR : Element fini non implemente
        write(ioimp,*) 'TSHAPE(1) : Element fini non implemente'
        call erreur(5)
        return
      ENDIF
 
C- ERREUR lors de l'appel au sous-programme T_ef_
      IF (IPINTE.LT.0) THEN
        write(ioimp,*) 'TSHAPE(2) : Erreur lors appel a T_ef_'
        call erreur(5)
        return
      ENDIF
 
      IPINTH(IELSTH,ITINTE) = IPINTE
      IF (IPINTE.GT.0) THEN
        CALL SAVSEG(IPINTE)
        MINTE = IPINTE
        SEGACT,MINTE*NOMOD
      ENDIF
 
c      RETURN
      END