Télécharger excell.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales