Télécharger ldmt3.eso

Retour à la liste

Numérotation des lignes :

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

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