1 : C OTTOCA SOURCE PV 05/11/30 21:15:39 5248 2 : C responsable MILLARD 3 : SUBROUTINE OTTOCA(SIG0,DEPST,W,WMAX,XLAMC, 4 : & SMAX,WRUPT,BILIN,SBILI,XLTR,XLCS,XINVL, 5 : & WREOUV,YOUN,XNU,GFTR,GFCS,G,GS,BTR,XCOMP, 6 : & NFISSU,NVF,VF,XX,IRESU,NRESU, 7 : & SIGF,DEFP,PRECIE,PRECIZ,MFR,KERRE) 8 : C---------------------------------------------------------------------- 9 : C ECOULEMENT OTTOSEN 10 : C---------------------------------------------------------------------- 11 : C 12 : C ENTREES : SIG0,DEPST,PRECIE,PRECIZ,MFR,KERRE 13 : C 14 : C SORTIES : SIGF,DEFP 15 : C 16 : C 17 : C RAPPEL : EN DEFO PLANES,CONTRAINTES PLANES OU AXI, 18 : C LA DIRECTION 1 EST CELLE PERPENDICULAIRE AU MAILLAGE 19 : C 20 : C----------------------------------------------------------------------- 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : -INC CCOPTIO 25 : * 26 : PARAMETER (XZER=0.D0,NC=4) 27 : 28 : DIMENSION SIG0(*),DEPST(*),SIGF(*),DEFP(*),XCOMP(*) 29 : DIMENSION STOT(6),SIGEL(6),DELAS(6),DEFPLA(6),DEPSTT(6) 30 : DIMENSION DSIGT(6) ,DDPLAS(6) 31 : DIMENSION SIG1(6) ,SIG2(6) 32 : DIMENSION SAUX(6) 33 : * 34 : DIMENSION DD(18),GS(3) 35 : DIMENSION W(3),WMAX(3),BILIN(3),WREOUV(3),SMAX0(3) 36 : DIMENSION WRUPT(3),XLTR(3),XINVL(3),SBILI(3),W0(3),WMAX0(3) 37 : DIMENSION VF(3,3),JFIS(3),DXV1(3),DXV2(3) 38 : * 39 : DIMENSION DDE(18) 40 : DIMENSION DEPST0(6) 41 : * 42 : DIMENSION SMAX(*),IRESU(*) 43 : * 44 : DIMENSION NN(NC),FC(NC),FC2(NC),FCC(NC) 45 : DIMENSION MM(20),MM2(20),FCV(20),FCV1(20) 46 : * 47 : DIMENSION PENTE( 6),LEBIL( 6),ISING(NC) 48 : DIMENSION IFERM(NC),IBRUP(NC) 49 : DIMENSION PENTE2( 6),LEBIL2( 6),ISING2(NC) 50 : DIMENSION AA(NC+1,NC+1),BB1(NC+1),BB2(NC+1) 51 : DIMENSION DFDS(6,NC),DGDS(6,NC),HDFDQ(NC) 52 : DIMENSION DX(NC+1),DDX(NC+1) 53 : DIMENSION VEC1(NC+1),VEC2(NC+1) 54 : DIMENSION VAUX1(6),VAUX2(6),VAUX(6) 55 : DIMENSION DFF(6),DGG(6) 56 : * 57 : DATA ITMAX/25/ 58 : DATA IRMAX/5/ 59 : * 60 : * INITIALISATIONS 61 : * 62 : IRED=0 63 : REFAC=1.D0 64 : * 65 : DO I=1,3 66 : W0(I)=W(I) 67 : WMAX0(I)=WMAX(I) 68 : WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I)) 69 : SMAX0(I)=SMAX(I) 70 : ENDDO 71 : XLAMC0=XLAMC 72 : * 73 : 74 : 888 CONTINUE 75 : 76 : * 77 : KERRE=0 78 : NC1=NC+1 79 : 80 : 81 : IRED=IRED+1 82 : IF(IRED.GT.IRMAX) THEN 83 : PRINT *,'&&&&&&&& OTTOCA IRED = ',IRED 84 : KERRE=2 85 : RETURN 86 : ENDIF 87 : * 88 : IF(IRED.GT.1) THEN 89 : DO I=1,3 90 : W(I)=W0(I) 91 : WMAX(I)=WMAX0(I) 92 : WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I)) 93 : SMAX(I)=SMAX0(I) 94 : ENDDO 95 : XLAMC=XLAMC0 96 : REFAC=REFAC*0.5D0 97 : ENDIF 98 : 99 : * 100 : * MATRICE ELASTIQUE 101 : * 101 : CALL OTTODD(DDE,YOUN,XNU,G,GS,XINVL,W) 102 : * 102 : CALL SHIFTD(DEPST,DEPSTT,6) 103 : 104 : DO I=1,6 105 : DEPSTT(I)=DEPSTT(I)*REFAC 106 : ENDDO 107 : 108 : * 109 : * SPECIAL CP 110 : * 111 : IF(IFOUR.EQ.-2) THEN 112 : DEPSTT(1)= (-DDE(6)*DEPSTT(2)-DDE(5)*DEPSTT(3))/DDE(1) 113 : ENDIF 114 : * 115 : * ON CALCULE L'INCREMENT DE CONTRAINTE EN ELASTIQUE 116 : * 116 : CALL OTTOPR(DDE,DEPSTT,DSIGT) 116 : CALL ZDANUL(PENTE,6 ) 116 : CALL ZDANUL(PENTE2,6 ) 116 : CALL IANUL(LEBIL,6 ) 116 : CALL IANUL(LEBIL2,6 ) 116 : CALL ZDANUL(AA,(NC+1)**2) 116 : CALL ZDANUL(BB1,NC+1) 116 : CALL ZDANUL(BB2,NC+1) 116 : CALL ZDANUL(DEFPLA,6) 116 : CALL ZDANUL(VAUX,6) 116 : CALL ZDANUL(VAUX1,6) 116 : CALL ZDANUL(VAUX2,6) 116 : CALL ZDANUL(DX,NC1) 116 : CALL ZDANUL(DXV1,3) 116 : CALL ZDANUL(DXV2,3) 116 : CALL IANUL(ISING2,NC) 117 : 118 : 119 : IF(IIMPI.EQ.42) THEN 120 : WRITE(IOIMP,76633) IRED,NFISSU,NVF,XLAMC,REFAC 121 : 76633 FORMAT(1X,' ENTREE DANS OTTOCA - IRED =',I4,2X, 122 : & ' NFISSU=',I4,2X,' NVF=',I4/ 123 : & 2X,'XLAMC=',1PE12.5,2X,' REFAC=',1PE12.5//) 124 : WRITE(IOIMP,74433) (DSIGT(I),I=1,6) 125 : 74433 FORMAT(1X,' DSIGT ',6(1X,1PE12.5)/) 126 : ENDIF 127 : 128 : * 129 : * write (6,*) ' pente avant ottoet dans ottoca ',(PENTE(IC),IC=1,4) 129 : CALL OTTOET(NC,NN,SIG0,W,WMAX,SMAX,BILIN,WRUPT,BTR, 130 : & XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2, 131 : & LEBIL,NFISSU,NVF,VF,FCV,PENTE,PENTE2, 132 : & DX,DXV1,YOUN,NCA,MC,MM,ISING,IFERM, 133 : & IBRUP,IPLAS,XCOMP,XLAMC,DFF,DGG,KERRE) 134 : IF(KERRE.NE.0) RETURN 135 : * write (6,*) ' pente apres ottoet dans ottoca ',(PENTE(IC),IC=1,4) 136 : 137 : * 138 : IF(IIMPI.EQ.42) THEN 139 : PRINT *,' IPLAS = ',IPLAS 140 : ENDIF 141 : 142 : * 143 : ICOCRI=0 144 : IF(ABS(FC(4)).LE.PRECIZ) ICOCRI=1 145 : 146 : * 147 : * 148 : IF(IPLAS.NE.0) GO TO 88 149 : * 150 : * 151 : * on essaye l'ecoulement elastique pur 152 : * ------------------------------------ 153 : * 154 : IF(IIMPI.EQ.42) THEN 155 : PRINT *,' ESSAI DU CAS ELASTIQUE' 156 : ENDIF 157 : 158 : * 159 : * MLR 9/7/99 160 : * 161 : ICOMEL=0 162 : IF(ABS(FC(4)).LE.PRECIZ) THEN 163 : 164 : IF(IIMPI.EQ.42) THEN 165 : WRITE(IOIMP,59502) (DSIGT(I),I=1,6) 166 : 59502 FORMAT(2X,' DSIGT ',6(1X,1PE12.5)/) 167 : WRITE(IOIMP,59503) (DFF(I),I=1,6) 168 : 59503 FORMAT(2X,' DFF ',6(1X,1PE12.5)/) 169 : ENDIF 170 : 171 : * 172 : TRA=0.D0 173 : DO I=1,6 174 : TRA = TRA + DFF(I)*DSIGT(I) 175 : ENDDO 176 : IF(IIMPI.EQ.42) THEN 177 : PRINT *,' ######## TRA = ',TRA 178 : ENDIF 179 : IF(TRA.LT.0.D0) ICOMEL=1 180 : ENDIF 181 : 182 : * 183 : * RETRAITEMENT DE MM SI IFERM=1 184 : * ET SI ICOMEL=0 185 : * 186 : MC2=0 187 : DO I=1,MC 188 : IF(MM(I).GE.4.AND.MM(I).LE.6) THEN 189 : IC=MM(I)-3 190 : IF(IFERM(IC).EQ.1) GO TO 101 191 : ENDIF 192 : * 193 : IF(MM(I).EQ.16.AND.ICOCRI.EQ.1.AND.ICOMEL.EQ.0) 194 : & GO TO 101 195 : * 196 : MC2=MC2+1 197 : MM2(MC2)=MM(I) 198 : 101 CONTINUE 199 : ENDDO 200 : 201 : * 202 : IF(IIMPI.EQ.42) THEN 203 : WRITE(IOIMP,49102) MC2 204 : 49102 FORMAT(2X,' NOUVELLE VALEUR MC2 = ',I3/) 205 : WRITE(IOIMP,49103) (MM2(IC),IC=1,MC2) 206 : 49103 FORMAT(2X,' NOUVELLE LISTE MM2'/16(1X,I3)/) 207 : ENDIF 208 : 209 : * 209 : CALL OTTOXX(MC2,MM2,SIG0,DSIGT,STOT, 210 : & VAUX1,VAUX2,VAUX,FCV,DX,DXV1,DXV2, 211 : & PRECIE,PRECIZ,BTR,YOUN, 212 : & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF, 213 : & XX,IRESU,NRESU,XCOMP,XLAMC,ICOMEL,LERED,KERRE) 214 : IF(KERRE.NE.0) RETURN 215 : * 216 : IF(IIMPI.EQ.42) THEN 217 : WRITE(IOIMP,44103) NRESU 218 : 44103 FORMAT(1X,' SORTIE DE OTTOXX NRESU=',I3/) 219 : WRITE(IOIMP,48103) (IRESU(I),I=1,NRESU) 220 : 48103 FORMAT(1X,' IRESU '/10I4/) 221 : PRINT *,'XX =',XX 222 : ENDIF 223 : * 224 : IF(NCA.EQ.0) THEN 225 : 226 : IF(IIMPI.EQ.42) THEN 227 : WRITE(IOIMP,77003) 228 : 77003 FORMAT(1X,' :::::::::::::::::::::::' / 229 : & 1X,' SORTIE ELASTIQUE ' / 230 : & 1X,' :::::::::::::::::::::::' /) 231 : ENDIF 232 : * 233 : IF(XX.LE.0.D0) THEN 234 : KERRE=2 235 : PRINT *,' XX EST NEGATIF OU NUL ' 236 : PRINT *,'XX=',XX 237 : RETURN 238 : ENDIF 239 : * 240 : GO TO 89 241 : 242 : ELSE 243 : * 243 : CALL IANUL(LEBIL2,NC) 244 : * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4) 245 : 245 : CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR, 246 : & XLTR,XINVL,SBILI,FCC,PENTE2,LEBIL2, 247 : & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) 248 : IF(KERRE.NE.0) RETURN 249 : * write (6,*) ' pente apres ottocr dans ottoca ',(PENTE(IC),IC=1,4) 250 : 251 : * 252 : IF(IIMPI.EQ.42) THEN 253 : WRITE(IOIMP,72093) (FCC(IJ),IJ=1,NC) 254 : 72093 FORMAT(1X,' FCC ',(4(1X,1PE12.5))/) 255 : ENDIF 256 : * 257 : IELAS=1 258 : DO IJ=1,NCA 259 : JJ=NN(IJ) 260 : IF (FCC(JJ).GT.PRECIZ) IELAS=0 261 : ENDDO 262 : * 263 : IF(IELAS.EQ.1) THEN 264 : 265 : IF(IIMPI.EQ.42) THEN 266 : WRITE(IOIMP,77003) 267 : ENDIF 268 : * 269 : GO TO 89 270 : ENDIF 271 : * 272 : ENDIF 273 : * 274 : * 275 : * cas de l'ecoulement elastoplastique 276 : * ----------------------------------- 277 : * 278 : 88 CONTINUE 279 : 280 : IF(IIMPI.EQ.42) THEN 281 : WRITE(IOIMP,70378) 282 : 70378 FORMAT(/2X,' ON ATTAQUE LE CAS PLASTIQUE '//) 283 : ENDIF 284 : 285 : * 286 : * INITIALISATIONS 287 : * 288 : ITER =0 289 : DO I=1,6 290 : DEPST0(I)=DEPSTT(I) 291 : STOT(I)=SIG0(I) 292 : ENDDO 293 : * 294 : DO I=1,NC 295 : ISING(I)=0 296 : IF(LEBIL(I).EQ.2) ISING(I)=1 297 : ENDDO 298 : * 299 : * write (6,*) ' pente avant ottoin dans ottoca ',(PENTE(IC),IC=1,4) 300 : 301 : IF(ISING(1)+ISING(2)+ISING(3).NE.0.OR. 302 : & (IFERM(4).EQ.1.AND.NCA.GE.2)) THEN 302 : CALL OTTOIN(ISING,IFERM,IBRUP,LEBIL,PENTE,PENTE2, 303 : & NCA,NN,MC,MM,STOT,DSIGT,DDE,GS,FC, 304 : & XINVL,SMAX,XLTR,PRECIZ,XCOMP,XLAMC,KERRE) 305 : IF(KERRE.NE.0) RETURN 306 : * write (6,*) ' pente apres ottoin dans ottoca ',(PENTE(IC),IC=1,4) 307 : 308 : ENDIF 309 : 310 : 311 : * 312 : 444 CONTINUE 313 : * 314 : IF(ITER.NE.0) THEN 315 : * 316 : IF(IIMPI.EQ.42) THEN 317 : WRITE(IOIMP,74078) 318 : 74078 FORMAT(/2X,' ON REINITIALISE LE PROCESSUS'//) 319 : ENDIF 320 : * 321 : DO I=1,6 322 : DEPSTT(I)=DEPST0(I) 323 : STOT(I)=SIG0(I) 324 : ENDDO 324 : CALL ZDANUL(DEFPLA,6) 324 : CALL ZDANUL(VAUX,6) 324 : CALL ZDANUL(VAUX1,6) 324 : CALL ZDANUL(VAUX2,6) 325 : * 326 : DO I=1,3 327 : IF (XINVL(I).NE.XZER) THEN 328 : W(I)=W0(I) 329 : WMAX(I)=WMAX0(I) 330 : WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I)) 331 : SMAX(I)=SMAX0(I) 332 : ENDIF 333 : ENDDO 334 : XLAMC=XLAMC0 335 : * 336 : ******* 337 : ******* REACTUALISATION DE DDE ? 337 : ******* CALL OTTODD(DDE,YOUN,XNU,G,GS,XINVL,W) 338 : ******* 339 : * 340 : * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4) 341 : 341 : CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR, 342 : & XLTR,XINVL,SBILI,FC,PENTE,LEBIL, 343 : & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) 344 : IF(KERRE.NE.0) RETURN 345 : * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4) 346 : * 347 : ENDIF 348 : 349 : * 350 : XX=0.D0 351 : DO IC=1,NC+1 352 : DX(IC)=0.D0 353 : DDX(IC)=0.D0 354 : ENDDO 355 : 356 : * 357 : * MLR 9/7/99 358 : * RETRAITEMENT DE MM SI ICOMPL=1 359 : * 360 : 361 : ICOMPL=0 362 : DO IJ=1,NCA 363 : IF(NN(IJ).EQ.4.AND.ICOCRI.EQ.1) ICOMPL=1 364 : ENDDO 365 : * 366 : 367 : MC2=0 368 : DO I=1,MC 369 : IF(ICOMPL.EQ.1.AND.MM(I).EQ.16) GO TO 102 370 : * 371 : MC2=MC2+1 372 : MM2(MC2)=MM(I) 373 : 102 CONTINUE 374 : ENDDO 375 : 376 : * 377 : * 378 : * ------------------------------- 379 : * | LES ITERATIONS INTERNES | 380 : * ------------------------------- 381 : 555 CONTINUE 382 : ITER=ITER+1 383 : IF(IIMPI.EQ.42) THEN 384 : WRITE(IOIMP,77888) ITER 385 : 77888 FORMAT(1X,' >>>>>>>>>>> OTTOCA - ITER =',I4/) 386 : ENDIF 387 : * 388 : IF(ITER.GT.ITMAX) THEN 389 : KERRE=2 390 : RETURN 391 : ENDIF 392 : * 392 : CALL SHIFTD(STOT,SIGEL,6) 392 : CALL ZDANUL(DDPLAS,6) 393 : 394 : IF(IIMPI.EQ.42) THEN 395 : WRITE(IOIMP,60081) (SIGEL(I),I=1,6) 396 : 60081 FORMAT(1X,' SIGEL '/(6(1X,1PE12.5))/) 397 : ENDIF 398 : * 399 : * write (6,*) ' pente avant ottofl dans ottoca ',(PENTE(IC),IC=1,4) 399 : CALL OTTOFL(NCA,NN,XINVL,PENTE,SIGEL,GS,SMAX,XLTR, 400 : & DFDS,DGDS,HDFDQ,XCOMP,XLAMC,PRECIE, 401 : & PRECIZ,KERRE) 402 : IF(KERRE.NE.0) RETURN 403 : * write (6,*) ' pente avant ottofl dans ottoca ',(PENTE(IC),IC=1,4) 404 : * 405 : * 406 : * 407 : * REMPLISSAGES 408 : * 409 : NDIM=NCA 410 : IF(IFOUR.EQ.-2) NDIM=NCA+1 411 : * 412 : IF(IIMPI.EQ.42) THEN 413 : WRITE(IOIMP,77010) NCA,NDIM 414 : 77010 FORMAT(5X,'NCA=',I3,2X,'NDIM =',I3/) 415 : WRITE(IOIMP,77018) (NN(IJ),IJ=1,NCA) 416 : 77018 FORMAT(5X,'NN ',5(1X,I3)) 417 : ENDIF 418 : * 419 : DO IJ=1,NCA 420 : * 421 : JJ=NN(IJ) 421 : CALL OTTOPR(DDE,DGDS(1,JJ),VAUX1) 422 : * 423 : DO IK=1,NCA 424 : JK=NN(IK) 425 : AA(IK,IJ)= SDOT(6,DFDS(1,JK),1,VAUX1,1) 426 : IF(IK.EQ.IJ) AA(IK,IJ)=AA(IK,IJ)-HDFDQ(JK) 427 : ENDDO 428 : BB1(IJ)=FC(JJ) 429 : BB2(IJ)=SDOT(6,DFDS(1,JJ),1,DSIGT,1) 430 : 431 : * 432 : * SPECIAL CP 433 : * 434 : IF(IFOUR.EQ.-2) THEN 435 : * LA COMPOSANTE EPS 33 EST EN POSITION 1 ( CF RAPPEL ) 436 : AA(IJ,NDIM)=-(DFDS(1,JJ)*DDE(1)+DFDS(2,JJ)*DDE(6) 437 : * +DFDS(3,JJ)*DDE(5)+DFDS(4,JJ)*DDE(10)) 438 : AA(NDIM,IJ)=VAUX1(1) 439 : ENDIF 440 : ENDDO 441 : 442 : * 443 : DO IK=1,NCA 444 : IF(AA(IK,IK).LT.0.D0) THEN 445 : PRINT *,' OTTOCA - TERME DIAGONAL NEGATIF' 446 : KERRE=61 447 : WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5) 448 : RETURN 449 : ENDIF 450 : ENDDO 451 : * 452 : IF(IFOUR.EQ.-2) THEN 453 : AA(NDIM,NDIM)=-DDE(1) 454 : BB1(NDIM)=SIGEL(1) 455 : BB2(NDIM)=DSIGT(1) 456 : ENDIF 457 : 458 : * 459 : * SPECIAL XX(N+1) 460 : * 461 : DO I=1,NDIM 462 : BB1(I)=BB1(I) - XX*BB2(I) 463 : ENDDO 464 : * 465 : IF(IIMPI.EQ.42) THEN 466 : WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5) 467 : 77011 FORMAT(5X,' MATRICE AA'/(5(1X,1PE12.5))) 468 : WRITE(IOIMP,77012) (BB1(I),I=1,5) 469 : 77012 FORMAT(5X,' VECTEUR BB1'/(5(1X,1PE12.5))) 470 : WRITE(IOIMP,70012) (BB2(I),I=1,5) 471 : 70012 FORMAT(5X,' VECTEUR BB2'/(5(1X,1PE12.5))) 472 : ENDIF 473 : * 474 : * RESOLUTION 475 : * 476 : KERRE=0 476 : CALL INVALM(AA,NC1,NDIM,KERRE,PRECIZ) 477 : IF(KERRE.NE.0) THEN 478 : RETURN 479 : ENDIF 480 : IF(IIMPI.EQ.42) THEN 481 : WRITE(IOIMP,77013) ((AA(I,J),J=1,5),I=1,5) 482 : 77013 FORMAT(5X,' MATRICE AA INVERSEE '/(5(1X,1PE12.5))) 483 : ENDIF 484 : * 484 : CALL MULMA2(VEC1,AA,BB1,NDIM,1,NDIM,NC1,NC1) 484 : CALL MULMA2(VEC2,AA,BB2,NDIM,1,NDIM,NC1,NC1) 485 : * 485 : CALL ZDANUL(VAUX1,6) 485 : CALL ZDANUL(VAUX2,6) 486 : * 487 : DO IJ=1,NCA 488 : JJ=NN(IJ) 489 : DO I=1,6 490 : VAUX1(I)=VAUX1(I)+DGDS(I,JJ)*VEC1(IJ) 491 : VAUX2(I)=VAUX2(I)+DGDS(I,JJ)*VEC2(IJ) 492 : ENDDO 493 : IF(JJ.LE.3) THEN 494 : DXV1(JJ)=VEC1(IJ) 495 : DXV2(JJ)=VEC2(IJ) 496 : ENDIF 497 : ENDDO 498 : * 499 : IF(IFOUR.EQ.-2) THEN 500 : VAUX1(1)=VAUX1(1)-VEC1(NDIM) 501 : VAUX2(1)=VAUX2(1)-VEC2(NDIM) 502 : ENDIF 503 : * 504 : 504 : CALL OTTOPR(DDE,VAUX1,SIG1) 504 : CALL OTTOPR(DDE,VAUX2,SIG2) 505 : 506 : IF(IIMPI.EQ.42) THEN 507 : WRITE(IOIMP,77081) (SIG1(I),I=1,6) 508 : 77081 FORMAT(5X,' VECTEUR SIG1'/(6(1X,1PE12.5))) 509 : WRITE(IOIMP,70082) (SIG2(I),I=1,6) 510 : 70082 FORMAT(5X,' VECTEUR SIG2'/(6(1X,1PE12.5))) 511 : ENDIF 512 : 513 : DO I=1,6 514 : SIG1(I)=SIGEL(I)-SIG1(I)-XX*DSIGT(I) 515 : SIG2(I)=DSIGT(I) - SIG2(I) 516 : ENDDO 517 : * 518 : IF(IIMPI.EQ.42) THEN 519 : WRITE(IOIMP,73312) (VEC1(I),I=1,5) 520 : 73312 FORMAT(5X,' VECTEUR VEC1'/(5(1X,1PE12.5))) 521 : WRITE(IOIMP,73313) (VEC2(I),I=1,5) 522 : 73313 FORMAT(5X,' VECTEUR VEC2'/(5(1X,1PE12.5))) 523 : WRITE(IOIMP,74412) (VAUX1(I),I=1,6) 524 : 74412 FORMAT(5X,' VECTEUR VAUX1'/(6(1X,1PE12.5))) 525 : WRITE(IOIMP,74413) (VAUX2(I),I=1,6) 526 : 74413 FORMAT(5X,' VECTEUR VAUX2'/(6(1X,1PE12.5))) 527 : WRITE(IOIMP,77014) (SIG1(I),I=1,6) 528 : 77014 FORMAT(5X,' VECTEUR SIG1'/(6(1X,1PE12.5))) 529 : WRITE(IOIMP,70014) (SIG2(I),I=1,6) 530 : 70014 FORMAT(5X,' VECTEUR SIG2'/(6(1X,1PE12.5))) 531 : ENDIF 532 : * 533 : * 534 : ICOMEL=0 534 : CALL OTTOCE(MC2,MM2,SIG1,DX,DXV1,W,WMAX,SMAX,WRUPT, 535 : & XLTR,XINVL,BTR,NFISSU,NVF,FCV1,VF,YOUN, 536 : & PRECIZ,JFIS,XCOMP,XLAMC,DFF,DGG,KERRE) 537 : IF(KERRE.NE.0) RETURN 538 : * 539 : * MLR 9/7/99 540 : * 541 : IF(ICOCRI.EQ.1.AND.ICOMPL.EQ.0.AND. 542 : & ABS(FCV1(16)).LE.PRECIZ) THEN 543 : ICOMEL=1 544 : ENDIF 545 : * 545 : CALL OTTOXX(MC2,MM2,SIG1,SIG2,STOT, 546 : & VAUX1,VAUX2,VAUX,FCV1,DX,DXV1,DXV2, 547 : & PRECIE,PRECIZ,BTR,YOUN, 548 : & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF, 549 : & XXX,IRESU,NRESU,XCOMP,XLAMC,ICOMEL,LERED,KERRE) 550 : * 551 : IF(KERRE.NE.0) RETURN 552 : IF(LERED.EQ.1) GO TO 888 553 : * 554 : DO IJ=1,NCA 555 : DDX(IJ)=VEC1(IJ)+XXX*VEC2(IJ) 556 : ENDDO 557 : * 558 : * TESTS 559 : * 560 : IF(XXX.LE.0.D0) THEN 561 : KERRE=2 562 : PRINT *,' XXX EST NEGATIF OU NUL ' 563 : RETURN 564 : ENDIF 565 : * 566 : * 567 : NCAA=0 568 : DO IJ=1,NCA 569 : JJ=NN(IJ) 570 : DXSOM=DX(JJ)+DDX(IJ) 571 : * 572 : IF(DXSOM.GE.0.D0) THEN 573 : NCAA=NCAA+1 574 : NN(NCAA)=JJ 575 : 576 : ELSE IF(DXSOM.LT.0.D0) THEN 577 : 578 : IF(LEBIL(JJ).EQ.1) THEN 579 : IF(IFERM(JJ).NE.1) THEN 580 : NCAA=NCAA+1 581 : NN(NCAA)=JJ 582 : * 583 : ELSE IF(IFERM(JJ).EQ.1) THEN 584 : IF(W0(JJ)+DXSOM/XINVL(JJ).GT.WREOUV(JJ)) THEN 585 : NCAA=NCAA+1 586 : NN(NCAA)=JJ 587 : ENDIF 588 : ENDIF 589 : * 590 : ENDIF 591 : ENDIF 592 : ENDDO 593 : * 594 : * 595 : IF(IIMPI.EQ.42) THEN 596 : WRITE(IOIMP,77008) NCA,NCAA,(NN(IJ),IJ=1,NCAA) 597 : 77008 FORMAT(5X,'NCA=',I3,2X,'NCAA=',I3/2X,'NN ' ,8I3/) 598 : WRITE(IOIMP,77607) (DDX(IJ),IJ=1,NC+1) 599 : 77607 FORMAT(5X,'DDX '/(8(1X,1PE12.5))/) 600 : ENDIF 601 : * 602 : * QUELQUES TESTS SUPPLEMENTAIRES 603 : * 604 : IF(NCAA.EQ.0) THEN 605 : IF(IIMPI.EQ.42) THEN 606 : PRINT *,' OTTOCA - NCAA EST NUL ' 607 : ENDIF 608 : GO TO 888 609 : ENDIF 610 : * 611 : * 612 : IF(NCA.NE.NCAA) THEN 613 : * 614 : IF(NCAA.GT.NCA) THEN 615 : KERRE=7 616 : PRINT *,' OTTOCA - NCAA EST SUPERIEUR A NCA ' 617 : RETURN 618 : ENDIF 619 : NCA=NCAA 620 : GO TO 444 621 : ENDIF 622 : * 623 : * ON ENQUILLE 624 : * 625 : XX=XXX 626 : DO IJ=1,NCA 627 : JJ=NN(IJ) 628 : DX(JJ)=DX(JJ)+DDX(IJ) 629 : DO I=1,6 630 : DDPLAS(I)=DDPLAS(I)+DGDS(I,JJ)*DDX(IJ) 631 : DEFPLA(I)=DEFPLA(I)+DGDS(I,JJ)*DDX(IJ) 632 : ENDDO 633 : * 634 : IF(JJ.EQ.4) THEN 635 : XLAMC=XLAMC0+DX(4) 636 : ENDIF 637 : ENDDO 638 : * 639 : DO I=1,3 640 : IF (XINVL(I).NE.XZER) W(I)=W0(I)+DX(I)/XINVL(I) 641 : IF (W(I).GT.WMAX0(I)) THEN 642 : IF(LEBIL(I).NE.1.OR.WMAX0(I).GE.WRUPT(I)) THEN 643 : WMAX(I)=W(I) 644 : WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I)) 645 : ENDIF 646 : ENDIF 647 : ENDDO 648 : * 649 : IF(IFOUR.EQ.-2) THEN 650 : DEPSTT(1)=DEPSTT(1)+DDX(NDIM) 651 : STOT(1)=STOT(1)-DDE(1)*DDX(NDIM) 652 : STOT(2)=STOT(2)-DDE(6)*DDX(NDIM) 653 : STOT(3)=STOT(3)-DDE(5)*DDX(NDIM) 654 : STOT(4)=STOT(4)-DDE(10)*DDX(NDIM) 655 : ENDIF 656 : * 657 : IF(IIMPI.EQ.42) THEN 658 : WRITE(IOIMP,77991) (DEFPLA(IJ),IJ=1,6) 659 : 77991 FORMAT(1X,' DEFPLA '/(6(1X,1PE12.5))/) 660 : WRITE(IOIMP,60091) (DDPLAS(IJ),IJ=1,6) 661 : 60091 FORMAT(1X,' DDPLAS '/(6(1X,1PE12.5))/) 662 : WRITE(IOIMP,60095) (DX(IJ),IJ=1,NC+1) 663 : 60095 FORMAT(1X,' DX '/(6(1X,1PE12.5))/) 664 : WRITE(IOIMP,60096) XLAMC 665 : 60096 FORMAT(1X,' XLAMC=',1PE12.5/) 666 : WRITE(IOIMP,60901) (W0(IJ),IJ=1,3) 667 : 60901 FORMAT(1X,' W0 '/(3(1X,1PE12.5))/) 668 : WRITE(IOIMP,70901) (W(IJ),IJ=1,3),(WMAX(IJ),IJ=1,3) 669 : 70901 FORMAT(1X,' W '/(3(1X,1PE12.5))/ 670 : & 1X,' WMAX '/(3(1X,1PE12.5))/) 671 : WRITE(IOIMP,70091) (STOT(IJ),IJ=1,6) 672 : 70091 FORMAT(1X,' ENFIN STOT '/(6(1X,1PE12.5))/) 673 : WRITE(IOIMP,70080) 674 : 70080 FORMAT(1X,' FIN DE L ITERATION - AVANT TESTS ' /) 675 : WRITE(IOIMP,77806) (STOT(I),I=1,6) 676 : 77806 FORMAT(1X,' STOT ' /(6(1X,1PE12.5))/) 677 : ENDIF 678 : 679 : * 680 : * TESTS DE CONVERGENCE 681 : * 682 : * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4) 683 : 683 : CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR, 684 : & XLTR,XINVL,SBILI,FC,PENTE,LEBIL, 685 : & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) 686 : IF(KERRE.NE.0) RETURN 687 : * write (6,*) ' pente apres ottocr dans ottoca ',(PENTE(IC),IC=1,4) 688 : * 689 : IF(IIMPI.EQ.42) THEN 690 : WRITE(IOIMP,77903) (LEBIL(IJ),IJ=1,NC) 691 : 77903 FORMAT(1X,' TESTS DE CONVERGENCE - SORTIE DE OTTOCR '/ 692 : & 2X,' LEBIL ' , (4(1X,I4))/) 693 : WRITE(IOIMP,77093) (FC(IJ),IJ=1,NC) 694 : 77093 FORMAT(1X,' FC ',(4(1X,1PE12.5))/) 695 : ENDIF 696 : * 697 : DO IJ=1,NCA 698 : JJ=NN(IJ) 699 : IF (ABS(FC(JJ)).GT.PRECIZ) GO TO 555 700 : ENDDO 701 : IF(IFOUR.EQ.-2) THEN 702 : IF(ABS(STOT(1)).GT.PRECIZ) GO TO 555 703 : ENDIF 704 : 705 : * 706 : * MISE A JOUR DE WMAX ET SMAX 707 : * 708 : DO I=1,3 709 : IF(W(I).GT.WMAX(I)) THEN 710 : WMAX(I)=W(I) 711 : * write (6,*) ' pente avant ottofu dans ottoca ',(PENTE(IC),IC=1,4) 712 : 712 : CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN, 713 : & SBILI,W,WMAX,SMAX,PENTE,I) 714 : * write (6,*) ' pente apres ottofu dans ottoca ',(PENTE(IC),IC=1,4) 715 : ENDIF 716 : 717 : ENDDO 718 : * 719 : * 720 : 89 CONTINUE 721 : * 722 : * 723 : * ENCORE QUELQUES TESTS 724 : * 724 : CALL OTTOVE(NRESU,IRESU,STOT,W,WMAX,WRUPT,SMAX, 725 : & BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA, 726 : & NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING, 727 : & XCOMP,XLAMC,KERRE) 728 : IF(KERRE.NE.0) RETURN 729 : 730 : * 731 : * SORTIE - REMPLISSAGE 732 : * 733 : DO I=1,6 734 : SIGF(I)=STOT(I) 735 : DEFP(I)=DEFPLA(I) 736 : ENDDO 737 : * 738 : 739 : XX=XX*REFAC 740 : * 741 : * 742 : IF(IIMPI.EQ.42) THEN 743 : WRITE(IOIMP,77895) (SIGF(IJ),IJ=1,6) 744 : 77895 FORMAT(1X,' OTTOCA - SIGF '/(6(1X,1PE12.5))/) 745 : WRITE(IOIMP,77896) (DEFP(IJ),IJ=1,6) 746 : 77896 FORMAT(1X,' OTTOCA - DEFP '/(6(1X,1PE12.5))/) 747 : ENDIF 748 : * 749 : RETURN 750 : END 751 : 752 : 753 : 754 : 755 :
© Cast3M 2003 - All rights reserved.
Disclaimer