Télécharger la plaquette Cast3M


fr en

Télécharger ntape1.eso

Retour à la liste

Numérotation des lignes : 

ntape1

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

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