Télécharger la plaquette Cast3M


fr en

Télécharger g3glkk.eso

Retour à la liste

Numérotation des lignes : 

g3glkk

  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