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

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