Télécharger chole1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHOLE1 SOURCE PV 16/11/17 21:58:23 9180
  2. FUNCTION CHOLE1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
  3. # KIDEP,KI1,KQ,imasq,idep,prec,nbo)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC SMMATRI
  7. -INC CCHOLE
  8. DIMENSION ILIGF(*),VALF(*),DAAG(*),IPKNO(*),IPPVF(*),IVPOF(*)
  9. dimension imasq(1)
  10. IPPKHG=IPPVF(KHG)
  11. KBAS=IPKNO(KIDEP)
  12. KHAU=IPKNO(KI1)
  13. KDIAG=KI1+1
  14. DNORM=ABS(VALF(KDIAG))*PREC
  15. KPREM=IVPOF(KHG)-IPPKHG
  16. DO 10 K=KBAS,KHAU
  17. LIG1=ILIGF(K)
  18. IF (LIG1.EQ.LIGN) GOTO 20
  19. IECAR=KQ-LIG1.IPREL+1
  20. ICA=MAX(1,KIDEP+IECAR)
  21. ICB=LIG1.IMMM(/1)
  22. CALL CHOLE2(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
  23. > imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm)
  24. 10 CONTINUE
  25. GOTO 50
  26. 20 CONTINUE
  27. IECAR=KQ-IPREL+1
  28. DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
  29. KK=NNJ-IECAR
  30. NNJJ=IPPVF(NNJ+1)
  31. NJ=NNJJ-IPPVF(NNJ)
  32. LLOL=MIN(NJ,KK)-1
  33. LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1)
  34. IF (LLON.GT.0.and.kk.ge.1) THEN
  35. IEC1=KK-LLOL-1
  36. IEC2=NNJJ-IPPKHG-KK
  37. ideq=1+iec1+idep-1
  38. if (llon.gt.masdim+1) then
  39. p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2),
  40. > imasq(1),1+idep-1,nbo)
  41. else
  42. ** if (imasq(ideq/masdim+1).gt.0.or.
  43. ** > imasq((ideq+llon)/masdim+1).gt.0)
  44. p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2))
  45. if (llon.ge.1) nc=nc+llon
  46. endif
  47. VALF(KK)=VALF(KK)-P
  48. IF (ABS(VALF(KK)).GT.DNORM) then
  49. KPREM=KK
  50. imasq((kk+idep-1)/masdim+1) =1
  51. * si on remonte, on tombe au terme diagonal ou apres, mais ce n'est qu'un seul terme
  52. imasq(kk/masdim+1) =1
  53. ELSE
  54. * annuler le terme car on l'ignorera par la suite
  55. valf(kk)=0.d0
  56. ENDIF
  57. ENDIF
  58. 30 CONTINUE
  59. 50 CONTINUE
  60. AUX1=0.D0
  61. kdeb=1
  62. 43 continue
  63. kdebi=kdeb
  64. 44 continue
  65. do 100 im=kdeb/masdim+1,kprem/masdim+1
  66. jm=imasq(im)
  67. if (jm.gt.0) goto 105
  68. if (jm.eq.0) goto 100
  69. jinio=-jm/masdim+1
  70. if (jinio.gt.im+7) then
  71. * write (6,*) 'saut kdeb jm ',kdeb,jm
  72. kdeb=-jm
  73. goto 44
  74. endif
  75. 100 continue
  76. 105 continue
  77. ideb=max((im-1)*masdim,kdebi)
  78. do 110 im=ideb/masdim+1,kprem/masdim+1
  79. if (imasq(im).le.0) goto 115
  80. 110 continue
  81. 115 continue
  82. im=im-1
  83. ifin=min((im)*masdim-1,kprem)
  84. ** write (6,*) ' chole1 kdeb kprem ideb ifin ',kdeb,kprem,ideb,ifin
  85. DO 9 K=ideb,ifin
  86. AUX=VALF(K)
  87. VALF(K)=AUX/DAAG(K)
  88. AUX1=AUX1+AUX*VALF(K)
  89. 9 CONTINUE
  90. if (ifin.lt.kprem) then
  91. kdeb=ifin+1
  92. goto 43
  93. endif
  94. ivpof(khg)=kprem+ippkhg
  95. CHOLE1=-AUX1
  96. RETURN
  97. END
  98.  
  99.  
  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