Télécharger pos.eso

Retour à la liste

Numérotation des lignes :

  1. C POS SOURCE CHAT 05/01/13 02:18:05 5004
  2. C
  3. C CETTE PROCEDURE RENVOIE IND=1 SI LES EXTREMITES D'UN COTE DE LA
  4. C FACE (POINTEE PAR IPT1) SONT EGALES A I1I2 ET ORIENTE LA FACE
  5. C POUR QUE SON COTE 1 SOIT I1I2; ELLE RENVOIE IND=0 SINON.
  6. C
  7. SUBROUTINE POS(IPT1,I1,I2,IND)
  8. IMPLICIT INTEGER(I-N)
  9. -INC SMELEME
  10. -INC CCOPTIO
  11. C
  12. IND=0
  13. CALL COIN(IPT1,IP1,IP2,IP3,IP4,N1,N2)
  14. IF ((IP1.EQ.I1).AND.(IP2.EQ.I2)) IND=1
  15. IF ((IP2.EQ.I1).AND.(IP1.EQ.I2)) IND=2
  16. IF ((IP4.EQ.I1).AND.(IP3.EQ.I2)) IND=3
  17. IF ((IP3.EQ.I1).AND.(IP4.EQ.I2)) IND=4
  18. IF ((IP2.EQ.I1).AND.(IP3.EQ.I2)) IND=5
  19. IF ((IP3.EQ.I1).AND.(IP2.EQ.I2)) IND=6
  20. IF ((IP1.EQ.I1).AND.(IP4.EQ.I2)) IND=7
  21. IF ((IP4.EQ.I1).AND.(IP1.EQ.I2)) IND=8
  22. 10 IF ((IND.EQ.0).OR.(IND.EQ.1)) RETURN
  23. C
  24. C CREATION DU POINTEUR IPT2
  25. NBSOUS=0
  26. NBREF=IPT1.LISREF(/1)
  27. NBNN=IPT1.NUM(/1)
  28. NBELEM=N1*N2
  29. SEGINI IPT2
  30. IPT2.ITYPEL=IPT1.ITYPEL
  31. C
  32. IF (IND.EQ.2) GOTO 20
  33. IF (IND.EQ.3) GOTO 30
  34. IF (IND.EQ.4) GOTO 40
  35. GOTO 50
  36. C
  37. C RETOURNER LA FACE : <-->
  38. 20 N3=NBNN*5/4+2
  39. DO 25 I=1,N2
  40. DO 25 J=1,N1
  41. DO 25 K=1,NBNN
  42. K1=MOD(N3-K,NBNN)
  43. IF (K1.EQ.0) K1=NBNN
  44. IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,I*N1+1-J)
  45. 25 CONTINUE
  46. IPT3=IPT1.LISREF(1)
  47. IPT4=IPT1.LISREF(2)
  48. SEGACT IPT3,IPT4
  49. CALL INVERS(IPT3,IPT5)
  50. CALL INVERS(IPT4,IPT6)
  51. IPT2.LISREF(1)=IPT5
  52. IPT2.LISREF(4)=IPT6
  53. SEGDES IPT3,IPT4,IPT5,IPT6
  54. IPT3=IPT1.LISREF(3)
  55. IPT4=IPT1.LISREF(4)
  56. SEGACT IPT3,IPT4
  57. CALL INVERS(IPT3,IPT5)
  58. CALL INVERS(IPT4,IPT6)
  59. IPT2.LISREF(3)=IPT5
  60. IPT2.LISREF(2)=IPT6
  61. SEGDES IPT3,IPT4,IPT5,IPT6
  62. SEGDES IPT1
  63. IPT1=IPT2
  64. RETURN
  65. C
  66. C RETOURNER LA FACE : ^
  67. 30 N3=NBNN*3/4+2
  68. DO 35 I=1,N2
  69. DO 35 J=1,N1
  70. DO 35 K=1,NBNN
  71. K1=MOD(N3-K,NBNN)
  72. IF (K1.EQ.0) K1=NBNN
  73. IPT2.NUM(K,(I-1)*N1+J)=IPT1.NUM(K1,(N2-I)*N1+J)
  74. 35 CONTINUE
  75. IPT3=IPT1.LISREF(1)
  76. IPT4=IPT1.LISREF(2)
  77. SEGACT IPT3,IPT4
  78. CALL INVERS(IPT3,IPT5)
  79. CALL INVERS(IPT4,IPT6)
  80. IPT2.LISREF(3)=IPT5
  81. IPT2.LISREF(2)=IPT6
  82. SEGDES IPT3,IPT4,IPT5,IPT6
  83. IPT3=IPT1.LISREF(3)
  84. IPT4=IPT1.LISREF(4)
  85. SEGACT IPT3,IPT4
  86. CALL INVERS(IPT3,IPT5)
  87. CALL INVERS(IPT4,IPT6)
  88. IPT2.LISREF(1)=IPT5
  89. IPT2.LISREF(4)=IPT6
  90. SEGDES IPT3,IPT4,IPT5,IPT6
  91. SEGDES IPT1
  92. IPT1=IPT2
  93. RETURN
  94. C
  95. C RETOURNER LA FACE : X
  96. 40 N3=NBNN/2
  97. DO 45 I=1,NBELEM
  98. DO 45 K=1,NBNN
  99. K1=MOD(K+N3,NBNN)
  100. IF (K1.EQ.0) K1=NBNN
  101. IPT2.NUM(K,I)=IPT1.NUM(K1,NBELEM+1-I)
  102. 45 CONTINUE
  103. IPT2.LISREF(1)=IPT1.LISREF(3)
  104. IPT2.LISREF(2)=IPT1.LISREF(4)
  105. IPT2.LISREF(3)=IPT1.LISREF(1)
  106. IPT2.LISREF(4)=IPT1.LISREF(2)
  107. SEGDES IPT1
  108. IPT1=IPT2
  109. RETURN
  110. C
  111. C RETOURNER LA FACE : <-'
  112. 50 N3=NBNN/4
  113. DO 55 I=1,N1
  114. DO 55 J=1,N2
  115. DO 55 K=1,NBNN
  116. K1=MOD(K+N3,NBNN)
  117. IF (K1.EQ.0) K1=NBNN
  118. IPT2.NUM(K,(I-1)*N2+J)=IPT1.NUM(K1,J*N1-I+1)
  119. 55 CONTINUE
  120. IPT2.LISREF(1)=IPT1.LISREF(2)
  121. IPT2.LISREF(2)=IPT1.LISREF(3)
  122. IPT2.LISREF(3)=IPT1.LISREF(4)
  123. IPT2.LISREF(4)=IPT1.LISREF(1)
  124. SEGDES IPT1
  125. IPT1=IPT2
  126. IND=IND-4
  127. N3=N1
  128. N1=N2
  129. N2=N3
  130. GOTO 10
  131. END
  132.  
  133.  

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