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