Télécharger graco3.eso

Retour à la liste

Numérotation des lignes :

  1. C GRACO3 SOURCE PV 16/11/17 21:59:36 9180
  2. FUNCTION GRACO3(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
  3. # KIDEP,KI1,KQ,imasq,idep,prec,ittrl,nc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C
  7. C COPIE DE CHOLE1 POUR FAIRE UN CHOLEVSKI INCOMPLET
  8. C
  9. -INC SMMATRI
  10. -INC CCHOLE
  11. DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1)
  12. dimension imasq(1),ittrl(1)
  13. IPPKHG=IPPVF(KHG)
  14. KBAS=IPKNO(KIDEP)
  15. KHAU=IPKNO(KI1)
  16. KDIAG=KI1+1
  17. kndiag=ipkno(kdiag)
  18. DNORM=ABS(VALF(KDIAG))*PREC
  19. KPREM=IVPOF(KHG)-IPPKHG
  20. incomp=1
  21. if (ittrl(iprel-1+khg).ne.0) incomp=0
  22. DO 10 K=KBAS,KHAU
  23. if (kndiag-k.lt.1) incomp=0
  24. LIG1=ILIGF(K)
  25. IF (LIG1.EQ.LIGN) GOTO 20
  26. IECAR=KQ-LIG1.IPREL+1
  27. ICA=MAX(1,KIDEP+IECAR)
  28. ICB=LIG1.IMMM(/1)
  29. CALL GRACO4(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
  30. > imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm,incomp,
  31. > lig1.iderl,ittrl(1),nc)
  32. 10 CONTINUE
  33. GOTO 50
  34. 20 CONTINUE
  35. IECAR=KQ-IPREL+1
  36. DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
  37. KK=NNJ-IECAR
  38. NNJJ=IPPVF(NNJ+1)
  39. if (valf(kk).eq.0.d0.and.incomp.eq.1.and.
  40. > ittrl(iderl-ki1+kk).eq.0)goto 31
  41. NJ=NNJJ-IPPVF(NNJ)
  42. LLOL=MIN(NJ,KK)-1
  43. LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1)
  44. IF (LLON.GT.0) THEN
  45. P=0.D0
  46. IEC1=KK-LLOL-1
  47. IEC2=NNJJ-IPPKHG-KK
  48. ideq=1+iec1+idep-1
  49. if (llon.gt.masdim+1) then
  50. p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2),
  51. > imasq(1),ideq,nc)
  52. else
  53. if (imasq(ideq/masdim+1).gt.0.or.
  54. > imasq((ideq+llon)/masdim+1).gt.0)
  55. > p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2))
  56. nc=nc+llon
  57. endif
  58. VALF(KK)=VALF(KK)-P
  59. ENDIF
  60. 31 continue
  61. IF (ABS(VALF(KK)).GT.DNORM) then
  62. KPREM=KK
  63. imasq((kk+idep-1)/masdim+1) =1
  64. ENDIF
  65. 30 CONTINUE
  66. 50 CONTINUE
  67. AUX1=0.D0
  68. kdeb=1
  69. 43 continue
  70. km1=0
  71. im=1
  72. DO 9 K=kdeb,KPREM
  73. km=(k+idep-1)/masdim+1
  74. if (km.ne.km1) then
  75. km1=km
  76. im=imasq(km)
  77. endif
  78. if (im.eq.0) goto 9
  79. if (im.lt.0) then
  80. imr=-im-idep+1
  81. if (imr.gt.k+5) then
  82. kdeb=imr
  83. * write (6,*) ' k kdeb ',k,imasq(km)
  84. GOTO 43
  85. else
  86. goto 9
  87. endif
  88. ENDIF
  89. AUX=VALF(K)
  90. VALF(K)=AUX/DAAG(K)
  91. AUX1=AUX1+AUX*VALF(K)
  92. 9 CONTINUE
  93. IVPOF(KHG)=KPREM+IPPKHG
  94. DO 8 K=KPREM+1,KI1
  95. VALF(K)=0.D0
  96. 8 CONTINUE
  97. GRACO3=-AUX1
  98. RETURN
  99. END
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  

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