Esope source files

   1 : C VERPAD    SOURCE    CHAT      05/01/13    04:06:04     5004           
   2 :       SUBROUTINE VERPAD(MLENTI,MELEME,IRET)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : C*************************************************************************
   6 : C  Vérifie que MELEME est bien inclus dans IPADL
   7 : C  Attention, rien n'est désactivé...
   8 : C*************************************************************************
   9 : C HISTORIQUE : 26/10/98 : si on envoie un MELEME de pointeur 
  10 : C              nul alors on considère qu'il a bien ses points 
  11 : C              inclus dans ceux du maillage qui a servi a 
  12 : C              construire le MLENTI (par KRIPAD).
  13 : C HISTORIQUE :
  14 : C HISTORIQUE :
  15 : C***********************************************************************
  16 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  17 : C en cas de modification de ce sous-programme afin de faciliter
  18 : C la maintenance !
  19 : C***********************************************************************
  20 : -INC SMCOORD
  21 : -INC SMLENTI
  22 : -INC SMELEME
  23 : C***  
  24 :       SEGACT MLENTI
  25 :       IF (MELEME.NE.0) THEN
  26 :          SEGACT MELEME
  27 :          NBTOT=LECT(/1)
  28 :          NBSOUS=LISOUS(/1)
  29 :          IF(NBSOUS.EQ.0) NBSOUS=1
  30 :          DO 1 L=1,NBSOUS
  31 :             IF(NBSOUS.NE.1) THEN
  32 :                IPT1=LISOUS(L)
  33 :                SEGACT IPT1
  34 :             ELSE
  35 :                IPT1=MELEME
  36 :             ENDIF
  37 :             NP=IPT1.NUM(/1)
  38 :             NBEL=IPT1.NUM(/2)
  39 :             DO 2 K=1,NBEL
  40 :                DO 3 I=1,NP
  41 :                   I1=IPT1.NUM(I,K)
  42 :                   IF (I1.GT.NBTOT)   GOTO 9999
  43 :                   IF (LECT(I1).EQ.0) GOTO 9999
  44 :  3             CONTINUE
  45 :  2          CONTINUE
  46 :  1       CONTINUE
  47 :       ENDIF
  48 : *
  49 : * Normal termination
  50 : *
  51 :       IRET=0
  52 :       RETURN
  53 : *
  54 : * Error handling
  55 : *
  56 :  9999 CONTINUE
  57 :       IRET=1
  58 :       RETURN
  59 :       END
  60 : 
  61 :  
  62 :  
  63 :