Télécharger s0dtno.eso

Retour à la liste

Numérotation des lignes :

  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
  29. CALL DSERRE(1,iarr,'ST',
  30. > 'DANS S0DTNO : POINT ENCORE CONNECTE')
  31. GOTO 999
  32. ENDIF
  33. C
  34. DO 10 J=1,IDIMC
  35. COORD((NBN-1)*IDIMC+J) = 0.0D0
  36. 10 CONTINUE
  37. NBN = NBN - 1
  38. iarr = 0
  39. 999 END
  40.  
  41.  
  42.  
  43.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales