Télécharger mulab.eso

Retour à la liste

Numérotation des lignes :

  1. C MULAB SOURCE AM 12/02/28 00:28:36 7289
  2.  
  3.  
  4. SUBROUTINE MULAB(A,B,R,ia,ja,ib,jb)
  5. C
  6. C ***************************************************************
  7. C * *
  8. C * MULTIPLICATION OF TWO MATRIX *
  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(ia,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 mulAB(A,B,A,...)
  30. c or Call mulAB(A,B,B,...)
  31.  
  32. i0 = 0
  33. i1 = 1
  34. i3 = 3
  35. i6 = 6
  36. r0 = 0.
  37.  
  38. if (ia*jb.gt.idimrloc) then
  39. write(2,3)ia,jb,ia*jb,idimrloc
  40. 3 format(' ERROR from subr. MULAB.'/
  41. . ' The dimensions of the result matrix are ',i3,'X',i3,' = ',
  42. . i6,' > ',i6/
  43. . ' Change idimrloc in MULAB')
  44. stop
  45. endif
  46.  
  47. if (ja.ne.ib) then
  48. write(2,2000) ia,ja,ib,jb
  49. write(*,2000) ia,ja,ib,jb
  50. 2000 format(' ERROR in subr. MULAB.'/
  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,ia
  61. iloc = iloc+i1
  62. SUM = r0
  63. DO 2 K=i1,ja
  64. SUM = SUM+A(i,K)*B(K,j)
  65. 2 continue
  66. rloc(iloc) = SUM
  67. c end do
  68. 1 continue
  69.  
  70. call AequalB(R,rloc,ia,jb,i1,i1)
  71. c **** *******
  72.  
  73. RETURN
  74. END
  75.  
  76.  
  77.  
  78.  

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