C Q4ORG2 SOURCE CB215821 26/10/26 21:16:02 12682 C C SUBROUTINE Q4ORG2(ITRNO1,NBNMX1,ITRTR1,NBCMX1,NBE1, > ITRNO2,NBNMX2,ITRTR2,NBCMX2,NBE2,N1,N2, > COORD,NBCOOR,IDIMC, > ITVL,NITMAX, > IGR1,NGRMX1,IGR2,NGRMX2,ICOIN,NBNL,ITRACE,iarr) C ********************************************************************** C OBJET Q4ORG2 : TRANSFORME 2 MAILLAGES Q4 EN 2 GRILLES COMPATIBLES C C EN ENTREE : C C ITRNOE1 : INDICE DES NOEUDS DES ELEMENTS DU PREMIER MAILLAGE C NBNMX1 : NOMBRE MAX. DE NOEUDS PAR ELEMENTS (4 OU +) C NBE1 : NOMBRE D'ELEMENTS DU PREMIER MAILLAGE C C ITRNOE2,NBNMX2,NBE2 : DEUXIEME MAILLAGE C C N1,N2 : N1 EST LE NUMERO DU NOEUD DU PREMIER MAILLAGE QUI DOIT C ETRE CONNECTE AU NOEUD N2 DANS LE DEUXIEME MAILLAGE C C COORD : COORDONNEES DES NOEUDS C IDIMC : DIMENSION DE L'ESPACE C NBCOOR : NOMBRE DE NOEUDS C C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS C NTIMAX : TAILLE DU TABLEAU ITVL C ON A BESOIN DU TABLEAU DE TRAVAIL SEULEMENT SI ON CHANGE C SIMULTANEMENT L'ORIGINE ET L'ORIENTATION DU MAILLAGE. C LA PLACE NECESSAIRE EST ALORS DE : NBCOL*NBLIG = NBN C QUI EST TOUJOURS INFERIEUR A : 3+2*MAX(NBE1,NBE2) C C EN SORTIE : C C IGR1 : GRILLE ORIGINE C IGR2 : GRILLE DESTINATION C ICOIN : LES INDICES DES COINS DES 2 GRILLES C NBNL : NOMBRE DE COLONNES ET DE LIGNES DES 2 GRILLES C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES C -2 SI TABLEAUX INSUFFISANTS C C REMARQUES : LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON C AVEC UNE ORIGINE COMPATIBLE, C AVEC NBCOL2 >= NBCOL1 ET NBLIG2 <= NBLIG1 C C ********************************************************************** IMPLICIT INTEGER(I-N) INTEGER ITRNO1(*),NBNMX1,ITRTR1(*),NBCMX1,NBE1 INTEGER ITRNO2(*),NBNMX2,ITRTR2(*),NBCMX2,NBE2,N1,N2 REAL*8 COORD(*) INTEGER IDIMC,NBCOOR,ITVL(*),NITMAX INTEGER IGR1(*),NGRMX1,IGR2(*),NGRMX2 INTEGER ICOIN(*),NBNL(*),ITRACE,iarr C REAL*8 VK(3),XNVK,ZERO INTEGER NBLIG1,NBCOL1,NBLIG2,NBCOL2,NBCOL,NBLIG INTEGER I,IOP,ITAMPO EXTERNAL XNORVE REAL*8 XNORVE C IF(ITRACE.GT.0) > CALL ESECHA(1,'* PRETRAITEMENT : ', > ' CALCUL DES GRILLES SURFACIQUES ') C DO 10 I=1,8 ICOIN(I) = 0 10 CONTINUE DO 20 I=1,4 NBNL(I) = 0 20 CONTINUE C C ========================= C --- CALCUL DE L'ORIENTATION --- C ========================= C ZERO = 1.E-6 C CALL DIFFVE(COORD((N2-1)*IDIMC+1), C > COORD((N1-1)*IDIMC+1), C > IDIMC,VK) DO 730 JG=1,IDIMC VK(JG)=COORD((N2-1)*IDIMC+JG) - COORD((N1-1)*IDIMC+JG) 730 CONTINUE XNVK = XNORVE(VK,IDIMC) IF( XNVK.LT.ZERO )THEN iarr = -1 CALL DSERRE(1,iarr,'Q4ORG2', > ' LES NOEUDS (N1,N2) SONT CONFONDUS ') GOTO 9999 ENDIF C CALL MUSCVE( VK,XNVK,IDIMC, VK ) DO 710 JG=1,IDIMC VK(JG)=VK(JG)*XNVK 710 CONTINUE C C =========================== C --- CALCUL DE LA 1IERE GRILLE --- C =========================== C CALL G2ORQ4(ITRNO1,NBNMX1,ITRTR1,NBCMX1,NBE1, > COORD,IDIMC,N1,VK, > ITVL,NITMAX, > IGR1,NBCOL1,NBLIG1,NGRMX1, > ICOIN,iarr ) C NBNL(1) = NBCOL1 NBNL(2) = NBLIG1 C IF(ITRACE.GT.0)THEN CALL ESECHA(1,'-> DU MAILLAGE 1 A LA GRILLE 1',' ') CALL ESEINT(1,'NUMERO DES COINS : ',ICOIN(1),4) CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(1),2) ENDIF IF( iarr.NE. 0 )THEN CALL DSERRE(1,iarr,'Q4ORG2',' APPEL G2ORQ4') CALL DSERRE(1,iarr,'Q4ORG2', > ' PASSAGE PREMIER MAILLAGE EN GRILLE ') GOTO 9999 ENDIF C C =========================== C --- CALCUL DE LA 2IERE GRILLE --- C =========================== C CALL G2ORQ4(ITRNO2,NBNMX2,ITRTR2,NBCMX2,NBE2, > COORD,IDIMC,N2,VK, > ITVL ,NITMAX, > IGR2,NBCOL2,NBLIG2,NGRMX2, > ICOIN(5),iarr ) C NBNL(3) = NBCOL2 NBNL(4) = NBLIG2 C IF(ITRACE.GT.0)THEN CALL ESECHA(1,'-> DU MAILLAGE 2 A LA GRILLE 2',' ') CALL ESEINT(1,'NUMERO DES COINS : ',ICOIN(5),4) CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(3),2) ENDIF IF( iarr.NE. 0 )THEN CALL DSERRE(1,iarr,'Q4ORG2',' APPEL G2ORQ4') CALL DSERRE(1,iarr,'Q4ORG2', > ' PASSAGE DU DEUXIEME MAILLAGE EN GRILLE ') GOTO 9999 ENDIF C C ==================================================== C ---- INVERSION DES LIGNES ET DES COLONNES DES 2 GRILLES ---- C ==================================================== C IF((NBCOL1.GT.NBCOL2 ).AND.(NBLIG1.GT.NBLIG2))THEN iarr = -1 NBNL(1) = NBCOL1 NBNL(2) = NBLIG1 NBNL(3) = NBCOL2 NBNL(4) = NBLIG2 GOTO 9999 ENDIF C IF((NBCOL1.GT.NBCOL2 ).OR.(NBLIG2.GT.NBLIG1))THEN C IF(ITRACE.GT.0) > CALL ESECHA(1,' REORIENTATION : ', > ' ROTATION DES GRILLES SURFACIQUES ') C IF( ( (NITMAX - NBCOL1*NBLIG1).LT.0 ).OR. > ( (NITMAX - NBCOL2*NBLIG2).LT.0 ) )THEN iarr = -2 CALL DSERRE(1,iarr,'Q4ORG2', > ' POUR LA REORIENTATION DES GRILLES ') GOTO 9999 ENDIF C IOP = 2 CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP, > ITVL,NBCOL,NBLIG ) IOP = 1 CALL G2COPY(ITVL,NBCOL,NBLIG,IOP, > IGR1,NBCOL1,NBLIG1 ) ITAMPO = ICOIN(1) ICOIN(1) = ICOIN(4) ICOIN(4) = ICOIN(3) ICOIN(3) = ICOIN(2) ICOIN(2) = ITAMPO NBNL(1) = NBCOL1 NBNL(2) = NBLIG1 C IOP = 2 CALL G2COPY(IGR2,NBCOL2,NBLIG2,IOP, > ITVL,NBCOL,NBLIG ) IOP = 1 CALL G2COPY(ITVL,NBCOL,NBLIG,IOP, > IGR2,NBCOL2,NBLIG2 ) ITAMPO = ICOIN(5) ICOIN(5) = ICOIN(8) ICOIN(8) = ICOIN(7) ICOIN(7) = ICOIN(6) ICOIN(6) = ITAMPO NBNL(3) = NBCOL2 NBNL(4) = NBLIG2 C IF(ITRACE.GT.0)THEN CALL ESECHA(1,'-> GRILLE 1 REOREINTEE ',' ') CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(1),2) CALL ESECHA(1,'-> GRILLE 2 REORIENTEE ',' ') CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(3),2) ENDIF ENDIF C 9999 END