Télécharger la plaquette Cast3M


fr en

Télécharger prqrf.eso

Retour à la liste

Numérotation des lignes : 

prqrf

  1. C PRQRF     SOURCE    GOUNAND   21/06/02    21:17:35     11022          
  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.  
  33. -INC PPARAM
  34. -INC CCOPTIO
  35. -INC CCGEOME
  36. -INC TNLIN      
  37. *-INC SIQUAF
  38.       POINTEUR QRF.IQUAF
  39.       INTEGER NDIMQR,NBNOQR
  40. *
  41.       INTEGER IMPR,IRET
  42. *
  43.       INTEGER IDIMQR,IBNOQR
  44.       INTEGER NUMER
  45.       INTEGER QRFETA
  46. *
  47. * Executable statements
  48. *
  49.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prqrf'
  50. *
  51.       CALL OOOETA(QRF,QRFETA,IMOD)
  52.       IF (QRFETA.NE.1) SEGACT QRF
  53.       WRITE(IOIMP,*) 'Segment IQUAF de pointeur',QRF
  54.       NUMER=QRF.NUMQUF
  55.       WRITE(IOIMP,*) 'Nom : ',NOMS(NUMER)
  56.       WRITE(IOIMP,*) 'Coordonnées des noeuds du QUAF:'
  57.       NDIMQR=QRF.XCONQR(/1)
  58.       NBNOQR=QRF.XCONQR(/2)
  59.       DO 1 IBNOQR=1,NBNOQR
  60.          WRITE(IOIMP,4005)
  61.      $        IBNOQR,(QRF.XCONQR(IDIMQR,IBNOQR),IDIMQR=1,NDIMQR)
  62.  1    CONTINUE
  63.       WRITE(IOIMP,*) 'Numéro du centre : ',QRF.NUCENT
  64.       WRITE(IOIMP,*) 'Maillage des faces : '
  65.       MYMEL=QRF.LFACE
  66.       IF (MYMEL.NE.0) THEN
  67.          CALL ECROBJ('MAILLAGE',MYMEL)
  68.          CALL PRLIST
  69.       ELSE
  70.          WRITE(IOIMP,*) 'Pas de maillage des faces'
  71.       ENDIF
  72.       IF (QRFETA.NE.1) SEGDES QRF
  73. *
  74. * Normal termination
  75. *
  76.       IRET=0
  77.       RETURN
  78. *
  79. * Format handling
  80. *
  81.  4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  82. *
  83. * Error handling
  84. *
  85.  9999 CONTINUE
  86.       IRET=1
  87.       WRITE(IOIMP,*) 'An error was detected in subroutine prqrf'
  88.       RETURN
  89. *
  90. * End of subroutine PRQRF
  91. *
  92.       END
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales