Esope source files

   1 : C SUPGS     SOURCE    GOUNAND   05/12/21    21:36:48     5281           
   2 :       SUBROUTINE SUPGS(MYPGS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : SUPGS
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Supprimme le segment contenant les informations sur
   9 : C               l'ensemble des méthodes d'intégration (type Gauss).
  10 : C
  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)    : 
  17 : C APPELE PAR       : 
  18 : C***********************************************************************
  19 : C ENTREES            : -
  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, 19/12/02, version initiale
  25 : C HISTORIQUE : v1, 19/12/02, création
  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 SPOGAU
  34 :       SEGMENT POGAU
  35 :       CHARACTER*(LNNPG)  NOMPG
  36 :       CHARACTER*(LNTPG)  TYPMPG
  37 :       CHARACTER*(LNFPG)  FORLPG
  38 :       INTEGER NORDPG
  39 :       REAL*8 XCOPG(NDLPG,NBPG)
  40 :       REAL*8 XPOPG(NBPG)
  41 :       ENDSEGMENT
  42 :       SEGMENT POGAUS
  43 :       POINTEUR LISPG(0).POGAU
  44 :       ENDSEGMENT
  45 : CENDINCLUDE SPOGAU
  46 :       POINTEUR MYPGS.POGAUS
  47 :       POINTEUR MYPG.POGAU
  48 : *
  49 :       INTEGER IMPR,IRET
  50 : *
  51 :       INTEGER NBPG,IBPG
  52 : *     
  53 : * Executable statements
  54 : *
  55 :       IF (IMPR.GT.6) WRITE(IOIMP,*) 'Entrée dans supgs'
  56 :       SEGACT MYPGS*MOD
  57 :       NBPG=MYPGS.LISPG(/1)
  58 :       DO IBPG=1,NBPG
  59 :          MYPG=MYPGS.LISPG(IBPG)
  60 :          IF (MYPG.NE.0) THEN
  61 : * SEGACT MYPG*MOD
  62 :             SEGSUP MYPG
  63 :          ENDIF
  64 :       ENDDO
  65 :       SEGSUP MYPGS
  66 : *
  67 : * Normal termination
  68 : *
  69 :       IRET=0
  70 :       RETURN
  71 : *
  72 : * Format handling
  73 : *
  74 : *
  75 : * Error handling
  76 : *
  77 :  9999 CONTINUE
  78 :       IRET=1
  79 :       WRITE(IOIMP,*) 'An error was detected in subroutine supgs'
  80 :       RETURN
  81 : *
  82 : * End of subroutine SUPGS
  83 : *
  84 :       END
  85 : 
  86 :  
  87 :