Télécharger prpg.eso

Retour à la liste

Numérotation des lignes :

  1. C PRPG SOURCE GOUNAND 05/12/21 21:36:04 5281
  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. -INC CCOPTIO
  34. CBEGININCLUDE SPOGAU
  35. SEGMENT POGAU
  36. CHARACTER*(LNNPG) NOMPG
  37. CHARACTER*(LNTPG) TYPMPG
  38. CHARACTER*(LNFPG) FORLPG
  39. INTEGER NORDPG
  40. REAL*8 XCOPG(NDLPG,NBPG)
  41. REAL*8 XPOPG(NBPG)
  42. ENDSEGMENT
  43. SEGMENT POGAUS
  44. POINTEUR LISPG(0).POGAU
  45. ENDSEGMENT
  46. CENDINCLUDE SPOGAU
  47. POINTEUR PG.POGAU
  48. *
  49. INTEGER IMPR,IRET
  50. *
  51. INTEGER PGETA
  52. INTEGER INDLPG,INBPG
  53. INTEGER IND,IINBPG
  54. *
  55. * Executable statements
  56. *
  57. CALL OOOETA(PG,PGETA)
  58. IF (PGETA.NE.1) SEGACT PG
  59. WRITE(IOIMP,*) 'Segment POGAU de pointeur',PG
  60. IF (IMPR.GT.1) THEN
  61. WRITE(IOIMP,*) 'Nom : ',PG.NOMPG
  62. IF (IMPR.GT.2) THEN
  63. WRITE(IOIMP,*) 'Type de méthode : ',PG.TYPMPG
  64. WRITE(IOIMP,*) 'Forme dom. intg. : ',PG.FORLPG
  65. WRITE(IOIMP,*) 'Ordre de la méthode : ',PG.NORDPG
  66. INDLPG=PG.XCOPG(/1)
  67. INBPG =PG.XCOPG(/2)
  68. WRITE(IOIMP,*) 'Nb. points intégrat. : ',INBPG
  69. WRITE(IOIMP,*) 'Dim. esp. référence : ',INDLPG
  70. IF (IMPR.GT.3) THEN
  71. WRITE(IOIMP,*) 'Coordonnées des noeuds et poids associés'
  72. DO 1 IINBPG=1,INBPG
  73. WRITE(IOIMP,4005)
  74. $ IINBPG,(PG.XCOPG(IND,IINBPG),IND=1,INDLPG)
  75. WRITE(IOIMP,4006) PG.XPOPG(IINBPG)
  76. 1 CONTINUE
  77. ENDIF
  78. ENDIF
  79. ENDIF
  80. IF (PGETA.NE.1) SEGDES PG
  81. C INBPG =PG.XCOPG(/2)
  82. C WRITE(IOIMP,4004) PG.NOMPG,PG.TYPMPG,PG.FORLPG,PG.NORDPG,INBPG
  83. *
  84. * Normal termination
  85. *
  86. IRET=0
  87. RETURN
  88. *
  89. * Format handling
  90. *
  91. 4004 FORMAT (A20,' ',A20,' ',A20,' ',I6,' ',I6)
  92. 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  93. 4006 FORMAT (2X,'Poids ',6X,' :',1(1X,1PE24.16))
  94. *
  95. * Error handling
  96. *
  97. 9999 CONTINUE
  98. IRET=1
  99. WRITE(IOIMP,*) 'An error was detected in subroutine prpg'
  100. RETURN
  101. *
  102. * End of subroutine prpg
  103. *
  104. END
  105.  
  106.  
  107.  
  108.  

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