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