Télécharger graco5.eso

Retour à la liste

Numérotation des lignes :

  1. C GRACO5 SOURCE PV 15/04/08 21:15:13 8468
  2. SUBROUTINE GRACO5(IPREL,IDERL,IPPV,IPPR,IDDR,IVPO,
  3. # IPPVV1,VAL,VAL1,IVPO1,imasq,prec,ittr,incom1,nc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCHOLE
  7. C
  8. C COPIE DE CHOLE3 POUR FAIRE UN CHOLEVSKI INCOMPLET
  9. C
  10. DIMENSION IPPV(1),IVPO(1),IPPVV1(1),VAL(1),VAL1(1),IVPO1(1)
  11. dimension imasq(1),ittr(1)
  12. IDD2=IPPV(1)
  13. DO 10 J=IPREL,IDERL
  14. incomp=incom1
  15. if (ittr(j).ne.0) incomp=0
  16. JID=J-IPREL+1
  17. IDD3=IPPV(JID+1)
  18. IF(IDD3.NE.1)THEN
  19. DNORM=ABS(VAL(IDD3-1))*PREC
  20. ELSE
  21. DNORM=0.
  22. ENDIF
  23. N2=IDD3-IDD2
  24. KD2=J-N2+1
  25. N2J=IDD3-J
  26. KIDEP=IVPO(JID)
  27. IBABA=MAX(IPPR,KD2+1)
  28. IF (IBABA.GT.IDDR) GOTO 30
  29. IDEB4=2*IPPVV1(IBABA-IPPR+1)
  30. IDD=IVPO1(IDEB4-1)
  31. DO 20 JHY=IBABA,IDDR
  32. ILM=JHY-IPPR+1
  33. IDEB3=2*IPPVV1(ILM+1)
  34. NNJJ=IVPO1(IDEB3-1)
  35. N=NNJJ-IDD
  36. KD1=1+JHY-N
  37. IDEP=MAX(KD2,KD1)
  38. LLOL=JHY-IDEP
  39. I1=JHY+N2J
  40. LLON=LLOL-I1+KIDEP+1
  41. IF(VAL(I1) .NE.0.D0.or.incomp.eq.0.or.ittr(jhy).ne.0) then
  42. IF (LLON.GT.0) THEN
  43. P=0.D0
  44. IPOSM=N-LLOL+IDD-2
  45. IPLAC2=N2J+IDEP-1
  46. idebzc=ivpo1(ideb3)
  47. DO 2 IDEB2=IDEB3,IDEB4+2,-2
  48. IAUX=IVPO1(IDEB2-3)-IPOSM
  49. IPLAC=IVPO1(IDEB2-2)-IAUX
  50. IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
  51. IDEBZC=MAX(1,IAUX)+IPLAC
  52. IPLAC3=IPLAC2-IPLAC
  53. lond=ifinz-idebzc+1
  54. if (lond.GT.0) then
  55. ideq=IDEBZC+IPLAC3
  56. if (IFINZ-IDEBZC.GT.masdim) then
  57. p=p+ddotpw(lond,VAL(ideq),VAL1(IDEBZC),
  58. > imasq(1),ideq,nc)
  59. else
  60. if (imasq(ideq/masdim+1).gt.0.or.
  61. > imasq((ifinz+iplac3)/masdim+1).gt.0)
  62. > p=p+ddotpv(lond,VAL(ideq),VAL1(IDEBZC))
  63. if (lond.ge.1) nc=nc+lond
  64. endif
  65. endif
  66. IF (IAUX.LE.1) GOTO 3
  67. 2 CONTINUE
  68. 3 CONTINUE
  69. if (abs(p).LT.dnorm.and.imasq(i1/masdim+1).le.0) goto 5
  70. VAL(I1)=VAL(I1)-P
  71. ENDIF
  72. ENDIF
  73. IF (ABS(VAL(I1)).GT.DNORM) then
  74. if (imasq(i1/masdim+1).le.0) imasq(i1/masdim+1)=1
  75. KIDEP=I1
  76. endif
  77. 5 continue
  78. IDEB4=IDEB3
  79. IDD=NNJJ
  80. 20 CONTINUE
  81. 30 CONTINUE
  82. IVPO(JID)=KIDEP
  83. IDD2=IDD3
  84. 10 CONTINUE
  85. RETURN
  86. END
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  

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