Télécharger ldmt3.eso

Retour à la liste

Numérotation des lignes :

  1. C LDMT3 SOURCE PV 19/07/31 21:15:48 10276
  2. SUBROUTINE LDMT3(MMATRX,PREC)
  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. POINTEUR LIG2.LIGN, LIG3.LIGN
  10. POINTEUR L.LLIGN, M.LLIGN
  11. POINTEUR LL.MILIGN, MM.MILIGN, LILIGN.MILIGN
  12. POINTEUR LLL.LIGN, MMM.LIGN
  13. SEGMENT ITEMP
  14. REAL*8 P(INC)
  15. ENDSEGMENT
  16. C POINTEUR R.ITEMP,W.ITEMP
  17. C
  18. C **** MISE SOUS FORME A=L D Mt DE LA MATRICE MMATRX
  19. C
  20. -INC CCOPTIO
  21. -INC CCREEL
  22. -INC SMMATRI
  23.  
  24. -INC CCASSIS
  25. -INC CCHOLE
  26. SEGMENT KIVPO(IIMAX)
  27. SEGMENT KIVLO(IIMAX)
  28. SEGMENT ITMASM(NBLIG)
  29. SEGMENT ITMASL(NBLIGI)
  30. SEGMENT IMASQ(LMASQ)
  31. SEGMENT IMASQI(LMASQI)
  32. segment immt(nblig)
  33. external chole3i
  34. SAVE IPASV
  35. DATA IPASV/0/
  36. logical ngmpet
  37. C character*8 zen
  38. C equivalence (zen,izen)
  39. ** write (6,*) ' prec ',prec
  40.  
  41. ngmpet=.true.
  42. call timespv(ittime,oothrd)
  43. kcour=(ittime(1)+ittime(2))/10
  44. kcourp=kcour
  45. kcouri=kcour
  46. kdiff=0
  47. kcour=0
  48. perf=0.d0
  49. perfp=-1
  50. nbchan=1
  51. nbopit=0
  52. iposm=0
  53. C zen='CPU'//char(0)
  54. C le=4
  55. lolig=0
  56. nvaor=0
  57. nvaori=0
  58. nbthro=nbthrs
  59. ithrd=0
  60. if (nbthro.gt.1) then
  61. ithrd=1
  62. call threadii
  63. call oooprl(1)
  64. endif
  65. nbthr=nbthro
  66. do ith=1,nbthro
  67. nbop(ith)=0
  68. enddo
  69.  
  70. C nouvelle methode de gestion de l'espace memoire necessitee par la parallelisation
  71. C memoire vive totale
  72. MACTIT=OOOVAL(1,1)
  73. C un bloc de memoire fera au plus macti/2
  74. nvstrm=0
  75. MMATRI=MMATRX
  76. SEGACT,MMATRI*MOD
  77. PRCHLV=PREC
  78. LL =IILIGN
  79. MM =IILIGS
  80. SEGACT, MM*MOD,LL*MOD
  81. INO=MM.ILIGN(/1)
  82. MDIAG=IDIAG
  83. SEGACT,MDIAG*MOD
  84. NBLIG=INO
  85. NBLIGI=INO
  86. SEGINI ITMASM,ITMASL
  87. segini immt
  88. precc=prec
  89. INC=DIAG(/1)
  90. nvstrm=inc
  91. C INCC=INC
  92. MIMIK=IIMIK
  93. MINCPO=IINCPO
  94. SEGACT,MINCPO,MIMIK
  95. IPLUMI=IMIK(/2)*2 +4
  96. IL2=0
  97. IIMAX=IJMAX+IPLUMI
  98. SEGINI KIVPO,KIVLO
  99. INEG=0
  100. NBLAG=0
  101. NENSLX=0
  102. NVSTOC=0
  103. NVSTOR=0
  104. NVSTIC=0
  105. NVSTIR=0
  106. diagmax=xpetit/xzprec
  107. diagmin=xgrand
  108. do i=1,diag(/1)
  109. if (ll.ittr(i).eq.0) diagmax=max(diagmax,abs(diag(i)))
  110. if (ll.ittr(i).eq.0.and.abs(diag(i)).gt.xpetit/xzprec)
  111. > diagmin=min(diagmin,abs(diag(i)))
  112. enddo
  113. ** write (6,*) ' chole diagmin diagmax ',diagmin,diagmax,diag(/1)
  114. if (diagmax.le.xpetit/xzprec) then
  115. do i=1,diag(/1)
  116. diagmax=max(diagmax,abs(diag(i)))
  117. if (abs(diag(i)).gt.xpetit/xzprec)
  118. > diagmin=min(diagmin,abs(diag(i)))
  119. enddo
  120. endif
  121. diagmin=min(diagmin,diagmax)
  122. ** write (6,*) ' chole diagmin diagmax ',diagmin,diagmax,diag(/1)
  123. * ngmaxy vient de option
  124. * ngmaxx est la valeur autoajustee
  125. * ngmaxz est la valeur utilisee dans les tests (grande si il y a du debordement)
  126. ngmaxx=ngmaxy*2
  127. NGMAXZ=NGMAXX
  128.  
  129. C
  130. C **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD,
  131. C **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUDS
  132. C
  133. C **** LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX
  134. C
  135. 1 CONTINUE
  136. IVALMA=IJMAX+IPLUMI
  137. IL1=IL2+1
  138. IVALMI=IJMAX+IPLUMI
  139. IMINM=IL1
  140. IMINL=IL1
  141.  
  142. mactic=0
  143. DO 2 I=IL1,INO
  144. imasq=0
  145. imasqi=0
  146. m=0
  147. l=0
  148. lll=0
  149. mmm=0
  150.  
  151. M = MM.ILIGN(I)
  152. SEGACT /ERR=3/M
  153. NA=M.IMMMM(/1)
  154. NBPAR=NA+1
  155. NVALL=M.NJMAX
  156. NVALLL=NVALL
  157. lolig=nvall/na+1
  158. if (lolig.gt.2048.and.lolig.gt.3.*loligp/2.and.
  159. > mactic.gt.NGMAXZ*nbthro/2 .and.
  160. > i-il1.ge.nbthro) goto 3
  161. loligp=lolig
  162. mmm=0
  163. lll=0
  164. imasq=0
  165. imasqi=0
  166. SEGINI /ERR=3/MMM
  167.  
  168. L = LL.ILIGN(I)
  169. SEGACT /ERR=3/L
  170. NA=L.IMMMM(/1)
  171. NBPAR=NA+1
  172. NVALL= L.NJMAX
  173. NVILL=NVALL
  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+1.ge.nbthro) goto 3
  178. loligp=lolig
  179. lll=0
  180. SEGINI /ERR=3/LLL
  181. C recuperer la longueur du segment
  182. mactic=mactic+ooolen(MMM)+ooolen(LLL)
  183. if ((mactic.gt.mactit/2.or.mactic.gt.mactit-nvstrm*12)
  184. > .AND.I.GT.IL1) THEN
  185. SEGSUP LLL ,MMM
  186. GOTO 3
  187. endif
  188. NVSTOC=NVSTOC + NVALLL
  189. IVALMA=IVALMA + NVALLL
  190. NVSTIC=NVSTIC + NVALL
  191. IVALMI=IVALMI + NVALL
  192. NVALL=NVALLL
  193.  
  194. nvaor = nvaor + M.XXVA(/1)
  195. nvaori= nvaori+ L.XXVA(/1)
  196. C
  197. C **** DECOMPACTAGE
  198. C
  199. LMASQ=NVALL/MASDIM+2
  200. LMASQI=NVALLL/MASDIM+2
  201. IMASQ=0
  202. SEGINI /ERR=3/ IMASQ
  203. C WRITE(6,*)'Apres SEGINI, IMASQ(/1)=',IMASQ(/1),IMASQ
  204. IMASQI = 0
  205. SEGINI /ERR=3/ IMASQI
  206.  
  207. IPA=1
  208. NA=M.IMMMM(/1)
  209. DO 121 JPA=1,NA
  210. MMM.IVPO(JPA)=IPA
  211. KPA = M.IPPO(JPA+1)-M.IPPO(JPA)
  212. IPP = M.IPPO(JPA)
  213. MMM.IPPVV(JPA)=IPA-1
  214. LPA = M.LDEB(JPA)
  215. LPA1 = LPA-IPA
  216.  
  217. DO 122 MPA=1,KPA
  218. LLO = M.LINC(MPA+IPP)
  219. IPLA = LLO -LPA1
  220. MMM.VAL(IPLA)=M.XXVA(MPA+IPP)
  221. IMASQ(IPLA/MASDIM+1)=1
  222. if (ipla-ipa+1.ge.1) IMASQ((IPLA-ipa+1)/MASDIM+1)=1
  223. 122 CONTINUE
  224.  
  225. IPA=IPA+M.IMMMM(JPA)-LPA + 1
  226. Cpv MMM.IMMM(JPA)=MM.IPNO(LPA)
  227. MMM.IMMM(JPA)=LPA
  228. IF(IMINM .GT.MM.IPNO(LPA )) IMINM = MM.IPNO(LPA)
  229.  
  230. 121 CONTINUE
  231.  
  232. * indexation de imasq
  233. ipln=lmasq/na
  234. iplp=lmasq/na
  235. do 123 ipl=lmasq/na,1,-1
  236. if (imasq(ipl).gt.0) then
  237. imasq(ipl)=iplp*masdim
  238. ipln=ipl-1
  239. else
  240. imasq(ipl)=-ipln*masdim
  241. iplp=ipl-1
  242. endif
  243. 123 continue
  244. ** write (6,*) ' imasq ',lmasq/na
  245. ** write (6,*) (imasq(ipl),ipl=1,lmasq/na)
  246.  
  247. IPI=1
  248. NA=L.IMMMM(/1)
  249. DO 1210 JPA=1,NA
  250. LLL.IVPO(JPA)=IPI
  251. KPI =L.IPPO(JPA+1)-L.IPPO(JPA)
  252. IPPI=L.IPPO(JPA)
  253. LLL.IPPVV(JPA)=IPI-1
  254. LPAI =L.LDEB(JPA)
  255. LPA1I=LPAI-IPI
  256.  
  257. DO 1220 MPA=1,KPI
  258. LLO=L.LINC(MPA+IPPI)
  259. IPLA=LLO-LPA1I
  260. LLL.VAL(IPLA)=L.XXVA(MPA+IPPI)
  261. IMASQI(IPLA/MASDIM+1)=1
  262. if (ipla-ipi+1.ge.1) IMASQI((IPLA-ipi+1)/MASDIM+1)=1
  263. 1220 CONTINUE
  264.  
  265. IPI=IPI+L.IMMMM(JPA)-LPAI+ 1
  266. Cpv LLL.IMMM(JPA)=LL.IPNO(LPAI)
  267. LLL.IMMM(JPA)=LPAI
  268. IF(IMINL.GT.LL.IPNO(LPAI)) IMINL= LL.IPNO(LPAI)
  269. 1210 CONTINUE
  270. C*** **** ****
  271. * indexation de imasq
  272. ipln=lmasq/na
  273. iplp=lmasq/na
  274. do 1230 ipl=lmasq/na,1,-1
  275. if (imasqi(ipl).gt.0) then
  276. imasqi(ipl)=iplp*masdim
  277. ipln=ipl-1
  278. else
  279. imasqi(ipl)=-ipln*masdim
  280. iplp=ipl-1
  281. endif
  282. 1230 continue
  283. ** write (6,*) ' imasqi ',lmasq/na
  284. ** write (6,*) (imasqi(ipl),ipl=1,lmasq/na)
  285.  
  286. ITMASM(I)=IMASQ
  287. NA=M.IMMMM(/1)
  288. if (NA.gt.0) then
  289. MMM.IPREL=M.IMMMM(1)
  290. MMM.IDERL=M.IMMMM(NA)
  291. mm.lcara(2,i)=mmm.iprel
  292. mm.lcara(3,i)=mmm.iderl
  293. endif
  294. MMM.IPPVV(NA+1)=IPA-1
  295.  
  296. ITMASL(I)=IMASQI
  297. NA=L.IMMMM(/1)
  298. if (NA.gt.0) then
  299. LLL.IPREL=L.IMMMM(1)
  300. LLL.IDERL=L.IMMMM(NA)
  301. ll.lcara(2,i)=lll.iprel
  302. ll.lcara(3,i)=lll.iderl
  303. endif
  304. LLL.IPPVV(NA+1)=IPI-1
  305.  
  306. SEGSUP L,M
  307. LL.ILIGN(I)=LLL
  308. MM.ILIGN(I)=MMM
  309. nbths=nbthr
  310. C* write (6,*) 'longueur ligne ',nvall
  311. C nb de ligne multiple du nb de threads
  312. C blocage ligne lecture-ecriture pour minimiser le cache
  313. if (mod(i+1-il1,nbths).eq.0
  314. > .and.mactic.gt.NGMAXx*nbthro.OR.I+1-il1.gt.768)
  315. > then
  316. il2=i
  317. GOTO 4
  318. endif
  319.  
  320.  
  321. 2 CONTINUE
  322. IL2=INO
  323. GO TO 4
  324. 3 IL2=I-1
  325. if(m.ne.0) segdes m
  326. if(l.ne.0) segdes l
  327. if (imasq.ne.0) segsup imasq
  328. if (imasqi.ne.0) segsup imasqi
  329. if (lll.ne.0) segsup lll
  330. if (mmm.ne.0) segsup mmm
  331. 4 CONTINUE
  332. nbthro=nbthrs
  333. if (mactic.le.50000) nbthro=1
  334. nbthr=nbthro
  335. C WRITE(IOIMP,*) 'Mactic = ', mactic, nbthr
  336. C
  337. IF(IL2.GE.IL1) GO TO 40
  338. C
  339. C **** APPEL AUX ERREURS MESSAGE PAS ASSEZ DE PLACE MEMOIRE
  340. C
  341. C ITYP=48
  342. CALL ERREUR(48)
  343. if (ithrd.eq.1) then
  344. call threadis
  345. call oooprl(0)
  346. endif
  347. RETURN
  348. 40 CONTINUE
  349. IM=INC
  350. DO 352 IH=IL2,IL1,-1
  351. MMM=MM.ILIGN(IH)
  352. IL=INC
  353. DO 354 JH=1,MMM.IMMM(/1)
  354. IM=MIN(IM,MMM.IMMM(JH))
  355. IL=MIN(IL,MMM.IMMM(JH))
  356. 354 CONTINUE
  357.  
  358. MMM.IML=IL
  359. MMM.IMM=MM.ipno(IM)
  360. if (immt(ih).ne.0) then
  361. immt(ih)=min(immt(ih),mm.ipno(IM))
  362. else
  363. immt(ih)=mm.ipno(IM)
  364. endif
  365. 352 CONTINUE
  366. C 353 CONTINUE
  367. MMM=MM.ILIGN(IL1)
  368. IL11=MMM.IPREL
  369.  
  370. IM=INC
  371. DO 3520 IH=IL2,IL1,-1
  372. LLL=LL.ILIGN(IH)
  373. IL=INC
  374. DO 3540 JH=1,LLL.IMMM(/1)
  375. IM=MIN(IM,LLL.IMMM(JH))
  376. IL=MIN(IL,LLL.IMMM(JH))
  377. 3540 CONTINUE
  378.  
  379. LLL.IML=IL
  380. LLL.IMM=LL.ipno(IM)
  381. if (immt(ih).ne.0) then
  382. immt(ih)=min(immt(ih),ll.ipno(IM))
  383. else
  384. immt(ih)=ll.ipno(IM)
  385. endif
  386. 3520 CONTINUE
  387. C 3530 CONTINUE
  388. LLL=LL.ILIGN(IL1)
  389. IL22=LLL.IPREL
  390. C
  391. C **** BOUCLE *5* TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE
  392. C
  393. C lig1=MM.ilign(IMINM)
  394. C lig2=LL.ilign(IMINL)
  395.  
  396. ipos=0
  397. iper=IMINM
  398. ider=IMINM-1
  399. iderac=IMINM-1
  400. if (ngmaxz.lt.ngmaxx*4.and.ngmpet) ngmaxz=ngmaxx*2
  401. macsec=0
  402. isec=0
  403.  
  404.  
  405. IMINA=MIN(IMINM,IMINL)
  406. IMIN = IMINA
  407. DO 5 I=IMINA,IL2
  408. IMASQ =ITMASM(I)
  409. IMASQI=ITMASL(I)
  410. LIG1=MM.ILIGN(I)
  411. LIG2=LL.ILIGN(I)
  412. IF(I.LT.IL1) GO TO 7
  413. C
  414. C ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A
  415. C ******* IPREL IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER
  416. C ******* LE TERME DIAGONAL
  417. C
  418.  
  419. C on s'occupe d'abord de la partie superieur
  420. LIGN=LIG1
  421. NAA= IMMM(/1)
  422.  
  423. DO 156 KHG=1,NAA
  424. LIGN=LIG1
  425. II=IPREL-1+KHG
  426. IMMM(KHG)=0
  427. NN1=IPPVV(KHG+1)
  428. NNM1=IPPVV(KHG)
  429. NNM1S=NNM1
  430. N=NN1-NNM1
  431. DIAG(II)=VAL(NN1)
  432. IF(N.EQ.1) GO TO 8
  433. NMI=N-II
  434. IDEP=MAX(IL11,2-NMI)
  435. KIDEP=IDEP+NMI
  436. KI1=N-1
  437. KQ=-NMI
  438. C WRITE(IOIMP,*)'Avant CHOLI1, Imasq(/1)=',Imasq(/1)
  439. * WRITE(IOIMP,*)'Avant CHOLI1-1 ',val(nn1)
  440. diagref=0.d0
  441. VAL(NN1)=VAL(NN1)+
  442. # CHOLI1(LL.ILIGN,LIG2,LIG1.VAL(1+IPPVV(KHG)),DIAG(1-NMI),
  443. # LL.IPNO(1-NMI),LIG1.IPPVV(1),KHG,LIG1.IVPO(1),KIDEP,KI1,
  444. # KQ,IMASQ(1),1+IPPVV(KHG),PREC,1,nbop(1),diagref)
  445. imasq(nn1/masdim+1)=1
  446. imasq(n/masdim+1)=1
  447. 8 CONTINUE
  448.  
  449. LIGN=LIG2
  450. II=IPREL-1+KHG
  451. IMMM(KHG)=0
  452. NN2=IPPVV(KHG+1)
  453. NNM1=IPPVV(KHG)
  454. N=NN2-NNM1
  455. IF(N.EQ.1) GO TO 88
  456. NMI=N-II
  457. IDEP=MAX(IL22,2-NMI)
  458. KIDEP=IDEP+NMI
  459. KI1=N-1
  460. KQ=-NMI
  461. * WRITE(IOIMP,*)'Avant CHOLI1-2 ',val(nn2)
  462. VAL(NN2)=VAL(NN2)+
  463. # CHOLI1(MM.ILIGN,LIG1,LIG2.VAL(1+IPPVV(KHG)),DIAG(1-NMI),
  464. # MM.IPNO(1-NMI),LIG2.IPPVV(1),KHG,LIG2.IVPO(1),KIDEP,KI1,
  465. # KQ,IMASQI(1),1+IPPVV(KHG),PREC,2,nbop(1),diagref)
  466. IMASQI(nn2/masdim+1)=1
  467. IMASQI(n/masdim+1)=1
  468. 88 CONTINUE
  469. LIGN=LIG1
  470. diagref=max(abs(diag(ii)),diagmin)
  471. diagcmp=diagref*1d-10
  472. IF(LL.ITTR(II).EQ.0.AND.
  473. & ABS(LIG2.VAL(NN2)).GT.diagcmp) GO TO 12
  474. IF(LL.ITTR(II).NE.0.AND.
  475. & ABS(LIG2.VAL(NN2)).GT.diagcmp) GO TO 12
  476. C il faut mettre une valeur plus grande sur les LX car on a un probleme de conditionnement
  477. C sur le calcul des reactions en cas de 2 relations presque identique
  478. C
  479. C **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE
  480. C **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT
  481. C **** AU PREALABLE SUR CETTE INCONNUE.
  482. C
  483. ** write (6,*) ' ldmt3 mode d ensemble ittr ligne ',
  484. ** > ll.ittr(ii),ii,diag(ii),val(nn2)
  485. C on garde le signe car il fau un moins sur les ML
  486.  
  487. if(LL.ittr(ii).NE.0) then
  488. LIG2.VAL(NN2)=LIG2.VAL(NN2)-4.D0*diagref
  489. NENSLX=NENSLX+1
  490. else
  491. LIG2.VAL(NN2)=diagref
  492. endif
  493. NENS=NENS+1
  494. LIG2.IMMM(KHG)=NENS
  495. LIG1.IMMM(KHG)=NENS
  496. 12 CONTINUE
  497.  
  498.  
  499. DIAG(II)=LIG2.VAL(NN2)
  500. IF(DIAG(II).NE.0.D0) GO TO 41
  501.  
  502. KQ1=1+NNM1S
  503. KQN=N+NNM1S
  504. DO 16 LFG=KQ1,KQN
  505. IF(LIG1.VAL(LFG).NE.0.D0) GO TO 17
  506. 16 CONTINUE
  507.  
  508. KQ1=1+NNM1
  509. KQN=N+NNM1
  510. DO 160 LFG=KQ1,KQN
  511. IF(LIG2.VAL(LFG).NE.0.D0) GO TO 170
  512. 160 CONTINUE
  513.  
  514. DIAG(II)=1.D0
  515. if (LL.ittr(ii).ne.0) diag(ii)=-1.D0
  516. LIG2.VAL(NN2)=DIAG(II)
  517. GO TO 41
  518. 17 CONTINUE
  519. C write (6,*) ' ldmt3 apres 17 ',val(lfg)
  520. diag(ii)=LIG1.VAL(LFG)
  521. goto 171
  522. 170 CONTINUE
  523. diag(ii)=LIG2.VAL(LFG)
  524. 171 continue
  525. if (LL.ittr(ii).ne.0) diag(ii)=-abs(diag(ii))
  526. *** LIG2.val(nn2)=diag(ii)
  527. GOTO 41
  528. C
  529. C **** ENVOI ERREUR MATRICE SINGUIERE
  530. C
  531. C ITYP=49
  532. INTERR(1)=I
  533. CALL ERREUR(49)
  534. if (ithrd.eq.1) then
  535. call threadis
  536. call oooprl(0)
  537. endif
  538. RETURN
  539. C
  540. C **** ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS
  541. C ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  542. C
  543. 41 IF(DIAG(II).LT.0.D0) INEG=INEG+1
  544. IF(LL.ITTR(II).NE.0) NBLAG=NBLAG+1
  545. LIG1.VAL(NN1)=DIAG(ii)
  546. 156 CONTINUE
  547. C
  548. C RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE)
  549. C d'abord la triangulaire superieure
  550. C
  551. NA=LIG1.IMMM(/1)
  552. NBPAR=NA+1
  553. if (na.gt.0)
  554. > CALL COMPAC(LIG1.VAL(1),NBPAR,KIVPO(1),KIVLO(1),
  555. # NVALL,LIG1.IPPVV(1),IZROSF,NA,PREC,imasq(1),
  556. # LIG1.IPREL,LIG1.IDERL)
  557. segsup IMASQ
  558. IMASQ=ITMASM(I)
  559.  
  560. C on recree lig1 car la compacter en place emiette la memoire
  561. lig3=lig1
  562. segini /err=1431/ lig3
  563. 1431 continue
  564. do it=1,nvall
  565. lig3.val(it)=lig1.val(it)
  566. enddo
  567. do it=1,na
  568. lig3.immm(it)=lig1.immm(it)
  569. lig3.ippvv(it)=lig1.ippvv(it)
  570. enddo
  571. lig3.ippvv(na+1)=lig1.ippvv(na+1)
  572. lig3.iml=lig1.iml
  573. lig3.iprel=lig1.iprel
  574. lig3.iderl=lig1.iderl
  575. mm.lcara(1,i)=lig3.iml
  576. mm.lcara(2,i)=lig3.iprel
  577. mm.lcara(3,i)=lig3.iderl
  578. if (lig3.ne.lig1) then
  579. segsup lig1
  580. else
  581. segadj lig3
  582. endif
  583. lig1=lig3
  584. mm.ilign(i)=lig3
  585. NVSTOR=NVSTOR+NVALL
  586. nvstrm=max(nvstrm,nvall)
  587. DO 143 LHG=1,NBPAR
  588. LIG1.IVPO(2*LHG-1)=KIVPO(LHG)
  589. LIG1.IVPO(2*LHG) =KIVLO(LHG)
  590. 143 CONTINUE
  591. C
  592. C RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE)
  593. C puis la triangulaire inférieure
  594. C
  595. NA=LIG2.IMMM(/1)
  596. NBPAR=NA+1
  597. if (na.gt.0)
  598. > CALL COMPAC(LIG2.VAL(1),NBPAR,KIVPO(1),KIVLO(1),
  599. # NVILL,LIG2.IPPVV(1),IZROSF,NA,PREC,imasqi(1),
  600. # LIG2.IPREL,LIG2.IDERL)
  601. segsup IMASQI
  602. IMASQI=ITMASL(I)
  603.  
  604. NVALL=NVILL
  605. C on recree lig2 car la compacter en place emiette la memoire
  606. C WRITE(IOIMP,*) 'Valeur de LIG2', LIG2
  607. lig3=lig2
  608. segini /err=1432/ lig3
  609. 1432 continue
  610. do it=1,nvall
  611. lig3.val(it)=lig2.val(it)
  612. enddo
  613. do it=1,na
  614. lig3.immm(it)=lig2.immm(it)
  615. lig3.ippvv(it)=lig2.ippvv(it)
  616. enddo
  617. lig3.ippvv(na+1)=lig2.ippvv(na+1)
  618. lig3.iml=lig2.iml
  619. lig3.iprel=lig2.iprel
  620. lig3.iderl=lig2.iderl
  621. ll.lcara(1,i)=lig3.iml
  622. ll.lcara(2,i)=lig3.iprel
  623. ll.lcara(3,i)=lig3.iderl
  624. if (lig3.ne.lig2) then
  625. segsup lig2
  626. else
  627. segadj lig3
  628. endif
  629. lig2=lig3
  630. ll.ilign(i)=lig2
  631. NVSTIR=NVSTIR+NVILL
  632. nvstrm=max(nvstrm,nvIll)
  633. DO 1430 LHG=1,NBPAR
  634. LIG2.IVPO(2*LHG-1)=KIVPO(LHG)
  635. LIG2.IVPO(2*LHG) =KIVLO(LHG)
  636. 1430 CONTINUE
  637.  
  638.  
  639.  
  640.  
  641.  
  642. IF (I.GT.1) THEN
  643. LIG1=MM.ILIGN(I-1)
  644. LIG2=LL.ILIGN(I-1)
  645. SEGDES LIG1,LIG2
  646. IDERAC=MIN(IDERAC,I-2)
  647. ENDIF
  648.  
  649. C
  650. C **** ON TRIANGULARISE LES AUTRES LIGNES
  651. C
  652.  
  653. IL1=IL1+1
  654. IF (IL1.GT.IL2) GOTO 5
  655. LIG1=MM.ILIGN(I)
  656. LIGN=MM.ILIGN(IL1)
  657. IL11=IPREL
  658. LIG2=LL.ILIGN(I)
  659. LIGN=LL.ILIGN(IL1)
  660. IL22=IPREL
  661. GOTO 7
  662. C 72 CONTINUE
  663. 71 CONTINUE
  664. if (iper.gt.ider) then
  665. call erreur(48)
  666. return
  667. endif
  668.  
  669.  
  670. IF (I.LT.IL1-10) THEN
  671. * en mode lent, on alloue plus de place pour les lignes en calcul
  672. NGMAXZ= INT(OOOVAL(1,1)/(NBTHS*0.90))*2.
  673. ngmpet=.false.
  674. C** WRITE (6,*) ' PASSAGE AU GRAND NGMAX ',I,IL1,IL2,NGMAXZ
  675. ENDIF
  676. IF (ISEC.NE.0) IDER=ISEC
  677. MACSEC=0
  678. ISEC=0
  679. C SOIT PARCE QU'ON A FINI, SOIT PARCE QU'ON MANQUE DE MEMOIRE
  680. C IL FAUT EXECUTER LES LIGNES ACTIVEES PUIS LES DESACTIVER
  681. C LANCER LES CHOLE3 ET ATTENDRE QU'ILS SOIENT FINIS
  682. IF (IPOS.NE.0) THEN
  683. C WRITE (6,*) ' LANCEMENT THREAD ',IPER,IDER,IL1,IL2
  684. IF (IPER.GT.IDER) THEN
  685. WRITE (6,*) ' ERREUR INTERNE CHOLE '
  686. CALL ERREUR(5)
  687. ENDIF
  688. C WRITE (6,*) ' NBTHR-2 ',NBTHR
  689.  
  690.  
  691. NBTHR=MIN(NBTHR,IL2-IL1+1)
  692. C WRITE (6,*) ' NBTHR-3 ',NBTHR
  693. IF (NBTHR.GE.1) THEN
  694. MILIGN=MM
  695. LILIGN=LL
  696. C Write(6,*) 'ldmt3.eso On passe LL dans LILIGN : ', LILIGN
  697. ITMASQ=ITMASM
  698. DO ITH=2,NBTHR
  699. CALL THREADID(ITH,CHOLE3I)
  700. ENDDO
  701. CALL CHOLE3I(1)
  702. DO ITH=2,NBTHR
  703. CALL THREADIF(ITH)
  704. ENDDO
  705.  
  706. MILIGN=LL
  707. LILIGN=MM
  708. C Write(6,*) 'ldmt3.eso On passe MM dans LILIGN : ', LILIGN
  709. ITMASQ=ITMASL
  710. DO ITH=2,NBTHR
  711. CALL THREADID(ITH,CHOLE3I)
  712. ENDDO
  713. CALL CHOLE3I(1)
  714. DO ITH=2,NBTHR
  715. CALL THREADIF(ITH)
  716. ENDDO
  717.  
  718. ELSE
  719. MILIGN=MM
  720. LILIGN=LL
  721. ITMASQ=ITMASM
  722. DO ITH=1,NBTHR
  723. CALL CHOLE3I(ITH)
  724. ENDDO
  725.  
  726. MILIGN=LL
  727. LILIGN=MM
  728. ITMASQ=ITMASL
  729. DO ITH=1,NBTHR
  730. CALL CHOLE3I(ITH)
  731. ENDDO
  732. ENDIF
  733. ENDIF
  734. * test ctrlC
  735. if (ierr.ne.0) goto 9999
  736.  
  737. IPOSM=MAX(IPOSM,IPOS)
  738. IPOS=0
  739. IDERF=IDER-1
  740. IF (IDER.NE.IL1-1) IDERF=IDER
  741. DO IL=IDERF,IPER,-1
  742. LIGN=MM.ILIGN(IL)
  743. SEGDES LIGN
  744. LIGN=LL.ILIGN(IL)
  745. SEGDES LIGN
  746. C WRITE (6,*) ' DESACTIVATION LIGNE & COLONNE ',IL
  747. ENDDO
  748. IDERAC=MIN(IDERAC,IPER-1)
  749. IPER=IDER+1
  750. C WRITE (6,*) ' IPER IDER IL1 ',IPER,IDER,IL1
  751. IF (IPER.NE.IL1) GOTO 7
  752. GOTO 5
  753. 7 CONTINUE
  754.  
  755.  
  756. SEGACT/ERR=71/LIG1
  757. SEGACT/ERR=71/LIG2
  758. IPOS=IPOS+1
  759. IDER=I
  760. IF (I.GT.IDERAC) IDERAC=I
  761. IF (I.EQ.IL1-1) GOTO 71
  762. 5 CONTINUE
  763.  
  764. DO 11 I=IL1,IL2
  765. LLL=LL.ILIGN(I)
  766. MMM=MM.ILIGN(I)
  767. C Write(6,*)' SEGDES de LLL, MMM : ',LLL,MMM
  768. SEGDES,LLL,MMM
  769. 11 CONTINUE
  770. nbopt=0
  771. do ith=1,nbthro
  772. nbopt=nbopt+nbop(ith)
  773. nbop(ith)=0
  774. enddo
  775. nbopin=nbopt
  776. nbopit=nbopit+nbopin
  777. call timespv(ittime,oothrd)
  778. kcourp=kcour
  779. kcour=(ittime(1)+ittime(2))/10
  780. kdiff=kcour-kcourp
  781. ** write (6,*) ' nb operation temps ',nbopin,kdiff
  782. if (kdiff.gt.5) then
  783. perf=nbopin/kdiff
  784. ** write (6,*) 'perf ngmaxy il1 il2',perf,ngmaxy,il1i,il2
  785. if (perf.lt.perfp*0.90 .and.nbchan.ne.1 ) then
  786. nbchan=1
  787. ngmaxx=ngmaxx*0.90
  788. perfp=perf
  789. elseif (nbchan.eq.0) then
  790. nbchan=-1
  791. ngmaxx=ngmaxx*1.10
  792. perfp=max(perf,perfp)
  793. else
  794. nbchan=0
  795. endif
  796. ** nbchan=0
  797. ngmaxx=max(10000,min(1000000000,ngmaxx))
  798. if (ngmpet) ngmaxz=ngmaxx
  799. endif
  800.  
  801. iderac=min(iderac,il1-1)
  802. macsec=0
  803. isec=0
  804. IF(IL2.LT.INO) GO TO 1
  805. C ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF
  806. C ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  807. C INEG=INEG-NBLAG
  808. C on ne compte pas 2 fois les multiplicateurs qui vont etre
  809. C elimines lors de la resolution car mode d'ensemble
  810. INEG=INEG-(NBLAG-NENSLX)
  811. if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX
  812. 4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS',
  813. 1' DE LAGRANGE DETECTES')
  814.  
  815. IF (IIMPI.EQ.1) WRITE(IOIMP,4821) NVSTOC+NVSTIC
  816. 4821 FORMAT( ' NOMBRE DE VALEURS DANS LE PROFIL',I12)
  817. IF (IIMPI.EQ.1) WRITE(IOIMP,4822) NVSTOR+NVSTIR
  818. 4822 FORMAT( ' NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I12)
  819. IF (IIMPI.EQ.1) WRITE(IOIMP,4823) NVaor+NVaori
  820. 4823 FORMAT( ' NOMBRE DE VALEURS initiales',I12)
  821. INTERR(1)=NVSTOR+NVSTIR
  822. reaerr(1)=nvstor/inc**(4./3)
  823. reaerr(2)=2*nbopit/1D6/max(1,(kcour-kcouri))
  824. IF (IPASV.EQ.0) CALL ERREUR(-278)
  825. IPASV=1
  826. SEGDES,MINCPO
  827. SEGDES,MIMIK
  828. SEGDES,MMATRI
  829. SEGDES,LL,MM
  830. SEGDES,MDIAG
  831. MMATRX=MMATRI
  832. SEGSUP KIVPO,KIVLO,ITMASM,ITMASL
  833. segsup immt
  834. 9999 continue
  835. if (ithrd.eq.1) then
  836. call threadis
  837. call oooprl(0)
  838. endif
  839. RETURN
  840. END
  841.  
  842.  
  843.  
  844.  
  845.  
  846.  
  847.  
  848.  
  849.  
  850.  
  851.  
  852.  
  853.  
  854.  
  855.  
  856.  
  857.  
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.  
  869.  
  870.  
  871.  
  872.  
  873.  
  874.  

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