Télécharger prlrf.eso

Retour à la liste

Numérotation des lignes :

  1. C PRLRF SOURCE CB215821 18/09/27 21:15:45 9936
  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. CBEGININCLUDE SELREF
  37. SEGMENT ELREF
  38. CHARACTER*(LNNOM) NOMLRF
  39. CHARACTER*(LNFORM) FORME
  40. CHARACTER*(LNTYPL) TYPEL
  41. CHARACTER*(LNESP) ESPACE
  42. INTEGER DEGRE
  43. REAL*8 XCONOD(NDIMEL,NBNOD)
  44. INTEGER NPQUAF(NBDDL)
  45. INTEGER NUMCMP(NBDDL)
  46. INTEGER QUENOD(NBDDL)
  47. INTEGER ORDDER(NDIMEL,NBDDL)
  48. POINTEUR MBPOLY.POLYNS
  49. ENDSEGMENT
  50. SEGMENT ELREFS
  51. POINTEUR LISEL(0).ELREF
  52. ENDSEGMENT
  53. CENDINCLUDE SELREF
  54. POINTEUR LRF.ELREF
  55. CBEGININCLUDE SPOLYNO
  56. SEGMENT POLYNO
  57. REAL*8 COEMON(NBMON)
  58. INTEGER EXPMON(NDIML,NBMON)
  59. ENDSEGMENT
  60. SEGMENT POLYNS
  61. POINTEUR LIPOLY(NBPOLY).POLYNO
  62. ENDSEGMENT
  63. CENDINCLUDE SPOLYNO
  64. POINTEUR MYBPOL.POLYNS
  65. *
  66. INTEGER IMPR,IRET
  67. *
  68. INTEGER LRFETA
  69. INTEGER INDIM,INBNO,IDDL
  70. INTEGER IINBNO,IND,IIDDL
  71. *
  72. * Executable statements
  73. *
  74. CALL OOOETA(LRF,LRFETA,IMOD)
  75. IF (LRFETA.NE.1) SEGACT LRF
  76. WRITE(IOIMP,*) 'Segment ELREF de pointeur',LRF
  77. IF (IMPR.GT.1) THEN
  78. WRITE(IOIMP,*) 'Nom : ',LRF.NOMLRF
  79. IF (IMPR.GT.2) THEN
  80. WRITE(IOIMP,*) 'Forme : ',LRF.FORME
  81. WRITE(IOIMP,*) 'Type d''élément : ',LRF.TYPEL
  82. WRITE(IOIMP,*) 'Esp. discr. inconnue : ',LRF.ESPACE
  83. INDIM=LRF.XCONOD(/1)
  84. INBNO=LRF.XCONOD(/2)
  85. WRITE(IOIMP,*) 'Dim. esp. référence : ',INDIM
  86. WRITE(IOIMP,*) 'Nb. noeuds approx. : ',INBNO
  87. IF (IMPR.GT.3) THEN
  88. WRITE(IOIMP,*) 'Coordonnées des noeuds d''approximation:'
  89. DO 1 IINBNO=1,INBNO
  90. WRITE(IOIMP,4005)
  91. $ IINBNO,(LRF.XCONOD(IND,IINBNO),IND=1,INDIM)
  92. 1 CONTINUE
  93. ENDIF
  94. WRITE(IOIMP,*) 'Degré de l''approx. : ',LRF.DEGRE
  95. IDDL=LRF.NPQUAF(/1)
  96. WRITE(IOIMP,*) 'Nb.degrés de liberté : ',IDDL
  97. IF (IMPR.GT.3) THEN
  98. WRITE(IOIMP,*) 'Pour chaque ddl, num. noeud du QUAF<=>',
  99. $ 'forme ET num. comp. dans les champs : '
  100. WRITE(IOIMP,4006)
  101. $ (LRF.NPQUAF(IIDDL),IIDDL=1,IDDL)
  102. WRITE(IOIMP,4007)
  103. $ (LRF.NUMCMP(IIDDL),IIDDL=1,IDDL)
  104. WRITE(IOIMP,*) 'On ne liste pas QUENOD et ORDDER'
  105. MYBPOL=LRF.MBPOLY
  106. IF (MYBPOL.EQ.0) THEN
  107. WRITE(IOIMP,*) 'Pas de base polynomiale'
  108. ELSE
  109. CALL PRBPOL(MYBPOL,IMPR,IRET)
  110. IF (IRET.NE.0) GOTO 9999
  111. ENDIF
  112. ENDIF
  113. ENDIF
  114. ENDIF
  115. *! WRITE(IOIMP,4004) LRF.NOMLRF,LRF.FORME,LRF.ESPACE,LRF.DEGRE,
  116. *! $ LRF.NPQUAF(/1)
  117. IF (LRFETA.NE.1) SEGDES LRF
  118. *
  119. * Normal termination
  120. *
  121. IRET=0
  122. RETURN
  123. *
  124. * Format handling
  125. *
  126. 4004 FORMAT (A10,' ',A20,' ',A5,' ',I5,' ',I5)
  127. 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  128. 4006 FORMAT (2X,'Num.noeud :',9(1X,I6))
  129. 4007 FORMAT (2X,'Num.comp :',9(1X,I6))
  130. *
  131. * Error handling
  132. *
  133. 9999 CONTINUE
  134. IRET=1
  135. WRITE(IOIMP,*) 'An error was detected in subroutine prlrf'
  136. RETURN
  137. *
  138. * End of subroutine prlrf
  139. *
  140. END
  141.  
  142.  
  143.  
  144.  
  145.  

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