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

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