Télécharger la plaquette Cast3M


fr en

Télécharger bgrmas.eso

Retour à la liste

Numérotation des lignes : 

bgrmas

  1. C BGRMAS    SOURCE    CHAT      05/01/12    21:39:48     5004
  2.  
  3. C=======================================================================
  4. C=                            B G R M A S                              =
  5. C=                            -----------                              =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul de la matrice de gradients BGR au point de Gauss iGau de   =
  10. C=   l'element fini de type iTEl.                                      =
  11. C=   Le jacobien est egalement evalue au point de Gauss pour verifier  =
  12. C=   ulterieurement si l'element fini n'est pas trop distordu.         =
  13. C=                                                                     =
  14. C=  Parametres :  (E)=Entree  (S)=Sortie                               =
  15. C=  ------------                                                       =
  16. C=   iGau     (E)   Numero du point de Gauss considere                 =
  17. C=   iTEl     (E)   Type de l'element fini (cf. NOMTP dans bdata.eso)  =
  18. C=   NBNO     (E)   Nombre de noeuds de l'element fini                 =
  19. C=   LRE      (E)   Nombre de DDL de l'element fini                    =
  20. C=   IFOU     (E)   Mode de calcul utilise (cf. IFOUR dans CCOPTIO)    =
  21. C=   NGRA     (E)   Nombre de composantes du gradient                  =
  22. C=   NN       (E)   Numero du mode de Fourier (si IFOU=1)              =
  23. C=   XEL      (E)   Coordonnees des noeuds de l'element fini etudie    =
  24. C=   Excen    (E)   Excentrement dans le cas d'un element coque        =
  25. C=   SHPTOT   (E)   Fonctions de forme et leurs derivees               =
  26. C=   SHP      (S)   Fonctions de forme et leurs derivees actuelles     =
  27. C=   BB       (S)   Matrice de travail                                 =
  28. C=   BGR      (S)   Matrice de gradients (B) calcule au point de Gauss =
  29. C=   DJac     (S)   Jacobien au point de Gauss etudie                  =
  30. C=   IIPDPG   (E)   Numero du noeud support en modes GENERALISEs       =
  31. C=                                                                     =
  32. C=  Remarque :                                                         =
  33. C=  ----------                                                         =
  34. C=   SHPTOT(2 a 4,*) contient les DERIVEES des fonctions de forme par  =
  35. C=   rapport aux coordonnees de REFERENCE Qsi,Eta,Dzeta.               =
  36. C=   En sortie du sousprogramme, SHPTOT(2 a 4,*) contient les DERIVEES =
  37. C=   des fonctions de FORME par rapport aux coordonnees REELLES x,y,z. =
  38. C=======================================================================
  39.  
  40.       SUBROUTINE BGRMAS (iGau,iTEl,NBNO,LRE,IFOU,NGRA,NN,
  41.      .                   XEL,Excen,SHPTOT,SHP,BB,BGR,DJAC,IIPDPG)
  42.  
  43.       IMPLICIT INTEGER(I-N)
  44.       IMPLICIT REAL*8 (A-H,O-Z)
  45.  
  46.  
  47. -INC PPARAM
  48. -INC CCOPTIO
  49. -INC CCREEL
  50. -INC SMCOORD
  51.  
  52.       DIMENSION XEL(3,*),BGR(NGRA,*),SHP(6,*),SHPTOT(6,NBNO,*),BB(2,*)
  53.       DIMENSION GEOM(20),XX(3),YY(3),BBF(4,9)
  54.  
  55.       DATA XX / .5, .0, .5 /
  56.       DATA YY / .0, .5, .5 /
  57.  
  58. C= Quelques constantes (2.Pi et 4.Pi)
  59.       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  60.       PARAMETER (X4Pi=12.566370614359172953850573533118D0)
  61.  
  62.       CALL ZERO(BGR,NGRA,LRE)
  63.       IF (iTEl.EQ.28.OR.iTEl.EQ.45) GOTO 28
  64.       IF (iTEl.GE.57.AND.iTEl.LE.68) GOTO 57
  65.  
  66. C  1 - Elements MASSIFS en MECANIQUE
  67. C ===================================
  68.       IFOR=IFOU+4
  69.       GOTO (100,110,110,120,130,140,150,150,150,150,
  70.      .      150,150,150,150,150,160,160,160,170     ),IFOR
  71.       RETURN
  72. C =====
  73. C  1.1 - Elements MASSIFS 2D PLAN GENE
  74. C =====
  75.  100  XXX=XZero
  76.       YYY=XZero
  77.       DO i=1,NBNO
  78.         SHP(1,i)=SHPTOT(1,i,iGau)
  79.         SHP(2,i)=SHPTOT(2,i,iGau)
  80.         SHP(3,i)=SHPTOT(3,i,iGau)
  81.         XXX=XXX+SHP(1,i)*XEL(1,i)
  82.         YYY=YYY+SHP(1,i)*XEL(2,i)
  83.       ENDDO
  84.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  85.       K=1
  86.       DO i=1,NBNO
  87.         BGR(1,K)=SHP(2,i)
  88.         BGR(2,K)=SHP(3,i)
  89.         BGR(4,K+1)=SHP(2,i)
  90.         BGR(5,K+1)=SHP(3,i)
  91.         K=K+2
  92.       ENDDO
  93.       IREF=(IIPDPG-1)*(IDIM+1)
  94.       BGR(9,K)=1.
  95.       BGR(9,K+1)=XCOOR(IREF+1)-XXX
  96.       BGR(9,K+2)=YYY-XCOOR(IREF+2)
  97.       RETURN
  98. C =====
  99. C  1.2 - Elements MASSIFS 2D PLAN DEFO ou PLAN CONT
  100. C =====
  101.  110  DO i=1,NBNO
  102.         SHP(1,i)=SHPTOT(1,i,iGau)
  103.         SHP(2,i)=SHPTOT(2,i,iGau)
  104.         SHP(3,i)=SHPTOT(3,i,iGau)
  105.       ENDDO
  106.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  107.       K=1
  108.       DO i=1,NBNO
  109.         BGR(1,K)=SHP(2,i)
  110.         BGR(2,K)=SHP(3,i)
  111.         BGR(4,K+1)=SHP(2,i)
  112.         BGR(5,K+1)=SHP(3,i)
  113.         K=K+2
  114.       ENDDO
  115.       RETURN
  116. C =====
  117. C  1.3 - Elements MASSIFS 2D AXISymetrique
  118. C =====
  119.  120  DO i=1,NBNO
  120.         SHP(1,i)=SHPTOT(1,i,iGau)
  121.         SHP(2,i)=SHPTOT(2,i,iGau)
  122.         SHP(3,i)=SHPTOT(3,i,iGau)
  123.       ENDDO
  124.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  125.       CALL DISTRR(XEL,SHP,NBNO,RR)
  126. C*OF  DJAC=X2Pi*DJAC*RR
  127.       DJAC=DJAC*RR
  128.       K=1
  129.       DO i=1,NBNO
  130.         BGR(1,K)=SHP(2,i)
  131.         BGR(2,K)=SHP(3,i)
  132.         BGR(4,K+1)=SHP(2,i)
  133.         BGR(5,K+1)=SHP(3,i)
  134.         BGR(9,K)=SHP(1,i)/RR
  135.         K=K+2
  136.       ENDDO
  137.       RETURN
  138. C =====
  139. C  1.4 - Elements MASSIFS 2D FOURIER
  140. C =====
  141.  130  DO i=1,NBNO
  142.         SHP(1,i)=SHPTOT(1,i,iGau)
  143.         SHP(2,i)=SHPTOT(2,i,iGau)
  144.         SHP(3,i)=SHPTOT(3,i,iGau)
  145.       ENDDO
  146.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  147.       CALL DISTRR(XEL,SHP,NBNO,RR)
  148. C*OF  DJAC=X2Pi*DJAC*RR
  149. C*OF  IF (NN.EQ.0) DJAC=0.5*DJAC
  150.       DJAC=DJAC*RR
  151.       XNSUR=DBLE(NN)/RR
  152.       K=1
  153.       DO i=1,NBNO
  154.         BGR(1,K)=SHP(2,i)
  155.         BGR(2,K)=SHP(3,i)
  156.         BGR(3,K)=-SHP(1,i)*XNSUR
  157.         BGR(3,K+2)=-SHP(1,i)/RR
  158.         BGR(4,K+1)=SHP(2,i)
  159.         BGR(5,K+1)=SHP(3,i)
  160.         BGR(6,K+1)=-SHP(1,i)*XNSUR
  161.         BGR(7,K+2)=SHP(2,i)
  162.         BGR(8,K+2)=SHP(3,i)
  163.         BGR(9,K)=SHP(1,i)/RR
  164.         BGR(9,K+2)=SHP(1,i)*XNSUR
  165.         K=K+3
  166.       ENDDO
  167.       RETURN
  168. C =====
  169. C  1.6 - Elements MASSIFS 3D
  170. C =====
  171.  140  DO i=1,NBNO
  172.         SHP(1,i)=SHPTOT(1,i,iGau)
  173.         SHP(2,i)=SHPTOT(2,i,iGau)
  174.         SHP(3,i)=SHPTOT(3,i,iGau)
  175.         SHP(4,i)=SHPTOT(4,i,iGau)
  176.       ENDDO
  177.       CALL JACOBI(XEL,SHP,3,NBNO,DJAC)
  178.       K=1
  179.       DO i=1,NBNO
  180.         BGR(1,K)=SHP(2,i)
  181.         BGR(2,K)=SHP(3,i)
  182.         BGR(3,K)=SHP(4,i)
  183.         BGR(4,K+1)=SHP(2,i)
  184.         BGR(5,K+1)=SHP(3,i)
  185.         BGR(6,K+1)=SHP(4,i)
  186.         BGR(7,K+2)=SHP(2,i)
  187.         BGR(8,K+2)=SHP(3,i)
  188.         BGR(9,K+2)=SHP(4,i)
  189.         K=K+3
  190.       ENDDO
  191.       RETURN
  192. C =====
  193. C  1.7 - Elements MASSIFS 1D
  194. C =====
  195. C= 1.7.1 - Modes 1D PLAN
  196.  150  DO i=1,NBNO
  197.         SHP(1,i)=SHPTOT(1,i,iGau)
  198.         SHP(2,i)=SHPTOT(2,i,iGau)
  199.       ENDDO
  200.       CALL JACOBI(XEL,SHP,1,NBNO,DJAC)
  201.       DO i=1,NBNO
  202.         BGR(1,i)=SHP(2,i)
  203.       ENDDO
  204.       IF (IFOU.GE.7) THEN
  205.         BGR(9,i)=1.
  206.         IF (IFOU.EQ.11) BGR(5,i+1)=1.
  207.       ENDIF
  208.       RETURN
  209. C= 1.7.2 - Modes 1D AXIS
  210.  160  DO i=1,NBNO
  211.         SHP(1,i)=SHPTOT(1,i,iGau)
  212.         SHP(2,i)=SHPTOT(2,i,iGau)
  213.       ENDDO
  214.       CALL JACOBI(XEL,SHP,1,NBNO,DJAC)
  215.       CALL DISTRR(XEL,SHP,NBNO,RR)
  216. C*OF  DJAC=X2Pi*DJAC*RR
  217.       DJAC=DJAC*RR
  218.       DO i=1,NBNO
  219.         BGR(1,i)=SHP(2,i)
  220.         BGR(9,i)=SHP(1,i)/RR
  221.       ENDDO
  222.       IF (IFOU.EQ.14) BGR(5,i)=1.
  223.       RETURN
  224. C= 1.7.3 - Mode 1D SPHE
  225.  170  DO i=1,NBNO
  226.         SHP(1,i)=SHPTOT(1,i,iGau)
  227.         SHP(2,i)=SHPTOT(2,i,iGau)
  228.       ENDDO
  229.       CALL JACOBI(XEL,SHP,1,NBNO,DJAC)
  230.       CALL DISTRR(XEL,SHP,NBNO,RR)
  231. C*OF  DJAC=X4Pi*DJAC*RR*RR
  232.       DJAC=DJAC*RR*RR
  233.       DO i=1,NBNO
  234.         BGR(1,i)=SHP(2,i)
  235.         ZZ=SHP(1,i)/RR
  236.         BGR(5,i)=ZZ
  237.         BGR(9,i)=ZZ
  238.       ENDDO
  239.       RETURN
  240.  
  241. C  2 - Elements MASSIFS en THERMIQUE
  242. C ===================================
  243.  57   IFOR=IFOU+4
  244.       GOTO (200,200,200,210,210,220,230,230,230,230,
  245.      .      230,230,230,230,230,230,230,230,230     ),IFOR
  246.       RETURN
  247. C =====
  248. C  2.1 - Elements MASSIFS 2D
  249. C =====
  250.  200  DO i=1,NBNO
  251.         SHP(1,i)=SHPTOT(1,i,iGau)
  252.         SHP(2,i)=SHPTOT(2,i,iGau)
  253.         SHP(3,i)=SHPTOT(3,i,iGau)
  254.       ENDDO
  255.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  256.       DO i=1,NBNO
  257.         BGR(1,i)=SHP(2,i)
  258.         BGR(2,i)=SHP(3,i)
  259.       ENDDO
  260.       RETURN
  261. C =====
  262. C  2.2 - Elements MASSIFS 2D AXISymetrique
  263. C  2.3 - Elements MASSIFS 2D FOURIER
  264. C =====
  265.  210  DO i=1,NBNO
  266.         SHP(1,i)=SHPTOT(1,i,iGau)
  267.         SHP(2,i)=SHPTOT(2,i,iGau)
  268.         SHP(3,i)=SHPTOT(3,i,iGau)
  269.       ENDDO
  270.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  271.       CALL DISTRR(XEL,SHP,NBNO,RR)
  272. C*OF  DJAC=X2Pi*DJAC*RR
  273.       DJAC=DJAC*RR
  274.       DO i=1,NBNO
  275.         BGR(1,i)=SHP(2,i)
  276.         BGR(2,i)=SHP(3,i)
  277.       ENDDO
  278.       RETURN
  279. C =====
  280. C  2.4 - Elements MASSIFS 3D
  281. C =====
  282.  220  DO i=1,NBNO
  283.         SHP(1,i)=SHPTOT(1,i,iGau)
  284.         SHP(2,i)=SHPTOT(2,i,iGau)
  285.         SHP(3,i)=SHPTOT(3,i,iGau)
  286.         SHP(4,i)=SHPTOT(4,i,iGau)
  287.       ENDDO
  288.       CALL JACOBI(XEL,SHP,3,NBNO,DJAC)
  289.       DO i=1,NBNO
  290.         BGR(1,i)=SHP(2,i)
  291.         BGR(2,i)=SHP(3,i)
  292.         BGR(3,i)=SHP(4,i)
  293.       ENDDO
  294.       RETURN
  295. C =====
  296. C  2.5 - Elements MASSIFS 1D
  297. C =====
  298.  230  DO i=1,NBNO
  299.         SHP(1,i)=SHPTOT(1,i,iGau)
  300.         SHP(2,i)=SHPTOT(2,i,iGau)
  301.       ENDDO
  302.       CALL JACOBI(XEL,SHP,1,NBNO,DJAC)
  303.       IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
  304.         CALL DISTRR(XEL,SHP,NBNO,RR)
  305. C*OF    DJAC=X2Pi*DJAC*RR
  306.         DJAC=DJAC*RR
  307.       ELSE IF (IFOUR.EQ.15) THEN
  308.         CALL DISTRR(XEL,SHP,NBNO,RR)
  309. C*OF    DJAC=X4Pi*DJAC*RR*RR
  310.         DJAC=DJAC*RR*RR
  311.       ENDIF
  312.       DO i=1,NBNO
  313.         BGR(1,i)=SHP(2,i)
  314.       ENDDO
  315.       RETURN
  316.  
  317. C  3 - Element COQUE DKT en MECANIQUE
  318. C ====================================
  319.  28   DO i=1,NBNO
  320.         SHP(1,i)=SHPTOT(1,i,iGau)
  321.         SHP(2,i)=SHPTOT(2,i,iGau)
  322.         SHP(3,i)=SHPTOT(3,i,iGau)
  323.       ENDDO
  324.       CALL JACOBI(XEL,SHP,2,NBNO,DJAC)
  325.       K=1
  326.       DO i=1,NBNO
  327.         BGR(1,K)=SHP(2,i)
  328.         BGR(2,K)=SHP(3,i)
  329.         BGR(4,K+1)=SHP(2,i)
  330.         BGR(5,K+1)=SHP(3,i)
  331.         K=K+6
  332.       ENDDO
  333. C= Prise en compte de l'excentrement des elements
  334.       CALL GEOCST(XEL,GEOM)
  335.       CALL BBGFDK(XX(iGau),YY(iGau),GEOM,BBF)
  336.       K=2
  337.       KK=0
  338.       DO i=1,NBNO
  339.         DO j=1,3
  340.           BGR(1,K+j)=Excen*BBF(1,j+KK)
  341.           BGR(2,K+j)=Excen*BBF(2,j+KK)
  342.           BGR(4,K+j)=Excen*BBF(3,j+KK)
  343.           BGR(5,K+j)=Excen*BBF(4,j+KK)
  344.         ENDDO
  345.         K=K+6
  346.         KK=KK+3
  347.       ENDDO
  348. C= Fin du traitement de l'excentrement
  349.       CALL GERADK(XEL,GEOM)
  350.       CALL BBGRDK(XX(iGau),YY(iGau),GEOM,BB)
  351.       K=2
  352.       KK=0
  353.       DO i=1,3
  354.         DO j=1,3
  355.           BGR(3,K+j)= BB(1,j+KK)
  356.           BGR(6,K+j)= BB(2,j+KK)
  357.           BGR(7,K+j)=-BB(1,j+KK)
  358.           BGR(8,K+j)=-BB(2,j+KK)
  359.         ENDDO
  360.         K=K+6
  361.         KK=KK+3
  362.       ENDDO
  363.       RETURN
  364.  
  365.       END
  366.  
  367.  
  368.  
  369.  

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