Télécharger dtchpo.eso

Retour à la liste

Numérotation des lignes :

  1. C DTCHPO SOURCE PV 16/11/26 21:15:35 9205
  2. SUBROUTINE DTCHPO(IRET)
  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. integer i,ico, idet, ipile, iret,nat, nsoupo
  10. -INC CCOPTIO
  11. -INC COCOLL
  12. -INC SMCHPOI
  13. -INC SMELEME
  14. -INC TMCOLAC
  15.  
  16. pointeur piles.LISPIL
  17. pointeur jcolac.ICOLAC
  18. pointeur jlisse.ILISSE
  19. pointeur jtlacc.ITLACC
  20. DATA MOMOT/'GEOM'/
  21. CALL LIRMOT(MOMOT,1,IDET,0)
  22. MCHPOI=IRET
  23. SEGACT MCHPOI*MOD
  24. NSOUPO=IPCHP(/1)
  25. DO 1 I=1,NSOUPO
  26. MSOUPO=IPCHP(I)
  27. SEGACT MSOUPO
  28. MPOVAL=IPOVAL
  29. MELEME=IGEOC
  30. IF (IDET.EQ.1) THEN
  31. SEGSUP MELEME
  32. IF(IPSAUV.NE.0) THEN
  33. ICOLAC=IPSAUV
  34. SEGACT ICOLAC
  35. ILISSE=ILISSG
  36. SEGACT ILISSE*MOD
  37. CALL TYPFIL('MAILLAGE',ICO)
  38. ITLACC=KCOLA(ICO)
  39. SEGACT ITLACC*MOD
  40. CALL AJOUN0(ITLACC,MELEME,ILISSE,1)
  41. SEGDES ITLACC
  42. SEGDES ILISSE
  43. SEGDES ICOLAC
  44. ENDIF
  45. C Suppression du meleme des piles d'objets communiques
  46. if(piComm.gt.0) then
  47. piles=piComm
  48. segact piles
  49. call typfil('MAILLAGE',ico)
  50. do ipile=1,piles.proc(/1)
  51. jcolac= piles.proc(ipile)
  52. if(jcolac.ne.0) then
  53. segact jcolac
  54. jlisse=jcolac.ilissg
  55. segact jlisse*mod
  56. jtlacc=jcolac.kcola(ico)
  57. segact jtlacc*mod
  58. call ajoun0(jtlacc,MELEME,jlisse,1)
  59. segdes jtlacc
  60. segdes jlisse
  61. segdes jcolac
  62. endif
  63. enddo
  64. segdes piles
  65. endif
  66. ENDIF
  67. SEGSUP MPOVAL
  68. SEGSUP MSOUPO
  69. 1 CONTINUE
  70. NSOUPO=1
  71. NAT=0
  72. SEGADJ MCHPOI
  73. ipchp(1)=0
  74. SEGDES MCHPOI
  75. IRET=0
  76. RETURN
  77. END
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  

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