1 : C TRSMTK SOURCE GOUNAND 11/05/24 21:16:23 6976 2 : SUBROUTINE TRSMTK(EMTK,SMTK) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : TRSMTK 7 : C DESCRIPTION : Transposition d'une matrice (type MATRIK) 8 : C 9 : C 10 : C LANGAGE : ESOPE 11 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 12 : C mél : gounand@semt2.smts.cea.fr 13 : C*********************************************************************** 14 : C APPELES : 15 : C APPELES (E/S) : LIROBJ 16 : C APPELES (BLAS) : 17 : C APPELES (CALCUL) : 18 : C APPELE PAR : 19 : C*********************************************************************** 20 : C SYNTAXE GIBIANE : 21 : C ENTREES : EMTK 22 : C ENTREES/SORTIES : - 23 : C SORTIES : SMTK 24 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 25 : C*********************************************************************** 26 : C VERSION : v1, 04/07/2002, version initiale 27 : C HISTORIQUE : v1, 04/07/2002, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : -INC SMMATRIK 37 : INTEGER NRIGE,NMATRI,NKID,NKMT,NBSOUS,NBME,NBEL,NP,MP 38 : POINTEUR EMTK.MATRIK 39 : POINTEUR SMTK.MATRIK 40 : POINTEUR EIMAT.IMATRI 41 : POINTEUR SIMAT.IMATRI 42 : POINTEUR EIZAF.IZAFM 43 : POINTEUR SIZAF.IZAFM 44 : * 45 : INTEGER IRETOU 46 : INTEGER IRIGE,JMATRI,IBSOUS,IBME,IBEL,INP,IMP 47 : INTEGER NBELE,NPE,MPE 48 : * 49 : * Executable statements 50 : * 51 : * 52 : * Initialisation du chapeau Matrik résultat et mise à zéro 53 : * de toute information de préconditionnement. 54 : * 55 : SEGACT EMTK 56 : NRIGE=EMTK.IRIGEL(/1) 57 : NMATRI=EMTK.IRIGEL(/2) 58 : NKID=EMTK.KIDMAT(/1) 59 : NKMT=EMTK.KKMMT(/1) 60 : SEGINI,SMTK 61 : DO JMATRI=1,NMATRI 62 : * On échange les supports primaux et duaux 63 : SMTK.IRIGEL(1,JMATRI)=EMTK.IRIGEL(2,JMATRI) 64 : SMTK.IRIGEL(2,JMATRI)=EMTK.IRIGEL(1,JMATRI) 65 : DO IRIGE=3,NRIGE 66 : SMTK.IRIGEL(IRIGE,JMATRI)=EMTK.IRIGEL(IRIGE,JMATRI) 67 : ENDDO 68 : * Pour supprimer les cas particuliers foireux 69 : SMTK.IRIGEL(7,JMATRI)=3 70 : ENDDO 71 : * 72 : * Duplication des segments IMATRI et changement des noms 73 : * d'inconnues 74 : * 75 : DO JMATRI=1,NMATRI 76 : EIMAT=EMTK.IRIGEL(4,JMATRI) 77 : SEGACT,EIMAT 78 : SEGINI,SIMAT=EIMAT 79 : SMTK.IRIGEL(4,JMATRI)=SIMAT 80 : NBSOUS=EIMAT.LIZAFM(/1) 81 : NBME =EIMAT.LIZAFM(/2) 82 : DO IBME=1,NBME 83 : SIMAT.LISPRI(IBME)=EIMAT.LISDUA(IBME) 84 : SIMAT.LISDUA(IBME)=EIMAT.LISPRI(IBME) 85 : DO IBSOUS=1,NBSOUS 86 : EIZAF=EIMAT.LIZAFM(IBSOUS,IBME) 87 : SEGACT,EIZAF 88 : NBELE=EIZAF.AM(/1) 89 : NPE =EIZAF.AM(/2) 90 : MPE =EIZAF.AM(/3) 91 : NBEL = NBELE 92 : NP = MPE 93 : MP=NPE 94 : SEGINI,SIZAF 95 : SIMAT.LIZAFM(IBSOUS,IBME)=SIZAF 96 : DO IMP=1,MP 97 : DO INP=1,NP 98 : DO IBEL=1,NBEL 99 : SIZAF.AM(IBEL,INP,IMP)=EIZAF.AM(IBEL,IMP,INP) 100 : ENDDO 101 : ENDDO 102 : ENDDO 103 : SEGDES SIZAF 104 : SEGDES EIZAF 105 : ENDDO 106 : ENDDO 107 : SEGDES SIMAT 108 : SEGDES EIMAT 109 : ENDDO 110 : SEGDES SMTK 111 : SEGDES EMTK 112 : * 113 : * Normal termination 114 : * 115 : RETURN 116 : * 117 : * Format handling 118 : * 119 : * 120 : * End of subroutine TRSMTK 121 : * 122 : END 123 : 124 : 125 : 126 : 127 :
© Cast3M 2003 - All rights reserved.
Disclaimer