1 : C EXCELL SOURCE CHAT 05/01/12 23:48:12 5004 2 : SUBROUTINE EXCELL 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : -INC CCOPTIO 6 : -INC CCREEL 7 : -INC TMXMAT 8 : -INC SMLREEL 9 : -INC SMLENTI 10 : -INC SMTABLE 11 : segment ibo 12 : integer ibon(n) 13 : endsegment 14 : LOGICAL PDR,RSPB,RSPD,TEST,ILOG1,ILOG2,TERMIN 15 : SEGMENT MBI 16 : INTEGER MBID(NN) 17 : ENDSEGMENT 18 : SEGMENT RBI 19 : REAL*8 RBID(NN) 20 : ENDSEGMENT 21 : LOGICAL LOGIN,LOGRE 22 : CHARACTER*8 TYPOBJ 23 : CHARACTER*1 CHARIN,CHARRE 24 : CHARACTER*3 CMETH 25 : POINTEUR MLREE4.MLREEL,mlent5.mlenti,mlree5.mlreel,mlree6.mlreel 26 : DELTA0=50.D0 27 : XSMAX=500.D0 28 : IPASS=1 29 : IPART=0 30 : MAXITE=100 31 : ITTER=0 32 : ITISAV=0 33 : ITKSAV=0 34 : IVGP=0 35 : IVGM=0 36 : IVGE=0 37 : IVLAMB=0 38 : IVXU=0 39 : IVXL=0 40 : IVU=0 41 : IVN=0 42 : IVD=0 43 : IS0=0 44 : IT0=0 45 : MLAM1=0 46 : IVGP=0 47 : IVGE=0 48 : IVGM=0 49 : IPBASP=0 50 : * 51 : * 52 : *TAB = EXCELL TAB ; 53 : * 54 : * 54 : CALL LIROBJ('TABLE',ITAB,1,IRETOU) 55 : IF(IERR.NE.0) RETURN 56 : * 57 : * 58 : * TRANSFORMATION DES INFORMATIONS DES TABLES EN SEGMENT 59 : * 60 : * REEL ( VECTEUR) OU MXMAT ( MATRICE) LES VALEURS .0 61 : * SONT MISES DANS DES VARIABLES SEPAREES 62 : * 63 : * 64 : * VARIABLES X INITIALES 65 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES X'')') 66 : TYPOBJ='TABLE' 66 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN, 67 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 68 : IF(IERR.NE.0) GO TO 1000 69 : N=0 69 : CALL TABVEC(ITABLE,IVX0,N) 70 : IF(IERR.NE.0) RETURN 71 : * DERIVEES DE F PAR RAPPORT A X. PUIS VALEUR DE F INITIALE 72 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS VF'')') 73 : TYPOBJ='TABLE' 73 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VF',LOGIN,IOBIN, 74 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 75 : IF(IERR.NE.0) GO TO 1000 75 : CALL TABVEC(ITABLE,IVF,N) 76 : IF(IERR.NE.0) RETURN 77 : TYPOBJ='FLOTTANT' 78 : I = 0 78 : CALL ACCTAB(ITABLE,'ENTIER ',I,XVALIN,CHARIN,LOGIN,IOBIN, 79 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 80 : * 81 : ** verification que pas de derivée nulle 82 : * 83 : mlree5=ivf 84 : segact mlree5 85 : segini ibo 86 : nsup=0 87 : xgr= 0. 88 : do iou=1,n 89 : if( abs(mlree5.prog(iou)).gt.xgr) xgr = abs(mlree5.prog(iou)) 90 : enddo 91 : epscri= xgr * 1.e-30 92 : do iou=1,n 93 : if( abs(mlree5.prog(iou)).gt.0.d0) then 94 : ibon(iou)=1 95 : else 96 : ibon(iou)=0 97 : * on debranche pour l'instant car pose probleme pour les reprises 98 : * nsup=nsup+1 99 : endif 100 : enddo 101 : * elimination des pas bonnes et recopie des anciennes dans mlree6 102 : if(nsup.ne.0)then 103 : jg=n 104 : mlree5=ivx0 105 : mlree4=ivf 106 : segact mlree5,mlree4 107 : segini mlree6 108 : jg= n - nsup 109 : segini mlreel,mlree2 110 : ia = 0 111 : do iou=1,n 112 : mlree6.prog(iou)=mlree5.prog(iou) 113 : if( ibon(iou).eq.1) then 114 : ia = ia + 1 115 : prog(ia)=mlree5.prog(iou) 116 : mlree2.prog(ia)=mlree4.prog(iou) 117 : endif 118 : enddo 119 : ivx0=mlreel 120 : ivf=mlree2 121 : segdes mlree5,mlree4 122 : nvr = n - nsup 123 : write(6,*) ' nombre de variables non prises en compte ' , nsup 124 : endif 125 : IF(IERR.NE.0) GO TO 1000 126 : VF0=XVALRE 127 : * DERIVEES DES CJ PAR RAPPORT A X LE CJ0 SONT EN INDICE 0 ET SONT 128 : * RECUPERES JUSTE APRES 129 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS MC'')') 130 : TYPOBJ='TABLE' 130 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'MC',LOGIN,IOBIN, 131 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 132 : IF(IERR.NE.0) GO TO 1000 133 : M = 0 134 : if (iimpi.eq.1799) write (6,*) ' appel a tabmat(ITABLE,MC,M,N)' 134 : CALL TABMAT(ITABLE,MC,M,N) 135 : IF(IERR.NE.0) RETURN 136 : MXMAT=MC 137 : SEGACT MXMAT*MOD 138 : if(nsup.ne.0) then 139 : ldim2 = nvr 140 : ldim1=xmat(/1) 141 : segini mxma1 142 : do iou=1,ldim1 143 : ia = 0 144 : do iyo=1,n 145 : if(ibon(iyo).eq.1) then 146 : ia=ia+1 147 : mxma1.xmat(iou,ia)=xmat(iou,iyo) 148 : endif 149 : enddo 150 : enddo 151 : segsup mxmat 152 : mxmat=mxma1 153 : mc=mxmat 154 : if( iimpi.eq.1799) then 155 : write(6,*) ' pointeur de mc ldim1 ldim2 ',mc,xmat(/1),xmat(/2) 156 : write(6,*) ' mc' , ( xmat(1,iou),iou=1,xmat(/2)) 157 : endif 158 : endif 159 : JG=XMAT(/1) 160 : SEGINI MLREEL 161 : IMC0=MLREEL 162 : DO 1 J=1,JG 163 : TYPOBJ=' ' 163 : CALL ACCTAB(ITABLE,'ENTIER ',J,XVALIN,CHARIN,LOGIN,IOBIN, 164 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBR) 165 : IF(TYPOBJ.NE.'TABLE ') GO TO 1 166 : I= 0 167 : TYPOBJ='FLOTTANT' 167 : CALL ACCTAB(IOBR,'ENTIER ',I,XVALIN,CHARIN,LOGIN,IOBIN, 168 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE) 169 : PROG(J)=XVALRE 170 : 1 CONTINUE 171 : SEGDES MLREEL 172 : * VALEURS MINIMALES DES VARIABLES X 173 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS MINI DE X '')') 174 : TYPOBJ='TABLE' 174 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXMIN',LOGIN,IOBIN, 175 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 176 : IF(IERR.NE.0) GO TO 1000 176 : CALL TABVEC(ITABLE,IVXMIN,N) 177 : if(nsup.ne.0) then 178 : mlree4=ivxmin 179 : segact mlree4 180 : jg=nvr 181 : segini mlree5 182 : ia=0 183 : do iou=1,n 184 : if(ibon(iou).eq.1) then 185 : ia=ia+1 186 : mlree5.prog(ia)=mlree4.prog(iou) 187 : endif 188 : enddo 189 : segsup mlree4 190 : ivxmin=mlree5 191 : endif 192 : IF(IERR.NE.0) RETURN 193 : * VALEURS MAXIMALES DES VARIABLES X 194 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS MAXI DE X '')') 195 : TYPOBJ='TABLE' 195 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXMAX',LOGIN,IOBIN, 196 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 197 : IF(IERR.NE.0) GO TO 1000 197 : CALL TABVEC(ITABLE,IVXMAX,N) 198 : if(nsup.ne.0) then 199 : mlree4=ivxmax 200 : segact mlree4 201 : jg=nvr 202 : segini mlree5 203 : ia=0 204 : do iou=1,n 205 : if(ibon(iou).eq.1) then 206 : ia=ia+1 207 : mlree5.prog(ia)=mlree4.prog(iou) 208 : endif 209 : enddo 210 : segsup mlree4 211 : ivxmax=mlree5 212 : endif 213 : IF(IERR.NE.0) RETURN 214 : * VALEURS MAXIMALES DES CONTRAINTES CJ 215 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEURS MAXI DE CJ '')') 216 : TYPOBJ='TABLE' 216 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VCMAX',LOGIN,IOBIN, 217 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 218 : IF(IERR.NE.0) GO TO 1000 218 : CALL TABVEC(ITABLE,IVCMAX,M) 219 : IF(IERR.NE.0) RETURN 220 : * VALEURS DES VARIABLES DISCRETES 221 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE MVD '')') 222 : TYPOBJ=' ' 222 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VDIS',LOGIN,IOBIN, 223 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 224 : NVD=0 225 : NNVD=0 225 : IF( ITABLE.NE.0) CALL TABMAT(ITABLE,MVD,NVD,NNVD) 226 : IF(IERR.NE.0) RETURN 227 : IF(NVD.NE.0)THEN 228 : MXMAT=MVD 229 : if(nsup.ne.0) then 230 : ldim2 = nvr 231 : ldim1=xmat(/1) 232 : segini mxma1 233 : do iou=1,ldim1 234 : ia = 0 235 : do iyo=1,n 236 : if(ibon(iyo).eq.1) then 237 : ia=ia+1 238 : mxma1.xmat(iou,ia)=xmat(iou,iyo) 239 : endif 240 : enddo 241 : enddo 242 : segsup mxmat 243 : mxmat=mxma1 244 : mvd=mxmat 245 : endif 246 : ENDIF 247 : * ITERATION IP 248 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='(''VALEUR DE IP '')') 249 : TYPOBJ=' ' 249 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'IP',LOGIN,IOBIN, 250 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 251 : IF(TYPOBJ.EQ.'ENTIER ') THEN 252 : IP=IVALRE 253 : ELSE 254 : IP=1 255 : ENDIF 256 : * valeur de delta0 257 : TYPOBJ=' ' 257 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'DELTA0',LOGIN,IOBIN, 258 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 259 : IF(TYPOBJ.EQ.'ENTIER ') THEN 260 : DELTA0=IVALRE 261 : ENDIF 262 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 263 : DELTA0=XVALRE 264 : ENDIF 265 : * valeur de xsmax 266 : TYPOBJ=' ' 266 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'XSMAX',LOGIN,IOBIN, 267 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 268 : IF(TYPOBJ.EQ.'ENTIER ') THEN 269 : XSMAX=IVALRE 270 : ENDIF 271 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 272 : XSMAX=XVALRE 273 : ENDIF 274 : * valeur de maxite 275 : TYPOBJ=' ' 275 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'MAXITERATION',LOGIN, 276 : * IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 277 : IF(TYPOBJ.EQ.'ENTIER ') THEN 278 : MAXITE=IVALRE 279 : ENDIF 280 : * LECTURE DE L'OPTION CHOISIE 281 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' OPTION CHOISIE '')') 282 : TYPOBJ=' ' 282 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'METHODE',LOGIN,IOBIN, 283 : * TYPOBJ,IVALRE,XVALRE,CMETH,LOGRE,ITABLE) 284 : IMETH=1 285 : IF(TYPOBJ.EQ.'MOT ') THEN 286 : IF(CMETH.EQ.'MOV') IMETH=2 287 : IF(CMETH.EQ.'LIN') IMETH=3 288 : ENDIF 289 : * 290 : * POINTS PRECEDENTS 291 : * LIMITES PRECEDENTES 292 : IF(IP.EQ.1) THEN 293 : JG=N+1 294 : SEGINI MLREEL,MLREE1 295 : IVXPR1=MLREEL 296 : IVXPR2=MLREE1 297 : SEGINI MLREE2,MLREE3 298 : IVLL=MLREE2 299 : IVUL=MLREE3 300 : ELSE 301 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP1'')') 302 : TYPOBJ='TABLE' 302 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN, 303 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 304 : IF(IERR.NE.0) GO TO 1000 304 : CALL TABVEC(ITABLE,IVXPR1,N) 305 : IF(IERR.NE.0) RETURN 306 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES XP2'')') 307 : TYPOBJ='TABLE' 307 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN, 308 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 309 : IF(IERR.NE.0) GO TO 1000 309 : CALL TABVEC(ITABLE,IVXPR2,N) 310 : IF(IERR.NE.0) RETURN 311 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VUL '')') 312 : TYPOBJ='TABLE' 312 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN, 313 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 314 : IF(IERR.NE.0) GO TO 1000 314 : CALL TABVEC(ITABLE,IVUL,N) 315 : IF(IERR.NE.0) RETURN 316 : JG=N+1 317 : MLREEL=IVUL 318 : SEGADJ MLREEL 319 : IF(IERR.NE.0) RETURN 320 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VARIABLES VLL '')') 321 : TYPOBJ='TABLE' 321 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN, 322 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 323 : IF(IERR.NE.0) GO TO 1000 323 : CALL TABVEC(ITABLE,IVLL,N) 324 : IF(IERR.NE.0) RETURN 325 : JG=N+1 326 : MLREEL=IVLL 327 : SEGADJ MLREEL 328 : ENDIF 329 : * 330 : * VERIFICATION DU POINT DE DEPART 331 : * 332 : MLREEL=IVX0 333 : MLREE1=IVXMAX 334 : MLREE2=IVXMIN 335 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 336 : JG=PROG(/1) 337 : N=jg 338 : DO 64 I=1,JG 339 : PROD=(MLREE1.PROG(I)-PROG(I))*(MLREE2.PROG(I)-PROG(I)) 340 : aux=1d0+abs(MLREE2.PROG(I))+abs(MLREE1.PROG(I)) 341 : prod=prod/aux 342 : IF(PROD.GT.1D-4) THEN 343 : WRITE(6,63) 344 : WRITE(6,'(''!!LE POINT DE DEPART EST HORS-DOMAINE!!!'')') 345 : WRITE(6,63) 346 : 63 FORMAT('!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!') 347 : GOTO 1000 348 : ENDIF 349 : 64 CONTINUE 350 : * 351 : * calcu des Dj qui permettent de respecter les contraintes 352 : * en supposant que variable de relaxation egale DELTA0 353 : * 354 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE WD '')') 355 : MLREEL=IVCMAX 356 : MLREE1=IMC0 357 : SEGACT MLREEL*MOD,MLREE1*MOD 358 : JG=M 359 : SEGINI MLREE2 360 : IWD=MLREE2 361 : DO 17 K=1,M 362 : Z=MLREE1.PROG(K)-PROG(K) 363 : IF(Z.GT.1.D-20) THEN 364 : MLREE2.PROG(K)=Z/(1.-1./DELTA0) 365 : IF(IIMPI.GT.0) 366 : * WRITE(IOIMP,FMT='('' contrainte '',i3,'' pas satisfaite'')')K 367 : ELSE 368 : MLREE2.PROG(K)=0.D0 369 : ENDIF 370 : 17 CONTINUE 371 : * 372 : * introduction de la variable de relaxation 373 : * 374 : N11 = N + 1 375 : * dans X0 376 : MLREEL = IVX0 377 : SEGACT MLREEL*MOD 378 : JG=PROG(/1) + 1 379 : IF(JG.NE.N11) GO TO 1000 380 : SEGADJ MLREEL 381 : PROG(JG)=DELTA0 382 : SEGDES MLREEL 383 : * dans Xmin 384 : MLREEL=IVXMIN 385 : SEGACT MLREEL*MOD 386 : JG=PROG(/1) + 1 387 : IF(JG.NE.N11) GO TO 1000 388 : SEGADJ MLREEL 389 : PROG(JG)=1.D0 390 : SEGDES MLREEL 391 : * dans Xmax 392 : MLREEL=IVXMAX 393 : SEGACT MLREEL*MOD 394 : JG=PROG(/1) + 1 395 : IF(JG.NE.N11) GO TO 1000 396 : SEGADJ MLREEL 397 : PROG(JG)=XSMAX 398 : SEGDES MLREEL 399 : * dans les derivees de F 400 : MLREEL=IVF 401 : SEGACT MLREEL*MOD 402 : JG=PROG(/1) + 1 403 : IF(JG.NE.N11) GO TO 1000 404 : SEGADJ MLREEL 405 : PROG(JG)=2. ** IP * (ABS(VF0)) 406 : SEGDES MLREEL 407 : * dans f(x0) contenu dans la variable VF0 408 : VF0 = VF0 + 2. ** IP * (ABS( VF0)) * DELTA0 409 : * dans les derivees de CJ 410 : MXMAT=MC 411 : MLREEL=IWD 412 : SEGACT MLREEL*MOD,MXMAT*MOD 413 : LDIM2=XMAT(/2)+1 414 : LDIM1=XMAT(/1) 415 : if( iimpi.eq.1799) then 416 : write(6,*) ' mc pointeur ' , mc 417 : write(6,*) ' ldim1 ldim2 apres var relax',ldim1,ldim2 418 : endif 419 : SEGADJ MXMAT 420 : DELT=-1. / ( DELTA0 * DELTA0) 421 : DO 702 I=1,XMAT(/1) 422 : XMAT(I,LDIM2)=PROG(I)* DELT 423 : 702 CONTINUE 424 : SEGDES MLREEL,MXMAT 425 : * dans Cjmax 426 : MLREEL=IVCMAX 427 : MLREE1=IWD 428 : SEGACT MLREEL*MOD,MLREE1*MOD 429 : DO 703 I=1,PROG(/1) 430 : PROG(I)=PROG(I) + MLREE1.PROG(I) 431 : 703 CONTINUE 432 : SEGDES MLREEL,MLREE1 433 : * dans cj0 434 : MLREEL=IMC0 435 : MLREE1=IWD 436 : SEGACT MLREEL*MOD,MLREE1*MOD 437 : DO 707 I=1,PROG(/1) 438 : PROG(I)=PROG(I) - MLREE1.PROG(I)/DELTA0 439 : 707 CONTINUE 440 : SEGDES MLREEL,MLREE1 441 : * 442 : TYPOBJ=' ' 442 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'PREC',LOGIN,IOBIN, 443 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 444 : 445 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 446 : XPREC=XVALRE 447 : ELSEIF(TYPOBJ.EQ.'ENTIER ') THEN 448 : XPREC=IVALRE 449 : ELSE 450 : XPREC=500d0 451 : ENDIF 452 : * 453 : * INTRODUCTION DES MOVE-LIMITS 454 : * 455 : IF (IMETH.EQ.1) THEN 456 : TYPOBJ=' ' 456 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'T0',LOGIN,IOBIN, 457 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 458 : IF(TYPOBJ.EQ.'TABLE ') THEN 458 : CALL TABVEC(ITABLE,IT0,N11) 459 : IF(IERR.NE.0) RETURN 460 : ELSE 461 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 462 : XT0=XVALRE 463 : ELSEIF(TYPOBJ.EQ.'ENTIER ') THEN 464 : XT0=IVALRE 465 : ELSE 466 : XT0=0.333333d0 467 : ENDIF 468 : JG=N11 469 : SEGINI MLREEL 470 : IT0=MLREEL 471 : DO 704 I=1,JG 472 : PROG(I)=XT0 473 : 704 CONTINUE 474 : ENDIF 475 : ENDIF 476 : IF (IMETH.EQ.2) THEN 477 : TYPOBJ=' ' 477 : CALL ACCTAB(ITAB,'MOT ',IVALIN,XVALIN,'S0',LOGIN,IOBIN, 478 : * TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,ITABLE) 479 : IF(TYPOBJ.EQ.'TABLE') THEN 479 : CALL TABVEC(ITABLE,IS0,N11) 480 : IF(IERR.NE.0) RETURN 481 : ELSE 482 : IF(TYPOBJ.EQ.'FLOTTANT') THEN 483 : XS0=XVALRE 484 : ELSEIF(TYPOBJ.EQ.'ENTIER ') THEN 485 : XS0=IVALRE 486 : ELSE 487 : XS0=0.7d0 488 : ENDIF 489 : JG=N11 490 : SEGINI MLREEL 491 : IS0=MLREEL 492 : DO 705 I=1,JG 493 : PROG(I)=XS0 494 : 705 CONTINUE 495 : ENDIF 496 : ENDIF 497 : 497 : CALL CHGLIM(IVX0,IVXMIN,IVXMAX,IVXPR1,IVXPR2,N11,IP, 498 : * IVLL,IVUL,IVMIN,IVMAX,IMETH,IT0,IS0,XSMAX) 499 : * 500 : * SAUVEGARDE DES DERNIERES VALEURS DE VX0 501 : * 502 : MLREEL=IVX0 503 : MLREE1=IVXPR1 504 : MLREE2=IVXPR2 505 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 506 : DO 51 I=1,N 507 : MLREE2.PROG(I)=MLREE1.PROG(I) 508 : MLREE1.PROG(I)=PROG(I) 509 : 51 CONTINUE 510 : * 511 : * MODIFICATION DE LA VALEUR DE X 512 : * 513 : MLREEL=IVX0 514 : MLREE1=IVUL 515 : MLREE2=IVLL 516 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 517 : JG=PROG(/1) 518 : SEGINI MLREE3,MLREE4 519 : IVX0U=MLREE3 520 : IVX0L=MLREE4 521 : DO 52 I=1,JG 522 : MLREE3.PROG(I)=MLREE1.PROG(I)-PROG(I) 523 : MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I) 524 : 52 CONTINUE 525 : IF(IIMPI.EQ.1799) WRITE(IOIMP,57)(MLREE3.PROG(K),K=1,N11) 526 : 57 FORMAT(' VALEUR DE DEPART EN VX0U : ',/,(1X,5E12.5)) 527 : IF(IIMPI.EQ.1799) WRITE(IOIMP,58)(MLREE4.PROG(K),K=1,N11) 528 : 58 FORMAT(' VALEUR DE DEPART EN VX0L : ',/,(1X,5E12.5)) 529 : * 530 : * LINEARISATIONS CONVEXE DE F 531 : * 532 : MLREEL=IVF 533 : MLREE1=IVX0U 534 : MLREE2=IVX0L 535 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 536 : JG = PROG(/1) 537 : SEGINI,MLREE3 538 : IVFP=MLREE3 539 : SEGINI,MLREE4 540 : IVFQ=MLREE4 541 : DO 3 I=1,JG 542 : IF(PROG(I).GT.0.D0) THEN 543 : MLREE3.PROG(I)=PROG(I)*(MLREE1.PROG(I)**2) 544 : ELSE 545 : MLREE4.PROG(I)=ABS(PROG(I))*(MLREE2.PROG(I)**2) 546 : ENDIF 547 : 3 CONTINUE 548 : IF(IIMPI.EQ.1799) WRITE(IOIMP,4)(MLREE3.PROG(K),K=1,N11) 549 : 4 FORMAT(' SENSIBILITES TYPE + DE F LINEARISEE : ',/,(1X,5E12.5)) 550 : IF(IIMPI.EQ.1799) WRITE(IOIMP,41)(MLREE4.PROG(K),K=1,N11) 551 : 41 FORMAT(' SENSIBILITES TYPE - DE F LINEARISEE : ',/,(1X,5E12.5)) 552 : DO 53 I=1,N11 553 : VF0=VF0-(MLREE3.PROG(I)/MLREE1.PROG(I)) 554 : VF0=VF0-(MLREE4.PROG(I)/MLREE2.PROG(I)) 555 : 53 CONTINUE 556 : * 557 : * LINEARISATION CONVEXE DES CONTRAINTE CJ 558 : * 559 : MXMAT=MC 560 : SEGACT MXMAT*MOD 561 : LDIM1=XMAT(/1) 562 : LDIM2=XMAT(/2) 563 : if(iimpi.eq.1799) then 564 : write(6,*) ' xmat de mc' , (xmat(1,iou),iou=1,xmat(/2)) 565 : endif 566 : IF(LDIM2.NE.N11) GO TO 1000 567 : SEGINI MXMA1 568 : MCP=MXMA1 569 : SEGINI MXMA2 570 : MCQ=MXMA2 571 : MLREE1=IVX0U 572 : MLREE3=IVX0L 573 : MLREEL=IVCMAX 574 : MLREE2=IMC0 575 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD 576 : JG=LDIM1 577 : SEGINI MLREE4 578 : IVB=MLREE4 579 : DO 5 I=1,LDIM1 580 : MLREE4.PROG(I)=PROG(I)-MLREE2.PROG(I) 581 : TIN=0. 582 : DO 7 J=1,N11 583 : IF(XMAT(I,J).GT.0.D0) THEN 584 : MXMA1.XMAT(I,J)=XMAT(I,J)*(MLREE1.PROG(J)**2) 585 : ELSE 586 : MXMA2.XMAT(I,J)=ABS(XMAT(I,J))*(MLREE3.PROG(J)**2) 587 : ENDIF 588 : TIN=TIN+(MXMA1.XMAT(I,J)/MLREE1.PROG(J)) 589 : TIN=TIN+(MXMA2.XMAT(I,J)/MLREE3.PROG(J)) 590 : 7 CONTINUE 591 : MLREE4.PROG(I)=MLREE4.PROG(I)+TIN 592 : 5 CONTINUE 593 : IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE4.PROG(I),I=1,M) 594 : MLREEL=IWD 595 : MLREE1=IVB 596 : SEGACT MLREEL*MOD,MLREE1*MOD 597 : JG=PROG(/1) 598 : DO 56 I=1,JG 599 : IF(IIMPI.EQ.1799) WRITE(IOIMP,8)I,(MXMA1.XMAT(I,K),K=1,N11) 600 : 8 FORMAT(' SENSIBILITES TYPE + DE C',I3,' LINEARISEE : ', 601 : * /,(1X,5E12.5)) 602 : IF(IIMPI.EQ.1799) WRITE(IOIMP,9)I,(MXMA2.XMAT(I,K),K=1,N11) 603 : 9 FORMAT(' SENSIBILITES TYPE - DE C',I3,' LINEARISEE : ', 604 : * /,(1X,5E12.5)) 605 : 56 CONTINUE 606 : IF(IIMPI.EQ.1799) WRITE(IOIMP,6)(MLREE1.PROG(I),I=1,M) 607 : 6 FORMAT(' VALEURS DE IVB LINEARISEE : ',(1X,5E12.5)) 608 : * 609 : * CHANGEMENT DE VARIABLES DE XMAX 610 : * 611 : MLREEL=IVUL 612 : MLREE1=IVLL 613 : MLREE2=IVMAX 614 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 615 : JG=PROG(/1) 616 : SEGINI MLREE3,MLREE4 617 : IVMAXU=MLREE3 618 : IVMAXL=MLREE4 619 : DO 10 I=1,JG 620 : MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I) 621 : MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I) 622 : 10 CONTINUE 623 : IF(IIMPI.EQ.1799) WRITE(IOIMP,11)(MLREE3.PROG(K),K=1,N11) 624 : 11 FORMAT(' BORNES MAXIMA EN U ',/,(1X,5E12.5)) 625 : IF(IIMPI.EQ.1799) WRITE(IOIMP,12)(MLREE4.PROG(K),K=1,N11) 626 : 12 FORMAT(' BORNES MAXIMA EN L ',/,(1X,5E12.5)) 627 : * 628 : * CHANGEMENT DE VARIABLES DE XMIN 629 : * 630 : MLREEL=IVUL 631 : MLREE1=IVLL 632 : MLREE2=IVMIN 633 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD 634 : JG=PROG(/1) 635 : SEGINI MLREE3,MLREE4 636 : IVMINU=MLREE3 637 : IVMINL=MLREE4 638 : DO 54 I=1,JG 639 : MLREE3.PROG(I)=PROG(I)-MLREE2.PROG(I) 640 : MLREE4.PROG(I)=MLREE2.PROG(I)-MLREE1.PROG(I) 641 : 54 CONTINUE 642 : IF(IIMPI.EQ.1799) WRITE(IOIMP,14)(MLREE3.PROG(K),K=1,N11) 643 : 14 FORMAT(' BORNES MINIMA EN U ',/,(1X,5E12.5)) 644 : IF(IIMPI.EQ.1799) WRITE(IOIMP,15)(MLREE4.PROG(K),K=1,N11) 645 : 15 FORMAT(' BORNES MINIMA EN L ',/,(1X,5E12.5)) 646 : * 647 : * NORMALISATION DES VARIABLES DISCRETES 648 : * 649 : IF(NVD.NE.0) THEN 650 : MXMAT=MVD 651 : SEGACT MXMAT*MOD 652 : NDIS=XMAT(/2) 653 : LDIM1=XMAT(/1) 654 : LDIM2=NDIS+2 655 : SEGINI MXMA1 656 : NMVD=MXMA1 657 : DO 19 I=1,NVD 658 : DO 19 J=2,NDIS+1 659 : MXMA1.XMAT(I,J)=XMAT(I,J-1) 660 : 19 CONTINUE 661 : MLREEL=IVUL 662 : MLREE1=IVLL 663 : SEGACT MLREEL*MOD,MLREE1*MOD 664 : JG=LDIM1 665 : SEGINI MLENTI 666 : IDVD=MLENTI 667 : MVD=NMVD 668 : MXMAT=MVD 669 : SEGACT MXMAT*MOD 670 : LDIM1=XMAT(/1) 671 : LDIM2=XMAT(/2) 672 : SEGINI MXMA1,MXMA2 673 : MVDU=MXMA1 674 : MVDL=MXMA2 675 : DO 18 I=1,NVD 676 : DO 13 J=2,NDIS+2 677 : MXMA1.XMAT(I,J)=PROG(I)-XMAT(I,J) 678 : MXMA2.XMAT(I,J)=XMAT(I,J)-MLREE1.PROG(I) 679 : IF(XMAT(I,J).LT.1.D-20) THEN 680 : LECT(I)=J-1 681 : XMAT(I,J)=XGRAND 682 : MXMA1.XMAT(I,J)=XGRAND 683 : MXMA2.XMAT(I,J)=XGRAND 684 : GO TO 18 685 : ENDIF 686 : 13 CONTINUE 687 : 18 CONTINUE 688 : * 689 : IF(IIMPI.EQ.1799)THEN 690 : WRITE(IOIMP,'('' NOUVELLE MATRICE MVDU'')') 691 : DO 20 I=1,LDIM1 692 : WRITE(IOIMP,'('' LIGNE '',I2)')I 693 : DO 20 J=1,LDIM2 694 : WRITE(IOIMP,'(E12.5)')MXMA1.XMAT(I,J) 695 : 20 CONTINUE 696 : ENDIF 697 : IF(IIMPI.EQ.1799)THEN 698 : WRITE(IOIMP,'('' NOUVELLE MATRICE MVDL'')') 699 : DO 55 I=1,LDIM1 700 : WRITE(IOIMP,'('' LIGNE '',I2)')I 701 : DO 55 J=1,LDIM2 702 : WRITE(IOIMP,'(E12.5)')MXMA2.XMAT(I,J) 703 : 55 CONTINUE 704 : ENDIF 705 : ENDIF 706 : * 707 : * INITIALISATION DE L ALGORITHME 708 : * 709 : JG=M 710 : SEGINI MLREEL 711 : IVLAMB=MLREEL 712 : DO 16 I=1,JG 713 : PROG(I)=1.D0 714 : 16 CONTINUE 715 : * 716 : * INITIALISATION DES PARAMETRES DE CONTROLES 717 : * 718 : TERMIN=.FALSE. 719 : PDR=.FALSE. 720 : RSPB=.FALSE. 721 : RSPD=.FALSE. 722 : NDR=0 723 : EPSILO=0.001 724 : JG=0 725 : SEGINI MLENT1,MLENT2 726 : ITI=MLENT1 727 : ITK=MLENT2 728 : JG=M 729 : SEGINI MLENTI 730 : MDR=MLENTI 731 : NDP=1 732 : XL=0. 733 : NPDR=0 734 : XLL=0. 735 : LDIM1=M 736 : LDIM2=M 737 : SEGINI MXMAT 738 : MP=MXMAT 739 : * 740 : * 741 : * DEBUT DE TOURNER EN ROND 742 : * 743 : * 744 : IT=0 745 : JG= M 746 : SEGINI MLENTI 747 : IPBASE=MLENTI 748 : 101 CONTINUE 749 : IF(IIMPI.EQ.1799) 750 : *WRITE(IOIMP,FMT='('' ETAPE1: CALCUL DE X LAMBDA '')') 750 : CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL, 751 : *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL) 752 : 102 CONTINUE 753 : IF(IT.EQ.0) THEN 754 : MLREEL=IVXU 755 : MLREE3=IVXL 756 : MLREE1=IVN 757 : MLREE2=IVD 758 : SEGACT MLREEL*MOD,MLREE1*MOD,MLREE2*MOD,MLREE3*MOD 759 : ENDIF 760 : IF(IIMPI.EQ.1799) 761 : *WRITE(IOIMP,FMT='('' ETAPE2:CALCUL DE LA DIRECTION DE MONTEE'')') 762 : IF(IT.GT.0 ) THEN 763 : IVZZ=IVGE 764 : ENDIF 764 : CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE) 765 : IVDR=IVGM 766 : IF(IT.EQ.0) THEN 767 : MLREEL=IVGM 768 : SEGACT MLREEL*MOD 769 : IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M) 770 : IF(IIMPI.EQ.1799) WRITE(IOIMP,10014) (PROG(I),I=1,M) 771 : 10014 FORMAT(' VALEUR DE GRAD ',/ ,(1X,5(E12.5))) 772 : ENDIF 773 : * ON CONTINUE OBLIGATOIREMENT EN NDP=3 774 : 103 CONTINUE 775 : IF(IIMPI.EQ.1899) WRITE(IOIMP,10014) (PROG(I),I=1,M) 776 : ITTER=ITTER+1 777 : MLREEL=IVDR 778 : MLENTI=MDR 779 : DO 1020 I=1,M 780 : IF(LECT(I).EQ.1) PROG(I)=0.D0 781 : 1020 CONTINUE 782 : IF(ITTER.GT.MAXITE) THEN 783 : INTERR(1)=MAXITE 783 : CALL ERREUR(602) 784 : GO TO 116 785 : ENDIF 786 : IF(IIMPI.EQ.1799) 787 : *WRITE(IOIMP,FMT='('' ETAPE3:TEST NORME DIRECTION DE RECHERCHE'')') 787 : CALL ETAPE3(PROG,M,XNORZ) 788 : IF(IIMPI.NE.0) WRITE(6,1564) ITTER,XNORZ 789 : 1564 FORMAT(' iteration ', I5,' critere : ',E12.5) 790 : ***** TEST BIDON POUR CREER UN GO TO EN 104||| 791 : IF(IOIMP.EQ.-598) GO TO 104 792 : IF(ITTER.EQ.1) THEN 793 : EPSILO= XNORZ / XPREC 794 : WRITE(IOIMP,FMT='('' valeur du test de convergence'' 795 : $ ,2e12.5 )') EPSILO,XPREC 796 : ENDIF 797 : IF( XNORZ.LE.EPSILO.AND.IPART.NE.1) THEN 798 : GO TO 116 799 : ELSE 800 : IPART=0 801 : GO TO 106 802 : ENDIF 803 : 104 CONTINUE 804 : IF(IIMPI.EQ.1799) 805 : *WRITE(IOIMP,FMT='('' ETAPE4: CALCUL DU HESSIEN'')') 806 : IF ( IT .GT.0) THEN 806 : CALL ETAPE4(MCP,MCQ,M,N,IVU,IVXU,IVN,MH) 806 : CALL TXAY(IVZZ,MH,IVZZ,M,M,XRES) 807 : IF(XRES.EQ.0.D0) THEN 808 : IF(IIMPI.GT.1) 809 : *WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')') 810 : GO TO 106 811 : ELSE 812 : IF(IIMPI.EQ.1799) 813 : * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES POSSIBLE'')') 814 : GO TO 105 815 : ENDIF 816 : ELSE 817 : IF(IIMPI.GT.1) 818 : * WRITE(IOIMP,FMT='('' COMBINAISON DES RECHERCHES IMPOSSIBLE'')') 819 : GO TO 106 820 : ENDIF 821 : 105 CONTINUE 822 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT= 823 : *'('' ETAPE5 CONJUGAISON DES DIRECTIONS DE RECHERCHE'' )') 823 : CALL ETAPE5(IVZ,IVZZ,MH,M) 824 : * ON VA OBLIGATOIREMENT EN NDP=6 825 : 106 CONTINUE 826 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='( 827 : *'' ETAP6 RECHERCHE LINEAIRE SUIVANT LA DIRECTION DE RECHERCHE'')') 827 : CALL NTAPE6(MCP,MCQ,IVMINU,IVMINL,IVMAXU,IVMAXL,IVLAMB, 828 : * M,N,NVD,IVFP,IVFQ,MVDU,MVDL,IVB,IVD,IVN,II,KK,IVDR,IDVD, 829 : * NDR,TERMIN,IVLL,IVUL,IPBASE) 830 : IF(TERMIN)THEN 831 : ITI=ITISAV 832 : ITK=ITKSAV 833 : NPDR=NPDRSV 834 : GO TO 121 835 : ENDIF 836 : IF(II.GT.0) THEN 837 : IF(KK.EQ.-3) THEN 838 : MLENTI=IPBASE 839 : SEGACT MLENTI*MOD 840 : LECT(II)=1 841 : SEGDES MLENTI 842 : ENDIF 843 : ENDIF 843 : CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL, 844 : *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL) 844 : CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE) 845 : MLREEL=IVLAMB 846 : SEGACT MLREEL*MOD 847 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT= 848 : *'('' LAMBDA OPTIMAL '',/,(1X,5E12.5))')(PROG(I),I=1,M) 849 : MLREEL=IVGM 850 : SEGACT MLREEL*MOD 851 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 852 : *('' VALEUR DU GRADIENT MODIF SORTIE ETAPE6 : '',/,(1X,5E12.5))') 853 : *(PROG(I),I=1,M) 854 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE II ETAPE6 855 : *: '',/,(1X,I2))')II 856 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE KK ETAPE6 857 : *: '',/,(1X,I2))')KK 858 : MLREEL=IVXU 859 : SEGACT MLREEL*MOD 860 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXU : '' 861 : *,/,(1X,5E12.5))')(PROG(I),I=1,N11) 862 : MLREEL=IVXL 863 : SEGACT MLREEL*MOD 864 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEUR DE VXL : '' 865 : *,/,(1X,5E12.5))')(PROG(I),I=1,N11) 866 : * ON VA OBLIGATOIREMENT EN NDP=7 867 : 107 CONTINUE 868 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE7: TEST ... '')') 869 : IF(II.GT.0) THEN 870 : IF(KK.GT.0) THEN 871 : RSPD=.TRUE. 872 : RSPB=.FALSE. 873 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT=' 874 : *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE DISCONTINUITE '')') 875 : GO TO 111 876 : ENDIF 877 : ENDIF 878 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 879 : * ('' LA RECHERCHE NE SE TERMINE'', 880 : *''PAS SUR UN PLAN DE DISCONTINUITE '')') 881 : * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=8 882 : 108 CONTINUE 883 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE8: TEST ... '')') 884 : IF(II.GT.0) THEN 885 : IF(KK.EQ.-3) THEN 886 : RSPD=.FALSE. 887 : RSPB=.TRUE. 888 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 889 : *('' LA RECHERCHE SE TERMINE SUR UN PLAN DE BASE '')') 890 : GO TO 110 891 : ENDIF 892 : ENDIF 893 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT=' 894 : *('' LA RECHERCHE NE SE TERMINE PAS SUR UN PLAN DE BASE '')') 895 : * EN CE CAS ON CONTINUE OBLIGATOIREMENT EN NDP=9 896 : 109 CONTINUE 897 : RSPD=.FALSE. 898 : * RSPB=.FALSE. 899 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE9: TEST ... '')') 900 : IF(IIMPI.EQ.1799)WRITE(IOIMP,FMT=' 901 : *('' PREMIER PLAN DE DISCONTINUITE ?'')') 902 : IF(PDR) THEN 903 : GO TO 115 904 : ELSE 905 : IF(IPASS.EQ.1) THEN 906 : MLREEL=IVLAMB 907 : SEGINI,MLREE1=MLREEL 908 : MLAM1=MLREE1 909 : SEGDES MLREE1 910 : ELSEIF(IPASS.EQ.3) THEN 910 : CALL PARTAN (IVLAMB,MLAM1,IVGE,IVGM) 911 : IPART=1 912 : MLREEL=IVGM 913 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 914 : * ('' VALEUR DU GRADIENT MODIF SORTIE PARTAN: '', 915 : * /,(1X,5E12.5))')(PROG(I),I=1,M) 916 : IPASS=0 917 : ENDIF 918 : IPASS=IPASS + 1 919 : IT = IT + 1 920 : IVDR=IVGM 921 : GO TO 103 922 : ENDIF 923 : 110 CONTINUE 924 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE10: TEST ... '')') 925 : IF(PDR) THEN 926 : GO TO 114 927 : ELSE 928 : IPASS=1 929 : IT = IT + 1 930 : IVDR=IVGM 931 : GO TO 103 932 : ENDIF 933 : 111 CONTINUE 934 : NPDR=NPDR + 1 935 : IF(IIMPI.GT.1) 936 : *WRITE(IOIMP,FMT='('' ETAPE11: UN NOUVEAU PLAN DE '', 937 : *''DISCONTINUITE EST PRIS EN COMPTE '')') 938 : IF(IIMPI.GT.1) 939 : *WRITE(IOIMP,FMT='('' NOMBRE DE PLAN DE DISCONTINUITE '', 940 : *''A CONSIDERER :'',I4)')NPDR 941 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 942 : *('' INDICE DE LA VARIABLE DISCRETE :'',I4)')II 943 : IF(IIMPI.GT.1) 944 : *WRITE(IOIMP,FMT='('' INDICE DE SA VALEUR :'',I4)')KK 945 : JG=NPDR 946 : MLENT1=ITI 947 : MLENT2=ITK 948 : SEGADJ MLENT1 949 : SEGADJ MLENT2 950 : MLENT1.LECT(JG)=II 951 : MLENT2.LECT(JG)=KK 952 : IF(PDR) THEN 953 : GO TO 113 954 : ENDIF 955 : * SINON ON CONTINUE OBLIGATOIREMENT EN 112 956 : 112 CONTINUE 957 : PDR=.TRUE. 958 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT=' 959 : *('' ETAP12 : INITIALISATION DE LA MATRICE DE PROJECTION'')') 959 : CALL NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP) 960 : MXMAT=MP 961 : JG=M 962 : SEGINI MLREE1 963 : MLREEL=IVGE 963 : CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2) 964 : IF(IVGP.NE.0) THEN 965 : MLREEL=IVGP 966 : SEGSUP MLREEL 967 : ENDIF 968 : IVGP=MLREE1 969 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 970 : *('' VALEUR DU GRADIENT PROJETE DANS ETAPE12 : '',/,(1X,5E12.5))') 971 : *(MLREE1.PROG(I),I=1,M) 972 : MLREE2=IVLAMB 973 : JG=0 974 : SEGINI MLENTI 975 : DO 130 I=1,M 976 : IF(MLREE2.PROG(I).EQ.0.D0)THEN 977 : IF(MLREE1.PROG(I).LT.0.D0)THEN 978 : JG=JG+1 979 : SEGADJ MLENTI 980 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='( 981 : *'' ON CONSIDERE DANS L INITIALISATION LE PLAN DE BASE :'',I2)')I 982 : LECT(JG)=I 983 : ENDIF 984 : ENDIF 985 : 130 CONTINUE 986 : IF(JG.NE.0)THEN 987 : DO 131 I=1,JG 988 : IK=LECT(I) 988 : CALL ETAP14(MP,IK,M) 989 : 131 CONTINUE 990 : SEGSUP MLENTI 991 : ENDIF 992 : GO TO 115 993 : 113 CONTINUE 994 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 995 : *('' ETAPE13 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')') 995 : CALL NTAP13(MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II) 996 : IF(IIMPI.GT.1)THEN 997 : WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR DISCONTI'')') 998 : ENDIF 999 : GO TO 115 1000 : 114 CONTINUE 1001 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 1002 : *('' ETAPE14 : REMISE A JOUR DE LA MATRICE DE PROJECTION '')') 1002 : CALL ETAP14(MP,II,M) 1003 : IF(IIMPI.GT.1)THEN 1004 : WRITE(IOIMP,'('' MATRICE DE PROJECTION REMISE A JOUR BASE'')') 1005 : ENDIF 1006 : * ON CONTINUE OBLIGATOIREMENT EN 115 1007 : 115 CONTINUE 1008 : MXMAT=MP 1009 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 1010 : *('' ETAPE15 : PROJECTION DU GRADIENT DE LA FONCTION DUALE'')') 1011 : MLREEL=IVGE 1012 : JG=PROG(/1) 1013 : SEGINI MLREE1 1014 : MXMAT=MP 1014 : CALL MATVE1(XMAT,PROG,M,M,MLREE1.PROG,2) 1015 : IF( IVGP.NE.0) THEN 1016 : MLREE2=IVGP 1017 : SEGSUP MLREE2 1018 : ENDIF 1019 : IVGP=MLREE1 1020 : IT=IT+1 1021 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 1022 : *('' VALEUR DU GRADIENT PROJETE : '',/,(1X,5E12.5))') 1023 : *(MLREE1.PROG(I),I=1,M) 1024 : IVDR=IVGP 1025 : GO TO 103 1026 : 116 CONTINUE 1027 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE 16 : TEST ... '')') 1028 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 1029 : *('' REDEMARRAGE '')') 1030 : IF(RSPB) THEN 1031 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT=' 1032 : *('' PLAN DE BASE RENCONTRE '')') 1033 : IF(IPBASP.NE.0) THEN 1034 : MLENT1=IPBASP 1035 : SEGACT MLENT1*MOD 1036 : MLENTI=IPBASE 1037 : SEGACT MLENTI*MOD 1038 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 1039 : *('' VALEUR DE IPBASE : '',/,(1X,5I2))') 1040 : *( LECT(I),I=1,M) 1041 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT=' 1042 : *('' VALEUR DE IPBASP : '',/,(1X,5I2))') 1043 : *( MLENT1.LECT(I),I=1,M) 1044 : 1045 : DO 1160 IU=1,M 1046 : IF( MLENT1.LECT(IU).NE. 0 )GO TO 1161 1047 : 1160 CONTINUE 1048 : GO TO 1162 1049 : 1161 SEGSUP MLENT1 1050 : ENDIF 1051 : IPBASP=IPBASE 1052 : JG = M 1053 : SEGINI MLENTI 1054 : IPBASE=MLENTI 1054 : CALL NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,MVDL, 1055 : *IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,IVXU,IVXL) 1055 : CALL NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,IVGM,IVLAMB,IPBASE) 1056 : C avant NTAPE2, IVDR=IVGM or IVGM est "recree", on met le nouveau IVGM dans IVDR 1057 : IVDR=IVGM 1058 : GO TO 103 1059 : 1162 CONTINUE 1060 : * ON CONTINUE EN 117 1061 : ENDIF 1062 : IF(RSPD) THEN 1063 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT=' 1064 : *('' PLAN DE DISCONTINUITE RENCONTRE'')') 1065 : ENDIF 1066 : IF(.NOT.PDR) GO TO 122 1067 : * ON CONTINUE EN 117 1068 : 117 CONTINUE 1069 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT=' 1070 : * ('' ETAPE 17 : TEST DE REDEMARRAGE '')') 1071 : IF(NDR.EQ.5) GO TO 121 1071 : CALL NTAP17(IVFP,IVFQ,IVXU,IVXL,IVLAMB,IVB,IBU,IBL,VF0,NDR,N, 1072 : *MCP,MCQ,M,XL,XLL,TEST,NPDR,MVDU,MVDL,ITI,ITK,VFPMAX,IVN,IVD) 1073 : MLREE2=IBU 1074 : MLREE3=IBL 1075 : SEGACT MLREE2*MOD,MLREE3*MOD 1076 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17 1077 : * = IBU :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11) 1078 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES ETAP17 1079 : * = IBL :'',/,(1X,5E12.5))')(MLREE3.PROG(I),I=1,N11) 1080 : IF(TEST) THEN 1081 : MLENT1=ITI 1082 : MLENT2=ITK 1083 : JG=MLENT1.LECT(/1) 1084 : IF(ITISAV.NE.0) THEN 1085 : MLENTI= ITISAV 1086 : SEGSUP MLENTI 1087 : ENDIF 1088 : IF(ITKSAV.NE.0) THEN 1089 : MLENTI= ITKSAV 1090 : SEGSUP MLENTI 1091 : ENDIF 1092 : SEGINI MLENTI 1093 : SEGINI MLENT3 1094 : ITISAV=MLENTI 1095 : ITKSAV=MLENT3 1096 : NPDRSV=NPDR 1097 : DO 140 I=1,JG 1098 : LECT(I)=MLENT1.LECT(I) 1099 : MLENT3.LECT(I)=MLENT2.LECT(I) 1100 : 140 CONTINUE 1101 : PDR=.FALSE. 1102 : MXMAT=MP 1103 : SEGSUP MXMAT 1104 : IF(RSPD) THEN 1105 : MLENT1=ITI 1106 : MLENT2=ITK 1107 : MLENT1.LECT(1)=MLENT1.LECT(NPDR) 1108 : MLENT2.LECT(1)=MLENT2.LECT(NPDR) 1109 : NPDR=1 1110 : RSPD=.FALSE. 1111 : GO TO 112 1112 : ENDIF 1113 : 119 CONTINUE 1114 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE19 : TEST ..'')') 1115 : IF(RSPB)THEN 1116 : RSPB=.FALSE. 1117 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE19 PRISE EN COMPTE DU 1118 : *PLAN DE BASE NO :'',I4)')II 1119 : MLENTI=MDR 1120 : LECT(II)=1 1121 : ENDIF 1122 : NPDR=0 1123 : GO TO 101 1124 : ENDIF 1125 : 121 CONTINUE 1126 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' FIN DES RECHERCHES'')') 1127 : IF(IIMPI.GT.1)WRITE(IOIMP,FMT='('' ETAPE21 : SELECTION DES VARIA 1128 : *BLES DISCRETES OPTIMALES '')') 1128 : CALL NTAP21(IVFP,IVFQ,IVLAMB,IVB,IBU,IBL, 1129 : * NPDR,N,MCP,MCQ,M,MVDU,MVDL,ITI,ITK) 1130 : MLREE1=IBU 1131 : MLREE2=IBL 1132 : SEGACT MLREE1*MOD,MLREE2*MOD 1133 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT 1134 : *ION = IBU :'',/,(1X,5E12.5))')(MLREE1.PROG(I),I=1,N11) 1135 : IF(IIMPI.EQ.1799) WRITE(IOIMP,FMT='('' VALEURS DE X APRES SELECT 1136 : *ION = IBL :'',/,(1X,5E12.5))')(MLREE2.PROG(I),I=1,N11) 1137 : MLREE3=IVXU 1138 : MLREE4=IVXL 1139 : SEGACT MLREE3*MOD,MLREE4*MOD 1140 : JG=MLREE1.PROG(/1) 1141 : DO 1220 I=1,JG 1142 : MLREE3.PROG(I)=MLREE1.PROG(I) 1143 : MLREE4.PROG(I)=MLREE2.PROG(I) 1144 : 1220 CONTINUE 1145 : * ON CONTINUE EN 122 1146 : 122 CONTINUE 1147 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' ETAPE 22 : FIN DE L ALGORITHME 1148 : * '')') 1148 : * CALL ETAP22(IVX,IVX0,N,IVF,IVLL,IVUL) 1149 : INTERR(1)=ITTER 1149 : CALL ERREUR (-282) 1150 : MLREE1=IVXU 1151 : MLREE2=IVXL 1152 : MLREE3=IVUL 1153 : MLREE4=IVLL 1154 : SEGACT MLREE1*MOD 1155 : SEGACT MLREE2*MOD 1156 : SEGACT MLREE3*MOD 1157 : SEGACT MLREE4*MOD 1158 : JG=N 1159 : SEGINI MLREEL 1160 : IVX=MLREEL 1161 : DO 1221 I=1,JG 1162 : PROG(I)=MLREE3.PROG(I)-MLREE1.PROG(I) 1163 : CST=MLREE2.PROG(I)+MLREE4.PROG(I) 1164 : IF(IIMPI.EQ.17) 1165 : * WRITE(IOIMP,'('' XU , XL '',(1X,I2,2E12.5))')I,PROG(I),CST 1166 : IF(ABS(PROG(I)-CST).GT.1.D-4) GO TO 1000 1167 : 1221 CONTINUE 1168 : AAZER=MLREE3.PROG(N11)-MLREE1.PROG(N11) 1169 : IF(IIMPI.GT.1) WRITE(IOIMP,FMT='('' VALEUR DE X EN SORTIE :'',/, 1170 : *(1X,5E12.5))')(PROG(I),I=1,N),AAZER 1171 : * 1172 : * SAUVEGARDE DE VX DANS VX0 1173 : MLREEL=IVX0 1174 : MLREE1=IVX 1175 : SEGACT MLREEL*MOD,MLREE1*MOD 1176 : DO 65 I=1,N 1177 : PROG(I)=MLREE1.PROG(I) 1178 : 65 CONTINUE 1179 : if(nsup.ne.0) then 1180 : jg=mlree6.prog(/1) 1181 : n=jg 1182 : segini mlree5 1183 : ia=0 1184 : do iou=1,jg 1185 : if(ibon(iou).eq.1) then 1186 : ia=ia+1 1187 : mlree5.prog(iou)=prog(ia) 1188 : else 1189 : mlree5.prog(iou)=mlree6.prog(iou) 1190 : endif 1191 : enddo 1192 : ivx0=mlree5 1193 : segsup mlreel 1194 : mlreel=mlree5 1195 : segsup ibo 1196 : endif 1197 : * 1197 : CALL VECTAB(IVX0,N,IRET) 1197 : CALL ECCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VX0',LOGIN,IOBIN, 1198 : * 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET) 1198 : CALL VECTAB(IVXPR1,N-nsup,IRET) 1198 : CALL ECCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXPRE1',LOGIN,IOBIN, 1199 : * 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET) 1199 : CALL VECTAB(IVXPR2,N-nsup,IRET) 1199 : CALL ECCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VXPRE2',LOGIN,IOBIN, 1200 : * 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET) 1200 : CALL VECTAB(IVUL,N-nsup,IRET) 1200 : CALL ECCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VUL',LOGIN,IOBIN, 1201 : * 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET) 1201 : CALL VECTAB(IVLL,N-nsup,IRET) 1201 : CALL ECCTAB(ITAB,'MOT ',IVALIN,XVALIN,'VLL',LOGIN,IOBIN, 1202 : * 'TABLE',IVALRE,XVALRE,CHARRE,LOGRE,IRET) 1203 : * 1204 : * 1205 : 1205 : CALL ECROBJ('TABLE ',ITAB) 1206 : MTABLE=ITAB 1207 : SEGDES MTABLE 1208 : MLREEL=IVX 1209 : MLREE1=IVN 1210 : MLREE2=IVD 1211 : MLENTI=IVU 1212 : SEGSUP MLREEL,MLREE1,MLREE2,MLENTI 1213 : MLREEL = IVF 1214 : MXMAT=MC 1215 : MLREE1=IMC0 1216 : SEGSUP MLREEL,MXMAT,MLREE1 1217 : MLREEL=IVXMIN 1218 : MLREE1=IVXMAX 1219 : MLREE2=IVCMAX 1220 : SEGSUP MLREEL,MLREE1,MLREE2 1221 : MLREEL=IWD 1222 : MLREE1=IVFP 1223 : MLREE2=IVFQ 1224 : SEGSUP MLREEL,MLREE1,MLREE2 1225 : MXMAT=MCP 1226 : MXMA1=MCQ 1227 : SEGSUP MXMAT,MXMA1 1228 : MLREEL=IVLAMB 1229 : SEGSUP MLREEL 1230 : MLENTI=ITI 1231 : MLENT1=ITK 1232 : SEGSUP MLENTI,MLENT1 1233 : IF(NVD.NE.0) THEN 1234 : MLENTI=IDVD 1235 : MXMAT=MVD 1236 : MXMA1=MVDU 1237 : MXMA2=MVDL 1238 : SEGSUP MLENTI,MXMAT,MXMA1,MXMA2 1239 : ENDIF 1240 : MXMAT=MP 1241 : SEGSUP MXMAT 1242 : MLREEL=IVXPR1 1243 : MLREE1=IVXPR2 1244 : SEGSUP MLREEL,MLREE1 1245 : MLREEL=IVMIN 1246 : MLREE1=IVMAX 1247 : SEGSUP MLREEL,MLREE1 1248 : MLREEL=IVXU 1249 : MLREE1=IVXL 1250 : MLREE2=IVMINU 1251 : MLREE3=IVMINL 1252 : SEGSUP MLREEL,MLREE1,MLREE2,MLREE3 1253 : MLREEL=IVMAXU 1254 : MLREE1=IVMAXL 1255 : MLREE2=IVB 1256 : SEGSUP MLREEL,MLREE1,MLREE2 1257 : MLREEL=IVUL 1258 : MLREE1=IVLL 1259 : MLREE2=IVX0U 1260 : MLREE3=IVX0L 1261 : SEGSUP MLREEL,MLREE1,MLREE2,MLREE3 1262 : MLREEL=MLAM1 1263 : MLREE1=IVGE 1264 : MLREE2=IVGM 1265 : MLREE3=IVGP 1266 : SEGSUP MLREEL,MLREE1,MLREE2,MLREE3 1267 : IF( IT0.NE.0) THEN 1268 : MLREEL=IT0 1269 : SEGSUP MLREEL 1270 : ENDIF 1271 : IF( IS0.NE.0) THEN 1272 : MLREEL=IS0 1273 : SEGSUP MLREEL 1274 : ENDIF 1275 : RETURN 1276 : 1000 CONTINUE 1276 : CALL ERREUR(19) 1277 : RETURN 1278 : END 1279 : 1280 : 1281 : 1282 : 1283 : 1284 : 1285 : 1286 :
© Cast3M 2003 - All rights reserved.
Disclaimer