1 : C CONGE2 SOURCE CHAT 05/01/12 22:17:07 5004 2 : SUBROUTINE CONGE2 (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 2 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * CREER UN CONGE DE RACCORDEMENT ENTRE DEUX LIGNES 14 : * 15 : * TYPE DU CONGE : CIRCULAIRE 16 : * 17 : * MODULES UTILISES: 18 : * ----------------- 19 : * 20 : -INC CCOPTIO 21 : -INC SMELEME 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * L1 (E) PREMIERE LIGNE A RACCORDER 27 : * L2 (E) DEUXIEME LIGNE A RACCORDER 28 : * RCONGE (E) RAYON DU CONGE DU RACCORDEMENT 29 : * NCONGE (E) FACTEUR DE DECOUPAGE DU CONGE (CONVENTIONS 30 : * CLASSIQUES SUR SON SIGNE) 31 : * = 0 SI NON FOURNI 32 : * NL1 (S) LIGNE APPUYEE SUR L1 ET ABOUTISSANT SUR LE CONGE 33 : * LRAC (S) CONGE DE RACCORDEMENT 34 : * NL2 (S) LIGNE APPUYEE SUR L2 ET COMMENCANT SUR LE CONGE 35 : * 36 : INTEGER NCONGE 37 : * 38 : * CONSTANTES: 39 : * ----------- 40 : * 41 : PARAMETER (DEMI=0.5D0) 42 : * 43 : * VARIABLES: 44 : * ---------- 45 : * 46 : * ANG = DEMI ANGLE AU SOMMET DES DEUX DROITES 47 : * DID = DISTANCE DU PT D'INTERSECTION AU PT D'UNE DROITE 48 : * DIC = DISTANCE DU PT D'INTERSECTION AU CENTRE DU CERCLE 49 : * RESULT = 'OK ' OU 'PARA' OU 'NON ' 50 : * NBNOEU = NOMBRE DE NOEUD DE L'ELEMENT 51 : * NBELEM = NOMBRE D'ELEMENT 52 : * 53 : INTEGER N,NBNOEU,NBELEM,NL 54 : CHARACTER*4 RESULT 55 : * 56 : * AUTEUR, DATE DE CREATION: 57 : * ------------------------- 58 : * 59 : * LIONEL VIVAN 20 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 DE LA VALEUR DE RESULT 92 : * 92 : CALL INT2D(IP9,IP8,IP1,IP2,INTERS,RESULT) 93 : IF (IERR.NE.0) RETURN 94 : IF (RESULT.EQ.'PARA') THEN 94 : CALL ERREUR(397) 95 : RETURN 96 : ELSE IF (RESULT.EQ.'NON ') THEN 96 : CALL ERREUR(398) 97 : RETURN 98 : END IF 99 : * 99 : CALL EXCOO1(IP1,X1,Y1,Z1,D1) 99 : CALL EXCOO1(IP2,X2,Y2,Z2,D2) 99 : CALL EXCOO1(IP8,X8,Y8,Z8,D8) 99 : CALL EXCOO1(IP9,X9,Y9,Z9,D9) 99 : CALL EXCOO1(INTERS,XI,YI,ZI,DI) 100 : * 101 : * CONSTRUCTION DES VECTEURS P1P2 P9P8 102 : P1P21=X2-X1 103 : P1P22=Y2-Y1 104 : P1P23=Z2-Z1 105 : P9P81=X8-X9 106 : P9P82=Y8-Y9 107 : P9P83=Z8-Z9 108 : * 109 : PSA=(P1P21*P9P81)+(P1P22*P9P82)+(P1P23*P9P83) 110 : XN1=SQRT(P1P21**2+P1P22**2+P1P23**2) 111 : XN8=SQRT(P9P81**2+P9P82**2+P9P83**2) 112 : * 113 : * DEMI-ANGLE AU SOMMET DES DEUX DROITES 114 : ANG=(ACOS(PSA/(XN1*XN8)))*DEMI 115 : * 116 : * DISTANCE PT D'INTERSECTION - PT D'EXTREMITE DE LA DROITE 117 : DID=RCONGE/TAN(ANG) 118 : * 119 : * DISTANCE PT D'INTERSECTION - PT CENTRE DU CERCLE 120 : DIC=SQRT(RCONGE**2+DID**2) 121 : * 122 : * DETERMINATION DU POINT E (OU DEBUTERA LE CONGE) 123 : * 124 : XE=(DID/XN8)*P9P81+XI 125 : YE=(DID/XN8)*P9P82+YI 126 : ZE=(DID/XN8)*P9P83+ZI 126 : CALL CREPO1(XE,YE,ZE,IPE) 127 : * 128 : * DETERMINATION DU POINT F (OU FINIRA LE CONGE) 129 : * 130 : XF=(DID/XN1)*P1P21+XI 131 : YF=(DID/XN1)*P1P22+YI 132 : ZF=(DID/XN1)*P1P23+ZI 132 : CALL CREPO1(XF,YF,ZF,IPF) 133 : * 134 : * DETERMINATION DU POINT O (CENTRE DU CERCLE OU S'APPUIERA LE CONGE) 135 : * 136 : XEF=XE+XF-2.D0*XI 137 : YEF=YE+YF-2.D0*YI 138 : ZEF=ZE+ZF-2.D0*ZI 139 : PRO=DIC/SQRT(XEF**2+YEF**2+ZEF**2) 140 : XO=PRO*XEF+XI 141 : YO=PRO*YEF+YI 142 : ZO=PRO*ZEF+ZI 142 : CALL CREPO1(XO,YO,ZO,IPO) 143 : * 144 : * CREATION DES EXTREMITES DES LIGNES A RACCORDER 145 : * 145 : CALL RACLI1(L1,IPE,NL1) 146 : IF (IERR.NE.0) RETURN 146 : CALL RACLI2(IPF,L2,NL2) 147 : IF (IERR.NE.0) RETURN 148 : * 149 : * CREATION ARC DE CERCLE (COMMENCANT EN E, FINISSANT EN F) 150 : * 151 : IF (NCONGE.NE.0) THEN 151 : CALL ECRENT(NCONGE) 152 : END IF 152 : CALL ECROBJ('POINT',IPF) 152 : CALL ECROBJ('POINT',IPO) 152 : CALL ECROBJ('POINT',IPE) 152 : CALL LIGNE(3,1,DEN1,DEN2,N) 153 : IF (IERR.NE.0) RETURN 153 : CALL LIROBJ('MAILLAGE',LRAC,1,IRETOU) 154 : IF (IERR .NE. 0) RETURN 154 : CALL EXCOO1(IPE,XE,YE,ZE,DE) 154 : CALL EXCOO1(IPF,XF,YF,ZF,DF) 155 : IF (NCONGE.GT.0) THEN 156 : MELEME=LRAC 157 : SEGACT,MELEME 158 : NBNOEU=NUM(/1) 159 : NBELEM=NUM(/2) 160 : IP1C=NUM(NBNOEU,1) 160 : CALL EXCOO1(IP1C,X1C,Y1C,Z1C,D1C) 160 : CALL MODPOI(XE,YE,ZE,D1C,IPE) 161 : IP2C=NUM(1,NBELEM) 161 : CALL EXCOO1(IP2C,X2C,Y2C,Z2C,D2C) 161 : CALL MODPOI(XF,YF,ZF,D2C,IPF) 162 : SEGDES,MELEME 163 : END IF 164 : * 165 : END 166 :
© Cast3M 2003 - All rights reserved.
Disclaimer