Sources Esope | Cast3M

trsmtk
C TRSMTK    SOURCE    PV        20/09/26    21:20:07     10724          
      SUBROUTINE TRSMTK(EMTK,SMTK)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : TRSMTK
C DESCRIPTION : Transposition d'une matrice (type MATRIK)
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          :
C APPELES (E/S)    : LIROBJ
C APPELES (BLAS)   :
C APPELES (CALCUL) :
C APPELE PAR       :
C***********************************************************************
C SYNTAXE GIBIANE    :
C ENTREES            : EMTK
C ENTREES/SORTIES    : -
C SORTIES            : SMTK
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 04/07/2002, version initiale
C HISTORIQUE : v1, 04/07/2002, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      INTEGER NRIGE,NMATRI,NKID,NKMT,NBSOUS,NBME,NBEL,NP,MP
      POINTEUR EMTK.MATRIK
      POINTEUR SMTK.MATRIK
      POINTEUR EIMAT.IMATRI
      POINTEUR SIMAT.IMATRI
      POINTEUR EIZAF.IZAFM
      POINTEUR SIZAF.IZAFM
*
      INTEGER IRETOU
      INTEGER IRIGE,JMATRI,IBSOUS,IBME,IBEL,INP,IMP
      INTEGER NBELE,NPE,MPE
*
* Executable statements
*
*
* Initialisation du chapeau Matrik résultat et mise à zéro
* de toute information de préconditionnement.
*
      SEGACT EMTK
      NRIGE=EMTK.IRIGEL(/1)
      NMATRI=EMTK.IRIGEL(/2)
      NKID=EMTK.KIDMAT(/1)
      NKMT=EMTK.KKMMT(/1)
      SEGINI,SMTK
      DO JMATRI=1,NMATRI
* On échange les supports primaux et duaux
         SMTK.IRIGEL(1,JMATRI)=EMTK.IRIGEL(2,JMATRI)
         SMTK.IRIGEL(2,JMATRI)=EMTK.IRIGEL(1,JMATRI)
         DO IRIGE=3,NRIGE
            SMTK.IRIGEL(IRIGE,JMATRI)=EMTK.IRIGEL(IRIGE,JMATRI)
         ENDDO
* Pour supprimer les cas particuliers foireux
         SMTK.IRIGEL(7,JMATRI)=3
      ENDDO
*
* Duplication des segments IMATRI et changement des noms
* d'inconnues
*
      DO JMATRI=1,NMATRI
         EIMAT=EMTK.IRIGEL(4,JMATRI)
         SEGACT,EIMAT
         SEGINI,SIMAT=EIMAT
         SMTK.IRIGEL(4,JMATRI)=SIMAT
         NBSOUS=EIMAT.LIZAFM(/1)
         NBME  =EIMAT.LIZAFM(/2)
         DO IBME=1,NBME
            SIMAT.LISPRI(IBME)=EIMAT.LISDUA(IBME)
            SIMAT.LISDUA(IBME)=EIMAT.LISPRI(IBME)
            DO IBSOUS=1,NBSOUS
               EIZAF=EIMAT.LIZAFM(IBSOUS,IBME)
               SEGACT,EIZAF
               NBELE=EIZAF.AM(/1)
               NPE  =EIZAF.AM(/2)
               MPE  =EIZAF.AM(/3)
               NBEL = NBELE
               NP   = MPE
               MP=NPE
               SEGINI,SIZAF
               SIMAT.LIZAFM(IBSOUS,IBME)=SIZAF
               DO IMP=1,MP
                  DO INP=1,NP
                     DO IBEL=1,NBEL
                        SIZAF.AM(IBEL,INP,IMP)=EIZAF.AM(IBEL,IMP,INP)
                     ENDDO
                  ENDDO
               ENDDO
               SEGDES SIZAF
               SEGDES EIZAF
            ENDDO
         ENDDO
         SEGDES SIMAT
         SEGDES EIMAT
      ENDDO
      SEGDES SMTK
      SEGDES EMTK
*
* Normal termination
*
      RETURN
*
* Format handling
*
*
* End of subroutine TRSMTK
*
      END