1 : C OTTOIN SOURCE KK2000 05/06/23 21:15:02 5122 2 : SUBROUTINE OTTOIN(ISING,IFERM,IBRUP,LEBIL,PENTE,PENTE2, 3 : & NCA,NN,MC,MM,SIGEL,DSIGT,DDE,GS,FC, 4 : & XINVL,SMAX,XLTR,PRECIZ,XCOMP, 5 : & XLAMC,KERRE) 6 : C---------------------------------------------------------------------- 7 : C 8 : C ENTREES : SIG0,DEPST,PRECIZ,MFR,KERRE 9 : C 10 : C SORTIES : SIGF 11 : C 12 : C----------------------------------------------------------------------- 13 : C 14 : IMPLICIT INTEGER(I-N) 15 : IMPLICIT REAL*8(A-H,O-Z) 16 : -INC CCOPTIO 17 : * 18 : PARAMETER (XZER=0.D0,NC=6) 19 : 20 : DIMENSION SIGEL(*),DSIGT(*),DDE(*),XLTR(*),XCOMP(*) 21 : DIMENSION DSIG(6) ,DSIGP(6) 22 : DIMENSION SAUX(6),DDPLAS(6) 23 : * 24 : DIMENSION GS(3) 25 : DIMENSION XINVL(3),NSITUA(4) 26 : * 27 : DIMENSION DFF(6),DGG(6) 28 : * 29 : DIMENSION SMAX(*),ISING(*),IFERM(*),IBRUP(*) 30 : DIMENSION JESEC(4) 31 : * 32 : *ZZZZZZ ??? TAILLES A AJUSTER ? 33 : DIMENSION FC(NC),NN(NC),PENTE(NC),LEBIL(NC),NN2(NC) 34 : DIMENSION MM(*) 35 : DIMENSION LEBIL2(NC),PENTE2(NC),PENT(NC) 36 : DIMENSION AA(NC+1,NC+1),BB1(NC+1),BB2(NC+1) 37 : DIMENSION DX(NC+1),DDX(NC+1) 38 : DIMENSION VEC1(NC+1),VEC2(NC+1) 39 : DIMENSION DFDS(6,NC),DGDS(6,NC),HDFDQ(NC) 40 : DIMENSION LASIT(NC) 41 : DIMENSION VAUX1(6) 42 : * 43 : IF(IIMPI.EQ.42) THEN 44 : WRITE(IOIMP,74411) (ISING(IC),IC=1,NC), 45 : & (IFERM(IC),IC=1,NC), 46 : & (IBRUP(IC),IC=1,NC) 47 : 74411 FORMAT(5X,' ENTREE DANS OTTOIN - ISING = ',4I3, 48 : & 2X,'IFERM = ',4I3/2X,'IBRUP = ',4I3/) 49 : ENDIF 50 : * 51 : IF(IFERM(4).EQ.1.AND.ABS(FC(4)).GT.PRECIZ) THEN 52 : PRINT *,'OTTOIN - INCOHERENCE EN COMPRESSION ' 53 : KERRE=2 54 : RETURN 55 : ENDIF 56 : * 57 : * INITIALISATIONS 58 : * 59 : NC1=NC+1 60 : KERRE=0 60 : CALL SHIFTD(PENTE,PENT,6) 61 : PRECIE=1.D-10 62 : * 63 : * 64 : DO IC=1,4 65 : NSITUA(IC)=1 + ISING(IC) + IFERM(IC) + IBRUP(IC) 66 : * 67 : IF(NSITUA(IC).GT.2) THEN 68 : WRITE(IOIMP,74412) IC,ISING(IC),IFERM(IC),IBRUP(IC) 69 : 74412 FORMAT(2X,'####### CAS IMPOSSIBLE IC=',I3,2X, 70 : & 'ISING(IC)=',I3,2X,'IFERM(IC)=',I3,2X, 71 : & 'IBRUP(IC)=',I3/) 72 : KERRE=7 73 : RETURN 74 : ENDIF 75 : ENDDO 76 : 77 : * 78 : DO 21 I1=1,NSITUA(1) 79 : LASIT(1)=I1 80 : * 81 : DO 22 I2=1,NSITUA(2) 82 : LASIT(2)=I2 83 : * 84 : DO 23 I3=1,NSITUA(3) 85 : LASIT(3)=I3 86 : * 87 : DO 24 I4=1,NSITUA(4) 88 : LASIT(4)=I4 89 : * 90 : * TYPES 1 (ISING) ( IC=1 A 3 ) 91 : * 1 : PENTE2 (SECANTE) 92 : * 2 : PENTE 93 : * 94 : * TYPES 2 (IFERM) ( IC=1 A 4 ) 95 : * 1 : ELASTIQUE 96 : * 2 : PENTE SECANTE 97 : * 98 : * TYPES 3 (IBRUP) ( IC=1 A 3 ) 99 : * 1 : ELASTIQUE 100 : * 2 : PENTE 101 : * 102 : DO IC=1,3 103 : IF(LASIT(IC).EQ.2) THEN 104 : PENT(IC)=PENTE(IC) 105 : ELSE IF(LASIT(IC).EQ.1.AND.ISING(IC).EQ.1) THEN 106 : PENT(IC)=PENTE2(IC) 107 : ENDIF 108 : ENDDO 109 : * 110 : * 110 : CALL IANUL(JESEC,4) 111 : NCA2=0 112 : DO IJ=1,NCA 113 : JJ=NN(IJ) 114 : 115 : IF(LASIT(JJ).EQ.1) THEN 116 : IF(IFERM(JJ).NE.1.AND.IBRUP(JJ).NE.1) THEN 117 : NCA2=NCA2+1 118 : NN2(NCA2)=JJ 119 : ENDIF 120 : * 121 : ELSE IF(LASIT(JJ).EQ.2) THEN 122 : NCA2=NCA2+1 123 : NN2(NCA2)=JJ 124 : IF(IFERM(JJ).EQ.1.AND.JJ.LE.3) THEN 125 : JESEC(JJ)=1 126 : ENDIF 127 : ENDIF 128 : * 129 : ENDDO 130 : * 131 : IF(IIMPI.EQ.42) THEN 132 : WRITE(IOIMP,60080) I1,I2,I3,I4,NCA,NCA2 133 : 60080 FORMAT(//2X,' ******** SITUATION : I1 I2 I3 I4 ', 134 : & 4I3/2X,'NCA=',I3,2X,'NCA2=',I3/) 135 : ENDIF 136 : * 137 : IF(NCA2.EQ.0) THEN 138 : GO TO 55 139 : ENDIF 140 : * 141 : * INITIALISATIONS 142 : * 142 : CALL ZDANUL(VAUX1,6) 142 : CALL ZDANUL(DDPLAS,6) 143 : 144 : 145 : IF(IIMPI.EQ.42) THEN 146 : WRITE(IOIMP,60081) (SIGEL(I),I=1,6) 147 : 60081 FORMAT(2X,' SIGEL '/(6(1X,1PE12.5))/) 148 : ENDIF 149 : * 150 : * 150 : CALL OTTOFL(NCA2,NN2,XINVL,PENT,SIGEL,GS,SMAX,XLTR, 151 : & DFDS,DGDS,HDFDQ,XCOMP,XLAMC,PRECIE, 152 : & PRECIZ,KERRE) 153 : IF(KERRE.NE.0) RETURN 154 : * 155 : * 156 : NDIM=NCA2 157 : IF(IFOUR.EQ.-2) NDIM=NCA2+1 158 : * 159 : IF(IIMPI.EQ.42) THEN 160 : WRITE(IOIMP,77010) NCA2,NDIM 161 : 77010 FORMAT(5X,'NCA2=',I3,2X,'NDIM =',I3/) 162 : WRITE(IOIMP,77018) (NN2(IJ),IJ=1,NCA2) 163 : 77018 FORMAT(5X,'NN2 ',5(1X,I3)) 164 : ENDIF 165 : * 166 : DO IJ=1,NCA2 167 : * 168 : JJ=NN2(IJ) 168 : CALL OTTOPR(DDE,DGDS(1,JJ),VAUX1) 169 : * 170 : DO IK=1,NCA2 171 : JK=NN2(IK) 172 : AA(IK,IJ)= SDOT(6,DFDS(1,JK),1,VAUX1,1) 173 : IF(IK.EQ.IJ) AA(IK,IJ)=AA(IK,IJ)-HDFDQ(JK) 174 : ENDDO 175 : BB1(IJ)=FC(JJ) 176 : BB2(IJ)=SDOT(6,DFDS(1,JJ),1,DSIGT,1) 177 : 178 : * 179 : * SPECIAL CP 180 : * 181 : IF(IFOUR.EQ.-2) THEN 182 : AA(IJ,NDIM)=-(DFDS(1,JJ)*DDE(1)+DFDS(2,JJ)*DDE(6) 183 : * +DFDS(3,JJ)*DDE(5)+DFDS(4,JJ)*DDE(10)) 184 : AA(NDIM,IJ)=VAUX1(1) 185 : ENDIF 186 : ENDDO 187 : * 188 : IF(IFOUR.EQ.-2) THEN 189 : AA(NDIM,NDIM)=-DDE(1) 190 : BB1(NDIM)=SIGEL(1) 191 : BB2(NDIM)=DSIGT(1) 192 : ENDIF 193 : * 194 : * IF(IIMPI.EQ.42) THEN 195 : * WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5) 196 : *77011 FORMAT(5X,' MATRICE AA'/(5(1X,1PE12.5))) 197 : * WRITE(IOIMP,77012) (BB1(I),I=1,5) 198 : *77012 FORMAT(5X,' VECTEUR BB1'/(5(1X,1PE12.5))) 199 : * WRITE(IOIMP,70012) (BB2(I),I=1,5) 200 : *70012 FORMAT(5X,' VECTEUR BB2'/(5(1X,1PE12.5))) 201 : * ENDIF 202 : * 203 : * 204 : KERRE=0 204 : CALL INVALM(AA,NC1,NDIM,KERRE,PRECIZ) 205 : IF(KERRE.NE.0) THEN 206 : PRINT *,' MATRICE SINGULIERE DANS OTTOIN ' 207 : RETURN 208 : ENDIF 209 : * IF(IIMPI.EQ.42) THEN 210 : * WRITE(IOIMP,77113) ((AA(I,J),J=1,5),I=1,5) 211 : *77113 FORMAT(5X,' MATRICE AA INVERSEE '/(5(1X,1PE12.5))) 212 : * ENDIF 213 : * 213 : CALL MULMA2(VEC1,AA,BB1,NDIM,1,NDIM,NC1,NC1) 213 : CALL MULMA2(VEC2,AA,BB2,NDIM,1,NDIM,NC1,NC1) 214 : * 215 : DO IJ=1,NDIM 216 : DDX(IJ)=VEC1(IJ)+VEC2(IJ) 217 : ENDDO 218 : 219 : IF(IIMPI.EQ.42) THEN 220 : WRITE(IOIMP,77013) (DDX(IJ),IJ=1,NDIM) 221 : 77013 FORMAT(5X,' OTTOIN - DDX CALCULE'/(5(1X,1PE12.5))) 222 : ENDIF 223 : * 224 : * 225 : DO IJ=1,NCA2 226 : JJ=NN2(IJ) 227 : DO I=1,6 228 : DDPLAS(I)=DDPLAS(I)+DGDS(I,JJ)*DDX(IJ) 229 : ENDDO 230 : ENDDO 231 : * 231 : CALL OTTOPR(DDE,DDPLAS,DSIGP) 232 : * 233 : IF(IFOUR.EQ.-2) THEN 234 : DSIGP(1)=DSIGP(1)-DDE(1)*DDX(NDIM) 235 : DSIGP(2)=DSIGP(2)-DDE(6)*DDX(NDIM) 236 : DSIGP(3)=DSIGP(3)-DDE(5)*DDX(NDIM) 237 : DSIGP(4)=DSIGP(4)-DDE(10)*DDX(NDIM) 238 : ENDIF 239 : * 240 : DO I=1,6 241 : DSIG(I)=DSIGT(I)-DSIGP(I) 242 : ENDDO 243 : IF(IIMPI.EQ.42) THEN 244 : WRITE(IOIMP,79013) (DSIG(I),I=1,6) 245 : 79013 FORMAT(5X,' DSIG CALCULE '/(6(1X,1PE12.5))) 246 : ENDIF 247 : * 248 : * 249 : IFLAG=0 250 : DO IJ=1,NCA2 251 : JJ=NN2(IJ) 252 : IF(ISING(JJ).EQ.1) THEN 253 : IF(DSIG(JJ).GT.PRECIZ) IFLAG=1 254 : IF(PENT(JJ).EQ.PENTE(JJ).AND.DDX(IJ).LT.0.D0) IFLAG=1 255 : IF(PENT(JJ).EQ.PENTE2(JJ).AND.DDX(IJ).GT.0.D0) IFLAG=1 256 : ENDIF 257 : * 258 : IF(IFERM(JJ).EQ.1) THEN 259 : IF(DDX(IJ).LT.0.D0.OR.DSIG(JJ).LT.-PRECIZ) IFLAG=1 260 : ENDIF 261 : ENDDO 262 : * 263 : DO I=1,3 264 : IF(IFERM(I).EQ.1.AND.LASIT(I).EQ.1) THEN 265 : IF(DSIG(I).GT.PRECIZ) IFLAG=1 266 : ENDIF 267 : ENDDO 268 : * 269 : DO I=1,3 270 : IF(IBRUP(I).EQ.1.AND.LASIT(I).EQ.1) THEN 271 : IF(DSIG(I).GT.PRECIZ) IFLAG=1 272 : ENDIF 273 : ENDDO 274 : 275 : * 276 : * MLR 9/7/99 277 : * 278 : DO IJ=1,NCA 279 : JJ=NN(IJ) 280 : IF(JJ.EQ.4.AND.LASIT(4).EQ.1) THEN 280 : CALL OTTOCP(SIGEL,FCR4,XLTR,DFF,DGG,H4, 281 : & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE) 282 : * 283 : TRA = 0.D0 284 : DO I=1,6 285 : TRA = TRA + DFF(I)*DSIG(I) 286 : ENDDO 287 : IF(IIMPI.EQ.42) THEN 288 : WRITE(IOIMP,76621) TRA 289 : 76621 FORMAT(///2X,'OTTOIN ****** TRA = ',1PE12.5//) 290 : ENDIF 291 : IF(TRA.GT.PRECIZ) IFLAG=1 292 : ENDIF 293 : ENDDO 294 : * 295 : * 296 : IF(IFLAG.EQ.0) THEN 297 : DO IJ=1,NCA2 298 : JJ=NN2(IJ) 299 : IF(ISING(JJ).EQ.1) THEN 300 : IF(PENT(JJ).EQ.PENTE(JJ)) THEN 301 : ISING(JJ)=2 302 : LEBIL(JJ)=0 303 : ENDIF 304 : IF(PENT(JJ).EQ.PENTE2(JJ)) THEN 305 : ISING(JJ)=3 306 : LEBIL(JJ)=1 307 : ENDIF 308 : ENDIF 309 : ENDDO 310 : GO TO 99 311 : ENDIF 312 : 313 : * 314 : 55 CONTINUE 315 : * 316 : 24 CONTINUE 317 : * 318 : 23 CONTINUE 319 : * 320 : 22 CONTINUE 321 : * 322 : 21 CONTINUE 323 : 324 : 325 : * 326 : * EN CAS DE PROBLEME : 327 : * 328 : KERRE=7 329 : * VALEUR DE KERRE A AMELIORER 330 : * 331 : WRITE(IOIMP,73312) 332 : 73312 FORMAT(2X,'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ' / 333 : & 4X,'ATTENTION - OTTOIN - PAS DE SOLUTION ' / 334 : & 2X,'ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ'/) 335 : RETURN 336 : 337 : 338 : * 339 : 99 CONTINUE 340 : * 340 : CALL SHIFTD(PENT,PENTE,6) 341 : 342 : IF(IIMPI.EQ.42) THEN 343 : WRITE(IOIMP,70801) (PENTE(I),I=1,NC) 344 : 70801 FORMAT(///2X,'OTTOIN SORTIE - PENTE '/(4(1X,1PE12.5)/)) 345 : WRITE(IOIMP,76802) (LEBIL(I),I=1,NC) 346 : 76802 FORMAT(/2X,'OTTOIN SORTIE - LEBIL '/(4I5/)) 347 : WRITE(IOIMP,76803) (ISING(I),I=1,NC) 348 : 76803 FORMAT(/2X,'OTTOIN SORTIE - ISING '/(4I5/)) 349 : ENDIF 350 : * 351 : * RETRAITEMENT 352 : * 353 : NCA=NCA2 354 : DO I=1,NCA 355 : NN(I)=NN2(I) 356 : ENDDO 357 : * 358 : MC2=0 359 : DO I=1,MC 360 : * 361 : * TYPES 1 362 : * 363 : IF(MM(I).GE.7.AND.MM(I).LE.9) THEN 364 : IC=MM(I)-6 365 : IF(ISING(IC).EQ.3) GO TO 101 366 : ENDIF 367 : 368 : IF(MM(I).GE.13.AND.MM(I).LE.15) THEN 369 : IC=MM(I)-12 370 : IF(ISING(IC).EQ.2) GO TO 101 371 : ENDIF 372 : * 373 : * TYPES 2 374 : * 375 : IF(MM(I).GE.4.AND.MM(I).LE.6) THEN 376 : IC=MM(I)-3 377 : IF(IFERM(IC).EQ.1.AND.JESEC(IC).EQ.0) GO TO 101 378 : ENDIF 379 : * 380 : MC2=MC2+1 381 : MM(MC2)=MM(I) 382 : 101 CONTINUE 383 : ENDDO 384 : MC=MC2 385 : 386 : IF(IIMPI.EQ.42) THEN 387 : WRITE(IOIMP,44102) NCA 388 : 44102 FORMAT(2X,'OTTOIN - NOUVELLE VALEUR NCA =',I3/) 389 : WRITE(IOIMP,44103) (NN(IC),IC=1,NCA) 390 : 44103 FORMAT(2X,'OTTOIN - NOUVELLE LISTE NN '/16(1X,I3)/) 391 : WRITE(IOIMP,49102) MC 392 : 49102 FORMAT(2X,'OTTOIN - NOUVELLE VALEUR MC =',I3/) 393 : WRITE(IOIMP,49103) (MM(IC),IC=1,MC) 394 : 49103 FORMAT(2X,'OTTOIN - NOUVELLE LISTE MM '/16(1X,I3)/) 395 : ENDIF 396 : 397 : 398 : RETURN 399 : END 400 : 401 : 402 : 403 : 404 : 405 : 406 : 407 : 408 :
© Cast3M 2003 - All rights reserved.
Disclaimer