1 : C DYN204 SOURCE CHAT 05/01/12 23:10:37 5004
2 : SUBROUTINE DYN204(I,ITLB,ITYP,KTLIAB,NPLB)
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 : * Remplissage des tableaux de description des liaisons sur *
11 : * la base @ partir des informations contenues dans la *
12 : * table ITLB (liaison de type PROFIL_PROFIL_...) *
13 : * Liaison PROFIL_PROFIL_INTERIEUR *
14 : * Liaison PROFIL_PROFIL_EXTERIEUR *
15 : * *
16 : * Param}tres: *
17 : * *
18 : * e I Num{ro de la liaison. *
19 : * e ITLB Table rassemblant la description d'une liaison. *
20 : * e ITYP Type de la liaison. *
21 : * s KTLIAB Segment descriptif des liaisons sur base B. *
22 : * e NPLB Nombre total de points. *
23 : * *
24 : * *
25 : * Auteur, date de cr{ation: *
26 : * *
27 : * Lionel VIVAN, le 1 f{vrier 1991. *
28 : * *
29 : *--------------------------------------------------------------------*
30 : -INC CCOPTIO
31 : -INC SMCOORD
32 : -INC SMELEME
33 : *
34 : SEGMENT MTLIAB
35 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB)
36 : REAL*8 XPALB(NLIAB,NXPALB)
37 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP)
38 : ENDSEGMENT
39 : *
40 : LOGICAL L1,L0
41 : *
42 : MTLIAB = KTLIAB
43 : NLIAB = XPALB(/1)
44 : *
45 : * --- choc {l{mentaire PROFIL_PROFIL_INTERIEUR
46 : * --- choc {l{mentaire PROFIL_PROFIL_EXTERIEUR
47 : *
48 : IF (ITYP.EQ.31 .OR. ITYP.EQ.32) THEN
48 : CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_FIXE',L0,IP0,
49 : & 'MAILLAGE',I1,X1,' ',L1,IMA1)
50 : IF (IERR.NE.0) RETURN
50 : CALL ACCTAB(ITLB,'MOT',I0,X0,'PROFIL_MOBILE',L0,IP0,
51 : & 'MAILLAGE',I1,X1,' ',L1,IMA2)
52 : IF (IERR.NE.0) RETURN
52 : CALL ACCTAB(ITLB,'MOT',I0,X0,'NORMALE',L0,IP0,
53 : & 'POINT',I1,X1,' ',L1,INOR)
54 : IF (IERR.NE.0) RETURN
54 : CALL ACCTAB(ITLB,'MOT',I1,X0,'RAIDEUR',L0,IP0,
55 : & 'FLOTTANT',I0,XRAID,' ',L1,IP1)
56 : IF (IERR.NE.0) RETURN
56 : CALL ACCTAB(ITLB,'MOT',I1,X0,'SUPPORT',L0,IP0,
57 : & 'POINT',I0,X1,' ',L1,ISUP)
58 : IF (IERR.NE.0) RETURN
58 : CALL ACCTAB(ITLB,'MOT',I1,X0,'EXPOSANT_RAIDEUR',L0,IP0,
59 : & 'FLOTTANT',I0,XPUIS,' ',L1,IP1)
60 : IF (IERR.NE.0) RETURN
61 : *
62 : IPALB(I,1) = ITYP
63 : IPALB(I,3) = IDIM
64 : XPALB(I,1) = XRAID
65 : XPALB(I,3) = XPUIS
66 : ID1 = 3
67 : IP1 = 5
68 : *
69 : * le maillage IMA1 est en {l{ment de type POI1
70 : MELEME = IMA1
71 : SEGACT MELEME
72 : NOMBN1 = NUM(/2)
73 : IPALB(I,4) = NOMBN1
74 : IDP = ID1 + 5*IDIM
75 : DO 12 IE = 1,NOMBN1
76 : IPT = NUM(1,IE)
77 : INPT = ( IDIM + 1 ) * ( IPT - 1 )
78 : DO 14 ID = 1,IDIM
79 : XPALB(I,IDP+ID) = XCOOR(INPT + ID)
80 : 14 CONTINUE
81 : * end do
82 : IDP = IDP + IDIM
83 : 12 CONTINUE
84 : * end do
85 : SEGDES MELEME
86 : *
87 : * le maillage IMA2 est en {l{ment de type POI1
88 : MELEME = IMA2
89 : SEGACT MELEME
90 : NOMBN2 = NUM(/2)
91 : IPALB(I,5) = NOMBN2
92 : DO 16 IE = 1,NOMBN2
93 : IPT = NUM(1,IE)
94 : INPT = ( IDIM + 1 ) * ( IPT - 1 )
95 : DO 18 ID = 1,IDIM
96 : XPALB(I,IDP+ID) = XCOOR(INPT + ID)
97 : 18 CONTINUE
98 : * end do
99 : IDP = IDP + IDIM
100 : 16 CONTINUE
101 : * end do
102 : SEGDES MELEME
102 : CALL PLACE2(JPLIB,NPLB,IPLAC,ISUP)
103 : IPLIB(I,1) = IPLAC
104 : *
105 : * cr{ation d'un rep}re orthonorm{ dans le plan des maillages
106 : * le point origine est le premier point de IMA1
106 : CALL DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
107 : IF (IERR.NE.0) RETURN
108 : *
109 : * coefficient des droites form{es par les {l{ments de IMA1
109 : CALL DYNE29(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
110 : *
111 : * position initiale de IMA2 par rapport @ IMA1
111 : CALL DYNE30(IPALB,XPALB,NLIAB,NOMBN1,NOMBN2,I,ID1,IP1)
112 : *
113 : * calcul de la section du profil mobile
113 : CALL DYNE33(XPALB,IPALB,NLIAB,I,ID1,XSECT)
114 : XPALB(I,2) = XSECT
115 : *
116 : * --- choc {l{mentaire PROFIL_...
117 : *
118 : * ELSE IF (ITYP.EQ. ) THEN
119 : * ...
120 : * ...
121 : ENDIF
122 : *
123 : END
124 :
125 :
© Cast3M 2003 - All rights reserved.
Disclaimer