Télécharger additi.eso

Retour à la liste

Numérotation des lignes :

  1. C ADDITI SOURCE CHAT 05/01/12 21:17:40 5004
  2. C CE SOUS PROGRAMME AJOUTE LE POINT X A UN OBJET ELEMENTAIRE
  3. C IL RELAIE A ADDITEL
  4. C
  5. SUBROUTINE ADDITI(X,IPT1,IPT2,ICPR)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. DIMENSION X(3)
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. SEGACT IPT1
  12. C ON TRAVAILLE SUR LES SOUS-OBJETS ET SUR LES REFERENCES ELEMENTAIRES
  13. IF (IPT1.LISOUS(/1).NE.0) GOTO 50
  14. CALL ADDITE(X,IPT1,IPT2,ICPR,1)
  15. IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  16. NBREF=IPT1.LISREF(/1)
  17. GO TO 60
  18. 50 NBELEM=0
  19. NBNN=0
  20. NBSOUS=IPT1.LISOUS(/1)
  21. NBREF=IPT1.LISREF(/1)
  22. SEGINI IPT2
  23. DO 51 I=1,IPT1.LISOUS(/1)
  24. IPT3=IPT1.LISOUS(I)
  25. SEGACT IPT3
  26. C ON ENLEVE LES REFERENCES
  27. CALL ADDITE(X,IPT3,IPT5,ICPR,0)
  28. SEGDES IPT3,IPT5
  29. IPT2.LISOUS(I)=IPT5
  30. 51 CONTINUE
  31. 60 CONTINUE
  32. IF (IPT1.LISREF(/1).EQ.0) GOTO 100
  33. C POUR LES REFERENCES ON ESSAYE D'EN PRENDRE LES REFERENCES ICI
  34. DO 61 I=1,IPT1.LISREF(/1)
  35. IPT3=IPT1.LISREF(I)
  36. SEGACT IPT3
  37. IF (IPT3.LISOUS(/1).NE.0) GOTO 67
  38. CALL ADDITE(X,IPT3,IPT5,ICPR,1)
  39. IF (IPT5.LISREF(/1).EQ.0) GOTO 62
  40. DO 63 J=1,IPT3.LISREF(/1)
  41. IPT6=IPT3.LISREF(J)
  42. SEGACT IPT6
  43. IF (IPT6.LISOUS(/1).NE.0) GOTO 64
  44. CALL ADDITE(X,IPT6,IPT8,ICPR,0)
  45. SEGDES IPT6,IPT8
  46. IPT5.LISREF(J)=IPT8
  47. GOTO 63
  48. C FAUX MAIS NE PLANTE PAS
  49. 64 IPT5.LISREF(J)=IPT6
  50. 63 CONTINUE
  51. 62 CONTINUE
  52. SEGDES IPT5
  53. IPT2.LISREF(I)=IPT5
  54. GOTO 68
  55. 67 CONTINUE
  56. NBREF=0
  57. NBSOUS=IPT3.LISOUS(/1)
  58. NBNN=0
  59. NBELEM=0
  60. SEGINI IPT8
  61. DO 69 I2=1,IPT3.LISOUS(/1)
  62. IPT5=IPT3.LISOUS(I2)
  63. SEGACT IPT5
  64. CALL ADDITE(X,IPT5,IPT7,ICPR,0)
  65. IPT8.LISOUS(I2)=IPT7
  66. SEGDES IPT5,IPT7
  67. 69 CONTINUE
  68. IPT2.LISREF(I)=IPT8
  69. 68 CONTINUE
  70. SEGDES IPT3
  71. 61 CONTINUE
  72. 100 CONTINUE
  73. SEGDES IPT1,IPT2
  74. RETURN
  75. END
  76.  
  77.  

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