C PRPG SOURCE GOUNAND 21/06/02 21:17:34 11022 SUBROUTINE PRPG(PG, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : PRPG C PROJET : Noyau linéaire NLIN C DESCRIPTION : Imprime un segment décrivant une méthode d'intégration C numérique. C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : - C APPELES (E/S) : OOOETA C APPELE PAR : INPGS C*********************************************************************** C ENTREES : PG C ENTREES/SORTIES : - C SORTIES : - C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 21/07/99, version initiale C HISTORIQUE : v1, 21/07/99, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO -INC TNLIN *-INC SPOGAU POINTEUR PG.POGAU * INTEGER IMPR,IRET * INTEGER PGETA INTEGER INDLPG,INBPG INTEGER IND,IINBPG * * Executable statements * CALL OOOETA(PG,PGETA,IMOD) IF (PGETA.NE.1) SEGACT PG WRITE(IOIMP,*) 'Segment POGAU de pointeur',PG IF (IMPR.GT.1) THEN WRITE(IOIMP,*) 'Nom : ',PG.NOMPG IF (IMPR.GT.2) THEN WRITE(IOIMP,*) 'Type de méthode : ',PG.TYPMPG WRITE(IOIMP,*) 'Forme dom. intg. : ',PG.FORLPG WRITE(IOIMP,*) 'Ordre de la méthode : ',PG.NORDPG INDLPG=PG.XCOPG(/1) INBPG =PG.XCOPG(/2) WRITE(IOIMP,*) 'Nb. points intégrat. : ',INBPG WRITE(IOIMP,*) 'Dim. esp. référence : ',INDLPG IF (IMPR.GT.3) THEN WRITE(IOIMP,*) 'Coordonnées des noeuds et poids associés' DO 1 IINBPG=1,INBPG WRITE(IOIMP,4005) $ IINBPG,(PG.XCOPG(IND,IINBPG),IND=1,INDLPG) WRITE(IOIMP,4006) PG.XPOPG(IINBPG) 1 CONTINUE ENDIF ENDIF ENDIF IF (PGETA.NE.1) SEGDES PG C INBPG =PG.XCOPG(/2) C WRITE(IOIMP,4004) PG.NOMPG,PG.TYPMPG,PG.FORLPG,PG.NORDPG,INBPG * * Normal termination * IRET=0 RETURN * * Format handling * 4004 FORMAT (A20,' ',A20,' ',A20,' ',I6,' ',I6) 4005 FORMAT (2X,'Point ',I6,' :',6(1X,1PE24.16)) 4006 FORMAT (2X,'Poids ',6X,' :',1(1X,1PE24.16)) * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine prpg' RETURN * * End of subroutine prpg * END