Télécharger ldmt3.eso

Retour à la liste

Numérotation des lignes :

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

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