Télécharger mama.eso

Retour à la liste

Numérotation des lignes :

mama
  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.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. *
  43. REAL*8 MA1(NI1,NJ1)
  44. REAL*8 MA2(NI2,NJ2)
  45. CHARACTER*8 COPER
  46. *
  47. INTEGER IMPR,IRET
  48. *
  49. * Executable statements
  50. *
  51. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans mama.eso'
  52. IF (COPER.EQ.'COPIE ') THEN
  53. IF ((NI1.NE.NI2).OR.(NJ1.NE.NJ2)) THEN
  54. WRITE(IOIMP,*) NI1,'.NE.',NI2,'.OR.',NJ1,'.NE.',NJ2
  55. GOTO 9999
  56. ENDIF
  57. DO IJ=1,NJ1
  58. DO II=1,NI1
  59. MA2(II,IJ)=MA1(II,IJ)
  60. ENDDO
  61. ENDDO
  62. ELSEIF (COPER.EQ.'TRANSPOS') THEN
  63. IF ((NI1.NE.NJ2).OR.(NJ1.NE.NI2)) THEN
  64. WRITE(IOIMP,*) NI1,'.NE.',NJ2,'.OR.',NJ1,'.NE.',NI2
  65. GOTO 9999
  66. ENDIF
  67. DO IJ=1,NJ1
  68. DO II=1,NI1
  69. MA2(IJ,II)=MA1(II,IJ)
  70. ENDDO
  71. ENDDO
  72. ELSEIF (COPER.EQ.'JJT ') THEN
  73. IF ((NI1.NE.NI2).OR.(NI2.NE.NJ2)) THEN
  74. WRITE(IOIMP,*) NI1,'.NE.',NI2,'.OR.',NI2,'.NE.',NJ2
  75. GOTO 9999
  76. ENDIF
  77. DO IJ=1,NI1
  78. DO II=1,NI1
  79. XX=0.D0
  80. DO IK=1,NJ1
  81. XX=XX+MA1(II,IK)*MA1(IJ,IK)
  82. ENDDO
  83. MA2(II,IJ)=XX
  84. ENDDO
  85. ENDDO
  86. ELSEIF (COPER.EQ.'JTJ ') THEN
  87. IF ((NJ1.NE.NJ2).OR.(NI2.NE.NJ2)) THEN
  88. WRITE(IOIMP,*) NJ1,'.NE.',NJ2,'.OR.',NI2,'.NE.',NJ2
  89. GOTO 9999
  90. ENDIF
  91. DO IJ=1,NJ2
  92. DO II=1,NI2
  93. XX=0.D0
  94. DO IK=1,NI1
  95. XX=XX+MA1(IK,II)*MA1(IK,IJ)
  96. ENDDO
  97. MA2(II,IJ)=XX
  98. ENDDO
  99. ENDDO
  100. ELSE
  101. WRITE(IOIMP,*) 'Operation ',COPER,' unknown'
  102. GOTO 9999
  103. ENDIF
  104. *
  105. * Normal termination
  106. *
  107. IRET=0
  108. RETURN
  109. *
  110. * Format handling
  111. *
  112. *
  113. * Error handling
  114. *
  115. *
  116. 9999 CONTINUE
  117. IRET=1
  118. WRITE(IOIMP,*) 'An error was detected in subroutine mama'
  119. RETURN
  120. *
  121. * End of subroutine MAMA
  122. *
  123. END
  124.  
  125.  
  126.  

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