Télécharger mulatb.eso

Retour à la liste

Numérotation des lignes :

  1. C MULATB SOURCE AM 12/02/28 00:28:37 7289
  2.  
  3.  
  4. SUBROUTINE MULATB(A,B,R,ia,ja,ib,jb)
  5. C
  6. C ***************************************************************
  7. C * *
  8. C * MULTIPLICATION OF Atranspose BY B *
  9. C * --------------------------------- *
  10. C * *
  11. C * INPUT : A,B : MATRIX TO MULTIPLY *
  12. C * *
  13. C * OUTPUT : R : RESULT *
  14. C * *
  15. C ***************************************************************
  16. C
  17. IMPLICIT REAL*8 (A-B,D-H,O-Z)
  18. implicit integer (I-K,M,N)
  19. implicit logical (L)
  20. implicit character*10 (C)
  21.  
  22. parameter (idimrloc = 441)
  23.  
  24. DIMENSION A(ia,ja),B(ib,jb),R(ja,jb)
  25.  
  26. dimension rloc(idimrloc)
  27.  
  28. c rloc is introduced to allow the results of R to be stored in A or in B
  29. c Example : Call mulATB(A,B,A,...)
  30. c or Call mulATB(A,B,B,...)
  31.  
  32. i1 = 1
  33. i0 = 0
  34. i3 = 3
  35. i6 = 6
  36. r0 = 0.
  37.  
  38. if (ja*jb.gt.idimrloc) then
  39. write(2,3)ja,jb,ja*jb,idimrloc
  40. 3 format(' ERROR from subr. MULATB.'/
  41. . ' The dimensions of the result matrix are ',i3,'X',i3,' = ',
  42. . i6,' > ',i6/
  43. . ' Change idimrloc in MULATB')
  44. stop
  45. endif
  46.  
  47. if (ia.ne.ib) then
  48. write(2,2000) ja,ia,ib,jb
  49. write(*,2000) ja,ia,ib,jb
  50. 2000 format(' ERROR in subr. MULATB.'/
  51. . ' It is impossible to multiply a matrix of dimensions',I3
  52. . ,' x',i3/
  53. . ' by a matrix of dimensions',I3
  54. . ,' x',i3)
  55. stop
  56. endif
  57.  
  58. iloc = i0
  59. DO 1 J=i1,jb
  60. DO 1 I=i1,ja
  61. iloc = iloc+i1
  62. SUM = r0
  63. DO 2 K=i1,ia
  64. SUM = SUM+A(K,I)*B(K,J)
  65. 2 CONTINUE
  66. rloc(iloc) = SUM
  67. 1 CONTINUE
  68.  
  69. call AequalB(R,rloc,ja,jb,i1,i1)
  70. c **** *******
  71.  
  72. RETURN
  73. END
  74.  
  75.  
  76.  
  77.  

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