Télécharger la plaquette Cast3M


fr en

Télécharger mamama.eso

Retour à la liste

Numérotation des lignes : 

mamama

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

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