Télécharger chomod.eso

Retour à la liste

Numérotation des lignes :

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

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