Télécharger enlev5.eso

Retour à la liste

Numérotation des lignes :

  1. C ENLEV5 SOURCE PV 13/04/11 21:15:44 7755
  2. SUBROUTINE ENLEV5(IPOIN1,MSWMIL,IPOIN2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. -INC CCOPTIO
  6. -INC SMCHPOI
  7. -INC SMCOORD
  8. -INC SMELEME
  9. -INC TMTRAV
  10. SEGMENT MSWMIL
  11. CHARACTER*4 MOTDDL(IAAA)
  12. ENDSEGMENT
  13. SEGMENT/MTRA/(ICPR(XCOOR(/1)/(IDIM+1)))
  14. SEGMENT MTR1
  15. CHARACTER*4 IPCOM(0)
  16. ENDSEGMENT
  17. SEGMENT/MTR2/(IPHAR(0))
  18. C
  19. SEGACT MSWMIL
  20. IBDDL=MOTDDL(/2)
  21. IF(IBDDL.EQ.0) THEN
  22. IPOIN2=IPOIN1
  23. RETURN
  24. ENDIF
  25. IF(IBDDL.EQ.1) THEN
  26. MCHPOI=IPOIN1
  27. SEGACT MCHPOI
  28. NSOUPO=IPCHP(/1)
  29. ITOT=0
  30. ISOU=0
  31. DO 4 IA=1,NSOUPO
  32. MSOUPO=IPCHP(IA)
  33. SEGACT MSOUPO
  34. NCBBB=NOCOMP(/2)
  35. IEXT=0
  36. DO 5 IB=1,NCBBB
  37. IF(NOCOMP(IB).EQ.MOTDDL(1)) THEN
  38. IEXT=IA
  39. ITOT=ITOT+1
  40. ENDIF
  41. 5 CONTINUE
  42. 4 CONTINUE
  43. IF(ITOT.NE.1) GO TO 2876
  44. IF(IEXT.EQ.0) GO TO 2876
  45. MSOUPO=IPCHP(IEXT)
  46. IF(NOCOMP(/2).NE.1) GO TO 2876
  47. NSOUPO=NSOUPO-1
  48. NC=IBDDL
  49. NAT=MAX ( JATTRI(/1) , 1)
  50. SEGINI MCHPO1
  51. MCHPO1.MTYPOI=MTYPOI
  52. MCHPO1.MOCHDE=MOCHDE
  53. IF ( JATTRI(/1) .GE. 1 ) THEN
  54. MCHPO1.JATTRI(1) = JATTRI(1)
  55. ELSE
  56. MCHPO1.JATTRI(1) = 0
  57. ENDIF
  58. MCHPO1.IFOPOI=IFOPOI
  59. IBB=0
  60. DO 7 IA=1,IPCHP(/1)
  61. MSOUPO=IPCHP(IA)
  62. IF ( IEXT.EQ.IA) THEN
  63. SEGDES MSOUPO
  64. ELSE
  65. SEGINI,MSOUP1=MSOUPO
  66. IBB=IBB+1
  67. IPT1=IGEOC
  68. SEGACT IPT1
  69. ** SEGINI,MELEME=IPT1
  70. MELEME=IPT1
  71. MPOVAL=IPOVAL
  72. SEGACT MPOVAL
  73. SEGINI,MPOVA1=MPOVAL
  74. MSOUP1.IGEOC=MELEME
  75. MSOUP1.IPOVAL=MPOVA1
  76. SEGDES MPOVA1,MPOVAL,MSOUP1,MSOUPO,MELEME,IPT1
  77. MCHPO1.IPCHP(IBB)=MSOUP1
  78. ENDIF
  79. 7 CONTINUE
  80. IPOIN2 = MCHPO1
  81. SEGDES MCHPO1,MCHPOI
  82. RETURN
  83. ENDIF
  84. 2876 CONTINUE
  85. C
  86. SEGINI MTRA,MTR1,MTR2
  87. C
  88. NC=0
  89. IK=0
  90. MCHPOI=IPOIN1
  91. SEGACT MCHPOI
  92. NSOUPO=IPCHP(/1)
  93. C
  94. C BOUCLE SUR LES SOUS REFERENCES DU CHPOINT
  95. C
  96. DO 350 IA=1,NSOUPO
  97. MSOUPO=IPCHP(IA)
  98. SEGACT MSOUPO
  99. NCBBB=NOCOMP(/2)
  100. MILCO=0
  101. C
  102. DO 330 IB=1,NCBBB
  103. DO 344 MIK=1,IBDDL
  104. IF(NOCOMP(IB).EQ.MOTDDL(MIK)) GO TO 330
  105. 344 CONTINUE
  106. NC=IPCOM(/2)
  107. DO 320 IC=1,NC
  108. IF(IPCOM(IC).NE.NOCOMP(IB)) GO TO 320
  109. IF(IPHAR(IC).EQ.NOHARM(IB)) GO TO 331
  110. 320 CONTINUE
  111. IPCOM(**)=NOCOMP(IB)
  112. IPHAR(**)=NOHARM(IB)
  113. NC=NC+1
  114. 331 MILCO=MILCO+1
  115. 330 CONTINUE
  116. C
  117. IF(MILCO.NE.0) THEN
  118. MELEME=IGEOC
  119. SEGACT MELEME
  120. NBELEM=NUM(/2)
  121. DO 310 IB=1,NBELEM
  122. K=NUM(1,IB)
  123. IF(ICPR(K).NE.0) GO TO 310
  124. IK=IK+1
  125. ICPR(K)=IK
  126. 310 CONTINUE
  127. SEGDES MELEME
  128. ENDIF
  129. SEGDES MSOUPO
  130. 350 CONTINUE
  131. SEGDES MSWMIL
  132. C
  133. NNIN=NC
  134. NNNOE=IK
  135. SEGINI MTRAV
  136. C
  137. C REMPLISSAGE DES TABLEAUX DU SEGMENT MTRAV
  138. C
  139. DO 380 IA=1,NNIN
  140. INCO(IA)=IPCOM(IA)
  141. NHAR(IA)=IPHAR(IA)
  142. 380 CONTINUE
  143. C
  144. DO 430 IA=1,NSOUPO
  145. MSOUPO=IPCHP(IA)
  146. SEGACT MSOUPO
  147. MELEME=IGEOC
  148. SEGACT MELEME
  149. MPOVAL=IPOVAL
  150. SEGACT MPOVAL
  151. NBELEM=NUM(/2)
  152. C
  153. DO 420 IB=1,NOCOMP(/2)
  154. DO 390 IC=1,NNIN
  155. IF(NOCOMP(IB).NE.IPCOM(IC)) GO TO 390
  156. IF(NOHARM(IB).EQ.IPHAR(IC)) GO TO 400
  157. 390 CONTINUE
  158. GO TO 420
  159. 400 CONTINUE
  160. DO 410 ID=1,NBELEM
  161. KI=ICPR(NUM(1,ID))
  162. IF(KI.EQ.0) GO TO 410
  163. IGEO(KI)=NUM(1,ID)
  164. IBIN(IC,KI)=1
  165. BB(IC,KI)=VPOCHA(ID,IB)
  166. 410 CONTINUE
  167. 420 CONTINUE
  168. SEGDES MELEME,MSOUPO,MPOVAL
  169. 430 CONTINUE
  170. C
  171. ITRAV=MTRAV
  172. SEGDES MTRAV
  173. C
  174. CALL CRECHP(ITRAV,IPOIN2)
  175. C ATTRIBUTION D'UNE NATURE A IPOIN2 IDENTIQUE AU CHPO IPOIN1
  176. MCHPO1 = IPOIN2
  177. SEGACT MCHPO1
  178. NAT = MAX ( MCHPO1.JATTRI(/1) , 1)
  179. NSOUPO = MCHPO1.IPCHP(/1)
  180. SEGADJ MCHPO1
  181. IF ( JATTRI(/1) .GE. 1 ) THEN
  182. MCHPO1.JATTRI(1) = JATTRI(1)
  183. ELSE
  184. MCHPO1.JATTRI(1) = 0
  185. ENDIF
  186. SEGDES MCHPOI,MCHPO1
  187. SEGSUP MTRAV,MTRA,MTR1,MTR2
  188. RETURN
  189. END
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  

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