Esope source files

   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 : *
  56 :       CALL OOOETA(PG,PGETA)
  57 :       IF (PGETA.NE.1) SEGACT PG
  58 :       WRITE(IOIMP,*) 'Segment POGAU de pointeur',PG
  59 :       IF (IMPR.GT.1) THEN 
  60 :          WRITE(IOIMP,*) 'Nom : ',PG.NOMPG
  61 :          IF (IMPR.GT.2) THEN 
  62 :             WRITE(IOIMP,*) 'Type de méthode      : ',PG.TYPMPG
  63 :             WRITE(IOIMP,*) 'Forme dom. intg.     : ',PG.FORLPG
  64 :             WRITE(IOIMP,*) 'Ordre de la méthode  : ',PG.NORDPG
  65 :             INDLPG=PG.XCOPG(/1)
  66 :             INBPG =PG.XCOPG(/2)
  67 :             WRITE(IOIMP,*) 'Nb. points intégrat. : ',INBPG
  68 :             WRITE(IOIMP,*) 'Dim. esp. référence  : ',INDLPG
  69 :             IF (IMPR.GT.3) THEN
  70 :                WRITE(IOIMP,*) 'Coordonnées des noeuds et poids associés'
  71 :                DO 1 IINBPG=1,INBPG
  72 :                   WRITE(IOIMP,4005) 
  73 :      $                 IINBPG,(PG.XCOPG(IND,IINBPG),IND=1,INDLPG)
  74 :                   WRITE(IOIMP,4006) PG.XPOPG(IINBPG)
  75 :  1             CONTINUE
  76 :             ENDIF
  77 :          ENDIF
  78 :       ENDIF
  79 :       IF (PGETA.NE.1) SEGDES PG
  80 : C      INBPG =PG.XCOPG(/2)
  81 : C      WRITE(IOIMP,4004) PG.NOMPG,PG.TYPMPG,PG.FORLPG,PG.NORDPG,INBPG
  82 : *
  83 : * Normal termination
  84 : *
  85 :       IRET=0
  86 :       RETURN
  87 : *
  88 : * Format handling
  89 : *
  90 :  4004 FORMAT (A20,' ',A20,' ',A20,' ',I6,' ',I6)
  91 :  4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16))
  92 :  4006 FORMAT (2X,'Poids ',6X,' :',1(1X,1PE24.16))
  93 : *
  94 : * Error handling
  95 : *
  96 :  9999 CONTINUE
  97 :       IRET=1
  98 :       WRITE(IOIMP,*) 'An error was detected in subroutine prpg'
  99 :       RETURN
 100 : *
 101 : * End of subroutine prpg
 102 : *
 103 :       END
 104 : 
 105 :  
 106 :