Télécharger mulabt.eso

Retour à la liste

Numérotation des lignes :

  1. C MULABT SOURCE AM 12/02/28 00:28:37 7289
  2.  
  3.  
  4. SUBROUTINE MULABT(A,B,R,ia,ja,ib,jb)
  5. C
  6. C ***************************************************************
  7. C * *
  8. C * MULTIPLICATION OF A BY Btranspose *
  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,ib)
  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 mulABT(A,B,A,...)
  30. c or Call mulABT(A,B,B,...)
  31.  
  32. i1 = 1
  33. i0 = 0
  34. i3 = 3
  35. i6 = 6
  36. r0 = 0.
  37.  
  38. if (ia*ib.gt.idimrloc) then
  39. write(2,3)ia,ib,ia*ib,idimrloc
  40. 3 format(' ERROR from subr. MULABT.'/
  41. . ' The dimensions of the result matrix are ',i3,'X',i3,' = ',
  42. . i6,' > ',i6/
  43. . ' Change idimrloc in MULABT')
  44. stop
  45. endif
  46.  
  47.  
  48. if (ja.ne.jb) then
  49. write(2,2000) ia,ja,jb,ib
  50. write(*,2000) ia,ja,jb,ib
  51. 2000 format(' ERROR in subr. MULATB.'/
  52. . ' It is impossible to multiply a matrix of dimensions',I3
  53. . ,' x',i3/
  54. . ' by a matrix of dimensions',I3
  55. . ,' x',i3)
  56. stop
  57. endif
  58.  
  59. iloc = i0
  60. DO 1 j=i1,ib
  61. DO 1 i=i1,ia
  62. iloc = iloc+i1
  63. SUM = r0
  64. DO 2 K=i1,ja
  65. SUM = SUM+A(I,K)*B(J,K)
  66. 2 CONTINUE
  67. rloc(iloc) = SUM
  68. 1 CONTINUE
  69.  
  70. call AequalB(R,rloc,ia,ib,i1,i1)
  71. c **** *******
  72.  
  73. RETURN
  74. END
  75.  
  76.  
  77.  
  78.  

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