Télécharger g3glkk.eso

Retour à la liste

Numérotation des lignes :

  1. C G3GLKK SOURCE CHAT 06/03/29 21:22:23 5360
  2. C
  3. C
  4. SUBROUTINE G3GLKK(IARETE,KARETE,NBLIG,NBCOL,NBRAN,
  5. > ITRNOE,NBNMAX,iarr)
  6. C **********************************************************************
  7. C OBJET G3GLKK : COLLAGE D'UNE ARETE D'UNE GRILLE 3D
  8. C
  9. C ARETE (K2,K10,K8 OU K7) POUR LE RACCORD DE LA FACE (K4,K7,K12,K8)
  10. C A LA FACE (K2,K6,K10,K5)
  11. C
  12. C EN ENTREE :
  13. C IARETE : NUMERO DE L'ARETE DU BLOC (2,10,8 OU 7)
  14. C KARETE : NOMBRE DE COUCHE D'ELEMENTS A DETRUIRE
  15. C NBLIG,NBCOL,NBRAN : DEFINITION DE LA GRILLE
  16. C ITRNOE : MAILLAGE A MODIFIER
  17. C NBNMAX : NOMBRE MAXIMUM DE NOEUDS PAR MAILLE
  18. C
  19. C EN SORTIE :
  20. C ITRNOE : MAILLAGE MODIFIE.
  21. C LES ELEMENTS DETRUITS ONT TOUS LEURS NOEUDS A 0
  22. C
  23. C **********************************************************************
  24. IMPLICIT INTEGER(I-N)
  25. INTEGER IARETE,KARETE,NBLIG,NBCOL,NBRAN,NBNMAX
  26. INTEGER ITRNOE(*),iarr
  27. C
  28. INTEGER I,I0,J,J0,K,K0,L,IE,P1,P2,P3,P4
  29. C
  30. GOTO( 1,5,1,1,1,1,200,300,1,400 ) IARETE
  31. 1 iarr = 0
  32. GOTO 999
  33. C =========
  34. C --- ARETE K2 ---
  35. C =========
  36. 5 I = NBCOL - KARETE
  37. C PRINT *,'=====ARETE ',IARETE,' ====='
  38. C PRINT *,'---INF---'
  39. DO 15 K=1,KARETE
  40. DO 10 J=1,NBLIG
  41. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  42. C
  43. P1 = (NBCOL+2-K) + (J-1)*(NBCOL+1)+ (K-1)*(NBLIG+1)*(NBCOL+1)
  44. P2 = P1 + (NBCOL+1)
  45. P3 = P1 - 1 + (NBLIG+1)*(NBCOL+1)
  46. P4 = P1 - 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  47. C
  48. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  49. C PRINT *,ITRNOE((IE-1)*NBNMAX+2),ITRNOE((IE-1)*NBNMAX+3),
  50. C > ITRNOE((IE-1)*NBNMAX+6),ITRNOE((IE-1)*NBNMAX+7)
  51. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  52. C
  53. ITRNOE((IE-1)*NBNMAX+2) = P1
  54. ITRNOE((IE-1)*NBNMAX+3) = P2
  55. ITRNOE((IE-1)*NBNMAX+6) = P3
  56. ITRNOE((IE-1)*NBNMAX+7) = P4
  57. 10 CONTINUE
  58. 15 CONTINUE
  59. K = KARETE +1
  60. C PRINT *,'---SUP---'
  61. DO 40 I=NBCOL-KARETE+1,NBCOL
  62. DO 30 J=1,NBLIG
  63. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  64. C
  65. C P1 = (NBCOL+1-KARETE+I) + (J-1)*(NBCOL+1)+
  66. C > (K-I+1)*(NBLIG+1)*(NBCOL+1)
  67. P1 = I + (J-1)*(NBCOL+1)+(NBCOL-I+1)*(NBLIG+1)*(NBCOL+1)
  68. P2 = P1+1 - (NBLIG+1)*(NBCOL+1)
  69. P3 = P1+1 + (NBCOL+1) - (NBLIG+1)*(NBCOL+1)
  70. P4 = P1 + (NBCOL+1)
  71. C
  72. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  73. C PRINT *,ITRNOE((IE-1)*NBNMAX+1),ITRNOE((IE-1)*NBNMAX+2),
  74. C > ITRNOE((IE-1)*NBNMAX+3),ITRNOE((IE-1)*NBNMAX+4)
  75. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  76. C
  77. ITRNOE((IE-1)*NBNMAX+1) = P1
  78. ITRNOE((IE-1)*NBNMAX+2) = P2
  79. ITRNOE((IE-1)*NBNMAX+3) = P3
  80. ITRNOE((IE-1)*NBNMAX+4) = P4
  81. 30 CONTINUE
  82. 40 CONTINUE
  83. C
  84. C --- DESTRUCTION ---
  85. C
  86. DO 80 K=1,KARETE
  87. DO 70 I=(NBCOL-KARETE+1),NBCOL
  88. DO 60 J=1,NBLIG
  89. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  90. DO 50 L=1,NBNMAX
  91. ITRNOE((IE-1)*NBNMAX+L) = 0
  92. 50 CONTINUE
  93. 60 CONTINUE
  94. 70 CONTINUE
  95. 80 CONTINUE
  96. GOTO 999
  97. C =========
  98. C --- ARETE K7 ---
  99. C =========
  100. C ...
  101. 200 I = KARETE+1
  102. C PRINT *,'=====ARETE ',IARETE,' ====='
  103. C PRINT *,'---DROIT---'
  104. J0 = NBLIG-KARETE
  105. DO 215 K=1,NBRAN
  106. DO 210 J=1,KARETE
  107. IE = I + (J+J0-1)*NBCOL + (K-1)*NBLIG*NBCOL
  108. C
  109. P1 = KARETE+2-J +(J+J0-1)*(NBCOL+1) +(K-1)*(NBLIG+1)*(NBCOL+1)
  110. P2 = P1 - 1 + (NBCOL+1)
  111. P3 = P1 + (NBLIG+1)*(NBCOL+1)
  112. P4 = P1 - 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  113. C
  114. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  115. C PRINT *,ITRNOE((IE-1)*NBNMAX+1),ITRNOE((IE-1)*NBNMAX+4),
  116. C > ITRNOE((IE-1)*NBNMAX+5),ITRNOE((IE-1)*NBNMAX+8)
  117. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  118. C
  119. ITRNOE((IE-1)*NBNMAX+1) = P1
  120. ITRNOE((IE-1)*NBNMAX+4) = P2
  121. ITRNOE((IE-1)*NBNMAX+5) = P3
  122. ITRNOE((IE-1)*NBNMAX+8) = P4
  123. 210 CONTINUE
  124. 215 CONTINUE
  125. J = NBLIG - KARETE
  126. C PRINT *,'---GAUCH---'
  127. DO 240 I=1,KARETE
  128. DO 230 K=1,NBRAN
  129. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  130. C
  131. P1 = I + (NBLIG-I+1)*(NBCOL+1) + (K-1)*(NBLIG+1)*(NBCOL+1)
  132. P2 = P1 + 1 - (NBCOL+1)
  133. P3 = P1 + (NBLIG+1)*(NBCOL+1)
  134. P4 = P1 + 1 - (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  135. C
  136. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  137. C PRINT *,ITRNOE((IE-1)*NBNMAX+4),ITRNOE((IE-1)*NBNMAX+3),
  138. C > ITRNOE((IE-1)*NBNMAX+8),ITRNOE((IE-1)*NBNMAX+7)
  139. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  140. C
  141. ITRNOE((IE-1)*NBNMAX+4) = P1
  142. ITRNOE((IE-1)*NBNMAX+3) = P2
  143. ITRNOE((IE-1)*NBNMAX+8) = P3
  144. ITRNOE((IE-1)*NBNMAX+7) = P4
  145. 230 CONTINUE
  146. 240 CONTINUE
  147. C
  148. C --- DESTRUCTION ---
  149. C
  150. DO 280 K=1,NBRAN
  151. DO 270 I=1,KARETE
  152. DO 260 J=NBLIG-KARETE+1,NBLIG
  153. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  154. DO 250 L=1,NBNMAX
  155. ITRNOE((IE-1)*NBNMAX+L) = 0
  156. 250 CONTINUE
  157. 260 CONTINUE
  158. 270 CONTINUE
  159. 280 CONTINUE
  160. GOTO 999
  161. C
  162. C =========
  163. C --- ARETE K8 ---
  164. C =========
  165. C ...
  166. 300 I = KARETE+1
  167. C PRINT *,'=====ARETE ',IARETE,' ====='
  168. C PRINT *,'---DROIT---'
  169. DO 315 K=1,NBRAN
  170. DO 310 J=1,KARETE
  171. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  172. C
  173. P1 = J + (J-1)*(NBCOL+1) + (K-1)*(NBLIG+1)*(NBCOL+1)
  174. P2 = P1 + 1 + (NBCOL+1)
  175. P3 = P1 + (NBLIG+1)*(NBCOL+1)
  176. P4 = P1 + 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  177. C
  178. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  179. C PRINT *,ITRNOE((IE-1)*NBNMAX+1),ITRNOE((IE-1)*NBNMAX+4),
  180. C > ITRNOE((IE-1)*NBNMAX+5),ITRNOE((IE-1)*NBNMAX+8)
  181. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  182. C
  183. ITRNOE((IE-1)*NBNMAX+1) = P1
  184. ITRNOE((IE-1)*NBNMAX+4) = P2
  185. ITRNOE((IE-1)*NBNMAX+5) = P3
  186. ITRNOE((IE-1)*NBNMAX+8) = P4
  187. 310 CONTINUE
  188. 315 CONTINUE
  189. J = KARETE + 1
  190. C PRINT *,'---GAUCH---'
  191. DO 340 I=1,KARETE
  192. DO 330 K=1,NBRAN
  193. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  194. C
  195. P1 = I + (I-1)*(NBCOL+1) + (K-1)*(NBLIG+1)*(NBCOL+1)
  196. P2 = P1 + 1 + (NBCOL+1)
  197. P3 = P1 + (NBLIG+1)*(NBCOL+1)
  198. P4 = P1 + 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  199. C
  200. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  201. C PRINT *,ITRNOE((IE-1)*NBNMAX+1),ITRNOE((IE-1)*NBNMAX+2),
  202. C > ITRNOE((IE-1)*NBNMAX+5),ITRNOE((IE-1)*NBNMAX+6)
  203. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  204. C
  205. ITRNOE((IE-1)*NBNMAX+1) = P1
  206. ITRNOE((IE-1)*NBNMAX+2) = P2
  207. ITRNOE((IE-1)*NBNMAX+5) = P3
  208. ITRNOE((IE-1)*NBNMAX+6) = P4
  209. 330 CONTINUE
  210. 340 CONTINUE
  211. C
  212. C --- DESTRUCTION ---
  213. C
  214. DO 380 K=1,NBRAN
  215. DO 370 I=1,KARETE
  216. DO 360 J=1,KARETE
  217. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  218. DO 350 L=1,NBNMAX
  219. ITRNOE((IE-1)*NBNMAX+L) = 0
  220. 350 CONTINUE
  221. 360 CONTINUE
  222. 370 CONTINUE
  223. 380 CONTINUE
  224. GOTO 999
  225. C
  226. C ==========
  227. C --- ARETE K10 ---
  228. C ==========
  229. C ...
  230. 400 I = NBCOL - KARETE
  231. C PRINT *,'=====ARETE ',IARETE,' ====='
  232. C PRINT *,'---SUP---'
  233. K0 = NBRAN-KARETE
  234. DO 415 K=1,KARETE
  235. DO 410 J=1,NBLIG
  236. IE = I + (J-1)*NBCOL + (K+K0-1)*NBLIG*NBCOL
  237. C
  238. P1 = (NBCOL-KARETE+K) + (J-1)*(NBCOL+1)+
  239. > (K+K0-1)*(NBLIG+1)*(NBCOL+1)
  240. P2 = P1 + (NBCOL+1)
  241. P3 = P1 + 1 + (NBLIG+1)*(NBCOL+1)
  242. P4 = P1 + 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  243. C
  244. C P1 = (NBCOL+2-K) + (J-1)*(NBCOL+1)+ (K-1)*(NBLIG+1)*(NBCOL+1)
  245. C P2 = P1 + (NBCOL+1)
  246. C P3 = P1 - 1 + (NBLIG+1)*(NBCOL+1)
  247. C P4 = P1 - 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  248. C
  249. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  250. C PRINT *,ITRNOE((IE-1)*NBNMAX+2),ITRNOE((IE-1)*NBNMAX+3),
  251. C > ITRNOE((IE-1)*NBNMAX+6),ITRNOE((IE-1)*NBNMAX+7)
  252. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  253. C
  254. ITRNOE((IE-1)*NBNMAX+2) = P1
  255. ITRNOE((IE-1)*NBNMAX+3) = P2
  256. ITRNOE((IE-1)*NBNMAX+6) = P3
  257. ITRNOE((IE-1)*NBNMAX+7) = P4
  258. 410 CONTINUE
  259. 415 CONTINUE
  260. K = NBRAN - KARETE
  261. C PRINT *,'---INF---'
  262. I0 = NBCOL-KARETE
  263. DO 440 I=1,KARETE
  264. DO 430 J=1,NBLIG
  265. IE = I+I0 + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  266. C
  267. P1 = I+I0 + (J-1)*(NBCOL+1)+(K+I-1)*(NBLIG+1)*(NBCOL+1)
  268. P2 = P1 + (NBCOL+1)
  269. P3 = P1 + 1 + (NBLIG+1)*(NBCOL+1)
  270. P4 = P1 + 1 + (NBCOL+1) + (NBLIG+1)*(NBCOL+1)
  271. C
  272. C P1 = I + (J-1)*(NBCOL+1)+(NBCOL-I+1)*(NBLIG+1)*(NBCOL+1)
  273. C P2 = P1+1 - (NBLIG+1)*(NBCOL+1)
  274. C P3 = P1+1 + (NBCOL+1) - (NBLIG+1)*(NBCOL+1)
  275. C P4 = P1 + (NBCOL+1)
  276. C
  277. C PRINT *,'IE =',IE,' ANCIEN POINTS = '
  278. C PRINT *,ITRNOE((IE-1)*NBNMAX+5),ITRNOE((IE-1)*NBNMAX+8),
  279. C > ITRNOE((IE-1)*NBNMAX+6),ITRNOE((IE-1)*NBNMAX+7)
  280. C PRINT *,' NOUVEAUX POINTS = ',P1,P2,P3,P4
  281. C
  282. ITRNOE((IE-1)*NBNMAX+5) = P1
  283. ITRNOE((IE-1)*NBNMAX+8) = P2
  284. ITRNOE((IE-1)*NBNMAX+6) = P3
  285. ITRNOE((IE-1)*NBNMAX+7) = P4
  286. 430 CONTINUE
  287. 440 CONTINUE
  288. C
  289. C --- DESTRUCTION ---
  290. C
  291. DO 480 K=(NBRAN-KARETE+1),NBRAN
  292. DO 470 I=(NBCOL-KARETE+1),NBCOL
  293. DO 460 J=1,NBLIG
  294. IE = I + (J-1)*NBCOL + (K-1)*NBLIG*NBCOL
  295. DO 450 L=1,NBNMAX
  296. ITRNOE((IE-1)*NBNMAX+L) = 0
  297. 450 CONTINUE
  298. 460 CONTINUE
  299. 470 CONTINUE
  300. 480 CONTINUE
  301. GOTO 999
  302. C
  303. C
  304. 999 END
  305.  
  306.  
  307.  
  308.  

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