Télécharger prpg.eso

Retour à la liste

Numérotation des lignes :

  1. C PRPG SOURCE CB215821 18/09/27 21:15:46 9936
  2. SUBROUTINE PRPG(PG,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRPG
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un segment décrivant une méthode d'intégration
  10. C numérique.
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELES : -
  16. C APPELES (E/S) : OOOETA
  17. C APPELE PAR : INPGS
  18. C***********************************************************************
  19. C ENTREES : PG
  20. C ENTREES/SORTIES : -
  21. C SORTIES : -
  22. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23. C***********************************************************************
  24. C VERSION : v1, 21/07/99, version initiale
  25. C HISTORIQUE : v1, 21/07/99, création
  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 SPOGAU
  37. SEGMENT POGAU
  38. CHARACTER*(LNNPG) NOMPG
  39. CHARACTER*(LNTPG) TYPMPG
  40. CHARACTER*(LNFPG) FORLPG
  41. INTEGER NORDPG
  42. REAL*8 XCOPG(NDLPG,NBPG)
  43. REAL*8 XPOPG(NBPG)
  44. ENDSEGMENT
  45. SEGMENT POGAUS
  46. POINTEUR LISPG(0).POGAU
  47. ENDSEGMENT
  48. CENDINCLUDE SPOGAU
  49. POINTEUR PG.POGAU
  50. *
  51. INTEGER IMPR,IRET
  52. *
  53. INTEGER PGETA
  54. INTEGER INDLPG,INBPG
  55. INTEGER IND,IINBPG
  56. *
  57. * Executable statements
  58. *
  59. CALL OOOETA(PG,PGETA,IMOD)
  60. IF (PGETA.NE.1) SEGACT PG
  61. WRITE(IOIMP,*) 'Segment POGAU de pointeur',PG
  62. IF (IMPR.GT.1) THEN
  63. WRITE(IOIMP,*) 'Nom : ',PG.NOMPG
  64. IF (IMPR.GT.2) THEN
  65. WRITE(IOIMP,*) 'Type de méthode : ',PG.TYPMPG
  66. WRITE(IOIMP,*) 'Forme dom. intg. : ',PG.FORLPG
  67. WRITE(IOIMP,*) 'Ordre de la méthode : ',PG.NORDPG
  68. INDLPG=PG.XCOPG(/1)
  69. INBPG =PG.XCOPG(/2)
  70. WRITE(IOIMP,*) 'Nb. points intégrat. : ',INBPG
  71. WRITE(IOIMP,*) 'Dim. esp. référence : ',INDLPG
  72. IF (IMPR.GT.3) THEN
  73. WRITE(IOIMP,*) 'Coordonnées des noeuds et poids associés'
  74. DO 1 IINBPG=1,INBPG
  75. WRITE(IOIMP,4005)
  76. $ IINBPG,(PG.XCOPG(IND,IINBPG),IND=1,INDLPG)
  77. WRITE(IOIMP,4006) PG.XPOPG(IINBPG)
  78. 1 CONTINUE
  79. ENDIF
  80. ENDIF
  81. ENDIF
  82. IF (PGETA.NE.1) SEGDES PG
  83. C INBPG =PG.XCOPG(/2)
  84. C WRITE(IOIMP,4004) PG.NOMPG,PG.TYPMPG,PG.FORLPG,PG.NORDPG,INBPG
  85. *
  86. * Normal termination
  87. *
  88. IRET=0
  89. RETURN
  90. *
  91. * Format handling
  92. *
  93. 4004 FORMAT (A20,' ',A20,' ',A20,' ',I6,' ',I6)
  94. 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  95. 4006 FORMAT (2X,'Poids ',6X,' :',1(1X,1PE24.16))
  96. *
  97. * Error handling
  98. *
  99. 9999 CONTINUE
  100. IRET=1
  101. WRITE(IOIMP,*) 'An error was detected in subroutine prpg'
  102. RETURN
  103. *
  104. * End of subroutine prpg
  105. *
  106. END
  107.  
  108.  
  109.  
  110.  
  111.  

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