1 : C G2KKM2 SOURCE CHAT 06/03/29 21:21:45 5360 2 : C 3 : C ********************************************************************** 4 : C FICHIER : GR2D_INTERFACE.F 5 : C 6 : C RECONNAISSANCE D'UN MAILLAGE DE TYPE GRILLE 7 : C INTERFACE MAILLAGE ET GRILLE 8 : C 9 : C OBJET : 10 : C 11 : C OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D 12 : C OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS 13 : C OBJET G2ORQ4 : CREATION D'UNE GRILLE ORIENTE A PARTIR D'UN MAILLAGE 14 : C OBJET Q4ORG2 : TRANSFORME 2 MAILLAGES Q4 EN 2 GRILLES COMPATIBLES 15 : C 16 : C AUTEUR : O. STAB 17 : C DATE : 06.96 18 : C MODIFICATIONS : 19 : C AUTEUR, DATE, OBJET : 20 : C 21 : C 22 : C ********************************************************************** 23 : C 24 : C 25 : SUBROUTINE G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, 26 : > NN,IEK,ICK,NKK,NKKMAX,iarr) 27 : C ********************************************************************** 28 : C OBJET G2KKM2 : IDENTIFIE LES COINS DANS UN MAILLAGE 2D 29 : C 30 : C EN ENTREE : 31 : C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D 32 : C NKKMAX : NOMBRE MAXIMUM DE COINS 33 : C 34 : C EN SORTIE : 35 : C NN : NOMBRE DE NOEUDS ENTRE 2 COINS 36 : C (IEK,ICK)(I) --- NN(I) --- (IEK,ICK)(I+1) 37 : C (IEK,ICK) : INDICE DES COINS = ITRNOE((IEK-1)*NBNMAX+ICK) 38 : C 39 : C NKK : NOMBRE DE COINS 40 : C iarr : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES 41 : C 42 : C REMARQUE : FONCTIONNE SUR DES MAILLAGE MIXTES 43 : C 44 : C ********************************************************************** 45 : IMPLICIT INTEGER(I-N) 46 : INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE 47 : INTEGER NN(*),IEK(*),ICK(*),NKK,NKKMAX,iarr 48 : C 49 : INTEGER I,IE,IC,NBC,J,IES,ICS,IDEB 50 : INTEGER STRNBN 51 : EXTERNAL STRNBN 52 : C 53 : C --------- INITIALISATION ------------------ 54 : DO 10 I=1,NKKMAX 55 : NN(I) = 0 56 : IEK(I) = 0 57 : ICK(I) = 0 58 : 10 CONTINUE 59 : NKK = 0 60 : C 61 : C --------- 1. RECHERCHE D'UN ELEMENT DE LA FRONTIERE -------- 62 : IE = 0 63 : 20 IE = IE + 1 64 : IF(IE.GT.NBE)THEN 65 : iarr = -1 65 : CALL DSERRE(1,iarr,' G2KKM2 ', 66 : > ' ON NE TROUVE PAS DE FRONTIERE SUR LES NBE ELEMENTS ') 67 : GOTO 9999 68 : ENDIF 69 : NBC = STRNBN(IE,ITRNOE,NBNMAX) 70 : IC = 0 71 : DO 30 J=1,NBC 72 : IF(ITRTRI((IE-1)*NBCMAX+J).EQ.0)IC = J 73 : 30 CONTINUE 74 : IF( IC.EQ.0 )GOTO 20 75 : C 76 : C --------- 2. PARCOURS DE LA FRONTIERE ------- 77 : C 78 : IDEB = IE 79 : C --- 1. UN ELEMENT AVEC UNE ARETE FRONTIERE --- 80 : C ON PASSE A L'ARETE SUIVANTE PUIS SUR L'ELEMENT 81 : C 82 : 100 NBC = STRNBN(IE,ITRNOE,NBNMAX) 83 : IC = MOD(IC,NBC) + 1 83 : CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS) 84 : IF(NKK.NE.0)NN(NKK) = NN(NKK) + 1 85 : C 86 : C --- UN COIN TOPOLOGIQUE --- 87 : IF( IES.EQ.0 )THEN 88 : C --- ON RETROUVE LE PREMIER COIN --- 89 : C IF( IKK(1).EQ.ITRNOE((IE-1)*NBNMAX+IC))GOTO 9999 90 : IF( ITRNOE((IEK(1)-1)*NBNMAX+ICK(1)).EQ. 91 : > ITRNOE((IE-1)*NBNMAX+IC) )GOTO 9999 92 : NKK = NKK + 1 93 : IEK(NKK) = IE 94 : ICK(NKK) = IC 95 : C IKK(NKK) = ITRNOE((IE-1)*NBNMAX+IC) 96 : NN(NKK) = 1 97 : ICS = IC 98 : C ICS = MOD(IC,NBCMAX) + 1 99 : IES = IE 100 : ELSE 101 : C --- ON PASSE SUR L'ARETE DE FRONTIERE --- 102 : ICS = MOD(ICS,NBCMAX) + 1 103 : ENDIF 104 : C 105 : IF(ITRTRI((IES-1)*NBCMAX+ICS).NE.0)THEN 106 : iarr = -1 106 : CALL DSERRE(1,iarr,' G2KKM2 ', 107 : > ' ON A PERDU LA FRONTIERE ') 108 : GOTO 9999 109 : ENDIF 110 : IE = IES 111 : IC = ICS 112 : C --- IL N'Y A PAS DE COIN : POUR EVITER LES BOUCLES --- 113 : IF((IE.EQ.IDEB).AND.(NKK.EQ.0))GOTO 9999 114 : C 115 : GOTO 100 116 : C 117 : 9999 END 118 : 119 : 120 :
© Cast3M 2003 - All rights reserved.
Disclaimer