Télécharger mulqp2.eso

Retour à la liste

Numérotation des lignes :

  1. C MULQP2 SOURCE CHAT 05/01/13 01:55:29 5004
  2. SUBROUTINE MULQP2(P, Q, R)
  3. C
  4. C Procedure de multiplication de 2 polynomes de 2 variables
  5. C Entree : P(30) : premier polynome : les coefficients sont
  6. C ranges comme suit :
  7. C indice : 1 2 3 4 5 6 7 8 9
  8. C terme : 1 T1 T2 T1*T2 T1^2 T2^2 T1*T2^2 T1^2*T2 T1^3
  9. C indice : 10 11 12 13 14 15
  10. C terme : T2^3 T1*T2^3 T1^2*T2^2 T1^3*T1^3 T1^4 T2^4
  11. C indice : 16 17 18 19 20 21
  12. C terme : T1*T2^4 T1^2*T2^3 T1^3*T2^2 T1^4*T2 T1^5 T2^5
  13. C indice : 22 23 24 25 26
  14. C terme : T1*T2^5 T1^2*T2^4 T1^3*T2^3 T1^4*T2^2 T1^5*T2
  15. C indice : 27 28 29 30
  16. C terme : T1^2*T2^5 T1^3*T2^4 T1^4*T2^3 T1^5*T2^2
  17. C Q(30) : deuxieme polynome
  18. C Sortie : R(30) : polynome resultat de la multiplication
  19. C
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. DIMENSION P(30), Q(30), R(30), INXM(13, 13)
  23. DATA INXM/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
  24. 2 2, 5, 4, 8, 9, 7, 12, 13, 14, 11, 17, 18, 19,
  25. 3 3, 4, 6, 7, 8, 10, 11, 12, 13, 15, 16, 17, 18,
  26. 4 4, 8, 7, 12, 13, 11, 17, 18, 19, 16, 23, 24, 25,
  27. 5 5, 9, 8, 13, 14, 12, 18, 19, 20, 17, 24, 25, 26,
  28. 6 6, 7, 10, 11, 12, 15, 16, 17, 18, 21, 22, 23, 24,
  29. 7 7, 12, 11, 17, 18, 16, 23, 24, 25, 22, 27, 28, 29,
  30. 8 8, 13, 12, 18, 19, 17, 24, 25, 26, 23, 28, 29, 30,
  31. 9 9, 14, 13, 19, 20, 18, 25, 26, 0, 24, 0, 30, 0,
  32. 9 10, 11, 15, 16, 17, 21, 22, 23, 24, 0, 0, 27, 28,
  33. 1 11, 17, 16, 23, 24, 22, 27, 28, 0, 0, 0, 0, 0,
  34. 2 12, 18, 17, 24, 25, 23, 28, 29, 30, 27, 0, 0, 0,
  35. 3 13, 19, 18, 25, 26, 24, 29, 30, 0, 28, 0, 0, 0/
  36. C
  37. C Initialisation du polynome resultat
  38. C
  39. DO 50 I = 1, 30
  40. 50 R(I) = 0.D0
  41. C
  42. C Multiplication de P et Q
  43. C
  44. DO 60 I = 1, 13
  45. DO 60 J = 1, 13
  46. IF (INXM(I, J) .NE. 0) THEN
  47. R(INXM(I,J)) = R(INXM(I,J)) + P(I)*Q(J)
  48. ENDIF
  49. 60 CONTINUE
  50. RETURN
  51. END
  52.  
  53.  
  54.  
  55.  

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