C ECMATK SOURCE PV 20/09/26 21:16:33 10724 SUBROUTINE ECMATK(IMATRK) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : ECMATK C DESCRIPTION : Impression d'un segment de type MATRIK C C Les sous-programmes ECIMAT, ECMINC, ECMORS sont C également appelables indépendamment en Esope. C (utiles pour la mise au point). C C Ils impriment respectivement les segments de type C IMATRI, MINC, (KMORS, KISA)<->matrice Morse. C C Pour plus de précisions, voir la notice de ces C sous-programmes et l'include SMMATRIK. C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES (E/S) : LIRENT, ERREUR C ECIMAT, ECMINC, ECMORS C*********************************************************************** C SYNTAXE GIBIANE : 'LIST' MATRIK NIVIMP C ENTREES : IMATRK C ENTREES/SORTIES : - C SORTIES : - C CODE RETOUR (IRET) : - C IMATRK : segment de type MATRIK (include SMMATRIK) C NIVIMP : niveau d'impression. Suivant sa valeur, on obtient : C Convention (probablement non totalement respectée) : C ---------- 0 : presque rien (numéro de pointeur) C 1 : affichage du chapeau MATRIK C 2 : affichage des données concernant les objets C pointés par MATRIK C 3 : affichage du contenu des objets vectoriels C 4 : affichage du contenu des objets matriciels C On ne change pas l'état (actif ou inactif) du segment IMATRK. C*********************************************************************** C VERSION : 20/12/99 C HISTORIQUE : v1, 01/04/98, création C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé C en sortie C HISTORIQUE : 20/12/99, ajout des nouveaux types de matrice (-3) et de C l'affichage éventuel des maillages supports. 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 POINTEUR IMATRK.MATRIK * * Variables pour la gestion des options de l'opérateur LIST * INTEGER NIVIMP * INTEGER I,IRETOU,LENTYP,NA INTEGER NBID,NBLK,NBTMAT,NKMT INTEGER NKZA,NMATRI,NPT,NRIGE * Variable d'état du segment IMATRK INTEGER IMAETA * * Tableau de correspondance (numéro <-> type de matrice) * stocké dans IRIGEL(7,.) PARAMETER (LENTYP=30) PARAMETER (NBTMAT=9) CHARACTER*(LENTYP) TYPMAT(-3:NBTMAT) * Initialisations des tableaux * Tableau des types de matrice DATA TYPMAT/ $ 'RECTANGULAIRE (DUAL mult.lag.)', $ 'inconnu au bataillon ', $ 'inconnu au bataillon ', $ 'SYMETRIQUE ', $ 'ANTISYMETRIQUE ', $ 'NON SYMETRIQUE ', $ 'RECTANGULAIRE ', $ 'CCt (DUAL mult.lag.)', $ 'DIAGONALE ', $ 'MORSE ', $ 'SYMETRIQUE apres assemblage ', $ 'NON SYMETRIQUE apres assem. ', $ 'MATRICE DE ROTATION '/ * Tableau message d'erreur MOTERR(1:40)=' ' * Lecture des options : * On précise un niveau d'impression. * Par défaut : 1 * CALL LIRENT(NIVIMP,0,IRETOU) IF (IRETOU.EQ.0) THEN NIVIMP=1 ELSEIF ((NIVIMP.LT.0).OR.(NIVIMP.GT.9)) THEN * %m1:40 * Données incompatibles MOTERR(1:6)='NIVIMP' CALL ERREUR(-301) CALL ERREUR(21) GOTO 9999 ENDIF * Début MATRIK=IMATRK CALL OOOETA(MATRIK,IMAETA,IMOD) IF (IMAETA.NE.1) SEGACT MATRIK WRITE(IOIMP,2001) 'Segment MATRIK de pointeur ',MATRIK * * Affichage du chapeau * IF (NIVIMP.GT.0) THEN NRIGE =IRIGEL(/1) NMATRI=IRIGEL(/2) WRITE(IOIMP,1999) 'Rigidités élémentaires :' WRITE(IOIMP,1000) 'Tableau IRIGEL (',NRIGE,',',NMATRI,')' DO 2 I=1,NMATRI WRITE(IOIMP,1001) 'IRIGEL(1,',I,')=',IRIGEL(1,I), $ ' (Pointeur MELEME primal)' WRITE(IOIMP,1001) 'IRIGEL(2,',I,')=',IRIGEL(2,I), $ ' (Pointeur MELEME dual)' WRITE(IOIMP,1001) 'IRIGEL(4,',I,')=',IRIGEL(4,I), $ ' (Pointeur IMATRI)' WRITE(IOIMP,1001) 'IRIGEL(5,',I,')=',IRIGEL(5,I), $ ' (Non utilisé)' WRITE(IOIMP,1001) 'IRIGEL(6,',I,')=',IRIGEL(6,I), $ ' (Non utilisé)' WRITE(IOIMP,1001) 'IRIGEL(7,',I,')=',IRIGEL(7,I), $ ' : matrice ',TYPMAT(IRIGEL(7,I)) WRITE(IOIMP,1998) '---' 2 CONTINUE WRITE(IOIMP,1999) ' ' WRITE(IOIMP,1999) 'Matrice assemblée :' WRITE(IOIMP,1996) 'KSYM=',KSYM,' : matrice ',TYPMAT(KSYM) WRITE(IOIMP,1998) 'Pointeurs MINC (répartition des inconnues)' WRITE(IOIMP,1002) 'KMINC =',KMINC,'(total)', $ 'KMINCP=',KMINCP,'(primal)', $ 'KMINCD=',KMINCD,'(dual)' WRITE(IOIMP,1998) 'Pointeurs MELEME (SPG assemblés)' WRITE(IOIMP,1003) 'KISPGT=',KISPGT, $ 'KISPGP=',KISPGP, $ 'KISPGD=',KISPGD IF (NIVIMP.GT.4.AND.KISPGT.NE.0) THEN MELEME=KISPGT WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME WRITE(IOIMP,*) 'pointé par KISPGT' CALL ECROBJ('MAILLAGE',MELEME) CALL PRLIST ENDIF WRITE(IOIMP,1998) 'Nombre d''inconnues total' WRITE(IOIMP,1003) 'KNTTT =',KNTTT, $ 'KNTTP =',KNTTP, $ 'KNTTD =',KNTTD WRITE(IOIMP,1998) 'Pointeur MELEME (connectivités globales)' WRITE(IOIMP,1005) 'KIZM =',KIZM WRITE(IOIMP,1999) ' ' WRITE(IOIMP,1999) 'Tableau KIDMAT(9) (stockage Choleski) :' WRITE(IOIMP,1998) 'Pointeur IDMAT' WRITE(IOIMP,1004) '(1) IDMATP=',KIDMAT(1), $ '(2) IDMATD=',KIDMAT(2) WRITE(IOIMP,1998) 'Pointeur IZA (second membre)' WRITE(IOIMP,1005) '(3) KS2B =',KIDMAT(3) WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée)' WRITE(IOIMP,1004) '(4) KMORS =',KIDMAT(4), $ '(5) KISA =',KIDMAT(5) WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée AAt)' WRITE(IOIMP,1004) '(6) KMRST =',KIDMAT(6), $ '(7) KIST =',KIDMAT(7) WRITE(IOIMP,1998) 'Pointeur MCHPOI (conditions aux limites)' WRITE(IOIMP,1005) '(8) KCLIM =',KIDMAT(8) WRITE(IOIMP,1007) '(9) KTRING=',KIDMAT(9),'(0=non triangulée)' NKMT=KKMMT(/1) WRITE(IOIMP,1999) ' ' WRITE(IOIMP,1006) 'Tableau KKMMT(',NKMT,')',(KKMMT(I),I=1,NKMT) WRITE(IOIMP,1999) 'END Segment MATRIK' WRITE(IOIMP,1999) ' ' ENDIF * * Affichage des segments pointés par MATRIK * IF (NIVIMP.GT.1) THEN * Affichage des IMATRI DO 3 I=1,NMATRI IF (NIVIMP.GT.4) THEN MELEME=IRIGEL(1,I) WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME WRITE(IOIMP,2002) 'pointé par IRIGEL(1,',I,')' CALL ECROBJ('MAILLAGE',MELEME) CALL PRLIST MELEME=IRIGEL(2,I) WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME WRITE(IOIMP,2002) 'pointé par IRIGEL(2,',I,')' CALL ECROBJ('MAILLAGE',MELEME) CALL PRLIST ENDIF IMATRI=IRIGEL(4,I) WRITE(IOIMP,2001) 'Segment IMATRI de pointeur',IMATRI WRITE(IOIMP,2002) 'pointé par IRIGEL(4,',I,')' IF (IMATRI.NE.0) THEN CALL ECIMAT(IMATRI,NIVIMP) ENDIF WRITE(IOIMP,1999) 'End segment IMATRI' WRITE(IOIMP,1999) ' ' 3 CONTINUE * Affichage des MINC IF (KMINC.NE.0) THEN WRITE(IOIMP,3000) KMINC,'Total' MINC=KMINC CALL ECMINC(MINC,NIVIMP) WRITE(IOIMP,1999) 'End segment MINC' WRITE(IOIMP,1999) ' ' ENDIF IF ((KMINCP.NE.0).AND.(KMINCP.NE.KMINC)) THEN WRITE(IOIMP,3000) KMINCP,'Primal' MINC=KMINCP CALL ECMINC(MINC,NIVIMP) WRITE(IOIMP,1999) 'End segment MINC' WRITE(IOIMP,1999) ' ' ENDIF IF ((KMINCD.NE.0).AND.(KMINCD.NE.KMINC).AND.(KMINCD.NE.KMINCP)) $ THEN WRITE(IOIMP,3000) KMINCD,'Dual' MINC=KMINCD CALL ECMINC(MINC,NIVIMP) WRITE(IOIMP,1999) 'End segment MINC' WRITE(IOIMP,1999) ' ' ENDIF * Affichage des matrices stockées en MORSE PMORS=KIDMAT(4) IZA=KIDMAT(5) IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN WRITE(IOIMP,4000) PMORS,IZA,'assemblée' CALL ECMORS(PMORS,IZA,NIVIMP) WRITE(IOIMP,1999) 'End Matrice Morse' WRITE(IOIMP,1999) ' ' ENDIF PMORS=KIDMAT(6) IZA=KIDMAT(7) IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN WRITE(IOIMP,4000) PMORS,IZA,'assemblée AAt' CALL ECMORS(PMORS,IZA,NIVIMP) WRITE(IOIMP,1999) 'End Matrice Morse' WRITE(IOIMP,1999) ' ' ENDIF * Affichage du segment stockage bloc Choleski IF (NIVIMP.GT.3) THEN DO 5 NBID=1,2 IDMAT=KIDMAT(NBID) IF (IDMAT.NE.0) THEN SEGACT IDMAT IF (NBID.EQ.1) WRITE(IOIMP,5000) IDMAT,'primal' IF (NBID.EQ.2) WRITE(IOIMP,5000) IDMAT,'dual' WRITE(IOIMP,*) 'IDIAG=',IDIAG IF (IDIAG.NE.0) THEN IZA=IDIAG SEGACT IZA NA=A(/1) WRITE(IOIMP,1902) (A(I),I=1,NA) SEGDES IZA ENDIF NKZA=KZA(/1) WRITE(IOIMP,*) 'KZA(1..',NKZA,')' WRITE(IOIMP,5001) (KZA(I),I=1,NKZA) WRITE(IOIMP,*) 'NUIA(1..',NKZA,',2)' WRITE(IOIMP,5001) (NUIA(I,1),I=1,NKZA) WRITE(IOIMP,5001) (NUIA(I,2),I=1,NKZA) NPT=NUAN(/1) WRITE(IOIMP,*) 'NUAN(1..',NPT,')' WRITE(IOIMP,5001) (NUAN(I),I=1,NPT) WRITE(IOIMP,*) 'NUNA(1..',NPT,')' WRITE(IOIMP,5001) (NUNA(I),I=1,NPT) NBLK=IDESCL(/1) WRITE(IOIMP,*) 'IDESCL(1..',NBLK,')' WRITE(IOIMP,5001) (IDESCL(I),I=1,NBLK) WRITE(IOIMP,*) 'IDESCU(1..',NBLK,')' WRITE(IOIMP,5001) (IDESCU(I),I=1,NBLK) WRITE(IOIMP,*) 'NLDBLK(1..',NBLK+1,')' WRITE(IOIMP,5001) (NLDBLK(I),I=1,NBLK+1) SEGDES IDMAT ENDIF 5 CONTINUE ENDIF ENDIF IF (IMAETA.NE.1) SEGDES MATRIK * * Normal termination * RETURN * * Format handling * 1901 FORMAT ( ' OBJET DE TYPE MATRIK '/ & ' -------------------- ') 1902 FORMAT (8(1X,1PE11.2)) * Chapeau MATRIK 1000 FORMAT (2X,A,I1,A,I1,A) 1001 FORMAT (4X,A,I1,A,I6,2A) 1002 FORMAT (4X,A,I6,1X,A,4X,A,I6,1X,A,4X,A,I6,1X,A) 1003 FORMAT (4X,A,I6,4X,A,I6,4X,A,I6) 1004 FORMAT (4X,A,I6,4X,A,I6) 1005 FORMAT (4X,A,I6) 1006 FORMAT (A,I1,A,8(1X,I6)) 1007 FORMAT (4X,A,I1,2X,A) 1996 FORMAT (2X,A,I1,A,A) 1997 FORMAT (4X,A) 1998 FORMAT (2X,A) 1999 FORMAT (A) * Segments IMATRI 2001 FORMAT (A,1X,I6) 2002 FORMAT (A,I1,A) * Segments MINC 3000 FORMAT ('Segment MINC de pointeur',1X,I6,1X,'(',A,')') * Matrices Morses 4000 FORMAT ('Matrice Morse de pointeurs',1X,I6,1X,I6,1X,'(',A,')') * Chapeau Choleski 5000 FORMAT ('Chapeau Choleski de pointeur',1X,I6,1X,'(',A,')') 5001 FORMAT (8(1X,I8)) * * Error handling * 9999 CONTINUE RETURN * * End of subroutine ECMATK * END