Télécharger dtrigi.eso

Retour à la liste

Numérotation des lignes :

  1. C DTRIGI SOURCE PV 16/11/26 21:15:38 9205
  2. SUBROUTINE DTRIGI(IRET)
  3. C **** DESTRUCTION DE LA MATRICE SI ELLE EXISTE,DESTRUCTION DU CHAPEAU
  4. C **** MATRICE: ON DETRUIT TOUT
  5. IMPLICIT INTEGER(I-N)
  6. character*4 momot(1)
  7. character*6 msorse
  8. integer i,ico, idet, inc, ipile, iret
  9. -INC CCOPTIO
  10. -INC COCOLL
  11. -INC SMRIGID
  12. -INC SMMATRI
  13. -INC SMELEME
  14. -INC TMCOLAC
  15.  
  16. pointeur piles.LISPIL
  17. pointeur jcolac.ICOLAC
  18. pointeur jlisse.ILISSE
  19. pointeur jtlacc.ITLACC
  20. pointeur pile.ITLACC
  21. DATA MOMOT(1)/'ELEM'/
  22. CALL LIRMOT(MOMOT,1,IDET,0)
  23. MRIGID=IRET
  24. SEGACT MRIGID
  25. IF(IIMPI.EQ.1) WRITE(IOIMP,10) ICHOLE
  26. 10 FORMAT(' ON DETRUIT UNE RIGIDITE CHOLEVSKISE SI ICHOLE = 1',
  27. 1 I5)
  28. IF(ICHOLE.EQ.0) GOTO 2
  29. C
  30. C **** DESTRUCTION DE LA MATRICE
  31. MMATRI=ICHOLE
  32. SEGACT MMATRI
  33. MDIAG=IDIAG
  34. SEGSUP MDIAG
  35. MELEME=IGEOMA
  36. IF(IPSAUV.NE.0) THEN
  37. ICOLAC = IPSAUV
  38. SEGACT ICOLAC
  39. ILISSE=ILISSG
  40. SEGACT ILISSE*MOD
  41. CALL TYPFIL('MAILLAGE',ICO)
  42. ITLACC = KCOLA(ICO)
  43. SEGACT ITLACC*MOD
  44. CALL AJOUN0(ITLACC,MELEME,ILISSE,1)
  45. * SEGDES ITLACC,ILISSE
  46. * SEGDES ICOLAC
  47. ENDIF
  48. C Suppression du meleme des piles d'objets communiques
  49. if(piComm.gt.0) then
  50. piles=piComm
  51. segact piles
  52. call typfil('MAILLAGE',ico)
  53. do ipile=1,piles.proc(/1)
  54. jcolac= piles.proc(ipile)
  55. if(jcolac.ne.0) then
  56. segact jcolac
  57. jlisse=jcolac.ilissg
  58. segact jlisse*mod
  59. jtlacc=jcolac.kcola(ico)
  60. segact jtlacc*mod
  61. call ajoun0(jtlacc,MELEME,jlisse,1)
  62. segdes jtlacc
  63. segdes jlisse
  64. segdes jcolac
  65. endif
  66. enddo
  67. segdes piles
  68. endif
  69. SEGSUP MELEME
  70. MINCPO=IINCPO
  71. SEGSUP MINCPO
  72. MIDUA=IIDUA
  73. SEGSUP MIDUA
  74. MHARK=IHARK
  75. SEGSUP MHARK
  76. MIMIK=IIMIK
  77. SEGSUP MIMIK
  78. MDNOR=IDNORM
  79. SEGSUP MDNOR
  80. MILIGN=IILIGN
  81. SEGACT MILIGN
  82. INC=ILIGN(/1)
  83. DO 1 I=1,INC
  84. LIGN=ILIGN(I)
  85. SEGSUP LIGN
  86. 1 CONTINUE
  87. SEGSUP MILIGN
  88. SEGSUP MMATRI
  89. C
  90. C **** DESTRUCTION DU CHAPEAU
  91. 2 CONTINUE
  92. C
  93. CCCCCCCCCCCCC SI ON MIS DETRUIRE ELEM ON DETRUIT AUSSI LES RIGI
  94. C ELEMENTAIRES
  95. IF(IMGEO1.NE.0) THEN
  96. IMGEOD=IMGEO1
  97. SEGSUP IMGEOD
  98. ENDIF
  99. IF(IVECRI.NE.0) then
  100. MVECRI=IVECRI
  101. segsup MVECRI
  102. endif
  103. IF(IDET.EQ.1) CALL DERIGI(IRET,-1,msorse)
  104. IF(IDET.EQ.0) SEGSUP MRIGID
  105. IRET=0
  106. RETURN
  107. END
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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