Télécharger ntap12.eso

Retour à la liste

Numérotation des lignes :

  1. C NTAP12 SOURCE CHAT 05/01/13 02:01:57 5004
  2. SUBROUTINE NTAP12(II,KK,MCP,MCQ,MVDU,MVDL,M,N,MP)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. -INC TMXMAT
  6. -INC SMLENTI
  7. -INC CCOPTIO
  8. -INC SMLREEL
  9. POINTEUR MLREE4.MLREEL,MLREE5.MLREEL,MLREE6.MLREEL
  10. MXMAT=MCP
  11. MXMA1=MCQ
  12. MXMA2=MVDU
  13. MXMA3=MVDL
  14. JG=M
  15. SEGINI MLREEL
  16. DO 1 J=1,M
  17. IF (XMAT(J,II).EQ.0.D0) THEN
  18. PROG(J)=MXMA1.XMAT(J,II)*MXMA2.XMAT(II,KK)*MXMA2.XMAT(II,KK-1)
  19. ELSE
  20. PROG(J)=XMAT(J,II)*MXMA3.XMAT(II,KK)*MXMA3.XMAT(II,KK-1)
  21. ENDIF
  22. 1 CONTINUE
  23. * CONSTRUCTION DE LA MATRICE IDENTITE
  24. LDIM1=M
  25. LDIM2=M
  26. SEGINI MXMAT,MXMA2
  27. DO 2 I=1,M
  28. XMAT(I,I)=1
  29. 2 CONTINUE
  30. XNORM2=0.D0
  31. DO 3 I=1,M
  32. XNORM2=PROG(I)**2+XNORM2
  33. 3 CONTINUE
  34. CALL XITY(PROG,PROG,M,MXMA2.XMAT)
  35. XNORM2=1./XNORM2
  36. CALL REEMAT(XNORM2,MXMA2.XMAT,M,M)
  37. CALL ADDIMA(XMAT,MXMA2.XMAT,M,M,2)
  38. MP=MXMAT
  39. IF(IIMPI.EQ.1799)THEN
  40. MXMAT=MP
  41. WRITE(IOIMP,'('' MATRICE DE PROJECTION'')')
  42. DO 200 I=1,M
  43. WRITE(IOIMP,'('' LIGNE '',I2)')I
  44. DO 200 J=1,M
  45. WRITE(IOIMP,'(1X,E12.5)')XMAT(I,J)
  46. 200 CONTINUE
  47. ENDIF
  48. RETURN
  49. END
  50.  
  51.  

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