1 : C PRBPOL SOURCE GOUNAND 05/12/21 21:34:49 5281 2 : SUBROUTINE PRBPOL(BAPOLY, 3 : $ IMPR,IRET) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : IMPLICIT INTEGER (I-N) 6 : C*********************************************************************** 7 : C NOM : PRBPOL 8 : C DESCRIPTION : Imprime un segment décrivant une liste de polynômes. 9 : C 10 : C LANGAGE : ESOPE 11 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 12 : C mél : gounand@semt2.smts.cea.fr 13 : C*********************************************************************** 14 : C APPELES : - 15 : C APPELES (E/S) : OOOETA 16 : C APPELE PAR : PRLRF 17 : C*********************************************************************** 18 : C ENTREES : BAPOLY 19 : C ENTREES/SORTIES : - 20 : C SORTIES : - 21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 22 : C*********************************************************************** 23 : C VERSION : v1, 10/05/2000, version initiale 24 : C HISTORIQUE : v1, 10/05/2000, création 25 : C HISTORIQUE : 26 : C HISTORIQUE : 27 : C*********************************************************************** 28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 29 : C en cas de modification de ce sous-programme afin de faciliter 30 : C la maintenance ! 31 : C*********************************************************************** 32 : -INC CCOPTIO 33 : CBEGININCLUDE SPOLYNO 34 : SEGMENT POLYNO 35 : REAL*8 COEMON(NBMON) 36 : INTEGER EXPMON(NDIML,NBMON) 37 : ENDSEGMENT 38 : SEGMENT POLYNS 39 : POINTEUR LIPOLY(NBPOLY).POLYNO 40 : ENDSEGMENT 41 : CENDINCLUDE SPOLYNO 42 : POINTEUR BAPOLY.POLYNS 43 : POINTEUR MYPOLY.POLYNO 44 : * 45 : INTEGER IMPR,IRET 46 : * 47 : INTEGER BAPETA,MYPETA 48 : INTEGER NMONO,NPOLY,NDIML 49 : INTEGER IMONO,IPOLY,INDIML 50 : * 51 : * Executable statements 52 : * 53 : IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans prbpol.eso' 53 : CALL OOOETA(BAPOLY,BAPETA) 54 : IF (BAPETA.NE.1) SEGACT BAPOLY 55 : NPOLY=BAPOLY.LIPOLY(/1) 56 : DO 1 IPOLY=1,NPOLY 57 : WRITE(IOIMP,*) 'Polynôme ',IPOLY 58 : MYPOLY=BAPOLY.LIPOLY(IPOLY) 58 : CALL OOOETA(MYPOLY,MYPETA) 59 : IF (MYPETA.NE.1) SEGACT MYPOLY 60 : NMONO=MYPOLY.COEMON(/1) 61 : NDIML=MYPOLY.EXPMON(/1) 62 : DO 12 IMONO=1,NMONO 63 : WRITE(IOIMP,*) 'Monôme : ',IMONO, 64 : $ ' coeff. et puissances de ksi_i' 65 : WRITE(IOIMP,4004) MYPOLY.COEMON(IMONO) 66 : WRITE(IOIMP,3004) 67 : $ (MYPOLY.EXPMON(INDIML,IMONO),INDIML=1,NDIML) 68 : 12 CONTINUE 69 : IF (MYPETA.NE.1) SEGDES MYPOLY 70 : 1 CONTINUE 71 : IF (BAPETA.NE.1) SEGDES BAPOLY 72 : * 73 : * Normal termination 74 : * 75 : IRET=0 76 : RETURN 77 : * 78 : * Format handling 79 : * 80 : 3004 FORMAT (2X,10(1X,I4)) 81 : 4004 FORMAT (2X,6(1X,1PE13.5)) 82 : * 83 : * Error handling 84 : * 85 : 9999 CONTINUE 86 : IRET=1 87 : WRITE(IOIMP,*) 'An error was detected in subroutine prbpol' 88 : RETURN 89 : * 90 : * End of subroutine PRBPOL 91 : * 92 : END 93 : 94 : 95 :
© Cast3M 2003 - All rights reserved.
Disclaimer