Download tufeps.eso

Back to the list

   1 : C TUFEPS    SOURCE    CHAT      05/01/13    03:55:05     5004           
   2 :       SUBROUTINE TUFEPS(XDDL,CAR,EPS,KERRE)
   3 : C----------------------------------------------------------------------
   4 : C     DEFORMATIONS POUR L ELEMENT TUYAU FISSURE
   5 : C     
   6 : C ENTREES
   7 : C     XDDL(12)    = LES DDL AUX 2 NOEUDS
   8 : C     CAR(9)      = LES CARACTERISTIQUES
   9 : C                      CAR(1) = RAYON  EXTERIEUR DU TUYAU
  10 : C                      CAR(2) = EPAISSEUR DU TUYAU
  11 : C                      CAR(3),CAR(4),CAR(5)  AXE DU TUYAU
  12 : C                      CAR(6),CAR(7),CAR(8)  DIRECTION DE LA FISSU
  13 : C                      CAR(9)  = ANGLE DE LA FISSURE
  14 : C  TABLEAU DE TRAVAIL
  15 : C  SORTIES
  16 : C     EPS(8)     = DEFORMATIONS
  17 : C     
  18 : C     KERRE = CODE D'ERREUR
  19 : C             0 SI PAS DE PROBLEME, SINON :
  20 : C             1 SI V2 EST NUL OU SI V1 ET V2 SONT COLINEAIRES
  21 : C             2 SI V1 EST NUL
  22 : C             3 SI TUYAU TROP EPAIS
  23 : C----------------------------------------------------------------------
  24 :       IMPLICIT INTEGER(I-N)
  25 :       IMPLICIT REAL*8(A-H,O-Z)
  26 : C    Include contenant quelques constantes dont XPI :
  27 : -INC CCREEL
  28 :       PARAMETER(UN=1.D0,XEPS=1.D-10)
  29 :       DIMENSION CAR(*),EPS(*),XDDL(*)
  30 :       DIMENSION XDDLOC(12),V1(3),V2(3),BV1(3),BV2(3),BPSS(3,3)
  31 :       KERRE=0
  32 : C     
  33 :       V1(1)=CAR(3)
  34 :       V1(2)=CAR(4)
  35 :       V1(3)=CAR(5)
  36 :       V2(1)=CAR(6)
  37 :       V2(2)=CAR(7)
  38 :       V2(3)=CAR(8)
  39 : C     
  40 : C     NORMALISATION DES VECTEURS V1 ET V2.
  41 : C     
  42 :       XNV1 = XZERO
  43 :       XNV2 = XZERO
  44 :       DO 5 I=1,3
  45 :          XNV1 = XNV1 + (V1(I)*V1(I))
  46 :          XNV2 = XNV2 + (V2(I)*V2(I))
  47 :  5    CONTINUE
  48 :       IF (XNV1.LT.XEPS) THEN
  49 :          KERRE = 2
  50 :          GOTO 666
  51 :       ENDIF
  52 :       IF (XNV2.LT.XEPS) THEN
  53 :          KERRE = 1
  54 :          GOTO 666
  55 :       ENDIF
  56 :       XNV1 = UN/SQRT(XNV1)
  57 :       XNV2 = UN/SQRT(XNV2)
  58 :       DO 10 I=1,3
  59 :          BV1(I) = V1(I)*XNV1
  60 :          BV2(I) = V2(I)*XNV2
  61 :  10   CONTINUE
  62 : C     
  63 : C     ORTHOGONALISATION ET RENORMALISATION DE V2.
  64 : C     
  65 :       PS = (BV1(1)*BV2(1))+(BV1(2)*BV2(2))+(BV1(3)*BV2(3))
  66 : C     
  67 : C     TEST SUR LA COLINEARITE DE V1 ET V2.
  68 : C     
  69 :       IF(ABS(PS).GE.(.99D0)) THEN
  70 :          KERRE = 1
  71 :          GOTO 666
  72 :       ELSE
  73 :          XNV2 = UN/SQRT(UN-(PS**2))
  74 :          DO 15 I=1,3
  75 :             BV2(I) = XNV2*(BV2(I)-(PS*BV1(I)))
  76 :  15      CONTINUE
  77 :       ENDIF
  78 : C     
  79 : C     CALCUL DE LA MATRICE DE PASSAGE
  80 : C      LOCAL = BPSS * GLOBAL
  81 : C     V1 REPRESENTE L'AXE LOCAL DES Z
  82 : C     V2 REPRESENTE L'AXE LOCAL DES Y
  83 : C     
  84 :       DO 20 I=1,3
  85 :          BPSS(1,I) =BV1(I)
  86 :          BPSS(2,I) =BV2(I)
  87 :  20   CONTINUE
  88 :       BPSS(3,1) = (BPSS(1,2)*BPSS(2,3))-(BPSS(1,3)*BPSS(2,2))
  89 :       BPSS(3,2) = (BPSS(1,3)*BPSS(2,1))-(BPSS(1,1)*BPSS(2,3))
  90 :       BPSS(3,3) = (BPSS(1,1)*BPSS(2,2))-(BPSS(1,2)*BPSS(2,1))
  91 : C     
  92 : C     TRANSFORMATION DES DDL GLOBAUX EN DDL LOCAUX X AXE TUYAU
  93 : C                                                  Y POSITION FISSURE
  94 : C                                                  Z COMPLEMENT
  94 :       CALL MATVEC(XDDL,XDDLOC,BPSS,4)
  95 : C     
  96 :       EPS(1)=XDDLOC(7)-XDDLOC(1)
  97 :       EPS(2)=XDDLOC(8 )-XDDLOC(2)
  98 :       EPS(3)=XDDLOC(9 )-XDDLOC(3)
  99 :       EPS(4)=XDDLOC(10)-XDDLOC(4)
 100 :       EPS(5)=XDDLOC(11)-XDDLOC(5)
 101 :       EPS(6)=XDDLOC(12)-XDDLOC(6)
 102 :       EPS(7)=0.D0
 103 :       EPS(8)=0.D0
 104 : C     
 105 :  666  CONTINUE
 106 :       RETURN
 107 :       END
 108 : 
 109 : 
 110 :  
 111 :  
 112 :  

© Cast3M 2003 - All rights reserved.
Disclaimer