Télécharger la plaquette Cast3M


fr en

Télécharger bbar.eso

Retour à la liste

Numérotation des lignes : 

bbar

  1. C BBAR      SOURCE    OF166741  23/04/25    21:15:04     11608          
  2.  
  3.       SUBROUTINE BBAR(IGAU,NBPGAU,POIGAU,QSIGAU,ETAGAU,DZEGAU,
  4.      1                MELE,NBNO,LRE,IFOU,NST,XE,DJAC,A,BB,BGENE)
  5.  
  6. C=======================================================================
  7. C=                            B B A R                                  =
  8. C=                          -----------                                =
  9. C=  Fonction :                                                         =
  10. C=  ----------                                                         =
  11. C= CALCUL DE LA MATRICE B-BARRE - ELEMENTS INCOMPRESSIBLES 'IC--'      =
  12. C=         - EN 2D : ELEMENTS ICT3, ICT6, ICQ4, ICQ8                   =
  13. C=         - EN 3D : ELEMENTS ICC8, IC20, ICT4, ICY5                   =
  14. C=                   ELEMENTS IC10, ICP6, IC15, IC13 -> A voir         =
  15. C=                                                                     =
  16. C=   Calcul de la matrice B reliant les deformations en un point d'un  =
  17. C=   element fini aux ddls de deplacement aux noeuds de cet element    =
  18. C=   Le jacobien est egalement evalue au point de Gauss pour verifier  =
  19. C=   ulterieurement si l'element fini n'est pas trop distordu.         =
  20. C=                                                                     =
  21. C=  Parametres :  (E)=Entree  (S)=Sortie                               =
  22. C=  ------------                                                       =
  23. C=   IGAU     (E)   Numero du point de Gauss considere                 =
  24. C=   NBPGAU   (E)   Nombre de points de Gauss de l'element fini        =
  25. C=   POIGAU,QSIGAU   (E)   |  Poids et coordonnees de reference des    =
  26. C=   ETAGAU,DZEGAU   (E)   |  differents points de Gauss de l'element  =
  27. C=   MELE     (E)   Type de l'element fini (cf. NOMTP dans bdata.eso)  =
  28. C=   NBNO     (E)   Nombre de noeuds de l'element fini                 =
  29. C=   LRE      (E)   Nombre de DDL de l'element fini                    =
  30. C=   IFOU     (E)   Mode de calcul utilise (cf. IFOUR dans CCOPTIO)    =
  31. C=   NST      (E)   Nombre de composantes de deformations              =
  32. C=   XE       (E)   Coordonnees des noeuds de l'element fini etudie    =
  33. C=   DJAC     (S)   Jacobien au point de Gauss etudie                  =
  34. C=   BGENE   (E/S)  Matrice de gradients (B) calcule au point de Gauss =
  35. C=   A,BB     (S)   Matrices utiles pour la methode BBar               =
  36. C=======================================================================
  37. C    LRE = NOMBRE DE COLONNES DE LA MATRICE B
  38. C    A = COEFFICIENTS DE MODIFICATION
  39. C    BB(3,LRE) = MATRICE B-BARRE DILATATION
  40. C    BGENE(NST,LRE) = MATRICE B
  41. C=======================================================================
  42.  
  43.       IMPLICIT INTEGER(I-N)
  44.       IMPLICIT REAL*8(A-H,O-Z)
  45.  
  46.       PARAMETER (XZero=0., XUn=1., X1s2=0.5,
  47.      &           X1s3=0.333333333333333333333333333333333333333333)
  48.  
  49.       DIMENSION XE(3,*),BGENE(NST,*),
  50.      &          POIGAU(*),QSIGAU(*),ETAGAU(*),DZEGAU(*),
  51.      &          A(4,*),BB(3,*)
  52.  
  53. *      WRITE(6,*) 'Entree dans le sousprogramme BBAR'
  54. *      WRITE(6,*) 'Element',MELE,NST,IFOU
  55. *      WRITE(6,*) 'Point Gauss: xsi=',QSIGAU(IGAU),'eta=',ETAGAU(IGAU),
  56. *     &           'dze=',DZEGAU(IGAU)
  57.  
  58. C-----------------------------------------------------------------------
  59. C---- Elements incompressibles (MFR = 31) ------------------------------
  60. C-----------------------------------------------------------------------
  61. C NOM  :   ICT3, ICQ4, ICT6, ICQ8, ICC8, ICT4, ICP6, IC20, IC10, IC15
  62. C MELE :    69 ,  70 ,  71 ,  72 ,  73 ,  74 ,  75 ,  76 ,  77 ,  78
  63. C NOM  :   ICY5, IC13
  64. C MELE :   273 , 274 ,
  65. C-----------------------------------------------------------------------
  66. C= 0 = Quelques initialisations ========================================
  67.       IFR = IFOU+4
  68. C= Indices des composantes diagonales du gradient / deformation
  69. C= Attention : NST = 9 pour gradient et NST = 6/4/3 pour deformations
  70.       I1BG = 1
  71.       IF (NST.EQ.9) THEN
  72.         I2BG = 5
  73.         I3BG = 9
  74.       ELSE
  75.         I2BG = 2
  76.         I3BG = 3
  77.       ENDIF
  78.  
  79. C= 1 = Branchement selon l'Element Fini BBAR ============================
  80.       IF (MELE.EQ.273) GOTO 273
  81.       IF (MELE.EQ.274) GOTO 274
  82.       GOTO ( 69, 70, 71, 72, 73, 74, 75, 76, 77, 78 ), (MELE-68)
  83.       GOTO 666
  84.  
  85. C-----------------------------------------------------------------------
  86. C----- Element massif bidimensionnel ICT3 ------------------------------
  87. C-----------------------------------------------------------------------
  88.  69   CONTINUE
  89. *W      WRITE(*,*) 'Element ICT3',IFOU
  90.       GOTO (666,691,691,693),IFR
  91.       GOTO 666
  92. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  93.  691  CONTINUE
  94.       K = 1
  95.       DO i = 1,NBNO
  96.         BGENE(I2BG,K) = X1s2 * (BB(1,K)-BGENE(I1BG,K))
  97.         BGENE(I1BG,K) = X1s2 * (BB(1,K)+BGENE(I1BG,K))
  98.         K = K+1
  99.         BGENE(I1BG,K) = X1s2 * (BB(2,K)-BGENE(I2BG,K))
  100.         BGENE(I2BG,K) = X1s2 * (BB(2,K)+BGENE(I2BG,K))
  101.         K = K+1
  102.       ENDDO
  103.       GOTO 999
  104. *----- Axisymetrie (IFOU=0)
  105.  693  CONTINUE
  106.       K = 1
  107.       DO i = 1,NBNO
  108.         r_z = X1s3 * (BB(1,K)-BGENE(I1BG,K)+BB(3,K)-BGENE(I3BG,K))
  109.         BGENE(I1BG,K) = BGENE(I1BG,K) + r_z
  110.         BGENE(I2BG,K) = r_z
  111.         BGENE(I3BG,K) = BGENE(I3BG,K) + r_z
  112.         K = K + 1
  113.         r_z = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  114.         BGENE(I1BG,K) = r_z
  115.         BGENE(I2BG,K) = BGENE(I2BG,K) + r_z
  116.         BGENE(I3BG,K) = r_z
  117.         K = K + 1
  118.       ENDDO
  119.       GOTO 999
  120.  
  121. C-----------------------------------------------------------------------
  122. C----- Element massif bidimensionnel ICQ4 ------------------------------
  123. C-----------------------------------------------------------------------
  124.  70   CONTINUE
  125. *W      WRITE(*,*) 'Element ICQ4',IFOU
  126.       GOTO (666,701,701,703),IFR
  127.       GOTO 666
  128. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  129.  701  CONTINUE
  130.       K = 1
  131.       DO i = 1,NBNO
  132.         BGENE(I2BG,K) = X1s2 * (BB(1,K)-BGENE(I1BG,K))
  133.         BGENE(I1BG,K) = X1s2 * (BB(1,K)+BGENE(I1BG,K))
  134.         K = K + 1
  135.         BGENE(I1BG,K) = X1s2 * (BB(2,K)-BGENE(I2BG,K))
  136.         BGENE(I2BG,K) = X1s2 * (BB(2,K)+BGENE(I2BG,K))
  137.         K = K + 1
  138.       ENDDO
  139.       GOTO 999
  140. *----- Axisymetrie (IFOU=0)
  141.  703  CONTINUE
  142.       K = 1
  143.       DO i = 1,NBNO
  144.         r_z = X1s3 * (BB(1,K)-BGENE(I1BG,K)+BB(3,K)-BGENE(I3BG,K))
  145.         BGENE(I1BG,K) = BGENE(I1BG,K) + r_z
  146.         BGENE(I2BG,K) = r_z
  147.         BGENE(I3BG,K) = BGENE(I3BG,K) + r_z
  148.         K = K + 1
  149.         r_z = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  150.         BGENE(I1BG,K) = r_z
  151.         BGENE(I2BG,K) = BGENE(I2BG,K) + r_z
  152.         BGENE(I3BG,K) = r_z
  153.         K = K + 1
  154.       ENDDO
  155.       GOTO 999
  156.  
  157. C-----------------------------------------------------------------------
  158. C----- Element massif bidimensionnel ICT6 ------------------------------
  159. C-----------------------------------------------------------------------
  160.  71   CONTINUE
  161. *      WRITE(6,*) 'Element ICT6',IFOU
  162.       GOTO (666,711,711,713),IFR
  163.       GOTO 666
  164. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  165.  711  CONTINUE
  166.       K = 1
  167.       DO i = 1,NBNO
  168.         BGENE(I2BG,K) = X1s2 * (BB(1,K)-BGENE(I1BG,K))
  169.         BGENE(I1BG,K) = X1s2 * (BB(1,K)+BGENE(I1BG,K))
  170.         K = K + 1
  171.         BGENE(I1BG,K) = X1s2 * (BB(2,K)-BGENE(I2BG,K))
  172.         BGENE(I2BG,K) = X1s2 * (BB(2,K)+BGENE(I2BG,K))
  173.         K = K + 1
  174.       ENDDO
  175.       GOTO 999
  176. *----- Axisymetrie (IFOU=0)
  177.  713  CONTINUE
  178.       K = 1
  179.       DO i = 1,NBNO
  180.         r_z = X1s3 * (BB(1,K)-BGENE(I1BG,K)+BB(3,K)-BGENE(I3BG,K))
  181.         BGENE(I1BG,K) = BGENE(I1BG,K) + r_z
  182.         BGENE(I2BG,K) = r_z
  183.         BGENE(I3BG,K) = BGENE(I3BG,K) + r_z
  184.         K = K + 1
  185.         r_z = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  186.         BGENE(I1BG,K) = r_z
  187.         BGENE(I2BG,K) = BGENE(I2BG,K) + r_z
  188.         BGENE(I3BG,K) = r_z
  189.         K = K + 1
  190.       ENDDO
  191.       GOTO 999
  192.  
  193. C-----------------------------------------------------------------------
  194. C----- Element massif bidimensionnel ICQ8 ------------------------------
  195. C-----------------------------------------------------------------------
  196.  72   CONTINUE
  197. *W      WRITE(*,*) 'Element ICQ8',IFOU
  198.       QSI_z = QSIGAU(IGAU)
  199.       ETA_z = ETAGAU(IGAU)
  200.       GOTO (666,721,721,723),IFR
  201.       GOTO 666
  202. *----- Contraintes planes ou deformations planes (IFOU=-2,-1)
  203.  721  CONTINUE
  204. *----- Calculs des composantes de BB-DILATATION
  205.       BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  206.       BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  207.       BB(1, 3) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  208.       BB(2, 4) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  209.       BB(1, 5) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  210.       BB(2, 6) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  211.       BB(1, 7) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  212.       BB(2, 8) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  213.       BB(1, 9) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  214.       BB(2,10) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  215.       BB(1,11) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  216.       BB(2,12) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  217.       BB(1,13) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  218.       BB(2,14) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  219.       BB(1,15) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  220.       BB(2,16) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  221. *W      WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  222. *W      WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  223. *W 4    FORMAT (3(A,I1,A,I1,A,F8.4,2X))
  224. *----- Calcul des composantes de B-BARRE
  225.       K = 1
  226.       DO i = 1,NBNO
  227.         BGENE(I2BG,K) = X1s2 * (BB(1,K)-BGENE(I1BG,K))
  228.         BGENE(I1BG,K) = X1s2 * (BB(1,K)+BGENE(I1BG,K))
  229.         K = K + 1
  230.         BGENE(I1BG,K) = X1s2 * (BB(2,K)-BGENE(I2BG,K))
  231.         BGENE(I2BG,K) = X1s2 * (BB(2,K)+BGENE(I2BG,K))
  232.         K = K + 1
  233.       ENDDO
  234.       GOTO 999
  235. *----- Axisymetrie (IFOU=0)
  236.  723  CONTINUE
  237. *----- Calculs des composantes de BB-DILATATION
  238.       BB(1, 1) = A(1, 1) + A(2, 1)*QSI_z + A(3, 1)*ETA_z
  239.       BB(2, 2) = A(1, 2) + A(2, 2)*QSI_z + A(3, 2)*ETA_z
  240.       BB(3, 1) = A(1, 3) + A(2, 3)*QSI_z + A(3, 3)*ETA_z
  241.       BB(1, 3) = A(1, 4) + A(2, 4)*QSI_z + A(3, 4)*ETA_z
  242.       BB(2, 4) = A(1, 5) + A(2, 5)*QSI_z + A(3, 5)*ETA_z
  243.       BB(3, 3) = A(1, 6) + A(2, 6)*QSI_z + A(3, 6)*ETA_z
  244.       BB(1, 5) = A(1, 7) + A(2, 7)*QSI_z + A(3, 7)*ETA_z
  245.       BB(2, 6) = A(1, 8) + A(2, 8)*QSI_z + A(3, 8)*ETA_z
  246.       BB(3, 5) = A(1, 9) + A(2, 9)*QSI_z + A(3, 9)*ETA_z
  247.       BB(1, 7) = A(1,10) + A(2,10)*QSI_z + A(3,10)*ETA_z
  248.       BB(2, 8) = A(1,11) + A(2,11)*QSI_z + A(3,11)*ETA_z
  249.       BB(3, 7) = A(1,12) + A(2,12)*QSI_z + A(3,12)*ETA_z
  250.       BB(1, 9) = A(1,13) + A(2,13)*QSI_z + A(3,13)*ETA_z
  251.       BB(2,10) = A(1,14) + A(2,14)*QSI_z + A(3,14)*ETA_z
  252.       BB(3, 9) = A(1,15) + A(2,15)*QSI_z + A(3,15)*ETA_z
  253.       BB(1,11) = A(1,16) + A(2,16)*QSI_z + A(3,16)*ETA_z
  254.       BB(2,12) = A(1,17) + A(2,17)*QSI_z + A(3,17)*ETA_z
  255.       BB(3,11) = A(1,18) + A(2,18)*QSI_z + A(3,18)*ETA_z
  256.       BB(1,13) = A(1,19) + A(2,19)*QSI_z + A(3,19)*ETA_z
  257.       BB(2,14) = A(1,20) + A(2,20)*QSI_z + A(3,20)*ETA_z
  258.       BB(3,13) = A(1,21) + A(2,21)*QSI_z + A(3,21)*ETA_z
  259.       BB(1,15) = A(1,22) + A(2,22)*QSI_z + A(3,22)*ETA_z
  260.       BB(2,16) = A(1,23) + A(2,23)*QSI_z + A(3,23)*ETA_z
  261.       BB(3,15) = A(1,24) + A(2,24)*QSI_z + A(3,24)*ETA_z
  262. *W      WRITE (*,*) 'Ecriture de la matrice BB[ ]'
  263. *W      WRITE (*,4) (('BB(',I,',',J,')=',BB(I,J),I=1,3),J=1,16)
  264. *----- Calcul des composantes de B-BARRE
  265.       K = 1
  266.       DO i = 1,NBNO
  267.         r_z = X1s3 * (BB(1,K)-BGENE(I1BG,K)+BB(3,K)-BGENE(I3BG,K))
  268.         BGENE(I1BG,K) = BGENE(I1BG,K) + r_z
  269.         BGENE(I2BG,K) = r_z
  270.         BGENE(I3BG,K) = BGENE(I3BG,K) + r_z
  271.         K = K + 1
  272.         r_z = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  273.         BGENE(I1BG,K) = r_z
  274.         BGENE(I2BG,K) = BGENE(I2BG,K) + r_z
  275.         BGENE(I3BG,K) = r_z
  276.         K = K + 1
  277.       ENDDO
  278.       GOTO 999
  279.  
  280. C-----------------------------------------------------------------------
  281. C----- Element massif tridimensionnel ICC8,ICT4, ICP6 -----------------------------
  282. C-----------------------------------------------------------------------
  283.  73   CONTINUE
  284. *W      WRITE(*,*) 'Element ICC8',IFOU
  285.  74   CONTINUE
  286. *W      WRITE(*,*) 'Element ICT4',IFOU
  287.  75   CONTINUE
  288. *W      WRITE(*,*) 'Element ICP6',IFOU
  289.  273  CONTINUE
  290. *W      WRITE(*,*) 'Element ICY5',IFOU
  291.       IF (IFOU.NE.2) GOTO 666
  292. *      QSI_z = QSIGAU(IGAU)
  293. *      ETA_z = ETAGAU(IGAU)
  294. *      DZE_z = DZEGAU(IGAU)
  295.       K = 1
  296.       DO i = 1,NBNO
  297.         BGENE(I3BG,K) = X1s3 * (BB(1,K)-BGENE(I1BG,K))
  298.         BGENE(I2BG,K) = X1s3 * (BB(1,K)-BGENE(I1BG,K))
  299.         BGENE(I1BG,K) = X1s3 * (BB(1,K) + 2.D0*BGENE(I1BG,K))
  300.         K = K+1
  301.         BGENE(I1BG,K) = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  302.         BGENE(I3BG,K) = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  303.         BGENE(I2BG,K) = X1s3 * (BB(2,K) + 2.D0*BGENE(I2BG,K))
  304.         K = K+1
  305.         BGENE(I1BG,K) = X1s3 * (BB(3,K)-BGENE(I3BG,K))
  306.         BGENE(I2BG,K) = X1s3 * (BB(3,K)-BGENE(I3BG,K))
  307.         BGENE(I3BG,K) = X1s3 * (BB(3,K) + 2.D0*BGENE(I3BG,K))
  308.         K = K+1
  309.       ENDDO
  310.       GOTO 999
  311.  
  312. C-----------------------------------------------------------------------
  313. C----- Element massif tridimensionnel IC20 IC10 IC15 -------------------
  314. C-----------------------------------------------------------------------
  315.  76   CONTINUE
  316. *W       WRITE(*,*) 'Element IC20',IFOU
  317.  77   CONTINUE
  318. *W      WRITE(*,*) 'Element IC10',IFOU
  319.  78   CONTINUE
  320. *W      WRITE(*,*) 'Element IC15',IFOU
  321.  274  CONTINUE
  322. *W      WRITE(*,*) 'Element IC13',IFOU
  323.       IF (IFOU.NE.2) GOTO 666
  324.       QSI_z = QSIGAU(IGAU)
  325.       ETA_z = ETAGAU(IGAU)
  326.       DZE_z = DZEGAU(IGAU)
  327.  
  328. *----- Calculs des composantes de BB-DILATATION
  329.       K = 0
  330.       DO i = 1,NBNO
  331.       BB(1,K+1) = A(1,K+1) + A(2,K+1)*QSI_z + A(3,K+1)*ETA_z + 
  332.      &A(4,K+1)*DZE_z
  333.       BB(2,K+2) = A(1,K+2) + A(2,K+2)*QSI_z + A(3,K+2)*ETA_z + 
  334.      &A(4,K+2)*DZE_z
  335.       BB(3,K+3) = A(1,K+3) + A(2,K+3)*QSI_z + A(3,K+3)*ETA_z + 
  336.      &A(4,K+3)*DZE_z
  337.  
  338.         K = K+3
  339.       ENDDO
  340.  
  341. *----- Calcul des composantes de B-BARRE
  342.       K = 1
  343.       DO i = 1,NBNO
  344.         BGENE(I3BG,K) = X1s3 * (BB(1,K)-BGENE(I1BG,K))
  345.         BGENE(I2BG,K) = X1s3 * (BB(1,K)-BGENE(I1BG,K))
  346.         BGENE(I1BG,K) = X1s3 * (BB(1,K) + 2.D0*BGENE(I1BG,K))
  347.         K = K+1
  348.         BGENE(I1BG,K) = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  349.         BGENE(I3BG,K) = X1s3 * (BB(2,K)-BGENE(I2BG,K))
  350.         BGENE(I2BG,K) = X1s3 * (BB(2,K) + 2.D0*BGENE(I2BG,K))
  351.         K = K+1
  352.         BGENE(I1BG,K) = X1s3 * (BB(3,K)-BGENE(I3BG,K))
  353.         BGENE(I2BG,K) = X1s3 * (BB(3,K)-BGENE(I3BG,K))
  354.         BGENE(I3BG,K) = X1s3 * (BB(3,K) + 2.D0*BGENE(I3BG,K))
  355.         K = K+1
  356.       ENDDO
  357.       GOTO 999
  358.  
  359. C-----------------------------------------------------------------------
  360. C----- ERREUR : Donnees incompatibles ----------------------------------
  361. C-----------------------------------------------------------------------
  362.  666  CONTINUE
  363. *      WRITE(6,*) 'Mode de calcul ',IFOU,' incompatible avec ',
  364. *     &           'element ',MELE
  365.       CALL ERREUR(5)
  366.  
  367. C-----------------------------------------------------------------------
  368. C----- FIN du sousprogramme --------------------------------------------
  369. C-----------------------------------------------------------------------
  370.  999  CONTINUE
  371. *      WRITE(6,*) 'Sortie du sousprogramme BBAR'
  372.  
  373.       RETURN
  374.       END
  375.  
  376.  
  377.  

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