1 : C UO2ET SOURCE STRU 05/12/12 21:15:01 5272 2 : SUBROUTINE UO2ET(NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, 3 : & XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,LEBIL,NFISSU, 4 : & NVF,VF,FC0,PENTE,PENTE2,DXV1,YOUN,NCA,MC,MM, 5 : & ISING,IFERM,IBRUP,KERRE) 6 : C---------------------------------------------------------------------- 7 : C MODELE UO2 (OTTOSEN ET GATT_MONERIE) 8 : C DETERMINATION DE L ETAT INITIAL DE FISSURATION 9 : C---------------------------------------------------------------------- 10 : C 11 : C ENTREES 12 : C ------- 13 : C NC = (3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES 14 : C SIGMA(6) = CONTRAINTES INITIALES 15 : C W(3) = OUVERTURES INITIALES DES FISSURES 16 : C WMAX(3) = OUVERTURES MAXIMALES INITIALES DES FISSURES 17 : C SMAX(3) = CONTR. CORRESPONDANT A WMAX 18 : C BILIN(3) = OUVERTURES DEFINISSANT LE CHANGEMENT DE PENTE EN CAS DE 19 : C RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE 20 : C WRUPT(3) = OUVERTURES CONDITIONNANT LA RUPTURE 21 : C BTR = PARAMETRE DE FERMETURE 22 : C XLTR(3) = LIMITES EN TRACTION POUR LA FISSURATION 23 : C XINVL(3) = PARAMETRES DE TAILLE 24 : C SBILI(3) = CONTR. CORRESPONDANT A BILIN 25 : C PRECIE = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES 26 : C PRECIZ = PRECISION POUR TESTS SUR CONTRAINTES 27 : C NFISSU = NOMBRE DE FISSURES 28 : C NVF = NBR DE DIRECTIONS IMPOSEES POUVANT DEVENIR 29 : C DES DIRECTIONS DE FISSURATION 30 : C DXV1(3) = INCREMENT DES DEF. DE FISSURATION INITIALES (OUV.) 31 : C YOUN = MODULE D YOUNG 32 : C 33 : C SORTIES 34 : C ------- 35 : C NN(NC) = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT 36 : C FC(NC) = CRITERE DE FISSURATION 37 : C FC2(NC) = DEUXIEME CRITERE DE FISSURATION SI BIFURCATION POSSIBLE 38 : C LEBIL(NC) = COMPRESSION/TRACTION 39 : C VF(3,3) = VECTEURS DES DIRECTIONS DE FISSURATION 40 : C FC0(20) = CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS 41 : C PENTE(NC) = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FC 42 : C PENTE2(NC) = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FC2 43 : C NCA = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT 44 : C MM(20) = TYPES DES CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS 45 : C MC = NBR. DE CRITERES DE FISS. SUSCEPTIBLES D ETRE ATTEINTS 46 : C ISING(NC) = SINGULARITES CORRESPONDANT A UNE BIFURCATION 47 : C IFERM(NC) = FISSURES FERMEES 48 : C IBRUP(NC) = FISSURES ROMPUES 49 : C KERRE = GESTION DES ERREURS 50 : C---------------------------------------------------------------------- 51 : C 52 : IMPLICIT INTEGER(I-N) 53 : IMPLICIT REAL*8(A-H,O-Z) 54 : -INC CCOPTIO 55 : C 56 : PARAMETER (XZER=0.D0) 57 : C 58 : DIMENSION SIGMA(*),W(*),WMAX(*),SMAX(*),BILIN(*),WRUPT(*),XLTR(*) 59 : DIMENSION XINVL(*),SBILI(*),DXV1(*) 60 : DIMENSION NN(*),FC(*),FC2(*),LEBIL(*),VF(3,*),FC0(*) 61 : DIMENSION PENTE(*),PENTE2(*),MM(*) 62 : DIMENSION ISING(*),IFERM(*),IBRUP(*) 63 : DIMENSION WREOUV(3),JFIS(3) 64 : C 65 : KERRE=0 65 : CALL IANUL(ISING,NC) 65 : CALL IANUL(IFERM,NC) 65 : CALL IANUL(IBRUP,NC) 66 : C 67 : DO IC=1,NC 68 : NN(IC)=IC 69 : ENDDO 70 : C 71 : C ------ calcul de FC FC2 PENTE PENTE2 LEBIL ISING ------ 72 : C ------ caracterisant l etat de fissuration ------ 73 : C 73 : CALL UO2EC(NC,NC,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, 74 : & XLTR,XINVL,SBILI,FC,FC2,PENTE,PENTE2,LEBIL,ISING, 75 : & PRECIE,PRECIZ,KERRE) 76 : IF(KERRE.NE.0) THEN 77 : PRINT *, ' UO2ET - APRES UO2EC KERRE=',KERRE 78 : RETURN 79 : ENDIF 80 : C 81 : NCA=0 82 : MC=0 83 : C 84 : C 85 : DO IC=1,3 86 : WREOUV(IC)=BTR*MIN(WMAX(IC),WRUPT(IC)) 87 : C 88 : IF(FC(IC).GT.PRECIZ.OR.FC2(IC).GT.PRECIZ) THEN 89 : C cas ou le critere est violé 90 : KERRE=2 91 : PRINT *,' UO2ET - CRITERE VIOLE ',IC 92 : RETURN 93 : ENDIF 94 : C 95 : C cas ou le critere n'est pas atteint 96 : C ----------------------------------- 97 : C 98 : IF(FC(IC).LT.-PRECIZ.AND.FC2(IC).LT.-PRECIZ) THEN 99 : C 100 : C ---> sous-cas 1 : la direction n'a pas encore fissure 101 : C 102 : IF(XINVL(IC).EQ.XZER) THEN 103 : MC=MC+1 104 : MM(MC)= IC 105 : ELSE 106 : C 107 : C ---> sous-cas 2 : la direction a deja fissure 108 : C 109 : IF(LEBIL(IC).EQ.0) THEN 110 : C on est en compression 111 : IF(BTR.LT.1.D0.AND.WMAX(IC).NE.XZER) THEN 112 : MC=MC+1 113 : MM(MC)= 9+IC 114 : ELSE 115 : MC=MC+1 116 : MM(MC)= 3+IC 117 : ENDIF 118 : ELSE 119 : KERRE=2 120 : PRINT *,' UO2ET - CAS IMPOSSIBLE ',IC 121 : RETURN 122 : ENDIF 123 : C 124 : ENDIF 125 : C 126 : ELSE 127 : C 128 : C cas ou le critere est atteint 129 : C ----------------------------- 130 : C 131 : IF(XINVL(IC).EQ.XZER) THEN 132 : KERRE=2 133 : PRINT *,' UO2ET - XINVL EST NUL IC= ',IC 134 : RETURN 135 : ENDIF 136 : C 137 : PRECIW=PRECIE/XINVL(IC) 138 : NCA=NCA+1 139 : NN(NCA)=IC 140 : C 141 : C ---> sous-cas 1 : le materiau n est pas totalement casse 142 : C --------------------------------------------------- 143 : C 144 : IF(WMAX(IC).LT.WRUPT(IC)) THEN 145 : C 146 : IF(ABS(W(IC)-WREOUV(IC)).LT.PRECIW) THEN 147 : C 148 : IF(WMAX(IC).EQ.0.D0.OR.BTR.EQ.1.D0) THEN 149 : C 150 : C le materiau vient d'atteindre la limite 151 : C 152 : MC=MC+1 153 : MM(MC)= 6+IC 154 : IBRUP(IC)=1 155 : C 156 : ELSE 157 : C 158 : C on est pile sur le critere sigma=0 (==> IFERM=1) 159 : C et LEBIL vaut 1 160 : C 161 : IF(LEBIL(IC).NE.1) THEN 162 : KERRE=2 163 : PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC 164 : RETURN 165 : ENDIF 166 : C 167 : MC=MC+1 168 : MM(MC)= 3+IC 169 : IFERM(IC)=1 170 : ENDIF 171 : C 172 : ELSE IF(W(IC).GT.WREOUV(IC)) THEN 173 : C 174 : IF(ABS(W(IC)-WMAX(IC)).LT.PRECIW) THEN 175 : C 176 : C LEBIL vaut 2 177 : C 178 : IF(LEBIL(IC).NE.2) THEN 179 : KERRE=2 180 : PRINT *,' UO2ET - LEBIL NEG 2 SELON ',IC 181 : RETURN 182 : ENDIF 183 : C 184 : C d abord les 2 185 : C 186 : IF(FC(IC).GT.-PRECIZ.AND.FC2(IC).GT.-PRECIZ) THEN 187 : C 188 : MC=MC+1 189 : MM(MC)= 6+IC 190 : MC=MC+1 191 : MM(MC)= 12+IC 192 : C 193 : C sinon seul le secant 194 : C 195 : ELSE IF(FC(IC).LT.-PRECIZ.AND. 196 : & FC2(IC).GT.-PRECIZ) THEN 197 : C 198 : C on remet lebil a 1 199 : C 200 : LEBIL(IC)=1 201 : FC(IC)=FC2(IC) 202 : PENTE(IC)=PENTE2(IC) 203 : MC=MC+1 204 : MM(MC)= 3+IC 205 : MC=MC+1 206 : MM(MC)= 12+IC 207 : C 208 : ELSE 209 : KERRE=2 210 : PRINT *,' UO2ET - CAS PAS POSSIBLE SELON ',IC 211 : RETURN 212 : ENDIF 213 : C 214 : C 215 : ELSE 216 : C 217 : C on est sur le secant et LEBIL vaut 1 218 : C 219 : IF(LEBIL(IC).NE.1) THEN 220 : KERRE=2 221 : PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC 222 : RETURN 223 : ENDIF 224 : C 225 : MC=MC+1 226 : MM(MC)= 3+IC 227 : MC=MC+1 228 : MM(MC)= 12+IC 229 : ENDIF 230 : C 231 : ELSE 232 : C 233 : C W < WREOUV : CAS IMPOSSIBLE 234 : C 235 : KERRE=2 236 : PRINT *,' UO2ET - W < WREOUV IC= ',IC 237 : PRINT *,'W(IC)=',W(IC) 238 : PRINT *,'WMAX(IC)=',WMAX(IC) 239 : PRINT *,'WREOUV(IC)=',WREOUV(IC) 240 : PRINT *,'WRUPT(IC)=',WRUPT(IC) 241 : 242 : 243 : RETURN 244 : ENDIF 245 : C 246 : C ---> sous-cas 2 : le materiau est totalement casse 247 : C --------------------------------------------- 248 : C 249 : ELSE IF(WMAX(IC).GE.WRUPT(IC)) THEN 250 : C 251 : C 252 : IF(W(IC)-WREOUV(IC).LT.-PRECIW) THEN 253 : C 254 : KERRE=2 255 : PRINT *,' UO2ET - W < WREOUV IC= ',IC 256 : PRINT *,'W(IC)=',W(IC) 257 : PRINT *,'WMAX(IC)=',WMAX(IC) 258 : PRINT *,'WREOUV(IC)=',WREOUV(IC) 259 : PRINT *,'WRUPT(IC)=',WRUPT(IC) 260 : RETURN 261 : C 262 : ELSE 263 : C 264 : C on est en ouverture 265 : C ou bien on est pile sur la limite sigma=0 266 : C LEBIL vaut 1 dans les 2 cas 267 : C 268 : IF(LEBIL(IC).NE.1) THEN 269 : KERRE=2 270 : PRINT *,' UO2ET - LEBIL NEG 1 SELON ',IC 271 : RETURN 272 : ENDIF 273 : C 274 : IF(W(IC)-WREOUV(IC).GT.PRECIW) THEN 275 : MC=MC+1 276 : MM(MC)= 12+IC 277 : ELSE 278 : IFERM(IC)=1 279 : ENDIF 280 : C 281 : ENDIF 282 : ENDIF 283 : C 284 : ENDIF 285 : C 286 : ENDDO 287 : C 288 : C 289 : C 290 : C TEST SUR MC 291 : C 292 : IF(MC.EQ.0) THEN 293 : KERRE=2 294 : PRINT *,' UO2ET - MC EST NUL ' 295 : RETURN 296 : ENDIF 297 : C 298 : C APPEL A UO2CE 299 : C 299 : CALL UO2CE(MC,MM,SIGMA,DXV1,W,WMAX,SMAX,WRUPT,XLTR,XINVL,BTR, 300 : & NFISSU,NVF,FC0,VF,YOUN,PRECIZ,JFIS,KERRE) 301 : IF(KERRE.NE.0) THEN 302 : PRINT *, ' UO2ET - APRES UO2CE KERRE=',KERRE 303 : RETURN 304 : ENDIF 305 : C 306 : C TEST DE L'ETAT INITIAL 307 : C 308 : DO IC=1,MC 309 : JC=MM(IC) 310 : IF(FC0(JC).GT.PRECIZ)THEN 311 : PRINT *,'UO2ET - ETAT INITIAL INADMISSIBLE' 312 : KERRE=2 313 : RETURN 314 : ENDIF 315 : ENDDO 316 : C 317 : IF(IIMPI.EQ.42) THEN 318 : WRITE(IOIMP,77000) (FC(IC),IC=1,NC) 319 : 77000 FORMAT( 2X, ' UO2ET - FC '/(4(1X,1PE12.5)/)/) 320 : WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC) 321 : 77001 FORMAT( 2X, ' UO2ET - LEBIL '/(7I4)/) 322 : WRITE(IOIMP,77002) NCA,MC 323 : 77002 FORMAT( 2X, ' UO2ET - NCA=',I3,2X,'MC=',I3/) 324 : WRITE(IOIMP,77003) (NN(IC),IC=1,NCA) 325 : 77003 FORMAT( 2X, ' UO2ET - NN '/16(1X,I3)/) 326 : WRITE(IOIMP,77004) (MM(IC),IC=1,MC) 327 : 77004 FORMAT( 2X, ' UO2ET - MM '/16(1X,I3)/) 328 : ENDIF 329 : C 330 : RETURN 331 : END 332 : 333 : 334 :
© Cast3M 2003 - All rights reserved.
Disclaimer