1 : C OTTOXX SOURCE AM 11/05/03 21:17:53 6955 2 : SUBROUTINE OTTOXX(MC,MM,SIG0,DSIGT,STOT, 3 : & VAUX1,VAUX2,VAUX,FC0,DX,DXV1,DXV2, 4 : & PRECIE,PRECIZ,BTR,YOUN, 5 : & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF, 6 : & XXMIN,JCRIT,NCRIT,XCOMP,XLAMC,ICOMEL,LERED,KERRE) 7 : C========================================================================= 8 : C 9 : C ENTREES : 10 : C SIG0,DSIGT,FC0,PRECIZ 11 : C W,WMAX,SMAX,WRUPT,BTR,XLTR,XINVL 12 : C VAUX1,VAUX2 13 : C 14 : C SORTIES : 15 : C JCRIT,XXMIN,STOT,VAUX 16 : C 17 : C========================================================================== 18 : C 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8(A-H,O-Z) 21 : -INC CCOPTIO 22 : C 23 : PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0) 24 : C 25 : DIMENSION SIG0(6),DSIGT(6),STOT(6),XCOMP(*) 26 : DIMENSION VAUX1(6),VAUX2(6),VAUX(6) 27 : DIMENSION DX(*),DXV1(*),DXV2(*) 28 : DIMENSION DXVV(3) 29 : DIMENSION W(3),WMAX(3),WREOUV(3), 30 : & WRUPT(3),XLTR(3),XINVL(3),XXF(3) 31 : DIMENSION MM(*),SMAX(*) 32 : DIMENSION FC0(*),JCRIT(*) 33 : DIMENSION VF(3,3),JFIS(3),JFIS2(3) 34 : DIMENSION JCDUM(1) 35 : DIMENSION FC2(16),FCT(16),MMA(20) 36 : 37 : DIMENSION DFF(6),DGG(6) 38 : 39 : IF(IIMPI.EQ.42) THEN 40 : WRITE(IOIMP,55446) ICOMEL 41 : 55446 FORMAT(/2X,' ENTREE OTTOXX - ICOMEL =',I4/) 42 : ENDIF 43 : 44 : C 45 : C INITIALISATIONS 46 : C 47 : KERRE=0 48 : LERED=0 49 : XXMIN=1.D0 50 : NCRIT=0 50 : CALL IANUL(JCRIT,20) 51 : * 52 : * 53 : DO I=1,6 54 : STOT(I)=SIG0(I)+DSIGT(I) 55 : VAUX(I)=VAUX1(I)+VAUX2(I) 56 : ENDDO 57 : * 58 : DO I=1,3 59 : DXVV(I)=DXV1(I)+DXV2(I) 60 : ENDDO 61 : 62 : * 63 : * APPEL A OTTOCE 64 : * 64 : CALL OTTOCE(MC,MM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT, 65 : & XLTR,XINVL,BTR,NFISSU,NVF,FCT,VF,YOUN,PRECIZ, 66 : & JFIS,XCOMP,XLAMC,DFF,DGG,KERRE) 67 : IF(KERRE.NE.0) RETURN 68 : * 69 : * 70 : MCA=0 71 : DO IC=1,MC 72 : JC=MM(IC) 73 : * 74 : IF(IIMPI.EQ.42) THEN 75 : WRITE(IOIMP,30446) IC,JC,FCT(JC) 76 : 30446 FORMAT(/2X,' OTTOXX - IC=',I4,2X,' JC=',I4,2X, 77 : & ' FCT(JC)=',1PE12.5/) 78 : ENDIF 79 : * 80 : IF(FCT(JC).GT.0.D0)THEN 81 : MCA=MCA+1 82 : MMA(MCA)=JC 83 : ELSE IF(ABS(FCT(JC)).LE.PRECIZ)THEN 84 : MCA=MCA+1 85 : MMA(MCA)=JC 86 : IF(FCT(JC).LT.0.D0) FCT(JC)=0.D0 87 : ENDIF 88 : ENDDO 89 : * 90 : 91 : IF(IIMPI.EQ.42) THEN 92 : WRITE(IOIMP,50446) MCA 93 : 50446 FORMAT(/2X,' DANS OTTOXX - MCA =',I4/) 94 : WRITE(IOIMP,40446) (MMA(I),I=1,MCA) 95 : 40446 FORMAT(/2X,' OTTOXX - MMA =',5I4/) 96 : ENDIF 97 : * 98 : * 99 : IF(MCA.NE.0) THEN 100 : * 101 : * FAUT-IL APPELER OTTOXF ? 102 : * 103 : LAPPEL=0 104 : 105 : IZOB = 0 106 : IF(IZOB.GT.0) THEN 107 : DO IC=1,MCA 108 : JC=MMA(IC) 109 : * 110 : IF(JC.GE.1.AND.JC.LE.3) THEN 111 : * 112 : IF(FC0(JC).GT.0.D0.AND.FC0(JC).LT.PRECIZ) THEN 113 : * 114 : XXMIN=0.D0 115 : JCRIT(1)=JC 116 : NCRIT=1 117 : DO I=1,6 118 : STOT(I)=SIG0(I) 119 : VAUX(I)=VAUX1(I) 120 : ENDDO 121 : GO TO 300 122 : ENDIF 123 : IF(JFIS(JC).GT.1) LAPPEL=1 124 : ENDIF 125 : ENDDO 126 : ENDIF 127 : * 128 : * MLR 9/7/99 129 : * 130 : DO IC=1,MCA 131 : JC=MMA(IC) 132 : IF(ICOMEL.EQ.1.AND.JC.EQ.16) GO TO 77 133 : IF(FC0(JC)*FCT(JC).GT.0.D0) THEN 134 : IF(IIMPI.EQ.42) THEN 135 : PRINT *,'##### OTTOXX CRITERES INCOMPATIBLES JC = ',JC 136 : PRINT *,' FC0 = ',FC0(JC), ' FCT = ', FCT(JC) 137 : ENDIF 138 : LERED=1 139 : RETURN 140 : ENDIF 141 : 77 CONTINUE 142 : ENDDO 143 : 144 : 145 : * 146 : * APPEL A OTTOXF 147 : * 148 : IF(LAPPEL.EQ.1) THEN 148 : CALL OTTOXF(SIG0,DSIGT,XINVL,XLTR, 149 : & NFISSU,NVF,XXF,PRECIZ,KERRE) 150 : IF(KERRE.NE.0) RETURN 151 : * 152 : IF(IIMPI.EQ.42) THEN 153 : WRITE(IOIMP,44556) (XXF(I),I=1,3) 154 : 44556 FORMAT(/2X,' APRES OTTOXF : XXF ',3(1X,1PE12.5)/) 155 : ENDIF 156 : * 157 : **** MLR 9/7/99 158 : * 159 : IF(XXF(2).EQ.1.D4.AND.XXF(3).EQ.1.D4) THEN 160 : LAPPEL=0 161 : GO TO 50 162 : ENDIF 163 : * 164 : * 165 : IF(JFIS(2).GT.1) THEN 166 : I1=1 167 : IF(JFIS(2).EQ.2) I1=2 168 : DO I=I1,3 169 : IF(XXF(I).GT.0.D0) THEN 170 : XXFIS=XXF(I) 171 : GO TO 50 172 : ENDIF 173 : ENDDO 174 : IF(IIMPI.EQ.42) THEN 175 : WRITE(IOIMP,77453) 176 : 77453 FORMAT(2X,'####### PAS DE RACINE POSITIVE #######'/) 177 : ENDIF 178 : ****** KERRE=70 179 : ****** RETURN 180 : * ON SE DONNE UNE DERNIERE CHANCE 181 : * 182 : LAPPEL=0 183 : ENDIF 184 : * 185 : 50 CONTINUE 186 : * 187 : ENDIF 188 : * 189 : * 190 : DO IC=1,MCA 191 : JC=MMA(IC) 192 : F1=FC0(JC) 193 : F2=FCT(JC) 194 : IF(IIMPI.EQ.42) THEN 195 : PRINT *,' IC=',IC 196 : PRINT *,' JC=',JC 197 : PRINT *,' FC0=',FC0(JC) 198 : PRINT *,' FCT=',FCT(JC) 199 : ENDIF 200 : 201 : * 202 : * MLR 9/7/99 203 : * 204 : XXDEP=0.D0 205 : 206 : IF(ICOMEL.EQ.1.AND.JC.EQ.16) THEN 207 : * 208 : * SPECIAL RETRAITEMENT DU POINT INITIAL 209 : * 210 : IF(ABS(F2).LE.PRECIZ) THEN 211 : XX=1.D0 212 : GO TO 200 213 : ENDIF 214 : * 215 : IDITER=0 216 : XX=0.5D0 217 : 218 : 600 IDITER=IDITER+1 219 : IF(IDITER.GT.100) THEN 220 : PRINT *,'IDITER=100 ' 221 : KERRE=1 222 : RETURN 223 : ENDIF 224 : * 225 : DO I=1,6 226 : STOT(I)=SIG0(I)+XX*DSIGT(I) 227 : VAUX(I)=VAUX1(I)+XX*VAUX2(I) 228 : ENDDO 229 : * 230 : DO I=1,3 231 : DXVV(I)=DXV1(I)+XX*DXV2(I) 232 : ENDDO 233 : * 234 : * 235 : JCDUM(1)=JC 235 : CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT, 236 : & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ, 237 : & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE) 238 : IF(KERRE.NE.0) RETURN 239 : FF=FC2(JC) 240 : IF(ABS(FF).LT.PRECIZ) GO TO 200 241 : * 242 : * 243 : IF(FF.GT.0.D0) THEN 244 : XX=XX/2.D0 245 : GO TO 600 246 : ELSE 247 : XXDEP=XX 248 : F1=FF 249 : ENDIF 250 : * 251 : ENDIF 252 : * 253 : IF(IIMPI.EQ.42) THEN 254 : PRINT *,'VALEUR DE DEPART XXDEP = ',XXDEP 255 : ENDIF 256 : 257 : 258 : 259 : * 260 : XX1=XXDEP 261 : XX2=1.D0 262 : XX= XX2 - F2*(XX2-XX1)/(F2-F1) 263 : 264 : 265 : IF(IIMPI.EQ.42) THEN 266 : PRINT *,'ESTIMATION SECANTE XX = ',XX 267 : PRINT *,'JC=',JC,' JFIS(JC)=',JFIS(JC) 268 : ENDIF 269 : * 270 : * 271 : IF(JC.GE.1.AND.JC.LE.3.AND.LAPPEL.EQ.1) THEN 272 : IF(JFIS(JC).GE.2) THEN 273 : * 274 : IF(IIMPI.EQ.42) THEN 275 : PRINT *,'VALEUR CALCULEE XX = ',XXFIS 276 : ENDIF 277 : * 278 : * MLR 9/7/99 279 : * 280 : IF(XX.LE.1.D0.AND.XXFIS.LE.1.D0) THEN 281 : XX=XXFIS 282 : GO TO 200 283 : * 284 : ELSE 285 : LAPPEL=0 286 : ENDIF 287 : * 288 : ENDIF 289 : ENDIF 290 : * 291 : ITER=0 292 : * 293 : IF(IIMPI.EQ.42) THEN 294 : PRINT *,'PREMIERE ESTIMATION XX = ',XX 295 : ENDIF 296 : * 297 : * ITERATIONS 298 : * 299 : 100 CONTINUE 300 : ITER=ITER+1 301 : * 302 : * 303 : IF(ITER.GT.2500) THEN 304 : PRINT *,' 2500 ITERATIONS DANS OTTOXX' 305 : KERRE=1 306 : RETURN 307 : ENDIF 308 : DO I=1,6 309 : STOT(I)=SIG0(I)+XX*DSIGT(I) 310 : VAUX(I)=VAUX1(I)+XX*VAUX2(I) 311 : ENDDO 312 : * 313 : DO I=1,3 314 : DXVV(I)=DXV1(I)+XX*DXV2(I) 315 : ENDDO 316 : * 317 : * 318 : JCDUM(1)=JC 318 : CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT, 319 : & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ, 320 : & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE) 321 : IF(KERRE.NE.0) RETURN 322 : FF=FC2(JC) 323 : IF(ABS(FF).LT.PRECIZ) GO TO 200 324 : * 325 : IF(IIMPI.EQ.42) THEN 326 : ZOB1 = F1 327 : ZOB2 = F2 328 : ENDIF 329 : * 330 : IF(FF*F2.GE.0.D0) THEN 331 : XX2=XX 332 : F2=FF 333 : ELSE 334 : XX1=XX 335 : F1=FF 336 : ENDIF 337 : * 338 : XX= XX2 - F2*(XX2-XX1)/(F2-F1) 339 : * 340 : IF(IIMPI.EQ.42) THEN 341 : WRITE(IOIMP,75461) ITER, ZOB1,ZOB2,XX 342 : 75461 FORMAT( 2X, 'I=',I3,2X,'F1=',1PE12.5,2X, 343 : & 'F2=',1PE12.5,2X,'XX=',1PE12.5) 344 : ENDIF 345 : 346 : GO TO 100 347 : * 348 : 200 CONTINUE 349 : * 350 : IF(XX.LT.XXMIN) THEN 351 : XXMIN=XX 352 : ENDIF 353 : * 354 : ENDDO 355 : 356 : 357 : * 358 : * ON IMPRIME XXMIN 359 : * 360 : IF(IIMPI.EQ.42) THEN 361 : WRITE(IOIMP,73361) XXMIN 362 : 73361 FORMAT( 2X, ' OTTOXX APRES BOUCLE - XXMIN= ',1PE12.5/) 363 : ENDIF 364 : 365 : 366 : * 367 : * MISES A JOUR ( NCRIT ) 368 : * 369 : 370 : DO I=1,6 371 : STOT(I)=SIG0(I)+XXMIN*DSIGT(I) 372 : VAUX(I)=VAUX1(I)+XXMIN*VAUX2(I) 373 : ENDDO 374 : * 375 : DO I=1,3 376 : DXVV(I)=DXV1(I)+XXMIN*DXV2(I) 377 : ENDDO 378 : * 378 : CALL OTTOCE(MCA,MMA,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT, 379 : & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ, 380 : & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE) 381 : IF(KERRE.NE.0) RETURN 382 : DO IC=1,MCA 383 : JC=MMA(IC) 384 : * 385 : * TEST SUPPLEMENTAIRE 386 : * 387 : IF(FC2(JC).GT.PRECIZ) THEN 388 : PRINT *,'######### OTTOXX CRITERE INCOHERENT JC = ',JC 389 : PRINT *,' FC2 = ',FC2(JC), ' PRECIZ=',PRECIZ 390 : KERRE=2 391 : RETURN 392 : ENDIF 393 : * 394 : IF(ABS(FC2(JC)).LT.PRECIZ) THEN 395 : NCRIT=NCRIT+1 396 : JCRIT(NCRIT)=JC 397 : ENDIF 398 : ENDDO 399 : * 400 : 300 CONTINUE 401 : * 402 : ENDIF 403 : 404 : * 405 : * SORTIE 406 : * 407 : IF(IIMPI.EQ.42) THEN 408 : WRITE(IOIMP,77000) NCRIT,(JCRIT(I),I=1,NCRIT) 409 : 77000 FORMAT( 2X, ' OTTOXX - NCRIT =',I3,4X,'JCRIT = ',15I3/) 410 : WRITE(IOIMP,77001) XXMIN 411 : 77001 FORMAT( 2X, ' OTTOXX - XXMIN= ',1PE12.5/) 412 : ENDIF 413 : * 414 : RETURN 415 : END 416 : 417 : 418 : 419 : 420 : 421 : 422 : 423 : 424 :
© Cast3M 2003 - All rights reserved.
Disclaimer