Download prcael.eso

Back to the list

   1 : C PRCAEL    SOURCE    GOUNAND   05/12/21    21:34:54     5281           
   2 :       SUBROUTINE PRCAEL(MYCAEL,
   3 :      $     IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : PRCAEL 
   8 : C PROJET      : Noyau linéaire NLIN
   9 : C DESCRIPTION : Imprime un champ par élément (type MCHAEL)
  10 : C LANGAGE     : ESOPE
  11 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  12 : C               mél : gounand@semt2.smts.cea.fr
  13 : C***********************************************************************
  14 : C APPELES          : OOOETA (état d'un segment)
  15 : C                    PRCHVA (impression d'un segment MCHEVA)
  16 : C APPELES (E/S)    : ECROBJ, PRLIST (écriture, impression)
  17 : C APPELE PAR       : MKCOOR
  18 : C***********************************************************************
  19 : C ENTREES            : * MYCAEL (type MCHAEL) : le champ par éléments à
  20 : C                        imprimer.
  21 : C SORTIES            : -
  22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23 : C***********************************************************************
  24 : C VERSION    : v1, 03/09/99, version initiale
  25 : C HISTORIQUE : v1, 03/09/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 MYCAEL.MCHAEL
  47 :       POINTEUR MYCHVA.MCHEVA
  48 : -INC SMELEME
  49 :       POINTEUR MYMACH.MELEME
  50 : *
  51 :       INTEGER IMPR,IRET
  52 : *
  53 :       INTEGER ISOUS
  54 :       INTEGER NSOUS
  55 :       INTEGER MCAETA,MACETA
  56 : *     
  57 : * Executable statements
  58 : *
  59 : * On veut laisser MYCAEL dans le même état (actif, inactif) qu'avant
  60 : * l'appel à PRCAEL.
  60 :       CALL OOOETA(MYCAEL,MCAETA)
  61 :       IF (MCAETA.NE.1) SEGACT MYCAEL
  62 :       WRITE(IOIMP,*) 'Segment MCHAEL de pointeur',MYCAEL
  63 :       IF (IMPR.GT.1) THEN 
  64 :          NSOUS=MYCAEL.ICHEVA(/1)
  65 :          WRITE(IOIMP,*) 'Nombre de partitions :',NSOUS
  66 :          IF (IMPR.GT.2) THEN
  67 :             DO 1 ISOUS=1,NSOUS
  68 :                MYMACH=MYCAEL.IMACHE(ISOUS)
  69 :                MYCHVA=MYCAEL.ICHEVA(ISOUS)
  70 :                WRITE(IOIMP,*) 'Sous-champ ',ISOUS,' : supp. géo. ',
  71 :      $              MYMACH,' MCHEVA=',MYCHVA
  72 :                IF (IMPR.GT.3) THEN
  73 :                   IF (IMPR.GT.5) THEN
  74 :                      IF (MYMACH.NE.0) THEN
  74 :                         CALL OOOETA(MYMACH,MACETA)
  75 :                         WRITE(IOIMP,*) 'Support géométrique'
  75 :                         CALL ECROBJ('MAILLAGE',MYMACH)
  75 :                         CALL PRLIST
  76 :                         IF (MACETA.NE.1) THEN
  77 :                            SEGDES MYMACH
  78 :                         ELSE 
  79 :                            SEGACT MYMACH
  80 :                         ENDIF
  81 :                      ENDIF
  82 :                   ENDIF
  83 :                   WRITE(IOIMP,*) 'Valeurs du champ par éléments'
  83 :                   CALL PRCHVA(MYCHVA,IMPR,IRET)
  84 :                   IF (IRET.NE.0) GOTO 9999
  85 :                ENDIF
  86 :  1          CONTINUE
  87 :          ENDIF
  88 :       ENDIF
  89 :       IF (MCAETA.NE.1) SEGDES MYCAEL
  90 : *
  91 : * Normal termination
  92 : *
  93 :       IRET=0
  94 :       RETURN
  95 : *
  96 : * Format handling
  97 : *
  98 : *
  99 : * Error handling
 100 : *
 101 :  9999 CONTINUE
 102 :       IRET=1
 103 :       WRITE(IOIMP,*) 'An error was detected in subroutine prcael'
 104 :       RETURN
 105 : *
 106 : * End of subroutine prcael
 107 : *
 108 :       END
 109 : 
 110 :  

© Cast3M 2003 - All rights reserved.
Disclaimer