1 : C CONGE3 SOURCE CHAT 05/01/12 22:17:11 5004 2 : SUBROUTINE CONGE3 (L1,L2,RCONGE,NCONGE, NL1,LRAC,NL2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * C O N G E 3 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * CREER UN CONGE DE RACCORDEMENT ENTRE DEUX LIGNES 14 : * 15 : * TYPE DU CONGE : DOUBLE COUDE 16 : * 17 : * 18 : * MODULES UTILISES: 19 : * ----------------- 20 : * 21 : -INC CCOPTIO 22 : -INC SMELEME 23 : * 24 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 25 : * ----------- 26 : * 27 : * L1 (E) PREMIERE LIGNE A RACCORDER 28 : * L2 (E) DEUXIEME LIGNE A RACCORDER 29 : * RCONGE (E) RAYON DU CONGE DU RACCORDEMENT 30 : * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS 31 : * CLASSIQUES SUR SON SIGNE) 32 : * = 0 SI NON FOURNI 33 : * NL1 (S) LIGNE APPUYEE SUR L1 ET ABOUTISSANT SUR LE CONGE 34 : * LRAC (S) CONGE DE RACCORDEMENT 35 : * NL2 (S) LIGNE APPUYEE SUR L2 ET COMMENCANT SUR LE CONGE 36 : * 37 : INTEGER NCONGE 38 : REAL*8 RCONGE 39 : * 40 : * CONSTANTES: 41 : * ----------- 42 : * 43 : * 44 : PARAMETER (DEMI=0.5D0) 45 : * 46 : * VARIABLES: 47 : * ---------- 48 : * 49 : * RESULT = DROITES PARALLELES ? 50 : * 51 : INTEGER N,NBNOEU,NBELEM,NL,ND, 52 : & ITYPLM,NBSOUS,NBREF,NBNN 53 : CHARACTER*4 RESULT 54 : * 55 : * 56 : * AUTEUR, DATE DE CREATION: 57 : * ------------------------- 58 : * 59 : * LIONEL VIVAN 30 NOVEMBRE 1987 60 : * 61 : * LANGAGE: 62 : * -------- 63 : * 64 : * ESOPE + FORTRAN77 65 : * 66 : ************************************************************************ 67 : * 68 : MELEME=L1 69 : SEGACT,MELEME 70 : NL=LISOUS(/1) 71 : IF (NL.NE.0) THEN 71 : CALL ERREUR(25) 72 : RETURN 73 : END IF 74 : NBNOEU=NUM(/1) 75 : NBELEM=NUM(/2) 76 : IP9=NUM(NBNOEU,NBELEM) 77 : IP8=NUM(1,NBELEM) 78 : SEGDES,MELEME 79 : * 80 : MELEME=L2 81 : SEGACT,MELEME 82 : NL=LISOUS(/1) 83 : IF (NL.NE.0) THEN 83 : CALL ERREUR(25) 84 : RETURN 85 : END IF 86 : NBNOEU=NUM(/1) 87 : IP1=NUM(1,1) 88 : IP2=NUM(NBNOEU,1) 89 : SEGDES,MELEME 90 : * 91 : * TEST DROITES PARALLELES , DROITES NON COPLANAIRES 92 : * 92 : CALL INT2D(IP9,IP8,IP1,IP2,INTERS,RESULT) 93 : IF (IERR.NE.0) RETURN 94 : IF (RESULT .EQ. 'NON') THEN 94 : CALL CONGE4(L1,L2,RCONGE,NCONGE,NL1,LRAC,NL2) 95 : RETURN 96 : END IF 97 : IF (RESULT.EQ.'OK')THEN 97 : CALL ERREUR(400) 98 : RETURN 99 : END IF 100 : * 100 : CALL EXCOO1(IP9,X9,Y9,Z9,D9) 100 : CALL EXCOO1(IP8,X8,Y8,Z8,D8) 100 : CALL EXCOO1(IP1,X1,Y1,Z1,D1) 100 : CALL EXCOO1(IP2,X2,Y2,Z2,D2) 101 : * 102 : * RECHERCHE DU POINT C : 103 : * - SUR LA PERPENDICULAIRE AUX DEUX DROITES PASSANT PAR LE POINT 104 : * - APPARTENANT A LA DROITE 'L2' 105 : * 106 : A8921=(X8-X9)*(X2-X1)+(Y8-Y9)*(Y2-Y1)+(Z8-Z9)*(Z2-Z1) 107 : B8929=(X8-X9)*(X2-X9)+(Y8-Y9)*(Y2-Y9)+(Z8-Z9)*(Z2-Z9) 108 : XC=X2-(B8929/A8921)*(X2-X1) 109 : YC=Y2-(B8929/A8921)*(Y2-Y1) 110 : ZC=Z2-(B8929/A8921)*(Z2-Z1) 110 : CALL CREPO1(XC,YC,ZC,IPC) 111 : * 112 : * DISTANCE ENTRE LES DEUX DROITES 113 : * 114 : D2D=SQRT((X9-XC)**2+(Y9-YC)**2+(Z9-ZC)**2) 115 : * 116 : * TEST DE LA VALEUR DE RCONGE 117 : * 118 : IF (RCONGE.LT.(D2D*DEMI)) THEN 118 : CALL ERREUR(401) 119 : RETURN 120 : END IF 121 : * 122 : * RECHERCHE DU POINT P1 ,SE SITUE SUR 'L1' 123 : * 124 : ANG=ASIN((RCONGE-D2D*DEMI)/RCONGE) 125 : XN9=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2) 126 : XP1=X9+D2D*DEMI*(X8-X9)*TAN(ANG)/XN9 127 : YP1=Y9+D2D*DEMI*(Y8-Y9)*TAN(ANG)/XN9 128 : ZP1=Z9+D2D*DEMI*(Z8-Z9)*TAN(ANG)/XN9 128 : CALL CREPO1(XP1,YP1,ZP1,IPP1) 129 : * 130 : * RECHERCHE DU POINT P2 ,SE SITUE SUR 'L2' 131 : * 132 : XN1=SQRT((X2-X1)**2+(Y2-Y1)**2+(Z2-Z1)**2) 133 : XP2=XC+D2D*DEMI*(X2-X1)*TAN(ANG)/XN1 134 : YP2=YC+D2D*DEMI*(Y2-Y1)*TAN(ANG)/XN1 135 : ZP2=ZC+D2D*DEMI*(Z2-Z1)*TAN(ANG)/XN1 135 : CALL CREPO1(XP2,YP2,ZP2,IPP2) 136 : * 137 : * RECHERCHE DU POINT O ,MILIEU DE P1 P2 138 : * 139 : XO=(XP1+XP2)*DEMI 140 : YO=(YP1+YP2)*DEMI 141 : ZO=(ZP1+ZP2)*DEMI 141 : CALL CREPO1(XO,YO,ZO,IPO) 142 : * 143 : * CREATION DE LA DROITE P1-O 144 : * 145 : ND=1 145 : CALL ECRENT(ND) 145 : CALL ECROBJ('POINT',IPO) 145 : CALL ECROBJ('POINT',IPP1) 145 : CALL LIGNE(1,1,DEN1,DEN2,N) 146 : IF (IERR.NE.0) RETURN 146 : CALL LIROBJ('MAILLAGE',L3,1,IRETOU) 147 : IF (IERR.NE.0) RETURN 148 : * 149 : * CREATION DE LA DROITE O-P2 150 : * 151 : ND=1 151 : CALL ECRENT(ND) 151 : CALL ECROBJ('POINT',IPP2) 151 : CALL ECROBJ('POINT',IPO) 151 : CALL LIGNE(1,1,DEN1,DEN2,N) 152 : IF (IERR.NE.0) RETURN 152 : CALL LIROBJ('MAILLAGE',L4,1,IRETOU) 153 : IF (IERR.NE.0) RETURN 154 : * 155 : * CREATION DU CONGE DOUBLE 156 : * 157 : NCONGE=(NCONGE+1)/2 157 : CALL CONGE2(L1,L4,RCONGE,NCONGE,NL1,LRAC1,NL4) 158 : IF (IERR.NE.0) RETURN 158 : CALL CONGE2(L3,L2,RCONGE,NCONGE,NL3,LRAC2,NL2) 159 : IF (IERR.NE.0) RETURN 160 : * 161 : * LES 2 DEMI-CERCLES ONT UN POINT EN COMMUN: 162 : MELEME=LRAC1 163 : SEGACT,MELEME 164 : NBNOEU=NUM(/1) 165 : NBELEM=NUM(/2) 166 : IPO1=NUM(NBNOEU,NBELEM) 167 : SEGDES,MELEME 168 : MELEME=LRAC2 169 : SEGACT,MELEME 170 : NUM(1,1)=IPO1 171 : SEGDES,MELEME 172 : * ON REUNIT LES 2 DEMI-CERCLES: 172 : CALL ECROBJ('MAILLAGE',LRAC2) 172 : CALL ECROBJ('MAILLAGE',LRAC1) 172 : CALL PRFUSE 173 : IF (IERR.NE.0) RETURN 173 : CALL LIROBJ('MAILLAGE',LRAC,1,IRETOU) 174 : IF (IERR.NE.0) RETURN 175 : MELEME=LRAC1 176 : SEGSUP,MELEME 177 : MELEME=LRAC2 178 : SEGSUP,MELEME 179 : * 180 : MELEME=L3 181 : SEGSUP,MELEME 182 : MELEME=NL3 183 : SEGSUP,MELEME 184 : MELEME=L4 185 : SEGSUP,MELEME 186 : MELEME=NL4 187 : SEGSUP,MELEME 188 : * 189 : END 190 :
© Cast3M 2003 - All rights reserved.
Disclaimer