Télécharger la plaquette Cast3M


fr en

Télécharger frigi2.eso

Retour à la liste

Numérotation des lignes : 

frigi2

  1. C FRIGI2    SOURCE    CB215821  24/04/12    21:16:05     11897          
  2.       SUBROUTINE FRIGI2(MELE,IPMAIL,MINTE,NBPTEL,
  3.      1     IVAMAT,IVACAR,NMATT,NCARR,
  4.      2     CRIGI,CMASS)
  5. ***********************************************************************
  6. *     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
  7. *     CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
  8. *     .... AU SIGNE PRES
  9. *     BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  10. **********************************************************************
  11. * ENTREES :
  12. *
  13. * MELE    = NUMERO  ELEMENT FINI
  14. * IPMAIL = POINTEUR DU MAILLAGE
  15. * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  16. * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  17. * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  18. * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  19. * NMATT  =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  20. * NCARR  =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  21. *
  22. * SORTIES :
  23. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  24. * CMASS(12) MASSE SUR LA FIBRE MOYENNE
  25. *
  26. ************************************************************************
  27. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  28. ***********************************************************************
  29.       IMPLICIT INTEGER(I-N)
  30.       IMPLICIT REAL*8(A-H,O-Z)
  31. *
  32.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC SMCHAML
  36. -INC SMELEME
  37. -INC SMCOORD
  38. -INC SMMODEL
  39. -INC SMINTE
  40. -INC CCHAMP
  41. *
  42.       SEGMENT MPTVAL
  43.         INTEGER IPOS(NS)    ,NSOF(NS)
  44.         INTEGER      IVAL(NCOSOU)
  45.         CHARACTER*16 TYVAL(NCOSOU)
  46.       ENDSEGMENT
  47. *
  48.       SEGMENT WRK0
  49.        REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  50.       ENDSEGMENT
  51. *
  52.       SEGMENT WRK2
  53.         REAL*8 XE(3,NBBB),SHP(6,NBBB)
  54.       ENDSEGMENT
  55. *
  56.       DIMENSION CRIGI(12),CMASS(12)
  57. *
  58. C
  59.       MFR =NUMMFR(MELE)
  60.       MELEME=IPMAIL
  61.       NBNN=NUM(/1)
  62.       NBELEM=NUM(/2)
  63. *
  64. *    SEGMENT D'INTEGRATION
  65. *
  66.       SEGACT,MINTE
  67. *
  68. *    INITIALISATION DES SEGMENTS DE TRAVAIL
  69. *
  70.       NCXMAT=NMATT
  71.       NCXCAR=NCARR
  72.       NBBB=NBNN
  73.       SEGINI WRK0,WRK2
  74. *
  75. *       BOUCLE SUR LES ELEMENTS
  76. *
  77.       SEGACT,MCOORD
  78.       DO 1000 IB=1,NBELEM
  79. *
  80. *       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  81. *
  82.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  83. *
  84. *       BOUCLE SUR LES POINTS DE GAUSS
  85. *
  86.          DO 1100 IGAU=1,NBPTEL
  87. *
  88. *       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  89. *
  90.            YY=0.D0
  91.            ZZ=0.D0
  92.            DO IE1=1,NBNN
  93.              CGAUSS=SHPTOT(1,IE1,IGAU)
  94.              YY=YY+XE(1,IE1)*CGAUSS
  95.              ZZ=ZZ+XE(2,IE1)*CGAUSS
  96.            END DO
  97.            YY2=YY*YY
  98.            ZZ2=ZZ*ZZ
  99. *
  100. *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  101. *
  102.            DO IE1=1,6
  103.              DO IE2=1,NBNN
  104.                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  105.              END DO
  106.            END DO
  107. C PPf     CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  108. *
  109. *     ON RECUPERE LES CONSTANTES DU MATERIAU
  110. *
  111.            MPTVAL=IVAMAT
  112.            DO IC=1,NMATT
  113.                  MELVAL=IVAL(IC)
  114.                  IF(IC.LT.3)THEN
  115.                    IIC=IC
  116.                  ELSEIF(IC.LT.(NMATT-4))THEN
  117.                    IIC=IC+3
  118.                  ELSEIF(IC.LE.(NMATT-2))THEN
  119.                    IIC=5+IC-NMATT+2
  120.                  ELSE
  121.                    IIC=IC
  122.                  ENDIF
  123.  
  124.                  IF(MELVAL.NE.0)THEN
  125.                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  126.                        IBMN=MIN(IB,VELCHE(/2))
  127.                       IGMN=MIN(IGAU,VELCHE(/1))
  128.                        XMAT(IIC)=VELCHE(IGMN,IBMN)
  129.                     ELSE
  130.                       IBMN=MIN(IB,IELCHE(/2))
  131.                      IGMN=MIN(IGAU,IELCHE(/1))
  132.                       XMAT(IIC)=IELCHE(IGMN,IBMN)
  133.                     ENDIF
  134.                  ELSE
  135.                     XMAT(IIC)=0.D0
  136.                     IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  137.                        XMAT(IIC)=0.D0
  138.                     END IF
  139.                  ENDIF
  140.            END DO
  141. *
  142. *     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  143. *
  144.            MPTVAL=IVACAR
  145.            DO IC=1,NCARR
  146.               MELVAL=IVAL(IC)
  147.               IF(MELVAL.NE.0)THEN
  148.                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  149.                        IBMN=MIN(IB,VELCHE(/2))
  150.                        IGMN=MIN(IGAU,VELCHE(/1))
  151.                         XCAR(IC)=VELCHE(IGMN,IBMN)
  152.                       ELSE
  153.                        IBMN=MIN(IB,IELCHE(/2))
  154.                         IGMN=MIN(IGAU,IELCHE(/1))
  155.                         XCAR(IC)=IELCHE(IGMN,IBMN)
  156.                     ENDIF
  157.                  ELSE
  158.                     XCAR(IC)=0.D0
  159.                     IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  160.                        XCAR(IC)=0.D0
  161.                     END IF
  162.                  ENDIF
  163. *
  164. *          write(6,*) 'frigi2 caracteristiques ic xcar ',ic,xcar(ic)
  165.            END DO
  166.  
  167. C+PPf
  168. C
  169. C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  170. C
  171.            IF(MELE.EQ.167)THEN
  172.              DJAC=XCAR(3)
  173.            ELSEIF(MELE.EQ.166)THEN
  174. C+DC on utilise le cas joi3
  175.              CALL JACOBI(XE,SHP,86,NBNN,DJAC)
  176.              DJAC= DJAC*XCAR(3)
  177.            ELSE
  178.              CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  179.            ENDIF
  180.  
  181. C+PPf
  182. *
  183. *     CONTRIBUTION A CRIGI
  184. *
  185.            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  186. *
  187.            YOUNG=XMAT(1)
  188.            GAMMA=XMAT(1)/2.D0/(1.D0+XMAT(2))
  189.            ALPH1=XCAR(1)
  190.            ALPH2=XCAR(2)
  191.            CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
  192.            CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
  193.            CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS
  194.            CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS
  195.            CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS
  196.            CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS
  197. *
  198.            CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS
  199.            CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS
  200.            CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS
  201.            CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS
  202.            CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS
  203.            CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS
  204. *
  205. *     CONTRIBUTION A CMASS
  206. *
  207. *
  208.          RHO=XMAT(3)
  209. C
  210. C
  211. C           RHO=XMAT(NMATT)
  212. C
  213.            CMASS( 1)=CMASS( 1)+RHO*PGAUSS
  214.            CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
  215.            CMASS( 3)=CMASS( 3)+RHO*ZZ*PGAUSS
  216.            CMASS( 4)=CMASS( 4)+RHO*YY2*PGAUSS
  217.            CMASS( 5)=CMASS( 5)+RHO*YY*ZZ*PGAUSS
  218.            CMASS( 6)=CMASS( 6)+RHO*ZZ2*PGAUSS
  219. *
  220.            CMASS( 7)=CMASS( 7)+RHO*PGAUSS
  221.            CMASS( 8)=CMASS( 8)+RHO*PGAUSS
  222.            CMASS( 9)=CMASS( 9)+RHO*YY*PGAUSS
  223.            CMASS(10)=CMASS(10)+RHO*ZZ*PGAUSS
  224.            CMASS(11)=CMASS(11)+RHO*YY2*PGAUSS
  225.            CMASS(12)=CMASS(12)+RHO*ZZ2*PGAUSS
  226. C
  227. C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  228. C
  229. 1100     CONTINUE
  230. C
  231. C     FIN DE LA BOUCLE SUR LES ELEMENTS
  232. C
  233. 1000  CONTINUE
  234. *
  235.       SEGSUP WRK0,WRK2
  236. *
  237.       RETURN
  238.       END
  239.  
  240.  
  241.  
  242.  
  243.  

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