Numérotation des lignes :

conge2
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  

© Cast3M 2003 - Tous droits réservés.
Mentions légales