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