Esope source files

   1 : C SULRFS    SOURCE    GOUNAND   05/12/21    21:36:39     5281           
   2 :       SUBROUTINE SULRFS(MYLRFS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : SULRFS
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Supprimme le segment contenant les informations sur
   9 : C               l'ensemble des éléments de référence.
  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 SORTIES            : 
  21 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  22 : C***********************************************************************
  23 : C VERSION    : v1, 19/12/02, version initiale
  24 : C HISTORIQUE : v1, 19/12/02, 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 SELREF
  34 :       SEGMENT ELREF
  35 :       CHARACTER*(LNNOM)  NOMLRF
  36 :       CHARACTER*(LNFORM) FORME 
  37 :       CHARACTER*(LNTYPL) TYPEL 
  38 :       CHARACTER*(LNESP)  ESPACE
  39 :       INTEGER DEGRE
  40 :       REAL*8 XCONOD(NDIMEL,NBNOD)
  41 :       INTEGER NPQUAF(NBDDL)
  42 :       INTEGER NUMCMP(NBDDL)
  43 :       INTEGER QUENOD(NBDDL)
  44 :       INTEGER ORDDER(NDIMEL,NBDDL)
  45 :       POINTEUR MBPOLY.POLYNS
  46 :       ENDSEGMENT
  47 :       SEGMENT ELREFS
  48 :       POINTEUR LISEL(0).ELREF
  49 :       ENDSEGMENT
  50 : CENDINCLUDE SELREF
  51 :       POINTEUR MYLRFS.ELREFS
  52 :       POINTEUR MYLRF.ELREF
  53 : CBEGININCLUDE SPOLYNO
  54 :       SEGMENT POLYNO
  55 :       REAL*8  COEMON(NBMON)
  56 :       INTEGER EXPMON(NDIML,NBMON)
  57 :       ENDSEGMENT 
  58 :       SEGMENT POLYNS
  59 :       POINTEUR LIPOLY(NBPOLY).POLYNO
  60 :       ENDSEGMENT
  61 : CENDINCLUDE SPOLYNO
  62 :       POINTEUR MYPOLS.POLYNS
  63 :       POINTEUR MYPOL.POLYNO
  64 : *
  65 :       INTEGER IMPR,IRET
  66 : *
  67 :       INTEGER NBELRF,NBPOLY
  68 :       INTEGER IBELRF,IBPOLY
  69 : *     
  70 : * Executable statements
  71 : *
  72 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans sulrfs'
  73 :       SEGACT MYLRFS*MOD
  74 :       NBELRF=MYLRFS.LISEL(/1)
  75 :       DO IBELRF=1,NBELRF
  76 :          MYLRF=MYLRFS.LISEL(IBELRF)
  77 :          IF (MYLRF.NE.0) THEN
  78 :             SEGACT MYLRF*MOD
  79 :             MYPOLS=MYLRF.MBPOLY
  80 :             IF (MYPOLS.NE.0) THEN
  81 :                SEGACT MYPOLS*MOD
  82 :                NBPOLY=MYPOLS.LIPOLY(/1)
  83 :                DO IBPOLY=1,NBPOLY
  84 :                   MYPOL=MYPOLS.LIPOLY(IBPOLY)
  85 : * SEGACT MYPOL*MOD
  86 :                   IF (MYPOL.NE.0) THEN
  87 :                      SEGSUP MYPOL
  88 :                   ENDIF
  89 :                ENDDO
  90 :                SEGSUP MYPOLS
  91 :             ENDIF
  92 :             SEGSUP MYLRF
  93 :          ENDIF
  94 :       ENDDO
  95 :       SEGSUP MYLRFS
  96 : *
  97 : * Normal termination
  98 : *
  99 :       IRET=0
 100 :       RETURN
 101 : *
 102 : * Format handling
 103 : *
 104 : *
 105 : * Error handling
 106 : *
 107 :  9999 CONTINUE
 108 :       IRET=1
 109 :       WRITE(IOIMP,*) 'An error was detected in subroutine sulrfs'
 110 :       RETURN
 111 : *
 112 : * End of subroutine SULRFS
 113 : *
 114 :       END
 115 : 
 116 :  
 117 :