C FRIGT2 SOURCE BP208322 15/06/22 21:18:35 8543 SUBROUTINE FRIGT2(INFIBR,MELE,IPMAIL,MINTE,NBPTEL, 1 IVAMAT,IVACAR,IVARI,NMATT,NCARR,NVARI, 2 CRIGI) *********************************************************************** * COMPOSANTES DE LA RIGIDITE (HOOK) TANGENTE * BOUCLE SUR LES SS_ZONE DU MODELE DE SECTION *********************************************************************** * ENTREES : * * INFIBR = NUMERO DE MATERIAU INELASTIQUE * MELE = NUMERO ELEMENT FINI * IPMAIL = POINTEUR DU MAILLAGE * NBPTEL =NOMBRE DE POINTS PAR ELEMENT * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES * IVARI =POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES * NMATT =NOMBRE DE COMPOSANTES DE PROPRIETES DE MATERIAU * NCARR =NOMBRE DE COMPOSANTES DE CARACTERISTIQUES GEOMETRIQUES * NVARI =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES * * SORTIES : * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE * ************************************************************************ * Pierre Pegon (ISPRA) Juillet/Aout 1993 *********************************************************************** IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) * -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMELEME -INC SMCOORD -INC SMMODEL -INC SMINTE -INC CCHAMP * SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT * SEGMENT WRK0 REAL*8 XMAT(NCXMAT),XCAR(NCXCAR),XVAR(NCXVAR) ENDSEGMENT * SEGMENT WRK2 REAL*8 XE(3,NBBB),SHP(6,NBBB) ENDSEGMENT * DIMENSION CRIGI(*) * MFR =NUMMFR(MELE) MELEME=IPMAIL NBNN=NUM(/1) NBELEM=NUM(/2) * * SEGMENT D'INTEGRATION * C* SEGACT,MINTE <- ACTIF EN E/S * * INITIALISATION DES SEGMENTS DE TRAVAIL * NCXMAT=NMATT NCXCAR=NCARR NCXVAR=NVARI NBBB=NBNN SEGINI,WRK0,WRK2 * * BOUCLE SUR LES ELEMENTS * DO 1000 IB=1,NBELEM * * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB * CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) * * BOUCLE SUR LES POINTS DE GAUSS * DO 1100 IGAU=1,NBPTEL * * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z) * YY=0.0 ZZ=0.0 DO IE1=1,NBNN CGAUSS=SHPTOT(1,IE1,IGAU) YY=YY+XE(1,IE1)*CGAUSS ZZ=ZZ+XE(2,IE1)*CGAUSS END DO YY2=YY*YY ZZ2=ZZ*ZZ * * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN * DO IE2=1,NBNN DO IE1=1,6 SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU) END DO END DO C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC) * * ON RECUPERE LES CONSTANTES DU MATERIAU * MPTVAL=IVAMAT DO IC=1,NMATT MELVAL=IVAL(IC) IF(IC.LT.3)THEN IIC=IC ELSEIF(IC.LT.(NMATT-1))THEN IIC=IC+2 ELSE IIC=4+IC-NMATT ENDIF IF(MELVAL.NE.0)THEN IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) XMAT(IIC)=VELCHE(IGMN,IBMN) ELSE IBMN=MIN(IB,IELCHE(/2)) IGMN=MIN(IGAU,IELCHE(/1)) XMAT(IIC)=IELCHE(IGMN,IBMN) ENDIF C ELSE C XMAT(IIC)=0. C IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN C XMAT(IIC)=0 C END IF ENDIF END DO * * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES * MPTVAL=IVACAR DO IC=1,NCARR MELVAL=IVAL(IC) IF(MELVAL.NE.0)THEN IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) XCAR(IC)=VELCHE(IGMN,IBMN) C* ELSE C* XCAR(IC)=0.D0 ENDIF END DO * * ON RECUPERE LES VARIABLES INTERNES * MPTVAL=IVARI DO IC=1,NVARI MELVAL=IVAL(IC) IF (MELVAL.NE.0)THEN IBMN=MIN(IB,VELCHE(/2)) IGMN=MIN(IGAU,VELCHE(/1)) XVAR(IC)=VELCHE(IGMN,IBMN) C* ELSE C* XVAR(IC)=0.D0 ENDIF END DO * C Recuperation du module de YOUNG YOUNG=XMAT(1) * * YOUNG TANGENT SELON LES MODELES * IF(INFIBR.EQ.0)THEN C C MODELE ELASTIQUE LINEAIRE (EXEMPLE) C YOUNGT=XMAT(1) C ELSEIF(INFIBR.EQ.1)THEN C C MODELE BETON_UNI C C PP YOUNGT=XVAR(6) YOUNGT=XVAR(5) C ELSEIF(INFIBR.EQ.2)THEN C C MODELE ACIER_UNI C YOUNGT=XVAR(4) C ELSEIF(INFIBR.EQ.3)THEN C C MODELE MAZARS_FIB C YOUNGT=(1.-XVAR(2))*YOUNG C ELSEIF(INFIBR.EQ.4)THEN C C MODELE FRAGILE_UNI C YOUNGT=XVAR(4) C ELSEIF(INFIBR.EQ.5)THEN C C MODELE BETON_BAEL C YOUNGT=XVAR(3) C ELSEIF(INFIBR.EQ.6)THEN C C MODELE PARFAIT_UNI C YOUNGT=XVAR(2) C ELSEIF(INFIBR.EQ.7)THEN C C MODELE STRUT_UNI C YOUNGT=XVAR(6) C ELSEIF(INFIBR.EQ.8)THEN C C MODELE CISAIL_NL C YOUNGT=XMAT(1) C ELSEIF(INFIBR.EQ.9)THEN C C MODELE 'PARFAIT_ANCRAGE' C YOUNGT=XVAR(6) C ELSEIF(INFIBR.EQ.10)THEN C C MODELE 'ACIER_ANCRAGE' C YOUNGT=XVAR(16) C ELSEIF(INFIBR.EQ.11)THEN C C MODELE UNILATERAL C YOUNGT=XVAR(1) C ELSE C C A MINIMA ON PREND MODULE D'YOUNG C YOUNGT=YOUNG C ENDIF C+PPf C C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167) C IF(MELE.EQ.167)THEN DJAC=XCAR(NCARR) ELSEIF(MELE.EQ.166)THEN CALL JACOBI(XE,SHP,1,NBNN,DJAC) DJAC=DJAC*XCAR(NCARR) ELSE CALL JACOBI(XE,SHP,2,NBNN,DJAC) ENDIF C+PPf * * CONTRIBUTION A CRIGI * PGAUSS=POIGAU(IGAU)*ABS(DJAC) * GAMMA=YOUNG/(2.*(1.+XMAT(2))) ALPH1=XCAR(1) ALPH2=XCAR(2) * CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS CRIGI( 3)=CRIGI( 3)+YOUNGT*ZZ*PGAUSS CRIGI( 4)=CRIGI( 4)+YOUNGT*YY2*PGAUSS CRIGI( 5)=CRIGI( 5)+YOUNGT*YY*ZZ*PGAUSS CRIGI( 6)=CRIGI( 6)+YOUNGT*ZZ2*PGAUSS * CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS C C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS C 1100 CONTINUE C C FIN DE LA BOUCLE SUR LES ELEMENTS C 1000 CONTINUE * C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE) SEGSUP,WRK0,WRK2 * RETURN END