Télécharger dtchpz.eso

Retour à la liste

Numérotation des lignes :

  1. C DTCHPZ SOURCE PV 16/11/26 21:15:36 9205
  2. SUBROUTINE DTCHPZ(IRET,ktrace,msorse)
  3. C
  4. C **** DESTRUCTION D'UN CHPOINT: ON TUE LES VALEURS,LES MSOUPO,
  5. C **** LE CHAPEAU. IGEOC EST CONSERVE SI PAS LECTURE DU MOT GEOM
  6. C
  7. IMPLICIT INTEGER(I-N)
  8. character*4 momot(1)
  9. character*6 msorse
  10. integer i,ico, idet,ipile, iret, ktrace, nat, nsoupo
  11. -INC CCOPTIO
  12. -INC COCOLL
  13. -INC SMCHPOI
  14. -INC SMELEME
  15. -INC TMCOLAC
  16.  
  17. pointeur piles.LISPIL
  18. pointeur jcolac.ICOLAC
  19. pointeur jlisse.ILISSE
  20. pointeur jtlacc.ITLACC
  21. DATA MOMOT/'GEOM'/
  22. CALL LIRMOT(MOMOT,1,IDET,0)
  23. MCHPOI=IRET
  24. SEGACT MCHPOI*MOD
  25. NSOUPO=IPCHP(/1)
  26. DO 1 I=1,NSOUPO
  27. MSOUPO=IPCHP(I)
  28. SEGACT MSOUPO
  29. MPOVAL=IPOVAL
  30. MELEME=IGEOC
  31. IF (IDET.EQ.1) THEN
  32. if(meleme.eq.ktrace) then
  33. msorse='MELEME'
  34. ktrace=-ktrace
  35. endif
  36. SEGSUP MELEME
  37. IF(IPSAUV.NE.0) THEN
  38. ICOLAC=IPSAUV
  39. SEGACT ICOLAC
  40. ILISSE=ILISSG
  41. SEGACT ILISSE*MOD
  42. CALL TYPFIL('MAILLAGE',ICO)
  43. ITLACC=KCOLA(ICO)
  44. SEGACT ITLACC*MOD
  45. CALL AJOUN0(ITLACC,MELEME,ILISSE,1)
  46. SEGDES ITLACC
  47. SEGDES ILISSE
  48. SEGDES ICOLAC
  49. ENDIF
  50. C Suppression du chpo des piles d'objets communiques
  51. if(piComm.gt.0) then
  52. piles=piComm
  53. segact piles
  54. call typfil('MAILLAGE',ico)
  55. do ipile=1,piles.proc(/1)
  56. jcolac= piles.proc(ipile)
  57. if(jcolac.ne.0) then
  58. C normalement, deja active par detrui
  59. C segact jcolac
  60. jlisse=jcolac.ilissg
  61. C normalement, deja active par detrui
  62. C segact jlisse*mod
  63. jtlacc=jcolac.kcola(ico)
  64. segact jtlacc*mod
  65. call ajoun0(jtlacc,MELEME,jlisse,1)
  66. segdes jtlacc
  67. C Faut-il desactiver jlisse et icolac ?
  68. C Non, ils sont actives par detrui et seul detrui
  69. C appelle cette fonction
  70. endif
  71. enddo
  72. segdes piles
  73. endif
  74. ENDIF
  75. if( msoupo.eq.ktrace) then
  76. msorse='MSOUPO'
  77. ktrace=-ktrace
  78. endif
  79. if( mpoval.eq.ktrace) then
  80. msorse='MPOVAL'
  81. ktrace=-ktrace
  82. endif
  83. SEGSUP MPOVAL
  84. SEGSUP MSOUPO
  85. 1 CONTINUE
  86. NSOUPO=0
  87. NAT=0
  88. SEGADJ MCHPOI
  89. SEGDES MCHPOI
  90. IRET=0
  91. RETURN
  92. END
  93.  
  94.  
  95.  
  96.  
  97.  

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