Télécharger chole3i.eso

Retour à la liste

Numérotation des lignes :

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

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