Télécharger la plaquette Cast3M


fr en

Télécharger prpg.eso

Retour à la liste

Numérotation des lignes : 

prpg

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

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