Télécharger la plaquette Cast3M


fr en

Télécharger frigt2.eso

Retour à la liste

Numérotation des lignes : 

frigt2

  1. C FRIGT2    SOURCE    CB215821  24/04/12    21:16:05     11897          
  2.       SUBROUTINE FRIGT2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL,
  3.      1     IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI,
  4.      2     CRIGI)
  5. ***********************************************************************
  6. *     COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
  7. *     BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION
  8. ***********************************************************************
  9. * ENTREES :
  10. *
  11. * INFIBR = NUMERO DE MATERIAU INELASTIQUE
  12. * MELE    = NUMERO  ELEMENT FINI
  13. * IPMAIL = POINTEUR DU MAILLAGE
  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. * IVARI  =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
  18. * NMATT  =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
  19. * NCARR  =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES
  20. * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  21. *
  22. * SORTIES :
  23. * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  24. *
  25. ************************************************************************
  26. *      Pierre Pegon (ISPRA) Juillet/Aout 1993
  27. ***********************************************************************
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8(A-H,O-Z)
  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),XVAR(NCXVAR)
  48.       ENDSEGMENT
  49. *
  50.       SEGMENT WRK2
  51.         REAL*8 XE(3,NBBB),SHP(6,NBBB)
  52.       ENDSEGMENT
  53. *
  54.       DIMENSION CRIGI(*)
  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.       NCXVAR=NVARI
  70.       NBBB=NBNN
  71.       SEGINI,WRK0,WRK2
  72. *
  73. *       BOUCLE SUR LES ELEMENTS
  74. *
  75.       DO 1000 IB=1,NBELEM
  76. *
  77. *       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  78. *
  79.          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  80. *
  81. *       BOUCLE SUR LES POINTS DE GAUSS
  82. *
  83.          DO 1100 IGAU=1,NBPTEL
  84. *
  85. *       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  86. *
  87.            YY=0.0
  88.            ZZ=0.0
  89.            DO IE1=1,NBNN
  90.              CGAUSS=SHPTOT(1,IE1,IGAU)
  91.              YY=YY+XE(1,IE1)*CGAUSS
  92.              ZZ=ZZ+XE(2,IE1)*CGAUSS
  93.            END DO
  94.            YY2=YY*YY
  95.            ZZ2=ZZ*ZZ
  96. *
  97. *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  98. *
  99.            DO IE2=1,NBNN
  100.              DO IE1=1,6
  101.                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  102.              END DO
  103.            END DO
  104. C PPf      CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  105. *
  106. *     ON RECUPERE LES CONSTANTES DU MATERIAU
  107. *
  108.            MPTVAL=IVAMAT
  109.            DO IC=1,NMATT
  110.                  MELVAL=IVAL(IC)
  111.                  IF(IC.LT.3)THEN
  112.                    IIC=IC
  113.                  ELSEIF(IC.LT.(NMATT-1))THEN
  114.                    IIC=IC+2
  115.                  ELSE
  116.                    IIC=4+IC-NMATT
  117.                  ENDIF
  118.                  IF(MELVAL.NE.0)THEN
  119.                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  120.                        IBMN=MIN(IB,VELCHE(/2))
  121.                       IGMN=MIN(IGAU,VELCHE(/1))
  122.                        XMAT(IIC)=VELCHE(IGMN,IBMN)
  123.                     ELSE
  124.                       IBMN=MIN(IB,IELCHE(/2))
  125.                      IGMN=MIN(IGAU,IELCHE(/1))
  126.                       XMAT(IIC)=IELCHE(IGMN,IBMN)
  127.                     ENDIF
  128. C                ELSE
  129. C                   XMAT(IIC)=0.
  130. C                   IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  131. C                      XMAT(IIC)=0
  132. C                   END IF
  133.                  ENDIF
  134.            END DO
  135. *
  136. *     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  137. *
  138.            MPTVAL=IVACAR
  139.            DO IC=1,NCARR
  140.               MELVAL=IVAL(IC)
  141.               IF(MELVAL.NE.0)THEN
  142.                 IBMN=MIN(IB,VELCHE(/2))
  143.                 IGMN=MIN(IGAU,VELCHE(/1))
  144.                 XCAR(IC)=VELCHE(IGMN,IBMN)
  145. C*            ELSE
  146. C*              XCAR(IC)=0.D0
  147.               ENDIF
  148.            END DO
  149. *
  150. *     ON RECUPERE LES VARIABLES INTERNES
  151. *
  152.            MPTVAL=IVARI
  153.            DO IC=1,NVARI
  154.               MELVAL=IVAL(IC)
  155.               IF (MELVAL.NE.0)THEN
  156.                 IBMN=MIN(IB,VELCHE(/2))
  157.                 IGMN=MIN(IGAU,VELCHE(/1))
  158.                 XVAR(IC)=VELCHE(IGMN,IBMN)
  159. C*            ELSE
  160. C*              XVAR(IC)=0.D0
  161.               ENDIF
  162.            END DO
  163. *
  164. C Recuperation du module de YOUNG
  165.            YOUNG=XMAT(1)
  166. *
  167. *     YOUNG TANGENT SELON LES MODELES
  168. *
  169.            IF(INFIBR.EQ.0)THEN
  170. C
  171. C      MODELE ELASTIQUE LINEAIRE  (EXEMPLE)
  172. C
  173.              YOUNGT=XMAT(1)
  174. C
  175.            ELSEIF(INFIBR.EQ.1)THEN
  176. C
  177. C      MODELE BETON_UNI
  178. C
  179. C PP         YOUNGT=XVAR(6)
  180.              YOUNGT=XVAR(5)
  181. C
  182.            ELSEIF(INFIBR.EQ.2)THEN
  183. C
  184. C      MODELE ACIER_UNI
  185. C
  186.              YOUNGT=XVAR(4)
  187. C
  188.            ELSEIF(INFIBR.EQ.3)THEN
  189. C
  190. C      MODELE MAZARS_FIB
  191. C
  192.              YOUNGT=(1.-XVAR(2))*YOUNG
  193. C
  194.            ELSEIF(INFIBR.EQ.4)THEN
  195. C
  196. C      MODELE FRAGILE_UNI
  197. C
  198.              YOUNGT=XVAR(4)
  199. C
  200.            ELSEIF(INFIBR.EQ.5)THEN
  201. C
  202. C      MODELE BETON_BAEL
  203. C
  204.              YOUNGT=XVAR(3)
  205. C
  206.            ELSEIF(INFIBR.EQ.6)THEN
  207. C
  208. C      MODELE PARFAIT_UNI
  209. C
  210.              YOUNGT=XVAR(2)
  211. C
  212.            ELSEIF(INFIBR.EQ.7)THEN
  213. C
  214. C      MODELE STRUT_UNI
  215. C
  216.              YOUNGT=XVAR(6)
  217. C
  218.            ELSEIF(INFIBR.EQ.8)THEN
  219. C
  220. C      MODELE CISAIL_NL
  221. C
  222.              YOUNGT=XMAT(1)
  223. C
  224.            ELSEIF(INFIBR.EQ.9)THEN
  225. C
  226. C      MODELE  'PARFAIT_ANCRAGE'
  227. C
  228.              YOUNGT=XVAR(6)
  229. C
  230.            ELSEIF(INFIBR.EQ.10)THEN
  231. C
  232. C      MODELE  'ACIER_ANCRAGE'
  233. C
  234.              YOUNGT=XVAR(16)
  235. C
  236.            ELSEIF(INFIBR.EQ.11)THEN
  237. C
  238. C      MODELE UNILATERAL
  239. C
  240.              YOUNGT=XVAR(1)
  241. C
  242.            ELSE
  243. C
  244. C A MINIMA ON PREND MODULE D'YOUNG
  245. C
  246.              YOUNGT=YOUNG
  247. C
  248.            ENDIF
  249. C+PPf
  250. C
  251. C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  252. C
  253.            IF(MELE.EQ.167)THEN
  254.              DJAC=XCAR(NCARR)
  255.            ELSEIF(MELE.EQ.166)THEN
  256.              CALL JACOBI(XE,SHP,1,NBNN,DJAC)
  257.              DJAC=DJAC*XCAR(NCARR)
  258.            ELSE
  259.              CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  260.            ENDIF
  261. C+PPf
  262. *
  263. *     CONTRIBUTION A CRIGI
  264. *
  265.            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  266. *
  267.            GAMMA=YOUNG/(2.*(1.+XMAT(2)))
  268.            ALPH1=XCAR(1)
  269.            ALPH2=XCAR(2)
  270. *
  271.            CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS
  272.            CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS
  273.            CRIGI( 3)=CRIGI( 3)+YOUNGT*ZZ*PGAUSS
  274.            CRIGI( 4)=CRIGI( 4)+YOUNGT*YY2*PGAUSS
  275.            CRIGI( 5)=CRIGI( 5)+YOUNGT*YY*ZZ*PGAUSS
  276.            CRIGI( 6)=CRIGI( 6)+YOUNGT*ZZ2*PGAUSS
  277. *
  278.            CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS
  279.            CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS
  280.            CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS
  281.            CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS
  282.            CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS
  283.            CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS
  284. C
  285. C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  286. C
  287. 1100     CONTINUE
  288. C
  289. C     FIN DE LA BOUCLE SUR LES ELEMENTS
  290. C
  291. 1000  CONTINUE
  292. *
  293. C*    SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
  294.       SEGSUP,WRK0,WRK2
  295. *
  296.       RETURN
  297.       END
  298.  
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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