Sources Esope | Cast3M

etape4
C ETAPE4    SOURCE    CHAT      05/01/12    23:46:18     5004
      SUBROUTINE ETAPE4(MCPLUS,MCMOIN,M,N,IVU,IVX,IVN,IMH)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC TMXMAT
-INC SMLREEL
 
-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
      POINTEUR MLREE4.MLREEL,MLREE5.MLREEL
      N11 = N + 1
      MLENTI=IVU
      MLREE1=IVN
      MLREE2=IVX
******* TEST SI VN = 0 ET SI VX = 0
      DO 100 I=1,N
        IF (MLREE1.PROG(I).LT.1.D-10) MLREE1.PROG(I)=1.D-10
        IF (MLREE2.PROG(I).LT.1.D-10) MLREE2.PROG(I)=1.D-10
 100  CONTINUE
      JG=N11
      SEGINI MLREE3,MLREE4,MLREE5
      IVPN=MLREE3
      IVPP=MLREE4
      IVNN=MLREE5
      DO 1 I = 1,N11
      VNI2=MLREE1.PROG(I)*2
      VT=VNI2 * MLREE2.PROG(I)
      MLREE3.PROG(I)=LECT(I) /VT
      MLREE4.PROG(I)=LECT(I)*MLREE2.PROG(I)/VNI2
      MLREE5.PROG(I)=LECT(I)/VNI2/(MLREE2.PROG(I)**3)
   1  CONTINUE
      LDIM1=N11
      LDIM2=M
      SEGINI MXMAT
      MXMA1=MCPLUS
*1
      CALL MATMAD(MXMA1.XMAT,MLREE3.PROG,M,N11,XMAT)
      MXMA1=MCMOIN
      LDIM1=M
      LDIM2=M
      SEGINI MXMA2
*2
      CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA2.XMAT)
*3
      CALL MATMAD(MXMA1.XMAT,MLREE3.PROG,M,N11,XMAT)
      SEGINI MXMA4
      MXMA1=MCPLUS
*4
      CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT)
*4+
      CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,1)
*5
      CALL MATMAD(MXMA1.XMAT,MLREE4.PROG,M,N11,XMAT)
*6
      CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT)
*6-
      CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,2)
*7
      MXMA1=MCMOIN
      CALL MATMAD(MXMA1.XMAT,MLREE5.PROG,M,N11,XMAT)
*8
      CALL MATMAT(MXMA1.XMAT,XMAT,M,N11,M,MXMA4.XMAT)
*8-
      CALL ADDIMA(MXMA2.XMAT,MXMA4.XMAT,M,M,2)
      IMH=MXMA2
      SEGSUP MXMAT,MXMA4
      RETURN
      END