Télécharger ntape1.eso

Retour à la liste

Numérotation des lignes :

  1. C NTAPE1 SOURCE CHAT 05/01/13 02:02:13 5004
  2. SUBROUTINE NTAPE1(MCP,MCQ,IVFP,IVFQ,IVLAMB,NVD,M,N,MVDU,
  3. $ MVDL,IVMINU,IVMINL,IVMAXU,IVMAXL,IVU,IVN,IVD,IVUL,IVLL,
  4. $ IVXU,IVXL)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8(A-H,O-Z)
  7. -INC CCOPTIO
  8. -INC TMXMAT
  9. -INC SMLENTI
  10. -INC SMLREEL
  11. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
  12. POINTEUR MLREE6.MLREEL,MLREE7.MLREEL
  13. MXMAT=MCP
  14. N11= N + 1
  15. MLREEL=IVLAMB
  16. JG =XMAT(/2)
  17. SEGINI MLREE1,MLREE2
  18. CALL MATVE1(XMAT,PROG,M,N11,MLREE1.PROG,1)
  19. MXMAT=MCQ
  20. CALL MATVE1(XMAT,PROG,M,N11,MLREE2.PROG,1)
  21. MLREEL=IVFP
  22. CALL AEQAPB(MLREE1.PROG,PROG,N11)
  23. MLREEL=IVFQ
  24. CALL AEQAPB(MLREE2.PROG,PROG,N11)
  25. *
  26. * EVALUATION DES VARIABLES DISCRETES
  27. *
  28. JG=N11
  29. SEGINI MLREEL,MLREE3
  30. IF(NVD.NE.0) THEN
  31. MXMAT=MVDU
  32. MXMA1=MVDL
  33. NDIS=XMAT(/2)-2
  34. JG=NVD
  35. SEGINI MLREE4
  36. DO 2 I=1,NVD
  37. CT=MLREE1.PROG(I)
  38. IF (MLREE1.PROG(I).LT.1.D-15) CT=1.D-15
  39. MLREE4.PROG(I)=MLREE2.PROG(I)/CT
  40. 2 CONTINUE
  41. DO 1 I=1,NVD
  42. PROG(I)=XMAT(I,2)
  43. MLREE3.PROG(I)=MXMA1.XMAT(I,2)
  44. DO 4 K=3,NDIS
  45. XXK=XMAT(I,K-1)*XMAT(I,K)
  46. XXK=MXMA1.XMAT(I,K-1)*MXMA1.XMAT(I,K)/XXK
  47. XXK1=XMAT(I,K)*XMAT(I,K+1)
  48. XXK1=MXMA1.XMAT(I,K)*MXMA1.XMAT(I,K+1)/XXK1
  49. IF(XXK.LE.MLREE4.PROG(I).AND.XXK1.GT.MLREE4.PROG(I)) THEN
  50. PROG(I)=XMAT(I,K)
  51. MLREE3.PROG(I)=MXMA1.XMAT(I,K)
  52. GO TO 1
  53. ENDIF
  54. XXF=XMAT(I,NDIS+1)*XMAT(I,NDIS)
  55. XXF=MXMA1.XMAT(I,NDIS+1)*MXMA1.XMAT(I,NDIS)/XXF
  56. IF(XXF.LE.MLREE4.PROG(I)) THEN
  57. PROG(I)=XMAT(I,NDIS+1)
  58. MLREE3.PROG(I)=MXMA1.XMAT(I,NDIS+1)
  59. ENDIF
  60. 4 CONTINUE
  61. 1 CONTINUE
  62. SEGSUP MLREE4
  63. ENDIF
  64. *
  65. * EVALUATIONS DES VARIABLES CONTINUES
  66. *
  67. NK=N11-NVD
  68. JG=N11
  69. SEGINI MLENTI
  70. DO 3 I=1,NK
  71. J=I+NVD
  72. * DERIVEE EN XMIN
  73. MLREE4=IVMINU
  74. MLREE5=IVMINL
  75. T1=MLREE1.PROG(J)/(MLREE4.PROG(J)**2)
  76. T1=T1-(MLREE2.PROG(J)/(MLREE5.PROG(J)**2))
  77. * DERIVEE EN XMAX
  78. MLREE6=IVMAXU
  79. MLREE7=IVMAXL
  80. T2=MLREE1.PROG(J)/(MLREE6.PROG(J)**2)
  81. T2=T2-(MLREE2.PROG(J)/(MLREE7.PROG(J)**2))
  82. * CHOIX DE X(LAMBDA)
  83. IF(T1.GE.0.D0) THEN
  84. PROG(J)=MLREE4.PROG(J)
  85. MLREE3.PROG(J)=MLREE5.PROG(J)
  86. ENDIF
  87. IF(T2.LE.0.D0) THEN
  88. PROG(J)=MLREE6.PROG(J)
  89. MLREE3.PROG(J)=MLREE7.PROG(J)
  90. ENDIF
  91. MLREE4=IVUL
  92. MLREE5=IVLL
  93. IF(T1.LT.0.D0.AND.T2.GT.0.D0) THEN
  94. CTE=SQRT(MLREE1.PROG(J))*MLREE5.PROG(J)
  95. CTE=CTE+(SQRT(MLREE2.PROG(J))*MLREE4.PROG(J))
  96. CTE=CTE/(SQRT(MLREE1.PROG(J))+SQRT(MLREE2.PROG(J)))
  97. PROG(J)=MLREE4.PROG(J)-CTE
  98. MLREE3.PROG(J)=CTE-MLREE5.PROG(J)
  99. LECT(J)=1
  100. ENDIF
  101. 3 CONTINUE
  102. IF(IVXU.NE.0) THEN
  103. MLREE7=IVXU
  104. SEGSUP MLREE7
  105. ENDIF
  106. IF(IVXL.NE.0) THEN
  107. MLREE7=IVXL
  108. SEGSUP MLREE7
  109. ENDIF
  110. IF(IVU.NE.0) THEN
  111. MLENT1=IVU
  112. SEGSUP MLENT1
  113. ENDIF
  114. IF(IVN.NE.0) THEN
  115. MLREE7=IVN
  116. SEGSUP MLREE7
  117. ENDIF
  118. IF(IVD.NE.0) THEN
  119. MLREE7=IVD
  120. SEGSUP MLREE7
  121. ENDIF
  122. IVXU=MLREEL
  123. IVXL=MLREE3
  124. IVU=MLENTI
  125. IVN=MLREE1
  126. IVD=MLREE2
  127. RETURN
  128. END
  129.  
  130.  

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