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

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