Télécharger g2glkk.eso

Retour à la liste

Numérotation des lignes :

  1. C G2GLKK SOURCE CHAT 06/03/29 21:21:39 5360
  2. C
  3. C
  4. SUBROUTINE G2GLKK(ICOIN,KCOIN,NBLIG,NBCOL,
  5. > ITRNOE,NBNMAX,iarr)
  6. C **********************************************************************
  7. C OBJET G2GLKK : COLLAGE D'UN COIN D'UN MAILLAGE GRILLE 2D
  8. C
  9. C EN ENTREE :
  10. C ICOIN, KCOIN : INDICE DU COIN ET NOMBRE D'ELEMENTS A ENLEVER
  11. C ITRNOE : MAILLAGE GRILLE
  12. C NBNMAX : NOMBRE MAXIMUM DE NOEUDS PAR MAILLES
  13. C NBLIG, NBCOL : NOMBRE DE LIGNES ET DE COLONNES DE LA GRILLE
  14. C
  15. C EN SORTIE :
  16. C ITRNOE : MAILLAGE GRILLE MODIFIE
  17. C iarr : CODE D'ERREUR (INUTILISE)
  18. C
  19. C REMARQUE : ATTENTION LE MAILLAGE RESULTANT GARDE UNE STRUCTURE
  20. C DE GRILLE (NBLIG,NBCOL). CELA SIGNIFIE QU'IL Y A DES
  21. C ELEMENTS "NULS" (TOUS LEURS NOEUDS SONT A "0").
  22. C **********************************************************************
  23. IMPLICIT INTEGER(I-N)
  24. INTEGER ICOIN,KCOIN,NBLIG,NBCOL,NBNMAX
  25. INTEGER ITRNOE(*),iarr
  26. C
  27. INTEGER I,J,K,IE,IN,INNEW
  28. C
  29. GOTO( 5,50,100,150 ) ICOIN
  30. 1 iarr = 0
  31. GOTO 999
  32. C =========
  33. C --- COIN K1 ---
  34. C =========
  35. 5 I = NBCOL - KCOIN
  36. INNEW = NBCOL+1
  37. C PRINT *,'COLONNE'
  38. DO 10 J=1,KCOIN
  39. K = (J-1)*(NBCOL+1)+I
  40. IE = K-J+1
  41. C INNEW = J*NBCOL+1
  42. C PRINT *,'NOEUD =',K+1,'ELEM =',IE,
  43. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),
  44. C > 'NOUVEAU NOEUD = ',INNEW
  45. ITRNOE((IE-1)*NBNMAX+2) = INNEW
  46. INNEW = INNEW + NBCOL
  47. C PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,
  48. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),
  49. C > 'NOUVEAU NOEUD = ',INNEW
  50. ITRNOE((IE-1)*NBNMAX+3) = INNEW
  51. 10 CONTINUE
  52. J = KCOIN +1
  53. INNEW = (KCOIN+1)*NBCOL+1
  54. C PRINT *,'LIGNE'
  55. DO 20 I=(NBCOL +1- KCOIN),NBCOL
  56. K = (J-1)*(NBCOL+1)+I
  57. IE = K-J+1
  58. IN = K
  59. C INNEW = (NBCOL-I+2)*NBCOL+1
  60. C PRINT *,'NOEUD =',K,'ELEM =',IE,
  61. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),
  62. C > 'NOUVEAU NOEUD = ',INNEW
  63. ITRNOE((IE-1)*NBNMAX+1) = INNEW
  64. C IN = IN+NBCOL+1
  65. INNEW = INNEW - NBCOL
  66. C PRINT *,'NOEUD =',K+1,'ELEM =',IE,
  67. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),
  68. C > 'NOUVEAU NOEUD = ',INNEW
  69. ITRNOE((IE-1)*NBNMAX+2) = INNEW
  70. 20 CONTINUE
  71. C --- DESTRUCTION ---
  72. DO 40 I=(NBCOL-KCOIN+1),NBCOL
  73. DO 35 J=1,KCOIN
  74. IE = (J-1)*NBCOL+I
  75. DO 30 K=1,NBNMAX
  76. ITRNOE((IE-1)*NBNMAX+K) = 0
  77. 30 CONTINUE
  78. 35 CONTINUE
  79. 40 CONTINUE
  80. GOTO 999
  81. C =========
  82. C --- COIN K2 ---
  83. C =========
  84. 50 I = NBCOL - KCOIN
  85. INNEW = (NBLIG+1-KCOIN)*(NBCOL+2)-NBLIG-1
  86. C PRINT *,'COLONNE'
  87. DO 60 J=(NBLIG+1-KCOIN),NBLIG
  88. K = (J-1)*(NBCOL+1)+I
  89. IE = K-J+1
  90. C INNEW = (I-NBCOL+NBLIG)*(NBCOL+2)-1-NBLIG
  91. C INNEW = J*(NBCOL+2)-NBLIG-1
  92. C PRINT *,'NOEUD =',K+1,'ELEM =',IE,
  93. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),
  94. C > 'NOUVEAU NOEUD = ',INNEW
  95. ITRNOE((IE-1)*NBNMAX+2) = INNEW
  96. INNEW = INNEW + NBCOL + 2
  97. C PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,
  98. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),
  99. C > 'NOUVEAU NOEUD = ',INNEW
  100. ITRNOE((IE-1)*NBNMAX+3) = INNEW
  101. 60 CONTINUE
  102. J = NBLIG - KCOIN
  103. INNEW = (NBLIG+1-KCOIN)*(NBCOL+2)-1-NBLIG
  104. C PRINT *,'LIGNE'
  105. DO 70 I=(NBCOL +1- KCOIN),NBCOL
  106. K = (J-1)*(NBCOL+1)+I
  107. IE = K-J+1
  108. IN = K
  109. C INNEW = (NBLIG-KCOIN)*NBCOL+I-1
  110. C INNEW = (I-NBCOL+NBLIG)*(NBCOL+2)-1-NBLIG
  111. C PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,
  112. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),
  113. C > 'NOUVEAU NOEUD = ',INNEW
  114. ITRNOE((IE-1)*NBNMAX+4) = INNEW
  115. C IN = IN+NBCOL+1
  116. INNEW = INNEW + NBCOL + 2
  117. C PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,
  118. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),
  119. C > 'NOUVEAU NOEUD = ',INNEW
  120. ITRNOE((IE-1)*NBNMAX+3) = INNEW
  121. 70 CONTINUE
  122. C --- DESTRUCTION ---
  123. DO 90 I=(NBCOL-KCOIN+1),NBCOL
  124. DO 85 J=(NBLIG-KCOIN+1),NBLIG
  125. IE = (J-1)*NBCOL+I
  126. DO 80 K=1,NBNMAX
  127. ITRNOE((IE-1)*NBNMAX+K) = 0
  128. 80 CONTINUE
  129. 85 CONTINUE
  130. 90 CONTINUE
  131. GOTO 999
  132. C =========
  133. C --- COIN K3 ---
  134. C =========
  135. 100 I = KCOIN+1
  136. C PRINT *,'COLONNE'
  137. INNEW = (NBLIG-KCOIN)*(NBCOL+1)+KCOIN+1
  138. DO 110 J=(NBLIG+1-KCOIN),NBLIG
  139. K = (J-1)*(NBCOL+1)+I
  140. IE = K-J+1
  141. C PRINT *,'NOEUD =',K,'ELEM =',IE,
  142. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),
  143. C > 'NOUVEAU NOEUD = ',INNEW
  144. ITRNOE((IE-1)*NBNMAX+1) = INNEW
  145. INNEW = INNEW + NBCOL
  146. C PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,
  147. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),
  148. C > 'NOUVEAU NOEUD = ',INNEW
  149. ITRNOE((IE-1)*NBNMAX+4) = INNEW
  150. 110 CONTINUE
  151. J = NBLIG - KCOIN
  152. C PRINT *,'LIGNE'
  153. INNEW = NBLIG*(NBCOL+1)+1
  154. DO 120 I=1,KCOIN
  155. K = (J-1)*(NBCOL+1)+I
  156. IE = K-J+1
  157. IN = K
  158. C INNEW = (NBLIG-KCOIN)*NBCOL+I-1
  159. C PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,
  160. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),
  161. C > 'NOUVEAU NOEUD = ',INNEW
  162. ITRNOE((IE-1)*NBNMAX+4) = INNEW
  163. C IN = IN+NBCOL+1
  164. INNEW = INNEW - NBCOL
  165. C PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,
  166. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),
  167. C > 'NOUVEAU NOEUD = ',INNEW
  168. ITRNOE((IE-1)*NBNMAX+3) = INNEW
  169. 120 CONTINUE
  170. C --- DESTRUCTION ---
  171. DO 140 I=1,KCOIN
  172. DO 135 J=(NBLIG-KCOIN+1),NBLIG
  173. IE = (J-1)*NBCOL+I
  174. DO 130 K=1,NBNMAX
  175. ITRNOE((IE-1)*NBNMAX+K) = 0
  176. 130 CONTINUE
  177. 135 CONTINUE
  178. 140 CONTINUE
  179. GOTO 999
  180. C =========
  181. C --- COIN K4 ---
  182. C =========
  183. 150 I = KCOIN +1
  184. INNEW = 1
  185. DO 160 J=1,KCOIN
  186. K = (J-1)*(NBCOL+1)+I
  187. IE = K-J+1
  188. C INNEW = (J-1)*(NBCOL+2)+1
  189. C PRINT *,'NOEUD =',K,'ELEM =',IE,
  190. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),
  191. C > 'NOUVEAU NOEUD = ',INNEW
  192. ITRNOE((IE-1)*NBNMAX+1) = INNEW
  193. INNEW = INNEW + NBCOL + 2
  194. C PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,
  195. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),
  196. C > 'NOUVEAU NOEUD = ',INNEW
  197. ITRNOE((IE-1)*NBNMAX+4) = INNEW
  198. 160 CONTINUE
  199. J = KCOIN +1
  200. INNEW = 1
  201. DO 170 I=1,KCOIN
  202. K = (J-1)*(NBCOL+1)+I
  203. IE = K-J+1
  204. IN = K
  205. C INNEW = (I-1)*(NBCOL+2)+1
  206. C PRINT *,'NOEUD =',K,'ELEM =',IE,
  207. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),
  208. C > 'NOUVEAU NOEUD = ',INNEW
  209. ITRNOE((IE-1)*NBNMAX+1) = INNEW
  210. C IN = IN+NBCOL+1
  211. INNEW = INNEW + NBCOL + 2
  212. C PRINT *,'NOEUD =',K+1,'ELEM =',IE,
  213. C > 'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),
  214. C > 'NOUVEAU NOEUD = ',INNEW
  215. ITRNOE((IE-1)*NBNMAX+2) = INNEW
  216. 170 CONTINUE
  217. C --- DESTRUCTION ---
  218. DO 200 I=1,KCOIN
  219. DO 190 J=1,KCOIN
  220. IE = (J-1)*NBCOL+I
  221. DO 180 K=1,NBNMAX
  222. ITRNOE((IE-1)*NBNMAX+K) = 0
  223. 180 CONTINUE
  224. 190 CONTINUE
  225. 200 CONTINUE
  226. GOTO 999
  227. C
  228. 999 END
  229.  
  230.  
  231.  
  232.  

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