Télécharger chomod.eso

Retour à la liste

Numérotation des lignes :

  1. C CHOMOD SOURCE PV 19/07/31 21:15:40 10276
  2. C
  3. C DECOMPOSITION DE CROUT MODIFIEE POUR LE CALCUL DES MATRICES
  4. C CONDENSEES D'UN SUPER-ELEMENT
  5. C RESULTAT DANS XMATRI
  6. C
  7. SUBROUTINE CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATRI,NLIGRA)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. C TANT QUE OOOVAL(1,4) NE MARCHE PAS SUR CRAY
  11. PARAMETER (LPCRAY=10000)
  12. INTEGER OOOVAL,ILIMITE,OOOLEN
  13. dimension ittime(4)
  14. SEGMENT ITMASQ(NBLIG)
  15. SEGMENT IMASQ(LMASQ)
  16. segment immt(nblig)
  17. POINTEUR LILIGN.MILIGN
  18. external chole3i
  19. C
  20. LOGICAL TEST1,LIMIT
  21. C
  22. C **** MISE SOUS FORME A=Lt D L DE LA MATRICE MMATRX
  23. C
  24. -INC CCOPTIO
  25. -INC CCREEL
  26. -INC SMMATRI
  27. -INC SMRIGID
  28. -INC CCASSIS
  29. -INC CCHOLE
  30. -INC SMELEME
  31. C
  32. SEGMENT SNTO
  33. INTEGER NTOTMA(NN)
  34. ENDSEGMENT
  35. C
  36. SEGMENT SNTT
  37. INTEGER NTTMAI(NN)
  38. ENDSEGMENT
  39. C
  40. SEGMENT KIVPO(IIMAX)
  41. SEGMENT KIVLO(IIMAX)
  42. SAVE IPASV
  43. DATA IPASV/0/
  44. logical ngmpet
  45. DATA PREC /1D-18/
  46. C character*8 zen
  47. C equivalence (zen,izen)
  48. ngmpet=.false.
  49. call timespv(ittime,oothrd)
  50. kcour=(ittime(1)+ittime(2))/10
  51. kcourp=kcour
  52. kcouri=kcour
  53. kdiff=0
  54. kcour=0
  55. perf=0.d0
  56. perfp=-1
  57. nbchan=1
  58. nbopit=0
  59. iposm=0
  60. C zen='CPU'//char(0)
  61. C le=4
  62. lolig=0
  63. nvaor=0
  64. nbthro=nbthrs
  65. ithrd=0
  66. if (nbthro.gt.1) then
  67. ithrd=1
  68. call threadii
  69. call oooprl(1)
  70. endif
  71. nbthr=nbthro
  72. do ith=1,nbthro
  73. nbop(ith)=0
  74. enddo
  75.  
  76. C nouvelle methode de gestion de l'espace memoire necessitee par la parallelisation
  77. C memoire vive totale
  78. MACTIT=OOOVAL(1,1)
  79. C un bloc de memoire fera au plus macti/2
  80. nvstrm=0
  81. MMATRI=MMATRX
  82. SEGACT,MMATRI*MOD
  83. * ipt2=igeoma
  84. * segact ipt2
  85. PRCHLV=PREC
  86. MILIGN=IILIGN
  87.  
  88. SEGACT,MILIGN*MOD
  89. INO=ILIGN(/1)
  90. MDIAG=IDIAG
  91. SEGACT,MDIAG*MOD
  92. NBLIG=INO
  93. segini immt
  94. SEGINI ITMASQ
  95. precc=prec
  96. INC=DIAG(/1)
  97. nvstrm=inc
  98. INCC=INC
  99. MIMIK=IIMIK
  100. MINCPO=IINCPO
  101. SEGACT,MINCPO,MIMIK
  102. IPLUMI=IMIK(/2)*2 +4
  103. IL2=0
  104. IIMAX=IJMAX+IPLUMI
  105. SEGINI KIVPO,KIVLO
  106. INEG=0
  107. NBLAG=0
  108. NENSLX=0
  109. NVSTOC=0
  110. NVSTOR=0
  111. NLIGRP=NLIGRA
  112. NLIGRD=NLIGRA
  113. diagmax=xpetit/xzprec
  114. diagmin=xgrand
  115. do i=1,diag(/1)
  116. if (ittr(i).eq.0) diagmax=max(diagmax,abs(diag(i)))
  117. if (ittr(i).eq.0.and.abs(diag(i)).gt.xpetit/xzprec)
  118. > diagmin=min(diagmin,abs(diag(i)))
  119. enddo
  120. if (diagmax.le.xpetit/xzprec) then
  121. do i=1,diag(/1)
  122. diagmax=max(diagmax,abs(diag(i)))
  123. if (abs(diag(i)).gt.xpetit/xzprec)
  124. > diagmin=min(diagmin,abs(diag(i)))
  125. enddo
  126. endif
  127. diagmin=min(diagmin,diagmax)
  128. ** write (6,*) ' chole diagmin diagmax ',diagmin,diagmax
  129. CC
  130. C ngmaxy vient de option
  131. C ngmaxx est la valeur autoajustee
  132. C ngmaxz est la valeur utilisee dans les tests (grande si il y a du debordement)
  133. ngmaxx=ngmaxy
  134. NGMAXZ=NGMAXX
  135. C
  136. nelrig=1
  137. SEGINI,XMATRI
  138. C
  139. C** ILIMITE = nb de noeuds qui ne sont pas maitres
  140. C
  141. SEGACT,SNTO
  142. SEGACT,SNTT
  143. ILIMITE = INO - (NTOTMA(/1) + NTTMAI(/1))
  144. TEST1=.FALSE.
  145. IF(ILIMITE.EQ.0) THEN
  146. IL2=0
  147. TEST1=.TRUE.
  148. ENDIF
  149. NGMAXZ=NGMAXY
  150.  
  151. LIMIT=.FALSE.
  152. C
  153. C **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD,
  154. C **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUD
  155. C
  156. C **** LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX
  157. C
  158. 1 CONTINUE
  159. IF (TEST1) LIMIT=.TRUE.
  160. C
  161. IVALMA=IJMAX+IPLUMI
  162. IL1=IL2+1
  163. IMIN=IL1
  164.  
  165. mactic=0
  166. DO 2 I=IL1,INO
  167. imasq=0
  168. LIGN=0
  169.  
  170. LLIGN= ILIGN(I)
  171. SEGACT /ERR=3/LLIGN
  172. NA=IMMMM(/1)
  173. NBPAR=NA+1
  174. NVALL=NJMAX
  175. lolig=nvall/na+1
  176. if (lolig.gt.2048.and.lolig.gt.3*loligp/2.and.
  177. > mactic.gt.NGMAXZ*nbthro/2 .and.
  178. > i-il1.ge.nbthro) goto 3
  179. loligp=lolig
  180. SEGINI /ERR=3/ LIGN
  181. C recuperer la longueur du segment
  182. mactic=mactic+ooolen(lign)
  183. * if ((mactic.gt.mactit/2.or.mactic.gt.mactit-nvstrm*12)
  184. * > .AND.I.GT.IL1) THEN
  185. * SEGSUP LIGN
  186. * GOTO 3
  187. * endif
  188. NVSTOC=NVSTOC + NVALL
  189. IVALMA=IVALMA+NVALL
  190. nvaor=nvaor+xxva(/1)
  191. C
  192. C **** DECOMPACTAGE
  193. C
  194. LMASQ=NVALL/MASDIM+2
  195. SEGINI /ERR=3/IMASQ
  196. IPA=1
  197. DO 121 JPA=1,NA
  198. IVPO(JPA)=IPA
  199. KPA=IPPO(JPA+1)-IPPO(JPA)
  200. IPP=IPPO(JPA)
  201. IPPVV(JPA)=IPA-1
  202. LPA=LDEB(JPA)
  203. LPA1=LPA-IPA
  204. DO 122 MPA=1,KPA
  205. LL=LINC(MPA+IPP)
  206. IPLA=LL-LPA1
  207. VAL(IPLA)=XXVA(MPA+IPP)
  208. IMASQ(IPLA/MASDIM+1)=1
  209. if (ipla-ipa+1.ge.1) IMASQ((IPLA-ipa+1)/MASDIM+1)=1
  210. 122 CONTINUE
  211. IPA=IPA+IMMMM(JPA)-LPA+1
  212. Cpv IMMM(JPA)=IPNO(LPA)
  213. IMMM(JPA)=LPA
  214. IF(IMIN.GT.IPNO(LPA)) IMIN=IPNO(LPA)
  215. 121 CONTINUE
  216. * indexation de imasq
  217. ipln=lmasq/na
  218. iplp=lmasq/na
  219. do 123 ipl=lmasq/na,1,-1
  220. if (imasq(ipl).gt.0) then
  221. imasq(ipl)=iplp*masdim
  222. ipln=ipl-1
  223. else
  224. imasq(ipl)=-ipln*masdim
  225. iplp=ipl-1
  226. endif
  227. 123 continue
  228. ** write (6,*) ' imasq ',lmasq/na
  229. ** write (6,*) (imasq(ipl),ipl=1,lmasq/na)
  230. C*** **** ****
  231. ITMASQ(I)=IMASQ
  232.  
  233.  
  234. if (na.gt.0) then
  235. IPREL= IMMMM(1)
  236. IDERL= IMMMM(NA)
  237. lcara(2,i)=iprel
  238. lcara(3,i)=iderl
  239. endif
  240. IPPVV(NA+1)=IPA-1
  241. SEGSUP LLIGN
  242. ILIGN(I)=LIGN
  243. IF(IIMPI.EQ.1525) THEN
  244. WRITE( IOIMP,4987) I
  245. 4987 FORMAT (' NOEUD NUMERO ',I5)
  246. LL=VAL(/1)
  247. WRITE(IOIMP, 4926)(VAL(MPA),MPA=1,LL)
  248. 4926 FORMAT(' VAL ' , 10E11.4)
  249. ENDIF
  250. nbths=nbthr
  251. C
  252. IF ((I.EQ.(ILIMITE)).AND.(.NOT.TEST1)) THEN
  253. TEST1=.TRUE.
  254. IL2 = I
  255. GOTO 4
  256. ENDIF
  257. C* write (6,*) 'longueur ligne ',nvall
  258. C nb de ligne multiple du nb de threads
  259. C blocage ligne lecture-ecriture pour minimiser le cache
  260. if (mod(i+1-il1,nbths).eq.0
  261. > .and.mactic.gt.NGMAXZ*nbthro.OR.I+1-il1.gt.768) then
  262. il2=i
  263. GOTO 4
  264. endif
  265. 2 CONTINUE
  266. IL2=INO
  267. GO TO 4
  268. 3 IL2=I-1
  269. loligp=lolig
  270. segdes llign
  271. if(imasq.eq.0.and.lign.ne.0) segsup lign
  272. 4 CONTINUE
  273. nbthro=nbthrs
  274. if (mactic.le.50000) nbthro=1
  275. nbthr=nbthro
  276. C
  277. IF(IL2.GE.IL1) GO TO 40
  278. C
  279. C **** APPEL AUX ERREURS MESSAGE PAS ASSEZ DE PLACE MEMOIRE
  280. C
  281. ITYP=48
  282. CALL ERREUR(48)
  283. if (ithrd.eq.1) then
  284. call threadis
  285. call oooprl(0)
  286. endif
  287. RETURN
  288. 40 CONTINUE
  289. IM=INC
  290.  
  291.  
  292.  
  293.  
  294. DO 352 IH=IL2 ,IL1,-1
  295. LIGN= ILIGN(IH )
  296. IL=INC
  297. DO 354 JH=1, IMMM(/1)
  298. IM=MIN(IM, IMMM(JH))
  299. IL=MIN(IL, IMMM(JH))
  300. 354 CONTINUE
  301. IML=IL
  302. immt(ih)=ipno(im)
  303. 352 CONTINUE
  304. C 353 CONTINUE
  305. LIGN=ILIGN(IL1)
  306. IL11=IPREL
  307. C
  308. C **** BOUCLE *5* TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE
  309. C
  310. C if (ngmaxz.eq.ngmaxx) write (6,*) 'resolution in core ',il1,il2
  311. C if (ngmaxz.ne.ngmaxx) write (6,*) 'resolution out of core ',
  312. C > il1,il2
  313. lig1=ilign(imin)
  314. ipos=0
  315. iper=imin
  316. ider=imin-1
  317. iderac=imin-1
  318. if (ngmaxz.lt.ngmaxx*2) ngmaxz=ngmaxx
  319. isec=0
  320. DO 5 I=IMIN,IL2
  321. IMASQ=ITMASQ(I)
  322. LIG1=ILIGN(I)
  323. IF(I.LT.IL1) GO TO 7
  324. C____________
  325. C
  326. C ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A
  327. C ******* IPREL IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER
  328. C ******* LE TERME DIAGONAL
  329. C
  330. LIGN=LIG1
  331. DO 156 KHG=1,IMMM(/1)
  332. II=IPREL-1+KHG
  333. IMMM(KHG)=0
  334. NN=IPPVV(KHG+1)
  335. NNM1=IPPVV(KHG)
  336. N=NN-NNM1
  337. DIAG(II)=VAL(NN)
  338. IF(N.EQ.1) THEN
  339. IF(LIMIT) THEN
  340. RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN)
  341. GO TO 41
  342. ELSE
  343. GO TO 8
  344. ENDIF
  345. ENDIF
  346. NMI=N-II
  347. KI1=N-1
  348. KQ=-NMI
  349. IF(LIMIT) THEN
  350. C
  351. C ****** CAS NOEUD MAITRE
  352. C
  353. IDEP=MAX(IL11,1-NMI)
  354. KIDEP=IDEP+NMI
  355. VAL(NN)=VAL(NN)+
  356. # SUPER1(ILIGN,LIGN,VAL(1+IPPVV(KHG)),DIAG(1-NMI),IPNO(1-NMI),
  357. # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,NBNNMA,XMATRI,
  358. # IMASQ(1),1+IPPVV(KHG),prec,nbop(1))
  359. imasq(nn/masdim+1)=1
  360. imasq(n/masdim+1)=1
  361. RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN)
  362. GOTO 41
  363. ENDIF
  364. C
  365. C ****** CAS NOEUD NON MAITRE
  366. C
  367. IDEP=MAX(IL11,2-NMI)
  368. KIDEP=IDEP+NMI
  369. VAL(NN)=VAL(NN)+
  370. # CHOLE1(ILIGN,LIGN,VAL(1+IPPVV(KHG)),DIAG(1-NMI),IPNO(1-NMI),
  371. # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,IMASQ(1),1+IPPVV(KHG),
  372. # prec,nbop(1))
  373. imasq(nn/masdim+1)=1
  374. imasq(n/masdim+1)=1
  375. C
  376. 8 CONTINUE
  377. diagref=max(abs(diag(ii)),diagmin)
  378. diagcmp=diagref*1d-10
  379. IF( ITTR(II).EQ.0.AND.
  380. & ABS( VAL(NN)).GT.diagcmp) GO TO 12
  381. IF( ITTR(II).NE.0.AND.
  382. & ABS( VAL(NN)).GT.diagcmp) GO TO 12
  383. C il faut mettre une valeur plus grande sur les LX car on a un probleme de conditionnement
  384. C sur le calcul des reactions en cas de 2 relations presque identique
  385. C
  386. C **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE
  387. C **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT
  388. C **** AU PREALABLE SUR CETTE INCONNUE.
  389. C
  390. * write (6,*) ' chomod nens ii ittr val diag ',ii,ittr(ii),
  391. * > val(nn),diag(ii),ipt2.num(1,ipno(ii)),limit
  392. if (ittr(ii).eq.0) then
  393. VAL(NN)=DIAGREF
  394. else
  395. VAL(NN)=val(nn)-4.D0*abs(DIAGREF)
  396. NENSLX=NENSLX+1
  397. endif
  398. NENS=NENS+1
  399. IMMM(KHG)=NENS
  400. 12 CONTINUE
  401. IMASQ(NN/MASDIM+1)=1
  402. IMASQ(N/MASDIM+1)=1
  403. DIAG(II)=VAL(NN)
  404. IF(DIAG(II).NE.0.d0) GO TO 41
  405. KQ1=1+NNM1
  406. KQN=N+NNM1
  407. DO 16 LFG=KQ1,KQN
  408. IF(VAL(LFG).NE.0.d0) GO TO 17
  409. 16 CONTINUE
  410. DIAG(II)=1.d0
  411. if (ittr(ii).ne.0) diag(ii)=-1.d0
  412. VAL(NN)=diag(ii)
  413. GO TO 41
  414. 17 CONTINUE
  415. diag(ii)=val(lfg)
  416. if (ittr(ii).ne.0) diag(ii)=-abs(diag(ii))
  417. val(nn)=diag(ii)
  418. goto 41
  419. C
  420. C **** ENVOI ERREUR MATRICE SINGULIERE
  421. C
  422. ITYP=49
  423. INTERR(1)=I
  424. CALL ERREUR(49)
  425. if (ithrd.eq.1) then
  426. call threadis
  427. call oooprl(0)
  428. endif
  429. RETURN
  430. C
  431. C **** ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS
  432. C ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  433. C
  434. 41 IF(DIAG(II).LT.0.D0) INEG=INEG+1
  435. IF(ITTR(II).NE.0) NBLAG=NBLAG+1
  436. 156 CONTINUE
  437. NA=IMMM(/1)
  438. C
  439. C RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE)
  440. C
  441. if (na.gt.0)
  442. >CALL COMPAC(VAL(1),NBPAR,KIVPO(1),KIVLO(1),
  443. # NVALL,IPPVV(1),IZROSF,NA,PREC,imasq(1),iprel,iderl)
  444. C
  445. C on recree lign car la compacter en place emiette la memoire
  446. segini,lig1
  447. do it=1,nvall
  448. lig1.val(it)=val(it)
  449. enddo
  450. do it=1,na
  451. lig1.immm(it)=immm(it)
  452. lig1.ippvv(it)=ippvv(it)
  453. enddo
  454. lig1.ippvv(na+1)=ippvv(na+1)
  455. lig1.iml=iml
  456. lig1.iprel=iprel
  457. lig1.iderl=iderl
  458. lcara(1,i)=iml
  459. lcara(2,i)=iprel
  460. lcara(3,i)=iderl
  461. segsup lign
  462. lign=lig1
  463. ilign(i)=lign
  464. NVSTOR=NVSTOR+NVALL
  465. nvstrm=max(nvstrm,nvall)
  466. DO 143 LHG=1,NBPAR
  467. IVPO(2*LHG-1)=KIVPO(LHG)
  468. IVPO(2*LHG)=KIVLO(LHG)
  469. 143 CONTINUE
  470. C si la ligne est petite, il n'y a pas interet a paralleliser
  471. nbthr=min(nbthro,(nvall*(il2-il1+1))/64 +1)
  472. segsup imasq
  473. imasq=itmasq(i)
  474. if (i.gt.1) then
  475. lig1=ilign(i-1)
  476. segdes lig1
  477. iderac=min(iderac,i-2)
  478. endif
  479. C
  480. C **** ON TRIANGULARISE LES AUTRES LIGNES
  481. C
  482. il1=il1+1
  483. if (il1.gt.il2) goto 5
  484. LIG1=ILIGN(I)
  485. lign=ilign(il1)
  486. IL11=IPREL
  487. goto 7
  488. 72 continue
  489. C write (6,*) ' chomod segact ',i,ILIMITE,il1,il2
  490. 71 continue
  491. if (i.lt.il1-10.and.i.ne.ilimite) then
  492. ngmaxz= (oooval(1,1)/nbths)*0.90*2.
  493. ngmpet=.true.
  494. c write (ioimp,*) ' passage au grand ngmax ',i,il1,il2,ngmaxz
  495. endif
  496. if (isec.ne.0) ider=isec
  497. isec=0
  498. C soit parce qu'on a fini, soit parce qu'on manque de memoire
  499. C il faut executer les lignes activees puis les desactiver
  500. C lancer les chole3 et attendre qu'ils soient finis
  501. if (ipos.ne.0) then
  502. C write (6,*) ' lancement thread ',iper,ider,il1,il2
  503. if (iper.gt.ider) then
  504. write (6,*) ' erreur interne chole '
  505. call erreur(5)
  506. endif
  507. IF(I.LE.ILIMITE) THEN
  508. nbthr=min(nbthr,il2-il1+1)
  509. if (nbthr.ge.1) then
  510. LILIGN=MILIGN
  511. do ith=2,nbthr
  512. call threadid(ith,chole3i)
  513. enddo
  514. call chole3i(1)
  515. do ith=2,nbthr
  516. call threadif(ith)
  517. enddo
  518. else
  519. LILIGN=MILIGN
  520. do ith=1,nbthr
  521. call chole3i(ith)
  522. enddo
  523. endif
  524. endif
  525. C test ctrlC
  526. if (ierr.ne.0) goto 9999
  527. iposm=max(iposm,ipos)
  528. ipos=0
  529. iderf=ider-1
  530. if (ider.ne.il1-1) iderf=ider
  531. do il=iderf,iper,-1
  532. lign=ilign(il)
  533. segdes lign
  534. C write (6,*) ' desactivation ligne ',il
  535. enddo
  536. iderac=min(iderac,iper-1)
  537. iper=ider+1
  538. C write (6,*) ' iper ider il1 ',iper,ider,il1
  539. if (i.eq.ilimite) goto 5
  540. if (iper.ne.il1) goto 7
  541. ENDIF
  542. goto 5
  543. 7 CONTINUE
  544. C blocage secondaire sur les lignes en lecture pour minimiser le cache
  545. SEGACT/err=71/LIG1
  546. ipos=ipos+1
  547. ider=i
  548. if (i.gt.iderac) iderac=i
  549. if (i.eq.il1-1.and.i.le.ilimite) goto 71
  550. IF(I.EQ.ILIMITE) GOTO 71
  551. IF(I.GT.ILIMITE) THEN
  552. IPPR=LIG1.IPREL
  553. IDDR=LIG1.IDERL
  554. C
  555. C
  556. DO 10 JBI=IL1,IL2
  557. LIGN=ILIGN(JBI)
  558. IMASQ=ITMASQ(JBI)
  559. C
  560. C ****** CAS NOEUD MAITRE
  561. C
  562. CALL SUPER3(IPREL,IDERL,IPPVV(1),IPPR,IDDR,
  563. # IVPO(1),LIG1.IPPVV(1),VAL(1),
  564. # LIG1.VAL(1),LIG1.IVPO(1),NBNNMA,xmatri,
  565. # imasq(1),prec,nbop(1))
  566. IF(IMM.GT.I) GO TO 106
  567. 10 CONTINUE
  568. 106 CONTINUE
  569. IF(I.LT.IL1) then
  570. SEGDES,LIG1
  571. endif
  572. ENDIF
  573. 5 CONTINUE
  574. DO 11 I=IL1,IL2
  575. LIGN=ILIGN(I)
  576. SEGDES,LIGN
  577. 11 CONTINUE
  578. nbopt=0
  579. do ith=1,nbthro
  580. nbopt=nbopt+nbop(ith)
  581. nbop(ith)=0
  582. enddo
  583. nbopin=nbopt
  584. nbopit=nbopit+nbopin
  585. call timespv(ittime,oothrd)
  586. kcourp=kcour
  587. kcour=(ittime(1)+ittime(2))/10
  588. kdiff=kcour-kcourp
  589. C* write (6,*) ' nb operation temps ',nbopin,kdiff
  590. if (kdiff.gt.5) then
  591. perf=nbopin/kdiff
  592. C* write (6,*) 'perf ngmaxy il1 il2',perf,ngmaxy,il1i,il2
  593. if (perf.lt.perfp*0.90 .and.nbchan.ne.1 ) then
  594. nbchan=1
  595. ngmaxx=ngmaxx*0.90
  596. perfp=perf
  597. elseif (nbchan.eq.0) then
  598. nbchan=-1
  599. ngmaxx=ngmaxx*1.10
  600. perfp=max(perf,perfp)
  601. else
  602. nbchan=0
  603. endif
  604. C* nbchan=0
  605. ngmaxx=max(10000,min(1000000000,ngmaxx))
  606. if(ngmpet) ngmaxz=ngmaxx
  607. endif
  608.  
  609. iderac=min(iderac,il1-1)
  610. isec=0
  611. IF(IL2.LT.INO) GO TO 1
  612.  
  613. C ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF
  614. C ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  615. c INEG=INEG-NBLAG
  616. C on ne compte pas 2 fois les multiplicateurs qui vont etre
  617. C elimines lors de la resolution car mode d'ensemble
  618. INEG=INEG-(NBLAG-NENSLX)
  619. if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX
  620. 4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS',
  621. 1' DE LAGRANGE DETECTES')
  622.  
  623. IF (IIMPI.EQ.1)WRITE(IOIMP,4821) NVSTOC
  624. 4821 FORMAT( ' CHOMOD NOMBRE DE VALEURS DANS LE PROFIL',I9)
  625. IF (IIMPI.EQ.1)WRITE(IOIMP,4822) NVSTOR
  626. 4822 FORMAT( ' CHOMOD NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I9)
  627. IF (IIMPI.EQ.1)WRITE(IOIMP,4823) NVaor
  628. 4823 FORMAT( ' CHOMOD NOMBRE DE VALEURS initiales',I9)
  629. INTERR(1)=NVSTOR
  630. reaerr(1)=nvstor/inc**(4./3)
  631. reaerr(2)=2*nbopit/1D6/max(1,(kcour-kcouri))
  632. IF (IPASV.EQ.0) CALL ERREUR(-278)
  633. IPASV=1
  634. SEGDES,MINCPO
  635. SEGDES,MIMIK
  636. SEGDES,MMATRI
  637. SEGDES,MILIGN
  638. SEGDES,MDIAG
  639. SEGDES,SNTO
  640. SEGDES,SNTT
  641. * verif re
  642.  
  643. SEGDES,XMATRI
  644. MMATRX=MMATRI
  645. SEGSUP KIVPO,KIVLO,ITMASQ
  646. segsup immt
  647. 9999 continue
  648. if (ithrd.eq.1) then
  649. call threadis
  650. call oooprl(0)
  651. endif
  652. RETURN
  653. END
  654.  
  655.  
  656.  
  657.  
  658.  
  659.  
  660.  
  661.  
  662.  
  663.  
  664.  
  665.  
  666.  
  667.  
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  
  677.  
  678.  
  679.  
  680.  
  681.  
  682.  
  683.  
  684.  
  685.  

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