Télécharger ldmt3.eso

Retour à la liste

Numérotation des lignes :

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

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