Télécharger la plaquette Cast3M


fr en

Télécharger prlrf.eso

Retour à la liste

Numérotation des lignes : 

prlrf

  1. C PRLRF     SOURCE    GOUNAND   21/06/02    21:17:29     11022          
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC TNLIN      
  37. *-INC SELREF
  38.       POINTEUR LRF.ELREF
  39. *-INC SPOLYNO
  40.       POINTEUR MYBPOL.POLYNS
  41. *
  42.       INTEGER IMPR,IRET
  43. *
  44.       INTEGER LRFETA
  45.       INTEGER INDIM,INBNO,IDDL
  46.       INTEGER IINBNO,IND,IIDDL
  47. *
  48. * Executable statements
  49. *
  50.       CALL OOOETA(LRF,LRFETA,IMOD)
  51.       IF (LRFETA.NE.1) SEGACT LRF
  52.       WRITE(IOIMP,*) 'Segment ELREF de pointeur',LRF
  53.       IF (IMPR.GT.1) THEN
  54.          WRITE(IOIMP,*) 'Nom : ',LRF.NOMLRF
  55.          IF (IMPR.GT.2) THEN
  56.             WRITE(IOIMP,*) 'Forme                : ',LRF.FORME
  57.             WRITE(IOIMP,*) 'Type d''élément       : ',LRF.TYPEL
  58.             WRITE(IOIMP,*) 'Esp. discr. inconnue : ',LRF.ESPACE
  59.             INDIM=LRF.XCONOD(/1)
  60.             INBNO=LRF.XCONOD(/2)
  61.             WRITE(IOIMP,*) 'Dim. esp. référence  : ',INDIM
  62.             WRITE(IOIMP,*) 'Nb. noeuds approx.   : ',INBNO
  63.             IF (IMPR.GT.3) THEN
  64.                WRITE(IOIMP,*) 'Coordonnées des noeuds d''approximation:'
  65.                DO 1 IINBNO=1,INBNO
  66.                   WRITE(IOIMP,4005)
  67.      $                 IINBNO,(LRF.XCONOD(IND,IINBNO),IND=1,INDIM)
  68.  1             CONTINUE
  69.             ENDIF
  70.             WRITE(IOIMP,*) 'Degré de l''approx.   : ',LRF.DEGRE
  71.             IDDL=LRF.NPQUAF(/1)
  72.             WRITE(IOIMP,*) 'Nb.degrés de liberté : ',IDDL
  73.             IF (IMPR.GT.3) THEN
  74.                WRITE(IOIMP,*) 'Pour chaque ddl, num. noeud du QUAF<=>',
  75.      $              'forme ET num. comp. dans les champs : '
  76.                WRITE(IOIMP,4006)
  77.      $              (LRF.NPQUAF(IIDDL),IIDDL=1,IDDL)
  78.                WRITE(IOIMP,4007)
  79.      $              (LRF.NUMCMP(IIDDL),IIDDL=1,IDDL)
  80.                WRITE(IOIMP,*) 'On ne liste pas QUENOD et ORDDER'
  81.                MYBPOL=LRF.MBPOLY
  82.                IF (MYBPOL.EQ.0) THEN
  83.                   WRITE(IOIMP,*) 'Pas de base polynomiale'
  84.                ELSE
  85.                   CALL PRBPOL(MYBPOL,IMPR,IRET)
  86.                   IF (IRET.NE.0) GOTO 9999
  87.                ENDIF
  88.             ENDIF
  89.          ENDIF
  90.       ENDIF
  91. *!      WRITE(IOIMP,4004) LRF.NOMLRF,LRF.FORME,LRF.ESPACE,LRF.DEGRE,
  92. *!     $     LRF.NPQUAF(/1)
  93.       IF (LRFETA.NE.1) SEGDES LRF
  94. *
  95. * Normal termination
  96. *
  97.       IRET=0
  98.       RETURN
  99. *
  100. * Format handling
  101. *
  102.  4004 FORMAT (A10,' ',A20,' ',A5,' ',I5,' ',I5)
  103.  4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  104.  4006 FORMAT (2X,'Num.noeud :',9(1X,I6))
  105.  4007 FORMAT (2X,'Num.comp  :',9(1X,I6))
  106. *
  107. * Error handling
  108. *
  109.  9999 CONTINUE
  110.       IRET=1
  111.       WRITE(IOIMP,*) 'An error was detected in subroutine prlrf'
  112.       RETURN
  113. *
  114. * End of subroutine prlrf
  115. *
  116.       END
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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