C UO2EC SOURCE CHAT 05/01/13 03:58:58 5004 SUBROUTINE UO2EC(NC,NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, & XLTR,XINVL,SBILI,FCRIT,FCRIT2,PENTE,PENTE2,LEBIL,ISING, & PRECIE,PRECIZ,KERRE) C---------------------------------------------------------------------- C MODELE UO2 (OTTOSEN ET GATT_MONERIE) C CARACTERISATION DE L ETAT DE FISSURATION C---------------------------------------------------------------------- C C ENTREES C ------- C NC = (3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES C NCA = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT C (NCA=NC=3 A L APPEL PAR UO2ET) C NN(NC) = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT C (CONTIENT NN(I)=I I=1,3 A L APPEL PAR UO2ET) C SIGMA(6) = CONTRAINTES INITIALES C W(3) = OUVERTURES INITIALES DES FISSURES C WMAX(3) = OUVERTURES MAXIMALES INITIALES DES FISSURES C SMAX(3) = CONTR. CORRESPONDANT A WMAX C BILIN(3) = OUVERTURES DEFINISSANT LE CHANGEMENT DE PENTE EN CAS DE C RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE C WRUPT(3) = OUVERTURES CONDITIONNANT LA RUPTURE C BTR = PARAMETRE DE FERMETURE C XLTR(3) = LIMITES EN TRACTION POUR LA FISSURATION C XINVL(3) = PARAMETRES DE TAILLE C SBILI(3) = CONTR. CORRESPONDANT A BILIN C ISING(NC) = 0 A L APPEL PAR UO2ET C PRECIE = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES C PRECIZ = PRECISION POUR TESTS SUR CONTRAINTES C C C C SORTIES C ------- C FCRIT(NC) = CRITERE DE FISSURATION C FCRIT2(NC) = DEUXIEME CRITERE DE FISSURATION SI BIFURCATION POSSIBLE C PENTE(NC) = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FCRIT C PENTE2(NC) = PENTE DE LA DROITE DE FISS. CORRESPONDANT A FCRIT2 C LEBIL(NC) = COMPRESSION/TRACTION C ISING(NC) = SINGULARITES CORRESPONDANT A UNE BIFURCATION C---------------------------------------------------------------------- C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO C PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0) C DIMENSION NN(*),SIGMA(*),W(*),WMAX(*),SMAX(*),BILIN(*),WRUPT(*) DIMENSION XLTR(*),XINVL(*),SBILI(*) DIMENSION FCRIT(*),FCRIT2(*),PENTE(*),PENTE2(*),LEBIL(*),ISING(*) DIMENSION WREOUV(3) C C ----------------------- C INITIALISATIONS C ----------------------- C KERRE=0 DO IC=1,NC FCRIT(IC)=-1.D4*PRECIZ FCRIT2(IC)=-1.D4*PRECIZ LEBIL(IC)=0 ENDDO C C DO IC=1,NCA JC=NN(IC) C GO TO (1,1,1),JC C KERRE=99 RETURN C 1 CONTINUE C----------------- C IF (XINVL(JC).NE.XZER) THEN C WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC)) PRECIW=PRECIE/XINVL(JC) IF(IIMPI.EQ.42) THEN PRINT *,'UO2EC - JC =',JC PRINT *,'UO2EC - W =',W(JC) PRINT *,'UO2EC - WMAX =',WMAX(JC) PRINT *,'UO2EC - WREOUV =',WREOUV(JC) PRINT *,'UO2EC - WRUPT =',WRUPT(JC) PRINT *,'UO2EC - ISING =',ISING(JC) ENDIF C C C cas ou le materiau n est pas totalement casse C --------------------------------------------- C IF(WMAX(JC).LT.WRUPT(JC)) THEN IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN IF(WMAX(JC).EQ.0.D0.OR.BTR.EQ.UN) THEN C C le materiau vient d'atteindre la limite C CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W, & WMAX,SMAX,PENTE,JC) FCRIT(JC)=SIGMA(JC)-SMAX(JC) ELSE C IF(IIMPI.EQ.42) THEN PRINT *,'CAS W=WREOUV DANS UO2EC' ENDIF C FCRIT(JC)=SIGMA(JC) IF(FCRIT(JC).GE.-PRECIZ) THEN C C ici on pourrait aussi tester que w > wreouv C PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) LEBIL(JC)=1 FCRIT(JC)= SIGMA(JC) - & PENTE(JC)*(W(JC)-WREOUV(JC)) ENDIF ENDIF C ELSE IF(W(JC).GT.WREOUV(JC)) THEN C IF(W(JC)-WMAX(JC).GT.PRECIW) THEN C PRINT *,' UO2EC - W > WMAX SELON ',JC PRINT *,'W(JC) =',W(JC) PRINT *,'WMAX(JC) =',WMAX(JC) KERRE=7 RETURN C ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN C IF(IIMPI.EQ.42) THEN PRINT *,'CAS W=WMAX DANS UO2EC' PRINT *,'ISING(JC) =',ISING(JC) ENDIF C CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN, & SBILI,W,WMAX,SMAX,PENTE,JC) FCRIT(JC)=SIGMA(JC)-SMAX(JC) C IF(IIMPI.EQ.42) THEN PRINT *,'SIGMA=',SIGMA(JC) PRINT *,'SMAX =',SMAX(JC) PRINT *,'FCRIT=',FCRIT(JC) ENDIF C C CAS ISING=0 ON CALCULE 2 PENTES C PENTE2(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) FCRIT2(JC) = SIGMA(JC)-PENTE2(JC)*(W(JC)-WREOUV(JC)) C IF(ISING(JC).EQ.0) THEN LEBIL(JC)=2 ISING(JC)=1 C C CAS ISING=2 : PENTE POST-PIC C ELSE IF(ISING(JC).EQ.2) THEN LEBIL(JC)=0 C C CAS ISING=3 : PENTE SECANTE C ELSE IF(ISING(JC).EQ.3) THEN LEBIL(JC)=1 PENTE(JC)=PENTE2(JC) C IF(W(JC).LT.WMAX(JC)) THEN FCRIT(JC)= SIGMA(JC) - & PENTE(JC)*(W(JC)-WREOUV(JC)) ENDIF ENDIF C ELSE IF(W(JC).LT.WMAX(JC)) THEN C PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC)) LEBIL(JC)=1 C ENDIF C ELSE IF(W(JC).LT.WREOUV(JC)) THEN PRINT *,' UO2EC - W < WREOUV SELON ',JC PRINT *,'W(JC) =',W(JC) PRINT *,'WREOUV(JC) =',WREOUV(JC) KERRE=7 RETURN ENDIF C C cas ou le materiau est totalement casse C --------------------------------------- C ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN C FCRIT(JC)=SIGMA(JC) C IF(IIMPI.EQ.42) THEN PRINT *,'W(JC) =',W(JC) PRINT *,'WREOUV(JC) =',WREOUV(JC) ENDIF C IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN C IF(IIMPI.EQ.42) THEN PRINT *,' UO2EC - ON EST A LA LIMITE ' ENDIF C IF(FCRIT(JC).GE.-PRECIZ) THEN PENTE(JC)=0.D0 LEBIL(JC)=1 ENDIF C ELSE IF(W(JC).GT.WREOUV(JC)) THEN LEBIL(JC)=1 PENTE(JC)=0.D0 ENDIF C ENDIF C ENDIF C ENDDO C IF(IIMPI.EQ.42) THEN WRITE(IOIMP,77000) (FCRIT(IC),IC=1,NC) 77000 FORMAT( 2X, ' UO2EC - FCRIT '/(3(1X,1PE12.5)/)/) WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC) 77001 FORMAT( 2X, ' UO2EC - LEBIL '/(3I4)/) WRITE(IOIMP,77003) (PENTE(IC),IC=1,NC) 77003 FORMAT( 2X, ' UO2EC - PENTE '/(3(1X,1PE12.5)/)/) ENDIF C RETURN END