Download s0dtno.eso

Back to the list

   1 : C S0DTNO    SOURCE    CHAT      06/03/29    21:32:47     5360           
   2 :       SUBROUTINE S0DTNO(IPADET,COORD,IDIMC,NBN,NBNMAX,
   3 :      >                     NOETRI,NOEMAX,iarr)
   4 : C     *****************************************************************
   5 : C     OBJET : SUPPRIME LE POINT ISOLE OU LIBRE 
   6 : C     EN ENTREE :
   7 : C        IPADET : LE POINT A SUPPRIMER
   8 : C        COORD : TABLEAU DES COORDONNEES DE TOUS LES POINTS
   9 : C        IDIMC : DIMENSION DE L'ESPACE
  10 : C        NBN   : NOMBRE DE NOEUDS DEJA EXISTANT
  11 : C        NBNMAX: NOMBRE MAXIMUM DE NOEUD DANS COORD (POURRA SERVIR)
  12 : C        NOEMAX : SI = 0 NOETRI N'EST PAS MIS A JOUR
  13 : C                   SINON NOEMAX = TAILLE DE NOETRI
  14 : C     EN SORTIE : 
  15 : C        COORD, NOETRI ET NBN MODIFIES
  16 : C        iarr  : CODE D'ERREUR 0 SI OK, -1 SI C'EST IMPOSSIBLE
  17 : C     *****************************************************************
  18 :       IMPLICIT INTEGER(I-N)
  19 :       REAL*8    COORD(*)
  20 :       INTEGER IPADET,IDIMC,NBN,NBNMAX,iarr
  21 :       INTEGER NOETRI(*),NOEMAX
  22 : C
  23 :       INTEGER J
  24 : C     --- ON NE PEUT SUPPRIMER QUE LE DERNIER POINT 
  25 : C         IL DOIT ETRE ISOLE ---
  26 :       IF((IPADET.NE.NBN ).OR.
  27 :      >   ((NOEMAX.NE.0).AND.(NOETRI(IPADET).NE.0)))THEN
  28 :         iarr = -1
  28 :         CALL DSERRE(1,iarr,'ST',
  29 :      >              'DANS S0DTNO : POINT ENCORE CONNECTE')
  30 :         GOTO 999
  31 :       ENDIF
  32 : C
  33 :       DO 10 J=1,IDIMC    
  34 :         COORD((NBN-1)*IDIMC+J) = 0.0D0
  35 :    10 CONTINUE
  36 :       NBN = NBN - 1
  37 :       iarr = 0
  38 :   999 END
  39 :  
  40 :  
  41 :  

© Cast3M 2003 - All rights reserved.
Disclaimer