Esope source files

   1 : C SUQRFS    SOURCE    GOUNAND   06/08/04    21:17:55     5520           
   2 :       SUBROUTINE SUQRFS(MYQRFS,IMPR,IRET)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : SUQRFS
   7 : C PROJET      : Noyau linéaire NLIN
   8 : C DESCRIPTION : Supprimme le segment contenant les informations sur
   9 : C               les QUAFs 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 SIQUAF
  34 :       SEGMENT IQUAF
  35 :       INTEGER NUMQUF
  36 :       REAL*8 XCONQR(NDIMQR,NBNOQR)
  37 :       INTEGER NUCENT
  38 :       POINTEUR LFACE.MELEME
  39 :       ENDSEGMENT
  40 :       SEGMENT IQUAFS
  41 :       POINTEUR LISQRF(NBQRF).IQUAF
  42 :       ENDSEGMENT
  43 : CENDINCLUDE SIQUAF
  44 :       POINTEUR MYQRFS.IQUAFS
  45 :       POINTEUR MYQRF.IQUAF
  46 : -INC SMELEME
  47 :       POINTEUR MYMEL.MELEME
  48 :       POINTEUR MYSMEL.MELEME
  49 : *
  50 :       INTEGER IMPR,IRET
  51 : *
  52 :       INTEGER NBQRF,IBQRF
  53 :       INTEGER NBSOUS,IBSOUS
  54 : *     
  55 : * Executable statements
  56 : *
  57 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans suqrfs'
  58 :       SEGACT MYQRFS*MOD
  59 :       NBQRF=MYQRFS.LISQRF(/1)
  60 :       DO IBQRF=1,NBQRF
  61 :          MYQRF=MYQRFS.LISQRF(IBQRF)
  62 :          IF (MYQRF.NE.0) THEN
  63 :             SEGACT MYQRF*MOD
  64 :             MYMEL=MYQRF.LFACE
  65 :             SEGACT MYMEL*MOD
  66 :             NBSOUS=MYMEL.LISOUS(/1)
  67 :             DO IBSOUS=1,NBSOUS
  68 :                MYSMEL=MYMEL.LISOUS(IBSOUS)
  69 : *               SEGACT MYSMEL*MOD
  70 :                SEGSUP MYSMEL
  71 :             ENDDO
  72 :             SEGSUP MYMEL
  73 :             SEGSUP MYQRF
  74 :          ENDIF
  75 :       ENDDO
  76 :       SEGSUP MYQRFS
  77 : *
  78 : * Normal termination
  79 : *
  80 :       IRET=0
  81 :       RETURN
  82 : *
  83 : * Format handling
  84 : *
  85 : *
  86 : * Error handling
  87 : *
  88 :  9999 CONTINUE
  89 :       IRET=1
  90 :       WRITE(IOIMP,*) 'An error was detected in subroutine suqrfs'
  91 :       RETURN
  92 : *
  93 : * End of subroutine SUQRFS
  94 : *
  95 :       END
  96 : 
  97 :  
  98 :