Télécharger dedu1.eso

Retour à la liste

Numérotation des lignes :

  1. C DEDU1 SOURCE CHAT 05/01/12 22:39:40 5004
  2. C DEDU1
  3. C
  4. C IDENTIFIE LE CHPOINT MCHPO4 PERMETTANT DE PASSER D'UNE GEOMETRIE
  5. C IPT1 A UNE SECONDE IPT2 ET POINTE LES NOEUDS DE IPT1 DANS ICP1
  6. C ITABEL ET INOUVEL ENREGISTRENT LA CORRESPONDANCE POUR LES MELEME
  7. C FINALEMENT, MCHPO4 RANGE DANS IPOIN1
  8. C APPELE PAR PROPER, POUR EXECUTION OPTIONS 'TRANS' ET 'ROTA' DE DEDU
  9. C
  10. C 11/97 : KICH
  11. C---------------------------------------------------------------------
  12. SUBROUTINE DEDU1(IPT1,IPT2,ICP1,ITABEL,INOUVEL,IPOIN1)
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8 (A-H,O-Z)
  15. -INC CCOPTIO
  16. -INC SMCOORD
  17. -INC SMELEME
  18. -INC SMCHPOI
  19. SEGMENT ICP1(XCOOR(/1)/(IDIM+1))
  20. SEGMENT ITABEL(0)
  21. SEGMENT INOUVEL(0)
  22.  
  23. SEGINI ITABEL,INOUVEL
  24. SEGINI ICP1
  25. SEGDES ICP1
  26. SEGACT IPT1,IPT2
  27. NBSOUS1 = IPT1.LISOUS(/1)
  28. NBSOUS2 = IPT2.LISOUS(/1)
  29. NBREF1 = IPT1.LISREF(/1)
  30. NBREF2 = IPT2.LISREF(/1)
  31. IF (NBSOUS1.NE.NBSOUS2) GOTO 5397
  32. C pas de verification sur les references. kich
  33. c IF (NBREF1.NE.NBREF2) GOTO 5397
  34. IF (NBSOUS1.EQ.0) THEN
  35. IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 5397
  36. IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 5397
  37. IF (IPT1.NUM(/2).NE.IPT2.NUM(/2)) GOTO 5397
  38. SEGDES IPT1,IPT2
  39. CALL PROCHP(IPT1,IPT2,IPOIN1,ICP1)
  40. IF (IERR.NE.0) GOTO 5397
  41. ITABEL(**) = IPT1
  42. INOUVEL(**) = IPT2
  43. ELSE IF (NBSOUS1.NE.0) THEN
  44. DO 5310 J=1,NBSOUS1
  45. IPT3 = IPT1.LISOUS(J)
  46. IPT4 = IPT2.LISOUS(J)
  47. SEGACT IPT3,IPT4
  48. NBSOUS3 = IPT3.LISOUS(/1)
  49. NBSOUS4 = IPT4.LISOUS(/1)
  50. NBREF3 = IPT3.LISREF(/1)
  51. NBREF4 = IPT4.LISREF(/1)
  52. IF (NBSOUS3.NE.NBSOUS4) GOTO 5396
  53. C pas de verification sur les references. kich
  54. c IF (NBREF3.NE.NBREF4) GOTO 5396
  55. IF (IPT3.ITYPEL.NE.IPT4.ITYPEL) GOTO 5396
  56. IF (IPT3.NUM(/1).NE.IPT4.NUM(/1)) GOTO 5396
  57. IF (IPT3.NUM(/2).NE.IPT4.NUM(/2)) GOTO 5396
  58. SEGDES IPT3,IPT4
  59. CALL PROCHP(IPT3,IPT4,MCHPO4,ICP1)
  60. IF (IERR.NE.0) GOTO 5396
  61. ITABEL(**) = IPT3
  62. INOUVEL(**) = IPT4
  63. IF(J.EQ.1) THEN
  64. IPCHP0 = MCHPO4
  65. ELSE
  66. CALL FUCHPO(IPCHP0,MCHPO4,IPRET)
  67. IPCHP0 = IPRET
  68. ENDIF
  69. IF (IERR.NE.0) GOTO 5396
  70. 5310 CONTINUE
  71. IPOIN1 = IPCHP0
  72. IF ((NBREF1.NE.0).AND.(NBREF1.EQ.NBREF2)) THEN
  73. DO 5317 J=1,NBREF1
  74. DO 5316 K=1,ITABEL(/1)
  75. IF (ITABEL(K).EQ.IPT1.LISREF(J)) GOTO 5317
  76. 5316 CONTINUE
  77. ITABEL(**) = IPT1.LISREF(J)
  78. INOUVEL(**) = IPT2.LISREF(J)
  79. 5317 CONTINUE
  80. ENDIF
  81. SEGDES IPT1,IPT2
  82. ENDIF
  83. SEGDES ICP1,ITABEL,INOUVEL
  84. RETURN
  85.  
  86. 5396 CONTINUE
  87. SEGDES IPT3,IPT4
  88. 5397 CONTINUE
  89. SEGDES IPT1,IPT2
  90. SEGSUP ITABEL,INOUVEL,ICP1
  91. * erreur dans le calcul du CHPOINT, verifier les donnees
  92. CALL ERREUR(878)
  93. RETURN
  94. END
  95.  
  96.  
  97.  
  98.  
  99.  

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