Télécharger prfpg.eso

Retour à la liste

Numérotation des lignes :

  1. C PRFPG SOURCE BP208322 16/11/18 21:20:09 9177
  2. SUBROUTINE PRFPG(FACOUR,
  3. $ IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : PRFPG
  8. C PROJET : Noyau linéaire NLIN
  9. C DESCRIPTION : Imprime un segment décrivant une famille de méthodes
  10. C d'intégration.
  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 : OOOETA (état d'un segment)
  16. C APPELE PAR : INFPGS
  17. C***********************************************************************
  18. C ENTREES : FACOUR (type FAPG) : famille d'éléments de
  19. C référence.
  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, 16/07/02, version initiale
  25. C HISTORIQUE : v1, 16/07/02, 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. -INC CCGEOME
  35. CBEGININCLUDE SPOGAU
  36. SEGMENT POGAU
  37. CHARACTER*(LNNPG) NOMPG
  38. CHARACTER*(LNTPG) TYPMPG
  39. CHARACTER*(LNFPG) FORLPG
  40. INTEGER NORDPG
  41. REAL*8 XCOPG(NDLPG,NBPG)
  42. REAL*8 XPOPG(NBPG)
  43. ENDSEGMENT
  44. SEGMENT POGAUS
  45. POINTEUR LISPG(0).POGAU
  46. ENDSEGMENT
  47. CENDINCLUDE SPOGAU
  48. POINTEUR PGCOUR.POGAU
  49. CBEGININCLUDE SFAPG
  50. SEGMENT FAPG
  51. CHARACTER*(LNNFAP) NOMFAP
  52. INTEGER NBQUAF(NBMPG)
  53. POINTEUR MPOGAU(NBMPG).POGAU
  54. ENDSEGMENT
  55. SEGMENT FAPGS
  56. POINTEUR LISFPG(0).FAPG
  57. ENDSEGMENT
  58. CENDINCLUDE SFAPG
  59. POINTEUR FACOUR.FAPG
  60. *
  61. INTEGER IMPR,IRET
  62. *
  63. INTEGER IBMPG,NBMPG
  64. INTEGER FALETA
  65. *
  66. * Executable statements
  67. *
  68. * On veut laisser FACOUR dans le même état (actif, inactif) qu'avant
  69. * l'appel à PRFPG.
  70. CALL OOOETA(FACOUR,FALETA)
  71. IF (FALETA.NE.1) SEGACT FACOUR
  72. WRITE(IOIMP,*) 'Segment FAPG de pointeur',FACOUR
  73. IF (IMPR.GT.1) THEN
  74. WRITE(IOIMP,*) 'Nom : ',FACOUR.NOMFAP
  75. IF (IMPR.GT.2) THEN
  76. NBMPG=FACOUR.NBQUAF(/1)
  77. SEGACT FACOUR.MPOGAU(*)
  78. WRITE(IOIMP,4005) 'QUAF','Meth. integ.'
  79. DO 1 IBMPG=1,NBMPG
  80. PGCOUR=FACOUR.MPOGAU(IBMPG)
  81. WRITE(IOIMP,4005) NOMS(FACOUR.NBQUAF(IBMPG)),
  82. $ PGCOUR.NOMPG
  83. 1 CONTINUE
  84. SEGDES FACOUR.MPOGAU(*)
  85. ENDIF
  86. ENDIF
  87. IF (FALETA.NE.1) SEGDES FACOUR
  88. C NBMPG=FACOUR.NBQUAF(/1)
  89. C SEGACT FACOUR.MPOGAU(*)
  90. C DO 1 IBMPG=1,NBMPG
  91. C PGCOUR=FACOUR.MPOGAU(IBMPG)
  92. C WRITE(IOIMP,4004)
  93. C $ FACOUR.NOMFAP,NOMS(FACOUR.NBQUAF(IBMPG)),
  94. C $ PGCOUR.NOMPG
  95. C 1 CONTINUE
  96. C SEGDES FACOUR.MPOGAU(*)
  97. *
  98. * Normal termination
  99. *
  100. IRET=0
  101. RETURN
  102. *
  103. * Format handling
  104. *
  105. 4004 FORMAT (A20,' ',A20,' ',A20)
  106. 4005 FORMAT (A14,' <-> ',A14)
  107. *
  108. * Error handling
  109. *
  110. 9999 CONTINUE
  111. IRET=1
  112. WRITE(IOIMP,*) 'An error was detected in subroutine prfpg'
  113. RETURN
  114. *
  115. * End of subroutine prfpg
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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