Télécharger chole3i.eso

Retour à la liste

Numérotation des lignes :

  1. C CHOLE3I SOURCE PV 19/07/31 21:15:39 10276
  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. SEGMENT IMASQ(LMASQ)
  13. SEGMENT ITMASQ(NBLIG)
  14. segment immt(nblig)
  15. POINTEUR LILIGN.MILIGN
  16. nbo=nbop(ithr)
  17. C write (6,*) ' ith dans chole3i ',ith
  18. ** ic=-1
  19. C write (6,*) ' dans chole3i il1 il2 iper ider',il1,il2,iper,ider
  20. ngmaxl=ngmaxx
  21. do 100 jbib=il2,il1,-nbthr
  22. ** ic=mod(ic+1,nbthr)
  23. ** ithrm=(ithr+1)/2 +mod(ithr+1,2)*(nbthr+1)/2
  24. ** jbi=jbib-mod(ithrm+ic-1,nbthr)
  25. jbi=jbib-ithr+1
  26. if (jbi.gt.il2) goto 100
  27. if (jbi.lt.il1) goto 100
  28. LIGN=ILIGN(JBI)
  29.  
  30.  
  31. * blocage tertiaire en rondelles
  32. im=immt(jbi)
  33. if (im.gt.ider) then
  34. goto 100
  35. endif
  36. im=ipno(immm(1))
  37. ** do ih=2,na
  38. ** im=min(im,ipno(immm(ih)))
  39. ** enddo
  40. imasq=itmasq(jbi)
  41. lpl=ippvv(2)-ippvv(1)
  42. if (iper.eq.ider) ngm=lpl
  43. kidepb=iprel-lpl
  44. na=immm(/1)
  45. ngm=ngmaxl/(8 *na)
  46. * ici faire le decoupage de la ligne en rondelles
  47. iperi=iper
  48. iprelj=lcara(2,jbi)
  49. iderlj=lcara(3,jbi)
  50. do 300 irondh=1,lpl,ngm
  51. irondi=irondh
  52. irondf=min(lpl,irondi+ngm-1)
  53. if (irondi.eq.1) irondi=-kidepb-1
  54. ivpm=ivpo(1)
  55. kidep=kidepb+ivpm
  56. do 10 ip=max(im,iperi),ider
  57. C kidep nous donne le dernier terme non nul avant le terme courant de la ligne lign
  58. C lig1.iml (lcara(1 ) est le premier terme de lig1
  59. ippr=lcara(2,ip)
  60. iddr=lcara(3,ip)
  61. * test si la ligne touche la rondelle
  62. if (iddr.lt.irondh+kidepb) then
  63. iperi=ip
  64. goto 10
  65. endif
  66. if (lcara(1,ip).gt.irondf+kidepb) goto 10
  67. lig1=LILIGN.ilign(ip)
  68. irondj=irondi
  69. ivd=1
  70. if (kidep.lt.lcara(1,ip)) then
  71. mdeb=ippr-kidepb
  72. 13 continue
  73. * test si la rondelle est non nulle
  74. do ima=max(irondi,mdeb)/masdim+1 ,
  75. > min(iddr-kidepb,irondf+na)/masdim+1
  76. if (imasq(ima).gt.0) then
  77. ** ivd est le premier terme non nul de la rondelle
  78. ivd=max(ivd,(ima-1)*masdim)
  79. irondj=max(irondi,(ima-1)*masdim)
  80. goto 12
  81. elseif ((-imasq(ima))/masdim+1.gt.ima+7) then
  82. mdeb=-imasq(ima)
  83. goto 13
  84. endif
  85. enddo
  86. goto 10
  87. 12 continue
  88. endif
  89. ** write (6,*) 'chole3 jbi ip',jbi,ip
  90. CALL CHOLE3(iprelj,iderlj,IPPVV(1),IPPR,IDDR,IVPO(1),
  91. > LIG1.IPPVV(1),VAL(1),LIG1.VAL(1),LIG1.IVPO(1),
  92. > imasq(1),nbo,irondj,irondf,ivd)
  93. ivpm=ivpo(1)
  94. kidep=kidepb+ivpm
  95. 10 continue
  96. 300 continue
  97. 100 continue
  98. nbop(ithr)=nbo
  99. end
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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