Télécharger chole.eso

Retour à la liste

Numérotation des lignes :

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

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