Esope source files

   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 :