Sources Esope | Cast3M

thetis
C THETIS    SOURCE    BP208322  15/06/22    21:23:24     8543
 
C=======================================================================
C=                            T H E T I S                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des contraintes d'origine THERMIQUE dans le cas des        =
C=   materiaux ISOTROPES. Sousprogramme appele par EPTHP (epthp.eso).  =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   MFR     (E)   Numero de la FORMULATION utilisee                   =
C=   MELE    (E)   Numero de l'element fini dans NOMTP (cf. CCHAMP)    =
C=   VALMAT  (E)   Tableau des caracteristiques du materiau            =
C=   NSTRS   (E)   Nombre de composantes de contraintes                =
C=   NPINT   (E)   Nombre de points d'integration pour les coques      =
C=   TEMP    (E)   Temperature au point de Gauss considere             =
C=   THIF    (E)   | Temperatures des differentes couches              =
C=   THM     (E)   | dans les cas des elements coques                  =
C=   THSU    (E)   | (couches INFErieure, MOYEnne, SUPErieure)         =
C=   E3      (E)   Excentrement dans la cas d'elements coques          =
C=   SD      (E)   Section dans le cas d'elements barres               =
C=   EPAIST  (E)   Epaisseur dans le cas d'elements coques             =
C=   RES     (S)   Tableau des valeurs des contraintes thermiques      =
C=   KERRE   (S)   Indicateur d'erreur si non nul                      =
C=======================================================================
 
      SUBROUTINE THETIS (MFR,MELE,VALMAT,NSTRS,NPINT,TEMP,THIF,
     .                   THM,THSU,E3,SD,EPAIST,RES,KERRE)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCHAMP
 
      DIMENSION VALMAT(*),RES(*)
 
      KERRE=0
 
C  1 - Elements MASSIFS et POREUX
C ================================
      IF (MFR.EQ.1.OR.MFR.EQ.33.OR.MFR.EQ.31.OR.MFR.EQ.63) THEN
        YOU=VALMAT(1)
        XNU=VALMAT(2)
        ALPDT=VALMAT(3)*TEMP
C= 1.1 - Bidimensionnel PLAN Contraintes Planes
        IF (IFOUR.EQ.-2) THEN
          AUX=YOU*ALPDT/(1.D0-XNU)
          RES(1)=AUX
          RES(2)=AUX
          RES(3)=0.
          RES(4)=0.
C= 1.2 - Bidimensionnel PLAN (DP/DPGE) et Axisymetrie
        ELSE IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.0) THEN
          AUX=YOU*ALPDT/(1.D0-2.D0*XNU)
          RES(1)=AUX
          RES(2)=AUX
          RES(3)=AUX
          RES(4)=0.D0
C= 1.3 - Fourier et Tridimensionnel
        ELSE IF (IFOUR.EQ.1.OR.IFOUR.EQ.2) THEN
          AUX=YOU*ALPDT/(1.D0-2.D0*XNU)
          RES(1)=AUX
          RES(2)=AUX
          RES(3)=AUX
          RES(4)=0.
          RES(5)=0.
          RES(6)=0.
C= 1.4 - Unidimensionnel (1D)
        ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15.AND.MFR.EQ.1) THEN
          IF (IFOUR.EQ.6) THEN
            RES(1)=YOU*ALPDT
            RES(2)=0.
            RES(3)=0.
          ELSE IF (IFOUR.EQ.4.OR.IFOUR.EQ.8) THEN
            AUX=YOU*ALPDT/(1.-XNU)
            RES(1)=AUX
            RES(2)=AUX
            RES(3)=0.
          ELSE IF (IFOUR.EQ.5.OR.IFOUR.EQ.10.OR.IFOUR.EQ.13) THEN
            AUX=YOU*ALPDT/(1.-XNU)
            RES(1)=AUX
            RES(2)=0.
            RES(3)=AUX
          ELSE
            AUX=YOU*ALPDT/(1.-2.*XNU)
            RES(1)=AUX
            RES(2)=AUX
            RES(3)=AUX
          ENDIF
C= 1.5 - Cas non prevus
        ELSE
          KERRE=19
        ENDIF
 
C  2 - Elements JOINTS 2D PLAN : JOI2 et JOI3
C ============================================
      ELSE IF (MELE.EQ.85.OR.MELE.EQ.86) THEN
        IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.0) THEN
          ALPN=VALMAT(3)*VALMAT(2)*TEMP
          RES(1)=0.
          RES(2)=ALPN
        ELSE
          KERRE=19
        ENDIF
 
