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