Télécharger chditi.eso

Retour à la liste

Numérotation des lignes :

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

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