Télécharger s0ajno.eso

Retour à la liste

Numérotation des lignes :

  1. C S0AJNO SOURCE CHAT 06/03/29 21:32:42 5360
  2. C *****************************************************************
  3. C MODULE : ST (STRUCTURE DES DONNEES)
  4. C FICHIER : ST_0DSTRUCT.F
  5. C OBJET : AJOUT DE POINTS DANS UN MAILLAGE
  6. C FONCT. :
  7. C S0AJNO : AJOUTE UN POINT ISOLE OU LIBRE
  8. C S0DTNO : SUPPRIME LE POINT ISOLE OU LIBRE
  9. C
  10. C AUTEUR : O. STAB
  11. C DATE : 03.95
  12. C TESTS : A FAIRE
  13. C MODIFICATIONS :
  14. C AUTEUR, DATE, OBJET :
  15. C
  16. C
  17. C *****************************************************************
  18. C
  19. C
  20. SUBROUTINE S0AJNO(XYZ,COORD,IDIMC,NBN,NBNMAX,
  21. > NOETRI,NOEMAX,NNEW,iarr)
  22. C *****************************************************************
  23. C OBJET : AJOUTE UN POINT ISOLE OU LIBRE
  24. C EN ENTREE :
  25. C XYZ : TABLEAU DES COORDONNEES DU POINT
  26. C COORD : TABLEAU DES COORDONNEES DE TOUS LES POINTS
  27. C IDIMC : DIMENSION DE L'ESPACE
  28. C NBN : NOMBRE DE NOEUDS DEJA EXISTANT
  29. C NBNMAX: NOMBRE MAXIMUM DE NOEUD DANS COORD
  30. C NOEMAX : SI = 0 NOETRI N'EST PAS MIS A JOUR
  31. C SINON NOEMAX = TAILLE DE NOETRI
  32. C EN SORTIE :
  33. C COORD, NOETRI ET NBN MODIFIES
  34. C NNEW : NUMERO DU NOEUD AJOUTE
  35. C iarr : CODE D'ERREUR 0 SI OK, -2 SI COORD EST TROP PETIT
  36. C *****************************************************************
  37. IMPLICIT INTEGER(I-N)
  38. REAL*8 XYZ(*),COORD(*)
  39. INTEGER IDIMC,NBN,NBNMAX,iarr
  40. INTEGER NOETRI(*),NOEMAX,NNEW
  41. C
  42. INTEGER J
  43. C
  44. IF( NBN.GE.NBNMAX )THEN
  45. iarr = -2
  46. CALL DSERRE(1,iarr,'ST','DANS S0AJNO : TROP DE POINTS')
  47. GOTO 999
  48. ENDIF
  49. NBN = NBN + 1
  50. DO 10 J=1,IDIMC
  51. COORD((NBN-1)*IDIMC+J) = XYZ(J)
  52. 10 CONTINUE
  53. NNEW = NBN
  54. IF( NOEMAX.GT. 0 )THEN
  55. IF( NOEMAX.LT.NNEW )THEN
  56. iarr =-2
  57. CALL DSERRE(1,iarr,'ST','DANS S0AJNO : NOETRI TROP PETIT')
  58. GOTO 999
  59. ENDIF
  60. NOETRI(NNEW) = 0
  61. ENDIF
  62. iarr = 0
  63. 999 END
  64.  
  65.  
  66.  
  67.  

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