1 : C UO2IN SOURCE STRU 07/05/31 21:15:42 5744 2 : SUBROUTINE UO2IN(ISING,IFERM,IBRUP,LEBIL,PENTE,PENTE2,NCA,NN,MC, 3 : & MM,SIGG0,GS,FC,XINVL,XLTR,WMAX0,WRUPT,PRECIZ,T0, 4 : & TPOINT,FI0,FPOINT,PRECIS,XMAT,NCOMAT,NSIMP,AAD,BTR, 5 : & EPSPT,EPSV0,VAR0,W0,DX0,NGAT,TAU,KERRE) 6 : C---------------------------------------------------------------------- 7 : C ECOULEMENT MODELE UO2 (OTTOSEN ET GATT_MONERIE) 8 : C DETERMINATION DU CHEMIN A SUIVRE EN CAS DE BIFURCATION 9 : C---------------------------------------------------------------------- 10 : C 11 : C ENTREES 12 : C ------- 13 : C ISING(NC) = SINGULARITES CORRESPONDANT A UNE BIFURCATION 14 : C IFERM(NC) = FISSURES FERMEES 15 : C IBRUP(NC) = FISSURES ROMPUES 16 : C LEBIL(NC) = COMPRESSION/TRACTION 17 : C PENTE(NC) = PREMIERE PENTE DE FISSURATION CORRESPONDANT A FC 18 : C PENTE2(NC) = DEUXIEME PENTE DE FISSURATION 19 : C NCA = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT 20 : C NN(NC) = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT 21 : C MC = NBR. DE CRITERES DE FISS. SUSCEPTIBLES D ETRE ATTEINTS 22 : C MM(20) = TYPES DES CRIT. DE FISS. SUSCEPTIBLES D ETRE ATTEINTS 23 : C SIGG0(6) = CONTRAINTES INITIALES 24 : C GS(3) = RESISTANCES AU CISAILLEMENT 25 : C FC(NC) = CRITERE DE FISSURATION 26 : C XINVL(3) = PARAMETRES DE TAILLE 27 : C XLTR(3) = LIMITES EN TRACTION POUR LA FISSURATION 28 : C WMAX0(3) = OUVERTURES MAXIMALES DES FISSURES AU DEB. DU SOUS PAS 29 : C WRUPT(3) = OUVERTURES CONDITIONNANT LA RUPTURE 30 : C PRECIZ = PRECISION POUR TESTS SUR CONTRAINTES 31 : C T0 = TEMPERATURE AU DEBUT DU SOUS PAS D INTEGRATION 32 : C TPOINT = VITESSE DE TEMPERATURE SUR LE PAS D INTEGRATION 33 : C FI0 = DENSITE DE FISSION AU DEBUT DU SOUS PAS D INTEGRATION 34 : C FPOINT = VITESSE DE DENSITE DE FISSION SUR LE PAS D INTEGRATION 35 : C PRECIS = PRECISION POUR LA VISCOPLASTICITE 36 : C XMAT(NCOMAT) = CARACTERISTIQUES THERMOMECANIQUES DU MATERIAU 37 : C NSIMP = POINTE SUR LA CARACTERISTIQUE FACULTATIVE 'SIMP' DE XMAT 38 : C AAD = COEFFICIENT INTERVENANT DANS LE CALCUL DE L INCREMENT 39 : C DE LA DEFORMATION DE DENSIFICATION 40 : C BTR = PARAMETRE DE FERMETURE 41 : C EPSPT(6) = VITESSE DES DEFORM. TOTALES SUR LE PAS D INTEGRATION 42 : C EPSV0(6) = DEFORM. VISCOPLAST. AU DEBUT DU SOUS PAS D'INTEGRATION 43 : C VAR0(NGAT) = VAR. INT. SCAL. DE GATT_MONERIE AU DEB. DU SS PAS 44 : C W0(3) = OUVERTURES DE FISS. AU DEB. DU SS PAS D'INTEGRATION 45 : C DX0(NC) = DEF. DE FISSURATION (OUV.) AU DEB. DU SS PAS 46 : C TAU = (DT) PAS D INTEGRATION 47 : C 48 : C SORTIES 49 : C ------- 50 : C NCA = NBR. DE DIR. DE FISS. OU UN CRIT. EST ATTEINT CPTE TENU 51 : C DU CHEMIN A SUIVRE (DECHARGE ELASTIQUE POSSIBLE) 52 : C NN(NC) = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT 53 : C CPTE TENU DU CHEMIN A SUIVRE 54 : C MC = NOUVEAU NBR. DE CRIT. DE FISS. SUSCEPT. D ETRE ATTEINTS 55 : C MM(20) = NOUV. TYPES DES CRIT. DE FISS. SUSCEPT. D ETRE ATTEINTS 56 : C PENTE(NC) = PENTE DE FISSURATION DU CHEMIN A SUIVRE 57 : C----------------------------------------------------------------------- 58 : C 59 : IMPLICIT INTEGER(I-N) 60 : IMPLICIT REAL*8(A-H,O-Z) 61 : -INC CCOPTIO 62 : C 63 : PARAMETER (NC=3,NGATT=4) 64 : C 65 : DIMENSION ISING(*),IFERM(*),IBRUP(*),LEBIL(*) 66 : DIMENSION XINVL(*),XLTR(*),WRUPT(*),WMAX0(*) 67 : DIMENSION FC(*),PENTE(*),PENTE2(*) 68 : DIMENSION NN(*),MM(*) 69 : DIMENSION SIGG0(*),EPSPT(*),EPSV0(*),VAR0(*),W0(*),DX0(*) 70 : DIMENSION GS(*),XMAT(*) 71 : DIMENSION DDE(18) 72 : DIMENSION SIGGF(6),EPSVVF(6),VARF(NGATT),WF(3),DSIG(6) 73 : DIMENSION WMAXF(3),WREOU0(3),WREOUF(3) 74 : DIMENSION DXF(NC),DDX(NC) 75 : DIMENSION NSITUA(NC+1),JESEC(NC),LASIT(NC) 76 : DIMENSION PENT(NC),NN2(NC) 77 : C 78 : C 79 : IF(IIMPI.EQ.42) THEN 80 : WRITE(IOIMP,74411) (ISING(IC),IC=1,NC), 81 : & (IFERM(IC),IC=1,NC), 82 : & (IBRUP(IC),IC=1,NC) 83 : 74411 FORMAT(5X,' ENTREE DANS UO2IN - ISING = ',3I3, 84 : & 2X,'IFERM = ',3I3/2X,'IBRUP = ',3I3/) 85 : ENDIF 86 : C 87 : C 88 : C INITIALISATIONS 89 : C 90 : NC1=NC+1 91 : KERRE=0 91 : CALL SHIFTD(PENTE,PENT,NC) 92 : PRECIE=1.D-10 93 : IFLAG1=1 94 : DO I=1,3 95 : WREOU0(I) = BTR*MIN(WMAX0(I),WRUPT(I)) 96 : ENDDO 97 : C 98 : C 99 : DO IC=1,NC 100 : NSITUA(IC)=1 + ISING(IC) + IFERM(IC) + IBRUP(IC) 101 : IF(NSITUA(IC).GT.2) THEN 102 : WRITE(IOIMP,74412) IC,ISING(IC),IFERM(IC),IBRUP(IC) 103 : 74412 FORMAT(2X,'####### CAS IMPOSSIBLE IC=',I3,2X, 104 : & 'ISING(IC)=',I3,2X,'IFERM(IC)=',I3,2X, 105 : & 'IBRUP(IC)=',I3/) 106 : KERRE=7 107 : RETURN 108 : ENDIF 109 : ENDDO 110 : C 111 : C 112 : DO 21 I1=1,NSITUA(1) 113 : LASIT(1)=I1 114 : C 115 : DO 22 I2=1,NSITUA(2) 116 : LASIT(2)=I2 117 : C 118 : DO 23 I3=1,NSITUA(3) 119 : LASIT(3)=I3 120 : C 121 : C TYPES 1 (ISING) ( IC=1 A 3 ) 122 : C 1 : PENTE2 (SECANTE) 123 : C 2 : PENTE 124 : C 125 : C TYPES 2 (IFERM) ( IC=1 A 3 ) 126 : C 1 : ELASTIQUE 127 : C 2 : PENTE SECANTE 128 : C 129 : C TYPES 3 (IBRUP) ( IC=1 A 3 ) 130 : C 1 : ELASTIQUE 131 : C 2 : PENTE 132 : C 133 : DO IC=1,3 134 : IF(LASIT(IC).EQ.2) THEN 135 : PENT(IC)=PENTE(IC) 136 : ELSE IF(LASIT(IC).EQ.1.AND.ISING(IC).EQ.1) THEN 137 : PENT(IC)=PENTE2(IC) 138 : ENDIF 139 : ENDDO 140 : C 141 : C 141 : CALL IANUL(JESEC,NC) 142 : NCA2=0 143 : DO IJ=1,NCA 144 : JJ=NN(IJ) 145 : IF(LASIT(JJ).EQ.1) THEN 146 : IF(IFERM(JJ).NE.1.AND.IBRUP(JJ).NE.1) THEN 147 : NCA2=NCA2+1 148 : NN2(NCA2)=JJ 149 : ENDIF 150 : ELSE IF(LASIT(JJ).EQ.2) THEN 151 : NCA2=NCA2+1 152 : NN2(NCA2)=JJ 153 : IF(IFERM(JJ).EQ.1.AND.JJ.LE.3) THEN 154 : JESEC(JJ)=1 155 : ENDIF 156 : ENDIF 157 : ENDDO 158 : C 159 : IF(IIMPI.EQ.42) THEN 160 : WRITE(IOIMP,60080) I1,I2,I3,NCA,NCA2 161 : 60080 FORMAT(//2X,' ******** SITUATION : I1 I2 I3 ', 162 : & 3I3/2X,'NCA=',I3,2X,'NCA2=',I3/) 163 : ENDIF 164 : C 165 : IF(NCA2.EQ.0) THEN 166 : GO TO 55 167 : ENDIF 168 : C 169 : C 170 : C --- determination d un etat converge pour TAU inferieur ou egal a DT 171 : C 172 : NDIM=NCA2 173 : IF(IFOUR.EQ.-2) NDIM=NCA2+1 174 : C 175 : TAUESS=TAU 176 : C 176 : CALL UO2DCN(IFLAG1,T0,TPOINT,FI0,FPOINT,PRECIS,PRECIZ, 177 : & XMAT,NCOMAT,NSIMP,AAD,BTR,GS,WRUPT,LEBIL,XINVL,PENT, 178 : & EPSPT,SIGG0,EPSV0,VAR0,W0,WMAX0,WREOU0,DX0, 179 : & NGAT,NC1,NCA2,NDIM,NN2,TAUESS,TAUNEX,SIGGF,EPSVVF, 180 : & VARF,WF,DXF,WMAXF,WREOUF,TF,FIF,KERRE) 181 : IF (KERRE.NE.0) THEN 182 : RETURN 183 : ENDIF 184 : C 185 : C 186 : IF(IIMPI.EQ.42) THEN 187 : WRITE(IOIMP,60081) (SIGG0(I),I=1,6) 188 : 60081 FORMAT(2X,' SIGG0 '/(6(1X,1PE12.5))/) 189 : ENDIF 190 : C 191 : IF(IIMPI.EQ.42) THEN 192 : WRITE(IOIMP,77010) NCA2,NDIM 193 : 77010 FORMAT(5X,'NCA2=',I3,2X,'NDIM =',I3/) 194 : WRITE(IOIMP,77018) (NN2(IJ),IJ=1,NCA2) 195 : 77018 FORMAT(5X,'NN2 ',5(1X,I3)) 196 : ENDIF 197 : C 198 : C 199 : DO IJ=1,NCA2 200 : JJ=NN2(IJ) 201 : DDX(JJ)=DXF(JJ)-DX0(JJ) 202 : C 203 : IF(IIMPI.EQ.42) THEN 204 : WRITE(IOIMP,77013) JJ,DDX(JJ) 205 : 77013 FORMAT(5X,' UO2IN - DIRECTION',(1X,I3), 206 : & 'DDX CALCULE'/(1X,1PE12.5)) 207 : ENDIF 208 : C 209 : ENDDO 210 : C 211 : C 212 : DO I=1,6 213 : DSIG(I)=SIGGF(I)-SIGG0(I) 214 : ENDDO 215 : C 216 : IF(IIMPI.EQ.42) THEN 217 : WRITE(IOIMP,79013) (DSIG(I),I=1,6) 218 : 79013 FORMAT(5X,' UO2IN - DSIG CALCULE '/(6(1X,1PE12.5))) 219 : ENDIF 220 : C 221 : C 222 : IFLAG=0 223 : DO IJ=1,NCA2 224 : JJ=NN2(IJ) 225 : IF(ISING(JJ).EQ.1) THEN 226 : IF(DSIG(JJ).GT.PRECIZ) IFLAG=1 227 : IF(PENT(JJ).EQ.PENTE(JJ).AND.DDX(JJ).LT.0.D0) IFLAG=1 228 : IF(PENT(JJ).EQ.PENTE2(JJ).AND.DDX(JJ).GT.0.D0) IFLAG=1 229 : ENDIF 230 : C 231 : IF(IFERM(JJ).EQ.1) THEN 232 : IF(DDX(JJ).LT.0.D0.OR.DSIG(JJ).LT.-PRECIZ) IFLAG=1 233 : ENDIF 234 : ENDDO 235 : C 236 : DO I=1,3 237 : IF(IFERM(I).EQ.1.AND.LASIT(I).EQ.1) THEN 238 : IF(DSIG(I).GT.PRECIZ) IFLAG=1 239 : ENDIF 240 : ENDDO 241 : C 242 : DO I=1,3 243 : IF(IBRUP(I).EQ.1.AND.LASIT(I).EQ.1) THEN 244 : IF(DSIG(I).GT.PRECIZ) IFLAG=1 245 : ENDIF 246 : ENDDO 247 : C 248 : C 249 : IF(IFLAG.EQ.0) THEN 250 : DO IJ=1,NCA2 251 : JJ=NN2(IJ) 252 : IF(ISING(JJ).EQ.1) THEN 253 : IF(PENT(JJ).EQ.PENTE(JJ)) THEN 254 : ISING(JJ)=2 255 : LEBIL(JJ)=0 256 : ENDIF 257 : IF(PENT(JJ).EQ.PENTE2(JJ)) THEN 258 : ISING(JJ)=3 259 : LEBIL(JJ)=1 260 : ENDIF 261 : ENDIF 262 : ENDDO 263 : GO TO 99 264 : ENDIF 265 : C 266 : C 267 : 55 CONTINUE 268 : C 269 : 23 CONTINUE 270 : C 271 : 22 CONTINUE 272 : C 273 : 21 CONTINUE 274 : C 275 : C 276 : C EN CAS DE PROBLEME : 277 : C 278 : KERRE=7 279 : C VALEUR DE KERRE A AMELIORER 280 : C 281 : WRITE(IOIMP,73312) 282 : 73312 FORMAT(2X,'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ' / 283 : & 4X,'ATTENTION - UO2IN - PAS DE SOLUTION ' / 284 : & 2X,'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ'/) 285 : RETURN 286 : C 287 : C 288 : C 289 : 99 CONTINUE 290 : C 290 : CALL SHIFTD(PENT,PENTE,NC) 291 : C 292 : IF(IIMPI.EQ.42) THEN 293 : WRITE(IOIMP,70801) (PENTE(I),I=1,NC) 294 : 70801 FORMAT(///2X,'UO2IN SORTIE - PENTE '/(4(1X,1PE12.5)/)) 295 : WRITE(IOIMP,76802) (LEBIL(I),I=1,NC) 296 : 76802 FORMAT(/2X,'UO2IN SORTIE - LEBIL '/(4I5/)) 297 : WRITE(IOIMP,76803) (ISING(I),I=1,NC) 298 : 76803 FORMAT(/2X,'UO2IN SORTIE - ISING '/(4I5/)) 299 : ENDIF 300 : C 301 : C 302 : C RETRAITEMENT 303 : C 304 : NCA=NCA2 305 : IF (NCA.EQ.0) GOTO 1000 306 : DO I=1,NCA 307 : NN(I)=NN2(I) 308 : ENDDO 309 : C 310 : MC2=0 311 : DO I=1,MC 312 : C 313 : C TYPES 1 314 : C 315 : IF(MM(I).GE.7.AND.MM(I).LE.9) THEN 316 : IC=MM(I)-6 317 : IF(ISING(IC).EQ.3) GO TO 101 318 : ENDIF 319 : 320 : IF(MM(I).GE.13.AND.MM(I).LE.15) THEN 321 : IC=MM(I)-12 322 : IF(ISING(IC).EQ.2) GO TO 101 323 : ENDIF 324 : C 325 : C TYPES 2 326 : C 327 : IF(MM(I).GE.4.AND.MM(I).LE.6) THEN 328 : IC=MM(I)-3 329 : IF(IFERM(IC).EQ.1.AND.JESEC(IC).EQ.0) GO TO 101 330 : ENDIF 331 : C 332 : MC2=MC2+1 333 : MM(MC2)=MM(I) 334 : 101 CONTINUE 335 : ENDDO 336 : MC=MC2 337 : 338 : IF(IIMPI.EQ.42) THEN 339 : WRITE(IOIMP,44102) NCA 340 : 44102 FORMAT(2X,'UO2IN - NOUVELLE VALEUR NCA =',I3/) 341 : WRITE(IOIMP,44103) (NN(IC),IC=1,NCA) 342 : 44103 FORMAT(2X,'UO2IN - NOUVELLE LISTE NN '/16(1X,I3)/) 343 : WRITE(IOIMP,49102) MC 344 : 49102 FORMAT(2X,'UO2IN - NOUVELLE VALEUR MC =',I3/) 345 : WRITE(IOIMP,49103) (MM(IC),IC=1,MC) 346 : 49103 FORMAT(2X,'UO2IN - NOUVELLE LISTE MM '/16(1X,I3)/) 347 : ENDIF 348 : C 349 : 1000 CONTINUE 350 : C 351 : RETURN 352 : END 353 : 354 : 355 : 356 : 357 : 358 :
© Cast3M 2003 - All rights reserved.
Disclaimer