Télécharger ctrle.eso

Retour à la liste

Numérotation des lignes :

  1. C CTRLE SOURCE BP208322 16/11/18 21:16:10 9177
  2. C
  3. C CETTE PROCEDURE EST UTILISEE PAR PRPAVE POUR LE CONTROLE DES
  4. C ARETES DE L'OBJET; ELLE VERIFIE QUE LE COTE I1 DE IPT1 EST LE
  5. C MEME QUE LE COTE I2 DE IPT2 (IL FAUT I1<=I2).
  6. C IL FAUDRAIT TRAVAILLER SUR LES ELEMENTS ET PAS SUR LES REFERENCES
  7. C QUI NE SONT PAS FORCEMENT DANS L'ORDRE
  8. C
  9. SUBROUTINE CTRLE(IPT1,IPT2,I1,I2)
  10. IMPLICIT INTEGER(I-N)
  11. -INC SMELEME
  12. -INC CCOPTIO
  13. -INC CCGEOME
  14. SEGACT IPT1,IPT2
  15. IPT3=IPT1.LISREF(1)
  16. IPT4=IPT1.LISREF(2)
  17. IPT5=IPT2.LISREF(1)
  18. IPT6=IPT2.LISREF(2)
  19. SEGACT IPT3,IPT4,IPT5,IPT6
  20. NEL1X=IPT3.NUM(/2)
  21. NEL1Y=IPT4.NUM(/2)
  22. NEL2X=IPT5.NUM(/2)
  23. NEL2Y=IPT6.NUM(/2)
  24. SEGDES IPT3,IPT4,IPT5,IPT6
  25. NBN=KDEGRE(IPT1.ITYPEL)
  26. IF (KDEGRE(IPT2.ITYPEL).NE.NBN) CALL ERREUR(264)
  27. NEL=NEL1X
  28. IF (I1.EQ.2.OR.I1.EQ.4) NEL=NEL1Y
  29. NEL2=NEL2X
  30. IF (I2.EQ.2.OR.I2.EQ.4) NEL2=NEL2Y
  31. IF (NEL.NE.NEL2) CALL ERREUR(264)
  32. IF (IERR.NE.0) RETURN
  33. IF (((I1.EQ.1).AND.(I2.EQ.3)).OR.((I1.EQ.1).AND.(I2.EQ.4)).OR.
  34. 1 ((I1.EQ.2).AND.(I2.EQ.3)).OR.((I1.EQ.2).AND.(I2.EQ.4))) GOTO 30
  35. DO 20 J=1,NEL
  36. IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J)
  37. IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J)
  38. IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J)
  39. IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X)
  40. IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J)
  41. IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J)
  42. IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J)
  43. IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X)
  44. IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
  45. IF (IERR.NE.0) RETURN
  46. IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,J)
  47. IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*J)
  48. IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J)
  49. IF (I1.EQ.4) ITEST1=IPT1.NUM(1,NEL1X*NEL1Y+1-J*NEL1X)
  50. IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,J)
  51. IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*J)
  52. IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J)
  53. IF (I2.EQ.4) ITEST2=IPT2.NUM(1,NEL2X*NEL2Y+1-J*NEL2X)
  54. IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
  55. IF (IERR.NE.0) RETURN
  56. 20 CONTINUE
  57. SEGDES IPT3,IPT4
  58. RETURN
  59. 30 DO 40 J=1,NEL
  60. IF (I1.EQ.1) ITEST1=IPT1.NUM(1,J)
  61. IF (I1.EQ.2) ITEST1=IPT1.NUM(NBN,NEL1X*J)
  62. IF (I1.EQ.3) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y+1-J)
  63. IF (I1.EQ.4) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*NEL1Y+1-J*NEL1X)
  64. IF (I2.EQ.1) ITEST2=IPT2.NUM(NBN,NEL2X+1-J)
  65. IF (I2.EQ.2) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y-(J-1)*NEL2X)
  66. IF (I2.EQ.3) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*(NEL2Y-1)+J)
  67. IF (I2.EQ.4) ITEST2=IPT2.NUM(1,(J-1)*NEL2X+1)
  68. IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
  69. IF (IERR.NE.0) RETURN
  70. IF (I1.EQ.1) ITEST1=IPT1.NUM(NBN,NEL1X+1-J)
  71. IF (I1.EQ.2) ITEST1=IPT1.NUM(2*NBN-1,NEL1X*NEL1Y-(J-1)*NEL1X)
  72. IF (I1.EQ.3) ITEST1=IPT1.NUM(3*NBN-2,NEL1X*(NEL1Y-1)+J)
  73. IF (I1.EQ.4) ITEST1=IPT1.NUM(1,(J-1)*NEL1X+1)
  74. IF (I2.EQ.1) ITEST2=IPT2.NUM(1,J)
  75. IF (I2.EQ.2) ITEST2=IPT2.NUM(NBN,NEL2X*J)
  76. IF (I2.EQ.3) ITEST2=IPT2.NUM(2*NBN-1,NEL2X*NEL2Y+1-J)
  77. IF (I2.EQ.4) ITEST2=IPT2.NUM(3*NBN-2,NEL2X*NEL2Y+1-J*NEL2X)
  78. IF (ITEST1.NE.ITEST2) CALL ERREUR(264)
  79. IF (IERR.NE.0) RETURN
  80. 40 CONTINUE
  81. SEGDES IPT3,IPT4
  82. RETURN
  83. END
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  

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