Télécharger chomod.eso

Retour à la liste

Numérotation des lignes :

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

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