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