Télécharger la plaquette Cast3M


fr en

Télécharger ntap13.eso

Retour à la liste

Numérotation des lignes : 

ntap13

  1. C NTAP13    SOURCE    CHAT      05/01/13    02:02:00     5004
  2.       SUBROUTINE NTAP13 (MP,MCP,MCQ,M,N,MVDU,MVDL,KK,II)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8(A-H,O-Z)
  5. *
  6. *   MISE A JOUR DE LA MATRICE DE PROJECTION
  7. *
  8. -INC TMXMAT
  9. -INC SMLREEL
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13.       MXMAT=MCP
  14.       MXMA1=MCQ
  15.       MXMA2=MVDU
  16.       MXMA3=MVDL
  17.       JG=M
  18.       SEGINI MLREEL
  19.       DO 1 J=1,M
  20.       IF(XMAT(J,II).EQ.0.D0) THEN
  21.        PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1)
  22.       ELSE
  23.            PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1)
  24.       ENDIF
  25.     1 CONTINUE
  26.       SEGINI MLREE1
  27.       MXMAT=MP
  28.       CALL MATVE1( XMAT,PROG,M,M,MLREE1.PROG,2)
  29.       LDIM1=M
  30.       LDIM2=M
  31.       SEGINI MXMAT
  32.       XX=0.D0
  33.       DO 2 I=1,M
  34.       XX = MLREE1.PROG(I)*MLREE1.PROG(I) + XX
  35.     2 CONTINUE
  36.       CALL XITY(MLREE1.PROG,MLREE1.PROG,M,XMAT)
  37.       XX=1./XX
  38.       CALL REEMAT(XX,XMAT,M,M)
  39.       MXMA1=MP
  40.       CALL ADDIMA(MXMA1.XMAT,XMAT,M,M,2)
  41.       MP=MXMA1
  42.       SEGSUP MLREEL,MLREE1
  43.       RETURN
  44.       END
  45.  
  46.  

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