C CONGE2 SOURCE CHAT 05/01/12 22:17:07 5004 SUBROUTINE CONGE2 (L1,L2,RCONGE,NCONGE, NL1,LRAC,NL2) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) ************************************************************************ * * C O N G E 2 * ----------- * * FONCTION: * --------- * * CREER UN CONGE DE RACCORDEMENT ENTRE DEUX LIGNES * * TYPE DU CONGE : CIRCULAIRE * * MODULES UTILISES: * ----------------- * -INC PPARAM -INC CCOPTIO -INC SMELEME * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * L1 (E) PREMIERE LIGNE A RACCORDER * L2 (E) DEUXIEME LIGNE A RACCORDER * RCONGE (E) RAYON DU CONGE DU RACCORDEMENT * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS * CLASSIQUES SUR SON SIGNE) * = 0 SI NON FOURNI * NL1 (S) LIGNE APPUYEE SUR L1 ET ABOUTISSANT SUR LE CONGE * LRAC (S) CONGE DE RACCORDEMENT * NL2 (S) LIGNE APPUYEE SUR L2 ET COMMENCANT SUR LE CONGE * INTEGER NCONGE * * CONSTANTES: * ----------- * PARAMETER (DEMI=0.5D0) * * VARIABLES: * ---------- * * ANG = DEMI ANGLE AU SOMMET DES DEUX DROITES * DID = DISTANCE DU PT D'INTERSECTION AU PT D'UNE DROITE * DIC = DISTANCE DU PT D'INTERSECTION AU CENTRE DU CERCLE * RESULT = 'OK ' OU 'PARA' OU 'NON ' * NBNOEU = NOMBRE DE NOEUD DE L'ELEMENT * NBELEM = NOMBRE D'ELEMENT * INTEGER N,NBNOEU,NBELEM,NL CHARACTER*4 RESULT * * AUTEUR, DATE DE CREATION: * ------------------------- * * LIONEL VIVAN 20 NOVEMBRE 1987 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * ************************************************************************ * MELEME=L1 SEGACT,MELEME NL=LISOUS(/1) IF (NL.NE.0) THEN CALL ERREUR(25) RETURN END IF NBNOEU=NUM(/1) NBELEM=NUM(/2) IP9=NUM(NBNOEU,NBELEM) IP8=NUM(1,NBELEM) SEGDES,MELEME * MELEME=L2 SEGACT,MELEME NL=LISOUS(/1) IF (NL.NE.0) THEN CALL ERREUR(25) RETURN END IF NBNOEU=NUM(/1) IP1=NUM(1,1) IP2=NUM(NBNOEU,1) SEGDES,MELEME * * TEST DE LA VALEUR DE RESULT * CALL INT2D(IP9,IP8,IP1,IP2,INTERS,RESULT) IF (IERR.NE.0) RETURN IF (RESULT.EQ.'PARA') THEN CALL ERREUR(397) RETURN ELSE IF (RESULT.EQ.'NON ') THEN CALL ERREUR(398) RETURN END IF * CALL EXCOO1(IP1,X1,Y1,Z1,D1) CALL EXCOO1(IP2,X2,Y2,Z2,D2) CALL EXCOO1(IP8,X8,Y8,Z8,D8) CALL EXCOO1(IP9,X9,Y9,Z9,D9) CALL EXCOO1(INTERS,XI,YI,ZI,DI) * * CONSTRUCTION DES VECTEURS P1P2 P9P8 P1P21=X2-X1 P1P22=Y2-Y1 P1P23=Z2-Z1 P9P81=X8-X9 P9P82=Y8-Y9 P9P83=Z8-Z9 * PSA=(P1P21*P9P81)+(P1P22*P9P82)+(P1P23*P9P83) XN1=SQRT(P1P21**2+P1P22**2+P1P23**2) XN8=SQRT(P9P81**2+P9P82**2+P9P83**2) * * DEMI-ANGLE AU SOMMET DES DEUX DROITES ANG=(ACOS(PSA/(XN1*XN8)))*DEMI * * DISTANCE PT D'INTERSECTION - PT D'EXTREMITE DE LA DROITE DID=RCONGE/TAN(ANG) * * DISTANCE PT D'INTERSECTION - PT CENTRE DU CERCLE DIC=SQRT(RCONGE**2+DID**2) * * DETERMINATION DU POINT E (OU DEBUTERA LE CONGE) * XE=(DID/XN8)*P9P81+XI YE=(DID/XN8)*P9P82+YI ZE=(DID/XN8)*P9P83+ZI CALL CREPO1(XE,YE,ZE,IPE) * * DETERMINATION DU POINT F (OU FINIRA LE CONGE) * XF=(DID/XN1)*P1P21+XI YF=(DID/XN1)*P1P22+YI ZF=(DID/XN1)*P1P23+ZI CALL CREPO1(XF,YF,ZF,IPF) * * DETERMINATION DU POINT O (CENTRE DU CERCLE OU S'APPUIERA LE CONGE) * XEF=XE+XF-2.D0*XI YEF=YE+YF-2.D0*YI ZEF=ZE+ZF-2.D0*ZI PRO=DIC/SQRT(XEF**2+YEF**2+ZEF**2) XO=PRO*XEF+XI YO=PRO*YEF+YI ZO=PRO*ZEF+ZI CALL CREPO1(XO,YO,ZO,IPO) * * CREATION DES EXTREMITES DES LIGNES A RACCORDER * CALL RACLI1(L1,IPE,NL1) IF (IERR.NE.0) RETURN CALL RACLI2(IPF,L2,NL2) IF (IERR.NE.0) RETURN * * CREATION ARC DE CERCLE (COMMENCANT EN E, FINISSANT EN F) * IF (NCONGE.NE.0) THEN CALL ECRENT(NCONGE) END IF CALL ECROBJ('POINT',IPF) CALL ECROBJ('POINT',IPO) CALL ECROBJ('POINT',IPE) CALL LIGNE(3,1,DEN1,DEN2,N) IF (IERR.NE.0) RETURN CALL LIROBJ('MAILLAGE',LRAC,1,IRETOU) IF (IERR .NE. 0) RETURN CALL EXCOO1(IPE,XE,YE,ZE,DE) CALL EXCOO1(IPF,XF,YF,ZF,DF) IF (NCONGE.GT.0) THEN MELEME=LRAC SEGACT,MELEME NBNOEU=NUM(/1) NBELEM=NUM(/2) IP1C=NUM(NBNOEU,1) CALL EXCOO1(IP1C,X1C,Y1C,Z1C,D1C) CALL MODPOI(XE,YE,ZE,D1C,IPE) IP2C=NUM(1,NBELEM) CALL EXCOO1(IP2C,X2C,Y2C,Z2C,D2C) CALL MODPOI(XF,YF,ZF,D2C,IPF) SEGDES,MELEME END IF * END