1 : C FRIGT2 SOURCE CHAT 11/03/16 21:23:31 6902 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 CCOPTIO 32 : -INC SMCHAML 33 : -INC SMELEME 34 : -INC SMCOORD 35 : -INC SMMODEL 36 : -INC SMINTE 37 : -INC CCHAMP 38 : * 39 : SEGMENT MPTVAL 40 : INTEGER IPOS(NS) ,NSOF(NS) 41 : INTEGER IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : * 45 : SEGMENT WRK0 46 : REAL*8 XMAT(NCXMAT),XCAR(NCXCAR),XVAR(NCXVAR) 47 : ENDSEGMENT 48 : * 49 : SEGMENT WRK2 50 : REAL*8 XE(3,NBBB),SHP(6,NBBB) 51 : ENDSEGMENT 52 : * 53 : DIMENSION CRIGI(*) 54 : * 55 : MFR =NUMMFR(MELE) 56 : MELEME=IPMAIL 57 : NBNN=NUM(/1) 58 : NBELEM=NUM(/2) 59 : * 60 : * SEGMENT D'INTEGRATION 61 : * 62 : C* SEGACT,MINTE <- ACTIF EN E/S 63 : * 64 : * INITIALISATION DES SEGMENTS DE TRAVAIL 65 : * 66 : NCXMAT=NMATT 67 : NCXCAR=NCARR 68 : NCXVAR=NVARI 69 : NBBB=NBNN 70 : SEGINI,WRK0,WRK2 71 : * 72 : * BOUCLE SUR LES ELEMENTS 73 : * 74 : DO 1000 IB=1,NBELEM 75 : * 76 : * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 77 : * 77 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 78 : * 79 : * BOUCLE SUR LES POINTS DE GAUSS 80 : * 81 : DO 1100 IGAU=1,NBPTEL 82 : * 83 : * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z) 84 : * 85 : YY=0.0 86 : ZZ=0.0 87 : DO IE1=1,NBNN 88 : CGAUSS=SHPTOT(1,IE1,IGAU) 89 : YY=YY+XE(1,IE1)*CGAUSS 90 : ZZ=ZZ+XE(2,IE1)*CGAUSS 91 : END DO 92 : YY2=YY*YY 93 : ZZ2=ZZ*ZZ 94 : * 95 : * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN 96 : * 97 : DO IE2=1,NBNN 98 : DO IE1=1,6 99 : SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU) 100 : END DO 101 : 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 252 : CALL JACOBI(XE,SHP,1,NBNN,DJAC) 253 : DJAC=DJAC*XCAR(NCARR) 254 : ELSE 254 : CALL JACOBI(XE,SHP,2,NBNN,DJAC) 255 : ENDIF 256 : C+PPf 257 : * 258 : * CONTRIBUTION A CRIGI 259 : * 260 : PGAUSS=POIGAU(IGAU)*ABS(DJAC) 261 : * 262 : GAMMA=YOUNG/(2.*(1.+XMAT(2))) 263 : ALPH1=XCAR(1) 264 : ALPH2=XCAR(2) 265 : * 266 : CRIGI( 1)=CRIGI( 1)+YOUNGT*PGAUSS 267 : CRIGI( 2)=CRIGI( 2)+YOUNGT*YY*PGAUSS 268 : CRIGI( 3)=CRIGI( 3)+YOUNGT*ZZ*PGAUSS 269 : CRIGI( 4)=CRIGI( 4)+YOUNGT*YY2*PGAUSS 270 : CRIGI( 5)=CRIGI( 5)+YOUNGT*YY*ZZ*PGAUSS 271 : CRIGI( 6)=CRIGI( 6)+YOUNGT*ZZ2*PGAUSS 272 : * 273 : CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS 274 : CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS 275 : CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS 276 : CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS 277 : CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS 278 : CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS 279 : C 280 : C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS 281 : C 282 : 1100 CONTINUE 283 : C 284 : C FIN DE LA BOUCLE SUR LES ELEMENTS 285 : C 286 : 1000 CONTINUE 287 : * 288 : C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE) 289 : SEGSUP,WRK0,WRK2 290 : * 291 : RETURN 292 : END 293 : 294 : 295 : 296 :
© Cast3M 2003 - All rights reserved.
Disclaimer