C G2NOQ4 SOURCE CHAT 06/03/29 21:22:00 5360 C C SUBROUTINE G2NOQ4( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, > INOGR,NBCOL,NBLIG,NNOMAX,iarr) C ********************************************************************** C OBJET G2NOQ4 : CONSTRUIT LA GRILLE DES NOEUDS C C EN ENTREE : C ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE : UN MAILLAGE 2D C C INOGR : INDICE DES NOEUDS DE LA GRILLE (A REMPLIR) C NNOMAX : TAILLE DE INOGR C C ITVL(ITVMAX) : TABLEAU DE TRAVAIL (ENTIERS) C C EN SORTIE : C NBLIG,NBCOL : NOMBRE DE LIGNES ET DE COLONNES DE LA GRILLE C INOGR : INDICE DES NOEUDS DE LA GRILLE C INOGR((I-1)*NBCOL+J) = NOEUD DE LA COLONNE J C ET DE LA LIGNE I C iarr : 0 SI OK, -1 SI LES DONNEES SONT ERRONEES C C ********************************************************************** IMPLICIT INTEGER(I-N) INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX,NBE INTEGER INOGR(*),NBCOL,NBLIG,NNOMAX,iarr C INTEGER IEK(4),ICK(4),NKK,NN(4),NKKMAX INTEGER I,J,N1,N2,N3,N4,IECOL,ICCOL,IE,IC,IES,ICS C ======================== C --------- 1. RECHERCHE DES COINS -------- C ======================== C NKKMAX = 4 CALL G2KKM2( ITRNOE,NBNMAX,ITRTRI,NBCMAX,NBE, > NN,IEK,ICK,NKK,NKKMAX,iarr) IF( iarr.NE.0 )THEN CALL DSERRE(1,iarr,'G2NOQ4','APPEL G2KKM2') GOTO 9999 ENDIF IF( NKK.NE.4 )THEN iarr = -1 CALL DSERRE(1,iarr,'G2NOQ4','IL DOIT Y AVOIR 4 COINS') GOTO 9999 ENDIF IF( (NN(1).NE.NN(3)).OR.(NN(2).NE.NN(4)) )THEN iarr = -1 CALL DSERRE(1,iarr,'G2NOQ4', > ' LE NB DE SEGMENT DOIT ETRE EGAL SUR LES COTE OPPOSES') GOTO 9999 ENDIF IF( (NN(1)*NN(2)).GT.NNOMAX )THEN iarr = -2 CALL DSERRE(1,iarr,' G2NOQ4 ',' TROP DE POINTS') GOTO 9999 ENDIF C ============================= C --------- 2. REMPLISSAGE DE LA GRILLE -------- C ============================= NBCOL = NN(1) NBLIG = NN(2) IE = IEK(1) IC = ICK(1) DO 200 I=1,(NBLIG-1) C C ---- POUR CHAQUE LIGNE DE LA GRILLE ---- C DO 100 J=1,(NBCOL-1) IF((IE.LE.0).OR.(IC.LE.0))THEN iarr = -1 CALL DSERRE(1,iarr,'G2NOQ4', > ' LE MAILLAGE N A PAS LA STRUCTURE DE GRILLE') GOTO 9999 ENDIF C C ----- PARCOURS DU Q4 ---- C N1 = ITRNOE((IE-1)*NBNMAX+IC) IC = MOD(IC,NBCMAX) + 1 N2 = ITRNOE((IE-1)*NBNMAX+IC) C ----- ELEMENT SUIVANT SUR LA MEME LIGNE ---- CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IES,ICS) ICS = MOD(ICS,NBCMAX) + 1 C IC = MOD(IC,NBCMAX) + 1 N3 = ITRNOE((IE-1)*NBNMAX+IC) C ----- PREMIER ELEMENT DE LA LIGNE SUIVANTE ---- IF( J.EQ.1 )THEN CALL SESFR1(IE,IC,ITRTRI,NBCMAX,IECOL,ICCOL) ENDIF IC = MOD(IC,NBCMAX) + 1 N4 = ITRNOE((IE-1)*NBNMAX+IC) C C ----- STOCKAGE DES NOEUDS ---- C IF( I.EQ.1 )THEN INOGR((I-1)*NBCOL + J) = N1 INOGR((I-1)*NBCOL + J + 1) = N2 ELSE C --- ON VERIFIE L ADJACENCE DES LIGNES --- IF( (INOGR((I-1)*NBCOL + J) .NE.N1).OR. > (INOGR((I-1)*NBCOL + J + 1).NE.N2) )THEN iarr = -1 CALL DSERRE(1,iarr,'G2NOQ4', > ' LES LIGNES NE SONT PAS ADJACENTES') GOTO 9999 ENDIF ENDIF INOGR( I*NBCOL + J + 1) = N3 INOGR( I*NBCOL + J ) = N4 C ----- ON PASSE AU Q4 SUIVANT DANS LA LIGNE ----- C IE = IES IC = ICS 100 CONTINUE C ----- ON PASSE A LA LIGNE SUIVANTE ----- C IE = IECOL IC = ICCOL 200 CONTINUE GOTO 9999 C C 8888 CALL DSERRE(1,iarr,' G2KKM2 ',' ') 9999 END