Télécharger la plaquette Cast3M


fr en

Télécharger defcar.eso

Retour à la liste

Numérotation des lignes : 

defcar

  1. C DEFCAR    SOURCE    OF166741  25/02/21    21:15:47     12166          
  2.       SUBROUTINE DEFCAR(NCARR,IB,IGAU,MFR,MELE,IVACAR, WRK1)
  3.  
  4. ********************************************************
  5. *   ENTREES
  6. ********************************************************
  7. *
  8. *  NCARR   : nombre de composantes des caractéristiques géométriques
  9. *  ICARA   : dimension de XCAR
  10. *  IB: numéro de l'élément
  11. *  IGAU    : numéro du point de Gauss
  12. *  MFR     : formulation de l'élément
  13. *  MELE    : numéro de l'element fini
  14. *  IVACAR  : pointeur sur un segment mptval de caracteristiques geometrique
  15. *
  16. *******************************************************
  17. *   SORTIES
  18. *******************************************************
  19. *
  20. *  XCAR(ICARA) : caractéristiques géométriques (WRK1)
  21. *
  22. *******************************************************
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.  
  30. -INC SMCHAML
  31. -INC SMCOORD
  32.  
  33. -INC TMPTVAL
  34.  
  35.       SEGMENT WRK1
  36.         REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  37.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  38.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  39.       ENDSEGMENT
  40.  
  41.       SEGMENT WRKTRA
  42.         REAL*8 TTRAV(NTTRAV)
  43.       ENDSEGMENT
  44.  
  45.       IF (IVACAR.EQ.0) RETURN
  46.  
  47.       MPTVAL=IVACAR
  48.       ICARA=XCAR(/1)
  49. *
  50. * cas des tuyaux
  51. *
  52.       IF(MFR.EQ.13)THEN
  53.          DO 2106 IC=1,5
  54.             MELVAL=IVAL(IC)
  55.             IF(MELVAL.NE.0)THEN
  56.                IBMN=MIN(IB,VELCHE(/2))
  57.                IGMN=MIN(IGAU,VELCHE(/1))
  58.                XCAR(IC)=VELCHE(IGMN,IBMN)
  59.             ELSE
  60.                XCAR(IC)=0.D0
  61.             ENDIF
  62. 2106      continue
  63.          DO 2107 IC=6,NCARR
  64.             MELVAL=IVAL(IC)
  65.             IF(MELVAL.NE.0)THEN
  66.                IBMN=MIN(IB,VELCHE(/2))
  67.                IGMN=MIN(IGAU,VELCHE(/1))
  68.                XCAR(IC)=VELCHE(IGMN,IBMN)
  69.             ELSE
  70.                XCAR(IC)=-1.D0
  71.             ENDIF
  72. 2107      continue
  73. C
  74. C Poutre 3D
  75. C
  76.       ELSE IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  77.          DO 1107 IC=1,NCARR
  78.             MELVAL=IVAL(IC)
  79.             IF(MELVAL.NE.0)THEN
  80.                IBMN=MIN(IB,VELCHE(/2))
  81.                IGMN=MIN(IGAU,VELCHE(/1))
  82.                XCAR(IC)=VELCHE(IGMN,IBMN)
  83.             ELSE
  84.                XCAR(IC)=0.D0
  85.             ENDIF
  86. 1107      continue
  87. C  distinction entre poutre bernouilli et poutre timo en ce qui
  88. C  concerne le defaut pour les sections reduites de l'effort tranchant
  89.          IF(MFR.EQ.7.AND.MELE.EQ.84)THEN
  90.            SD=XCAR(4)
  91.            SREDY=XCAR(5)
  92.            SREDZ=XCAR(6)
  93.            IF(SREDY.EQ.0) XCAR(5)=SD
  94.            IF(SREDZ.EQ.0) XCAR(6)=SD
  95.           ENDIF
  96. C
  97. C Poutre 2D
  98. C
  99.          ELSEIF(IDIM.EQ.2)THEN
  100.           DO 1106 IC=1,NCARR
  101.             MELVAL=IVAL(IC)
  102.             IF(MELVAL.NE.0)THEN
  103.                IBMN=MIN(IB,VELCHE(/2))
  104.                IGMN=MIN(IGAU,VELCHE(/1))
  105.                XCAR(IC)=VELCHE(IGMN,IBMN)
  106.              ELSE
  107. *              cas des coques minces : défaut de alfah
  108.                IF(IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  109.                    XCAR(IC)=0.66666666666666D0
  110.                ELSE
  111.                    XCAR(IC)=0.D0
  112.                ENDIF
  113.             ENDIF
  114. 1106      continue
  115. C  distinction entre poutre bernouilli et poutre timo en ce qui
  116. C  concerne le defaut pour les sections reduites de l'effort tranchant
  117.            SD=XCAR(1)
  118.            if (ncarr.ge.3) then
  119.            SREDY=XCAR(3)
  120.            IF(SREDY.EQ.0) XCAR(3)=SD
  121.            endif
  122. C
  123.       ELSE
  124.          DO 1110 IC=1,ICARA
  125.             MELVAL=IVAL(IC)
  126.             IF(MELVAL.NE.0)THEN
  127.                IBMN=MIN(IB,VELCHE(/2))
  128.                IGMN=MIN(IGAU,VELCHE(/1))
  129.                XCAR(IC)=VELCHE(IGMN,IBMN)
  130.             ELSE
  131. *              cas des coques minces : défaut de alfah
  132.                IF (IC.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  133.                   XCAR(IC)=0.66666666666666D0
  134.                ELSE
  135.                   XCAR(IC)=0.D0
  136.                ENDIF
  137.             ENDIF
  138. 1110      continue
  139.       ENDIF
  140. *
  141. *    rearrangement du tableau xcar pour qu'on ait le meme ordre
  142. *    que l'ancien  chamelem
  143. *
  144.       IF(MFR.EQ.7.AND.IDIM.EQ.3)THEN
  145.             VX=XCAR(ICARA-5)
  146.             VY=XCAR(ICARA-4)
  147.             VZ=XCAR(ICARA-3)
  148.             XCAR(ICARA-5)=XCAR(ICARA-2)
  149.             XCAR(ICARA-4)=XCAR(ICARA-1)
  150.             XCAR(ICARA-3)=XCAR(ICARA)
  151.             XCAR(ICARA-2)=VX
  152.             XCAR(ICARA-1)=VY
  153.             XCAR(ICARA)=VZ
  154. *
  155.       ELSE IF(MFR.EQ.13)THEN
  156.          NTTRAV = 7
  157.          SEGINI WRKTRA
  158.          DO 1111 IC=4,10
  159.             TTRAV(IC-3)=XCAR(IC)
  160. 1111        continue
  161.          IF(IDIM.EQ.2)THEN
  162.             XCAR(4)=XCAR(ICARA-1)
  163.             XCAR(5)=XCAR(ICARA)
  164.             DO 1112 IC=1,NTTRAV
  165.                XCAR(IC+5)=TTRAV(IC)
  166. 1112        continue
  167.          ELSE IF(IDIM.EQ.3)THEN
  168.             XCAR(4)=XCAR(ICARA-2)
  169.             XCAR(5)=XCAR(ICARA-1)
  170.             XCAR(6)=XCAR(ICARA)
  171.             DO 1113 IC=1,NTTRAV
  172.                XCAR(IC+6)=TTRAV(IC)
  173. 1113        continue
  174.          ENDIF
  175.          SEGSUP WRKTRA
  176.       ENDIF
  177.  
  178.       RETURN
  179.       END
  180.  
  181.  
  182.  

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