Télécharger mamama.eso

Retour à la liste

Numérotation des lignes :

  1. C MAMAMA SOURCE GOUNAND 05/12/21 21:34:05 5281
  2. SUBROUTINE MAMAMA(MA1,NI1,NJ1,MA2,NI2,NJ2,
  3. $ COPER,
  4. $ MA3,NI3,NJ3,
  5. $ IMPR,IRET)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. IMPLICIT INTEGER (I-N)
  8. C***********************************************************************
  9. C NOM : MAMAMA
  10. C DESCRIPTION : Implémentation d'opérations matrice 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. REAL*8 MA3(NI3,NJ3)
  44. CHARACTER*8 COPER
  45. *
  46. INTEGER IMPR,IRET
  47. *
  48. * Executable statements
  49. *
  50. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans mamama.eso'
  51. IF (COPER.EQ.'PLUS ') THEN
  52. IF ((NI1.NE.NI2).OR.(NJ1.NE.NJ2)) THEN
  53. WRITE(IOIMP,*) NI1,'.NE.',NI2,'.OR.',NJ1,'.NE.',NJ2
  54. GOTO 9999
  55. ENDIF
  56. IF ((NI1.NE.NI3).OR.(NJ1.NE.NJ3)) THEN
  57. WRITE(IOIMP,*) NI1,'.NE.',NI3,'.OR.',NJ1,'.NE.',NJ3
  58. GOTO 9999
  59. ENDIF
  60. DO IJ=1,NJ1
  61. DO II=1,NI1
  62. MA3(II,IJ)=MA1(II,IJ)+MA2(II,IJ)
  63. ENDDO
  64. ENDDO
  65. ELSEIF (COPER.EQ.'FOIS ') THEN
  66. IF ((NJ1.NE.NI2).OR.(NI1.NE.NI3).OR.(NJ2.NE.NJ3)) THEN
  67. WRITE(IOIMP,*) NJ1,'.NE.',NI2,'.OR.',NI1,'.NE.',NI3
  68. WRITE(IOIMP,*) '.OR.',NJ2,'.NE.',NJ3
  69. GOTO 9999
  70. ENDIF
  71. DO IJ=1,NJ2
  72. DO II=1,NI1
  73. XTMP=0.D0
  74. DO IK=1,NJ1
  75. XTMP=XTMP+(MA1(II,IK)*(MA2(IK,IJ)))
  76. ENDDO
  77. MA3(II,IJ)=XTMP
  78. ENDDO
  79. ENDDO
  80. ELSE
  81. WRITE(IOIMP,*) 'Operation ',COPER,' unknown'
  82. GOTO 9999
  83. ENDIF
  84. *
  85. * Normal termination
  86. *
  87. IRET=0
  88. RETURN
  89. *
  90. * Format handling
  91. *
  92. *
  93. * Error handling
  94. *
  95. *
  96. 9999 CONTINUE
  97. IRET=1
  98. WRITE(IOIMP,*) 'An error was detected in subroutine mamama'
  99. RETURN
  100. *
  101. * End of subroutine MAMAMA
  102. *
  103. END
  104.  
  105.  
  106.  

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