Télécharger chomod.eso

Retour à la liste

Numérotation des lignes :

chomod
  1. C CHOMOD SOURCE PV 22/10/14 11:58:20 11482
  2. C
  3. C DECOMPOSITION DE CROUT MODIFIEE POUR LE CALCUL DES MATRICES
  4. C CONDENSEES D'UN SUPER-ELEMENT
  5. C RESULTAT DANS XMATRI
  6. C
  7. SUBROUTINE CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATRI,NLIGRA)
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. C TANT QUE OOOVAL(1,4) NE MARCHE PAS SUR CRAY
  11. PARAMETER (LPCRAY=10000)
  12. INTEGER OOOVAL,ILIMITE,OOOLEN
  13. dimension ittime(4)
  14. SEGMENT ITMASQ(NBLIG)
  15. SEGMENT IMASQ(LMASQ)
  16. segment immt(nblig)
  17. segment igarde(nvstrm)
  18. POINTEUR LILIGN.MILIGN
  19. external chole3i
  20. C
  21. LOGICAL TEST1,LIMIT
  22. C
  23. C **** MISE SOUS FORME A=Lt D L DE LA MATRICE MMATRX
  24. C
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCREEL
  29. -INC SMMATRI
  30. -INC SMRIGID
  31. -INC CCASSIS
  32. -INC CCHOLE
  33. -INC SMELEME
  34. C
  35. SEGMENT SNTO
  36. INTEGER NTOTMA(NN)
  37. ENDSEGMENT
  38. C
  39. SEGMENT SNTT
  40. INTEGER NTTMAI(NN)
  41. ENDSEGMENT
  42. C
  43. SEGMENT KIVPO(IIMAX)
  44. SEGMENT KIVLO(IIMAX)
  45. SAVE IPASV
  46. DATA IPASV/0/
  47. logical ngmpet
  48. C character*8 zen
  49. C equivalence (zen,izen)
  50. logical lsgdes,pasfait,ngdyn
  51. nbnnmc=nbnnma
  52.  
  53. prec=xpetit
  54. pasfait=.true.
  55. lsgdes=.false.
  56. * faire attention a respecter l'ordre des segdes par la suite
  57. call ooomru(1)
  58. condmax=0.d0
  59. condmin=xgrand
  60. ngmpet=.false.
  61. ngdyn=.true.
  62. call timespv(ittime,oothrd)
  63. kcour=(ittime(1)+ittime(2))/10
  64. kcourp=kcour
  65. kcouri=kcour
  66. kdiff=0
  67. kcour=0
  68. perf=0.d0
  69. perfp=-1
  70. nbchan=1
  71. nbopit=0
  72. iposm=0
  73. C zen='CPU'//char(0)
  74. C le=4
  75. lolig=0
  76. nvaor=0
  77. nbthro=nbthrs
  78. ithrd=0
  79. if (nbthro.gt.1) then
  80. ithrd=1
  81. call threadii
  82. call oooprl(1)
  83. endif
  84. nbthr=nbthro
  85. do ith=1,nbthr
  86. nbop(ith)=0
  87. enddo
  88. stmult=1d-5
  89.  
  90. C nouvelle methode de gestion de l'espace memoire necessitee par la parallelisation
  91. C memoire vive totale
  92. MACTIT=OOOVAL(1,1)
  93. C un bloc de memoire fera au plus macti/2
  94. call intpdo(inpdo)
  95. nvstrm=mactit/10
  96. MMATRI=MMATRX
  97. SEGACT,MMATRI*MOD
  98. PRCHLV=PREC
  99. MILIGN=IILIGN
  100.  
  101. SEGACT,MILIGN*MOD
  102. INO=ILIGN(/1)
  103. MDIAG=IDIAG
  104. SEGACT,MDIAG*MOD
  105. NBLIG=INO
  106. segini immt
  107. SEGINI ITMASQ
  108. precc=prec
  109. INC=DIAG(/1)
  110. nvstrm=max(inc*inpdo,nvstrm)
  111. ** write(6,*) ' nvstrm ',nvstrm
  112. INCC=INC
  113. MIMIK=IIMIK
  114. MINCPO=IINCPO
  115. SEGACT,MINCPO,MIMIK
  116. IPLUMI=IMIK(/2)*2 +4
  117. IL2=0
  118. IIMAX=IJMAX+IPLUMI
  119. SEGINI KIVPO,KIVLO
  120. INEG=0
  121. NBLAG=0
  122. NENSLX=0
  123. NVSTOC=0
  124. NVSTOR=0
  125. NLIGRP=NLIGRA
  126. NLIGRD=NLIGRA
  127. diagmax=xpetit/xzprec
  128. diagmin=xgrand
  129. do i=1,diag(/1)
  130. if (ittr(i).eq.0) diagmax=max(diagmax,abs(diag(i)))
  131. if (ittr(i).eq.0.and.abs(diag(i)).gt.xpetit/xzprec)
  132. > diagmin=min(diagmin,abs(diag(i)))
  133. enddo
  134. if (diagmax.le.xpetit/xzprec) then
  135. do i=1,diag(/1)
  136. diagmax=max(diagmax,abs(diag(i)))
  137. if (abs(diag(i)).gt.xpetit/xzprec)
  138. > diagmin=min(diagmin,abs(diag(i)))
  139. enddo
  140. endif
  141. diagmin=min(diagmin,diagmax)
  142. *** write (6,*) ' chole diagmin diagmax ',diagmin,diagmax,diag(/1)
  143. C
  144. C
  145. nelrig=1
  146. SEGINI,XMATRI
  147. matric=xmatri
  148. C
  149. C** ILIMITE = nb de noeuds qui ne sont pas maitres
  150. C
  151. SEGACT,SNTO
  152. SEGACT,SNTT
  153. ILIMITE = INO - (NTOTMA(/1) + NTTMAI(/1))
  154. ** write(6,*) ' nbnnma,ntotma nttmai ',nbnnma,ntotma(/1),nttmai(/1)
  155.  
  156.  
  157.  
  158.  
  159. TEST1=.FALSE.
  160. IF(ILIMITE.EQ.0) THEN
  161. IL2=0
  162. TEST1=.TRUE.
  163. ENDIF
  164.  
  165. LIMIT=.FALSE.
  166. C
  167. C **** DEBUT DE LA TRIANGULARISATION. ON PREND NOEUD A NOEUD,
  168. C **** DECOMPACTAGE PUIS TRAVAIL SUR LES LIGNES DU NOEUD
  169. C
  170. C **** LA LONGUEUR DE LA PLUS GRANDE LIGNE EST DONNEE PAR IMAX
  171. C
  172. 1 CONTINUE
  173. IF (TEST1) LIMIT=.TRUE.
  174. C
  175. IVALMA=IJMAX+IPLUMI
  176. IL1=IL2+1
  177.  
  178. IMIN=IL1
  179. * reserver de la place ou mettre les lignes superieures dans le cas debordement
  180. igarde=0
  181. if (ngmpet) then
  182. segini igarde
  183. ** write(6,*) 'segini igarde',nvstrm
  184. endif
  185. DO 2 I=IL1,INO
  186. ngdyn=.true.
  187. imasq=0
  188. LIGN=0
  189.  
  190. LLIGN= ILIGN(I)
  191. SEGACT /ERR=32/LLIGN
  192. goto 31
  193. 32 continue
  194. ** write(6,*) ' segact llign erreur',i,il1,lsgdes
  195. if (.not.lsgdes) then
  196. ** write(6,*) ' lsgdes 1 '
  197. lsgdes=.true.
  198. ***** ngmpet=.true.
  199. ** write(6,*) 'desactivation-1 ',1,il1-1
  200. do it=il1-1,1,-1
  201. lign=ilign(it)
  202. segdes lign
  203. enddo
  204. if(igarde.eq.0) segini igarde
  205. else
  206. goto 3
  207. endif
  208. SEGACT /ERR=3/LLIGN
  209. 31 continue
  210. NA= IMMMM(/1)
  211. NBPAR=NA+1
  212. NVALL= NJMAX
  213. *pv write (6,*) ' chole ligne noeud inconnues ',i,ipno(i),na,nvall
  214. lolig=nvall/na+1
  215. * Si separateur derriere on se prepare pour lui
  216. ** if (lolig.gt.8192.and.lolig.gt.5*loligp/3.and.
  217. ** > i-il1+1.ge. nbthrs/2+1) goto 3
  218. loligp=lolig
  219. SEGINI /ERR=33/ LIGN
  220. goto 34
  221. 33 continue
  222. ** write(6,*) ' segini lign erreur',il1
  223. if (.not.lsgdes) then
  224. ** write(6,*) ' lsgdes 2 '
  225. lsgdes=.true.
  226. ***** ngmpet=.true.
  227. ** write(6,*) 'desactivation-2 ',1,il1-1
  228. do it=il1-1,1,-1
  229. lign=ilign(it)
  230. segdes lign
  231. enddo
  232. if(igarde.eq.0) segini igarde
  233. else
  234. goto 3
  235. endif
  236. SEGINI /ERR=3/ LIGN
  237. ** write(6,*) 'deuxieme essai lign ok'
  238. 34 continue
  239. C recuperer la longueur du segment
  240. lglig=(nvall/na)**1.333333333333333333
  241. ** if(lglig.gt.1000000) write(6,*) 'i lglig ',i,lglig
  242. C* > .AND.I.GT.IL1) THEN
  243. C* SEGSUP LIGN
  244. C* GOTO 3
  245. C* endif
  246. NVSTOC=NVSTOC + NVALL
  247. IVALMA=IVALMA + NVALL
  248.  
  249.  
  250. nvaor = nvaor + xxva(/1)
  251. C
  252. C **** DECOMPACTAGE
  253. C
  254. LMASQ=NVALL/MASDIM+2
  255. SEGINI /ERR=35/ IMASQ
  256. goto 36
  257. 35 continue
  258. ** write(6,*) ' segini masq erreur',il1
  259. if (.not.lsgdes) then
  260. ** write(6,*) ' lsgdes 3 '
  261. lsgdes=.true.
  262. ***** ngmpet=.true.
  263. ** write(6,*) 'desactivation-3 ',1,il1-1
  264. do it=il1-1,1,-1
  265. lign=ilign(it)
  266. segdes lign
  267. enddo
  268. if(igarde.eq.0) segini igarde
  269. else
  270. goto 3
  271. endif
  272. SEGINI /ERR=3/ IMASQ
  273. 36 continue
  274. IPA=1
  275. DO 121 JPA=1,NA
  276. IVPO(JPA)=IPA
  277. KPA = IPPO(JPA+1)- IPPO(JPA)
  278. IPP = IPPO(JPA)
  279. IPPVV(JPA)=IPA-1
  280. LPA = LDEB(JPA)
  281. LPA1 = LPA-IPA
  282.  
  283. DO 122 MPA=1,KPA
  284. LL = LINC(MPA+IPP)
  285. IPLA = LL -LPA1
  286. VAL(IPLA)= XXVA(MPA+IPP)
  287. IMASQ(IPLA/MASDIM+1)=1
  288. if (ipla-ipa+1.ge.1) IMASQ((IPLA-ipa+1)/MASDIM+1)=1
  289. 122 CONTINUE
  290.  
  291. IPA=IPA+ IMMMM(JPA)-LPA + 1
  292. Cpv IMMM(JPA)= IPNO(LPA)
  293. IMMM(JPA)=LPA
  294. IF(IMIN .GT. IPNO(LPA )) IMIN = IPNO(LPA)
  295. 121 CONTINUE
  296. * indexation de imasq
  297. ipln=lmasq/na
  298. iplp=lmasq/na
  299. do 123 ipl=lmasq/na,1,-1
  300. if (imasq(ipl).gt.0) then
  301. imasq(ipl)=iplp*masdim
  302. ipln=ipl-1
  303. else
  304. imasq(ipl)=-ipln*masdim
  305. iplp=ipl-1
  306. endif
  307. 123 continue
  308. ** write (6,*) ' imasq ',lmasq/na
  309. ** write (6,*) (imasq(ipl),ipl=1,lmasq/na)
  310. C*** **** ****
  311. ITMASQ(I)=IMASQ
  312.  
  313.  
  314. if (na.gt.0) then
  315. IPREL= IMMMM(1)
  316. IDERL= IMMMM(NA)
  317. lcara(2,i)=iprel
  318. lcara(3,i)=iderl
  319. endif
  320. IPPVV(NA+1)=IPA-1
  321. SEGSUP LLIGN
  322. ILIGN(I)=LIGN
  323. IF(IIMPI.EQ.1525) THEN
  324. WRITE( IOIMP,4987) I
  325. 4987 FORMAT (' NOEUD NUMERO ',I5)
  326. LL=VAL(/1)
  327. WRITE(IOIMP, 4926)(VAL(MPA),MPA=1,LL)
  328. 4926 FORMAT(' VAL ' , 10E11.4)
  329. ENDIF
  330. C
  331. IF ((I.EQ.(ILIMITE)).AND.(.NOT.TEST1)) THEN
  332. TEST1=.TRUE.
  333. IL2 = I
  334. GOTO 4
  335. ENDIF
  336. C* write (6,*) 'longueur ligne ',nvall
  337. C nb de ligne multiple du nb de threads
  338. C blocage ligne lecture-ecriture pour minimiser le cache
  339. C on note si on est au minimum de lignes
  340. C si on est dans les noeuds maitres on prend tout ce qu'on peut
  341. if (i.ge.ilimite) then
  342. nbthro=nbthrs*(128000000/lglig+1)
  343. else
  344. nbthro=min(nbthrs,lglig/400+1)
  345. endif
  346. if (i+1-il1.ge.nbthro.and.(.not.ngmpet)) then
  347. nbthro=min(nbthrs,i+1-il1)
  348. ngdyn=.true.
  349. if(i+1-il1.eq.nbthrs) ngdyn=.false.
  350. il2=i
  351. GOTO 4
  352. endif
  353. 2 CONTINUE
  354. IL2=INO
  355. GO TO 4
  356. 3 IL2=I-1
  357. loligp=lolig
  358. ** write(6,*) 'desactivation-4 ',llign
  359. segdes llign
  360. if (imasq.eq.0.and.lign.ne.0) segsup lign
  361. 4 CONTINUE
  362. nbthro=min(nbthrs,nbthro)
  363. nbthr=nbthro
  364. C
  365. IF(IL2.GE.IL1) GO TO 40
  366. C
  367. C **** APPEL AUX ERREURS MESSAGE PAS ASSEZ DE PLACE MEMOIRE
  368. C
  369. C ITYP=48
  370. CALL ERREUR(48)
  371. call ooodmp(0)
  372. if (ithrd.eq.1) then
  373. call threadis
  374. call oooprl(0)
  375. endif
  376. call ooomru(0)
  377. RETURN
  378. 40 CONTINUE
  379. if (igarde.ne.0) then
  380. segsup igarde
  381. ** write(6,*) 'segsup igarde il1 il2 ',il1,il2
  382. endif
  383. IM=INC
  384.  
  385.  
  386.  
  387.  
  388. DO 352 IH=IL2 ,IL1,-1
  389. LIGN= ILIGN(IH )
  390. IL=INC
  391. DO 354 JH=1, IMMM(/1)
  392. IM=MIN(IM, IMMM(JH))
  393. IL=MIN(IL, IMMM(JH))
  394. 354 CONTINUE
  395. IML=IL
  396. lcara(1,ih)=iml
  397. immt(ih)=ipno(im)
  398. 352 CONTINUE
  399. C 353 CONTINUE
  400. LIGN=ILIGN(IL1)
  401. IL11= IPREL
  402. C
  403. C **** BOUCLE *5* TRAVAILLE SUR LE NOEUD I QUI EST EN LECTURE
  404. C
  405. C > il1,il2
  406. lig1= ilign(imin)
  407. ipos=0
  408. iper=imin
  409. ider=imin-1
  410. iderac=imin-1
  411.  
  412. IL1i=il1
  413. DO 5 I=IMIN ,IL2
  414. IMASQ=ITMASQ(I)
  415. LIG1= ILIGN(I)
  416. IF(I.LT.IL1) GO TO 7
  417. C____________
  418. C
  419. C ******* LE NOEUD I EST EN MEMOIRE IL EST TRIANGULE JUSQU'A
  420. C ******* IPREL IL FAUT CONTINUER TOUTE LES LIGNES PUIS CALCULER
  421. C ******* LE TERME DIAGONAL
  422. C
  423. LIGN=LIG1
  424. DO 156 KHG=1,IMMM(/1)
  425. II=IPREL-1+KHG
  426. IMMM(KHG)=0
  427. NN=IPPVV(KHG+1)
  428. NNM1=IPPVV(KHG)
  429. N=NN-NNM1
  430. DIAG(II)=VAL(NN)
  431. IF(N.EQ.1) THEN
  432. IF(LIMIT) THEN
  433. RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN)
  434. GO TO 41
  435. ELSE
  436. GO TO 8
  437. ENDIF
  438. ENDIF
  439. NMI=N-II
  440. KI1=N-1
  441. KQ=-NMI
  442. C
  443. C ****** NOEUD MAITRE ET NON MAITRE traites dans CHOLE1
  444. C
  445. if (limit) then
  446. IDEP=MAX(IL11,1-NMI)
  447. else
  448. IDEP=MAX(IL11,2-NMI)
  449. endif
  450. KIDEP=IDEP+NMI
  451. VAL(NN)=VAL(NN)+
  452. # CHOLE1(ILIGN,LIGN,VAL(1+IPPVV(KHG)),DIAG(1-NMI),IPNO(1-NMI),
  453. # IPPVV(1),KHG,IVPO(1),KIDEP,KI1,KQ,IMASQ(1),1+IPPVV(KHG),
  454. # prec,nbop(1))
  455. imasq(nn/masdim+1)=1
  456. imasq(n/masdim+1)=1
  457. if (limit) then
  458. RE(II-NBNNMA,II-NBNNMA,1)=VAL(NN)
  459. goto 41
  460. endif
  461. C
  462. 8 CONTINUE
  463. diagref=max(abs(diag(ii)),diagmin)
  464. diagcmp=diagref*5d-12
  465. IF( ITTR(II).EQ.0.AND.
  466. & ABS( VAL(NN)).GT.diagcmp) GO TO 12
  467. IF( ITTR(II).NE.0.AND.
  468. & ABS( VAL(NN)).GT.diagcmp) GO TO 12
  469. ** write(6,*) ' ittr val diagcmp ',ittr(ii),val(nn),diagcmp
  470. C il faut mettre une valeur plus grande sur les LX car on a un probleme de conditionnement
  471. C sur le calcul des reactions en cas de 2 relations presque identique
  472. C
  473. C **** ON VIENT DE DETECTER UN MODE D'ENSEMBLE
  474. C **** ON AJOUTE A LA STRUCTURE UN RESSORT EGAL A CELUI QUI EXISTAIT
  475. C **** AU PREALABLE SUR CETTE INCONNUE.
  476. C
  477. * write (6,*) ' chomod nens ii ittr val diag ',ii,ittr(ii),
  478. * > val(nn),diag(ii),ipt2.num(1,ipno(ii)),limit
  479. if (ittr(ii).eq.0) then
  480. VAL(NN)=DIAGREF
  481. else
  482. VAL(NN)=val(nn)-4.D0*abs(DIAGREF)
  483. NENSLX=NENSLX+1
  484. endif
  485. NENS=NENS+1
  486. IMMM(KHG)=NENS
  487. 12 CONTINUE
  488. IMASQ(NN/MASDIM+1)=1
  489. IMASQ(N/MASDIM+1)=1
  490. DIAG(II)=VAL(NN)
  491. IF(DIAG(II).NE.0.d0) GO TO 41
  492. KQ1=1+NNM1
  493. KQN=N+NNM1
  494. DO 16 LFG=KQ1,KQN
  495. IF(VAL(LFG).NE.0.d0) GO TO 17
  496. 16 CONTINUE
  497. DIAG(II)=1.d0
  498. if (ittr(ii).ne.0) diag(ii)=-1.d0
  499. VAL(NN)=diag(ii)
  500. GO TO 41
  501. 17 CONTINUE
  502. diag(ii)=val(lfg)
  503. if (ittr(ii).ne.0) diag(ii)=-abs(diag(ii))
  504. val(nn)=diag(ii)
  505. goto 41
  506. C
  507. C **** ENVOI ERREUR MATRICE SINGULIERE
  508. C
  509. ITYP=49
  510. INTERR(1)=I
  511. CALL ERREUR(49)
  512. if (ithrd.eq.1) then
  513. call threadis
  514. call oooprl(0)
  515. endif
  516. call ooomru(0)
  517. RETURN
  518. C
  519. C **** ON COMPTE LE NOMBRE DE TERMES DIAGONAUX NEGATIFS
  520. C ET LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  521. C
  522. 41 IF(DIAG(II).LT.0.D0) INEG=INEG+1
  523. IF(ITTR(II).NE.0) NBLAG=NBLAG+1
  524. if (.not.limit) then
  525. condmin=min(condmin,abs(diag(ii)))
  526. condmax=max(condmax,abs(diag(ii)))
  527. endif
  528. 156 CONTINUE
  529. NA=IMMM(/1)
  530. C
  531. C RECOMPACTAGE DE LIGN (DEJA ENTIEREMENT TRAITEE)
  532. C
  533. ** write(6,*) 'chole ligne lpl',i,na,ippvv(2)-ippvv(1)
  534. if (na.gt.0)
  535. >CALL COMPAC(VAL(1),NBPAR,KIVPO(1),KIVLO(1),
  536. # NVALL,IPPVV(1),IZROSF,NA,PREC,imasq(1),iprel,iderl)
  537. C
  538. C on recree lign car la compacter en place emiette la memoire
  539. lig1=lign
  540. segini /err=1431/ lig1
  541. 1431 continue
  542. * deplacement fait ici maintenant, avec unrolling
  543. do 300 nbp=1,nbpar-1
  544. kdif =kivpo(nbp)-kivlo(nbp)
  545. do iv=kivlo(nbp),kivlo(nbp+1)-4,4
  546. lig1.val(iv)=val(iv+kdif )
  547. lig1.val(iv+1)=val(iv+1+kdif )
  548. lig1.val(iv+2)=val(iv+2+kdif )
  549. lig1.val(iv+3)=val(iv+3+kdif )
  550. enddo
  551. do iv1=iv,kivlo(nbp+1)-1
  552. lig1.val(iv1)=val(iv1-kivlo(nbp)+kivpo(nbp))
  553. enddo
  554. 300 continue
  555. ** do it=1,nvall
  556. ** lig1.val(it)=val(it)
  557. ** enddo
  558. do it=1,na
  559. lig1.immm(it)=immm(it)
  560. lig1.ippvv(it)=ippvv(it)
  561. enddo
  562. lig1.ippvv(na+1)=ippvv(na+1)
  563. lig1.iml=iml
  564. lig1.iprel=iprel
  565. lig1.iderl=iderl
  566. lcara(1,i)=iml
  567. lcara(2,i)=iprel
  568. lcara(3,i)=iderl
  569. segsup lign
  570. *pv write (6,*) ' cho2 ligne noeud inconnues ',i,ipno(i),na,nvall
  571. lign=lig1
  572. ilign(i)=lign
  573. NVSTOR=NVSTOR+NVALL
  574. nvstrm=max(nvstrm,nvall)
  575. DO 143 LHG=1,NBPAR
  576. IVPO(2*LHG-1)=KIVPO(LHG)
  577. IVPO(2*LHG)=KIVLO(LHG)
  578. 143 CONTINUE
  579. C Si la ligne est petite, il n'y a rien a gagner a paralleliser
  580. segsup imasq
  581. imasq=itmasq(i)
  582. if (i.gt.1) then
  583. lig1=ilign(i-1)
  584. ** if(lsgdes) write(6,*) 'desactivation-5 ',i
  585. if (lsgdes) segdes lig1
  586. iderac=min(iderac,i-2)
  587. endif
  588. C
  589. C **** ON TRIANGULARISE LES AUTRES LIGNES
  590. C
  591. il1=il1+1
  592. if (il1.gt.il2) goto 5
  593. LIG1=ILIGN(I)
  594. lign=ilign(il1)
  595. IL11=IPREL
  596. goto 7
  597. C 72 continue
  598. 71 continue
  599. if (ider.lt.il1-1.and..not.ngmpet.and.i.ne.ilimite) then
  600. ngmpet=.true.
  601. endif
  602.  
  603.  
  604. C soit parce qu'on a fini, soit parce qu'on manque de memoire
  605. C il faut executer les lignes activees puis les desactiver
  606. C lancer les chole3 et attendre qu'ils soient finis
  607. if (ipos.ne.0) then
  608. C write (6,*) ' lancement thread ',iper,ider,il1,il2
  609. if (iper.gt.ider) then
  610. write (6,*) ' erreur interne chole '
  611. call erreur(5)
  612. endif
  613. IF(I.LE.ILIMITE) THEN
  614. maitre=0
  615. nbthr=min(nbthr,il2-il1+1)
  616. LILIGN=MILIGN
  617. * blocage pour rester dans le cache secondaire
  618. ipers=iper
  619. iders=ider
  620. ipas=2200
  621. if(nbthr.eq.1) ipas=igrand
  622. do 400 iper=ipers,iders,ipas
  623. ider=min(iders,iper+ipas-1)
  624. do ith=2,nbthr
  625. call threadid(ith,chole3i)
  626. enddo
  627. call chole3i(1)
  628. do ith=2,nbthr
  629. call threadif(ith)
  630. enddo
  631. 400 continue
  632. endif
  633. C test ctrlC
  634. if (ierr.ne.0) goto 9999
  635. iposm=max(iposm,ipos)
  636. ipos=0
  637. iderf=ider-1
  638. if (ider.ne.il1-1) iderf=ider
  639. if (lsgdes) then
  640. ** write(6,*) 'desactivation 7 iper iderf',iper,iderf
  641. do il=iderf,iper,-1
  642. lign=ilign(il)
  643. segdes lign
  644. C write (6,*) ' desactivation ligne ',il
  645. enddo
  646. endif
  647. iderac=min(iderac,iper-1)
  648. iper=ider+1
  649. C write (6,*) ' iper ider il1 ',iper,ider,il1
  650. if (i.eq.ilimite) goto 5
  651. if (iper.ne.il1) goto 7
  652.  
  653. ENDIF
  654. goto 5
  655. 7 CONTINUE
  656. ** call oooeta(lig1,ieta,imod)
  657. ** if (.not.lsgdes.and.ieta.ne.1) write(6,*) ' prob ',lig1
  658. if (lsgdes) SEGACT/err=71/LIG1
  659. ipos=ipos+1
  660. ider=i
  661. if (i.gt.iderac) iderac=i
  662. if (i.eq.il1-1.and.i.le.ilimite) goto 71
  663. IF(I.EQ.ILIMITE) GOTO 71
  664. IF(I.GT.ILIMITE) THEN
  665. maitre=1
  666. IPPR=LIG1.IPREL
  667. IDDR=LIG1.IDERL
  668. C
  669. C
  670. lig2=lig1
  671. ** write(6,*) 'chomod il1t il2t',il1t,il2t
  672. ** DO 10 JBI=IL1T,IL2T,nbthrs
  673. C
  674. C ****** CAS NOEUD MAITRE
  675. C
  676. nbthr=min(nbthrs,il2-il1+1)
  677. ** write(6,*) 'avant nouveau',iper,ider
  678. do ith=nbthr,2,-1
  679. call threadid(ith,chole3i)
  680. enddo
  681. ** write(6,*) ' deuxieme appel chole3 '
  682. call chole3i(1 )
  683. do ith=nbthr,2,-1
  684. call threadif(ith)
  685. enddo
  686. ** write(6,*) 'apres nouveau'
  687. IF(IMM.GT.I) GO TO 106
  688. 10 CONTINUE
  689. 106 CONTINUE
  690. IF(I.LT.IL1) then
  691. if(lsgdes) SEGDES,LIG1
  692. endif
  693. ENDIF
  694. 5 CONTINUE
  695. C write (6,*) ' il1 il2 apres 5 ',il1,il2
  696. if (lsgdes) then
  697. ** write(6,*) 'desactivation 8 il1 il2',il1,il2
  698. DO I=min(il1,il2),max(il1,il2)
  699. LIGN= ILIGN(I)
  700. if(lign.ne.0) SEGDES,LIGN
  701. enddo
  702. endif
  703. nbopt=0
  704. do ith=1,nbthro
  705. nbopt=nbopt+nbop(ith)
  706. nbop(ith)=0
  707. enddo
  708. nbopin=nbopt
  709. nbopit=nbopit+nbopin
  710. call timespv(ittime,oothrd)
  711. kcour=(ittime(1)+ittime(2))/10
  712. kdiff=kcour-kcourp
  713. C* write (6,*) ' nb operation temps ',nbopin,kdiff
  714. if (kdiff.ge.1) then
  715. perf=real(nbopin)/kdiff
  716. C* if (nbchan.ne.0) perfp=perf
  717. if (ngdyn.or.limit) then
  718. if (perf.lt.perfp*0.90 .and.nbchan.ne.1 ) then
  719. nbchan=1
  720. perfp=perf
  721. elseif (nbchan.eq.0) then
  722. nbchan=-1
  723. perfp=max(perf,perfp)
  724. else
  725. nbchan=0
  726. endif
  727. endif
  728. C* nbchan=0
  729. endif
  730. kcourp=kcour
  731.  
  732. iderac=min(iderac,il1-1)
  733. IF(IL2.LT.INO) GO TO 1
  734.  
  735. C ON MET A JOUR LE NOMBRE DE TERMES DIAGONAUX NEGATIF
  736. C ON ENLEVE LE NOMBRE DE MULTIPLICATEUR DE LAGRANGE
  737. C INEG=INEG-NBLAG
  738. C on ne compte pas 2 fois les multiplicateurs qui vont etre
  739. C elimines lors de la resolution car mode d'ensemble
  740. INEG=INEG-(NBLAG-NENSLX)
  741. if (iimpi.ne.0.and.NENSLX.gt.0) WRITE(IOIMP,4820) NENSLX
  742. 4820 FORMAT(I12,' MODES D ENSEMBLE PORTANT SUR DES MULTIPLICATEURS',
  743. 1' DE LAGRANGE DETECTES')
  744.  
  745. IF (IIMPI.EQ.1)WRITE(IOIMP,4821) NVSTOC
  746. 4821 FORMAT( ' CHOMOD NOMBRE DE VALEURS DANS LE PROFIL',I9)
  747. IF (IIMPI.EQ.1)WRITE(IOIMP,4822) NVSTOR
  748. 4822 FORMAT( ' CHOMOD NOMBRE DE VALEURS STOCKEES DANS LE PROFIL',I9)
  749. IF (IIMPI.EQ.1)WRITE(IOIMP,4823) NVaor
  750. 4823 FORMAT( ' CHOMOD NOMBRE DE VALEURS initiales',I9)
  751. INTERR(1)=NVSTOR
  752. reaerr(1)=nvstor/inc**(4./3)
  753. reaerr(2)=2*nbopit/1D6/max(1,(kcour-kcouri))
  754. reaerr(3)=condmax/condmin
  755. ** write(6,*) ' chomod condmin condmax ',condmin,condmax
  756. IF (IPASV.EQ.0.or.reaerr(3).gt.1.D23) CALL ERREUR(-278)
  757. IPASV=1
  758. call ooomru(0)
  759. if(lsgdes) then
  760. do ipv=1,ino
  761. lign=ilign(ipv)
  762. segdes lign
  763. enddo
  764. endif
  765. SEGDES,MINCPO
  766. SEGDES,MIMIK
  767. SEGDES,MMATRI
  768. SEGDES,MILIGN
  769. SEGDES,MDIAG
  770. SEGDES,SNTO
  771. SEGDES,SNTT
  772. * verif re
  773.  
  774. SEGDES,XMATRI
  775. MMATRX=MMATRI
  776. SEGSUP KIVPO,KIVLO,ITMASQ
  777. segsup immt
  778. 9999 continue
  779. call ooomru(0)
  780. if (ithrd.eq.1) then
  781. call threadis
  782. call oooprl(0)
  783. endif
  784. RETURN
  785. END
  786.  
  787.  
  788.  
  789.  
  790.  
  791.  
  792.  
  793.  
  794.  
  795.  
  796.  
  797.  
  798.  
  799.  
  800.  
  801.  
  802.  
  803.  
  804.  
  805.  
  806.  
  807.  
  808.  
  809.  
  810.  
  811.  
  812.  
  813.  
  814.  
  815.  
  816.  
  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.  
  847.  
  848.  
  849.  
  850.  
  851.  
  852.  

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