Esope source files

   1 : C PRLRF     SOURCE    GOUNAND   05/12/21    21:35:38     5281           
   2 :       SUBROUTINE PRLRF(LRF,
   3 :      $     IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : PRLRF 
   8 : C PROJET      : Noyau linéaire NLIN
   9 : C DESCRIPTION : Imprime un segment décrivant un élément de référence.
  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          : PRBPOL
  15 : C APPELES (E/S)    : OOOETA
  16 : C APPELE PAR       : INLRFS
  17 : C***********************************************************************
  18 : C ENTREES            : LRF
  19 : C ENTREES/SORTIES    : -
  20 : C SORTIES            : -
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 20/07/99, version initiale
  24 : C HISTORIQUE : v1, 20/07/99, création
  25 : C HISTORIQUE : v2, 10/05/00, modif. du segment ELREF
  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 SELREF
  35 :       SEGMENT ELREF
  36 :       CHARACTER*(LNNOM)  NOMLRF
  37 :       CHARACTER*(LNFORM) FORME 
  38 :       CHARACTER*(LNTYPL) TYPEL 
  39 :       CHARACTER*(LNESP)  ESPACE
  40 :       INTEGER DEGRE
  41 :       REAL*8 XCONOD(NDIMEL,NBNOD)
  42 :       INTEGER NPQUAF(NBDDL)
  43 :       INTEGER NUMCMP(NBDDL)
  44 :       INTEGER QUENOD(NBDDL)
  45 :       INTEGER ORDDER(NDIMEL,NBDDL)
  46 :       POINTEUR MBPOLY.POLYNS
  47 :       ENDSEGMENT
  48 :       SEGMENT ELREFS
  49 :       POINTEUR LISEL(0).ELREF
  50 :       ENDSEGMENT
  51 : CENDINCLUDE SELREF
  52 :       POINTEUR LRF.ELREF
  53 : CBEGININCLUDE SPOLYNO
  54 :       SEGMENT POLYNO
  55 :       REAL*8  COEMON(NBMON)
  56 :       INTEGER EXPMON(NDIML,NBMON)
  57 :       ENDSEGMENT 
  58 :       SEGMENT POLYNS
  59 :       POINTEUR LIPOLY(NBPOLY).POLYNO
  60 :       ENDSEGMENT
  61 : CENDINCLUDE SPOLYNO
  62 :       POINTEUR MYBPOL.POLYNS
  63 : *
  64 :       INTEGER IMPR,IRET
  65 : *
  66 :       INTEGER LRFETA
  67 :       INTEGER INDIM,INBNO,IDDL
  68 :       INTEGER IINBNO,IND,IIDDL
  69 : *     
  70 : * Executable statements
  71 : *
  71 :       CALL OOOETA(LRF,LRFETA)
  72 :       IF (LRFETA.NE.1) SEGACT LRF
  73 :       WRITE(IOIMP,*) 'Segment ELREF de pointeur',LRF
  74 :       IF (IMPR.GT.1) THEN 
  75 :          WRITE(IOIMP,*) 'Nom : ',LRF.NOMLRF
  76 :          IF (IMPR.GT.2) THEN 
  77 :             WRITE(IOIMP,*) 'Forme                : ',LRF.FORME
  78 :             WRITE(IOIMP,*) 'Type d''élément       : ',LRF.TYPEL
  79 :             WRITE(IOIMP,*) 'Esp. discr. inconnue : ',LRF.ESPACE
  80 :             INDIM=LRF.XCONOD(/1)
  81 :             INBNO=LRF.XCONOD(/2)
  82 :             WRITE(IOIMP,*) 'Dim. esp. référence  : ',INDIM
  83 :             WRITE(IOIMP,*) 'Nb. noeuds approx.   : ',INBNO
  84 :             IF (IMPR.GT.3) THEN
  85 :                WRITE(IOIMP,*) 'Coordonnées des noeuds d''approximation:'
  86 :                DO 1 IINBNO=1,INBNO
  87 :                   WRITE(IOIMP,4005) 
  88 :      $                 IINBNO,(LRF.XCONOD(IND,IINBNO),IND=1,INDIM)
  89 :  1             CONTINUE
  90 :             ENDIF
  91 :             WRITE(IOIMP,*) 'Degré de l''approx.   : ',LRF.DEGRE
  92 :             IDDL=LRF.NPQUAF(/1)
  93 :             WRITE(IOIMP,*) 'Nb.degrés de liberté : ',IDDL
  94 :             IF (IMPR.GT.3) THEN
  95 :                WRITE(IOIMP,*) 'Pour chaque ddl, num. noeud du QUAF<=>',
  96 :      $              'forme ET num. comp. dans les champs : '
  97 :                WRITE(IOIMP,4006) 
  98 :      $              (LRF.NPQUAF(IIDDL),IIDDL=1,IDDL)
  99 :                WRITE(IOIMP,4007) 
 100 :      $              (LRF.NUMCMP(IIDDL),IIDDL=1,IDDL)
 101 :                WRITE(IOIMP,*) 'On ne liste pas QUENOD et ORDDER'
 102 :                MYBPOL=LRF.MBPOLY
 103 :                IF (MYBPOL.EQ.0) THEN
 104 :                   WRITE(IOIMP,*) 'Pas de base polynomiale' 
 105 :                ELSE
 105 :                   CALL PRBPOL(MYBPOL,IMPR,IRET)
 106 :                   IF (IRET.NE.0) GOTO 9999
 107 :                ENDIF
 108 :             ENDIF
 109 :          ENDIF
 110 :       ENDIF
 111 : *!      WRITE(IOIMP,4004) LRF.NOMLRF,LRF.FORME,LRF.ESPACE,LRF.DEGRE,
 112 : *!     $     LRF.NPQUAF(/1)
 113 :       IF (LRFETA.NE.1) SEGDES LRF
 114 : *
 115 : * Normal termination
 116 : *
 117 :       IRET=0
 118 :       RETURN
 119 : *
 120 : * Format handling
 121 : *
 122 :  4004 FORMAT (A10,' ',A20,' ',A5,' ',I5,' ',I5)
 123 :  4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
 124 :  4006 FORMAT (2X,'Num.noeud :',9(1X,I6))
 125 :  4007 FORMAT (2X,'Num.comp  :',9(1X,I6))
 126 : *
 127 : * Error handling
 128 : *
 129 :  9999 CONTINUE
 130 :       IRET=1
 131 :       WRITE(IOIMP,*) 'An error was detected in subroutine prlrf'
 132 :       RETURN
 133 : *
 134 : * End of subroutine prlrf
 135 : *
 136 :       END
 137 : 
 138 :  
 139 :