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