Download prqrf.eso

Back to the list

   1 : C PRQRF     SOURCE    CHAT      07/10/29    21:26:30     5940           
   2 :       SUBROUTINE PRQRF(QRF,
   3 :      $     IMPR,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : PRQRF 
   8 : C PROJET      : Noyau linéaire NLIN
   9 : C DESCRIPTION : 
  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          : 
  15 : C APPELES (E/S)    : OOOETA
  16 : C APPELE PAR       : INQRFS
  17 : C***********************************************************************
  18 : C ENTREES            : QRF
  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, 17/10/02, version initiale
  24 : C HISTORIQUE : v1, 17/10/02, création
  25 : C HISTORIQUE :
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : -INC CCGEOME
  34 : CBEGININCLUDE SIQUAF
  35 :       SEGMENT IQUAF
  36 :       INTEGER NUMQUF
  37 :       REAL*8 XCONQR(NDIMQR,NBNOQR)
  38 :       INTEGER NUCENT
  39 :       POINTEUR LFACE.MELEME
  40 :       ENDSEGMENT
  41 :       SEGMENT IQUAFS
  42 :       POINTEUR LISQRF(NBQRF).IQUAF
  43 :       ENDSEGMENT
  44 : CENDINCLUDE SIQUAF
  45 :       POINTEUR QRF.IQUAF
  46 :       INTEGER NDIMQR,NBNOQR
  47 : *
  48 :       INTEGER IMPR,IRET
  49 : *
  50 :       INTEGER IDIMQR,IBNOQR
  51 :       INTEGER NUMER
  52 :       INTEGER QRFETA
  53 : *     
  54 : * Executable statements
  55 : *
  56 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prqrf'
  57 : *
  57 :       CALL OOOETA(QRF,QRFETA)
  58 :       IF (QRFETA.NE.1) SEGACT QRF
  59 :       WRITE(IOIMP,*) 'Segment IQUAF de pointeur',QRF
  60 :       NUMER=QRF.NUMQUF
  61 :       WRITE(IOIMP,*) 'Nom : ',NOMS(NUMER)
  62 :       WRITE(IOIMP,*) 'Coordonnées des noeuds du QUAF:'
  63 :       NDIMQR=QRF.XCONQR(/1)
  64 :       NBNOQR=QRF.XCONQR(/2)
  65 :       DO 1 IBNOQR=1,NBNOQR
  66 :          WRITE(IOIMP,4005) 
  67 :      $        IBNOQR,(QRF.XCONQR(IDIMQR,IBNOQR),IDIMQR=1,NDIMQR)
  68 :  1    CONTINUE
  69 :       WRITE(IOIMP,*) 'Numéro du centre : ',QRF.NUCENT
  70 :       WRITE(IOIMP,*) 'Maillage des faces : '
  71 :       MYMEL=QRF.LFACE
  72 :       IF (MYMEL.NE.0) THEN
  72 :          CALL ECROBJ('MAILLAGE',MYMEL)
  72 :          CALL PRLIST
  73 :       ELSE
  74 :          WRITE(IOIMP,*) 'Pas de maillage des faces'
  75 :       ENDIF
  76 :       IF (QRFETA.NE.1) SEGDES QRF
  77 : *
  78 : * Normal termination
  79 : *
  80 :       IRET=0
  81 :       RETURN
  82 : *
  83 : * Format handling
  84 : *
  85 :  4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  86 : *
  87 : * Error handling
  88 : *
  89 :  9999 CONTINUE
  90 :       IRET=1
  91 :       WRITE(IOIMP,*) 'An error was detected in subroutine prqrf'
  92 :       RETURN
  93 : *
  94 : * End of subroutine PRQRF
  95 : *
  96 :       END
  97 : 
  98 :  
  99 :  
 100 :  

© Cast3M 2003 - All rights reserved.
Disclaimer