Esope source files

   1 : C RPELEN    SOURCE    CHAT      05/01/13    03:06:46     5004           
   2 :       SUBROUTINE RPELEN(MTOUT,KRPOIN,
   3 :      $     LELEM,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : RPELEN
   9 : C DESCRIPTION : On repère les éléments d'un maillage qui contiennent (au
  10 : C               moins) un point d'une liste de points.
  11 : C
  12 : C               On repère les éléments de MTOUT qui contiennent au moins 
  13 : C               un point tel que KRPOIN(po_elem).NE.0
  14 : C
  15 : C
  16 : C LANGAGE     : ESOPE
  17 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  18 : C               mél : gounand@semt2.smts.cea.fr
  19 : C***********************************************************************
  20 : C APPELES          : NBDEL
  21 : C APPELE PAR       : PROMAT
  22 : C***********************************************************************
  23 : C ENTREES            : MTOUT, KRPOIN
  24 : C SORTIES            : LELEM
  25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  26 : C***********************************************************************
  27 : C VERSION    : v1, 02/02/2000, version initiale
  28 : C HISTORIQUE : v1, 02/02/2000, création
  29 : C HISTORIQUE :
  30 : C HISTORIQUE :
  31 : C***********************************************************************
  32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  33 : C en cas de modification de ce sous-programme afin de faciliter
  34 : C la maintenance !
  35 : C***********************************************************************
  36 : -INC CCOPTIO
  37 : -INC SMELEME
  38 :       POINTEUR MTOUT.MELEME
  39 :       POINTEUR SOUMT.MELEME
  40 : -INC SMLENTI
  41 :       POINTEUR KRPOIN.MLENTI
  42 :       INTEGER JG
  43 :       POINTEUR LELEM.MLENTI
  44 : *
  45 :       INTEGER IMPR,IRET
  46 : *
  47 :       INTEGER NEL,NNO,NSOUS,NELMT
  48 :       INTEGER IEL,INO,ISOUS,IELMT
  49 :       INTEGER IELEM,NUNO
  50 : *
  51 : * Executable statements
  52 : *
  53 :       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans rpelen.eso' 
  53 :       CALL NBDEL(MTOUT,NELMT,IMPR,IRET)
  54 :       IF (IRET.NE.0) GOTO 9999
  55 :       JG=NELMT
  56 :       SEGINI LELEM
  57 :       SEGACT KRPOIN
  58 :       SEGACT MTOUT
  59 : * Parcourons le maillage 
  60 :       IELMT=0
  61 :       IELEM=0
  62 :       NSOUS=MAX(1,MTOUT.LISOUS(/1))
  63 :       DO 1 ISOUS=1,NSOUS
  64 :          IF (NSOUS.EQ.1) THEN
  65 :             SOUMT=MTOUT
  66 :          ELSE
  67 :             SOUMT=MTOUT.LISOUS(ISOUS)
  68 :             SEGACT SOUMT
  69 :          ENDIF
  70 :          NNO=SOUMT.NUM(/1)
  71 :          NEL=SOUMT.NUM(/2)
  72 :          DO 12 IEL=1,NEL
  73 :             INO=1
  74 :             IELMT=IELMT+1
  75 :  122        CONTINUE
  76 :             NUNO=SOUMT.NUM(INO,IEL)
  77 :             IF (KRPOIN.LECT(NUNO).NE.0) THEN
  78 :                IELEM=IELEM+1
  79 :                LELEM.LECT(IELEM)=IELMT
  80 :             ELSE
  81 :                INO=INO+1
  82 :                IF (INO.LE.NNO) GOTO 122
  83 :             ENDIF
  84 :  12      CONTINUE
  85 :          IF (NSOUS.NE.1) THEN
  86 :             SEGDES SOUMT
  87 :          ENDIF
  88 :  1    CONTINUE
  89 :       SEGDES MTOUT
  90 :       SEGDES KRPOIN
  91 :       JG=IELEM
  92 :       SEGADJ,LELEM
  93 :       SEGDES LELEM
  94 : *
  95 : * Normal termination
  96 : *
  97 :       IRET=0
  98 :       RETURN
  99 : *
 100 : * Format handling
 101 : *
 102 : *
 103 : * Error handling
 104 : *
 105 :  9999 CONTINUE
 106 :       IRET=1
 107 :       WRITE(IOIMP,*) 'An error was detected in subroutine rpelen'
 108 :       RETURN
 109 : *
 110 : * End of subroutine RPELEN
 111 : *
 112 :       END
 113 : 
 114 :  
 115 :