Télécharger ldmt3.eso

Retour à la liste

Numérotation des lignes :

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

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