Télécharger monde2.eso

Retour à la liste

Numérotation des lignes :

  1. C MONDE2 SOURCE PV 15/04/22 21:15:06 8499
  2. SUBROUTINE MONDE2(ITTRV,IPPVV,VECTBB,VAL,IVPO,
  3. > NA,IPREL,MULRE,INC,IVS,LLOM,IFIB,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. IMOI2= IVPO(IDEB2-1)
  9. DO 50 ILM=1,NA
  10. II=IPREL+ILM-1
  11. IDEB22=2*IPPVV(ILM+1)
  12. IMOI1= IVPO(IDEB22-1)
  13. LLOM=IMOI1-IMOI2-1
  14. IF (LLOM.GT.0) THEN
  15. IPOSM=IMOI2-1
  16. DO 20 K=1,MULRE
  17. IPLAC=IVPO(IDEB2)-1
  18. IDEBZ=1
  19. J=II+(K-1)*INC
  20. IPLAC2=J-LLOM-1
  21. IF (ITTRV(K).LE.IVS) THEN
  22. P=0.D0
  23. DO 2 IDEB3=IDEB2,IFIB,2
  24. IMOI=IVPO(IDEB3+2)
  25. ILONZ=IMOI-IPLAC-IDEBZ
  26. IDEBZC=IDEBZ+IPLAC2
  27. IPLAC=IPLAC-IPLAC2
  28. ** DO 1 ISD=IDEBZC,MIN(IDEBZC+ILONZ,J)-1
  29. ** P = P + VECTBB(ISD) * VAL(IPLAC+ISD)
  30. ** 1 CONTINUE
  31. P=P+DDOTPV(MIN(IDEBZC+ILONZ,J)-IDEBZC,
  32. # VECTBB(IDEBZC),VAL(IPLAC+IDEBZC))
  33. IF (IDEBZ.GE.LLOM) GOTO 3
  34. IDEBZ=IVPO(IDEB3+1)-IPOSM
  35. IPLAC=IMOI-IDEBZ
  36. 2 CONTINUE
  37. 3 CONTINUE
  38. VECTBB(J)=VECTBB(J)-P
  39. if (abs(vectbb(j)).lt.dnorm) vectbb(j)=0.d0
  40. ENDIF
  41. 20 CONTINUE
  42. ENDIF
  43. IMOI2=IMOI1
  44. IDEB2=IDEB22
  45. 50 CONTINUE
  46. RETURN
  47. END
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  

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