Télécharger la plaquette Cast3M


fr en

Télécharger famo22.eso

Retour à la liste

Numérotation des lignes : 

famo22

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

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