1 : C DEVLIR SOURCE CHAT 11/03/16 21:19:12 6902
2 : SUBROUTINE DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,
3 : & NINS,ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN)
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8(A-H,O-Z)
6 : *--------------------------------------------------------------------*
7 : * *
8 : * Op{rateur DYNE : algorithme de Fu - de Vogelaere *
9 : * ________________________________________________ *
10 : * *
11 : * Lecture et coh{rence des op{randes, v{rification des supports *
12 : * objets TBAS, TKM, TA et TINIT. *
13 : * Obtention de la liste des points de r{f{rence. *
14 : * *
15 : * Param}tres: *
16 : * *
17 : * s ITBAS Table repr{sentant une base modale *
18 : * s ITKM Table contenant les matrices de raideur et de masse *
19 : * s ITA Table contenant la matrice des amortissements *
20 : * s ITLIA Table rassemblant la description des liaisons *
21 : * s ITCHAR Table contenant les chargements *
22 : * s ITINIT Table donnant les conditions initiales *
23 : * s NP Nombre de pas de temps *
24 : * s PDT Valeur du pas de temps *
25 : * s NINS On veut un r{sultat tous les NINS pas de calcul *
26 : * s ITSORT Table d{finissant les r{sultats attendus *
27 : * s ITREDU Table contenant les noms d'inconnues de la base B *
28 : * auxquelles on se restreint *
29 : * s KPREF Segment des points de r{f{rence *
30 : * s KCPR Segment des points *
31 : * *
32 : * Auteur, date de cr{ation: *
33 : * *
34 : * Denis ROBERT-MOUGIN, le 25 mai 1989. *
35 : * *
36 : *--------------------------------------------------------------------*
37 : -INC CCOPTIO
38 : -INC SMMODEL
39 : segment mwinit
40 : integer jpdep,jpvit,jrepr
41 : endsegment
42 : segment mtbas
43 : integer itbmod,lsstru(np1),nsstru
44 : endsegment
45 : *
46 : PARAMETER ( ZERO=0.D0 , NTABLE=8 )
47 : LOGICAL LMODYN, LOAMOR,L0,L1
48 : CHARACTER*8 TYPOBJ
49 : CHARACTER*72 CHARRE,CHARRI
50 : *
51 : NINS = 1
52 : MPSOR = 0
53 : LMODYN = .false.
54 : ITDYN = 0
55 : *
56 : IMESS = 0
57 : ITBAS = 0
58 : ITKM = 0
59 : ITA = 0
60 : ITLIA = 0
61 : ITCHAR = 0
62 : ITINIT = 0
63 : ITSORT = 0
64 : ITREDU = 0
65 : ITINV = 0
66 : ITIND = 0
67 :
67 : CALL LIRTAB('PASAPAS',ITDYN,0,IRET)
68 : if (iret.ne.0) lmodyn = .true.
69 : *
70 : * A/ Lecture des op{randes, les tables puis les autres:
71 : *
72 : if (lmodyn) then
72 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'MODELE',L0,IP0,
73 : & 'MMODEL',I1,X1,CHARRE,L1,ITMOD)
74 : IF (IERR.NE.0) RETURN
74 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'CARACTERISTIQUES',L0,IP0,
75 : & 'MCHAML',I1,X1,CHARRE,L1,ITCARA)
76 : IF (IERR.NE.0) RETURN
76 : call ecrcha('MECANIQUE')
76 : call ecrcha('FORM')
76 : call ecrobj('MMODEL',ITMOD)
76 : call extrai
76 : call lirobj('MMODEL',ITMO1,0,iret)
77 : mmodel = itmod
78 : segact mmodel
79 : np1 = kmodel(/1)
80 : segini mtbas
81 : itbas = mtbas
82 : itbmod = itmo1
83 : else
83 : CALL MESLIR(-261)
83 : CALL LIRTAB('BASE_MODALE',ITBAS,0,IRET)
84 : IF (IRET.EQ.0) THEN
84 : CALL LIRTAB('ENSEMBLE_DE_BASES',ITBAS,0,IRET)
85 : ENDIF
86 : IF (IERR.NE.0) RETURN
87 : IF (ITBAS.NE.0 .AND. IIMPI.EQ.333) THEN
88 : WRITE(IOIMP,*)' on a lu la table d{finissant la base modale.'
89 : ENDIF
90 : endif
91 : *
92 :
93 : if (lmodyn) then
94 : else
94 : CALL MESLIR(-262)
94 : CALL LIRTAB('RAIDEUR_ET_MASSE',ITKM,0,IRET)
95 : IF (IERR.NE.0) RETURN
96 : IF (ITKM.NE.0 .AND. IIMPI.EQ.333) THEN
97 : WRITE(IOIMP,*)
98 : & ' on a lu la table d{finissant les matrices de raideurs.'
99 : ENDIF
100 : endif
101 : *
102 : if (lmodyn) then
102 : call ecrobj('MCHAML',itcara)
102 : call ecrobj('MMODEL',itbmod)
102 : call redu
102 : call lirobj('MCHAML',ipche1,1,iret)
102 : call ecrcha('AMOR')
102 : call ecrobj('MCHAML',ipche1)
102 : call exis
102 : call lirlog(loamor,1,iret)
103 : if (loamor) then
103 : call ecrobj('MCHAML',itcara)
103 : call ecrobj('MMODEL',itmod)
103 : call amor
103 : call lirobj('RIGIDITE',ITA,1,iret)
104 : IF (IERR.NE.0) RETURN
105 : endif
106 : else
106 : CALL MESLIR(-263)
106 : CALL LIRTAB('AMORTISSEMENT',ITA,0,IRET)
107 : IF (IERR.NE.0) RETURN
108 : IF (ITA.NE.0 .AND. IIMPI.EQ.333) THEN
109 : WRITE(IOIMP,*)
110 : & ' on a lu la table d{finissant une matrice d''amortissement.'
111 : ENDIF
112 : endif
113 : *
114 : if (lmodyn) then
114 : call ecrcha('LIAISON')
114 : call ecrcha('FORM')
114 : call ecrobj('MMODEL',ITMOD)
114 : call exis
114 : call lirobj('LOGIQUE',itlog,0,iret)
115 : if (itlog.eq.1) then
115 : call ecrcha('LIAISON')
115 : call ecrcha('FORM')
115 : call ecrobj('MMODEL',ITMOD)
115 : call extrai
115 : call lirobj('MMODEL',itlia,0,iret)
116 : endif
117 : if (ierr.ne.0) return
118 : else
118 : CALL MESLIR(-264)
118 : CALL LIRTAB('LIAISON',ITLIA,0,IRET)
119 : IF (IERR.NE.0) RETURN
120 : IF (ITLIA.NE.0 .AND. IIMPI.EQ.333) THEN
121 : WRITE(IOIMP,*)' on a lu la table d{finissant les liaisons.'
122 : ENDIF
123 : endif
124 : *
125 : if (lmodyn) then
126 : typobj = ' '
127 : irep = 0
128 : ITCHAR = 0
128 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'CHARGEMENT',L0,IP0,
129 : & typobj,I1,X1,CHARRE,L1,irep)
130 : if (typobj.eq.'CHARGEME') ITCHAR = irep
131 : else
131 : CALL MESLIR(-265)
131 : CALL LIRTAB('CHARGEMENT',ITCHAR,0,IRET)
132 : IF (IERR.NE.0) RETURN
133 : IF (ITCHAR.NE.0 .AND. IIMPI.EQ.333) THEN
134 : WRITE(IOIMP,*)' on a lu la table d{finissant les chargements.'
135 : ENDIF
136 : endif
137 : *
138 : if (lmodyn) then
139 : typobj = ' '
140 : irep = 0
140 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'INIT_DYNE',L0,IP0,
141 : & typobj,I1,X1,CHARRE,L1,IREP)
142 :
143 : if (typobj.eq.'TABLE') then
144 : segini mwinit
145 : itinit = mwinit
146 : jrepr = irep
147 : else
148 : itinv = 0
149 : itind = 0
150 : typobj = ' '
150 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'DEPLACEMENTS',L0,IP0,
151 : & typobj,I1,X1,CHARRE,L1,ITAD)
152 : if (typobj.eq.'TABLE') then
152 : CALL ACCTAB(ITAD,'ENTIER',0,X0,' ',L0,IP0,
153 : & 'CHPOINT',I1,X1,CHARRE,L1,ITIND)
154 : endif
155 : typobj = ' '
155 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'VITESSES',L0,IP0,
156 : & typobj,I1,X1,CHARRE,L1,ITAV)
157 : if (typobj.eq.'TABLE') then
157 : CALL ACCTAB(ITAV,'ENTIER',0,X0,' ',L0,IP0,
158 : & 'CHPOINT',I1,X1,CHARRE,L1,ITINV)
159 : endif
160 : if(itinv.gt.0.or.itind.gt.0) then
161 : segini mwinit
162 : jpdep = itind
163 : jpvit = itinv
164 : itinit = mwinit
165 : endif
166 : endif
167 : else
167 : CALL MESLIR(-266)
168 :
168 : CALL LIRTAB('INITIAL',ITINIT,0,IRET)
169 : IF (IERR.NE.0) RETURN
170 : IF (ITINIT.NE.0 .AND. IIMPI.EQ.333) THEN
171 : WRITE(IOIMP,*)
172 : &' on a lu la table d{finissant les conditions initiales.'
173 : ENDIF
174 : endif
175 :
176 : if (lmodyn) then
177 : * le traitement des reprises semble �tre fait dans devalo
178 : else
178 : CALL LIRTAB('REPRISE',IREP,0,IRET)
179 : IF (IERR.NE.0) RETURN
180 : IF (IREP.NE.0 .AND. IIMPI.EQ.333) THEN
181 : WRITE(IOIMP,*)
182 : &' on a lu la table d{finissant la reprise'
183 : ENDIF
184 : endif
185 : *
186 : if (lmodyn) then
187 : ITSORT = 0
188 : typobj = ' '
188 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'SORTIE',L0,IP0,
189 : & typobj,I1,X1,CHARRE,L1,ITSOR1)
190 : if (typobj.eq.'TABLE') then
191 : ITSORT = ITSOR1
192 : endif
193 : else
193 : CALL MESLIR(-267)
193 : CALL LIRTAB('SORTIE',ITSORT,0,IRET)
194 : IF (IERR.NE.0) RETURN
195 : IF (ITSORT.NE.0 .AND. IIMPI.EQ.333) THEN
196 : WRITE(IOIMP,*)' on a lu la table d{finissant les sorties.'
197 : ENDIF
198 : endif
199 : *
200 : if (lmodyn) then
201 : else
201 : CALL MESLIR(-268)
201 : CALL LIRTAB('RESTRICTION',ITREDU,0,IRET)
202 : IF (IERR.NE.0) RETURN
203 : endif
204 : *
205 : if (lmodyn) then
205 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_TEMPS',L0,IP0,
206 : & 'FLOTTANT',I1,pdt,CHARRE,L1,IP1)
206 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'NOMBRE_PAS',L0,IP0,
207 : & 'ENTIER',np,X1,CHARRE,L1,IP1)
208 :
209 : typobj = ' '
210 : nins = 1
210 : CALL ACCTAB(ITDYN,'MOT',IM,X0,'PAS_DE_SORTIE',L0,IP0,
211 : & typobj,I1,X1,CHARRE,L1,IP1)
212 : if (typobj.eq.'ENTIER') nins = I1
213 : else
213 : CALL MESLIR(-269)
213 : CALL LIRENT(NP,1,IRET)
214 : IF (IERR.NE.0) RETURN
215 : *
215 : CALL MESLIR(-270)
215 : CALL LIRREE(PDT,1,IRET)
216 : IF (IERR.NE.0) RETURN
217 : *
217 : CALL MESLIR(-271)
217 : CALL LIRENT(NINS,0,IRET)
218 : IF (IERR.NE.0) RETURN
219 : endif
220 : *
221 : * B/ Coh{rence des op{randes
222 : *
223 : IF (ITBAS.EQ.0 .AND. ITKM.EQ.0) THEN
223 : CALL ERREUR(478)
224 : RETURN
225 : ENDIF
226 : IF (ITCHAR.EQ.0 .AND. ITINIT.EQ.0 .AND. IREP.EQ.0) THEN
226 : CALL ERREUR(479)
227 : RETURN
228 : ENDIF
229 : IF (NP.LE.0) THEN
229 : CALL ERREUR(480)
230 : RETURN
231 : ENDIF
232 : IF (PDT.LE.ZERO) THEN
232 : CALL ERREUR(481)
233 : RETURN
234 : ENDIF
235 : *
236 : * C/ V{rification des supports des objets TBAS, TKM, TA et TINIT
237 : * et obtention de la liste des points de r{f{rence
238 : *
239 : if (lmodyn) then
240 : it1 = itbmod
241 : else
242 : it1 = itbas
243 : endif
243 : CALL DYNE13(IT1,ITKM,KPREF,KCPR,LMODYN)
244 : IF (IERR.NE.0) RETURN
245 : *
246 : END
247 :
248 :
249 :
250 :
251 :
252 :
253 :
254 :
© Cast3M 2003 - All rights reserved.
Disclaimer