Télécharger chole.eso

Retour à la liste

Numérotation des lignes :

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

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