Download prbpol.eso

Back to the list

   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