1 : C ELLP00 SOURCE PV 11/03/07 21:16:46 6885
2 : SUBROUTINE ELLP00
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
10 : C OPERATEUR ELFE LAPLACE POUTRE
11 : C
12 : C CALCUL DES FONCTIONS DE TRANSFERT D'UN MAILLAGE DE POUTRES PAR
13 : C LA METHODE DITE "INTEGRALE". LA SYNTAXE EST LA SUIVANTE :
14 : C
15 : C EVOL = ELFE LAPLACE POUTRE GEO1 (GEO2) CHP1 CHAM1 LFR S0 PT
16 : C COMP IMETH (IMP)
17 : C
18 : C
19 : C ELFE .............. MOT DESIGNANT L'OPERATEUR
20 : C
21 : C LAPLACE, POUTRE ... MOTS CLES POUR L'OPTION DE ELFE
22 : C
23 : C GEO1 .............. OBJET TYPE MAILLAGE DONNANT LE RESEAU DE POUTRES
24 : C
25 : C GEO2 (FACULTATIF).. OBJET TYPE MAILLAGE SI ON VEUT LA DEFORMEE
26 : C
27 : C CHP1 .............. OBJET TYPE CHPOINT DONNANT LES COND. AUX LIMITE
28 : C
29 : C CHAM1 ............. OBJET TYPE NOUVEAU CHAMELEM POUR LES CARACT.
30 : C
31 : C LFR ............... OBJET TYPE LISTREEL DEFINISSANT LES FREQUENCES
32 : C
33 : C S0 ............... OBJET TYPE REEL POUR LA TRANSFORMEE DE LAPLACE
34 : C
35 : C PT ................ OBJET TYPE POINT OU L'ON DESIRE LE DEPLACEMENT
36 : C
37 : C COMP .............. OBJET TYPE CHAR*2 DESIGNANT 'UX','UY' OU 'UZ'
38 : C 'RX','RY' OU 'RZ'
39 : C
40 : C IMETH ............. ENTIER : CHOIX DE LA METHODE DE RESOLUTION
41 : C
42 : C IMP (FALCULTATIF).. ENTIER : <>0 POUR IMPRESSION INTERMEDIAIRE
43 : C
44 : C
45 : C PARAMETRES :
46 : C ('NEANT')
47 : C
48 : C SORTIES :
49 : C
50 : C EVOLUTION --------> SI ON DESIRE LA FONCTION DE TRANSFERT
51 : C
52 : C CHAMPOINT --------> SI ON DESIRE LA DEFORMEE
53 : C
54 : C
55 : C *****************************************************
56 : C * *
57 : C * Organigramme d'appel des diff{rentes SUBROUTINE *
58 : C * *
59 : C *****************************************************
60 : C
61 : C
62 : C ELLP00 (interface ESOPE <--> FORTRAN)
63 : C |
64 : C |
65 : C |-----> ELLP09 (conversion de ux , uy ... en 1 , 2 , ...)
66 : C |
67 : C |-----> ELLP08 (conversion de YOUN , NU ... en 1 , 2 , ...)
68 : C |
69 : C |
70 : C |-----> ELLP11 (programme principal FORTRAN)
71 : C |
72 : C |
73 : C |-----> ELLP12 (remplissage de la 2}me partie de ZA1
74 : C | qui ne d{pend pas de w)
75 : C |
76 : C |-----> ELLP21 (determination, pour chaque poutre et
77 : C | chaque frequence, de la matrice ZC1)
78 : C |
79 : C |
80 : C |-----> ELLP31 (valeur des fcts de GREEN)
81 : C |
82 : C |<--------|
83 : C |
84 : C |
85 : C |-----> ELLP51 (resolution du systeme lin{aire)
86 : C | (ELLP52)
87 : C | (ELLP53)
88 : C | (ELLP54)
89 : C |
90 : C |
91 : C |<--------|
92 : C |
93 : C |-----> ELLP23 (d{termination des d{placements aux noeuds du
94 : C | sous-maillage dans le cas du calcul de la
95 : C | d{form{e )
96 : C |
97 : C | -------------
98 : C | | |
99 : C |--------------->| FIN |
100 : C | |
101 : C -------------
102 : C
103 : C AUTEUR : SAINT-DIZIER
104 : C DATE : 04 JANVIER 1990 (VERSION DU 22 AOUT 1990)
105 : C
106 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
107 : C
108 : CHARACTER*4 COMP,CHAR
109 : C
110 : C
111 : -INC CCREEL
112 : -INC CCOPTIO
113 : -INC SMCOORD
114 : -INC SMELEME
115 : -INC SMCHPOI
116 : -INC SMCHAML
117 : -INC SMLREEL
118 : -INC SMEVOLL
119 : C
120 : POINTEUR MLREE4.MLREEL
121 : POINTEUR KEVOL3.KEVOLL
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 (NP24,NP24)
128 : COMPLEX*16 ZSM (NP24)
129 : COMPLEX*16 ZXX (NP24)
130 : COMPLEX*16 ZSOL (NNT12,NFRQ)
131 : REAL*8 COOR (3 ,NP2)
132 : REAL*8 GAMA (3 ,NP)
133 : REAL*8 CARACT(12,NP)
134 : REAL*8 XCL (12 ,NNT)
135 : REAL*8 XCOR (2 , 3 , NBELEM )
136 : REAL*8 VALDE1(2 , NBELEM , 3 )
137 : REAL*8 VALDE2(2 , NBELEM , 3 )
138 : INTEGER FLAG (NNT12)
139 : INTEGER CORRES(NP2)
140 : INTEGER NUMERO(NNT)
141 : INTEGER MASS (NNT,4)
142 : REAL*8 RMAS (NNT,4)
143 : INTEGER IPIVO(NP24)
144 : INTEGER JPIVO(NP24)
145 : INTEGER IAUX(NP24)
146 : ENDSEGMENT
147 : C
148 : SEGMENT MATITE
149 : REAL*8 SA(NP48,NP48)
150 : REAL*8 SB(NP48)
151 : REAL*8 SU(NP48)
152 : REAL*8 SR(NP48)
153 : REAL*8 SQ(NP48)
154 : REAL*8 SDELTA(NP48)
155 : REAL*8 SDELT1(NP48)
156 : REAL*8 SP(NP48)
157 : REAL*8 SP1(NP48)
158 : REAL*8 SCH(NP48)
159 : REAL*8 SCH1(NP48)
160 : INTEGER IIVO(NP48)
161 : INTEGER JIVO(NP48)
162 : INTEGER IIUX(NP48)
163 : INTEGER ITERA (NFRQ)
164 : ENDSEGMENT
165 : C
166 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
167 : C
168 : C EXPLICATION DE CES VARIABLES
169 : C ----------------------------
170 : C
171 : C NP : NOMBRE TOTAL DE POUTRES DU MAILLAGE
172 : C
173 : C NP2 : NP * 2
174 : C
175 : C NP24 : NP * 24
176 : C
177 : C NP48 : NP * 48
178 : C
179 : C NNT : NOMBRE TOTAL DE NOEUDS DU MAILLAGE
180 : C
181 : C NNT12 : NNT * 12
182 : C
183 : C NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
184 : C
185 : C ---------------------------------------------------------------------
186 : C
187 : C .................... ZA1 : MATRICE DE RESOLUTION
188 : C
189 : C .................... ZSM : VECTEUR SECOND MEMBRE
190 : C
191 : C .................... ZXX : VECTEUR INCONNU
192 : C
193 : C ZXX CONTIENT, POUR LES 2NP NOEUDS, DANS L'ORDRE SUIVANT :
194 : C
195 : C UX UY UZ RX RY RZ FX FY FZ MX MY MZ
196 : C
197 : C
198 : C .................... ZSOL : TABLEAU SOLUTION POUR TOUTES LES FREQ.
199 : C
200 : C
201 : C .................... COOR : TABLEAU DES COORDONNEES
202 : C
203 : C UNE POUTRE COMPORTE 2 NOEUDS (P1 ET P2) --> 2*NP NOEUDS FICTIFS
204 : C
205 : C | COOR(1,2*INP-1) | COOR(1,2*INP)
206 : C P1 | COOR(2,2*INP-1) P2 | COOR(2,2*INP)
207 : C | COOR(3,2*INP-1) | COOR(3,2*INP)
208 : C
209 : C ---------------------------------------------------------------------
210 : C
211 : C .................... GAMA : VECTEUR DEFINISSANT L'AXE OY
212 : C POUR CHAQUE POUTRE
213 : C
214 : C
215 : C .................... CARACT : TABLEAU DES CARACTERISTIQUES
216 : C
217 : C CARACT EST UNE MATRICE (12,NP) QUI, POUR TOUTES LES NP POUTRES,
218 : C DONNE LES CARACTERISTIQUES GEOMETRIQUES ET PHYSIQUE DE LA POUTRE :
219 : C
220 : C CARACT( 1,INP) --> MODULE D'YOUNG : E
221 : C CARACT( 2,INP) --> COEFICIENT DE POISSON : NU
222 : C CARACT( 3,INP) --> MASSE VOLUMIQUE : RHO
223 : C CARACT( 4,INP) --> SECTION DROITE DE LA POUTRE : SE
224 : C CARACT( 5,INP) --> MOMENT DE TORSION : C
225 : C CARACT( 6,INP) --> MOMENT D'INERTIE POLAIRE : IP
226 : C CARACT( 7,INP) --> MOMENT D'INERTIE SUIVANT L'AXE OY : IY
227 : C CARACT( 8,INP) --> MOMENT D'INERTIE SUIVANT L'AXE OZ : IZ
228 : C CARACT( 9,INP) --> CONSTANTE DE TIMOSHENKO KCY : KCY
229 : C CARACT(10,INP) --> CONSTANTE DE TIMOSHENKO KCZ : KCZ
230 : C CARACT(11,INP) --> COEFICIENT D'AMORTISSEMENT EXTERNE : CAM
231 : C CARACT(12,INP) --> COEFICIENT D'AMORTISSEMENT INTERNE : ETA
232 : C
233 : C ---------------------------------------------------------------------
234 : C
235 : C .................... XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
236 : C AUX LIMITES POUR CHAQUE NOEUD.
237 : C
238 : C XCL (K,NN) = VALEUR DE LA CONDITION K AU NOEUD REEL NN
239 : C LES CONDITIONS K CORRESPONDENT RESPECTIVEMENT A UX, UY, UZ, RX,
240 : C RY, RZ, FX, FY, FZ, MX, MY, MZ.
241 : C
242 : C CHAQUE NOEUD AYANT SOIT LES DEPLACEMENTS, SOIT LES EFFORTS, SOIT
243 : C RIEN DU TOUT D'IMPOSES, IL CONVIENT DE DEFINIR UN VECTEUR JOUANT LE
244 : C ROLE DE POINTEUR SUR XCL QUE L'ON APPELLE FLAG DE LONGUEUR 12*NNT.
245 : C
246 : C LES DIFFERENTS BLOCS DE 12 VALEURS POINTENT SUR LE NOEUD CORRES-
247 : C PONDANT :
248 : C
249 : C LA VALEUR DE FLAG VAUT LE NUMERO DU NOEUD SI ON IMPOSE LA CONDITION
250 : C ELLE VAUT 0 SINON.
251 : C
252 : C ---------------------------------------------------------------------
253 : C
254 : C .................... CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
255 : C
256 : C CHAQUE NOEUD FICTIF EST ASSOCIE A UN NOEUD REEL ; LE TABLEAU CORRES
257 : C DONNE, POUR CHAQUE NOEUD FICTIF (2*NP), LE NUMERO DU NOEUD REEL AS-
258 : C SOCIE.
259 : C
260 : C ---------------------------------------------------------------------
261 : C
262 : C
263 : C .................... NUMERO : TABLEAU DE NUMERO DE NOEUDS
264 : C
265 : C NUMERO (I) = NUMERO GIBI DU IEME NOEUD ( 1 < I < N )
266 : C
267 : C LA NUMEROTATION DE 1 A N EST ARBITRAIREMENT SELON LES NUMEROS
268 : C CROISSANTS DANS GIBI.
269 : C
270 : C
271 : C .................... MASS : TABLEAU DONNANT POUR CHAQUE MASSE
272 : C PONCTUELLE :
273 : C
274 : C - MASS(NNT,1) ... NUMERO DU NOEUD OU S'APPLIQUE LA MASSE
275 : C - MASS(NNT,2) ... NUMERO DE LA POUTRE ASSOCIEE
276 : C - MASS(NNT,3) ... NUMERO DU DEPLACEMENT UX CORRESPONDANT
277 : C DANS LE VECTEUR DES INCONNUS
278 : C - MASS(NNT,4) ... NUMERO DE LA LIGNE TRADUISANT
279 : C SOMME FX = FX EXTERIEURES
280 : C
281 : C .................... RMAS : TABLEAU DONNANT POUR LE NOEUD
282 : C CORRESPONDANT LA VALEUR DE LA MASSE
283 : C DE J0X
284 : C DE J0Y
285 : C DE J0Z
286 : C
287 : C ........... IPIVO,JPIVO,IAUX : TABLEAU INTERMEDIAIRE DE MEMORISATION
288 : C DE LA TRIANGULARISATION DE GAUSS
289 : C
290 : C
291 : C ..................... VALDE1 : TABLEAU DONNANT POUR CHAQUE ELEMENT
292 : C DU SOUS MAILLAGE LE MODULE DU DEPLA-
293 : C CEMENT
294 : C
295 : C ..................... VALDE2 : TABLEAU DONNANT POUR CHAQUE ELEMENT
296 : C DU SOUS MAILLAGE LA PHASE DU DEPLA-
297 : C CEMENT
298 : C
299 : C
300 : C ......S E G M E N T MATITE : TABLEAUX NE SERVANT QUE POUR
301 : C L'EVENTUALITE D'UNE METHODE ITERATIVE
302 : C
303 : C
304 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
305 : C
306 : C ------------------- DIMENSIONNEMENT DES MATRICES AUXILIAIRES
307 : C ----------------------------------------
308 : C
309 : SEGMENT AUXI
310 : INTEGER IAUXI(NNNP)
311 : ENDSEGMENT
312 : C
313 : C -------------------- LECTURE DES OBJETS MAILLAGE CHPOINT ET LISTREEL
314 : C -----------------------------------------------
315 : C
316 : C
316 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU)
317 : IF (IERR.NE.0) RETURN
318 : C
318 : CALL LIROBJ('MAILLAGE',IPT4,0,IRETOU)
319 : IF (IERR.NE.0) RETURN
320 : IF (IRETOU.NE.0) THEN
321 : IDEPL = 1
322 : SEGACT IPT4
323 : NBELEM = IPT4.NUM(/2)
324 : ELSE
325 : IDEPL = 0
326 : NBELEM = 1
327 : END IF
328 : C
328 : CALL LIROBJ('CHPOINT',MCHPO1,1,IRETOU)
329 : IF (IERR.NE.0) RETURN
330 : C
330 : CALL LIROBJ('MCHAML',MCHEL1,1,IRETOU)
331 : IF (IERR.NE.0) RETURN
332 : C
332 : CALL LIROBJ('LISTREEL',MLREE1,1,IRETOU)
333 : IF (IERR.NE.0) RETURN
334 : C
334 : CALL LIRREE(S0,1,IRETOU)
335 : IF (IERR.NE.0) RETURN
336 : C
336 : CALL LIROBJ('POINT',NPOI,1,IRETOU)
337 : IF (IERR.NE.0) RETURN
338 : C
338 : CALL LIRCHA(CHAR,1,LCHAR)
339 : IF (IERR.NE.0) RETURN
340 : C
340 : CALL ELLP09(CHAR,ICHAR,IERROR)
341 : C
342 : IF (IERROR.NE.0.OR.ICHAR.GT.12) THEN
343 : WRITE(IOIMP,*)'ERREUR DANS LA LECTURE DES DONNEES *********'
344 : WRITE(IOIMP,*)'ON NE RECONNAIT PAS UX, UY, UZ, RX, RY OU RZ'
345 : WRITE(IOIMP,*)'DANS LA DEMANDE DES RESULTATS. '
346 : RETURN
347 : END IF
348 : C
348 : CALL LIRENT(METH,1,IRETOU)
349 : IF (IERR.NE.0) RETURN
350 : C
350 : CALL LIRENT(IMP,0,IRETOU)
351 : IF (IERR.NE.0) RETURN
352 : IF (IRETOU.EQ.0) IMP = 0
353 : IF (IMP.NE.0) IMP = IOIMP
354 : C
355 : C
356 : C -------------------- ACTIVATION DES SEGMENTS
357 : C -----------------------
358 : SEGACT IPT1
359 : SEGACT MLREE1
360 : SEGACT MCHPO1
361 : SEGACT MCHEL1
362 : C
363 : C
364 : C **********************************************************************
365 : C LECTURE DU MAILLAGE
366 : C **********************************************************************
367 : C
368 : C ..................NP : NOMBRE DE POUTRES DU MAILLAGE
369 : C
370 : NP = IPT1.NUM(/2)
371 : C
372 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
373 : C
374 : IF (IMP.NE.0) THEN
375 : WRITE (IMP,*) 'NOMBRE DE POUTRES DU MAILLAGE :',NP
376 : END IF
377 : C
378 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
379 : C
380 : NN = IPT1.NUM(/1)
381 : C
382 : C --------------------- NFRQ : NOMBRE DE POINTS DE CALCUL EN FREQUENCE
383 : C
384 : NFRQ = MLREE1.PROG(/1)
385 : C
386 : IF (IDEPL.EQ.1.AND.NFRQ.NE.1) THEN
387 : WRITE(6,*)'ERREUR*********************************'
388 : WRITE(6,*)' '
389 : WRITE(6,*)'ON NE PEUT DONNER LA DEFORMEE QUE POUR'
390 : WRITE(6,*)'UNE SEULE FREQENCE (LISTREEL DE LONG 1)'
391 : RETURN
392 : END IF
393 : C
394 : C
395 : C --------------------- DETERMINATION DU NOMBRE DE NOEUDS DU MAILLAGE
396 : C ---------------------------------------------
397 : NNNP = NN*NP
398 : SEGINI AUXI
399 : ICOMP = 0
400 : DO 10 I = 1 , NP
401 : DO 11 J = 1 , NN
402 : AUXI.IAUXI(ICOMP+1) = IPT1.NUM(J,I)
403 : C
404 : IF (ICOMP.LT.1) THEN
405 : ITEST = 0
406 : GOTO 13
407 : END IF
408 : C
409 : ITEST = 0
410 : DO 12 K = 1 , ICOMP
411 : IF (AUXI.IAUXI(K).EQ.IPT1.NUM(J,I)) ITEST = 1
412 : 12 CONTINUE
413 : C
414 : 13 IF (ITEST.EQ.0) ICOMP = ICOMP + 1
415 : C
416 : 11 CONTINUE
417 : C
418 : 10 CONTINUE
419 : C
420 : SEGSUP AUXI
421 : C
422 : NNT = ICOMP
423 : C
424 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
425 : C
426 : IF (IMP.NE.0) THEN
427 : WRITE (IMP,*) 'NOMBRE TOTAL DE NOEUD DU MAILLAGE :',NNT
428 : END IF
429 : C
430 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
431 : C
432 : C --------------------- INITIALISATION DES TABLEAUX DE TRAVAIL
433 : C --------------------------------------
434 : NP2 = NP * 2
435 : NP12 = NP * 12
436 : NP24 = NP * 24
437 : NP48 = NP * 48
438 : NNT12 = NNT * 12
439 : C
440 : SEGINI MATRES
441 : C
442 : C ------------------- SI NON METHODE ITERATIVE, SEGMENT MATITE INUTILE
443 : C ------------------------------------------------
444 : IF (METH.LT.3) THEN
445 : NP48 = 48
446 : END IF
447 : C
448 : SEGINI MATITE
449 : C
450 : NUMP = 0
451 : C
452 : DO 20 INP = 1 , NP
453 : C
454 : IP1 = IPT1.NUM(1,INP)
455 : C
456 : C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
457 : C -------------------------------------
458 : IF (NUMP.EQ.0) THEN
459 : NUMP = NUMP + 1
460 : MATRES.NUMERO ( NUMP ) = IP1
461 : ELSE
462 : NON = 0
463 : DO 21 I = 1 , NUMP
464 : IF (MATRES.NUMERO(I).EQ.IP1) THEN
465 : NON = 1
466 : END IF
467 : 21 CONTINUE
468 : C
469 : IF (NON.EQ.0) THEN
470 : NUMP = NUMP + 1
471 : MATRES.NUMERO ( NUMP ) = IP1
472 : END IF
473 : END IF
474 : C
475 : IP2 = IPT1.NUM(2,INP)
476 : C
477 : C ---------------------- TRADUCTION NUMERO GLOBAL NUMERO LOCAL
478 : C -------------------------------------
479 : NON = 0
480 : DO 22 I = 1 , NUMP
481 : IF (MATRES.NUMERO(I).EQ.IP2) THEN
482 : NON = 1
483 : END IF
484 : 22 CONTINUE
485 : C
486 : IF (NON.EQ.0) THEN
487 : NUMP = NUMP + 1
488 : MATRES.NUMERO ( NUMP ) = IP2
489 : END IF
490 : C
491 : C
492 : C -------------------- COOR : TABLEAU DES COORDONNEES
493 : C --------------------------------
494 : MATRES.COOR(1,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
495 : MATRES.COOR(2,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
496 : MATRES.COOR(3,2*INP-1) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
497 : MATRES.COOR(1,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+1)
498 : MATRES.COOR(2,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+2)
499 : MATRES.COOR(3,2*INP ) = MCOORD.XCOOR((IP2-1)*(IDIM+1)+3)
500 : C
501 : C -------------------- CORRES : TABLEAU POUR CONNAITRE LES LIAISONS
502 : C --------------------------------------------
503 : C
504 : MATRES.CORRES(2*INP-1) = IP1
505 : MATRES.CORRES(2*INP ) = IP2
506 : C
507 : 20 CONTINUE
508 : C
509 : C
510 : C **********************************************************************
511 : C LECTURE DU CHPOINT (CONDITIONS AUX LIMITES)
512 : C **********************************************************************
513 : C
514 : C -------------------- XCL + FLAG : TABLEAU DONNANT LES CONDITIONS
515 : C ---------- AUX LIMITES POUR CHAQUE NOEUD.
516 : C
517 : NSOUPO = MCHPO1.IPCHP(/1)
518 : C
519 : IMAS = 0
520 : C
521 : DO 25 I = 1 , NNT
522 : DO 25 J = 1 , 12
523 : MATRES.XCL(J,I) = 0.E0
524 : MATRES.FLAG((I-1)*NNT+J) = 0
525 : 25 CONTINUE
526 : C
527 : DO 30 I = 1 , NSOUPO
528 : C
529 : MSOUP1 = MCHPO1.IPCHP(I)
530 : SEGACT MSOUP1
531 : C
532 : IPT2 = MSOUP1.IGEOC
533 : SEGACT IPT2
534 : C
535 : MPOVA2 = MSOUP1.IPOVAL
536 : SEGACT MPOVA2
537 : C
538 : NC = MSOUP1.NOCOMP(/2)
539 : N = MPOVA2.VPOCHA(/1)
540 : C
541 : DO 31 J = 1 , N
542 : C
543 : C -- ON CHERCHE NUM(1,J) CAR DANS UN CHAMP PAR POINTS, LES
544 : C -- ELEMENTS DES SOUS-MAILLAGES ELEMENTAIRES SONT LES POINTS
545 : C -- DE CES SOUS-MAILLAGES, ET CHAQUE ELEMENT CONTIENT DONC UN
546 : C -- SEUL NOEUD
547 : C
548 : NOEUD = IPT2.NUM(1,J)
549 : ISTOP = 0
550 : C
551 : DO 33 K = 1 , NNT
552 : IF (MATRES.NUMERO(K).EQ.NOEUD) THEN
553 : NNOEUD = K
554 : END IF
555 : 33 CONTINUE
556 : C
557 : DO 32 K = 1 , NC
558 : COMP = MSOUP1.NOCOMP(K)
558 : CALL ELLP09(COMP,ICOMP,IERROR)
559 : IF (IERROR.NE.0) THEN
560 : RETURN
561 : END IF
562 : C
563 : IF (ICOMP.GE.13.AND.ISTOP.EQ.0) THEN
564 : IMAS = IMAS + 1
565 : ISTOP = 1
566 : END IF
567 : IF (ICOMP.EQ.13) THEN
568 : DO 35 II = 2*NP , 1 , -1
569 : IF (CORRES(II).EQ.NOEUD) THEN
570 : MATRES.MASS(IMAS,1) = II
571 : END IF
572 : 35 CONTINUE
573 : C
574 : MATRES.MASS(IMAS,2) = INT((MATRES.MASS(IMAS,1)+1)/2)
575 : II = MATRES.MASS(IMAS,1)
576 : JJ = INT(II/2)*2
577 : IF (II.EQ.JJ) THEN
578 : MATRES.MASS(IMAS,3) = 24*(MATRES.MASS(IMAS,2)-1)+13
579 : ELSE
580 : MATRES.MASS(IMAS,3) = 24*(MATRES.MASS(IMAS,2)-1)+1
581 : END IF
582 : C
583 : MATRES.RMAS(IMAS,1) = MPOVA2.VPOCHA(J,K)
584 : C
585 : ELSE IF (ICOMP.GT.13) THEN
586 : JMAS = ICOMP - 12
587 : MATRES.RMAS(IMAS,JMAS) = MPOVA2.VPOCHA(J,K)
588 : C
589 : ELSE
590 : C
591 : MATRES.XCL(ICOMP,NNOEUD)=MPOVA2.VPOCHA(J,K)
592 : MATRES.FLAG((NNOEUD-1)*12+ICOMP)=NNOEUD
593 : END IF
594 : C
595 : 32 CONTINUE
596 : 31 CONTINUE
597 : C
598 : WRITE(6,*)'FIN D IMPRESSION'
599 : DO 34 IN = 1 , NNT12 , 3
600 : IF (MATRES.FLAG(IN ).NE.0.OR.
601 : * MATRES.FLAG(IN+1).NE.0.OR.
602 : * MATRES.FLAG(IN+2).NE.0) THEN
603 : MATRES.FLAG(IN ) = INT((IN-1)/12) + 1
604 : MATRES.FLAG(IN+1) = INT((IN-1)/12) + 1
605 : MATRES.FLAG(IN+2) = INT((IN-1)/12) + 1
606 : END IF
607 : 34 CONTINUE
608 : C
609 : SEGDES IPT2
610 : SEGDES MPOVA2
611 : SEGDES MSOUP1
612 : C
613 : 30 CONTINUE
614 : C
615 : NMAS = IMAS
616 : C
617 : C
618 : C **********************************************************************
619 : C LECTURE DU NOUVEAU CHAMLEM (CARACTERISTIQUES DU MATERIAU)
620 : C **********************************************************************
621 : C
622 : C
623 : C .................... CARACT : TABLEAU DES CARACTERISTIQUES
624 : C
625 : NN1 = MCHEL1.IMACHE(/1)
626 : C
627 : DO 700 I = 1 , NN1
628 : C
629 : IPT3 = MCHEL1.IMACHE(I)
630 : MCHAM1 = MCHEL1.ICHAML(I)
631 : C
632 : SEGACT IPT3
633 : NBE = IPT3.NUM(/2)
634 : C
635 : SEGACT MCHAM1
636 : NN2 = MCHAM1.IELVAL(/1)
637 : C
638 : DO 713 II = 1 , NN2
639 : C
639 : CALL ELLP08(MCHAM1.NOMCHE(II),ICARAC,IERROR)
640 : IF (IERROR.NE.0) THEN
641 : RETURN
642 : END IF
643 : C
644 : IF (ICARAC.NE.6) THEN
645 : MELVA1 = MCHAM1.IELVAL(II)
646 : SEGACT MELVA1
647 : XCARAC = MELVA1.VELCHE(1,1)
648 : SEGDES MELVA1
649 : ELSE
650 : MELVA1 = MCHAM1.IELVAL(II)
651 : SEGACT MELVA1
652 : IPP = MELVA1.IELCHE(1,1)
653 : X1 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+1)
654 : X2 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+2)
655 : X3 = MCOORD.XCOOR((IPP-1)*(IDIM+1)+3)
656 : SEGDES MELVA1
657 : END IF
658 : C
659 : DO 716 IE = 1 , NBE
660 : INU1 = IPT3.NUM(1,IE)
661 : INU2 = IPT3.NUM(2,IE)
662 : C
663 : NCARAC = 0
664 : C
665 : DO 717 III = 1 , NP2 , 2
666 : IN1 = MATRES.CORRES(III )
667 : IN2 = MATRES.CORRES(III+1)
668 : IF (INU1.EQ.IN1.AND.INU2.EQ.IN2) THEN
669 : NCARAC = INT(III/2) + 1
670 : END IF
671 : C
672 : IF (INU1.EQ.IN2.AND.INU2.EQ.IN1) THEN
673 : NCARAC = INT(III/2) + 1
674 : END IF
675 : C
676 : 717 CONTINUE
677 : C
678 : IF (ICARAC.NE.6) THEN
679 : MATRES.CARACT(ICARAC,NCARAC) = XCARAC
680 : ELSE
681 : MATRES.GAMA(1,NCARAC) = X1
682 : MATRES.GAMA(2,NCARAC) = X2
683 : MATRES.GAMA(3,NCARAC) = X3
684 : END IF
685 : C
686 : 716 CONTINUE
687 : C
688 : 713 CONTINUE
689 : C
690 : SEGDES MCHAM1
691 : SEGDES IPT3
692 : C
693 : 700 CONTINUE
694 : C
695 : C -------------------------- ENTREE DU MOMENT POLAIRE IP = IY + IZ
696 : C -------------------------------------
697 : DO 40 I = 1 , NP
698 : MATRES.CARACT ( 6, I ) = MATRES.CARACT ( 7, I)
699 : * + MATRES.CARACT ( 8, I )
700 : 40 CONTINUE
701 : C
702 : C -------------------------- CALCUL DE LA VALEUR REEL DE NPOI
703 : C --------------------------------
704 : DO 50 I = 1 , NNT
705 : IF (MATRES.NUMERO(I).EQ.NPOI) THEN
706 : NNPOI = I
707 : END IF
708 : 50 CONTINUE
709 : C
710 : SEGDES IPT1
711 : SEGDES MCHPO1
712 : SEGDES MCHEL1
713 : C
714 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
715 : C
716 : IF (IMP.NE.0) THEN
717 : C
718 : C ----------------------------------------------------------------------
719 : C
720 : C IMPRESSION DES TABLEAUX CREES A L'INTERFACE
721 : C
722 : C - COOR ( 3 , 2*NP )
723 : C - CORRES ( 2*NP )
724 : C - GAMA ( 3 , NP )
725 : C - CARACT (12 , NP )
726 : C - XCL (12 , NNT )
727 : C - FLAG ( 12*NNT )
728 : C - NUMERO ( NNT )
729 : C - MASS ( NMAS , 3 )
730 : C - RMAS ( NMAS , 4)
731 : C
732 : C ----------------------------------------------------------------------
733 : C
734 : WRITE (IMP,*) 'TABLEAU COOR :'
735 : WRITE (IMP,*) '************'
736 : C
737 : DO 980 I = 1 , 2*NP
738 : WRITE (IMP,*) 'NOEUD ',I,':',
739 : * MATRES.COOR(1,I),MATRES.COOR(2,I),MATRES.COOR(3,I)
740 : 980 CONTINUE
741 : C
742 : WRITE (IMP,*) 'TABLEAU CORRES :'
743 : WRITE (IMP,*) '**************'
744 : C
745 : DO 981 I = 1 , 2*NP
746 : WRITE (IMP,*) 'NOEUD ',I,':',MATRES.CORRES(I)
747 : 981 CONTINUE
748 : C
749 : C
750 : WRITE (IMP,*) 'TABLEAU NUMERO :'
751 : WRITE (IMP,*) '**************'
752 : C
753 : DO 987 I = 1 , NNT
754 : WRITE (IMP,*) 'NOEUD ',I,':',MATRES.NUMERO(I)
755 : 987 CONTINUE
756 : C
757 : WRITE (IMP,*) 'TABLEAU GAMA :'
758 : WRITE (IMP,*) '************'
759 : C
760 : DO 982 I = 1 , NP
761 : WRITE (IMP,*) 'POUTRE ',I,':',
762 : * MATRES.GAMA(1,I),MATRES.GAMA(2,I),MATRES.GAMA(3,I)
763 : 982 CONTINUE
764 : C
765 : WRITE (IMP,*) 'TABLEAU CARACT :'
766 : WRITE (IMP,*) '**************'
767 : C
768 : DO 983 I = 1 , NP
769 : WRITE (IMP,*) 'E : ',MATRES.CARACT ( 1 , I)
770 : WRITE (IMP,*) 'NU : ',MATRES.CARACT ( 2 , I)
771 : WRITE (IMP,*) 'RHO : ',MATRES.CARACT ( 3 , I)
772 : WRITE (IMP,*) 'SEC : ',MATRES.CARACT ( 4 , I)
773 : WRITE (IMP,*) 'C : ',MATRES.CARACT ( 5 , I)
774 : WRITE (IMP,*) 'IP : ',MATRES.CARACT ( 6 , I)
775 : WRITE (IMP,*) 'IY : ',MATRES.CARACT ( 7 , I)
776 : WRITE (IMP,*) 'IZ : ',MATRES.CARACT ( 8 , I)
777 : WRITE (IMP,*) 'KCY : ',MATRES.CARACT ( 9 , I)
778 : WRITE (IMP,*) 'KCZ : ',MATRES.CARACT (10 , I)
779 : WRITE (IMP,*) 'CAM : ',MATRES.CARACT (11 , I)
780 : WRITE (IMP,*) 'ETA : ',MATRES.CARACT (12 , I)
781 : 983 CONTINUE
782 : C
783 : WRITE (IMP,*) 'TABLEAU XCL :'
784 : WRITE (IMP,*) '***********'
785 : C
786 : DO 984 I = 1 , 12
787 : DO 985 J = 1 , NNT
788 : WRITE (IMP,*) I , J,':',MATRES.XCL (I,J)
789 : 985 CONTINUE
790 : 984 CONTINUE
791 : C
792 : WRITE (IMP,*) 'TABLEAU FLAG :'
793 : WRITE (IMP,*) '************'
794 : C
795 : DO 986 I = 1 , 12*NNT
796 : WRITE (IMP,*) 'VAL ',I,':',MATRES.FLAG ( I )
797 : 986 CONTINUE
798 : C
799 : WRITE(IMP,*)'NMAS',NMAS
800 : C
801 : IF (NMAS.GT.0) THEN
802 : DO 988 I = 1 , NMAS
803 : WRITE (IMP,*) 'MASS (',I,',1) :',MATRES.MASS(I,1)
804 : WRITE (IMP,*) 'MASS (',I,',2) :',MATRES.MASS(I,2)
805 : WRITE (IMP,*) 'MASS (',I,',3) :',MATRES.MASS(I,3)
806 : WRITE (IMP,*) 'MASS (',I,',4) :',MATRES.MASS(I,4)
807 : 988 CONTINUE
808 : C
809 : DO 989 I = 1 , NMAS
810 : WRITE (IMP,*) 'RMAS (',I,',1) :',MATRES.RMAS(I,1)
811 : WRITE (IMP,*) 'RMAS (',I,',2) :',MATRES.RMAS(I,2)
812 : WRITE (IMP,*) 'RMAS (',I,',3) :',MATRES.RMAS(I,3)
813 : WRITE (IMP,*) 'RMAS (',I,',4) :',MATRES.RMAS(I,4)
814 : 989 CONTINUE
815 : END IF
816 : C
817 : END IF
818 : C
819 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
820 : C
821 : C ----------------------------------------------------------------------
822 : C
823 : C APPEL DU PROGRAMME FORTRAN POUR LA RESOLUTION DU PROBLEME
824 : C
825 : C TABLEAUX D'ENTREE :
826 : C
827 : C COOR(3,2*NP), CORRES(2*NP), GAMA(3,NP), CARACT(12,NP),
828 : C XCL(12,NNT) , FLAG (12*NNT), NUMERO (NNT) (NP NOMBRE DE POUTRES
829 : C NNT NOMBRE REEL DE NOEUDS)
830 : C
831 : C TABLEAUX DE SORTIE :
832 : C
833 : C ZA1(24*NP,24*NP) , ZSM (24*NP) , ZXX (24*NP)
834 : C
835 : C ----------------------------------------------------------------------
836 : C
836 : CALL ELLP11(MATRES.COOR , MATRES.CORRES , MATRES.GAMA ,
837 : * MATRES.CARACT , MATRES.XCL , MATRES.FLAG ,
838 : * MATRES.NUMERO , MATRES.ZA1 , MATRES.ZSM ,
839 : * MATRES.ZXX , MATRES.ZSOL , MATITE.ITERA ,
840 : * MATRES.MASS , MATRES.RMAS , NMAS ,
841 : * MATITE.SA , MATITE.SB , MATITE.SU ,
842 : * MATITE.SR , MATITE.SQ , MATITE.SDELTA,
843 : * MATITE.SDELT1 , MATITE.SP , MATITE.SP1 ,
844 : * MATITE.SCH , MATITE.SCH1 , MATRES.IPIVO ,
845 : * MATRES.JPIVO , MATRES.IAUX , MLREE1.PROG ,
846 : * NNPOI,ICHAR,NP,NP24,NP48,NNT,NNT12,NFRQ,S0,XPI,METH,IMP)
847 : C
848 : ZS = S0 + (0.D0 , 1.D0 ) * 2. * XPI * MLREE1.PROG(1)
849 : C
850 : C
851 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
852 : IF (IMP.NE.0) THEN
853 : WRITE (IMP,*)'VECTEUR SOLUTION ZSOL (PREMIERE FREQUENCE) :'
854 : DO 42 J = 1 , NNT12
855 : WRITE (IMP,*) J,MATRES.ZSOL(J,1)
856 : 42 CONTINUE
857 : C
858 : END IF
859 : C IIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIIII
860 : C
861 : IF (IDEPL.EQ.0) THEN
862 : C
863 : JG = NFRQ
864 : SEGINI MLREE2
865 : SEGINI MLREE3
866 : SEGINI MLREE4
867 : C
868 : DO 100 I = 1 , NFRQ
869 : C
870 : MLREE2.PROG(I) = ABS(MATRES.ZSOL((NNPOI-1)*12+ICHAR,I))
871 : C
872 : ZT = MATRES.ZSOL((NNPOI-1)*12+ICHAR,I)
873 : PRZT = ZT
874 : PIZT = ZT*(0.D0,-1.D0)
875 : C
876 : IF (ABS(PRZT).LT.XPETIT.AND.ABS(PIZT).LT.XPETIT) THEN
877 : MLREE3.PROG(I) = 0.D0
878 : ELSE
879 : MLREE3.PROG(I) = ATAN2(PIZT,PRZT)*180.D0/XPI
880 : END IF
881 : C
882 : MLREE4.PROG(I) = MATITE.ITERA(I)
883 : 100 CONTINUE
884 : C
885 : C ------------------- OUVERTURE DU SEGMENT RESULTAT TYPE EVOLUTION
886 : C --------------------------------------------
887 : C
888 : N = 3
889 : SEGINI MEVOL1
890 : SEGINI KEVOL1
891 : SEGINI KEVOL2
892 : SEGINI KEVOL3
893 : C
894 : MEVOL1.ITYEVO = 'REEL'
895 : C MEVOL1.IEVTEX = 'OPERATEUR ELFE LAPLACE POUTRE'
896 : MEVOL1.IEVOLL(1) = KEVOL1
897 : MEVOL1.IEVOLL(2) = KEVOL2
898 : MEVOL1.IEVOLL(3) = KEVOL3
899 : C
900 : C
901 : KEVOL1.IPROGX = MLREE1
902 : KEVOL1.IPROGY = MLREE2
903 : C KEVOL1.NUMEVY = 'MODU'
904 : KEVOL1.TYPX = 'LISTREEL'
905 : KEVOL1.TYPY = 'LISTREEL'
906 : KEVOL1.NOMEVX = 'FREQ (HZ)'
907 : KEVOL1.NOMEVY = CHAR
908 : C KEVOL1.KEVTEX = '********'
909 : C
910 : C
911 : KEVOL2.IPROGX = MLREE1
912 : KEVOL2.IPROGY = MLREE3
913 : C KEVOL2.NUMEVY = 'PHAS'
914 : KEVOL2.TYPX = 'LISTREEL'
915 : KEVOL2.TYPY = 'LISTREEL'
916 : KEVOL2.NOMEVX = 'FREQ (HZ)'
917 : KEVOL2.NOMEVY = CHAR
918 : C KEVOL2.KEVTEX = '********'
919 : C
920 : KEVOL3.IPROGX = MLREE1
921 : KEVOL3.IPROGY = MLREE4
922 : KEVOL3.NUMEVY = 'ITER'
923 : KEVOL3.TYPX = 'LISTREEL'
924 : KEVOL3.TYPY = 'LISTREEL'
925 : KEVOL3.NOMEVX = 'FREQ (HZ)'
926 : KEVOL3.NOMEVY = CHAR
927 : C KEVOL3.KEVTEX = 'ITERATION'
928 : C
928 : CALL ECROBJ('EVOLUTION',MEVOL1)
929 : C
930 : SEGDES KEVOL1
931 : SEGDES KEVOL2
932 : SEGDES KEVOL3
933 : SEGDES MEVOL1
934 : SEGDES MLREE2
935 : SEGDES MLREE3
936 : SEGDES MLREE4
937 : C
938 : ELSE
939 : C
940 : DO 230 I = 1 , 2
941 : DO 240 J = 1 , NBELEM
942 : IP1 = IPT4.NUM(I,J)
943 : MATRES.XCOR(I,1,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+1)
944 : MATRES.XCOR(I,2,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+2)
945 : MATRES.XCOR(I,3,J) = MCOORD.XCOOR((IP1-1)*(IDIM+1)+3)
946 : 240 CONTINUE
947 : 230 CONTINUE
948 : C
948 : CALL ELLP23(MATRES.CARACT , MATRES.COOR , MATRES.GAMA ,
949 : * MATRES.ZXX , MATRES.XCOR , MATRES.VALDE1,
950 : * MATRES.VALDE2 , ZS , NP , NBELEM ,XPI )
951 : C
952 : N1 = 1
953 : N2 = 6
954 : L1=0
955 : N3=0
956 : SEGINI MCHEL1
957 : SEGINI MCHAM1
958 : MCHEL1.IMACHE(1) = IPT4
959 : MCHEL1.CONCHE(1) = ' '
960 : MCHEL1.ICHAML(1) = MCHAM1
961 : C
962 : MCHAM1.NOMCHE(1) = 'UXM'
963 : MCHAM1.NOMCHE(2) = 'UYM'
964 : MCHAM1.NOMCHE(3) = 'UZM'
965 : MCHAM1.NOMCHE(4) = 'UXP'
966 : MCHAM1.NOMCHE(5) = 'UYP'
967 : MCHAM1.NOMCHE(6) = 'UZP'
968 : MCHAM1.TYPCHE(1) = 'REAL*8'
969 : MCHAM1.TYPCHE(2) = 'REAL*8'
970 : MCHAM1.TYPCHE(3) = 'REAL*8'
971 : MCHAM1.TYPCHE(4) = 'REAL*8'
972 : MCHAM1.TYPCHE(5) = 'REAL*8'
973 : MCHAM1.TYPCHE(6) = 'REAL*8'
974 : C
975 : N1PTEL = 2
976 : N1EL = NBELEM
977 : N2PTEL = 0
978 : N2EL = 0
979 : C
980 : SEGINI MELVA1
981 : SEGINI MELVA2
982 : SEGINI MELVA3
983 : SEGINI MELVA4
984 : SEGINI MELVA5
985 : SEGINI MELVA6
986 : C
987 : MCHAM1.IELVAL(1) = MELVA1
988 : MCHAM1.IELVAL(2) = MELVA2
989 : MCHAM1.IELVAL(3) = MELVA3
990 : MCHAM1.IELVAL(4) = MELVA4
991 : MCHAM1.IELVAL(5) = MELVA5
992 : MCHAM1.IELVAL(6) = MELVA6
993 : C
994 : DO 200 I = 1 , 2
995 : DO 210 J = 1 , NBELEM
996 : MELVA1.VELCHE(I,J) = VALDE1 ( I , J , 1 )
997 : MELVA2.VELCHE(I,J) = VALDE1 ( I , J , 2 )
998 : MELVA3.VELCHE(I,J) = VALDE1 ( I , J , 3 )
999 : MELVA4.VELCHE(I,J) = VALDE2 ( I , J , 1 )
1000 : MELVA5.VELCHE(I,J) = VALDE2 ( I , J , 2 )
1001 : MELVA6.VELCHE(I,J) = VALDE2 ( I , J , 3 )
1002 : 210 CONTINUE
1003 : 200 CONTINUE
1004 : C
1005 : * NSOUPO = 1
1006 : * NAT=1
1007 : * SEGINI MCHPO1
1007 : CALL CHAMPO(MCHEL1,1,MCHPO1,IRET)
1007 : CALL ECROBJ('CHPOINT',MCHPO1)
1008 : C
1009 : SEGDES MELVA1
1010 : SEGDES MELVA2
1011 : SEGDES MELVA3
1012 : SEGDES MELVA4
1013 : SEGDES MELVA5
1014 : SEGDES MELVA6
1015 : SEGDES MCHAM1
1016 : SEGDES MCHEL1
1017 : SEGDES MCHPO1
1018 : C
1019 : END IF
1020 : C
1021 : SEGDES MLREE1
1022 : SEGSUP MATRES
1023 : SEGSUP MATITE
1024 : C
1025 : END
1026 :
1027 :
1028 :
1029 :
1030 :
1031 :
1032 :
1033 :
© Cast3M 2003 - All rights reserved.
Disclaimer