1 : C UO2EC SOURCE CHAT 05/01/13 03:58:58 5004 2 : SUBROUTINE UO2EC(NC,NCA,NN,SIGMA,W,WMAX,SMAX,BILIN,WRUPT,BTR, 3 : & XLTR,XINVL,SBILI,FCRIT,FCRIT2,PENTE,PENTE2,LEBIL,ISING, 4 : & PRECIE,PRECIZ,KERRE) 5 : C---------------------------------------------------------------------- 6 : C MODELE UO2 (OTTOSEN ET GATT_MONERIE) 7 : C CARACTERISATION DE L ETAT DE FISSURATION 8 : C---------------------------------------------------------------------- 9 : C 10 : C ENTREES 11 : C ------- 12 : C NC = (3) NBR. TOTAL DE DIRECTIONS DE FISS. POSSIBLES 13 : C NCA = NBR. DE DIRECTIONS DE FISS. OU UN CRITERE EST ATTEINT 14 : C (NCA=NC=3 A L APPEL PAR UO2ET) 15 : C NN(NC) = NUMEROS DES DIRECTIONS DE FISS. OU UN CRIT. EST ATTEINT 16 : C (CONTIENT NN(I)=I I=1,3 A L APPEL PAR UO2ET) 17 : C SIGMA(6) = CONTRAINTES INITIALES 18 : C W(3) = OUVERTURES INITIALES DES FISSURES 19 : C WMAX(3) = OUVERTURES MAXIMALES INITIALES DES FISSURES 20 : C SMAX(3) = CONTR. CORRESPONDANT A WMAX 21 : C BILIN(3) = OUVERTURES DEFINISSANT LE CHANGEMENT DE PENTE EN CAS DE 22 : C RELATION BILINEAIRE ENTRE CONTRAINTE ET OUVERTURE 23 : C WRUPT(3) = OUVERTURES CONDITIONNANT LA RUPTURE 24 : C BTR = PARAMETRE DE FERMETURE 25 : C XLTR(3) = LIMITES EN TRACTION POUR LA FISSURATION 26 : C XINVL(3) = PARAMETRES DE TAILLE 27 : C SBILI(3) = CONTR. CORRESPONDANT A BILIN 28 : C ISING(NC) = 0 A L APPEL PAR UO2ET 29 : C PRECIE = PRECISION POUR TESTS SUR OUVERTURES DE FISSURES 30 : C PRECIZ = PRECISION POUR TESTS SUR CONTRAINTES 31 : C 32 : C 33 : C 34 : C SORTIES 35 : C ------- 36 : C FCRIT(NC) = CRITERE DE FISSURATION 37 : C FCRIT2(NC) = DEUXIEME CRITERE DE FISSURATION SI BIFURCATION POSSIBLE 38 : C PENTE(NC) = PENTE DE LA DROITE DE FISSURATION CORRESPONDANT A FCRIT 39 : C PENTE2(NC) = PENTE DE LA DROITE DE FISS. CORRESPONDANT A FCRIT2 40 : C LEBIL(NC) = COMPRESSION/TRACTION 41 : C ISING(NC) = SINGULARITES CORRESPONDANT A UNE BIFURCATION 42 : C---------------------------------------------------------------------- 43 : C 44 : IMPLICIT INTEGER(I-N) 45 : IMPLICIT REAL*8(A-H,O-Z) 46 : -INC CCOPTIO 47 : C 48 : PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0) 49 : C 50 : DIMENSION NN(*),SIGMA(*),W(*),WMAX(*),SMAX(*),BILIN(*),WRUPT(*) 51 : DIMENSION XLTR(*),XINVL(*),SBILI(*) 52 : DIMENSION FCRIT(*),FCRIT2(*),PENTE(*),PENTE2(*),LEBIL(*),ISING(*) 53 : DIMENSION WREOUV(3) 54 : C 55 : C ----------------------- 56 : C INITIALISATIONS 57 : C ----------------------- 58 : C 59 : KERRE=0 60 : DO IC=1,NC 61 : FCRIT(IC)=-1.D4*PRECIZ 62 : FCRIT2(IC)=-1.D4*PRECIZ 63 : LEBIL(IC)=0 64 : ENDDO 65 : C 66 : C 67 : DO IC=1,NCA 68 : JC=NN(IC) 69 : C 70 : GO TO (1,1,1),JC 71 : C 72 : KERRE=99 73 : RETURN 74 : C 75 : 1 CONTINUE 76 : C----------------- 77 : C 78 : IF (XINVL(JC).NE.XZER) THEN 79 : C 80 : WREOUV(JC) = BTR*MIN(WMAX(JC),WRUPT(JC)) 81 : PRECIW=PRECIE/XINVL(JC) 82 : 83 : IF(IIMPI.EQ.42) THEN 84 : PRINT *,'UO2EC - JC =',JC 85 : PRINT *,'UO2EC - W =',W(JC) 86 : PRINT *,'UO2EC - WMAX =',WMAX(JC) 87 : PRINT *,'UO2EC - WREOUV =',WREOUV(JC) 88 : PRINT *,'UO2EC - WRUPT =',WRUPT(JC) 89 : PRINT *,'UO2EC - ISING =',ISING(JC) 90 : ENDIF 91 : 92 : C 93 : C 94 : C cas ou le materiau n est pas totalement casse 95 : C --------------------------------------------- 96 : C 97 : IF(WMAX(JC).LT.WRUPT(JC)) THEN 98 : 99 : IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN 100 : 101 : IF(WMAX(JC).EQ.0.D0.OR.BTR.EQ.UN) THEN 102 : C 103 : C le materiau vient d'atteindre la limite 104 : C 104 : CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,SBILI,W, 105 : & WMAX,SMAX,PENTE,JC) 106 : FCRIT(JC)=SIGMA(JC)-SMAX(JC) 107 : 108 : ELSE 109 : C 110 : IF(IIMPI.EQ.42) THEN 111 : PRINT *,'CAS W=WREOUV DANS UO2EC' 112 : ENDIF 113 : C 114 : FCRIT(JC)=SIGMA(JC) 115 : IF(FCRIT(JC).GE.-PRECIZ) THEN 116 : C 117 : C ici on pourrait aussi tester que w > wreouv 118 : C 119 : PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) 120 : LEBIL(JC)=1 121 : FCRIT(JC)= SIGMA(JC) - 122 : & PENTE(JC)*(W(JC)-WREOUV(JC)) 123 : ENDIF 124 : ENDIF 125 : C 126 : ELSE IF(W(JC).GT.WREOUV(JC)) THEN 127 : C 128 : IF(W(JC)-WMAX(JC).GT.PRECIW) THEN 129 : C 130 : PRINT *,' UO2EC - W > WMAX SELON ',JC 131 : PRINT *,'W(JC) =',W(JC) 132 : PRINT *,'WMAX(JC) =',WMAX(JC) 133 : KERRE=7 134 : RETURN 135 : C 136 : ELSE IF(ABS(W(JC)-WMAX(JC)).LT.PRECIW) THEN 137 : C 138 : IF(IIMPI.EQ.42) THEN 139 : PRINT *,'CAS W=WMAX DANS UO2EC' 140 : PRINT *,'ISING(JC) =',ISING(JC) 141 : ENDIF 142 : C 142 : CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN, 143 : & SBILI,W,WMAX,SMAX,PENTE,JC) 144 : FCRIT(JC)=SIGMA(JC)-SMAX(JC) 145 : C 146 : IF(IIMPI.EQ.42) THEN 147 : PRINT *,'SIGMA=',SIGMA(JC) 148 : PRINT *,'SMAX =',SMAX(JC) 149 : PRINT *,'FCRIT=',FCRIT(JC) 150 : ENDIF 151 : C 152 : C CAS ISING=0 ON CALCULE 2 PENTES 153 : C 154 : PENTE2(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) 155 : FCRIT2(JC) = SIGMA(JC)-PENTE2(JC)*(W(JC)-WREOUV(JC)) 156 : C 157 : IF(ISING(JC).EQ.0) THEN 158 : LEBIL(JC)=2 159 : ISING(JC)=1 160 : C 161 : C CAS ISING=2 : PENTE POST-PIC 162 : C 163 : ELSE IF(ISING(JC).EQ.2) THEN 164 : LEBIL(JC)=0 165 : C 166 : C CAS ISING=3 : PENTE SECANTE 167 : C 168 : ELSE IF(ISING(JC).EQ.3) THEN 169 : LEBIL(JC)=1 170 : PENTE(JC)=PENTE2(JC) 171 : C 172 : IF(W(JC).LT.WMAX(JC)) THEN 173 : FCRIT(JC)= SIGMA(JC) - 174 : & PENTE(JC)*(W(JC)-WREOUV(JC)) 175 : ENDIF 176 : ENDIF 177 : C 178 : ELSE IF(W(JC).LT.WMAX(JC)) THEN 179 : C 180 : PENTE(JC) = SMAX(JC)/(WMAX(JC)-WREOUV(JC)) 181 : FCRIT(JC)= SIGMA(JC) - PENTE(JC)*(W(JC)-WREOUV(JC)) 182 : LEBIL(JC)=1 183 : C 184 : ENDIF 185 : C 186 : ELSE IF(W(JC).LT.WREOUV(JC)) THEN 187 : PRINT *,' UO2EC - W < WREOUV SELON ',JC 188 : PRINT *,'W(JC) =',W(JC) 189 : PRINT *,'WREOUV(JC) =',WREOUV(JC) 190 : KERRE=7 191 : RETURN 192 : ENDIF 193 : C 194 : C cas ou le materiau est totalement casse 195 : C --------------------------------------- 196 : C 197 : ELSE IF(WMAX(JC).GE.WRUPT(JC)) THEN 198 : C 199 : FCRIT(JC)=SIGMA(JC) 200 : C 201 : IF(IIMPI.EQ.42) THEN 202 : PRINT *,'W(JC) =',W(JC) 203 : PRINT *,'WREOUV(JC) =',WREOUV(JC) 204 : ENDIF 205 : C 206 : IF(ABS(W(JC)-WREOUV(JC)).LT.PRECIW) THEN 207 : C 208 : IF(IIMPI.EQ.42) THEN 209 : PRINT *,' UO2EC - ON EST A LA LIMITE ' 210 : ENDIF 211 : C 212 : IF(FCRIT(JC).GE.-PRECIZ) THEN 213 : PENTE(JC)=0.D0 214 : LEBIL(JC)=1 215 : ENDIF 216 : C 217 : ELSE IF(W(JC).GT.WREOUV(JC)) THEN 218 : LEBIL(JC)=1 219 : PENTE(JC)=0.D0 220 : ENDIF 221 : C 222 : ENDIF 223 : C 224 : ENDIF 225 : C 226 : ENDDO 227 : C 228 : IF(IIMPI.EQ.42) THEN 229 : WRITE(IOIMP,77000) (FCRIT(IC),IC=1,NC) 230 : 77000 FORMAT( 2X, ' UO2EC - FCRIT '/(3(1X,1PE12.5)/)/) 231 : WRITE(IOIMP,77001) (LEBIL(IC),IC=1,NC) 232 : 77001 FORMAT( 2X, ' UO2EC - LEBIL '/(3I4)/) 233 : WRITE(IOIMP,77003) (PENTE(IC),IC=1,NC) 234 : 77003 FORMAT( 2X, ' UO2EC - PENTE '/(3(1X,1PE12.5)/)/) 235 : ENDIF 236 : C 237 : RETURN 238 : END 239 : 240 :
© Cast3M 2003 - All rights reserved.
Disclaimer