Sources Esope | Cast3M

ntape2
C NTAPE2    SOURCE    CHAT      05/01/13    02:02:17     5004
      SUBROUTINE NTAPE2(MCP,MCQ,IVXU,IVXL,IVB,N,M,IVGE,
     *IVGM,IVLAMB,IPBASE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 ( A-H,O-Z)
-INC TMXMAT
 
-INC PPARAM
-INC CCOPTIO
-INC SMLREEL
-INC SMLENTI
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE7.MLREEL
      N11=N + 1
      MXMAT=MCP
      MLREEL=IVXU
      MLREE1=IVXL
      SEGACT MLREEL,MLREE1
      JG=PROG(/1)
      SEGINI MLREE2,MLREE3
      DO 1 I=1,JG
         MLREE2.PROG(I)=1./PROG(I)
         MLREE3.PROG(I)=1./MLREE1.PROG(I)
   1  CONTINUE
      JG=M
      SEGDES MLREEL,MLREE1
      SEGINI MLREEL,MLREE1,MLREE4,MLREE5
      IF(IVGM.NE.0) THEN
          MLREE7=IVGM
          SEGSUP MLREE7
      ENDIF
      IVGM=MLREE4
      IF(IVGE.NE.0) THEN
          MLREE7=IVGE
          SEGSUP MLREE7
      ENDIF
      IVGE=MLREE5
      CALL MATVE1(XMAT,MLREE2.PROG,M,N11,PROG,2)
      MXMAT=MCQ
      CALL MATVE1(XMAT,MLREE3.PROG,M,N11,MLREE1.PROG,2)
      SEGSUP MLREE2
      MLREE2=IVB
      DO 2 I=1,M
        MLREE5.PROG(I)=PROG(I) + MLREE1.PROG(I) - MLREE2.PROG(I)
   2  CONTINUE
      SEGSUP MLREE1,MLREE3,MLREEL
*
*  CALCUL DE LA DIRECTION DE MONTEE
*
        MLENTI=IPBASE
        SEGACT MLENTI
        MLREEL=IVLAMB
        DO 3 I=1,M
          MLREE4.PROG(I)=MLREE5.PROG(I)
             IF(PROG(I).EQ.0. ) THEN
                IF(MLREE5.PROG(I).LT.0.D0) THEN
                MLREE4.PROG(I)=0.D0
              ENDIF
            ENDIF
    3   CONTINUE
        DO 4 I=1,M
          IF (LECT(I) .EQ.1)  MLREE4.PROG(I)=0.D0
    4   CONTINUE
      RETURN
      END