Télécharger graco4.eso

Retour à la liste

Numérotation des lignes :

  1. C GRACO4 SOURCE PV 15/04/08 21:15:12 8468
  2. SUBROUTINE GRACO4(IPPVV,VALF,VAL,IVPO,imasq,idep,prec,
  3. > ica,icb,iecar,kprem,dnorm,incomp,iddr,ittr,nc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC CCHOLE
  7. C
  8. C COPIE DE CHOLE2 POUR FAIRE UN CHOLEVSKI INCOMPLET
  9. C
  10. DIMENSION IPPVV(1),VALF(1),VAL(1),IVPO(1),imasq(1),ittr(1)
  11.  
  12. IDEB4=2*IPPVV(ICA)
  13. NNKK=IVPO(IDEB4-1)
  14. DO 10 NNJ=ICA,ICB
  15. KK=NNJ-IECAR
  16. IDEB3=2*IPPVV(NNJ+1)
  17. NNJJ=IVPO(IDEB3-1)
  18. IF(VALF(KK).EQ.0.D0.and.incomp.eq.1.and.ittr(iddr+nnj-icb).eq.0)
  19. > GO TO 11
  20. NJ=NNJJ-NNKK
  21. LLOL=MIN(NJ,KK)-1
  22. LLON=LLOL-KK+KPREM+1
  23. IF (LLON.GT.0) THEN
  24. IPOSM=NNJJ-LLOL-2
  25. IPLAC2=KK-LLOL-1
  26. IDEBZC=IVPO(IDEB3)
  27. P=0.D0
  28. DO 2 IDEB2=IDEB3,IDEB4+2,-2
  29. IAUX=IVPO(IDEB2-3)-IPOSM
  30. IPLAC=IVPO(IDEB2-2)-IAUX
  31. IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
  32. IDEBZC=MAX(1,IAUX)+IPLAC
  33. IPLAC3=IPLAC2-IPLAC
  34. if (IFINZ-IDEBZC+1.GT.0) then
  35. ideq=IDEBZC+IPLAC3+idep-1
  36. if (IFINZ-IDEBZC.gt.masdim) then
  37. p=p+ddotpw(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC),
  38. > imasq(1),ideq,nc)
  39. else
  40. if (imasq(ideq/masdim+1).gt.0.or.
  41. > imasq((ifinz+iplac3+idep-1)/masdim+1).gt.0)
  42. > p=p+ddotpv(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC))
  43. if(ifinz-idebzc+1.ge.1) nc=nc+ifinz-idebzc+1
  44. endif
  45. endif
  46. IF (IAUX.LE.1) GOTO 3
  47. 2 CONTINUE
  48. 3 CONTINUE
  49. VALF(KK)=VALF(KK)-P
  50. ENDIF
  51. 11 CONTINUE
  52. IF (ABS(VALF(KK)).GT.DNORM) then
  53. KPREM=KK
  54. if (imasq((kk+idep-1)/masdim+1).le.0)
  55. > imasq((kk+idep-1)/masdim+1)=1
  56. ENDIF
  57. IDEB4=IDEB3
  58. NNKK=NNJJ
  59. 10 CONTINUE
  60. RETURN
  61. END
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  

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