Télécharger mama.eso

Retour à la liste

Numérotation des lignes :

  1. C MAMA SOURCE GOUNAND 05/12/21 21:34:01 5281
  2. SUBROUTINE MAMA(MA1,NI1,NJ1,
  3. $ COPER,
  4. $ MA2,NI2,NJ2,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : MAMA
  10. C DESCRIPTION : Implémentation d'opérations matrice -> matrice
  11. C
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES :
  19. C APPELES (E/S) :
  20. C APPELES (BLAS) :
  21. C APPELES (CALCUL) :
  22. C APPELE PAR :
  23. C***********************************************************************
  24. C SYNTAXE GIBIANE :
  25. C ENTREES :
  26. C ENTREES/SORTIES :
  27. C SORTIES :
  28. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  29. C***********************************************************************
  30. C VERSION : v1, 27/09/2005, version initiale
  31. C HISTORIQUE : v1, 27/09/2005, création
  32. C HISTORIQUE :
  33. C HISTORIQUE :
  34. C***********************************************************************
  35. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  36. C en cas de modification de ce sous-programme afin de faciliter
  37. C la maintenance !
  38. C***********************************************************************
  39. -INC CCOPTIO
  40. *
  41. REAL*8 MA1(NI1,NJ1)
  42. REAL*8 MA2(NI2,NJ2)
  43. CHARACTER*8 COPER
  44. *
  45. INTEGER IMPR,IRET
  46. *
  47. * Executable statements
  48. *
  49. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans mama.eso'
  50. IF (COPER.EQ.'COPIE ') THEN
  51. IF ((NI1.NE.NI2).OR.(NJ1.NE.NJ2)) THEN
  52. WRITE(IOIMP,*) NI1,'.NE.',NI2,'.OR.',NJ1,'.NE.',NJ2
  53. GOTO 9999
  54. ENDIF
  55. DO IJ=1,NJ1
  56. DO II=1,NI1
  57. MA2(II,IJ)=MA1(II,IJ)
  58. ENDDO
  59. ENDDO
  60. ELSEIF (COPER.EQ.'TRANSPOS') THEN
  61. IF ((NI1.NE.NJ2).OR.(NJ1.NE.NI2)) THEN
  62. WRITE(IOIMP,*) NI1,'.NE.',NJ2,'.OR.',NJ1,'.NE.',NI2
  63. GOTO 9999
  64. ENDIF
  65. DO IJ=1,NJ1
  66. DO II=1,NI1
  67. MA2(IJ,II)=MA1(II,IJ)
  68. ENDDO
  69. ENDDO
  70. ELSEIF (COPER.EQ.'JJT ') THEN
  71. IF ((NI1.NE.NI2).OR.(NI2.NE.NJ2)) THEN
  72. WRITE(IOIMP,*) NI1,'.NE.',NI2,'.OR.',NI2,'.NE.',NJ2
  73. GOTO 9999
  74. ENDIF
  75. DO IJ=1,NI1
  76. DO II=1,NI1
  77. XX=0.D0
  78. DO IK=1,NJ1
  79. XX=XX+MA1(II,IK)*MA1(IJ,IK)
  80. ENDDO
  81. MA2(II,IJ)=XX
  82. ENDDO
  83. ENDDO
  84. ELSEIF (COPER.EQ.'JTJ ') THEN
  85. IF ((NJ1.NE.NJ2).OR.(NI2.NE.NJ2)) THEN
  86. WRITE(IOIMP,*) NJ1,'.NE.',NJ2,'.OR.',NI2,'.NE.',NJ2
  87. GOTO 9999
  88. ENDIF
  89. DO IJ=1,NJ2
  90. DO II=1,NI2
  91. XX=0.D0
  92. DO IK=1,NI1
  93. XX=XX+MA1(IK,II)*MA1(IK,IJ)
  94. ENDDO
  95. MA2(II,IJ)=XX
  96. ENDDO
  97. ENDDO
  98. ELSE
  99. WRITE(IOIMP,*) 'Operation ',COPER,' unknown'
  100. GOTO 9999
  101. ENDIF
  102. *
  103. * Normal termination
  104. *
  105. IRET=0
  106. RETURN
  107. *
  108. * Format handling
  109. *
  110. *
  111. * Error handling
  112. *
  113. *
  114. 9999 CONTINUE
  115. IRET=1
  116. WRITE(IOIMP,*) 'An error was detected in subroutine mama'
  117. RETURN
  118. *
  119. * End of subroutine MAMA
  120. *
  121. END
  122.  
  123.  
  124.  

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