Esope source files

   1 : C PRCHVA    SOURCE    GOUNAND   05/12/21    21:34:58     5281           
   2 :       SUBROUTINE PRCHVA(MYCHVA,
   3 :      $     IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : PRCHVA 
   8 : C PROJET      : Noyau linéaire NLIN
   9 : C DESCRIPTION : Imprime un segment contenant les valeurs d'un champ par
  10 : C               élément élémentaire (un seul type d'élément)
  11 : C LANGAGE     : ESOPE
  12 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13 : C               mél : gounand@semt2.smts.cea.fr
  14 : C***********************************************************************
  15 : C APPELES          : OOOETA (état d'un segment)
  16 : C APPELE PAR       : PRCAEL, GEOLIN
  17 : C***********************************************************************
  18 : C ENTREES            : * MYCHVA (type MCHEVA) :  le champ par éléments 
  19 : C                        élémentaire à imprimer.
  20 : C ENTREES/SORTIES    : -
  21 : C SORTIES            : -
  22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23 : C***********************************************************************
  24 : C VERSION    : v1, 12/08/99, version initiale
  25 : C HISTORIQUE : v1, 12/08/99, création
  26 : C HISTORIQUE :
  27 : C HISTORIQUE :
  28 : C***********************************************************************
  29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30 : C en cas de modification de ce sous-programme afin de faciliter
  31 : C la maintenance !
  32 : C***********************************************************************
  33 : -INC CCOPTIO
  34 : CBEGININCLUDE SMCHAEL
  35 :       SEGMENT MCHAEL
  36 :       POINTEUR IMACHE(N1).MELEME
  37 :       POINTEUR ICHEVA(N1).MCHEVA
  38 :       ENDSEGMENT
  39 :       SEGMENT MCHEVA
  40 :       REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41 :       ENDSEGMENT
  42 :       SEGMENT LCHEVA
  43 :       POINTEUR LISCHE(NBCHE).MCHEVA
  44 :       ENDSEGMENT
  45 : CENDINCLUDE SMCHAEL
  46 :       POINTEUR MYCHVA.MCHEVA
  47 : *
  48 :       INTEGER IMPR,IRET
  49 : *
  50 :       INTEGER MCVETA
  51 :       INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM
  52 :       INTEGER ILIG,ICOL,I2LIG,I2COL,IPOI,IELEM
  53 : *     
  54 : * Executable statements
  55 : *
  56 : * On veut laisser MYCHVA dans le même état (actif, inactif) qu'avant
  57 : * l'appel à PRCHVA.
  57 :       CALL OOOETA(MYCHVA,MCVETA)
  58 :       IF (MCVETA.NE.1) SEGACT MYCHVA
  59 :       WRITE(IOIMP,*) 'Segment MCHEVA de pointeur',MYCHVA
  60 :       IF (IMPR.GT.1) THEN 
  61 :          NBELM=MYCHVA.VELCHE(/6)
  62 :          NBPOI=MYCHVA.VELCHE(/5)
  63 :          N2COL=MYCHVA.VELCHE(/4)
  64 :          N2LIG=MYCHVA.VELCHE(/3)
  65 :          NBCOL=MYCHVA.VELCHE(/2)
  66 :          NBLIG=MYCHVA.VELCHE(/1)
  67 :          WRITE(IOIMP,*) 'Nombre d''éléments, points, ',
  68 :      $        'comp. colonnes, comp. lignes, colonnes, lignes :',
  69 :      $        NBELM,NBPOI,N2COL,N2LIG,NBCOL,NBLIG
  70 :          IF (IMPR.GT.3) THEN
  71 :             WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  72 :             DO 3 IELEM=1,NBELM
  73 :                DO 32 IPOI=1,NBPOI
  74 :                   DO 322 I2LIG=1,N2LIG
  75 :                      DO 3222 I2COL=1,N2COL
  76 :                         WRITE (IOIMP,*) 
  77 :      $                       'Elément',IELEM,' Point',IPOI,
  78 :      $                       'Comp. lig.',I2LIG,'Comp. col',I2COL
  79 :                         DO 32222 ILIG=1,NBLIG
  80 :                            WRITE(IOIMP,4002) 
  81 :      $                          ILIG,
  82 :      $                          (MYCHVA.VELCHE(ILIG,ICOL,I2LIG,I2COL,
  83 :      $                          IPOI,IELEM),
  84 :      $                          ICOL=1,NBCOL)
  85 : 32222                   CONTINUE
  86 :  3222                CONTINUE
  87 :  322              CONTINUE
  88 :  32            CONTINUE
  89 :  3          CONTINUE
  90 :          ENDIF
  91 :       ENDIF
  92 :       IF (MCVETA.NE.1) SEGDES MYCHVA
  93 : *
  94 : * Normal termination
  95 : *
  96 :       IRET=0
  97 :       RETURN
  98 : *
  99 : * Format handling
 100 : *
 101 :  4000 FORMAT (2X,'Ligne   :',6(1X,A8))
 102 :  4001 FORMAT (2X,'Colonne :',6(1X,A8))
 103 :  4002 FORMAT (2X,'Ligne ',I6,' :',4(1X,1PE16.8))
 104 : *
 105 : * Error handling
 106 : *
 107 :  9999 CONTINUE
 108 :       IRET=1
 109 :       WRITE(IOIMP,*) 'An error was detected in subroutine prchva'
 110 :       RETURN
 111 : *
 112 : * End of subroutine prchva
 113 : *
 114 :       END
 115 : 
 116 :