1 : C DYNE28 SOURCE CHAT 05/01/12 23:16:40 5004
2 : SUBROUTINE DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : *--------------------------------------------------------------------*
6 : * *
7 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
8 : * ________________________________________________ *
9 : * *
10 : * Cr{ation d'un rep}re orthonorm{ dans un plan. *
11 : * *
12 : * Param}tres: *
13 : * *
14 : * e INOR vecteur perpendiculaire aux profils *
15 : * e ISUP point support *
16 : * es XPALB tableau de description des liaisons sur base B *
17 : * e NLIAB nombre total de liaisons sur base B *
18 : * e I num{ro de la liaison trait{e *
19 : * e ID1 indice de tableau *
20 : * *
21 : * *
22 : * Auteur, date de cr{ation: *
23 : * *
24 : * Lionel VIVAN, le 1 f{vrier 1991. *
25 : * *
26 : *--------------------------------------------------------------------*
27 : -INC CCOPTIO
28 : -INC SMCOORD
29 : *
30 : REAL*8 XPALB(NLIAB,*)
31 : PARAMETER ( ZERO = 0.D0 )
32 : *
33 : ID2 = ID1 + IDIM
34 : ID3 = ID1 + 2*IDIM
35 : ID4 = ID1 + 3*IDIM
36 : ID5 = ID1 + 4*IDIM
37 : ID6 = ID1 + 5*IDIM
38 : *
39 : * normalisation de la normale
40 : *
41 : IPNO = (IDIM + 1) * (INOR - 1)
42 : IPSU = (IDIM + 1) * (ISUP - 1)
43 : PS = 0.D0
44 : DO 10 ID = 1,IDIM
45 : XC = XCOOR(IPNO + ID)
46 : PS = PS + XC * XC
47 : XPALB(I,ID1+ID) = XCOOR(IPSU + ID)
48 : 10 CONTINUE
49 : * end do
50 : IF (PS.LE.ZERO) THEN
50 : CALL ERREUR(162)
51 : RETURN
52 : ENDIF
53 : PS = SQRT(PS)
54 : DO 12 ID = 1,IDIM
55 : XPALB(I,ID5+ID) = XCOOR(IPNO + ID) / PS
56 : 12 CONTINUE
57 : * end do
58 : *
59 : * Le premier vecteur orthonorm{ est form{ par le premier {l{ment
60 : PS = ZERO
61 : ID61 = ID6 + IDIM
62 : DO 14 ID = 1,IDIM
63 : XPALB(I,ID2+ID) = XPALB(I,ID6+ID)
64 : XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
65 : PS = PS + XXX * XXX
66 : 14 CONTINUE
67 : * end do
68 : IF (PS.LE.ZERO) THEN
68 : CALL ERREUR(162)
69 : RETURN
70 : ENDIF
71 : PS = SQRT(PS)
72 : DO 16 ID = 1,IDIM
73 : XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
74 : XPALB(I,ID3+ID) = XXX / PS
75 : 16 CONTINUE
76 : * end do
77 : *
78 : * Le second vecteur orthonorm{ est form{ par le produit vectoriel
79 : XPALB(I,ID4+1) = XPALB(I,ID5+2)*XPALB(I,ID3+3) -
80 : & XPALB(I,ID5+3)*XPALB(I,ID3+2)
81 : XPALB(I,ID4+2) = XPALB(I,ID5+3)*XPALB(I,ID3+1) -
82 : & XPALB(I,ID5+1)*XPALB(I,ID3+3)
83 : XPALB(I,ID4+3) = XPALB(I,ID5+1)*XPALB(I,ID3+2) -
84 : & XPALB(I,ID5+2)*XPALB(I,ID3+1)
85 : *
86 : END
87 :
© Cast3M 2003 - All rights reserved.
Disclaimer