Télécharger la plaquette Cast3M


fr en

Télécharger fri2t2.eso

Retour à la liste

Numérotation des lignes : 

fri2t2

  1. C FRI2T2    SOURCE    OF166741  25/02/21    21:16:46     12166          
  2.  
  3.       SUBROUTINE FRI2T2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL,
  4.      1     IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI,
  5.      2     CRIGI)
  6. ***********************************************************************
  7. *     COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE
  8. *     BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION
  9. ***********************************************************************
  10. * ENTREES :
  11. *
  12. * INFIBR = NUMERO DE MATERIAU INELASTIQUE
  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. * IVARI  =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
  19. * NMATT  =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU
  20. * NCARR  =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES
  21. * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  22. *
  23. * SORTIES :
  24. * CRIGI(12) RIGIDITE 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. -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(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.       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.D0
  85.            DO IE1=1,NBNN
  86.              CGAUSS=SHPTOT(1,IE1,IGAU)
  87.              YY=YY+XE(1,IE1)*CGAUSS
  88.            END DO
  89.            YY2=YY*YY
  90. *
  91. *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  92. *
  93.            DO IE2=1,NBNN
  94.              DO IE1=1,6
  95.                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  96.              END DO
  97.            END DO
  98. C PPf      CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  99. *
  100. *     ON RECUPERE LES CONSTANTES DU MATERIAU
  101. *
  102.            MPTVAL=IVAMAT
  103.            DO IC=1,NMATT
  104.                  MELVAL=IVAL(IC)
  105.                  IF(IC.LT.3)THEN
  106.                    IIC=IC
  107.                  ELSEIF(IC.LT.(NMATT-1))THEN
  108.                    IIC=IC+2
  109.                  ELSE
  110.                    IIC=4+IC-NMATT
  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. *
  140. *     ON RECUPERE LES VARIABLES INTERNES
  141. *
  142.            MPTVAL=IVARI
  143.            DO IC=1,NVARI
  144.               MELVAL=IVAL(IC)
  145.               IBMN=MIN(IB,VELCHE(/2))
  146.               IGMN=MIN(IGAU,VELCHE(/1))
  147.               XVAR(IC)=VELCHE(IGMN,IBMN)
  148.            END DO
  149. *
  150. *     YOUNG TANGENT SELON LES MODELES
  151. *
  152.            IF(INFIBR.EQ.0)THEN
  153. C
  154. C      MODELE ELASTIQUE LINEAIRE  (EXEMPLE)
  155. C
  156.              YOUNGT=XMAT(1)
  157. C
  158.            ELSEIF(INFIBR.EQ.1)THEN
  159. C
  160. C      MODELE BETON_UNI
  161. C
  162. C PP         YOUNGT=XVAR(6)
  163.              YOUNGT=XVAR(5)
  164. C
  165.            ELSEIF(INFIBR.EQ.2)THEN
  166. C
  167. C      MODELE ACIER_UNI
  168. C
  169.              YOUNGT=XVAR(4)
  170. C
  171.            ELSEIF(INFIBR.EQ.3)THEN
  172. C
  173. C      MODELE MAZARS_FIB
  174. C
  175.              YOUNGT=(1.-XVAR(2))*XMAT(1)
  176. C
  177.            ELSEIF(INFIBR.EQ.4)THEN
  178. C
  179. C      MODELE FRAGILE_UNI
  180. C
  181.              YOUNGT=XVAR(4)
  182. C
  183.            ELSEIF(INFIBR.EQ.5)THEN
  184. C
  185. C      MODELE BETON_BAEL
  186. C
  187.              YOUNGT=XVAR(3)
  188. C
  189.            ELSEIF(INFIBR.EQ.6)THEN
  190. C
  191. C      MODELE PARFAIT_UNI
  192. C
  193.              YOUNGT=XVAR(2)
  194. C
  195.            ELSEIF(INFIBR.EQ.7)THEN
  196. C
  197. C      MODELE STRUT_UNI
  198. C
  199.              YOUNGT=XVAR(6)
  200. C
  201.            ELSEIF(INFIBR.EQ.8)THEN
  202. C
  203. C      MODELE CISAIL_NL
  204. C
  205.              YOUNGT=XMAT(1)
  206. C
  207.         ELSEIF(INFIBR.EQ.9)THEN
  208. C
  209. C      MODELE  'PARFAIT_ANCRAGE'
  210. C
  211.              YOUNGT=XVAR(6)
  212. C
  213.            ELSEIF(INFIBR.EQ.10)THEN
  214. C
  215. C      MODELE  'ACIER_ANCRAGE'
  216. C
  217.              YOUNGT=XVAR(16)
  218. C
  219.            ELSEIF(INFIBR.EQ.11)THEN
  220. C
  221. C      MODELE UNILATERAL
  222. C
  223.              YOUNGT=XVAR(1)
  224. C
  225.            ENDIF
  226. C+PPf
  227. C
  228. C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  229. C
  230.            IF(MELE.EQ.167)THEN
  231.              DJAC=XCAR(NCARR)
  232.            ELSEIF(MELE.EQ.166)THEN
  233.              CALL JACOBI(XE,SHP,1,NBNN,DJAC)
  234.              DJAC=DJAC*XCAR(NCARR)
  235.            ELSE
  236.              CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  237.            ENDIF
  238. C+PPf
  239. *
  240. *     CONTRIBUTION A CRIGI
  241. *
  242.            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  243. *
  244.            YOUNG=XMAT(1)
  245.            GAMMA=XMAT(1)/(2.*(1.+XMAT(2)))
  246.            ALPH1=XCAR(1)
  247.            CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS
  248.            CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS
  249.            CRIGI( 3)=CRIGI( 3)+YOUNGT*YY2*PGAUSS
  250. *
  251.            CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
  252. C
  253. C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  254. C
  255. 1100     CONTINUE
  256. C
  257. C     FIN DE LA BOUCLE SUR LES ELEMENTS
  258. C
  259. 1000  CONTINUE
  260. *
  261. C*    SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
  262.       SEGSUP WRK0,WRK2
  263.  
  264.       RETURN
  265.       END
  266.  
  267.  
  268.  

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