Télécharger pave.eso

Retour à la liste

Numérotation des lignes :

  1. C PAVE SOURCE BP208322 16/11/18 21:19:49 9177
  2. C PROCEDURE UTILISEE PAR PRPAVE POUR LE MAILLAGE DE CUBES.
  3. C
  4. SUBROUTINE PAVE(NX,NY,NZ,IPT1,IPT2,IPT3,IPT4,IPT5,IPT6)
  5. IMPLICIT INTEGER(I-N)
  6. -INC SMELEME
  7. -INC CCOPTIO
  8. -INC SMCOORD
  9. -INC CCGEOME
  10. IF (ILCOUR.NE.14.AND.ILCOUR.NE.15) CALL ERREUR(16)
  11. IF (IERR.NE.0) RETURN
  12. NBSOUS=0
  13. NBREF=6
  14. NBNN=8
  15. NBC=NX*NY
  16. NBELEM=NBC*NZ
  17. SEGINI IPT7
  18. IPT7.ITYPEL=14
  19. C
  20. NN1=IPT1.NUM(/1)/4
  21. NN2=IPT2.NUM(/1)/4
  22. NN3=IPT3.NUM(/1)/4
  23. NN4=IPT4.NUM(/1)/4
  24. NN5=IPT5.NUM(/1)/4
  25. NN6=IPT6.NUM(/1)/4
  26. I1=IPT1.NUM(1,1)
  27. I2=IPT4.NUM(1,1)
  28. I3=IPT6.NUM(NN6+1,NX)
  29. I4=IPT6.NUM(1,1)
  30. I5=IPT2.NUM(1,1)
  31. I6=IPT2.NUM(NN2+1,NX)
  32. I7=IPT2.NUM(2*NN2+1,NBC)
  33. I8=IPT3.NUM(2*NN3+1,NY*NZ)
  34. C
  35. C NUMEROTATION FACE 1
  36. C
  37. IPT7.NUM(1,1)=I1
  38. IF(NX.EQ.1) GOTO 15
  39. C
  40. DO 10 I=2,NX
  41. IPT7.NUM(1,I)=IPT1.NUM(1,I)
  42. IPT7.NUM(2,I-1)=IPT1.NUM(NN1+1,I-1)
  43. 10 CONTINUE
  44. 15 IPT7.NUM(2,NX)=I2
  45. IF(NY.EQ.1) GOTO 35
  46. C
  47. DO 30 N=2,NY
  48. IPT7.NUM(4,(N-2)*NX+1)=IPT1.NUM(3*NN1+1,(N-2)*NX+1)
  49. IPT7.NUM(1,(N-1)*NX+1)=IPT1.NUM(1,(N-1)*NX+1)
  50. IF(NX.EQ.1) GOTO 25
  51. C
  52. DO 20 I=2,NX
  53. IPOINT=IPT1.NUM(3*NN1+1,(N-2)*NX+I)
  54. IPT7.NUM(4,(N-2)*NX+I)=IPOINT
  55. IPT7.NUM(3,(N-2)*NX+I-1)=IPOINT
  56. IPT7.NUM(1,(N-1)*NX+I)=IPOINT
  57. IPT7.NUM(2,(N-1)*NX+I-1)=IPOINT
  58. 20 CONTINUE
  59. 25 IPT7.NUM(3,(N-1)*NX)=IPT1.NUM(2*NN1+1,(N-1)*NX)
  60. IPT7.NUM(2,N*NX)=IPT1.NUM(NN1+1,N*NX)
  61. 30 CONTINUE
  62. 35 IPT7.NUM(4,(NY-1)*NX+1)=I4
  63. IF(NX.EQ.1) GOTO 45
  64. C
  65. DO 40 N=2,NX
  66. IPT7.NUM(4,(NY-1)*NX+N)=IPT1.NUM(3*NN1+1,(NY-1)*NX+N)
  67. IPT7.NUM(3,(NY-1)*NX+N-1)=IPT1.NUM(2*NN1+1,(NY-1)*NX+N-1)
  68. 40 CONTINUE
  69. 45 IPT7.NUM(3,NBC)=I3
  70. C
  71. C `COUCHES` INTERMEDIAIRES
  72. C
  73. IF(NZ.EQ.1) GOTO 105
  74. C
  75. NBPTA=XCOOR(/1)/4
  76. NBPTS=NBPTA+(NY-1)*(NX-1)*(NZ-1)
  77. SEGADJ MCOORD
  78. DO 100 J=2,NZ
  79. C
  80. C 1ERE RANGEE
  81. IPT7.NUM(1,(J-1)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1)
  82. IPT7.NUM(5,(J-2)*NBC+1)=IPT5.NUM(1,(J-1)*NX+1)
  83. IF(NX.EQ.1) GOTO 55
  84. C
  85. DO 50 I=2,NX
  86. IPOINT=IPT5.NUM(1,(J-1)*NX+I)
  87. IPT7.NUM(1,(J-1)*NBC+I)=IPOINT
  88. IPT7.NUM(5,(J-2)*NBC+I)=IPOINT
  89. IPT7.NUM(2,(J-1)*NBC+I-1)=IPOINT
  90. IPT7.NUM(6,(J-2)*NBC+I-1)=IPOINT
  91. 50 CONTINUE
  92. 55 IPT7.NUM(2,(J-1)*NBC+NX)=IPT5.NUM(NN5+1,J*NX)
  93. IPT7.NUM(6,(J-2)*NBC+NX)=IPT5.NUM(NN5+1,J*NX)
  94. C
  95. C RANGEES SUIVANTES
  96. IF(NY.EQ.1) GOTO 85
  97. C
  98. DO 80 N=2,NY
  99. IPOINT=IPT3.NUM(1,(J-1)*NY+N)
  100. IPT7.NUM(1,(J-1)*NBC+(N-1)*NX+1)=IPOINT
  101. IPT7.NUM(5,(J-2)*NBC+(N-1)*NX+1)=IPOINT
  102. IPT7.NUM(4,(J-1)*NBC+(N-2)*NX+1)=IPOINT
  103. IPT7.NUM(8,(J-2)*NBC+(N-2)*NX+1)=IPOINT
  104. IF (NX.EQ.1) GOTO 75
  105. C
  106. DO 70 I=2,NX
  107. C
  108. C CREATION DU POINT COURANT
  109. IPL=I-1
  110. JPL=J-1
  111. NPL=N-1
  112. C
  113. DO 60 K=1,4
  114. XINT=(XCOOR(4*(I1-1)+K)*(NX-IPL)*(NZ-JPL)*(NY-NPL)
  115. 1 +XCOOR(4*(I5-1)+K)*(NX-IPL)*JPL*(NY-NPL)
  116. 2 +XCOOR(4*(I2-1)+K)*IPL*(NZ-JPL)*(NY-NPL)
  117. 3 +XCOOR(4*(I6-1)+K)*IPL*JPL*(NY-NPL)
  118. 4 +XCOOR(4*(I3-1)+K)*IPL*(NZ-JPL)*NPL
  119. 5 +XCOOR(4*(I7-1)+K)*IPL*JPL*NPL
  120. 6 +XCOOR(4*(I4-1)+K)*(NX-IPL)*(NZ-JPL)*NPL
  121. 7 +XCOOR(4*(I8-1)+K)*(NX-IPL)*JPL*NPL)/NBELEM
  122. C
  123. IND1=IPT1.NUM(NN1+1,NPL*NX+IPL)
  124. IND2=IPT2.NUM(NN2+1,NPL*NX+IPL)
  125. IND3=IPT3.NUM(NN3+1,JPL*NY+NPL)
  126. IND4=IPT4.NUM(NN4+1,JPL*NY+NPL)
  127. IND5=IPT5.NUM(NN5+1,JPL*NX+IPL)
  128. IND6=IPT6.NUM(NN6+1,JPL*NX+IPL)
  129. COFAC=(XCOOR(4*(IND1-1)+K)*(NZ-JPL)+XCOOR(4*
  130. 1 (IND2-1)+K)*JPL)/NZ+(XCOOR(4*(IND3-1)+K)*(NX-IPL)+
  131. 2 XCOOR(4*(IND4-1)+K)*IPL)/NX+(XCOOR(4*(IND5-1)+K)*
  132. 3 (NY-NPL)+XCOOR(4*(IND6-1)+K)*NPL)/NY
  133. C
  134. I13=IPT3.NUM(NN3+1,NPL)
  135. I14=IPT4.NUM(NN4+1,NPL)
  136. I15=IPT5.NUM(NN5+1,IPL)
  137. I16=IPT6.NUM(NN6+1,IPL)
  138. I23=IPT2.NUM(1,NPL*NX+1)
  139. I24=IPT2.NUM(NN2+1,(NPL+1)*NX)
  140. I25=IPT2.NUM(NN2+1,IPL)
  141. I26=IPT2.NUM(2*NN2+1,(NY-1)*NX+IPL)
  142. I35=IPT3.NUM(1,JPL*NY+1)
  143. I36=IPT3.NUM(NN3+1,(JPL+1)*NY)
  144. I45=IPT4.NUM(1,JPL*NY+1)
  145. I46=IPT4.NUM(NN4+1,(JPL+1)*NY)
  146. COAR=((XCOOR(4*(I35-1)+K)*(NX-IPL)+XCOOR(4*(I45-1)+K)
  147. 1 *IPL)*(NY-NPL)+(XCOOR(4*(I36-1)+K)*(NX-IPL)+
  148. 2 XCOOR(4*(I46-1)+K)*IPL)*NPL)/NBC
  149. COAR=COAR+((XCOOR(4*(I13-1)+K)*(NX-IPL)+XCOOR(4*(I14
  150. 1 -1)+K)*IPL)*(NZ-JPL)+(XCOOR(4*(I23-1)+K)*(NX-IPL)
  151. 2 +XCOOR(4*(I24-1)+K)*IPL)*JPL)/(NX*NZ)
  152. COAR=COAR+((XCOOR(4*(I15-1)+K)*(NY-NPL)+XCOOR(4*(I16
  153. 1 -1)+K)*NPL)*(NZ-JPL)+(XCOOR(4*(I25-1)+K)*(NY-NPL)
  154. 2 +XCOOR(4*(I26-1)+K)*NPL)*JPL)/(NY*NZ)
  155. C
  156. XCOOR(NBPTA*4+K)=XINT+COFAC-COAR
  157. 60 CONTINUE
  158. NBPTA=NBPTA+1
  159. C
  160. IPOINT=NBPTA
  161. IPT7.NUM(1,(N-1)*NX+(J-1)*NBC+I)=IPOINT
  162. IPT7.NUM(5,(N-1)*NX+(J-2)*NBC+I)=IPOINT
  163. IPT7.NUM(2,(N-1)*NX+(J-1)*NBC+I-1)=IPOINT
  164. IPT7.NUM(6,(N-1)*NX+(J-2)*NBC+I-1)=IPOINT
  165. IPT7.NUM(3,(N-2)*NX+(J-1)*NBC+I-1)=IPOINT
  166. IPT7.NUM(7,(N-2)*NX+(J-2)*NBC+I-1)=IPOINT
  167. IPT7.NUM(4,(N-2)*NX+(J-1)*NBC+I)=IPOINT
  168. IPT7.NUM(8,(N-2)*NX+(J-2)*NBC+I)=IPOINT
  169. 70 CONTINUE
  170. 75 IPOINT=IPT4.NUM(1,(J-1)*NY+N)
  171. IPT7.NUM(3,(N-1)*NX+(J-1)*NBC)=IPOINT
  172. IPT7.NUM(2,N*NX+(J-1)*NBC)=IPOINT
  173. IPT7.NUM(7,(N-1)*NX+(J-2)*NBC)=IPOINT
  174. IPT7.NUM(6,N*NX+(J-2)*NBC)=IPOINT
  175. 80 CONTINUE
  176. C
  177. C DERNIERE RANGEE
  178. 85 IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1)
  179. IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+1)=IPT6.NUM(1,(J-1)*NX+1)
  180. IF(NX.EQ.1) GOTO 95
  181. C
  182. DO 90 I=2,NX
  183. IPOINT=IPT6.NUM(1,(J-1)*NX+I)
  184. IPT7.NUM(4,(NY-1)*NX+(J-1)*NBC+I)=IPOINT
  185. IPT7.NUM(8,(NY-1)*NX+(J-2)*NBC+I)=IPOINT
  186. IPT7.NUM(3,(NY-1)*NX+(J-1)*NBC+I-1)=IPOINT
  187. IPT7.NUM(7,(NY-1)*NX+(J-2)*NBC+I-1)=IPOINT
  188. 90 CONTINUE
  189. 95 IPT7.NUM(3,J*NBC)=IPT6.NUM(NN6+1,J*NX)
  190. IPT7.NUM(7,(J-1)*NBC)=IPT6.NUM(NN6+1,J*NX)
  191. 100 CONTINUE
  192. C
  193. C DERNIERE COUCHE = FACE 2
  194. C
  195. 105 IND=NBC*(NZ-1)
  196. IPT7.NUM(5,IND+1)=I5
  197. IF(NX.EQ.1) GOTO 115
  198. C
  199. DO 110 I=2,NX
  200. IPT7.NUM(5,IND+I)=IPT2.NUM(1,I)
  201. IPT7.NUM(6,IND+I-1)=IPT2.NUM(NN2+1,I-1)
  202. 110 CONTINUE
  203. 115 IPT7.NUM(6,NX+IND)=I6
  204. IF(NY.EQ.1) GOTO 135
  205. C
  206. DO 130 N=2,NY
  207. IPT7.NUM(8,IND+(N-2)*NX+1)=IPT2.NUM(3*NN2+1,(N-2)*NX+1)
  208. IPT7.NUM(5,IND+(N-1)*NX+1)=IPT2.NUM(1,(N-1)*NX+1)
  209. IF(NX.EQ.1) GOTO 125
  210. C
  211. DO 120 I=2,NX
  212. IPOINT=IPT2.NUM(3*NN2+1,(N-2)*NX+I)
  213. IPT7.NUM(8,IND+(N-2)*NX+I)=IPOINT
  214. IPT7.NUM(7,IND+(N-2)*NX+I-1)=IPOINT
  215. IPT7.NUM(5,IND+(N-1)*NX+I)=IPOINT
  216. IPT7.NUM(6,IND+(N-1)*NX+I-1)=IPOINT
  217. 120 CONTINUE
  218. 125 IPT7.NUM(7,IND+(N-1)*NX)=IPT2.NUM(2*NN2+1,(N-1)*NX)
  219. IPT7.NUM(6,IND+N*NX)=IPT2.NUM(NN2+1,N*NX)
  220. 130 CONTINUE
  221. 135 IPT7.NUM(8,IND+(NY-1)*NX+1)=I8
  222. IF(NX.EQ.1) GOTO 145
  223. C
  224. DO 140 N=2,NX
  225. IPT7.NUM(8,IND+(NY-1)*NX+N)=IPT2.NUM(3*NN2+1,(NY-1)*NX+N)
  226. IPT7.NUM(7,IND+(NY-1)*NX+N-1)=IPT2.NUM(2*NN2+1,(NY-1)*NX+N-1)
  227. 140 CONTINUE
  228. 145 IPT7.NUM(7,IND+NBC)=I7
  229. C
  230. IPT7.LISREF(1)=IPT1
  231. IPT7.LISREF(2)=IPT2
  232. IPT7.LISREF(3)=IPT3
  233. IPT7.LISREF(4)=IPT4
  234. IPT7.LISREF(5)=IPT5
  235. IPT7.LISREF(6)=IPT6
  236. ITY=ILCOUR
  237. CALL CHANGE(IPT7,ITY)
  238. CALL ECROBJ('MAILLAGE',IPT7)
  239. SEGDES IPT7
  240. RETURN
  241. END
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  

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