1 : C DEVTRI SOURCE CHAT 05/01/12 22:47:54 5004
2 : SUBROUTINE DEVTRI(Q1,Q2,Q3,NA1,IINS2,FTOTA,XRES,ICHRES,NRES,
3 : & NCRES,NPRES,XVALA,INULA,NLIAA,NLSA,XRESLA,
4 : & XVALB,INULB,NLIAB,NLSB,XRESLB,ILIREA,ILIREB,
5 : & NTVAR,WEXT,WINT,XCHPFB,NPLB)
6 : IMPLICIT INTEGER(I-N)
7 : IMPLICIT REAL*8(A-H,O-Z)
8 : *--------------------------------------------------------------------*
9 : * *
10 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
11 : * ________________________________________________ *
12 : * *
13 : * Transfert des quantit{s initiales dans le tableau de *
14 : * sauvegarde, si l'on souhaite les garder ... *
15 : * *
16 : * Param}tres: *
17 : * *
18 : * e Q1(.,.) Vecteur des d{placements g{n{ralis{s *
19 : * e Q2(.,.) Vecteur des vitesses g{n{ralis{s *
20 : * e Q3(.,.) Vecteur des acc{l{rations g{n{ralis{s *
21 : * e NA1 Nombre total d'inconnues en base A *
22 : * e IINS2 Num{ro du pas de sortie *
23 : * e FTOTA Forces ext{rieures totalis{es en base A *
24 : * es XRES Valeurs des variables sauvegard{es *
25 : * e ICHRES Indique quelles variables seront sauvegard{es *
26 : * e NRES Nombre de variables ( principales et auxilliaires ) *
27 : * e NCRES Nombre de valeurs prises par les variables *
28 : * e NPRES Nombre de pas de sortie *
29 : * e XVALA Tableau contenant les variables internes de liaison *
30 : * e INULA Tableau contenant les rep}res des liaisons *
31 : * e NLIAA Nombre de liaisons sur la base A *
32 : * e NLSA Nombre de liaisons en sortie bas A *
33 : * es XRESLA Valeurs de variables de liaisons sauvegard{es base B *
34 : * e XVALB Tableau contenant les variables internes de liaison *
35 : * e INULB Tableau contenant les rep}res des liaisons *
36 : * e NLIAB Nombre de liaisons sur la base B *
37 : * e NLSB Nombre de liaisons en sortie bas B *
38 : * es XRESLB Valeurs de variables de liaisons sauvegard{es base B *
39 : * e,s WEXT travail des forces exterieures
40 : * e,s WINT travail des forces interieures (rigidite et
41 : * amortissement et forces de liaison )
42 : * *
43 : * Auteur, date de cr{ation: *
44 : * *
45 : * Lionel VIVAN, le 1 septembre 1989. *
46 : * *
47 : *--------------------------------------------------------------------*
48 : REAL*8 Q1(NA1,*),Q2(NA1,*),Q3(NA1,*)
49 : REAL*8 XVALA(NLIAA,4,*),XRESLA(NLSA,NPRES,*)
50 : REAL*8 XVALB(NLIAB,4,*),XRESLB(NLSB,NPRES,*)
51 : REAL*8 FTOTA(NA1,*),XRES(NRES,NCRES,*)
52 : REAL*8 XCHPFB(2,NLIAB,4,*)
53 : INTEGER ICHRES(*),INULA(*),INULB(*),ILIREA(NLSA,*),ILIREB(NLSB,*)
54 : *
55 : * Sauvegarde des valeurs initiales
56 : *
57 : IF (NRES.NE.0) THEN
58 : KRES = 0
59 : IF (ICHRES(1).EQ.1) THEN
60 : KRES = KRES + 1
61 : DO 10 I=1,NA1
62 : XRES(KRES,I,IINS2) = Q1(I,3)
63 : 10 CONTINUE
64 : * end do
65 : ENDIF
66 : IF (ICHRES(2).EQ.1) THEN
67 : KRES = KRES + 1
68 : DO 12 I=1,NA1
69 : XRES(KRES,I,IINS2) = Q2(I,3)
70 : 12 CONTINUE
71 : * end do
72 : ENDIF
73 : IF (ICHRES(3).EQ.1) THEN
74 : KRES = KRES + 1
75 : DO 14 I=1,NA1
76 : XRES(KRES,I,IINS2) = Q1(I,4)
77 : 14 CONTINUE
78 : * end do
79 : ENDIF
80 : IF (ICHRES(4).EQ.1) THEN
81 : KRES = KRES + 1
82 : DO 16 I=1,NA1
83 : XRES(KRES,I,IINS2) = Q2(I,4)
84 : 16 CONTINUE
85 : * end do
86 : ENDIF
87 : IF (ICHRES(5).EQ.1) THEN
88 : KRES = KRES + 1
89 : DO 18 I=1,NA1
90 : XRES(KRES,I,IINS2) = Q3(I,3)
91 : 18 CONTINUE
92 : * end do
93 : ENDIF
94 : IF (ICHRES(6).EQ.1) THEN
95 : KRES = KRES + 1
96 : DO 20 I=1,NA1
97 : XRES(KRES,I,IINS2) = Q3(I,4)
98 : 20 CONTINUE
99 : * end do
100 : ENDIF
101 :
102 : cc travaux
103 : IF (ICHRES(7).EQ.1) THEN
104 : KRES = KRES + 1
105 : DO 60 I=1,NA1
106 : XRES(KRES,I,IINS2) = 0.d0
107 : 60 CONTINUE
108 : ENDIF
109 : IF (ICHRES(7).EQ.1) THEN
110 : KRES = KRES + 1
111 : DO 70 I=1,NA1
112 : XRES(KRES,I,IINS2) = 0.d0
113 : 70 CONTINUE
114 : ENDIF
115 :
116 : ENDIF
117 : IF (ICHRES(9).EQ.1) THEN
118 : DO 30 IL = 1,NLSA
119 : IIL = INULA(IL)
120 : II = 0
121 : DO 32 IV = 1,NTVAR
122 : IF (ILIREA(IL,IV).EQ.1) THEN
123 : II = II + 1
124 : XRESLA(IL,IINS2,II) = XVALA(IIL,3,IV)
125 : ENDIF
126 : 32 CONTINUE
127 : * end do
128 : 30 CONTINUE
129 : * end do
130 : ENDIF
131 : IF (ICHRES(10).EQ.1) THEN
132 : DO 40 IL = 1,NLSB
133 : IIL = INULB(IL)
134 : II = 0
135 : DO 42 IV = 1,NTVAR
136 : IF (ILIREB(IL,IV).EQ.1) THEN
137 : II = II + 1
138 : XRESLB(IL,IINS2,II) = XVALB(IIL,3,IV)
139 : ELSE
140 : IF (ILIREB(IL,IV).EQ.2) THEN
141 : DO 43 IP=1,NPLB
142 : DO 44 ID=1,2
143 : II = II + 1
144 : XRESLB(IL,IINS2,II) = XCHPFB(ID,IIL,3,IP)
145 : 44 CONTINUE
146 : 43 CONTINUE
147 : ENDIF
148 : *
149 : ENDIF
150 : 42 CONTINUE
151 : * end do
152 : 40 CONTINUE
153 : * end do
154 : ENDIF
155 : *
156 : END
157 :
158 :
159 :
© Cast3M 2003 - All rights reserved.
Disclaimer