Télécharger la plaquette Cast3M


fr en

Télécharger ecmatk.eso

Retour à la liste

Numérotation des lignes : 

ecmatk

  1. C ECMATK    SOURCE    PV        20/09/26    21:16:33     10724          
  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.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  59.       POINTEUR IMATRK.MATRIK
  60. *
  61. * Variables pour la gestion des options de l'opérateur LIST
  62. *
  63.       INTEGER           NIVIMP
  64. *
  65.       INTEGER I,IRETOU,LENTYP,NA
  66.       INTEGER NBID,NBLK,NBTMAT,NKMT
  67.       INTEGER NKZA,NMATRI,NPT,NRIGE
  68. * Variable d'état du segment IMATRK
  69.       INTEGER IMAETA
  70. *
  71. * Tableau de correspondance (numéro                  <-> type de matrice)
  72. *                            stocké dans IRIGEL(7,.)
  73.       PARAMETER (LENTYP=30)
  74.       PARAMETER                (NBTMAT=9)
  75.       CHARACTER*(LENTYP) TYPMAT(-3:NBTMAT)
  76.  
  77. * Initialisations des tableaux
  78. *   Tableau des types de matrice
  79.       DATA TYPMAT/
  80.      $     'RECTANGULAIRE (DUAL mult.lag.)',
  81.      $     'inconnu au bataillon          ',
  82.      $     'inconnu au bataillon          ',
  83.      $     'SYMETRIQUE                    ',
  84.      $     'ANTISYMETRIQUE                ',
  85.      $     'NON SYMETRIQUE                ',
  86.      $     'RECTANGULAIRE                 ',
  87.      $     'CCt           (DUAL mult.lag.)',
  88.      $     'DIAGONALE                     ',
  89.      $     'MORSE                         ',
  90.      $     'SYMETRIQUE apres assemblage   ',
  91.      $     'NON SYMETRIQUE apres assem.   ',
  92.      $     'MATRICE DE ROTATION           '/
  93.  
  94. *   Tableau message d'erreur
  95.       MOTERR(1:40)='                                        '
  96. * Lecture des options :
  97. * On précise un niveau d'impression.
  98. * Par défaut : 1
  99. *
  100.       CALL LIRENT(NIVIMP,0,IRETOU)
  101.       IF (IRETOU.EQ.0) THEN
  102.          NIVIMP=1
  103.       ELSEIF ((NIVIMP.LT.0).OR.(NIVIMP.GT.9)) THEN
  104. *          %m1:40
  105. *          Données incompatibles
  106.          MOTERR(1:6)='NIVIMP'
  107.          CALL ERREUR(-301)
  108.          CALL ERREUR(21)
  109.          GOTO 9999
  110.       ENDIF
  111. * Début
  112.       MATRIK=IMATRK
  113.       CALL OOOETA(MATRIK,IMAETA,IMOD)
  114.       IF (IMAETA.NE.1) SEGACT MATRIK
  115.       WRITE(IOIMP,2001) 'Segment MATRIK de pointeur ',MATRIK
  116. *
  117. * Affichage du chapeau
  118. *
  119.       IF (NIVIMP.GT.0) THEN
  120.          NRIGE =IRIGEL(/1)
  121.          NMATRI=IRIGEL(/2)
  122.          WRITE(IOIMP,1999) 'Rigidités élémentaires :'
  123.          WRITE(IOIMP,1000) 'Tableau IRIGEL (',NRIGE,',',NMATRI,')'
  124.          DO 2 I=1,NMATRI
  125.             WRITE(IOIMP,1001) 'IRIGEL(1,',I,')=',IRIGEL(1,I),
  126.      $           ' (Pointeur MELEME primal)'
  127.             WRITE(IOIMP,1001) 'IRIGEL(2,',I,')=',IRIGEL(2,I),
  128.      $           ' (Pointeur MELEME dual)'
  129.             WRITE(IOIMP,1001) 'IRIGEL(4,',I,')=',IRIGEL(4,I),
  130.      $           ' (Pointeur IMATRI)'
  131.             WRITE(IOIMP,1001) 'IRIGEL(5,',I,')=',IRIGEL(5,I),
  132.      $           ' (Non utilisé)'
  133.             WRITE(IOIMP,1001) 'IRIGEL(6,',I,')=',IRIGEL(6,I),
  134.      $           ' (Non utilisé)'
  135.             WRITE(IOIMP,1001) 'IRIGEL(7,',I,')=',IRIGEL(7,I),
  136.      $           ' : matrice ',TYPMAT(IRIGEL(7,I))
  137.             WRITE(IOIMP,1998) '---'
  138.  2       CONTINUE
  139.          WRITE(IOIMP,1999) ' '
  140.          WRITE(IOIMP,1999) 'Matrice assemblée :'
  141.          WRITE(IOIMP,1996) 'KSYM=',KSYM,' : matrice ',TYPMAT(KSYM)
  142.          WRITE(IOIMP,1998) 'Pointeurs MINC (répartition des inconnues)'
  143.          WRITE(IOIMP,1002) 'KMINC =',KMINC,'(total)',
  144.      $        'KMINCP=',KMINCP,'(primal)',
  145.      $        'KMINCD=',KMINCD,'(dual)'
  146.          WRITE(IOIMP,1998) 'Pointeurs MELEME (SPG assemblés)'
  147.          WRITE(IOIMP,1003) 'KISPGT=',KISPGT,
  148.      $        'KISPGP=',KISPGP,
  149.      $        'KISPGD=',KISPGD
  150.          IF (NIVIMP.GT.4.AND.KISPGT.NE.0) THEN
  151.             MELEME=KISPGT
  152.             WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  153.             WRITE(IOIMP,*) 'pointé par KISPGT'
  154.             CALL ECROBJ('MAILLAGE',MELEME)
  155.             CALL PRLIST
  156.          ENDIF
  157.          WRITE(IOIMP,1998) 'Nombre d''inconnues total'
  158.          WRITE(IOIMP,1003) 'KNTTT =',KNTTT,
  159.      $        'KNTTP =',KNTTP,
  160.      $        'KNTTD =',KNTTD
  161.          WRITE(IOIMP,1998) 'Pointeur MELEME (connectivités globales)'
  162.          WRITE(IOIMP,1005) 'KIZM  =',KIZM
  163.          WRITE(IOIMP,1999) ' '
  164.          WRITE(IOIMP,1999) 'Tableau KIDMAT(9) (stockage Choleski) :'
  165.          WRITE(IOIMP,1998) 'Pointeur IDMAT'
  166.          WRITE(IOIMP,1004) '(1)  IDMATP=',KIDMAT(1),
  167.      $        '(2)  IDMATD=',KIDMAT(2)
  168.          WRITE(IOIMP,1998) 'Pointeur IZA (second membre)'
  169.          WRITE(IOIMP,1005) '(3)  KS2B  =',KIDMAT(3)
  170.          WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée)'
  171.          WRITE(IOIMP,1004) '(4)  KMORS =',KIDMAT(4),
  172.      $        '(5)  KISA  =',KIDMAT(5)
  173.          WRITE(IOIMP,1998) 'Pointeurs PMORS,IZA (matrice assemblée AAt)'
  174.          WRITE(IOIMP,1004) '(6)  KMRST =',KIDMAT(6),
  175.      $        '(7)  KIST  =',KIDMAT(7)
  176.          WRITE(IOIMP,1998) 'Pointeur MCHPOI (conditions aux limites)'
  177.          WRITE(IOIMP,1005) '(8)  KCLIM =',KIDMAT(8)
  178.          WRITE(IOIMP,1007) '(9)  KTRING=',KIDMAT(9),'(0=non triangulée)'
  179.          NKMT=KKMMT(/1)
  180.          WRITE(IOIMP,1999) ' '
  181.          WRITE(IOIMP,1006) 'Tableau KKMMT(',NKMT,')',(KKMMT(I),I=1,NKMT)
  182.          WRITE(IOIMP,1999) 'END Segment MATRIK'
  183.          WRITE(IOIMP,1999) ' '
  184.       ENDIF
  185. *
  186. * Affichage des segments pointés par MATRIK
  187. *
  188.       IF (NIVIMP.GT.1) THEN
  189. * Affichage des IMATRI
  190.          DO 3 I=1,NMATRI
  191.             IF (NIVIMP.GT.4) THEN
  192.                MELEME=IRIGEL(1,I)
  193.                WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  194.                WRITE(IOIMP,2002) 'pointé par IRIGEL(1,',I,')'
  195.                CALL ECROBJ('MAILLAGE',MELEME)
  196.                CALL PRLIST
  197.                MELEME=IRIGEL(2,I)
  198.                WRITE(IOIMP,2001) 'Segment MELEME de pointeur',MELEME
  199.                WRITE(IOIMP,2002) 'pointé par IRIGEL(2,',I,')'
  200.                CALL ECROBJ('MAILLAGE',MELEME)
  201.                CALL PRLIST
  202.             ENDIF
  203.             IMATRI=IRIGEL(4,I)
  204.             WRITE(IOIMP,2001) 'Segment IMATRI de pointeur',IMATRI
  205.             WRITE(IOIMP,2002) 'pointé par IRIGEL(4,',I,')'
  206.             IF (IMATRI.NE.0) THEN
  207.                CALL ECIMAT(IMATRI,NIVIMP)
  208.             ENDIF
  209.             WRITE(IOIMP,1999) 'End segment IMATRI'
  210.             WRITE(IOIMP,1999) ' '
  211.  3       CONTINUE
  212. * Affichage des MINC
  213.          IF (KMINC.NE.0) THEN
  214.             WRITE(IOIMP,3000) KMINC,'Total'
  215.             MINC=KMINC
  216.             CALL ECMINC(MINC,NIVIMP)
  217.             WRITE(IOIMP,1999) 'End segment MINC'
  218.             WRITE(IOIMP,1999) ' '
  219.          ENDIF
  220.          IF ((KMINCP.NE.0).AND.(KMINCP.NE.KMINC)) THEN
  221.             WRITE(IOIMP,3000) KMINCP,'Primal'
  222.             MINC=KMINCP
  223.             CALL ECMINC(MINC,NIVIMP)
  224.             WRITE(IOIMP,1999) 'End segment MINC'
  225.             WRITE(IOIMP,1999) ' '
  226.          ENDIF
  227.          IF ((KMINCD.NE.0).AND.(KMINCD.NE.KMINC).AND.(KMINCD.NE.KMINCP))
  228.      $        THEN
  229.             WRITE(IOIMP,3000) KMINCD,'Dual'
  230.             MINC=KMINCD
  231.             CALL ECMINC(MINC,NIVIMP)
  232.             WRITE(IOIMP,1999) 'End segment MINC'
  233.             WRITE(IOIMP,1999) ' '
  234.          ENDIF
  235. * Affichage des matrices stockées en MORSE
  236.          PMORS=KIDMAT(4)
  237.          IZA=KIDMAT(5)
  238.          IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN
  239.             WRITE(IOIMP,4000) PMORS,IZA,'assemblée'
  240.             CALL ECMORS(PMORS,IZA,NIVIMP)
  241.             WRITE(IOIMP,1999) 'End Matrice Morse'
  242.             WRITE(IOIMP,1999) ' '
  243.          ENDIF
  244.          PMORS=KIDMAT(6)
  245.          IZA=KIDMAT(7)
  246.          IF ((PMORS.NE.0).AND.(IZA.NE.0)) THEN
  247.             WRITE(IOIMP,4000) PMORS,IZA,'assemblée AAt'
  248.             CALL ECMORS(PMORS,IZA,NIVIMP)
  249.             WRITE(IOIMP,1999) 'End Matrice Morse'
  250.             WRITE(IOIMP,1999) ' '
  251.          ENDIF
  252. * Affichage du segment stockage bloc Choleski
  253.          IF (NIVIMP.GT.3) THEN
  254.             DO 5 NBID=1,2
  255.                IDMAT=KIDMAT(NBID)
  256.                IF (IDMAT.NE.0) THEN
  257.                   SEGACT IDMAT
  258.                   IF (NBID.EQ.1) WRITE(IOIMP,5000) IDMAT,'primal'
  259.                   IF (NBID.EQ.2) WRITE(IOIMP,5000) IDMAT,'dual'
  260.                   WRITE(IOIMP,*) 'IDIAG=',IDIAG
  261.                   IF (IDIAG.NE.0) THEN
  262.                      IZA=IDIAG
  263.                      SEGACT IZA
  264.                      NA=A(/1)
  265.                      WRITE(IOIMP,1902) (A(I),I=1,NA)
  266.                      SEGDES IZA
  267.                   ENDIF
  268.                   NKZA=KZA(/1)
  269.                   WRITE(IOIMP,*) 'KZA(1..',NKZA,')'
  270.                   WRITE(IOIMP,5001) (KZA(I),I=1,NKZA)
  271.                   WRITE(IOIMP,*) 'NUIA(1..',NKZA,',2)'
  272.                   WRITE(IOIMP,5001) (NUIA(I,1),I=1,NKZA)
  273.                   WRITE(IOIMP,5001) (NUIA(I,2),I=1,NKZA)
  274.                   NPT=NUAN(/1)
  275.                   WRITE(IOIMP,*) 'NUAN(1..',NPT,')'
  276.                   WRITE(IOIMP,5001) (NUAN(I),I=1,NPT)
  277.                   WRITE(IOIMP,*) 'NUNA(1..',NPT,')'
  278.                   WRITE(IOIMP,5001) (NUNA(I),I=1,NPT)
  279.                   NBLK=IDESCL(/1)
  280.                   WRITE(IOIMP,*) 'IDESCL(1..',NBLK,')'
  281.                   WRITE(IOIMP,5001) (IDESCL(I),I=1,NBLK)
  282.                   WRITE(IOIMP,*) 'IDESCU(1..',NBLK,')'
  283.                   WRITE(IOIMP,5001) (IDESCU(I),I=1,NBLK)
  284.                   WRITE(IOIMP,*) 'NLDBLK(1..',NBLK+1,')'
  285.                   WRITE(IOIMP,5001) (NLDBLK(I),I=1,NBLK+1)
  286.                   SEGDES IDMAT
  287.                ENDIF
  288.  5          CONTINUE
  289.          ENDIF
  290.       ENDIF
  291.       IF (IMAETA.NE.1) SEGDES MATRIK
  292. *
  293. * Normal termination
  294. *
  295.       RETURN
  296. *
  297. * Format handling
  298. *
  299.  1901 FORMAT ( '  OBJET DE TYPE MATRIK '/
  300.      &     '  -------------------- ')
  301.  1902 FORMAT (8(1X,1PE11.2))
  302. * Chapeau MATRIK
  303.  1000 FORMAT (2X,A,I1,A,I1,A)
  304.  1001 FORMAT (4X,A,I1,A,I6,2A)
  305.  1002 FORMAT (4X,A,I6,1X,A,4X,A,I6,1X,A,4X,A,I6,1X,A)
  306.  1003 FORMAT (4X,A,I6,4X,A,I6,4X,A,I6)
  307.  1004 FORMAT (4X,A,I6,4X,A,I6)
  308.  1005 FORMAT (4X,A,I6)
  309.  1006 FORMAT (A,I1,A,8(1X,I6))
  310.  1007 FORMAT (4X,A,I1,2X,A)
  311.  1996 FORMAT (2X,A,I1,A,A)
  312.  1997 FORMAT (4X,A)
  313.  1998 FORMAT (2X,A)
  314.  1999 FORMAT (A)
  315. * Segments IMATRI
  316.  2001 FORMAT (A,1X,I6)
  317.  2002 FORMAT (A,I1,A)
  318. * Segments MINC
  319.  3000 FORMAT ('Segment MINC de pointeur',1X,I6,1X,'(',A,')')
  320. * Matrices Morses
  321.  4000 FORMAT ('Matrice Morse de pointeurs',1X,I6,1X,I6,1X,'(',A,')')
  322. * Chapeau Choleski
  323.  5000 FORMAT ('Chapeau Choleski de pointeur',1X,I6,1X,'(',A,')')
  324.  5001 FORMAT (8(1X,I8))
  325. *
  326. * Error handling
  327. *
  328.  9999 CONTINUE
  329.       RETURN
  330. *
  331. * End of subroutine ECMATK
  332. *
  333.       END
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales