1 : C G2NOQ4 SOURCE CHAT 06/03/29 21:22:00 5360 2 : C 3 : C 4 : SUBROUTINE G2NOQ4( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, 5 : > INOGR,NBCOL,NBLIG,NNOMAX,iarr) 6 : C ********************************************************************** 7 : C OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS 8 : C 9 : C EN ENTREE : 10 : C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D 11 : C 12 : C INOGR : INDICE DES NOEUDS DE LA GRILLE (A REMPLIR) 13 : C NNOMAX : TAILLE DE INOGR 14 : C 15 : C ITVL(ITVMAX) : TABLEAU DE TRAVAIL (ENTIERS) 16 : C 17 : C EN SORTIE : 18 : C NBLIG,NBCOL : NOMBRE DE LIGNES ET DE COLONNES DE LA GRILLE 19 : C INOGR : INDICE DES NOEUDS DE LA GRILLE 20 : C INOGR((I-1)*NBCOL+J) = NOEUD DE LA COLONNE J 21 : C ET DE LA LIGNE I 22 : C iarr : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES 23 : C 24 : C ********************************************************************** 25 : IMPLICIT INTEGER(I-N) 26 : INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE 27 : INTEGER INOGR(*),NBCOL,NBLIG,NNOMAX,iarr 28 : C 29 : INTEGER IEK(4),ICK(4),NKK,NN(4),NKKMAX 30 : INTEGER I,J,N1,N2,N3,N4,IECOL,ICCOL,IE,IC,IES,ICS 31 : C ======================== 32 : C --------- 1. RECHERCHE DES COINS -------- 33 : C ======================== 34 : C 35 : NKKMAX = 4 35 : CALL G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, 36 : > NN,IEK,ICK,NKK,NKKMAX,iarr) 37 : IF( iarr.NE.0 )THEN 37 : CALL DSERRE(1,iarr,'G2NOQ4','APPEL G2KKM2') 38 : GOTO 9999 39 : ENDIF 40 : IF( NKK.NE.4 )THEN 41 : iarr = -1 41 : CALL DSERRE(1,iarr,'G2NOQ4','IL DOIT Y AVOIR 4 COINS') 42 : GOTO 9999 43 : ENDIF 44 : IF( (NN(1).NE.NN(3)).OR.(NN(2).NE.NN(4)) )THEN 45 : iarr = -1 45 : CALL DSERRE(1,iarr,'G2NOQ4', 46 : > ' LE NB DE SEGMENT DOIT ETRE EGAL SUR LES COTE OPPOSES') 47 : GOTO 9999 48 : ENDIF 49 : IF( (NN(1)*NN(2)).GT.NNOMAX )THEN 50 : iarr = -2 50 : CALL DSERRE(1,iarr,' G2NOQ4 ',' TROP DE POINTS') 51 : GOTO 9999 52 : ENDIF 53 : C ============================= 54 : C --------- 2. REMPLISSAGE DE LA GRILLE -------- 55 : C ============================= 56 : NBCOL = NN(1) 57 : NBLIG = NN(2) 58 : IE = IEK(1) 59 : IC = ICK(1) 60 : DO 200 I=1,(NBLIG-1) 61 : C 62 : C ---- POUR CHAQUE LIGNE DE LA GRILLE ---- 63 : C 64 : DO 100 J=1,(NBCOL-1) 65 : IF((IE.LE.0).OR.(IC.LE.0))THEN 66 : iarr = -1 66 : CALL DSERRE(1,iarr,'G2NOQ4', 67 : > ' LE MAILLAGE N A PAS LA STRUCTURE DE GRILLE') 68 : GOTO 9999 69 : ENDIF 70 : C 71 : C ----- PARCOURS DU Q4 ---- 72 : C 73 : N1 = ITRNOE((IE-1)*NBNMAX+IC) 74 : IC = MOD(IC,NBCMAX) + 1 75 : N2 = ITRNOE((IE-1)*NBNMAX+IC) 76 : C ----- ELEMENT SUIVANT SUR LA MEME LIGNE ---- 76 : CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS) 77 : ICS = MOD(ICS,NBCMAX) + 1 78 : C 79 : IC = MOD(IC,NBCMAX) + 1 80 : N3 = ITRNOE((IE-1)*NBNMAX+IC) 81 : C ----- PREMIER ELEMENT DE LA LIGNE SUIVANTE ---- 82 : IF( J.EQ.1 )THEN 82 : CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IECOL,ICCOL) 83 : ENDIF 84 : IC = MOD(IC,NBCMAX) + 1 85 : N4 = ITRNOE((IE-1)*NBNMAX+IC) 86 : C 87 : C ----- STOCKAGE DES NOEUDS ---- 88 : C 89 : IF( I.EQ.1 )THEN 90 : INOGR((I-1)*NBCOL + J) = N1 91 : INOGR((I-1)*NBCOL + J + 1) = N2 92 : ELSE 93 : C --- ON VERIFIE L ADJACENCE DES LIGNES --- 94 : IF( (INOGR((I-1)*NBCOL + J) .NE.N1).OR. 95 : > (INOGR((I-1)*NBCOL + J + 1).NE.N2) )THEN 96 : iarr = -1 96 : CALL DSERRE(1,iarr,'G2NOQ4', 97 : > ' LES LIGNES NE SONT PAS ADJACENTES') 98 : GOTO 9999 99 : ENDIF 100 : ENDIF 101 : INOGR( I*NBCOL + J + 1) = N3 102 : INOGR( I*NBCOL + J ) = N4 103 : C ----- ON PASSE AU Q4 SUIVANT DANS LA LIGNE ----- 104 : C 105 : IE = IES 106 : IC = ICS 107 : 100 CONTINUE 108 : C ----- ON PASSE A LA LIGNE SUIVANTE ----- 109 : C 110 : IE = IECOL 111 : IC = ICCOL 112 : 200 CONTINUE 113 : GOTO 9999 114 : C 114 : C 8888 CALL DSERRE(1,iarr,' G2KKM2 ',' ') 115 : 9999 END 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer