Télécharger la plaquette Cast3M


fr en

Télécharger prfpg.eso

Retour à la liste

Numérotation des lignes : 

prfpg

  1. C PRFPG     SOURCE    GOUNAND   21/06/02    21:17:22     11022          
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC CCGEOME
  37. -INC TNLIN      
  38. *-INC SPOGAU
  39.       POINTEUR PGCOUR.POGAU
  40. *-INC SFAPG
  41.       POINTEUR FACOUR.FAPG
  42. *
  43.       INTEGER IMPR,IRET
  44. *
  45.       INTEGER IBMPG,NBMPG
  46.       INTEGER FALETA
  47. *
  48. * Executable statements
  49. *
  50. * On veut laisser FACOUR dans le même état (actif, inactif) qu'avant
  51. * l'appel à PRFPG.
  52.       CALL OOOETA(FACOUR,FALETA,IMOD)
  53.       IF (FALETA.NE.1) SEGACT FACOUR
  54.       WRITE(IOIMP,*) 'Segment FAPG de pointeur',FACOUR
  55.       IF (IMPR.GT.1) THEN
  56.          WRITE(IOIMP,*) 'Nom : ',FACOUR.NOMFAP
  57.          IF (IMPR.GT.2) THEN
  58.             NBMPG=FACOUR.NBQUAF(/1)
  59.             SEGACT FACOUR.MPOGAU(*)
  60.             WRITE(IOIMP,4005) 'QUAF','Meth. integ.'
  61.             DO 1 IBMPG=1,NBMPG
  62.                PGCOUR=FACOUR.MPOGAU(IBMPG)
  63.                WRITE(IOIMP,4005) NOMS(FACOUR.NBQUAF(IBMPG)),
  64.      $              PGCOUR.NOMPG
  65.  1          CONTINUE
  66.             SEGDES FACOUR.MPOGAU(*)
  67.          ENDIF
  68.       ENDIF
  69.       IF (FALETA.NE.1) SEGDES FACOUR
  70. C            NBMPG=FACOUR.NBQUAF(/1)
  71. C            SEGACT FACOUR.MPOGAU(*)
  72. C            DO 1 IBMPG=1,NBMPG
  73. C               PGCOUR=FACOUR.MPOGAU(IBMPG)
  74. C               WRITE(IOIMP,4004)
  75. C     $              FACOUR.NOMFAP,NOMS(FACOUR.NBQUAF(IBMPG)),
  76. C     $              PGCOUR.NOMPG
  77. C 1          CONTINUE
  78. C            SEGDES FACOUR.MPOGAU(*)
  79. *
  80. * Normal termination
  81. *
  82.       IRET=0
  83.       RETURN
  84. *
  85. * Format handling
  86. *
  87.  4004 FORMAT (A20,' ',A20,' ',A20)
  88.  4005 FORMAT (A14,' <-> ',A14)
  89. *
  90. * Error handling
  91. *
  92.  9999 CONTINUE
  93.       IRET=1
  94.       WRITE(IOIMP,*) 'An error was detected in subroutine prfpg'
  95.       RETURN
  96. *
  97. * End of subroutine prfpg
  98. *
  99.       END
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  

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