Télécharger la plaquette Cast3M


fr en

Télécharger frith2.eso

Retour à la liste

Numérotation des lignes : 

frith2

  1. C FRITH2    SOURCE    OF166741  25/02/21    21:16:54     12166          
  2.  
  3.       SUBROUTINE FRITH2(MELE,IPMAIL,MINTE,NBPTEL,
  4.      1     IVAMAT,IVACAR,NMATT,NCARR,CRIGI,IELA,ICONT)
  5. ***********************************************************************
  6. *     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  7. *     BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  8. **********************************************************************
  9. * ENTREES :
  10. *
  11. * MELE    = NUMERO  ELEMENT FINI
  12. * IPMAIL = POINTEUR DU MAILLAGE                              (ACTIF)
  13. * MINTE  = POINTEUR CARACTERISTIQUES INTEGRATION             (ACTIF)
  14. * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  15. * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  16. * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  17. * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  18. * NMATT  =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  19. * NCARR  =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  20. *
  21. * SORTIES :
  22. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE ( SOMi (HOOKi * ALPHAi) )
  23. *
  24. ************************************************************************
  25. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  26. ***********************************************************************
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCHAMP
  33.  
  34. -INC SMCHAML
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC SMMODEL
  38. -INC SMINTE
  39.  
  40. -INC TMPTVAL
  41.  
  42.       SEGMENT WRK0
  43.        REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  44.       ENDSEGMENT
  45. *
  46.       SEGMENT WRK2
  47.         REAL*8 XE(3,NBBB),SHP(6,NBBB)
  48.       ENDSEGMENT
  49. *
  50.       DIMENSION CRIGI(12)
  51. *
  52.       MFR =NUMMFR(MELE)
  53.       MELEME=IPMAIL
  54.       NBNN=NUM(/1)
  55.       NBELEM=NUM(/2)
  56. *
  57. *    SEGMENT D'INTEGRATION
  58. *
  59. C**   SEGACT,MINTE           <- ACTIF EN E/S
  60. *
  61. *    INITIALISATION DES SEGMENTS DE TRAVAIL
  62. *
  63.       NCXMAT=NMATT
  64.       NCXCAR=NCARR
  65.       NBBB=NBNN
  66.       SEGINI WRK0,WRK2
  67. *
  68. *       BOUCLE SUR LES ELEMENTS
  69. *
  70.       DO 1000 IB=1,NBELEM
  71. *
  72. *       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  73. *
  74.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  75. *
  76. *       BOUCLE SUR LES POINTS DE GAUSS
  77. *
  78.          DO 1100 IGAU=1,NBPTEL
  79. *
  80. *       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  81. *
  82.            YY=0.D0
  83.            ZZ=0.D0
  84.            DO IE1=1,NBNN
  85.              CGAUSS=SHPTOT(1,IE1,IGAU)
  86.              YY=YY+XE(1,IE1)*CGAUSS
  87.              ZZ=ZZ+XE(2,IE1)*CGAUSS
  88.            END DO
  89.            YY2=YY*YY
  90.            ZZ2=ZZ*ZZ
  91. *
  92. *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  93. *
  94.            DO IE2=1,NBNN
  95.              DO IE1=1,6
  96.                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  97.              END DO
  98.            END DO
  99.            CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  100. *
  101. *     ON RECUPERE LES CONSTANTES DU MATERIAU
  102. *
  103.            MPTVAL=IVAMAT
  104.            DO IC=1,NMATT
  105.                  MELVAL=IVAL(IC)
  106.                  IF(IC.LT.3)THEN
  107.                    IIC=IC
  108.                  ELSEIF(IC.LT.(NMATT-1))THEN
  109.                    IIC=IC+2
  110.                  ELSE
  111.                    IIC=4+IC-NMATT
  112.                  ENDIF
  113.                  IF(MELVAL.NE.0)THEN
  114.                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  115.                        IBMN=MIN(IB,VELCHE(/2))
  116.                        IGMN=MIN(IGAU,VELCHE(/1))
  117.                        XMAT(IIC)=VELCHE(IGMN,IBMN)
  118.                     ELSE
  119.                       IBMN=MIN(IB,IELCHE(/2))
  120.                       IGMN=MIN(IGAU,IELCHE(/1))
  121.                       XMAT(IIC)=IELCHE(IGMN,IBMN)
  122.                     ENDIF
  123.                  ELSE
  124.                     XMAT(IIC)=0.D0
  125.                     IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  126.                        XMAT(IIC)=0
  127.                     END IF
  128.                  ENDIF
  129.            END DO
  130. *
  131. *     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  132. *
  133.            MPTVAL=IVACAR
  134.            DO IC=1,NCARR
  135.               MELVAL=IVAL(IC)
  136.               IBMN=MIN(IB,VELCHE(/2))
  137.               IGMN=MIN(IGAU,VELCHE(/1))
  138.               XCAR(IC)=VELCHE(IGMN,IBMN)
  139.            END DO
  140. *
  141. *     CONTRIBUTION A CRIGI
  142. *
  143.            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  144. *
  145.            IF(ICONT.EQ.0) THEN
  146.              YOUNG=1.D0
  147.              XNU  =1.D0
  148.            ELSE
  149.              YOUNG=XMAT(1)
  150.              XNU  =XMAT(2)
  151.            ENDIF
  152.            ALPHA=XMAT(4)
  153.            IF(IELA.EQ.1) ALPHA=1.D0
  154.            GAMMA=YOUNG/(2.D0*(1.+XNU))
  155.            ALPH1=XCAR(1)
  156.            ALPH2=XCAR(2)
  157.            CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS*ALPHA
  158.            CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS*ALPHA
  159.            CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS*ALPHA
  160.            CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS*ALPHA
  161.            CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS*ALPHA
  162.            CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS*ALPHA
  163. *
  164.            CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS*ALPHA
  165.            CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS*ALPHA
  166.            CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS*ALPHA
  167.            CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS*ALPHA
  168.            CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS*ALPHA
  169.            CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS*ALPHA
  170. C
  171. C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  172. C
  173. 1100     CONTINUE
  174. C
  175. C     FIN DE LA BOUCLE SUR LES ELEMENTS
  176. C
  177. 1000  CONTINUE
  178. *
  179. C**   SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
  180.       SEGSUP WRK0,WRK2
  181. *
  182.       RETURN
  183.       END
  184.  
  185.  
  186.  

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