1 : C Q4ORG2 SOURCE CHAT 06/03/29 21:30:57 5360 2 : C 3 : C 4 : SUBROUTINE Q4ORG2(ITRNO1,NBNMX1,ITRTR1,NBCMX1,NBE1, 5 : > ITRNO2,NBNMX2,ITRTR2,NBCMX2,NBE2,N1,N2, 6 : > COORD,NBCOOR,IDIMC, 7 : > ITVL,NITMAX, 8 : > IGR1,NGRMX1,IGR2,NGRMX2,ICOIN,NBNL,ITRACE,iarr) 9 : C ********************************************************************** 10 : C OBJET Q4ORG2 : TRANSFORME 2 MAILLAGES Q4 EN 2 GRILLES COMPATIBLES 11 : C 12 : C EN ENTREE : 13 : C 14 : C ITRNOE1 : INDICE DES NOEUDS DES ELEMENTS DU PREMIER MAILLAGE 15 : C NBNMX1 : NOMBRE MAX. DE NOEUDS PAR ELEMENTS (4 OU +) 16 : C NBE1 : NOMBRE D'ELEMENTS DU PREMIER MAILLAGE 17 : C 18 : C ITRNOE2,NBNMX2,NBE2 : DEUXIEME MAILLAGE 19 : C 20 : C N1,N2 : N1 EST LE NUMERO DU NOEUD DU PREMIER MAILLAGE QUI DOIT 21 : C ETRE CONNECTE AU NOEUD N2 DANS LE DEUXIEME MAILLAGE 22 : C 23 : C COORD : COORDONNEES DES NOEUDS 24 : C IDIMC : DIMENSION DE L'ESPACE 25 : C NBCOOR : NOMBRE DE NOEUDS 26 : C 27 : C ITVL : TABLEAU D'ENTIERS POUR LES CALCULS 28 : C NTIMAX : TAILLE DU TABLEAU ITVL 29 : C ON A BESOIN DU TABLEAU DE TRAVAIL SEULEMENT SI ON CHANGE 30 : C SIMULTANEMENT L'ORIGINE ET L'ORIENTATION DU MAILLAGE. 31 : C LA PLACE NECESSAIRE EST ALORS DE : NBCOL*NBLIG = NBN 32 : C QUI EST TOUJOURS INFERIEUR A : 3+2*MAX(NBE1,NBE2) 33 : C 34 : C EN SORTIE : 35 : C 36 : C IGR1 : GRILLE ORIGINE 37 : C IGR2 : GRILLE DESTINATION 38 : C ICOIN : LES INDICES DES COINS DES 2 GRILLES 39 : C NBNL : NOMBRE DE COLONNES ET DE LIGNES DES 2 GRILLES 40 : C iarr : CODE D'ERREUR -1 SI DONNEES INCORRECTES 41 : C -2 SI TABLEAUX INSUFFISANTS 42 : C 43 : C REMARQUES : LES GRILLES IGR1 ET IGR2 SONT ORIENTEES DE LA MEME FACON 44 : C AVEC UNE ORIGINE COMPATIBLE, 45 : C AVEC NBCOL2 >= NBCOL1 ET NBLIG2 <= NBLIG1 46 : C 47 : C ********************************************************************** 48 : IMPLICIT INTEGER(I-N) 49 : INTEGER ITRNO1(*),NBNMX1,ITRTR1(*),NBCMX1,NBE1 50 : INTEGER ITRNO2(*),NBNMX2,ITRTR2(*),NBCMX2,NBE2,N1,N2 51 : REAL*8 COORD(*) 52 : INTEGER IDIMC,NBCOOR,ITVL(*),NITMAX 53 : INTEGER IGR1(*),NGRMX1,IGR2(*),NGRMX2 54 : INTEGER ICOIN(*),NBNL(*),ITRACE,iarr 55 : C 56 : REAL*8 VK(3),XNVK,ZERO 57 : INTEGER NBLIG1,NBCOL1,NBLIG2,NBCOL2,NBCOL,NBLIG 58 : INTEGER I,IOP,ITAMPO 59 : EXTERNAL XNORVE 60 : REAL*8 XNORVE 61 : C 62 : IF(ITRACE.GT.0) 62 : > CALL ESECHA(1,'* PRETRAITEMENT : ', 63 : > ' CALCUL DES GRILLES SURFACIQUES ') 64 : C 65 : DO 10 I=1,8 66 : ICOIN(I) = 0 67 : 10 CONTINUE 68 : DO 20 I=1,4 69 : NBNL(I) = 0 70 : 20 CONTINUE 71 : C 72 : C ========================= 73 : C --- CALCUL DE L'ORIENTATION --- 74 : C ========================= 75 : C 76 : ZERO = 1.E-6 76 : C CALL DIFFVE(COORD((N2-1)*IDIMC+1), 77 : C > COORD((N1-1)*IDIMC+1), 78 : C > IDIMC,VK) 79 : DO 730 JG=1,IDIMC 80 : 730 VK(JG)=COORD((N2-1)*IDIMC+JG) - COORD((N1-1)*IDIMC+JG) 81 : XNVK = XNORVE(VK,IDIMC) 82 : IF( XNVK.LT.ZERO )THEN 83 : iarr = -1 83 : CALL DSERRE(1,iarr,'Q4ORG2', 84 : > ' LES NOEUDS (N1,N2) SONT CONFONDUS ') 85 : GOTO 9999 86 : ENDIF 86 : C CALL MUSCVE( VK,XNVK,IDIMC, VK ) 87 : DO 710 JG=1,IDIMC 88 : 710 VK(JG)=VK(JG)*XNVK 89 : C 90 : C =========================== 91 : C --- CALCUL DE LA 1IERE GRILLE --- 92 : C =========================== 93 : C 93 : CALL G2ORQ4(ITRNO1,NBNMX1,ITRTR1,NBCMX1,NBE1, 94 : > COORD,IDIMC,N1,VK, 95 : > ITVL,NITMAX, 96 : > IGR1,NBCOL1,NBLIG1,NGRMX1, 97 : > ICOIN,iarr ) 98 : C 99 : NBNL(1) = NBCOL1 100 : NBNL(2) = NBLIG1 101 : C 102 : IF(ITRACE.GT.0)THEN 102 : CALL ESECHA(1,'-> DU MAILLAGE 1 A LA GRILLE 1',' ') 102 : CALL ESEINT(1,'NUMERO DES COINS : ',ICOIN,4) 102 : CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL,2) 103 : ENDIF 104 : IF( iarr.NE. 0 )THEN 104 : CALL DSERRE(1,iarr,'Q4ORG2',' APPEL G2ORQ4') 104 : CALL DSERRE(1,iarr,'Q4ORG2', 105 : > ' PASSAGE PREMIER MAILLAGE EN GRILLE ') 106 : GOTO 9999 107 : ENDIF 108 : C 109 : C =========================== 110 : C --- CALCUL DE LA 2IERE GRILLE --- 111 : C =========================== 112 : C 112 : CALL G2ORQ4(ITRNO2,NBNMX2,ITRTR2,NBCMX2,NBE2, 113 : > COORD,IDIMC,N2,VK, 114 : > ITVL ,NITMAX, 115 : > IGR2,NBCOL2,NBLIG2,NGRMX2, 116 : > ICOIN(5),iarr ) 117 : C 118 : NBNL(3) = NBCOL2 119 : NBNL(4) = NBLIG2 120 : C 121 : IF(ITRACE.GT.0)THEN 121 : CALL ESECHA(1,'-> DU MAILLAGE 2 A LA GRILLE 2',' ') 121 : CALL ESEINT(1,'NUMERO DES COINS : ',ICOIN(5),4) 121 : CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(3),2) 122 : ENDIF 123 : IF( iarr.NE. 0 )THEN 123 : CALL DSERRE(1,iarr,'Q4ORG2',' APPEL G2ORQ4') 123 : CALL DSERRE(1,iarr,'Q4ORG2', 124 : > ' PASSAGE DU DEUXIEME MAILLAGE EN GRILLE ') 125 : GOTO 9999 126 : ENDIF 127 : C 128 : C ==================================================== 129 : C ---- INVERSION DES LIGNES ET DES COLONNES DES 2 GRILLES ---- 130 : C ==================================================== 131 : C 132 : IF((NBCOL1.GT.NBCOL2 ).AND.(NBLIG1.GT.NBLIG2))THEN 133 : iarr = -1 134 : NBNL(1) = NBCOL1 135 : NBNL(2) = NBLIG1 136 : NBNL(3) = NBCOL2 137 : NBNL(4) = NBLIG2 138 : GOTO 9999 139 : ENDIF 140 : C 141 : IF((NBCOL1.GT.NBCOL2 ).OR.(NBLIG2.GT.NBLIG1))THEN 142 : C 143 : IF(ITRACE.GT.0) 143 : > CALL ESECHA(1,' REORIENTATION : ', 144 : > ' ROTATION DES GRILLES SURFACIQUES ') 145 : C 146 : IF( ( (NITMAX - NBCOL1*NBLIG1).LT.0 ).OR. 147 : > ( (NITMAX - NBCOL2*NBLIG2).LT.0 ) )THEN 148 : iarr = -2 148 : CALL DSERRE(1,iarr,'Q4ORG2', 149 : > ' POUR LA REORIENTATION DES GRILLES ') 150 : GOTO 9999 151 : ENDIF 152 : C 153 : IOP = 2 153 : CALL G2COPY(IGR1,NBCOL1,NBLIG1,IOP, 154 : > ITVL,NBCOL,NBLIG ) 155 : IOP = 1 155 : CALL G2COPY(ITVL,NBCOL,NBLIG,IOP, 156 : > IGR1,NBCOL1,NBLIG1 ) 157 : ITAMPO = ICOIN(1) 158 : ICOIN(1) = ICOIN(4) 159 : ICOIN(4) = ICOIN(3) 160 : ICOIN(3) = ICOIN(2) 161 : ICOIN(2) = ITAMPO 162 : NBNL(1) = NBCOL1 163 : NBNL(2) = NBLIG1 164 : C 165 : IOP = 2 165 : CALL G2COPY(IGR2,NBCOL2,NBLIG2,IOP, 166 : > ITVL,NBCOL,NBLIG ) 167 : IOP = 1 167 : CALL G2COPY(ITVL,NBCOL,NBLIG,IOP, 168 : > IGR2,NBCOL2,NBLIG2 ) 169 : ITAMPO = ICOIN(5) 170 : ICOIN(5) = ICOIN(8) 171 : ICOIN(8) = ICOIN(7) 172 : ICOIN(7) = ICOIN(6) 173 : ICOIN(6) = ITAMPO 174 : NBNL(3) = NBCOL2 175 : NBNL(4) = NBLIG2 176 : C 177 : IF(ITRACE.GT.0)THEN 177 : CALL ESECHA(1,'-> GRILLE 1 REOREINTEE ',' ') 177 : CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL,2) 177 : CALL ESECHA(1,'-> GRILLE 2 REORIENTEE ',' ') 177 : CALL ESEINT(1,'COLONNES,LIGNES : ',NBNL(3),2) 178 : ENDIF 179 : ENDIF 180 : C 181 : 9999 END 182 : 183 : 184 :
© Cast3M 2003 - All rights reserved.
Disclaimer