Numérotation des lignes :

C G2GLKK    SOURCE    CHAT      06/03/29    21:21:39     5360CC      SUBROUTINE G2GLKK(ICOIN,KCOIN,NBLIG,NBCOL,     >                       ITRNOE,NBNMAX,iarr)C     **********************************************************************C     OBJET G2GLKK : COLLAGE D'UN COIN D'UN MAILLAGE GRILLE 2DCC     EN ENTREE   :C       ICOIN, KCOIN : INDICE DU COIN ET NOMBRE D'ELEMENTS A ENLEVERC       ITRNOE       : MAILLAGE GRILLEC       NBNMAX       : NOMBRE MAXIMUM DE NOEUDS PAR MAILLESC       NBLIG, NBCOL : NOMBRE DE LIGNES ET DE COLONNES DE LA GRILLECC     EN SORTIE   :C       ITRNOE       : MAILLAGE GRILLE MODIFIEC       iarr         : CODE D'ERREUR (INUTILISE)CC     REMARQUE : ATTENTION LE MAILLAGE RESULTANT GARDE UNE STRUCTUREC                DE GRILLE (NBLIG,NBCOL). CELA SIGNIFIE QU'IL Y A DESC                ELEMENTS "NULS" (TOUS LEURS NOEUDS SONT A "0").C     **********************************************************************      IMPLICIT INTEGER(I-N)      INTEGER ICOIN,KCOIN,NBLIG,NBCOL,NBNMAX      INTEGER ITRNOE(*),iarrC      INTEGER I,J,K,IE,IN,INNEWC      GOTO( 5,50,100,150 ) ICOIN   1  iarr = 0      GOTO 999C        =========C     --- COIN K1 ---C        =========    5 I = NBCOL - KCOIN      INNEW = NBCOL+1C      PRINT *,'COLONNE'      DO 10 J=1,KCOIN        K = (J-1)*(NBCOL+1)+I        IE = K-J+1C        INNEW = J*NBCOL+1C        PRINT *,'NOEUD =',K+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+2) = INNEW        INNEW = INNEW + NBCOLC        PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+3) = INNEW   10 CONTINUE      J = KCOIN +1      INNEW = (KCOIN+1)*NBCOL+1C      PRINT *,'LIGNE'      DO 20 I=(NBCOL +1- KCOIN),NBCOL        K = (J-1)*(NBCOL+1)+I        IE = K-J+1        IN = KC        INNEW = (NBCOL-I+2)*NBCOL+1C        PRINT *,'NOEUD =',K,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+1) = INNEWC        IN = IN+NBCOL+1        INNEW = INNEW - NBCOLC        PRINT *,'NOEUD =',K+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+2) = INNEW  20  CONTINUEC     --- DESTRUCTION ---      DO 40 I=(NBCOL-KCOIN+1),NBCOL      DO 35 J=1,KCOIN        IE = (J-1)*NBCOL+I        DO 30 K=1,NBNMAX         ITRNOE((IE-1)*NBNMAX+K) = 0   30   CONTINUE   35  CONTINUE   40 CONTINUE      GOTO 999C        =========C     --- COIN K2 ---C        =========   50 I = NBCOL - KCOIN      INNEW = (NBLIG+1-KCOIN)*(NBCOL+2)-NBLIG-1C      PRINT *,'COLONNE'      DO 60 J=(NBLIG+1-KCOIN),NBLIG        K = (J-1)*(NBCOL+1)+I        IE = K-J+1C        INNEW = (I-NBCOL+NBLIG)*(NBCOL+2)-1-NBLIGC        INNEW = J*(NBCOL+2)-NBLIG-1C        PRINT *,'NOEUD =',K+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+2) = INNEW        INNEW = INNEW + NBCOL + 2C        PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+3) = INNEW   60 CONTINUE      J = NBLIG - KCOIN      INNEW = (NBLIG+1-KCOIN)*(NBCOL+2)-1-NBLIGC      PRINT *,'LIGNE'      DO 70 I=(NBCOL +1- KCOIN),NBCOL        K = (J-1)*(NBCOL+1)+I        IE = K-J+1        IN = KC        INNEW = (NBLIG-KCOIN)*NBCOL+I-1C        INNEW = (I-NBCOL+NBLIG)*(NBCOL+2)-1-NBLIGC        PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+4) = INNEWC        IN = IN+NBCOL+1        INNEW = INNEW + NBCOL + 2C        PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+3) = INNEW  70  CONTINUEC     --- DESTRUCTION ---      DO 90 I=(NBCOL-KCOIN+1),NBCOL      DO 85 J=(NBLIG-KCOIN+1),NBLIG        IE = (J-1)*NBCOL+I        DO 80 K=1,NBNMAX         ITRNOE((IE-1)*NBNMAX+K) = 0   80   CONTINUE   85  CONTINUE   90 CONTINUE      GOTO 999C        =========C     --- COIN K3 ---C        =========  100 I = KCOIN+1C      PRINT *,'COLONNE'      INNEW = (NBLIG-KCOIN)*(NBCOL+1)+KCOIN+1      DO 110 J=(NBLIG+1-KCOIN),NBLIG        K = (J-1)*(NBCOL+1)+I        IE = K-J+1C        PRINT *,'NOEUD =',K,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+1) = INNEW        INNEW = INNEW + NBCOLC        PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+4) = INNEW  110 CONTINUE      J = NBLIG - KCOINC      PRINT *,'LIGNE'      INNEW = NBLIG*(NBCOL+1)+1      DO 120 I=1,KCOIN        K = (J-1)*(NBCOL+1)+I        IE = K-J+1        IN = KC        INNEW = (NBLIG-KCOIN)*NBCOL+I-1C        PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+4) = INNEWC        IN = IN+NBCOL+1        INNEW = INNEW - NBCOLC        PRINT *,'NOEUD =',K+NBCOL+2,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+3),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+3) = INNEW 120  CONTINUEC     --- DESTRUCTION ---      DO 140 I=1,KCOIN      DO 135 J=(NBLIG-KCOIN+1),NBLIG        IE = (J-1)*NBCOL+I        DO 130 K=1,NBNMAX         ITRNOE((IE-1)*NBNMAX+K) = 0  130   CONTINUE  135  CONTINUE  140 CONTINUE      GOTO 999C        =========C     --- COIN K4 ---C        =========  150 I = KCOIN +1      INNEW = 1      DO 160 J=1,KCOIN        K = (J-1)*(NBCOL+1)+I        IE = K-J+1C        INNEW = (J-1)*(NBCOL+2)+1C        PRINT *,'NOEUD =',K,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+1) = INNEW        INNEW = INNEW + NBCOL + 2C        PRINT *,'NOEUD =',K+NBCOL+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+4),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+4) = INNEW  160 CONTINUE      J = KCOIN +1      INNEW = 1      DO 170 I=1,KCOIN        K = (J-1)*(NBCOL+1)+I        IE = K-J+1        IN = KC        INNEW = (I-1)*(NBCOL+2)+1C        PRINT *,'NOEUD =',K,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+1),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+1) = INNEWC        IN = IN+NBCOL+1        INNEW = INNEW + NBCOL + 2C        PRINT *,'NOEUD =',K+1,'ELEM =',IE,C     >          'NOEUD DE ELEM =', ITRNOE((IE-1)*NBNMAX+2),C     >          'NOUVEAU NOEUD = ',INNEW        ITRNOE((IE-1)*NBNMAX+2) = INNEW  170 CONTINUEC     --- DESTRUCTION ---      DO 200 I=1,KCOIN      DO 190 J=1,KCOIN        IE = (J-1)*NBCOL+I        DO 180 K=1,NBNMAX         ITRNOE((IE-1)*NBNMAX+K) = 0  180   CONTINUE  190  CONTINUE  200 CONTINUE      GOTO 999C  999 END

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