1 : C ELLA00 SOURCE PV 11/03/07 21:16:40 6885
2 : SUBROUTINE ELLA00
3 : C
4 : IMPLICIT INTEGER(I-N)
5 : IMPLICIT REAL*8 (A-H,O-Y)
6 : IMPLICIT COMPLEX*16 (Z)
7 : C
8 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9 : C A 11 27 04 4 90
10 : C OPERATEUR ELFE LAPLACE ACOU
11 : C
12 : C CALCUL DES FONCTIONS DE TRANSFERT D'UN RESEAU DE TUYAUTERIES
13 : C CONTENANT UN FLUIDE SANS ECOULEMENT PAR LA METHODE DITE "INTEGRALE".
14 : C LA SYNTAXE EST LA SUIVANTE :
15 : C
16 : C EVOL = ELFE LAPLACE POUTRE ACOU GEO1 (GEO2) CHP1 CHAM1 LFR S0 PT
17 : C COMP IMETH (IMP)
18 : C
19 : C
20 : C ELFE .............. MOT DESIGNANT L'OPERATEUR
21 : C
22 : C LAPLACE, ACOU ..... MOTS CLES POUR L'OPTION DE ELFE( CALCUL ACOUSTO-
23 : C MECANIQUE)
24 : C
25 : C GEO1 .............. OBJET TYPE MAILLAGE DONNANT LE RESEAU DE POUTRES
26 : C
27 : C GEO2 (FACULTATIF).. OBJET TYPE MAILLAGE POUR L'OPTION DONNANT LE
28 : C CHPOINT CONTENANT DEFORMATIONS ET PRESSIONS
29 : C
30 : C CHP1 .............. OBJET TYPE CHPOINT DONNANT LES COND. AUX LIMITES
31 : C
32 : C CHAM1 ............. OBJET TYPE NOUVEAU CHAMELEM POUR LES CARACT.
33 : C DU MATERIAU ET DU FLUIDE
34 : C
35 : C LFR ............... OBJET TYPE LISTREEL DEFINISSANT LES FREQUENCES
36 : C
37 : C S0 ............... OBJET TYPE REEL POUR LA TRANSFORMEE DE LAPLACE
38 : C
39 : C PT ................ OBJET TYPE POINT OU L'ON DESIRE LE DEPLACEMENT
40 : C
41 : C COMP .............. OBJET TYPE CHAR*2 DESIGNANT 'UX','UY' OU 'UZ'
42 : C 'RX','RY' OU 'RZ'
43 : C
44 : C IMETH ............. ENTIER : CHOIX DE LA METHODE DE RESOLUTION
45 : C
46 : C IMP (FALCULTATIF).. ENTIER : <>0 POUR IMPRESSION INTERMEDIAIRE
47 : C
48 : C
49 : C PARAMETRES :
50 : C ('NEANT')
51 : C
52 : C SORTIES :
53 : C
54 : C EVOLUTION --------> SI ON DESIRE LA FONCTION DE TRANSFERT
55 : C
56 : C CHAMPOINT --------> SI ON DESIRE LES VALEURS -DES DEPLACEMENTS
57 : C -DES PRESSIONS
58 : C EN MODULE ET EN PHASE AUX DIFFERENTS NOEUDS.
59 : C
60 : C
61 : C *****************************************************
62 : C * *
63 : C * Organigramme d'appel des diff{rentes SUBROUTINE *
64 : C * *
65 : C *****************************************************
66 : C
67 : C
68 : C ELLA00 (INTERFACE ESOPE <--> FORTRAN)
69 : C |
70 : C |
71 : C |-----> ELLA09 (CONVERSION DE UX , UY ... EN 1 , 2 , ...
72 : C |
73 : C |-----> ELLA08 (CONVERSION DE YOUN , NU ... EN 1 , 2 , ...)
74 : C |
75 : C |
76 : C |-----> ELLA11 (PROGRAMME PRINCIPAL FORTRAN)
77 : C |
78 : C |
79 : C |-----> ELLA12 (REMPLISSAGE DE LA 2}ME PARTIE DE ZA1
80 : C | qui ne d{pend pas de w)
81 : C |
82 : C |-----> ELLA21 (DETERMINATION, POUR CHAQUE POUTRE ET
83 : C | chaque frequence, de la matrice ZC1)
84 : C |
85 : C |
86 : C |-----> ELLA31 (VALEUR DES FCTS DE GREEN)
87 : C |
88 : C |<--------|
89 : C |
90 : C |
91 : C |-----> ELLA51 (RESOLUTION DU SYSTEME LIN{AIRE)
92 : C | (ELLA53)
93 : C |
94 : C |
95 : C |<--------|
96 : C |
97 : C |-----> ELLA23 (D{TERMINATION DES D{PLACEMENTS AUX NOEUDS DU
98 : C | sous-maillage dans le cas du calcul de la
99 : C | d{form{e )
100 : C |
101 : C | -------------
102 : C | | |
103 : C |--------------->| FIN |
104 : C | |
105 : C -------------
106 : C
107 : C AUTEURS : SAINT-DIZIER ET GORCY
108 : C DATE : 23 JANVIER 1991
109 : C
110 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
111 : C
112 : CHARACTER*4 COMP,CHAR
113 : C
114 : -INC CCREEL
115 : -INC CCOPTIO
116 : -INC SMCOORD
117 : -INC SMELEME
118 : -INC SMCHPOI
119 : -INC SMCHAML
120 : -INC SMLREEL
121 : -INC SMEVOLL
122 : C
123 : C ------------------- DIMENSIONNEMENT DES MATRICES CREEES LORS DE
124 : C CETTE INTERFACE FORTRAN <--> ESOPE
125 : C
126 : SEGMENT MATRES
127 : COMPLEX*16 ZA1 (NP28,NP28)
128 : COMPLEX*16 ZSM (NP28)
129 : COMPLEX*16 ZXX (NP28)
130 : COMPLEX*16 ZSOL (NNT14,NFRQ)
131 : REAL*8 COOR (3 ,NP2)
132 : REAL*8 GAMA (3 ,NP)
133 : REAL*8 CARACT(10,NP)
134 : REAL*8 XCL (17 ,NNT)
135 : REAL*8 XCOR (2 , 3 , NBELEM )
136 : REAL*8 VALDE1(2 , NBELEM , 3 )
137 : REAL*8 VALDE2(2 , NBELEM , 3 )
138 : REAL*8 VALDE3(2 , NBELEM , 1 )
139 : REAL*8 VALDE4(2 , NBELEM , 1 )
140 : INTEGER FLAG (NNT17)
141 : INTEGER CORRES(NP2)
142 : INTEGER NUMERO(NNT)
143 : INTEGER MASS (4,NNT)
144 : REAL*8 RMAS (4,NNT)
145 : INTEGER IRAILO(4,NNT)
146 : REAL*8 VALRAI(6,NNT)
147 : INTEGER IPIVO(NP28)
148 : INTEGER JPIVO(NP28)
149 : INTEGER IAUX(NP28)
150 : INTEGER IEXPER(NP)
151 : COMPLEX*16 ALPHAI(14,28,NP,NFRQ)
152 : ENDSEGMENT
153 : C
154 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
155 : C
156 : C EXPLICATION DE CES VARIABLES
157 : C ----------------------------
158 : C
159 : C NP : NOMBRE TOTAL DE POUTRES DU MAILLAGE
160 : C
161 : C NP2 : NP * 2
162 : C
163 : C NP10 : NP * 10
164 : C
165 : C NP28 : NP * 28
166 : C
167 : C NNT : NOMBRE TOTAL DE NOEUDS DU MAILLAGE
168 : C
169 : C NNT14 : NNT * 14
170 : C
171 : C NNT17 : NNT * 17
172 : C
173 : C NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
174 : C
175 : C ---------------------------------------------------------------------
176 : C
177 : C .................... ZA1 : MATRICE DE RESOLUTION
178 : C
179 : C .................... ZSM : VECTEUR SECOND MEMBRE
180 : C
181 : C .................... ZXX : VECTEUR INCONNU
182 : C
183 : C ZXX CONTIENT, POUR LES 2NP NOEUDS, DANS L'ORDRE SUIVANT :
184 : C
185 : C UX UY UZ RX RY RZ FX FY FZ MX MY MZ P Q
186 : C
187 : C
188 : C .................... ZSOL : TABLEAU SOLUTION POUR TOUTES LES FREQ.
189 : C
190 : C
191 : C .................... COOR : TABLEAU DES COORDONNEES
192 : C
193 : C UNE POUTRE COMPORTE 2 NOEUDS (P1 ET P2) --> 2*NP NOEUDS FICTIFS
194 : C
195 : C | COOR(1,2*INP-1) | COOR(1,2*INP)
196 : C P1 | COOR(2,2*INP-1) P2 | COOR(2,2*INP)
197 : C | COOR(3,2*INP-1) | COOR(3,2*INP)
198 : C
199 : C ---------------------------------------------------------------------
200 : C
201 : C .................... GAMA : VECTEUR DEFINISSANT L'AXE OY
202 : C POUR CHAQUE POUTRE
203 : C
204 : C
205 : C .................... CARACT : TABLEAU DES CARACTERISTIQUES
206 : C
207 : C CARACT EST UNE MATRICE (10,NP) QUI, POUR TOUTES LES NP POUTRES,
208 : C DONNE LES CARACTERISTIQUES GEOMETRIQUES ET PHYSIQUE DE LA POUTRE :
209 : C
210 : C CARACT( 1,INP) --> MODULE D'YOUNG : E
211 : C CARACT( 2,INP) --> COEFICIENT DE POISSON : NU
212 : C CARACT( 3,INP) --> MASSE VOLUMIQUE DU MATERIAU : RHO
213 : C CARACT( 4,INP) --> RAYON INTERIEUR : RINT
214 : C CARACT( 5,INP) --> RAYON EXTERIEUR : REXT
215 : C CARACT( 6,INP) --> CONSTANTE DE TIMOSHENKO : KCYZ
216 : C CARACT( 7,INP) --> COEFF. D'AMORTISSEMENT EXTERNE : CAM
217 : C CARACT( 8,INP) --> COEFF. D'AMORTISSEMENT INTERNE : ETA
218 : C CARACT( 9,INP) --> MASSE VOLUMIQUE DU FLUIDE : RHOF
219 : C CARACT(10,INP) --> VITESSE DU SON : CSON
220 : C
221 : C ---------------------------------------------------------------------
222 : C
223 : C .................... XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
224 : C AUX LIMITES POUR CHAQUE NOEUD.
225 : C
226 : C XCL (K,NN) = VALEUR DE LA CONDITION K AU NOEUD REEL NN
227 : C LES CONDITIONS K CORRESPONDENT RESPECTIVEMENT A UX, UY, UZ, RX,
228 : C RY, RZ, FX, FY, FZ, MX, MY, MZ, DP, DQ, A, B, R
229 : C ( IMPEDANCE ACOUSTIQUE: AP + BQ = R )
230 : C
231 : C CHAQUE NOEUD AYANT SOIT LES DEPLACEMENTS, SOIT LES EFFORTS, SOIT
232 : C UNE SOURCE OU UNE IMPEDANCE ACOUSTIQUE, SOIT RIEN DU TOUTD'IMPOSE,
233 : C IL CONVIENT DE DEFINIR UN VECTEUR JOUANT LE ROLE DEPOINTEUR SUR
234 : C XCL QUE L'ON APPELLE FLAG DE LONGUEUR 17*NNT.
235 : C
236 : C LES DIFFERENTS BLOCS DE 17 VALEURS POINTENT SUR LE NOEUD CORRES-
237 : C PONDANT :
238 : C
239 : C LA VALEUR DE FLAG VAUT LE NUMERO DU NOEUD SI ON IMPOSE LA CONDITION
240 : C ELLE VAUT 0 SINON.
241 : C
242 : C ---------------------------------------------------------------------
243 : C
244 : C .................... CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
245 : C
246 : C CHAQUE NOEUD FICTIF EST ASSOCIE A UN NOEUD REEL ; LE TABLEAU CORRES
247 : C DONNE, POUR CHAQUE NOEUD FICTIF (2*NP), LE NUMERO DU NOEUD REEL AS-
248 : C SOCIE.
249 : C
250 : C ---------------------------------------------------------------------
251 : C
252 : C
253 : C .................... NUMERO : TABLEAU DE NUMERO DE NOEUDS
254 : C
255 : C NUMERO (I) = NUMERO GIBI DU IEME NOEUD ( 1 < I < N )
256 : C
257 : C LA NUMEROTATION DE 1 A N EST ARBITRAIREMENT SELON LES NUMEROS
258 : C CROISSANTS DANS GIBI.
259 : C
260 : C
261 : C .................... MASS : TABLEAU DONNANT POUR CHAQUE MASSE
262 : C PONCTUELLE :
263 : C
264 : C - MASS(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA MASSE
265 : C - MASS(2,NNT) ... NUMERO DE LA POUTREASSOCIEE
266 : C - MASS(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
267 : C DANS LE VECTEUR DES INCONNUS
268 : C - MASS(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
269 : C NOEUD OU S'APPLIQUE LA MASSE
270 : C
271 : C .................... RMAS : TABLEAU DONNANT POUR LE NOEUD
272 : C CORRESPONDANT LA VALEUR DE LA MASSE
273 : C DE J0X
274 : C DE J0Y
275 : C DE J0Z
276 : C-----------------------------------------------------------------------
277 : C
278 : C...................... IRAILO : TABLEAU DONNANT POUR CHAQUE RAIDEUR
279 : C LOCALISEE
280 : C
281 : C - IRAILO(1,NNT) ... NUMERO DU NOEUD OU S'APPLIQUE LA RAIDEUR
282 : C - IRAILO(2,NNT) ... NUMERO DE LA POUTRE ASSOCIEE
283 : C - IRAILO(3,NNT) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
284 : C DANS LE VECTEUR DES INCONNUES
285 : C - IRAILO(4,NNT) ... NUMERO DE LIGNE DE LA COMPOSANTE FX DU
286 : C NOEUD OU S'APPLIQUE LA RAIDEUR
287 : C
288 : C...................... VALRAI : TABLEAU DONNANT LA VALEUR DES RAIDEURS
289 : C LOCALISEES
290 : C
291 : C - VALRAI(1,NNT) ... KX
292 : C - VALRAI(2,NNT) ... KY
293 : C - VALRAI(3,NNT) ... KZ
294 : C - VALRAI(4,NNT) ... CX RAISEUR EN TORSION
295 : C - VALRAI(5,NNT) ... CY RAIDEUR EN FLEXION SUIVANT OY
296 : C - VALRAI(6,NNT) ... CZ RAIDEUR EN FLEXION SUIVANT OZ
297 : C
298 : C ........... IPIVO,JPIVO,IAUX : TABLEAU INTERMEDIAIRE DE MEMORISATION
299 : C DE LA TRIANGULARISATION DE GAUSS
300 : C
301 : C
302 : C ..................... VALDE1 : TABLEAU DONNANT POUR CHAQUE ELEMENT
303 : C DU SOUS MAILLAGE LE MODULE DU DEPLA-
304 : C CEMENT
305 : C
306 : C ..................... VALDE2 : TABLEAU DONNANT POUR CHAQUE ELEMENT
307 : C DU SOUS MAILLAGE LA PHASE DU DEPLA-
308 : C CEMENT
309 : C
310 : C
311 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
312 : C
313 : C ------------------- DIMENSIONNEMENT DES MATRICES AUXILIAIRES
314 : C ----------------------------------------
315 : C
316 : SEGMENT AUXI
317 : INTEGER IAUXI(NNNP)
318 : ENDSEGMENT
319 : C
320 : C -------------------- LECTURE DES OBJETS MAILLAGE CHPOINT ET LISTREEL
321 : C -----------------------------------------------
322 : C
322 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
323 : IF (IERR.NE.0) RETURN
324 : C
324 : CALL LIROBJ('MAILLAGE',IPT4,0,IRETOU)
325 : IF (IERR.NE.0) RETURN
326 : IF (IRETOU.NE.0) THEN
327 : IDEPL = 1
328 : SEGACT IPT4
329 : NBELEM = IPT4.NUM(/2)
330 : ELSE
331 : IDEPL = 0
332 : NBELEM = 1
333 : END IF
334 : C
334 : CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
335 : IF (IERR.NE.0) RETURN
336 : C
336 : CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
337 : IF (IERR.NE.0) RETURN
338 : C
339 : C DECODAGE DE LA TABLE TEXP
340 : C
340 : CALL LIRTAB('TAB_EXPERIMENTALE',ITEXP,0,IRETOU)
341 : IF (IERR.NE.0) RETURN
342 : C
342 : CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
343 : IF (IERR.NE.0) RETURN
344 : C
344 : CALL LIRREE(S0,1,IRETOU)
345 : IF (IERR.NE.0) RETURN
346 : C
346 : CALL LIROBJ('POINT',NPOI,1,IRETOU)
347 : IF (IERR.NE.0) RETURN
348 : C
348 : CALL LIRCHA(CHAR,1,LCHAR)
349 : IF (IERR.NE.0) RETURN
350 : C
350 : CALL ELLA09(CHAR,ICHAR,IERROR)
351 : C
352 : C
353 : METH= 2
354 : C
355 : imp = 0
356 : IF (iimpi .eq. 333) imp = ioimp
357 : C
358 : C
359 : C -------------------- ACTIVATION DES SEGMENTS
360 : C -----------------------
361 : SEGACT IPT1
362 : SEGACT MLREE1
363 : SEGACT MCHPO1
364 : SEGACT MCHEL1
365 : C
366 : C
367 : C **********************************************************************
368 : C LECTURE DU MAILLAGE
369 : C **********************************************************************
370 : C
371 : C ..................NP : NOMBRE DE POUTRES DU MAILLAGE
372 : C
373 : NP = IPT1.NUM(/2)
374 : C
375 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
376 : C
377 : IF (IMP.NE.0) THEN
378 : WRITE (IMP,*) 'NOMBRE DE POUTRES DU MAILLAGE :',NP
379 : END IF
380 : C
381 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
382 : C
383 : NN = IPT1.NUM(/1)
384 : C
385 : C --------------------- NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
386 : C
387 : NFRQ = MLREE1.PROG(/1)
388 : C
389 : IF (IDEPL.EQ.1.AND.NFRQ.NE.1) THEN
390 : RETURN
391 : END IF
392 : C
393 : C
394 : C --------------------- DETERMINATION DU NOMBRE DE NOEUDS DU MAILLAGE
395 : C ---------------------------------------------
396 : NNNP = NN*NP
397 : SEGINI AUXI
398 : ICOMP = 0
399 : DO 10 I = 1 , NP
400 : DO 11 J = 1 , NN
401 : AUXI.IAUXI(ICOMP+1) = IPT1.NUM(J,I)
402 : C
403 : IF (ICOMP.LT.1) THEN
404 : ITEST = 0
405 : GOTO 13
406 : END IF
407 : C
408 : ITEST = 0
409 : DO 12 K = 1 , ICOMP
410 : IF (AUXI.IAUXI(K).EQ.IPT1.NUM(J,I)) ITEST = 1
411 : 12 CONTINUE
412 : C
413 : 13 IF (ITEST.EQ.0) ICOMP = ICOMP + 1
414 : C
415 : 11 CONTINUE
416 : C
417 : 10 CONTINUE
418 : C
419 : SEGSUP AUXI
420 : C
421 : NNT = ICOMP
422 : C
423 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
424 : C
425 : IF (IMP.NE.0) THEN
426 : WRITE (IMP,*) 'NOMBRE TOTAL DE NOEUD DU MAILLAGE :',NNT
427 : END IF
428 : C
429 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
430 : C
431 : C --------------------- INITIALISATION DES TABLEAUX DE TRAVAIL
432 : C --------------------------------------
433 : NP2 = NP * 2
434 : NP10 = NP * 10
435 : NP28 = NP * 28
436 : NNT14 = NNT * 14
437 : NNT17 = NNT * 17
438 : C
439 : SEGINI MATRES
440 : C
441 : NUMP = 0
442 : C
443 : DO 20 INP = 1 , NP
444 : C
445 : IP1 = IPT1.NUM(1,INP)
446 : C
447 : C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
448 : C -------------------------------------
449 : IF (NUMP.EQ.0) THEN
450 : NUMP = NUMP + 1
451 : MATRES.NUMERO ( NUMP ) = IP1
452 : ELSE
453 : NON = 0
454 : DO 21 I = 1 , NUMP
455 : IF (MATRES.NUMERO(I).EQ.IP1) THEN
456 : NON = 1
457 : END IF
458 : 21 CONTINUE
459 : C
460 : IF (NON.EQ.0) THEN
461 : NUMP = NUMP + 1
462 : MATRES.NUMERO ( NUMP ) = IP1
463 : END IF
464 : END IF
465 : C
466 : IP2 = IPT1.NUM(2,INP)
467 : C
468 : C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
469 : C -------------------------------------
470 : NON = 0
471 : DO 22 I = 1 , NUMP
472 : IF (MATRES.NUMERO(I).EQ.IP2) THEN
473 : NON = 1
474 : END IF
475 : 22 CONTINUE
476 : C
477 : IF (NON.EQ.0) THEN
478 : NUMP = NUMP + 1
479 : MATRES.NUMERO ( NUMP ) = IP2
480 : END IF
481 : C
482 : C
483 : C -------------------- COOR : TABLEAU DES COORDONNEES
484 : C --------------------------------
485 : MATRES.COOR(1,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
486 : MATRES.COOR(2,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
487 : MATRES.COOR(3,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
488 : MATRES.COOR(1,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+1)
489 : MATRES.COOR(2,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+2)
490 : MATRES.COOR(3,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+3)
491 : C
492 : C -------------------- CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
493 : C --------------------------------------------
494 : C
495 : MATRES.CORRES(2*INP-1) = IP1
496 : MATRES.CORRES(2*INP ) = IP2
497 : C
498 : 20 CONTINUE
499 : C
500 : C
501 : C **********************************************************************
502 : C LECTURE DU CHPOINT (CONDITIONS AUX LIMITES)
503 : C **********************************************************************
504 : C
505 : C -------------------- XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
506 : C ---------- AUX LIMITES POUR CHAQUE NOEUD.
507 : C
508 : NSOUPO = MCHPO1.IPCHP(/1)
509 : C
510 : IMAS = 0
511 : IRAIDE = 0
512 : C
513 : DO 25 I = 1 , NNT
514 : DO 25 J = 1 , 17
515 : MATRES.XCL(J,I) = 0.E0
516 : MATRES.FLAG((I-1)*17+J) = 0
517 : 25 CONTINUE
518 : C
519 : DO 30 I = 1 , NSOUPO
520 : C
521 : MSOUP1 = MCHPO1.IPCHP(I)
522 : SEGACT MSOUP1
523 : C
524 : IPT2 = MSOUP1.IGEOC
525 : SEGACT IPT2
526 : C
527 : MPOVA2 = MSOUP1.IPOVAL
528 : SEGACT MPOVA2
529 : C
530 : NC = MSOUP1.NOCOMP(/2)
531 : N = MPOVA2.VPOCHA(/1)
532 : C
533 : DO 31 J = 1 , N
534 : C
535 : C -- ON CHERCHE NUM(1,J) CAR DANS UN CHAMP PAR POINTS, LES
536 : C -- ELEMENTS DES SOUS-MAILLAGES ELEMENTAIRES SONT LES POINTS
537 : C -- DE CES SOUS-MAILLAGES, ET CHAQUE ELEMENT CONTIENT DONC UN
538 : C -- SEUL NOEUD
539 : C
540 : NOEUD = IPT2.NUM(1,J)
541 : ISTOP = 0
542 : ISTO1 = 0
543 : C
544 : DO 33 K = 1 , NNT
545 : IF (MATRES.NUMERO(K).EQ.NOEUD) THEN
546 : NNOEUD = K
547 : END IF
548 : 33 CONTINUE
549 : C
550 : DO 32 K = 1 , NC
551 : COMP = MSOUP1.NOCOMP(K)
551 : CALL ELLA09(COMP,ICOMP,IERROR)
552 : IF (IERROR.NE.0) THEN
553 : RETURN
554 : END IF
555 : C
556 : C COMPTAGE DES MASSES
557 : C
558 : IF (ICOMP.GE.18.AND.ISTOP.EQ.0.AND.ICOMP.LE.21) THEN
559 : IMAS = IMAS + 1
560 : ISTOP = 1
561 : END IF
562 : C
563 : C COMPTAGE DES RAIDEURS
564 : C
565 : IF (ICOMP.GE.22.AND.ISTO1.EQ.0.AND.ICOMP.LE.27) THEN
566 : IRAIDE = IRAIDE + 1
567 : ISTO1 = 1
568 : ENDIF
569 : C
570 : C DETECTION DES MASSES ET AFFECTATION DES NUMEROS DE COLONNES
571 : C
572 : IF (ICOMP.EQ.18) THEN
573 : DO 35 II = 2*NP , 1 , -1
574 : IF (CORRES(II).EQ.NOEUD) THEN
575 : MATRES.MASS(1,IMAS) = II
576 : END IF
577 : 35 CONTINUE
578 : C
579 : MATRES.MASS(2,IMAS) = INT((MATRES.MASS(1,IMAS)+1)/2)
580 : II = MATRES.MASS(1,IMAS)
581 : JJ = INT(II/2)*2
582 : IF (II.EQ.JJ) THEN
583 : MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+15
584 : ELSE
585 : MATRES.MASS(3,IMAS) = 28*(MATRES.MASS(2,IMAS)-1)+1
586 : END IF
587 : C
588 : MATRES.RMAS(1,IMAS) = MPOVA2.VPOCHA(J,K)
589 : C
590 : ELSE IF (ICOMP.GT.18.AND.ICOMP.LE.21) THEN
591 : JMAS = ICOMP - 17
592 : MATRES.RMAS(JMAS,IMAS) = MPOVA2.VPOCHA(J,K)
593 : C
594 : ELSE IF (ICOMP.LT.18 ) THEN
595 : C
596 : MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
597 : MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
598 : C
599 : END IF
600 : C
601 : C DETECTION DES RAIDEURS ET AFFECTATION DES NUMEROS DE COLONNES
602 : C
603 : IF (ICOMP.EQ.22) THEN
604 : C
605 : NUMFIC = 0
606 : DO 60 II = 2*NP , 1 , -1
607 : C
608 : IF (CORRES(II).EQ.NOEUD) THEN
609 : NUMFIC = NUMFIC + 1
610 : C
611 : IF (NUMFIC.GT.3) THEN
612 : STOP
613 : ENDIF
614 : C
615 : MATRES.IRAILO(NUMFIC,IRAIDE) = II
616 : END IF
617 : 60 CONTINUE
618 : C
619 : MATRES.IRAILO(4,IRAIDE)= NUMFIC
620 : C
621 : MATRES.VALRAI(1,IRAIDE) = MPOVA2.VPOCHA(J,K)
622 : C
623 : ELSE IF (ICOMP.GT.22.AND.ICOMP.LE.27) THEN
624 : JRAIDE = ICOMP - 21
625 : C
626 : MATRES.VALRAI(JRAIDE,IRAIDE) = MPOVA2.VPOCHA(J,K)
627 : C
628 : ELSE IF (ICOMP.LT.18) THEN
629 : C
630 : MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
631 : MATRES.FLAG((NNOEUD-1)*17+ICOMP)=NNOEUD
632 : C
633 : END IF
634 : C
635 : 32 CONTINUE
636 : 31 CONTINUE
637 : C
638 : C
639 : SEGDES IPT2
640 : SEGDES MPOVA2
641 : SEGDES MSOUP1
642 : C
643 : 30 CONTINUE
644 : C
645 : NMAS = IMAS
646 : NRAIDE = IRAIDE
647 : C
648 : C **********************************************************************
649 : C LECTURE DU NOUVEAU CHAMLEM (CARACTERISTIQUES DU MATERIAU
650 : C ET DU FLUIDE)
651 : C **********************************************************************
652 : C
653 : C
654 : NELEXP=0
655 : C
656 : C .................... CARACT : TABLEAU DES CARACTERISTIQUES
657 : C
658 : NN1 = MCHEL1.IMACHE(/1)
659 : C
660 : DO 700 I = 1 , NN1
661 : C
662 : IPT3 = MCHEL1.IMACHE(I)
663 : MCHAM1 = MCHEL1.ICHAML(I)
664 : C
665 : SEGACT IPT3
666 : NBE = IPT3.NUM(/2)
667 : C
668 : SEGACT MCHAM1
669 : NN2 = MCHAM1.IELVAL(/1)
670 : IF (NN2.EQ.1) THEN
671 : C
672 : C IL Y A UN SEUL MOT CLEF : C'EST VECT
673 : C ON A UN ELEMENT EXPERIMENTAL
674 : C
674 : CALL ELLA08(MCHAM1.NOMCHE(NN2),ICARAC,IERROR)
675 : IF (IERROR.NE.0) THEN
676 : RETURN
677 : END IF
678 : C
679 : IF (ICARAC.NE.11) THEN
680 : RETURN
681 : END IF
682 : C
683 : IF (NBE.GT.1) THEN
684 : RETURN
685 : END IF
686 : C
687 : MELVA1 = MCHAM1.IELVAL(NN2)
688 : SEGACT MELVA1
689 : IPP = MELVA1.IELCHE(1,1)
690 : X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
691 : X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
692 : X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
693 : SEGDES MELVA1
694 : C
695 : INU1 = IPT3.NUM(1,NBE)
696 : INU2 = IPT3.NUM(2,NBE)
697 : NCARAC = 0
698 : DO 720 III = 1 , NP2 , 2
699 : IN1 = MATRES.CORRES(III )
700 : IN2 = MATRES.CORRES(III+1)
701 : IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
702 : NCARAC = INT(III/2) + 1
703 : END IF
704 : IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
705 : NCARAC = INT(III/2) + 1
706 : END IF
707 : 720 CONTINUE
708 : C
709 : NELEXP=NELEXP+1
710 : MATRES.IEXPER(NCARAC)=1
711 : MATRES.GAMA(1,NCARAC) = X1
712 : MATRES.GAMA(2,NCARAC) = X2
713 : MATRES.GAMA(3,NCARAC) = X3
714 : C
715 : C********************************
716 : C
717 : ELSE
718 : C
719 : C ON LIT LES CARACTERISTIQUES D'UNE POUTRE FORMULATION
720 : C INTEGRALE
721 : C
722 : DO 713 II = 1,NN2
723 : C
723 : CALL ELLA08(MCHAM1.NOMCHE(II),ICARAC,IERROR)
724 : IF (IERROR.NE.0) THEN
725 : RETURN
726 : END IF
727 : C
728 : IF (ICARAC.NE.11) THEN
729 : MELVA1 = MCHAM1.IELVAL(II)
730 : SEGACT MELVA1
731 : XCARAC = MELVA1.VELCHE(1,1)
732 : SEGDES MELVA1
733 : ELSE
734 : MELVA1 = MCHAM1.IELVAL(II)
735 : SEGACT MELVA1
736 : IPP = MELVA1.IELCHE(1,1)
737 : X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
738 : X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
739 : X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
740 : SEGDES MELVA1
741 : END IF
742 : C
743 : DO 716 IE = 1 , NBE
744 : INU1 = IPT3.NUM(1,IE)
745 : INU2 = IPT3.NUM(2,IE)
746 : C
747 : NCARAC = 0
748 : C
749 : DO 717 III = 1 , NP2 , 2
750 : IN1 = MATRES.CORRES(III )
751 : IN2 = MATRES.CORRES(III+1)
752 : IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
753 : NCARAC = INT(III/2) + 1
754 : END IF
755 : C
756 : IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
757 : NCARAC = INT(III/2) + 1
758 : END IF
759 : C
760 : 717 CONTINUE
761 : C
762 : IF (ICARAC.NE.11) THEN
763 : MATRES.CARACT(ICARAC,NCARAC) = XCARAC
764 : ELSE
765 : MATRES.GAMA(1,NCARAC) = X1
766 : MATRES.GAMA(2,NCARAC) = X2
767 : MATRES.GAMA(3,NCARAC) = X3
768 : END IF
769 : C
770 : 716 CONTINUE
771 : C
772 : 713 CONTINUE
773 : C
774 : END IF
775 : C
776 : SEGDES MCHAM1
777 : SEGDES IPT3
778 : C
779 : 700 CONTINUE
780 : C
781 : C LECTURE DE LA TABLE DES ELEMENTS EXPERIMENTAUX
782 : C
783 : IF (NELEXP.GT.0) THEN
783 : CALL ELLA01(NELEXP,NP2,NFRQ,ITEXP,MATRES)
784 : END IF
785 : C
786 : C -------------------------- CALCUL DE LA VALEUR REEL DE NPOI
787 : C --------------------------------
788 : DO 50 I = 1 , NNT
789 : IF (MATRES.NUMERO(I).EQ.NPOI) THEN
790 : NNPOI = I
791 : END IF
792 : 50 CONTINUE
793 : C
794 : SEGDES IPT1
795 : SEGDES MCHPO1
796 : SEGDES MCHEL1
797 : C
798 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
799 : C
800 : IF (IMP.NE.0) THEN
801 : C
802 : C ----------------------------------------------------------------------
803 : C
804 : C IMPRESSION DES TABLEAUX CREES A L'INTERFACE
805 : C
806 : C - COOR ( 3 , 2*NP )
807 : C - CORRES ( 2*NP )
808 : C - GAMA ( 3 , NP )
809 : C - CARACT (10 , NP )
810 : C - XCL (17 , NNT )
811 : C - FLAG ( 17*NNT )
812 : C - NUMERO ( NNT )
813 : C - MASS ( 3 , NMAS )
814 : C - RMAS ( 4 , NMAS )
815 : C - IRAILO ( 4 , NRAIDE )
816 : C - VALRAI ( 6 , NRAIDE )
817 : C
818 : C ----------------------------------------------------------------------
819 : C
820 : WRITE (IMP,*) 'TABLEAU COOR :'
821 : WRITE (IMP,*) '************'
822 : C
823 : DO 980 I = 1 , 2*NP
824 : WRITE (IMP,*) 'NOEUD ',I,':',
825 : * MATRES.COOR(1,I),MATRES.COOR(2,I),MATRES.COOR(3,I)
826 : 980 CONTINUE
827 : C
828 : WRITE (IMP,*) 'TABLEAU CORRES :'
829 : WRITE (IMP,*) '**************'
830 : C
831 : DO 981 I = 1 , 2*NP
832 : WRITE (IMP,*) 'NOEUD ',I,':',MATRES.CORRES(I)
833 : 981 CONTINUE
834 : C
835 : C
836 : WRITE (IMP,*) 'TABLEAU NUMERO :'
837 : WRITE (IMP,*) '**************'
838 : C
839 : DO 987 I = 1 , NNT
840 : WRITE (IMP,*) 'NOEUD ',I,':',MATRES.NUMERO(I)
841 : 987 CONTINUE
842 : C
843 : WRITE (IMP,*) 'TABLEAU GAMA :'
844 : WRITE (IMP,*) '************'
845 : C
846 : DO 982 I = 1 , NP
847 : WRITE (IMP,*) 'POUTRE ',I,':',
848 : * MATRES.GAMA(1,I),MATRES.GAMA(2,I),MATRES.GAMA(3,I)
849 : 982 CONTINUE
850 : C
851 : WRITE (IMP,*) 'TABLEAU CARACT :'
852 : WRITE (IMP,*) '**************'
853 : C
854 : DO 983 I = 1 , NP
855 : WRITE (IMP,*) 'E : ',MATRES.CARACT ( 1 , I)
856 : WRITE (IMP,*) 'NU : ',MATRES.CARACT ( 2 , I)
857 : WRITE (IMP,*) 'RHO : ',MATRES.CARACT ( 3 , I)
858 : WRITE (IMP,*) 'RINT : ',MATRES.CARACT ( 4 , I)
859 : WRITE (IMP,*) 'REXT : ',MATRES.CARACT ( 5 , I)
860 : WRITE (IMP,*) 'KCYZ : ',MATRES.CARACT ( 6 , I)
861 : WRITE (IMP,*) 'CAM : ',MATRES.CARACT ( 7 , I)
862 : WRITE (IMP,*) 'ETA : ',MATRES.CARACT ( 8 , I)
863 : WRITE (IMP,*) 'RHOF : ',MATRES.CARACT ( 9 , I)
864 : WRITE (IMP,*) 'CSON : ',MATRES.CARACT (10 , I)
865 : 983 CONTINUE
866 : C
867 : WRITE (IMP,*) 'TABLEAU XCL :'
868 : WRITE (IMP,*) '***********'
869 : C
870 : DO 984 I = 1 , 17
871 : DO 985 J = 1 , NNT
872 : WRITE (IMP,*) I , J,':',MATRES.XCL (I,J)
873 : 985 CONTINUE
874 : 984 CONTINUE
875 : C
876 : WRITE (IMP,*) 'TABLEAU FLAG :'
877 : WRITE (IMP,*) '************'
878 : C
879 : DO 986 I = 1 , 17*NNT
880 : WRITE (IMP,*) 'VAL ',I,':',MATRES.FLAG ( I )
881 : 986 CONTINUE
882 : C
883 : WRITE(IMP,*) 'TABLEAU POUR LES MASSES :'
884 : WRITE(IMP,*) '***********************'
885 : C
886 : WRITE(IMP,*)'NMAS : ',NMAS
887 : C
888 : IF (NMAS.GT.0) THEN
889 : C
890 : DO 988 I = 1 , NMAS
891 : WRITE (IMP,*) 'MASS (1,',I,') :',MATRES.MASS(1,I)
892 : WRITE (IMP,*) 'MASS (2,',I,') :',MATRES.MASS(2,I)
893 : WRITE (IMP,*) 'MASS (3,',I,') :',MATRES.MASS(3,I)
894 : WRITE (IMP,*) 'MASS (4,',I,') :',MATRES.MASS(4,I)
895 : 988 CONTINUE
896 : C
897 : DO 989 I = 1 , NMAS
898 : WRITE (IMP,*) 'RMAS (1,',I,') :',MATRES.RMAS(1,I)
899 : WRITE (IMP,*) 'RMAS (2,',I,') :',MATRES.RMAS(2,I)
900 : WRITE (IMP,*) 'RMAS (3,',I,') :',MATRES.RMAS(3,I)
901 : WRITE (IMP,*) 'RMAS (4,',I,') :',MATRES.RMAS(4,I)
902 : 989 CONTINUE
903 : END IF
904 : C
905 : WRITE(IMP,*) 'TABLEAU POUR LES RAIDEURS :'
906 : WRITE(IMP,*) '*************************'
907 : C
908 : WRITE(IMP,*) 'NRAIDE : ',NRAIDE
909 : C
910 : IF (NRAIDE.GT.0) THEN
911 : DO 800 I = 1 , NRAIDE
912 : WRITE(IMP,*) 'IRAILO(1,',I,') :',MATRES.IRAILO(1,I)
913 : WRITE(IMP,*) 'IRAILO(2,',I,') :',MATRES.IRAILO(2,I)
914 : WRITE(IMP,*) 'IRAILO(3,',I,') :',MATRES.IRAILO(3,I)
915 : WRITE(IMP,*) 'IRAILO(4,',I,') :',MATRES.IRAILO(4,I)
916 : C
917 : 800 CONTINUE
918 : C
919 : DO 810 I = 1 , NRAIDE
920 : WRITE(IMP,*) 'VALRAI(1,',I,') :',MATRES.VALRAI(1,I)
921 : WRITE(IMP,*) 'VALRAI(2,',I,') :',MATRES.VALRAI(2,I)
922 : WRITE(IMP,*) 'VALRAI(3,',I,') :',MATRES.VALRAI(3,I)
923 : WRITE(IMP,*) 'VALRAI(4,',I,') :',MATRES.VALRAI(4,I)
924 : WRITE(IMP,*) 'VALRAI(5,',I,') :',MATRES.VALRAI(5,I)
925 : WRITE(IMP,*) 'VALRAI(6,',I,') :',MATRES.VALRAI(6,I)
926 : C
927 : 810 CONTINUE
928 : END IF
929 : C
930 : C DO 820 I=1,NFRQ
931 : C WRITE(IMP,*) 'MLREE1.PROG(',I,')= ',MLREE1.PROG(I)
932 : C 820 CONTINUE
933 : C
934 : C
935 : WRITE(IMP,*) 'NOMBRE D''ELEMENTS EXPERIMENTAUX NELEXP ',NELEXP
936 : DO 830 I=1,NP
937 : WRITE(IMP,*) 'IEXPER(',I,')= ',MATRES.IEXPER(I)
938 : 830 CONTINUE
939 : C
940 : DO 870 K=1,NP
941 : C
942 : IF (MATRES.IEXPER(K).NE.0) THEN
943 : DO 840 L=1,NFRQ
944 : DO 850 I=1,14
945 : DO 860 J=1,28
946 : C WRITE(IMP,*) MATRES.ALPHAI(I,J,K,L)
947 : IF (ABS(ALPHAI(I,J,K,L)).GE.1.0D-10) THEN
948 : WRITE(IMP,871) I,J,K,L,MATRES.ALPHAI(I,J,K,L)
949 : 871 FORMAT(1X,'ALPHAI(',I2,',',I2,',',I2,',',I2,')= ',2(1X,E12.5))
950 : END IF
951 : 860 CONTINUE
952 : 850 CONTINUE
953 : 840 CONTINUE
954 : C
955 : END IF
956 : 870 CONTINUE
957 : C
958 : END IF
959 : C
960 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
961 : C
962 : C ----------------------------------------------------------------------
963 : C
964 : C APPEL DU PROGRAMME FORTRAN POUR LA RESOLUTION DU PROBLEME
965 : C
966 : C TABLEAUX D'ENTREE :
967 : C
968 : C COOR(3,2*NP), CORRES(2*NP), GAMA(3,NP), CARACT(10,NP),
969 : C XCL(17,NNT) , FLAG (17*NNT), NUMERO (NNT) (NP NOMBRE DE POUTRES
970 : C NNT NOMBRE REEL DE NOEUDS)
971 : C IRAILO(4,NNT), VALRAI(6,NNT)
972 : C
973 : C TABLEAUX DE SORTIE :
974 : C
975 : C ZA1(28*NP,28*NP) , ZSM (28*NP) , ZXX (28*NP)
976 : C
977 : C ----------------------------------------------------------------------
978 : C
979 : DO 141 I = 1 , NFRQ
980 : DO 142 J = 1 , NNT14
981 : MATRES.ZSOL(J,I) = CMPLX(0.D0,0.D0)
982 : 142 CONTINUE
983 : 141 CONTINUE
984 : C
984 : CALL ELLA11(MATRES.COOR , MATRES.CORRES , MATRES.GAMA ,
985 : * MATRES.CARACT , MATRES.XCL , MATRES.FLAG ,
986 : * MATRES.NUMERO , MATRES.ZA1 , MATRES.ZSM ,
987 : * MATRES.ZXX , MATRES.ZSOL , MATRES.MASS ,
988 : * MATRES.RMAS , NMAS , MATRES.IPIVO ,
989 : * MATRES.JPIVO , MATRES.IAUX , MLREE1.PROG ,
990 : & MATRES.IRAILO , MATRES.VALRAI , NRAIDE ,
991 : & MATRES.IEXPER , MATRES.ALPHAI ,NELEXP, NP , NP28 ,
992 : & NNT , NNT14 , NFRQ ,
993 : & S0 , XPI , METH , IMP)
994 : C
995 : ZS = S0 + (0.D0 , 1.D0 ) * 2. * XPI * MLREE1.PROG(1)
996 : C
997 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
998 : IF (IMP.NE.0) THEN
999 : WRITE (IMP,*)'VECTEUR SOLUTION ZSOL : ( PREMIERE FREQUENCE ) '
1000 : DO 42 J = 1 , NNT14
1001 : WRITE (IMP,*) J,MATRES.ZSOL(J,1)
1002 : 42 CONTINUE
1003 : C
1004 : END IF
1005 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
1006 : C
1007 : IF (IDEPL.EQ.0) THEN
1008 : C
1009 : JG = NFRQ
1010 : SEGINI MLREE2
1011 : SEGINI MLREE3
1012 : C
1013 : DO 100 I = 1 , NFRQ
1014 : C
1015 : MLREE2.PROG(I) = ABS(MATRES.ZSOL((NNPOI-1)*14+ICHAR,I))
1016 : C
1017 : ZT = MATRES.ZSOL((NNPOI-1)*14+ICHAR,I)
1018 : PRZT = ZT
1019 : PIZT = ZT*(0.D0,-1.D0)
1020 : C
1021 : IF (ABS(PRZT).LT.XPETIT.AND.ABS(PIZT).LT.XPETIT) THEN
1022 : MLREE3.PROG(I) = 0.D0
1023 : ELSE
1024 : MLREE3.PROG(I) = ATAN2(PIZT,PRZT)*180.D0/XPI
1025 : END IF
1026 : C
1027 : 100 CONTINUE
1028 : C
1029 : C ------------------- OUVERTURE DU SEGMENT RESULTAT TYPE EVOLUTION
1030 : C --------------------------------------------
1031 : C
1032 : N = 2
1033 : SEGINI MEVOL1
1034 : SEGINI KEVOL1
1035 : SEGINI KEVOL2
1036 : C
1037 : MEVOL1.ITYEVO = 'COMPLEXE'
1038 : C MEVOL1.IEVTEX = 'OPERATEUR ELFE LAPLACE POUTRE'
1039 : MEVOL1.IEVOLL(1) = KEVOL1
1040 : MEVOL1.IEVOLL(2) = KEVOL2
1041 : C
1042 : C
1043 : KEVOL1.IPROGX = MLREE1
1044 : KEVOL1.IPROGY = MLREE2
1045 : KEVOL1.NUMEVY = 'MODU'
1046 : KEVOL1.TYPX = 'LISTREEL'
1047 : KEVOL1.TYPY = 'LISTREEL'
1048 : KEVOL1.NOMEVX = 'FREQ (HZ)'
1049 : KEVOL1.NOMEVY = CHAR
1050 : C KEVOL1.KEVTEX = '********'
1051 : C
1052 : C
1053 : KEVOL2.IPROGX = MLREE1
1054 : KEVOL2.IPROGY = MLREE3
1055 : KEVOL2.NUMEVY = 'PHAS'
1056 : KEVOL2.TYPX = 'LISTREEL'
1057 : KEVOL2.TYPY = 'LISTREEL'
1058 : KEVOL2.NOMEVX = 'FREQ (HZ)'
1059 : KEVOL2.NOMEVY = CHAR
1060 : C KEVOL2.KEVTEX = '********'
1061 : C
1062 : C
1062 : CALL ECROBJ('EVOLUTION',MEVOL1)
1063 : C
1064 : SEGDES KEVOL1
1065 : SEGDES KEVOL2
1066 : SEGDES MEVOL1
1067 : SEGDES MLREE2
1068 : SEGDES MLREE3
1069 : C
1070 : ELSE
1071 : C
1072 : DO 230 I = 1 , 2
1073 : DO 240 J = 1 , NBELEM
1074 : IP1 = IPT4.NUM(I,J)
1075 : MATRES.XCOR(I,1,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
1076 : MATRES.XCOR(I,2,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
1077 : MATRES.XCOR(I,3,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
1078 : 240 CONTINUE
1079 : 230 CONTINUE
1080 : C
1080 : CALL ELLA23(MATRES.CARACT , MATRES.COOR , MATRES.GAMA ,
1081 : * MATRES.ZXX , MATRES.XCOR , MATRES.VALDE1,
1082 : * MATRES.VALDE2 , MATRES.VALDE3 , MATRES.VALDE4 ,
1083 : * ZS , NP , NBELEM , XPI )
1084 : C
1085 : N1 = 1
1086 : N2 = 8
1087 : L1= 0
1088 : N3= 0
1089 : SEGINI MCHEL1
1090 : SEGINI MCHAM1
1091 : MCHEL1.IMACHE(1) = IPT4
1092 : MCHEL1.ICHAML(1) = MCHAM1
1093 : C
1094 : MCHAM1.NOMCHE(1) = 'UXM'
1095 : MCHAM1.NOMCHE(2) = 'UYM'
1096 : MCHAM1.NOMCHE(3) = 'UZM'
1097 : MCHAM1.NOMCHE(4) = 'UXP'
1098 : MCHAM1.NOMCHE(5) = 'UYP'
1099 : MCHAM1.NOMCHE(6) = 'UZP'
1100 : MCHAM1.NOMCHE(7) = 'PM'
1101 : MCHAM1.NOMCHE(8) = 'PP'
1102 : MCHAM1.TYPCHE(1) = 'REAL*8'
1103 : MCHAM1.TYPCHE(2) = 'REAL*8'
1104 : MCHAM1.TYPCHE(3) = 'REAL*8'
1105 : MCHAM1.TYPCHE(4) = 'REAL*8'
1106 : MCHAM1.TYPCHE(5) = 'REAL*8'
1107 : MCHAM1.TYPCHE(6) = 'REAL*8'
1108 : MCHAM1.TYPCHE(7) = 'REAL*8'
1109 : MCHAM1.TYPCHE(8) = 'REAL*8'
1110 : C
1111 : N1PTEL = 2
1112 : N1EL = NBELEM
1113 : N2PTEL = 0
1114 : N2EL = 0
1115 : C
1116 : SEGINI MELVA1
1117 : SEGINI MELVA2
1118 : SEGINI MELVA3
1119 : SEGINI MELVA4
1120 : SEGINI MELVA5
1121 : SEGINI MELVA6
1122 : C
1123 : MCHAM1.IELVAL(1) = MELVA1
1124 : MCHAM1.IELVAL(2) = MELVA2
1125 : MCHAM1.IELVAL(3) = MELVA3
1126 : MCHAM1.IELVAL(4) = MELVA4
1127 : MCHAM1.IELVAL(5) = MELVA5
1128 : MCHAM1.IELVAL(6) = MELVA6
1129 : C
1130 : DO 200 I = 1 , 2
1131 : DO 210 J = 1 , NBELEM
1132 : MELVA1.VELCHE(I,J) = VALDE1 ( I , J , 1 )
1133 : MELVA2.VELCHE(I,J) = VALDE1 ( I , J , 2 )
1134 : MELVA3.VELCHE(I,J) = VALDE1 ( I , J , 3 )
1135 : MELVA4.VELCHE(I,J) = VALDE2 ( I , J , 1 )
1136 : MELVA5.VELCHE(I,J) = VALDE2 ( I , J , 2 )
1137 : MELVA6.VELCHE(I,J) = VALDE2 ( I , J , 3 )
1138 : 210 CONTINUE
1139 : 200 CONTINUE
1140 : C
1141 : C MCHAM1.IELVAL(7) = MELVA1
1142 : C MCHAM1.IELVAL(8) = MELVA2
1143 : C
1144 : C DO 300 I = 1 , 2
1145 : C DO 310 J = 1 , NBELEM
1146 : C MELVA1.VELCHE(I,J) = VALDE3 ( I , J , 1 )
1147 : C MELVA2.VELCHE(I,J) = VALDE4 ( I , J , 1 )
1148 : C310 CONTINUE
1149 : C300 CONTINUE
1150 : C
1151 : * NSOUPO = 1
1152 : * NAT=1
1153 : * SEGINI MCHPO1
1153 : CALL CHAMPO(MCHEL1,1,MCHPO1,IRET)
1153 : CALL ECROBJ('CHPOINT',MCHPO1)
1154 : C
1155 : SEGDES MELVA1
1156 : SEGDES MELVA2
1157 : SEGDES MELVA3
1158 : SEGDES MELVA4
1159 : SEGDES MELVA5
1160 : SEGDES MELVA6
1161 : SEGDES MCHAM1
1162 : SEGDES MCHEL1
1163 : SEGDES MCHPO1
1164 : C
1165 : C
1166 : END IF
1167 : C
1168 : SEGDES MLREE1
1169 : SEGSUP MATRES
1170 : C
1171 : END
1172 :
1173 :
1174 :
1175 :
1176 :
1177 :
1178 :
1179 :
1180 :
© Cast3M 2003 - All rights reserved.
Disclaimer