Télécharger la plaquette Cast3M


fr en

Télécharger g2glkk.eso

Retour à la liste

Numérotation des lignes : 

g2glkk

  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