Télécharger chole.eso

Retour à la liste

Numérotation des lignes :

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

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