Télécharger chole3i.eso

Retour à la liste

Numérotation des lignes :

chole3i
  1. C CHOLE3I SOURCE PV090527 24/01/15 21:15:02 10699
  2. subroutine chole3i(ithr)
  3. C
  4. C interface avec chole3 qui peut être appelee en parallele
  5. C pour un ensemble de ligne ligne en stockage complet, effectue les operations
  6. C avec les lignes superieures lig1 qui sont en stockage compact
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8 (A-H,O-Z)
  10. -INC SMMATRI
  11. -INC CCHOLE
  12. -INC CCREEL
  13. -INC CCASSIS
  14. ** SEGMENT IMASQ(LMASQ)
  15. ** SEGMENT ITMASQ(NBLIG)
  16. segment immt(nblig)
  17. POINTEUR LILIGN.MILIGN
  18. nbo=nbop(ithr)
  19. * maitre=1 pour nes noeuds maitres de chomod
  20. lig1=lig2
  21. C write (6,*) ' ith dans chole3i ',ith
  22. C write (6,*) ' dans chole3i il1 il2 iper ider',il1,il2,iper,ider
  23. nbtr=(il2-il1)/nbthr+1
  24. nbpck=nbtr/32+ 1
  25. * if(nbpck.gt.4) write(6,*) 'chole3i nbpck ',nbpck
  26. do 101 jbib=il2,il1,-nbthr*nbpck
  27. do 100 jbis=0,nbpck-1
  28. jbi=jbib-jbis-((ithr-1)*nbpck+1)+1
  29. if (jbi.gt.il2) goto 100
  30. if (jbi.lt.il1) goto 101
  31. ** write(6,*) 'chole3i ithr jbi',ithr,jbi,il1,il2
  32. LIGN=ILIGN(JBI)
  33.  
  34. * blocage tertiaire en rondelles
  35. im=immt(jbi)
  36. if (im.gt.ider) then
  37. goto 100
  38. endif
  39. ** imasq=itmasq(jbi)
  40. na=lcara(3,jbi)-lcara(2,jbi)+1
  41. kidepb=lcara(1,jbi)-1
  42. ** write(6,*) 'chole3i na kidepb ',na,kidepb
  43. lpl=lcara(2,jbi)-kidepb
  44. * *6 pour travailler avec un bloc 5.5 fois plus petit
  45. * ici faire le decoupage de la ligne en rondelles
  46. iperi=iper
  47. iprelj=lcara(2,jbi)
  48. iderlj=lcara(3,jbi)
  49. na=iderlj-iprelj+1
  50. ** na1=lcara(3,ider)-lcara(3,ider)+1
  51. ngm=450000/na
  52. ngm = ngm*nbthrs/nbthr
  53. ivpm=ivpo(1)
  54. kidep=kidepb+ivpm
  55. do 300 irondh=1,lpl,ngm
  56. irondf=min(lpl,irondh+ngm-1)
  57. * pour etre bien positionne sur imasq
  58. if(irondh.ne.1) then
  59. irondi=irondh
  60. else
  61. irondi=-kidepb-1
  62. endif
  63. do 10 ip=max(im,iperi),ider
  64. C kidep nous donne le dernier terme non nul avant le terme courant de la ligne lign
  65. C lig1.iml (lcara(1 ) est le premier terme de lig1
  66. if (lcara(1,ip).gt.irondf+kidepb) goto 10
  67. ippr=lcara(2,ip)
  68. iddr=lcara(3,ip)
  69. * test si la ligne touche la rondelle
  70. if (iddr.lt.irondi+kidepb) then
  71. iperi=ip+1
  72. goto 10
  73. endif
  74. lig1=LILIGN.ilign(ip)
  75. irondj=irondi
  76. ivd=1
  77. if (kidep.lt.lcara(1,ip)) then
  78. mdeb=ippr-kidepb
  79. 13 continue
  80. * test si la rondelle est non nulle
  81. do ima=max(irondi,mdeb)/masdim+1 ,
  82. > min(iddr-kidepb,irondf+na)/masdim+1
  83. if (imasq(ima).gt.0) then
  84. ** ivd est le premier terme non nul de la rondelle
  85. imam=(ima-1)*masdim-1
  86. irondj=max(irondi,imam)
  87. if(irondj.gt.irondf) goto 10
  88. ivd=irondj
  89. goto 12
  90. elseif ((-imasq(ima))/masdim+1.gt.ima+jacc) then
  91. mdeb=-imasq(ima)
  92. goto 13
  93. endif
  94. enddo
  95. goto 10
  96. 12 continue
  97. endif
  98. ** write (6,*) 'chole3 jbi ip',jbi,ip
  99. nbg1=lig1.ippvv(2)-1
  100. CALL CHOLE3(iprelj,iderlj,lpl,IPPR,IDDR,IVPO(1),
  101. > nbg1,VAL(1),LIG1.VAL(1),LIG1.IVPO(1),
  102. > imasq(1),nbo,irondj,irondf,ivd)
  103. ivpm=ivpo(1)
  104. kidep=kidepb+ivpm
  105. 10 continue
  106. 300 continue
  107. 100 continue
  108. 101 continue
  109. nbop(ithr)=nbo
  110. end
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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