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

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