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

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