C  3 - Element JOINT 3D : JOT4, JOI4
C ===================================
      ELSE IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
        IF (IFOUR.EQ.2) THEN
          ALPN=VALMAT(3)*VALMAT(2)*TEMP
          RES(1)=0.
          RES(2)=0.
          RES(3)=ALPN
        ELSE
          KERRE=19
        ENDIF
 
C  4 - Elements COQUES MINCES sauf COQ2
C ======================================
C+mdj !!!! Ajouter le cas de coque integre (NPINT.NE.0) :
C          on recupere un champs par elememt de temperatures aux
C          points de GAUSS cette temperature unique remplacera THMO
      ELSE IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.49.OR.
     .         MELE.EQ.93) THEN
        YOU=VALMAT(1)
        XNU=VALMAT(2)
        ALPH=VALMAT(3)
        AUX=YOU*ALPH/(1.D0-XNU)
        EXCEN =0.
        EP2=EPAIST*EPAIST/12.D0
        THMO=(THSU+THIF+4.D0*THM)/6.D0
        THDI=THSU-THIF
        IF (NPINT.EQ.0) THEN
          RES(1)=AUX*THMO*EPAIST
          RES(2)=RES(1)
          IF (IFOUR.GT.0) THEN
            RES(3)=0.
            RES(4)=AUX*(THMO*EPAIST*EXCEN+THDI*EP2)
            RES(5)=RES(4)
            RES(6)=0.
C**       ELSE IF (IFOUR.LE.0) THEN
          ELSE
            RES(3)=AUX*(THMO*EPAIST*EXCEN+THDI*EP2)
            RES(4)=RES(3)
          ENDIF
        ELSE
          KERRE=19
        ENDIF
 
C  5 - Element COQ2
C ==================
      ELSE IF (MELE.EQ.44) THEN
        YOU=VALMAT(1)
        XNU=VALMAT(2)
        ALPH=VALMAT(3)
        EP2=EPAIST*EPAIST/12.D0
        THMO=(THSU+THIF+4.D0*THM)/6.D0
        THDI=THSU-THIF
        EXCEN =0.
        IF (IFOUR.GT.0) THEN
          AUX=YOU*ALPH/(1.D0-XNU)
          RES(1)=AUX*THMO*EPAIST
          RES(2)=RES(1)
          RES(3)=0.
          RES(4)=AUX*(THMO*EPAIST*EXCEN+THDI*EP2)
          RES(5)=RES(4)
          RES(6)=0.
        ELSE IF (IFOUR.EQ.-2) THEN
          AUX=YOU*ALPH
          RES(1)=AUX*THMO*EPAIST
          RES(2)=0.
          RES(3)=AUX*(THMO*EPAIST*EXCEN+THDI*EP2)
          RES(4)=0.
        ELSE
          AUX=YOU*ALPH/(1.D0-XNU)
          RES(1)=AUX*THMO*EPAIST
          RES(2)=RES(1)
          RES(3)=AUX*(THMO*EPAIST*EXCEN+THDI*EP2)
          RES(4)=RES(3)
        ENDIF
 
C  6 - Elements COQUES EPAISSES
C ==============================
      ELSE IF (MELE.EQ.41.OR.MELE.EQ.56) THEN
        YOU=VALMAT(1)
        XNU=VALMAT(2)
        ALPH=VALMAT(3)
        AUX=YOU*ALPH/(1.-XNU)
        THG=0.5*E3*((E3+1.D0)*THSU+(E3-1.D0)*THIF)+(1.-E3*E3)*THM
        RES(1)=AUX*THG
        RES(2)=RES(1)
        RES(3)=0.
        RES(4)=0.
        RES(5)=0.
 
C  7 - Elements POUTRES et TUYAUX
C ================================
      ELSE IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.84) THEN
        YOU=VALMAT(1)
        ALPH=VALMAT(2)
        RES(1)=YOU*ALPH*SD*TEMP
 
C  8 - Elements BARRES, CERCES et POI1
C =====================================
      ELSE IF (MELE.EQ. 46.OR.MELE.EQ. 95.OR.MELE.EQ.45.OR.
     .         MELE.EQ.123.OR.MELE.EQ.124) THEN
        IF (MELE.EQ.45.AND.IFOUR.NE.-3) THEN
          KERRE=86
        ELSE IF (MELE.EQ.95.AND.IFOUR.NE.0) THEN
          KERRE=86
        ELSE
          YOU=VALMAT(1)
          ALPH=VALMAT(2)
          RES(1)=YOU*ALPH*SD*TEMP
        ENDIF
 
C  9 - Autres cas non prevus
C ===========================
      ELSE
        KERRE=19
      ENDIF
 
      RETURN
      END