Télécharger monde2.eso

Retour à la liste

Numérotation des lignes :

monde2
  1. C MONDE2 SOURCE PV 20/09/29 21:15:12 10725
  2. SUBROUTINE MONDE2(ITTRV,IPPVV,VECTBB,VAL,IVPO,
  3. > NA,IPREL,MULRE,INC,IVS,LLOM,dnorm)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. DIMENSION ITTRV(*),IPPVV(*),VECTBB(*),VAL(*),IVPO(*)
  7. IDEB2=IPPVV(1)*2
  8. nbg=ippvv(2)-1
  9. ifib=2*nbg*na
  10. IMOI2= IVPO(IDEB2-1)
  11. DO 50 ILM=1,NA
  12. II=IPREL+ILM-1
  13. IDEB22=2*IPPVV(ILM+1)
  14. IMOI1= IVPO(IDEB22-1)
  15. LLOM=IMOI1-IMOI2-1
  16. IF (LLOM.GT.0) THEN
  17. IPOSM=IMOI2-1
  18. DO 20 K=1,MULRE
  19. IPLAC=IVPO(IDEB2)-1
  20. IDEBZ=1
  21. J=II+(K-1)*INC
  22. IPLAC2=J-LLOM-1
  23. IF (ITTRV(K).LE.IVS) THEN
  24. P=0.D0
  25. DO 2 IDEB3=IDEB2,IFIB,2
  26. IMOI=IVPO(IDEB3+2)
  27. ILONZ=IMOI-IPLAC-IDEBZ
  28. IDEBZC=IDEBZ+IPLAC2
  29. IPLAC=IPLAC-IPLAC2
  30. ** DO 1 ISD=IDEBZC,MIN(IDEBZC+ILONZ,J)-1
  31. ** P = P + VECTBB(ISD) * VAL(IPLAC+ISD)
  32. ** 1 CONTINUE
  33. P=P+DDOTPV(MIN(IDEBZC+ILONZ,J)-IDEBZC,
  34. # VECTBB(IDEBZC),VAL(IPLAC+IDEBZC))
  35. IF (IDEBZ.GE.LLOM) GOTO 3
  36. IDEBZ=IVPO(IDEB3+1)-IPOSM
  37. IPLAC=IMOI-IDEBZ
  38. 2 CONTINUE
  39. 3 CONTINUE
  40. VECTBB(J)=VECTBB(J)-P
  41. if (abs(vectbb(j)).lt.dnorm) vectbb(j)=0.d0
  42. ENDIF
  43. 20 CONTINUE
  44. ENDIF
  45. IMOI2=IMOI1
  46. IDEB2=IDEB22
  47. 50 CONTINUE
  48. RETURN
  49. END
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  

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