1 : C ECMATK SOURCE MAGN 09/07/30 21:16:43 6458 2 : SUBROUTINE ECMATK(IMATRK) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : ECMATK 7 : C DESCRIPTION : Impression d'un segment de type MATRIK 8 : C 9 : C Les sous-programmes ECIMAT, ECMINC, ECMORS sont 10 : C également appelables indépendamment en Esope. 11 : C (utiles pour la mise au point). 12 : C 13 : C Ils impriment respectivement les segments de type 14 : C IMATRI, MINC, (KMORS, KISA)<->matrice Morse. 15 : C 16 : C Pour plus de précisions, voir la notice de ces 17 : C sous-programmes et l'include SMMATRIK. 18 : C 19 : C 20 : C LANGAGE : ESOPE 21 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 22 : C mél : gounand@semt2.smts.cea.fr 23 : C*********************************************************************** 24 : C APPELES (E/S) : LIRENT, ERREUR 25 : C ECIMAT, ECMINC, ECMORS 26 : C*********************************************************************** 27 : C SYNTAXE GIBIANE : 'LIST' MATRIK NIVIMP 28 : C ENTREES : IMATRK 29 : C ENTREES/SORTIES : - 30 : C SORTIES : - 31 : C CODE RETOUR (IRET) : - 32 : C IMATRK : segment de type MATRIK (include SMMATRIK) 33 : C NIVIMP : niveau d'impression. Suivant sa valeur, on obtient : 34 : C Convention (probablement non totalement respectée) : 35 : C ---------- 0 : presque rien (numéro de pointeur) 36 : C 1 : affichage du chapeau MATRIK 37 : C 2 : affichage des données concernant les objets 38 : C pointés par MATRIK 39 : C 3 : affichage du contenu des objets vectoriels 40 : C 4 : affichage du contenu des objets matriciels 41 : C On ne change pas l'état (actif ou inactif) du segment IMATRK. 42 : C*********************************************************************** 43 : C VERSION : 20/12/99 44 : C HISTORIQUE : v1, 01/04/98, création 45 : C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé 46 : C en sortie 47 : C HISTORIQUE : 20/12/99, ajout des nouveaux types de matrice (-3) et de 48 : C l'affichage éventuel des maillages supports. 49 : C HISTORIQUE : 50 : C*********************************************************************** 51 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 52 : C en cas de modification de ce sous-programme afin de faciliter 53 : C la maintenance ! 54 : C*********************************************************************** 55 : -INC CCOPTIO 56 : -INC SMMATRIK 57 : POINTEUR IMATRK.MATRIK 58 : * 59 : * Variables pour la gestion des options de l'opérateur LIST 60 : * 61 : INTEGER NIVIMP 62 : * 63 : INTEGER I,IRETOU,LENTYP,NA 64 : INTEGER NBID,NBLK,NBTMAT,NKMT 65 : INTEGER NKZA,NMATRI,NPT,NRIGE 66 : * Variable d'état du segment IMATRK 67 : INTEGER IMAETA 68 : * 69 : * Tableau de correspondance (numéro <-> type de matrice) 70 : * stocké dans IRIGEL(7,.) 71 : PARAMETER (LENTYP=30) 72 : PARAMETER (NBTMAT=9) 73 : CHARACTER*(LENTYP) TYPMAT(-3:NBTMAT) 74 : 75 : * Initialisations des tableaux 76 : * Tableau des types de matrice 77 : DATA TYPMAT/ 78 : $ 'RECTANGULAIRE (DUAL mult.lag.)', 79 : $ 'inconnu au bataillon ', 80 : $ 'inconnu au bataillon ', 81 : $ 'SYMETRIQUE ', 82 : $ 'ANTISYMETRIQUE ', 83 : $ 'NON SYMETRIQUE ', 84 : $ 'RECTANGULAIRE ', 85 : $ 'CCt (DUAL mult.lag.)', 86 : $ 'DIAGONALE ', 87 : $ 'MORSE ', 88 : $ 'SYMETRIQUE apres assemblage ', 89 : $ 'NON SYMETRIQUE apres assem. ', 90 : $ 'MATRICE DE ROTATION '/ 91 : 92 : * Tableau message d'erreur 93 : MOTERR(1:40)=' ' 94 : * Lecture des options : 95 : * On précise un niveau d'impression. 96 : * Par défaut : 1 97 : * 97 : CALL LIRENT(NIVIMP,0,IRETOU) 98 : IF (IRETOU.EQ.0) THEN 99 : NIVIMP=1 100 : ELSEIF ((NIVIMP.LT.0).OR.(NIVIMP.GT.9)) THEN 101 : * %m1:40 102 : * Données incompatibles 103 : MOTERR(1:6)='NIVIMP' 103 : CALL ERREUR(-301) 103 : CALL ERREUR(21) 104 : GOTO 9999 105 : ENDIF 106 : * Début 107 : MATRIK=IMATRK 107 : CALL OOOETA(MATRIK,IMAETA) 108 : IF (IMAETA.NE.1) SEGACT MATRIK 109 : WRITE(IOIMP,2001) 'Segment MATRIK de pointeur ',MATRIK 110 : * 111 : * Affichage du chapeau 112 : * 113 : IF (NIVIMP.GT.0) THEN 114 : NRIGE =IRIGEL(/1) 115 : NMATRI=IRIGEL(/2) 116 : WRITE(IOIMP,1999) 'Rigidités élémentaires :' 117 : WRITE(IOIMP,1000) 'Tableau IRIGEL (',NRIGE,',',NMATRI,')' 118 : DO 2 I=1,NMATRI 119 : WRITE(IOIMP,1001) 'IRIGEL(1,',I,')=',IRIGEL(1,I), 120 : $ ' (Pointeur MELEME primal)' 121 : WRITE(IOIMP,1001) 'IRIGEL(2,',I,')=',IRIGEL(2,I), 122 : $ ' (Pointeur MELEME dual)' 123 : WRITE(IOIMP,1001) 'IRIGEL(4,',I,')=',IRIGEL(4,I), 124 : $ ' (Pointeur IMATRI)' 125 : WRITE(IOIMP,1001) 'IRIGEL(5,',I,')=',IRIGEL(5,I), 126 : $ ' (Non utilisé)' 127 : WRITE(IOIMP,1001) 'IRIGEL(6,',I,')=',IRIGEL(6,I), 128 : $ ' (Non utilisé)' 129 : WRITE(IOIMP,1001) 'IRIGEL(7,',I,')=',IRIGEL(7,I), 130 : $ ' : matrice ',TYPMAT(IRIGEL(7,I)) 131 : WRITE(IOIMP,1998) '---' 132 : 2 CONTINUE 133 : WRITE(IOIMP,1999) ' ' 134 : WRITE(IOIMP,1999) 'Matrice assemblée :' 135 : WRITE(IOIMP,1996) 'KSYM=',KSYM,' : matrice ',TYPMAT(KSYM) 136 : WRITE(IOIMP,1998) 'Pointeurs MINC (répartition des inconnues)' 137 : WRITE(IOIMP,1002) 'KMINC =',KMINC,'(total)', 138 : $ 'KMINCP=',KMINCP,'(primal)', 139 : $ 'KMINCD=',KMINCD,'(dual)' 140 : WRITE(IOIMP,1998) 'Pointeurs MELEME (SPG assemblés)' 141 : WRITE(IOIMP,1003) 'KISPGT=',KISPGT, 142 : $ 'KISPGP=',KISPGP, 143 : $ 'KISPGD=',KISPGD 144 : IF (NIVIMP.GT.4.AND.KISPGT.NE.0) THEN 145 : MELEME=KISPGT 146 : WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME 147 : WRITE(IOIMP,*) 'pointé par KISPGT' 147 : CALL ECROBJ('MAILLAGE',MELEME) 147 : CALL PRLIST 148 : ENDIF 149 : WRITE(IOIMP,1998) 'Nombre d''inconnues total' 150 : WRITE(IOIMP,1003) 'KNTTT =',KNTTT, 151 : $ 'KNTTP =',KNTTP, 152 : $ 'KNTTD =',KNTTD 153 : WRITE(IOIMP,1998) 'Pointeur MELEME (connectivités globales)' 154 : WRITE(IOIMP,1005) 'KIZM =',KIZM 155 : WRITE(IOIMP,1999) ' ' 156 : WRITE(IOIMP,1999) 'Tableau KIDMAT(9) (stockage Choleski) :' 157 : WRITE(IOIMP,1998) 'Pointeur IDMAT' 158 : WRITE(IOIMP,1004) '(1) IDMATP=',KIDMAT(1), 159 : $ '(2) IDMATD=',KIDMAT(2) 160 : WRITE(IOIMP,1998) 'Pointeur IZA (second membre)' 161 : WRITE(IOIMP,1005) '(3) KS2B =',KIDMAT(3) 162 : WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée)' 163 : WRITE(IOIMP,1004) '(4) KMORS =',KIDMAT(4), 164 : $ '(5) KISA =',KIDMAT(5) 165 : WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée AAt)' 166 : WRITE(IOIMP,1004) '(6) KMRST =',KIDMAT(6), 167 : $ '(7) KIST =',KIDMAT(7) 168 : WRITE(IOIMP,1998) 'Pointeur MCHPOI (conditions aux limites)' 169 : WRITE(IOIMP,1005) '(8) KCLIM =',KIDMAT(8) 170 : WRITE(IOIMP,1007) '(9) KTRING=',KIDMAT(9),'(0=non triangulée)' 171 : NKMT=KKMMT(/1) 172 : WRITE(IOIMP,1999) ' ' 173 : WRITE(IOIMP,1006) 'Tableau KKMMT(',NKMT,')',(KKMMT(I),I=1,NKMT) 174 : WRITE(IOIMP,1999) 'END Segment MATRIK' 175 : WRITE(IOIMP,1999) ' ' 176 : ENDIF 177 : * 178 : * Affichage des segments pointés par MATRIK 179 : * 180 : IF (NIVIMP.GT.1) THEN 181 : * Affichage des IMATRI 182 : DO 3 I=1,NMATRI 183 : IF (NIVIMP.GT.4) THEN 184 : MELEME=IRIGEL(1,I) 185 : WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME 186 : WRITE(IOIMP,2002) 'pointé par IRIGEL(1,',I,')' 186 : CALL ECROBJ('MAILLAGE',MELEME) 186 : CALL PRLIST 187 : MELEME=IRIGEL(2,I) 188 : WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME 189 : WRITE(IOIMP,2002) 'pointé par IRIGEL(2,',I,')' 189 : CALL ECROBJ('MAILLAGE',MELEME) 189 : CALL PRLIST 190 : ENDIF 191 : IMATRI=IRIGEL(4,I) 192 : WRITE(IOIMP,2001) 'Segment IMATRI de pointeur',IMATRI 193 : WRITE(IOIMP,2002) 'pointé par IRIGEL(4,',I,')' 194 : IF (IMATRI.NE.0) THEN 194 : CALL ECIMAT(IMATRI,NIVIMP) 195 : ENDIF 196 : WRITE(IOIMP,1999) 'End segment IMATRI' 197 : WRITE(IOIMP,1999) ' ' 198 : 3 CONTINUE 199 : * Affichage des MINC 200 : IF (KMINC.NE.0) THEN 201 : WRITE(IOIMP,3000) KMINC,'Total' 202 : MINC=KMINC 202 : CALL ECMINC(MINC,NIVIMP) 203 : WRITE(IOIMP,1999) 'End segment MINC' 204 : WRITE(IOIMP,1999) ' ' 205 : ENDIF 206 : IF ((KMINCP.NE.0).AND.(KMINCP.NE.KMINC)) THEN 207 : WRITE(IOIMP,3000) KMINCP,'Primal' 208 : MINC=KMINCP 208 : CALL ECMINC(MINC,NIVIMP) 209 : WRITE(IOIMP,1999) 'End segment MINC' 210 : WRITE(IOIMP,1999) ' ' 211 : ENDIF 212 : IF ((KMINCD.NE.0).AND.(KMINCD.NE.KMINC).AND.(KMINCD.NE.KMINCP)) 213 : $ THEN 214 : WRITE(IOIMP,3000) KMINCD,'Dual' 215 : MINC=KMINCD 215 : CALL ECMINC(MINC,NIVIMP) 216 : WRITE(IOIMP,1999) 'End segment MINC' 217 : WRITE(IOIMP,1999) ' ' 218 : ENDIF 219 : * Affichage des matrices stockées en MORSE 220 : PMORS=KIDMAT(4) 221 : IZA=KIDMAT(5) 222 : IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN 223 : WRITE(IOIMP,4000) PMORS,IZA,'assemblée' 223 : CALL ECMORS(PMORS,IZA,NIVIMP) 224 : WRITE(IOIMP,1999) 'End Matrice Morse' 225 : WRITE(IOIMP,1999) ' ' 226 : ENDIF 227 : PMORS=KIDMAT(6) 228 : IZA=KIDMAT(7) 229 : IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN 230 : WRITE(IOIMP,4000) PMORS,IZA,'assemblée AAt' 230 : CALL ECMORS(PMORS,IZA,NIVIMP) 231 : WRITE(IOIMP,1999) 'End Matrice Morse' 232 : WRITE(IOIMP,1999) ' ' 233 : ENDIF 234 : * Affichage du segment stockage bloc Choleski 235 : IF (NIVIMP.GT.3) THEN 236 : DO 5 NBID=1,2 237 : IDMAT=KIDMAT(NBID) 238 : IF (IDMAT.NE.0) THEN 239 : SEGACT IDMAT 240 : IF (NBID.EQ.1) WRITE(IOIMP,5000) IDMAT,'primal' 241 : IF (NBID.EQ.2) WRITE(IOIMP,5000) IDMAT,'dual' 242 : WRITE(IOIMP,*) 'IDIAG=',IDIAG 243 : IF (IDIAG.NE.0) THEN 244 : IZA=IDIAG 245 : SEGACT IZA 246 : NA=A(/1) 247 : WRITE(IOIMP,1902) (A(I),I=1,NA) 248 : SEGDES IZA 249 : ENDIF 250 : NKZA=KZA(/1) 251 : WRITE(IOIMP,*) 'KZA(1..',NKZA,')' 252 : WRITE(IOIMP,5001) (KZA(I),I=1,NKZA) 253 : WRITE(IOIMP,*) 'NUIA(1..',NKZA,',2)' 254 : WRITE(IOIMP,5001) (NUIA(I,1),I=1,NKZA) 255 : WRITE(IOIMP,5001) (NUIA(I,2),I=1,NKZA) 256 : NPT=NUAN(/1) 257 : WRITE(IOIMP,*) 'NUAN(1..',NPT,')' 258 : WRITE(IOIMP,5001) (NUAN(I),I=1,NPT) 259 : WRITE(IOIMP,*) 'NUNA(1..',NPT,')' 260 : WRITE(IOIMP,5001) (NUNA(I),I=1,NPT) 261 : NBLK=IDESCL(/1) 262 : WRITE(IOIMP,*) 'IDESCL(1..',NBLK,')' 263 : WRITE(IOIMP,5001) (IDESCL(I),I=1,NBLK) 264 : WRITE(IOIMP,*) 'IDESCU(1..',NBLK,')' 265 : WRITE(IOIMP,5001) (IDESCU(I),I=1,NBLK) 266 : WRITE(IOIMP,*) 'NLDBLK(1..',NBLK+1,')' 267 : WRITE(IOIMP,5001) (NLDBLK(I),I=1,NBLK+1) 268 : SEGDES IDMAT 269 : ENDIF 270 : 5 CONTINUE 271 : ENDIF 272 : ENDIF 273 : IF (IMAETA.NE.1) SEGDES MATRIK 274 : * 275 : * Normal termination 276 : * 277 : RETURN 278 : * 279 : * Format handling 280 : * 281 : 1901 FORMAT ( ' OBJET DE TYPE MATRIK '/ 282 : & ' -------------------- ') 283 : 1902 FORMAT (8(1X,1PE11.2)) 284 : * Chapeau MATRIK 285 : 1000 FORMAT (2X,A,I1,A,I1,A) 286 : 1001 FORMAT (4X,A,I1,A,I6,2A) 287 : 1002 FORMAT (4X,A,I6,1X,A,4X,A,I6,1X,A,4X,A,I6,1X,A) 288 : 1003 FORMAT (4X,A,I6,4X,A,I6,4X,A,I6) 289 : 1004 FORMAT (4X,A,I6,4X,A,I6) 290 : 1005 FORMAT (4X,A,I6) 291 : 1006 FORMAT (A,I1,A,8(1X,I6)) 292 : 1007 FORMAT (4X,A,I1,2X,A) 293 : 1996 FORMAT (2X,A,I1,A,A) 294 : 1997 FORMAT (4X,A) 295 : 1998 FORMAT (2X,A) 296 : 1999 FORMAT (A) 297 : * Segments IMATRI 298 : 2001 FORMAT (A,1X,I6) 299 : 2002 FORMAT (A,I1,A) 300 : * Segments MINC 301 : 3000 FORMAT ('Segment MINC de pointeur',1X,I6,1X,'(',A,')') 302 : * Matrices Morses 303 : 4000 FORMAT ('Matrice Morse de pointeurs',1X,I6,1X,I6,1X,'(',A,')') 304 : * Chapeau Choleski 305 : 5000 FORMAT ('Chapeau Choleski de pointeur',1X,I6,1X,'(',A,')') 306 : 5001 FORMAT (8(1X,I8)) 307 : * 308 : * Error handling 309 : * 310 : 9999 CONTINUE 311 : RETURN 312 : * 313 : * End of subroutine ECMATK 314 : * 315 : END 316 : 317 : 318 : 319 :
© Cast3M 2003 - All rights reserved.
Disclaimer