Esope source files

   1 : C ECIMAT    SOURCE    MAGN      09/07/30    21:16:42     6458           
   2 :       SUBROUTINE ECIMAT(IMATRI,NIVIMP)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C***********************************************************************
   6 : C NOM         : ECIMAT
   7 : C DESCRIPTION : Impression d'un segment de type IMATRI.
   8 : C               Ce segment contient des groupes de 
   9 : C               matrices élémentaires non assemblées.
  10 : C               cf. include SMMATRIK
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C APPELES : -
  17 : C***********************************************************************
  18 : C ENTREES            : IMATRI, NIVIMP
  19 : C ENTREES/SORTIES    : -
  20 : C SORTIES            : -
  21 : C CODE RETOUR (IRET) : -
  22 : C    IMATRI : segment de type IMATRI (include SMMATRIK)
  23 : C    NIVIMP : niveau d'impression. Suivant sa valeur, on obtient :
  24 : C  Convention (probablement non totalement respectée) :
  25 : C  ----------   0 : presque rien (numéro de pointeur)
  26 : C               1 : affichage du chapeau IMATRI
  27 : C               2 : affichage des données concernant les objets
  28 : C                   pointés par IMATRI (s'il y en a)
  29 : C               3 : affichage du contenu des objets vectoriels
  30 : C               4 : affichage du contenu des objets matriciels
  31 : C On ne change pas l'état (actif ou inactif) du segment IMATRI.
  32 : C***********************************************************************
  33 : C VERSION    : v1, 01/04/98, version initiale
  34 : C HISTORIQUE : v1, 01/04/98, création
  35 : C HISTORIQUE : 29/10/98, modif. l'état du segment reste inchangé
  36 : C                        en sortie
  37 : C HISTORIQUE :
  38 : C***********************************************************************
  39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40 : C en cas de modification de ce sous-programme afin de faciliter
  41 : C la maintenance !
  42 : C***********************************************************************
  43 : -INC CCOPTIO
  44 : -INC SMMATRIK
  45 : * Variable d'état du segment IMATRK
  46 :       INTEGER IMAETA
  47 : *
  48 : * Executable statements
  49 : *
  50 :       IF (IMATRI.EQ.0) THEN
  51 :          WRITE(IOIMP,*) 'Nil pointer transmitted to ecimat'
  52 :          GOTO 9999
  53 :       ENDIF
  53 :       CALL OOOETA(IMATRI,IMAETA)
  54 :       IF (IMAETA.NE.1) SEGACT IMATRI
  55 :       WRITE(IOIMP,2001) 'Segment IMATRI de pointeur ',IMATRI
  56 : *
  57 :       NBME=LIZAFM(/2)
  58 :       NBSOUS=LIZAFM(/1)
  59 :       WRITE(IOIMP,2003) 'NBME  =',NBME,'(nb groupe mat. élém.)'
  60 :       WRITE(IOIMP,2003) 'NBSOUS=',NBSOUS,'(nb sous-obj.)'
  61 :       WRITE(IOIMP,2004) 'KSPGP=',KSPGP,'KSPGD=',KSPGD
  62 :       WRITE(IOIMP,1999) 'Liste inconnues primales et duales'
  63 :       WRITE(IOIMP,2999)  'LISPRI(NBME)=',(LISPRI(N),N=1,NBME)
  64 :       WRITE(IOIMP,2999)  'LISDUA(NBME)=',(LISDUA(N),N=1,NBME)
  65 :       WRITE(IOIMP,1999) 'Matrices élémentaires non assemblées'
  66 :       WRITE(IOIMP,1999) 'Tableau LIZAFM(NBSOUS,NBME)'
  67 :       DO 4 J=1,NBME
  68 :          DO 5 K=1,NBSOUS
  69 :             IZAFM=LIZAFM(K,J)
  70 :             WRITE(IOIMP,2007) 'LIZAFM(',K,',',J,')=',IZAFM,
  71 :      $           'pointeur IZAFM'
  72 :             IF ((NIVIMP.GT.2).AND.(IZAFM.NE.0)) THEN
  73 : * Affichage des IZAFM
  74 :                SEGACT IZAFM
  75 :                NBEL=AM(/1)
  76 :                NP=AM(/2)
  77 :                MP=AM(/3)
  78 :                WRITE(IOIMP,2008) 'NBEL=',NBEL,'(nb élém)'
  79 :                WRITE(IOIMP,2009) 'NP  =',NP,'MP  =',MP,
  80 :      $              '(nb points)'
  81 :                DO 6 L=1,NBEL
  82 :                   WRITE(IOIMP,2010) 'Matrice pour l''élément',L
  83 :                   DO 7 N=1,NP
  84 : * Affichage des AM
  85 :                      WRITE(IOIMP,2011) (AM(L,N,M),M=1,MP)
  86 :  7                CONTINUE
  87 :  6             CONTINUE
  88 :                SEGDES IZAFM
  89 :             ENDIF
  90 :             WRITE(IOIMP,1998) 'End segment IZAFM'
  91 :             WRITE(IOIMP,1998) '---'
  92 :  5       CONTINUE
  93 :  4    CONTINUE
  94 :       IF (IMAETA.NE.1) SEGDES IMATRI
  95 : *
  96 : * Normal termination
  97 : *
  98 :       RETURN
  99 : *
 100 : * Format handling
 101 : *
 102 :  1998 FORMAT (2X,A)
 103 :  1999 FORMAT (A)
 104 :  2001 FORMAT (A,1X,I6)
 105 :  2003 FORMAT (2X,A,I2,1X,A)
 106 :  2004 FORMAT (2X,A,I6,4X,A,I6)
 107 :  2007 FORMAT (2X,A,I2,A,I2,A,I6,2X,A)
 108 :  2008 FORMAT (4X,A,I6,1X,A)
 109 :  2009 FORMAT (4X,A,I6,2X,A,I6,1X,A)
 110 :  2010 FORMAT (6X,A,1X,I6)
 111 :  2011 FORMAT (4(1X,1PE18.10))
 112 :  2999 FORMAT (2X,A,100(1X,A8))
 113 : *
 114 : * Error handling
 115 : *
 116 :  9999 CONTINUE
 117 :       WRITE(IOIMP,*) 'An error was detected in subroutine ecimat'
 118 :       RETURN
 119 : *
 120 : * End of subroutine ECIMAT
 121 : *
 122 :       END
 123 :  
 124 :  
 125 :  
 126 :