Télécharger ntape2.eso

Retour à la liste

Numérotation des lignes :

  1. C NTAPE2 SOURCE CHAT 05/01/13 02:02:17 5004
  2. SUBROUTINE NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,
  3. *IVGM,IVLAMB,IPBASE)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 ( A-H,O-Z)
  6. -INC TMXMAT
  7. -INC CCOPTIO
  8. -INC SMLREEL
  9. -INC SMLENTI
  10. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE7.MLREEL
  11. N11=N + 1
  12. MXMAT=MCP
  13. MLREEL=IVXU
  14. MLREE1=IVXL
  15. SEGACT MLREEL,MLREE1
  16. JG=PROG(/1)
  17. SEGINI MLREE2,MLREE3
  18. DO 1 I=1,JG
  19. MLREE2.PROG(I)=1./PROG(I)
  20. MLREE3.PROG(I)=1./MLREE1.PROG(I)
  21. 1 CONTINUE
  22. JG=M
  23. SEGDES MLREEL,MLREE1
  24. SEGINI MLREEL,MLREE1,MLREE4,MLREE5
  25. IF(IVGM.NE.0) THEN
  26. MLREE7=IVGM
  27. SEGSUP MLREE7
  28. ENDIF
  29. IVGM=MLREE4
  30. IF(IVGE.NE.0) THEN
  31. MLREE7=IVGE
  32. SEGSUP MLREE7
  33. ENDIF
  34. IVGE=MLREE5
  35. CALL MATVE1(XMAT,MLREE2.PROG,M,N11,PROG,2)
  36. MXMAT=MCQ
  37. CALL MATVE1(XMAT,MLREE3.PROG,M,N11,MLREE1.PROG,2)
  38. SEGSUP MLREE2
  39. MLREE2=IVB
  40. DO 2 I=1,M
  41. MLREE5.PROG(I)=PROG(I) + MLREE1.PROG(I) - MLREE2.PROG(I)
  42. 2 CONTINUE
  43. SEGSUP MLREE1,MLREE3,MLREEL
  44. *
  45. * CALCUL DE LA DIRECTION DE MONTEE
  46. *
  47. MLENTI=IPBASE
  48. SEGACT MLENTI
  49. MLREEL=IVLAMB
  50. DO 3 I=1,M
  51. MLREE4.PROG(I)=MLREE5.PROG(I)
  52. IF(PROG(I).EQ.0. ) THEN
  53. IF(MLREE5.PROG(I).LT.0.D0) THEN
  54. MLREE4.PROG(I)=0.D0
  55. ENDIF
  56. ENDIF
  57. 3 CONTINUE
  58. DO 4 I=1,M
  59. IF (LECT(I) .EQ.1) MLREE4.PROG(I)=0.D0
  60. 4 CONTINUE
  61. RETURN
  62. END
  63.  
  64.  

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