Télécharger chole2.eso

Retour à la liste

Numérotation des lignes :

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

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