Sources Esope | Cast3M

conge2
C CONGE2    SOURCE    GOUNAND   24/10/09    21:15:03     12031          
      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)
*      WRITE(IOIMP,*) 'XI,YI,ZI,DI=',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
*
      XN1=SQRT(P1P21**2+P1P22**2+P1P23**2)
      XN8=SQRT(P9P81**2+P9P82**2+P9P83**2)
      P1P21=P1P21/XN1
      P1P22=P1P22/XN1
      P1P23=P1P23/XN1
      P9P81=P9P81/XN8
      P9P82=P9P82/XN8
      P9P83=P9P83/XN8
      PSA=(P1P21*P9P81)+(P1P22*P9P82)+(P1P23*P9P83)
*
*    DEMI-ANGLE AU SOMMET DES DEUX DROITES
*
      ANG=ACOS(PSA)*DEMI
*      WRITE(IOIMP,*) 'ANG=',ANG
*
*    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*P9P81+XI
      YE=DID*P9P82+YI
      ZE=DID*P9P83+ZI
      CALL CREPO1(XE,YE,ZE,IPE)
*
*    DETERMINATION DU POINT F (OU FINIRA LE CONGE)
*
      XF=DID*P1P21+XI
      YF=DID*P1P22+YI
      ZF=DID*P1P23+ZI
      CALL CREPO1(XF,YF,ZF,IPF)
*
*    DETERMINATION DU POINT O (CENTRE DU CERCLE OU S'APPUIERA LE CONGE)
*
      XEF=P9P81+P1P21
      YEF=P9P82+P1P22
      ZEF=P9P83+P1P23
      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