1 : C THETAP SOURCE AM 13/12/16 21:16:09 7825
2 : SUBROUTINE THETAP(IPMODL,IPCHE1,IPCHE2,IPSTRS,IRET)
3 : *_______________________________________________________________________
4 : *
5 : * OPERATEUR DE CALCUL DE CONTRAINTES DUES A UN CHAMP DE TEMPERATURE
6 : * APPELE PAR THETA
7 : *
8 : * ENTREES :
9 : * ---------
10 : *
11 : * IPMODL POINTEUR SUR UN MMODEL
12 : * IPCHE1 MCHAML DE SOUS TYPE CARACTERISTIQUE
13 : * IPCHE2 MCHAML DE SOUS TYPE TEMPERATURE
14 : *
15 : * SORTIES :
16 : * ---------
17 : *
18 : * IPSTRS MCHAML DE SOUS TYPE CONTRAINTE (DUE @ LA TEMP{RATURE)
19 : * IRET 1 OU 0 SUIVANT SUCCES OU PAS
20 : *
21 : * PASSAGE AUX NOUVEAUX CHAMELEMS PAR S.RAMAHANDRY LE 05/09/90
22 : *
23 : * VARIATION PARABOLIQUE DE TEMPERATURE DANS LES COQUES,OPTION ORTHOTROPE
24 : * ET ANISOTROPE POUR LES MASSIFS PAR P.DOWLATYARI LE 15/03/91
25 : *_______________________________________________________________________
26 : *
27 : IMPLICIT INTEGER(I-N)
28 : IMPLICIT REAL*8(A-H,O-Z)
29 : *
30 : -INC CCOPTIO
31 : -INC SMCHAML
32 : -INC SMELEME
33 : -INC SMINTE
34 : -INC SMMODEL
35 : -INC CCHAMP
36 : -INC SMCOORD
37 : *
38 : SEGMENT NOTYPE
39 : CHARACTER*16 TYPE(NBTYPE)
40 : ENDSEGMENT
41 : *
42 : SEGMENT MPTVAL
43 : INTEGER IPOS(NS) ,NSOF(NS)
44 : INTEGER IVAL(NCOSOU)
45 : CHARACTER*16 TYVAL(NCOSOU)
46 : ENDSEGMENT
47 : *
48 : SEGMENT WRK1
49 : REAL*8 WORK(LW)
50 : ENDSEGMENT
51 : *
52 : SEGMENT WRK2
53 : REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
54 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM)
55 : REAL*8 ROTS(NSTRS,NSTRS),DHOOK(LHOOK,LHOOK)
56 : ENDSEGMENT
57 : *
58 : SEGMENT WRK3
59 : REAL*8 RES(NSTRS)
60 : ENDSEGMENT
61 : *
62 : SEGMENT MVELCH
63 : REAL*8 VALMAT(NV1)
64 : ENDSEGMENT
65 : *
66 : CHARACTER*8 CMATE
67 : CHARACTER*(NCONCH) CONM
68 : PARAMETER ( NINF=3 )
69 : INTEGER INFOS(NINF)
70 : DIMENSION CRIGI(12)
71 : LOGICAL lsupco,lsupma,lsupte
72 : *
73 : IRET = 0
74 : IPSTRS = 0
75 : *
76 : NHRM=NIFOUR
77 : THM = 0.D0
78 : THIF = 0.D0
79 : THSU = 0.D0
80 : TEMP = 0.D0
81 : *
82 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
83 : *
83 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUPMA,IRETMA)
84 : IF(ISUPMA.GT.1) RETURN
85 : *
86 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE TEMPERATURE
87 : *
87 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISUPTE,IRETTE)
88 : IF(ISUPTE.GT.1) RETURN
89 : *
90 : * ACTIVATION DU MODELE
91 : *
92 : MMODEL=IPMODL
93 : SEGACT MMODEL
94 : NSOUS=KMODEL(/1)
95 : C=============================================
96 : KNB22=0
97 : DO IJKL=1,NSOUS
98 : IMODEL=KMODEL(IJKL)
99 : SEGACT IMODEL
100 : IF (NEFMOD.EQ.22) KNB22=KNB22+1
101 : END DO
102 : N1=NSOUS-KNB22
103 : C=============================================
104 : *
105 : * CREATION DU MCHELM
106 : *
107 : C N1=NSOUS
108 : L1=11
109 : N3=6
110 : SEGINI MCHELM
111 : TITCHE='CONTRAINTES'
112 : IFOCHE=IFOUR
113 : *____________________________________________________________________
114 : *
115 : * DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
116 : *____________________________________________________________________
117 : *
118 : ISOUS=0
119 : DO 500 KISOUS=1,NSOUS
120 : *
121 : * INITIALISATION
122 : *
123 : MOCARA=0
124 : MOMATR=0
125 : MOSTRS=0
126 : MOTEMP=0
127 : IVAMAT=0
128 : IVACAR=0
129 : IVATEM=0
130 : IVASTR=0
131 : NCARA=0
132 : NCARF=0
133 : NMATR=0
134 : NMATF=0
135 : *
136 : IMODEL=KMODEL(KISOUS)
137 : C* SEGACT IMODEL
138 : MELE=NEFMOD
139 : if(mele.eq.22) go to 999
140 : ISOUS=ISOUS+1
141 : *
142 : * TRAITEMENT DU MODELE
143 : *
144 : IPMAIL=IMAMOD
145 : CONM =CONMOD
146 :
147 : IMACHE(ISOUS)=IPMAIL
148 : CONCHE(ISOUS)=CONMOD
149 : *
150 : * CREATION DU TABLEAU INFOS
151 : *
151 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
152 : IF (IRTD.EQ.0) GOTO 999
153 : *
154 : * NATURE DU MATERIAU
155 : *
156 : C NFOR=FORMOD(/2)
157 : C NMAT=MATMOD(/2)
157 : C CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
158 : CMATE = CMATEE
159 : MATE = IMATEE
160 : INAT = INATUU
161 : C IF (CMATE.EQ.' ') THEN
161 : C CALL ERREUR(251)
162 : C GOTO 999
163 : C ENDIF
164 : C
165 : C COQUE INTEGREE OU PAS ?
166 : C
167 : IF(INFMOD(/1).NE.0)THEN
168 : NPINT=INFMOD(1)
169 : ELSE
170 : NPINT = 0
171 : ENDIF
172 : *
173 : * INFORMATION SUR L'ELEMENT FINI
174 : *
174 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
175 : * IF (IERR.NE.0) GOTO 999
176 : * INFO=IPINF
177 : MELE =INFELE(1)
178 : ICARA=INFELE(5)
179 : IPORE=INFELE(8)
180 : MFR =INFELE(13)
181 : LHOOK=INFELE(10)
182 : NBGS =INFELE(4)
183 : NSTRS=INFELE(16)
184 : LW =INFELE(7)
185 : * MINTE=INFELE(11)
186 : MINTE=INFMOD(7)
187 : MINTE1=INFMOD(8)
188 : IPMINT=MINTE
189 : * SEGSUP INFO
190 : *
191 : INFCHE(ISOUS,1)=0
192 : INFCHE(ISOUS,2)=0
193 : INFCHE(ISOUS,3)=NHRM
194 : INFCHE(ISOUS,4)=MINTE
195 : INFCHE(ISOUS,5)=0
196 : INFCHE(ISOUS,6)=5
197 : *
198 : * INITIALISATION DE MINTE
199 : *
200 : SEGACT MINTE
201 : NBPGAU=POIGAU(/1)
202 : *
203 : * ACTIVATION DU MELEME
204 : *
205 : MELEME=IPMAIL
206 : SEGACT MELEME
207 : NBNN =NUM(/1)
208 : NBELEM=NUM(/2)
209 : NBNO=NBNN
210 : IF(MFR.EQ.33) NBNO=IPORE
211 : IELE = NUMGEO(MELE)
212 : IPPORE=0
213 : IF(MFR.EQ.33) IPPORE=NBNN
214 : *
215 : * RECHERCHE DES NOMS DE COMPOSANTES
216 : *
217 : if(lnomid(4).ne.0) then
218 : nomid=lnomid(4)
219 : segact nomid
220 : mostrs=nomid
221 : nstr=lesobl(/2)
222 : nfac=lesfac(/2)
223 : lsupco=.false.
224 : else
225 : lsupco=.true.
225 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
226 : endif
227 : if(lnomid(8).ne.0) then
228 : nomid=lnomid(8)
229 : segact nomid
230 : motemp=nomid
231 : ntem=lesobl(/2)
232 : nfac=lesfac(/2)
233 : lsupte=.false.
234 : else
235 : lsupte=.true.
235 : CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
236 : endif
237 : *
238 : * VERIFICATION DE LEUR PRESENCE
239 : *
240 : NBTYPE=1
241 : SEGINI NOTYPE
242 : MOTYPE=NOTYPE
243 : TYPE(1)='REAL*8'
244 : *
244 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,
245 : 1 MOTYPE,1,INFOS,3,IVATEM)
246 : SEGSUP NOTYPE
247 : IF (IERR.NE.0) GOTO 9990
248 : IF(ISUPTE.EQ.1)THEN
248 : CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE)
249 : IF(IERR.NE.0)THEN
250 : ISUPTE=0
251 : GOTO 9990
252 : ENDIF
253 : ENDIF
254 : *
255 : * RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
256 : *
257 : N1PTEL=NBGS
258 : N1EL=NBELEM
259 : *
260 : * CREATION DU MCHAML DE LA SOUS ZONE
261 : *
262 : N2=NSTRS
263 : SEGINI MCHAML
264 : ICHAML(ISOUS)=MCHAML
265 : NS=1
266 : NCOSOU=NSTRS
267 : SEGINI MPTVAL
268 : IVASTR=MPTVAL
269 : NOMID=MOSTRS
270 : SEGACT NOMID
271 : N2PTEL=0
272 : N2EL=0
273 : *
274 : IF(MELE.EQ.30.OR.MELE.EQ.43) THEN
275 : N1PTEL=1
276 : N1EL=1
277 : ENDIF
278 : DO 100 ICOMP=1,NSTRS
279 : NOMCHE(ICOMP)=LESOBL(ICOMP)
280 : TYPCHE(ICOMP)='REAL*8'
281 : SEGINI MELVAL
282 : IELVAL(ICOMP)=MELVAL
283 : IVAL(ICOMP)=MELVAL
284 : 100 CONTINUE
285 : SEGDES NOMID
286 : *
287 : * TRAITEMENT DES CHAMPS DE MATERIAU
288 : *
289 : NBROBL=0
290 : NBRFAC=0
291 : MOMATR=0
292 : lsupma=.true.
293 : *
294 : IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.46
295 : & .OR.MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124
296 : & .OR.MELE.EQ.84) THEN
297 : NBROBL=2
298 : SEGINI NOMID
299 : MOMATR=NOMID
300 : LESOBL(1)='YOUN'
301 : LESOBL(2)='ALPH'
302 : *
303 : * materiau isotrope
304 : *
305 : ELSE IF (CMATE.EQ.'ISOTROPE') THEN
306 : IF (MFR.EQ.35) THEN
307 : NBROBL=3
308 : SEGINI NOMID
309 : MOMATR=NOMID
310 : LESOBL(1)='KS '
311 : LESOBL(2)='KN '
312 : LESOBL(3)='ALPN'
313 : ELSE
314 : NBROBL=3
315 : SEGINI NOMID
316 : MOMATR=NOMID
317 : LESOBL(1)='YOUN'
318 : LESOBL(2)='NU '
319 : LESOBL(3)='ALPH'
320 : ENDIF
321 : *
322 : * materiau orthotrope
323 : *
324 : ELSE IF(CMATE.EQ.'ORTHOTRO') THEN
325 : IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9)THEN
326 : NBROBL=7
327 : SEGINI NOMID
328 : MOMATR=NOMID
329 : LESOBL(1)='YG1 '
330 : LESOBL(2)='YG2 '
331 : LESOBL(3)='NU12'
332 : LESOBL(4)='ALP1'
333 : LESOBL(5)='ALP2'
334 : LESOBL(6)='V1X '
335 : LESOBL(7)='V1Y '
336 : ELSE IF (MFR.EQ.35) THEN
337 : NBROBL=6
338 : SEGINI NOMID
339 : MOMATR=NOMID
340 : LESOBL(1)='KS1 '
341 : LESOBL(2)='KS2 '
342 : LESOBL(3)='KN '
343 : LESOBL(4)='ALPN'
344 : LESOBL(5)='V1X'
345 : LESOBL(6)='V1Y '
346 : ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
347 : IF(IFOUR.EQ.-2) THEN
348 : NBROBL =10
349 : SEGINI NOMID
350 : MOMATR=NOMID
351 : LESOBL(1)='YG1 '
352 : LESOBL(2)='YG2 '
353 : LESOBL(3)='NU12'
354 : LESOBL(4)='ALP1'
355 : LESOBL(5)='ALP2'
356 : LESOBL(6)='V1X '
357 : LESOBL(7)='V1Y '
358 : LESOBL(8)='YG3 '
359 : LESOBL(9)='NU23'
360 : LESOBL(10)='NU13'
361 :
362 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0
363 : 1 .OR.IFOUR.EQ.1.OR.IFOUR.EQ.-3)THEN
364 : NBROBL = 11
365 : SEGINI NOMID
366 : MOMATR=NOMID
367 : LESOBL(1)='YG1 '
368 : LESOBL(2)='YG2 '
369 : LESOBL(3)='YG3 '
370 : LESOBL(4)='NU12'
371 : LESOBL(5)='NU23'
372 : LESOBL(6)='NU13'
373 : LESOBL(7)='ALP1'
374 : LESOBL(8)='ALP2'
375 : LESOBL(9)='ALP3'
376 : LESOBL(10)='V1X '
377 : LESOBL(11)='V1Y '
378 : ELSEIF(IFOUR.EQ.2)THEN
379 : NBROBL = 15
380 : SEGINI NOMID
381 : MOMATR=NOMID
382 : LESOBL(1)='YG1 '
383 : LESOBL(2)='YG2 '
384 : LESOBL(3)='YG3 '
385 : LESOBL(4)='NU12'
386 : LESOBL(5)='NU23'
387 : LESOBL(6)='NU13'
388 : LESOBL(7)='ALP1'
389 : LESOBL(8)='ALP2'
390 : LESOBL(9)='ALP3'
391 : LESOBL(10)='V1X '
392 : LESOBL(11)='V1Y '
393 : LESOBL(12)='V1Z '
394 : LESOBL(13)='V2X '
395 : LESOBL(14)='V2Y '
396 : LESOBL(15)='V2Z '
397 : C= Modes de calcul UNIDIMENSIONNELS (1D)
398 : ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
399 : C= Mode 1D UNID PLAN CYCZ
400 : IF (IFOUR.EQ.6) THEN
401 : NBROBL=7
402 : SEGINI,NOMID
403 : LESOBL(1)='YG1 '
404 : LESOBL(2)='YG2 '
405 : LESOBL(3)='YG3 '
406 : LESOBL(4)='NU12'
407 : LESOBL(5)='NU23'
408 : LESOBL(6)='NU13'
409 : LESOBL(7)='ALP1'
410 : C= Modes 1D UNID PLAN CYDZ et CYGZ
411 : ELSE IF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
412 : NBROBL=8
413 : SEGINI,NOMID
414 : LESOBL(1)='YG1 '
415 : LESOBL(2)='YG2 '
416 : LESOBL(3)='YG3 '
417 : LESOBL(4)='NU12'
418 : LESOBL(5)='NU23'
419 : LESOBL(6)='NU13'
420 : LESOBL(7)='ALP1'
421 : LESOBL(8)='ALP3'
422 : ELSE IF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
423 : C= Modes 1D UNID PLAN DYCZ et GYCZ, et mode 1D UNID AXIS AXCZ
424 : NBROBL=8
425 : SEGINI,NOMID
426 : LESOBL(1)='YG1 '
427 : LESOBL(2)='YG2 '
428 : LESOBL(3)='YG3 '
429 : LESOBL(4)='NU12'
430 : LESOBL(5)='NU23'
431 : LESOBL(6)='NU13'
432 : LESOBL(7)='ALP1'
433 : LESOBL(8)='ALP2'
434 : ELSE
435 : C= Autres modes de calcul 1D UNID
436 : C= Mode 1D UNID SPHErique : on suppose que YG2=YG3 NU12=NU13 ALP2=ALP3
437 : NBROBL=9
438 : SEGINI,NOMID
439 : LESOBL(1)='YG1 '
440 : LESOBL(2)='YG2 '
441 : LESOBL(3)='YG3 '
442 : LESOBL(4)='NU12'
443 : LESOBL(5)='NU23'
444 : LESOBL(6)='NU13'
445 : LESOBL(7)='ALP1'
446 : LESOBL(8)='ALP2'
447 : LESOBL(9)='ALP3'
448 : ENDIF
449 : MOMATR=NOMID
450 : ENDIF
451 : ENDIF
452 : *
453 : * materiau anisotrope
454 : *
455 : ELSE IF(CMATE.EQ.'ANISOTRO') THEN
456 : IF(MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)THEN
457 : IF(IFOUR.EQ.-2) THEN
458 : NBROBL=15
459 : SEGINI NOMID
460 : MOMATR=NOMID
461 : LESOBL(1)='D11 '
462 : LESOBL(2)='D21 '
463 : LESOBL(3)='D22 '
464 : LESOBL(4)='D41 '
465 : LESOBL(5)='D42 '
466 : LESOBL(6)='D44 '
467 : LESOBL(7)='ALP1'
468 : LESOBL(8)='ALP2'
469 : LESOBL(9)='AL12'
470 : LESOBL(10)='V1X '
471 : LESOBL(11)='V1Y '
472 : LESOBL(12)='D31 '
473 : LESOBL(13)='D32 '
474 : LESOBL(14)='D33 '
475 : LESOBL(15)='D43 '
476 : ELSE IF(IFOUR.EQ.-3.OR.IFOUR.
477 : 1 EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.1)THEN
478 : NBROBL=16
479 : SEGINI NOMID
480 : MOMATR=NOMID
481 : LESOBL(1)='D11 '
482 : LESOBL(2)='D21 '
483 : LESOBL(3)='D22 '
484 : LESOBL(4)='D31 '
485 : LESOBL(5)='D32 '
486 : LESOBL(6)='D33 '
487 : LESOBL(7)='D41 '
488 : LESOBL(8)='D42 '
489 : LESOBL(9)='D43 '
490 : LESOBL(10)='D44 '
491 : LESOBL(11)='ALP1'
492 : LESOBL(12)='ALP2'
493 : LESOBL(13)='AL12'
494 : LESOBL(14)='ALP3'
495 : LESOBL(15)='V1X '
496 : LESOBL(16)='V1Y '
497 : ELSEIF(IFOUR.EQ.2)THEN
498 : NBROBL=33
499 : SEGINI NOMID
500 : MOMATR=NOMID
501 : LESOBL(1)='D11 '
502 : LESOBL(2)='D21 '
503 : LESOBL(3)='D22 '
504 : LESOBL(4)='D31 '
505 : LESOBL(5)='D32 '
506 : LESOBL(6)='D33 '
507 : LESOBL(7)='D41 '
508 : LESOBL(8)='D42 '
509 : LESOBL(9)='D43 '
510 : LESOBL(10)='D44 '
511 : LESOBL(11)='D51 '
512 : LESOBL(12)='D52 '
513 : LESOBL(13)='D53 '
514 : LESOBL(14)='D54 '
515 : LESOBL(15)='D55 '
516 : LESOBL(16)='D61 '
517 : LESOBL(17)='D62 '
518 : LESOBL(18)='D63 '
519 : LESOBL(19)='D64 '
520 : LESOBL(20)='D65 '
521 : LESOBL(21)='D66 '
522 : LESOBL(22)='ALP1'
523 : LESOBL(23)='ALP2'
524 : LESOBL(24)='ALP3'
525 : LESOBL(25)='AL12'
526 : LESOBL(26)='AL13'
527 : LESOBL(27)='AL23'
528 : LESOBL(28)='V1X '
529 : LESOBL(29)='V1Y '
530 : LESOBL(30)='V1Z '
531 : LESOBL(31)='V2X '
532 : LESOBL(32)='V2Y '
533 : LESOBL(33)='V2Z '
534 : ENDIF
535 : ENDIF
536 : *
537 : * materiau unidirectionnel
538 : *
539 : ELSE IF(CMATE.EQ.'UNIDIREC') THEN
540 : * MLR 31/1/97 IF(IFOUR.EQ.2)THEN
541 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
542 : NBROBL=8
543 : SEGINI NOMID
544 : MOMATR=NOMID
545 : LESOBL(1)='YOUN'
546 : LESOBL(2)='ALPH'
547 : LESOBL(3)='V1X '
548 : LESOBL(4)='V1Y '
549 : LESOBL(5)='V1Z '
550 : LESOBL(6)='V2X '
551 : LESOBL(7)='V2Y '
552 : LESOBL(8)='V2Z '
553 : ELSE
554 : NBROBL=4
555 : SEGINI NOMID
556 : MOMATR=NOMID
557 : LESOBL(1)='YOUN'
558 : LESOBL(2)='ALPH'
559 : LESOBL(3)='V1X '
560 : LESOBL(4)='V1Y '
561 : ENDIF
562 : C ENDIF
563 : ELSE
564 : if(lnomid(6).ne.0) then
565 : nomid=lnomid(6)
566 : segact nomid
567 : momatr=nomid
568 : nmatr=lesobl(/2)
569 : nmatf=lesfac(/2)
570 : lsupma=.false.
571 : else
571 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
572 : endif
573 : NBROBL=NMATR
574 : NBRFAC=NMATF
575 : ENDIF
576 : NMATR=NBROBL
577 : NMATF=NBRFAC
578 : NMATT=NMATR+NMATF
579 : *
580 : IF (MOMATR.NE.0) THEN
581 : IF (CMATE.EQ.'SECTION') THEN
582 : NBTYPE=3
583 : SEGINI NOTYPE
584 : MOTYPE=NOTYPE
585 : TYPE(1)='POINTEURMMODEL'
586 : TYPE(2)='POINTEURMCHAML'
587 : TYPE(3)='POINTEURLISTREEL'
588 : ELSE
589 : NBTYPE=1
590 : SEGINI NOTYPE
591 : MOTYPE=NOTYPE
592 : TYPE(1)='REAL*8'
593 : ENDIF
594 : *
594 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,
595 : 1 MOTYPE,1,INFOS,3,IVAMAT)
596 : SEGSUP NOTYPE
597 : IF (IERR.NE.0) GOTO 9990
598 : IF(ISUPMA.EQ.1)THEN
598 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE)
599 : IF(IERR.NE.0)THEN
600 : ISUPMA=0
601 : GOTO 9990
602 : ENDIF
603 : ENDIF
604 : MPTVAL=IVAMAT
605 : MELVAL=IVAL(1)
606 : C NBGMAT=VELCHE(/1)
607 : C NELMAT=VELCHE(/2)
608 : NBGMAT = 0
609 : NELMAT = 0
610 : DO 1108 IM=1,NMATT
611 : IF(IVAL(IM).NE.0)THEN
612 : MELVAL=IVAL(IM)
613 : IF (CMATE.EQ.'SECTION') THEN
614 : NBGMAT=MAX(NBGMAT,IELCHE(/1))
615 : NELMAT=MAX(NELMAT,IELCHE(/2))
616 : ELSE
617 : NBGMAT=MAX(NBGMAT,VELCHE(/1))
618 : NELMAT=MAX(NELMAT,VELCHE(/2))
619 : ENDIF
620 : ENDIF
621 : 1108 CONTINUE
622 : ENDIF
623 : *
624 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
625 : *
626 : NBROBL=0
627 : NBRFAC=0
628 : IVECT=0
629 : *
630 : * EPAISSEUR DANS LE CAS DES COQUES
631 : *
632 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
633 : NBROBL=1
634 : SEGINI NOMID
635 : MOCARA=NOMID
636 : LESOBL(1)='EPAI'
637 : *
638 : NBTYPE=1
639 : SEGINI NOTYPE
640 : MOTYPE=NOTYPE
641 : TYPE(1)='REAL*8'
642 : *
643 : * SECTION POUR LES BARRES ET LES CERCES
644 : *
645 : ELSE IF (MFR.EQ.27) THEN
646 : NBROBL=1
647 : NBRFAC=0
648 : SEGINI NOMID
649 : MOCARA=NOMID
650 : LESOBL(1)='SECT'
651 : *
652 : NBTYPE=1
653 : SEGINI NOTYPE
654 : MOTYPE=NOTYPE
655 : TYPE(1)='REAL*8'
656 : *
657 : * section, excentrements et orientation pour les barres excentrees
658 : *
659 : ELSE IF (MFR.EQ.49) THEN
660 : NBROBL=6
661 : SEGINI NOMID
662 : MOCARA=NOMID
663 : LESOBL(1)='SECT'
664 : LESOBL(2)='EXCZ'
665 : LESOBL(3)='EXCY'
666 : LESOBL(4)='VX '
667 : LESOBL(5)='VY '
668 : LESOBL(6)='VZ '
669 : *
670 : NBTYPE=1
671 : SEGINI NOTYPE
672 : MOTYPE=NOTYPE
673 : TYPE(1)='REAL*8'
674 : *
675 : * CARACTERISTIQUES POUR LES POUTRES
676 : *
677 : ELSE IF (MFR.EQ.7 ) THEN
678 : IF (CMATE.NE.'SECTION') THEN
679 : NBROBL=1
680 : NBRFAC=0
681 : SEGINI NOMID
682 : MOCARA=NOMID
683 : LESOBL(1)='SECT'
684 : *
685 : NBTYPE=1
686 : SEGINI NOTYPE
687 : MOTYPE=NOTYPE
688 : TYPE(1)='REAL*8'
689 : ENDIF
690 : *
691 : * CARACTERISTIQUES POUR LES TUYAUX
692 : *
693 : ELSE IF (MFR.EQ.13) THEN
694 : NBROBL=2
695 : NBRFAC=3
696 : SEGINI NOMID
697 : MOCARA=NOMID
698 : LESOBL(1)='EPAI'
699 : LESOBL(2)='RAYO'
700 : LESFAC(1)='RACO'
701 : LESFAC(2)='CISA'
702 : LESFAC(3)='VECT'
703 : IVECT=1
704 : *
705 : NBTYPE=5
706 : SEGINI NOTYPE
707 : MOTYPE=NOTYPE
708 : TYPE(1)='REAL*8'
709 : TYPE(2)='REAL*8'
710 : TYPE(3)='REAL*8'
711 : TYPE(4)='REAL*8'
712 : TYPE(5)='POINTEURPOINT '
713 : ENDIF
714 : *
715 : NCARA=NBROBL
716 : NCARF=NBRFAC
717 : NCARR=NCARA+NCARF
718 : IF (MOCARA.NE.0) THEN
719 : IF (IPCHE1.EQ.0) THEN
720 : SEGSUP NOTYPE
721 : MOTERR(1:4)='CARA'
722 : MOTERR(5:8)='CARA'
723 : MOTERR(9:12)=NOMTP(MELE)
724 : MOTERR(13:20)='THETA'
724 : CALL ERREUR(145)
725 : GOTO 9990
726 : ENDIF
726 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,
727 : 1 1,INFOS,3,IVACAR)
728 : SEGSUP NOTYPE
729 : IF (IERR.NE.0) GOTO 9990
730 : IF (IVECT.EQ.1) THEN
731 : MPTVAL=IVACAR
732 : IF (IVAL(NBROBL+NBRFAC).EQ.0) THEN
733 : *
734 : * MOT CLE VECT EN CAS DE CONVERSION
735 : *
736 : IVECT=2
737 : NOMID=MOCARA
738 : SEGACT NOMID*MOD
739 : NBRFAC=NBRFAC+2
740 : SEGADJ NOMID
741 : MOCARA=NOMID
742 : LESFAC(NBRFAC-2)='VX '
743 : LESFAC(NBRFAC-1)='VY '
744 : LESFAC(NBRFAC) ='VZ '
745 : *
746 : NBTYPE=1
747 : SEGINI NOTYPE
748 : MOTYPE=NOTYPE
749 : TYPE(1)='REAL*8'
750 : *
751 : NCARA=NBROBL
752 : NCARF=NBRFAC
753 : NCARR=NCARA+NCARF
754 : *
754 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,
755 : 1 MOTYPE,1,INFOS,3,IVACAR)
756 : SEGSUP NOTYPE
757 : IF (IERR.NE.0) GOTO 9990
758 : ENDIF
759 : ENDIF
760 : IF (ISUPMA.EQ.1) THEN
760 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE)
761 : IF (IERR.NE.0) THEN
762 : ISUPMA=0
763 : GOTO 9990
764 : ENDIF
765 : ENDIF
766 : ENDIF
767 : *
768 : NV1=NMATT
769 : SEGINI,MVELCH
770 : SEGINI, WRK3
771 : *
772 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
773 : 1 CMATE.EQ.'UNIDIREC')) THEN
774 : C RENSEIGNEMENTS SUR LE MAILLAGE
775 : MELEME=IPMAIL
776 : SEGACT MELEME
777 : NBNN=NUM(/1)
778 : SEGINI WRK2
779 : *
780 : * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
781 : * L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
782 : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
782 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
783 : IF (IERR.NE.0) THEN
784 : SEGSUP MVELCH
785 : SEGSUP WRK2,WRK3
786 : SEGDES MELEME
787 : GOTO 9990
788 : ENDIF
789 : MINTE2=IPT1
790 : SEGACT MINTE2
791 : ENDIF
792 : ENDIF
793 : *
794 : * BOUCLE SUR LES ELEMENTS
795 : *
796 : DO 1000 IB=1,NBELEM
797 : C
798 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
799 : 1 CMATE.EQ.'UNIDIREC').AND.
800 : 2 (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
801 : C
802 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
803 : C
803 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
804 : C
805 : C CALCUL DES AXES LOCAUX
806 : C
807 : NBSH=MINTE2.SHPTOT(/2)
807 : CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
808 : if (nbsh.eq.-1) then
808 : call erreur(525)
809 : return
810 : endif
811 : ENDIF
812 : C
813 : IF(CMATE.EQ.'SECTION') THEN
814 : *
815 : * CAS DE LA POUTRE TIMO - MODELE SECTION
816 : *
817 : MPTVAL=IVAMAT
818 : MELVAL=IVAL(1)
819 : IBMN=MIN(IB,IELCHE(/2))
820 : IPMODL=IELCHE(1,IBMN)
821 : MELVAL=IVAL(2)
822 : IBMN=MIN(IB,IELCHE(/2))
823 : IPMAT=IELCHE(1,IBMN)
823 : CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,1)
824 : ENDIF
825 : C
826 : * BOUCLE SUR LES POINTS
827 : *
828 : DO 2000 IGAU=1,NBPGAU
829 : *
830 : * initialisations
831 : *
832 : EPAIST=0.
833 : SD=0.D0
834 : TEMP=0.D0
835 : THIF=0.D0
836 : THM=0.D0
837 : THSU=0.D0
838 : E3=0.D0
839 : *
840 : * remplissage du tableau des caracteristiques du materiau
841 : *
842 : IF(CMATE.NE.'SECTION') THEN
843 : MPTVAL=IVAMAT
844 : DO 1100 IO = 1,NMATT
845 : MELVAL = IVAL(IO)
846 : IBMN=MIN(IB,VELCHE(/2))
847 : IGMN=MIN(IGAU,VELCHE(/1))
848 : VALMAT(IO) = VELCHE( IGMN,IBMN)
849 : 1100 CONTINUE
850 : ENDIF
851 : *
852 : C Prise en compte de l'epaisseur et de l'excentrement
853 : C dans le cas des coques minces avec ou sans cisaillement
854 : C transverse
855 : C
856 : IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
857 : 1 OR.CMATE.EQ.'UNIDIREC').AND.
858 : 2 (MFR.EQ.3.OR.MFR.EQ.9)) THEN
859 : MPTVAL=IVACAR
860 : MELVAL=IVAL(1)
861 : IF (MELVAL.NE.0) THEN
862 : IBMN=MIN(IB ,VELCHE(/2))
863 : IGMN=MIN(IGAU,VELCHE(/1))
864 : EPAIST=VELCHE(IGMN,IBMN)
865 : ELSE
865 : CALL ERREUR(527)
866 : GOTO 9990
867 : ENDIF
868 : ENDIF
869 : *
870 : * remplissage du tableau des caracteristiques geometriques
871 : *
872 :
873 : IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.123
874 : 1 .OR.MELE.EQ.124.OR.MELE.EQ.46.OR.MELE.EQ.95
875 : 1 .OR.MELE.EQ.84) THEN
876 : SEGINI WRK1
877 : IF(MELE.EQ.42) THEN
878 : MPTVAL=IVACAR
879 : DO 1200 IC=1,NCARR
880 : IF (IVAL(IC).NE.0) THEN
881 : MELVAL=IVAL(IC)
882 : IBMN=MIN(IB,VELCHE(/2))
883 : IF (IBMN.NE.0) THEN
884 : WORK(IC)=VELCHE(1,IBMN)
885 : ELSE
886 : WORK(IC)=0.D0
887 : ENDIF
888 : ELSE
889 : WORK(IC)=0.D0
890 : ENDIF
891 : 1200 CONTINUE
892 : *
893 : * CAS OU ON A LU LE MOT VECTEUR
894 : *
895 : IF (IVECT.EQ.1) THEN
896 : IF (IVAL(NCARR).NE.0) THEN
897 : MELVAL=IVAL(NCARR)
898 : IBMN=MIN(IB,IELCHE(/2))
899 : IP=IELCHE(1,IBMN)
900 : IREF=(IP-1)*(IDIM+1)
901 : DO 1300 IC=1,IDIM
902 : WORK(NCARR+IC-1)=XCOOR(IREF+IC)
903 : 1300 CONTINUE
904 : ELSE
905 : DO 1400 IC=1,IDIM
906 : WORK(NCARR+IC-1)=0.D0
907 : 1400 CONTINUE
908 : ENDIF
909 : *
910 : * CAS DU CHAMELEM CONVERTI
911 : *
912 : ELSE IF (IVECT.EQ.2) THEN
913 : DO 1500 IC=1,IDIM
914 : MELVAL=IVAL(NCARR+IC-3)
915 : IF (MELVAL.NE.0) THEN
916 : IBMN=MIN(IB,VELCHE(/2))
917 : WORK(NCARR+IC-3)=VELCHE(1,IBMN)
918 : ELSE
919 : WORK(NCARR+IC-3)=0.D0
920 : ENDIF
921 : 1500 CONTINUE
922 : ENDIF
923 : *
924 : * CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE EQUIVA
925 : *
926 : CISA=WORK(4)
927 : VX=WORK(5)
928 : VY=WORK(6)
929 : VZ=WORK(7)
929 : CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,1)
930 : SD=WORK(4)
931 : ELSE
932 : MPTVAL=IVACAR
933 : MELVAL=IVAL(1)
934 : IBMN=MIN(IB,VELCHE(/2))
935 : SD=0.D0
936 : DO 1201 IAUX=1,NBPGAU
937 : IGMN=MIN(IAUX,VELCHE(/1))
938 : SD=SD+VELCHE(IGMN,IBMN)
939 : IF(IAUX.EQ.NBPGAU) SD=SD/NBPGAU
940 : 1201 CONTINUE
941 : ENDIF
942 : ENDIF
943 : IF(CMATE.EQ.'SECTION') SD=CRIGI(1)
944 : *
945 : IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
946 : + OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
947 : + OR.(MFR.EQ.5.AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.
948 : + EQ.'ORTHOTRO'))) THEN
949 : *
950 : IF(NPINT.EQ.0) THEN
951 : MPTVAL=IVATEM
952 : MELVAL=IVAL(1)
953 : IGMN=MIN(IGAU,VELCHE(/1))
954 : IBMN=MIN(IB ,VELCHE(/2))
955 : THIF=VELCHE(IGMN,IBMN)
956 : MELVAL=IVAL(2)
957 : IGMN=MIN(IGAU,VELCHE(/1))
958 : IBMN=MIN(IB ,VELCHE(/2))
959 : THM=VELCHE(IGMN,IBMN)
960 : MELVAL=IVAL(3)
961 : IGMN=MIN(IGAU,VELCHE(/1))
962 : IBMN=MIN(IB ,VELCHE(/2))
963 : THSU=VELCHE(IGMN,IBMN)
964 : ELSE
965 : MPTVAL=IVATEM
966 : MELVAL=IVAL(1)
967 : IGMN=MIN(IGAU,VELCHE(/1))
968 : IBMN=MIN(IB ,VELCHE(/2))
969 : TEMP=VELCHE(IGMN,IBMN)
970 : ENDIF
971 : *
972 : E3 = DZEGAU(IGAU)
973 : *
974 : ELSEIF((MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.27.OR.MELE.EQ.85.OR.
975 : + MELE.EQ.86.OR.MELE.EQ.87.OR.MELE.EQ.88.OR.MFR.EQ.49.OR.
976 : + MELE.EQ.84.OR.MFR.EQ.51).OR.((MFR.EQ.1.OR.MFR.EQ.33.OR.
977 : + MFR.EQ.31).AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'
978 : + .OR.CMATE.EQ.'ANISOTRO'.OR.CMATE.EQ.'UNIDIREC'))) THEN
979 : *
980 : MPTVAL=IVATEM
981 : MELVAL=IVAL(1)
982 : IGMN=MIN(IGAU,VELCHE(/1))
983 : IBMN=MIN(IB ,VELCHE(/2))
984 : TEMP=VELCHE(IGMN,IBMN)
985 : ENDIF
986 : *--------------------------------------------------------------
987 : * CAS ISOTROPE
988 : *--------------------------------------------------------------
989 : *
990 : IF(CMATE.EQ.'ISOTROPE') THEN
991 : *
991 : CALL THETIS(MFR,MELE,VALMAT,NSTRS,NPINT,TEMP,THIF,
992 : 1 THM,THSU,E3,SD,EPAIST,RES,KERRE)
993 : *
994 : *--------------------------------------------------------------
995 : * CAS ORTHOTROPE
996 : *--------------------------------------------------------------
997 : ELSEIF(CMATE.EQ.'ORTHOTRO') THEN
997 : CALL THETOR(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
998 : 1 THM,THSU,E3,SD,EPAIST,TXR,XLOC,XGLOB,
999 : 2 ROTS,DHOOK,RES,KERRE)
1000 : *
1001 : *--------------------------------------------------------------
1002 : * CAS ANISOTROPE
1003 : *--------------------------------------------------------------
1004 : ELSEIF(CMATE.EQ.'ANISOTRO') THEN
1004 : CALL THETAN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,
1005 : 1 SD,TXR,XLOC,XGLOB,ROTS,DHOOK,RES,KERRE)
1006 :
1007 : *--------------------------------------------------------------
1008 : * CAS UNIDIRECTIONNEL
1009 : *--------------------------------------------------------------
1010 : ELSEIF(CMATE.EQ.'UNIDIREC') THEN
1010 : CALL THETUN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
1011 : 1 THM,THSU,SD,EPAIST,TXR,XLOC,XGLOB,
1012 : 2 ROTS,DHOOK,RES,KERRE)
1013 : *
1014 : *--------------------------------------------------------------
1015 : * CAS HOMOGENEISE ET SECTION
1016 : *--------------------------------------------------------------
1017 : ELSEIF(CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
1017 : CALL THETHS(MELE,VALMAT,NSTRS,TEMP,SD,RES,KERRE)
1018 : *
1019 : *--------------------------------------------------------------
1020 : *
1021 : ELSE
1021 : CALL ERREUR(19)
1022 : GOTO 9900
1023 : ENDIF
1024 : *
1025 : IF (KERRE.EQ.19) THEN
1025 : CALL ERREUR(19)
1026 : GOTO 9900
1027 : ELSEIF (KERRE.EQ.86) THEN
1028 : MOTERR(1:4) =NOMTP(MELE)
1029 : MOTERR(5:12)='THET'
1029 : CALL ERREUR(86)
1030 : GO TO 9900
1031 : ENDIF
1032 : *
1033 : MPTVAL=IVASTR
1034 : DO 1600 I=1,NSTRS
1035 : MELVAL=IVAL(I)
1036 : VELCHE(IGAU,IB)=RES(I)
1037 : 1600 CONTINUE
1038 : *
1039 : 2000 CONTINUE
1040 : 1000 CONTINUE
1041 : *
1042 : *____________________________________________________________________
1043 : *
1044 : * DESACTIVATION DES SEGMENTS DE TRAVAIL
1045 : *____________________________________________________________________
1046 : *
1047 : 9900 CONTINUE
1048 : *
1049 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
1050 : 1 CMATE.EQ.'UNIDIREC')) THEN
1051 : SEGSUP WRK2
1052 : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)
1053 : & SEGDES MINTE2,MELEME
1054 : ENDIF
1055 : *
1056 : IF (MELE.EQ.29.OR.MELE.EQ.42) SEGSUP WRK1
1057 : *
1058 : SEGSUP MVELCH
1059 : SEGSUP WRK3
1060 : *
1061 : 9990 CONTINUE
1062 : *____________________________________________________________________
1063 : *
1064 : * DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
1065 : *____________________________________________________________________
1066 : *
1067 : SEGDES MINTE
1068 : IF(IERR.NE.0)THEN
1069 : SEGSUP MCHAML
1070 : ELSE
1071 : SEGDES MCHAML
1072 : ENDIF
1073 : *
1074 : IF(ISUPMA.EQ.1)THEN
1074 : CALL DTMVAL(IVAMAT,3)
1075 : ELSE
1075 : CALL DTMVAL(IVAMAT,1)
1076 : ENDIF
1077 : IF(ISUPMA.EQ.1)THEN
1077 : CALL DTMVAL(IVACAR,3)
1078 : ELSE
1078 : CALL DTMVAL(IVACAR,1)
1079 : ENDIF
1080 : IF(IERR.NE.0)THEN
1080 : CALL DTMVAL(IVASTR,3)
1081 : ELSE
1081 : CALL DTMVAL(IVASTR,1)
1082 : ENDIF
1083 : IF(ISUPTE.EQ.1)THEN
1083 : CALL DTMVAL(IVATEM,3)
1084 : ELSE
1084 : CALL DTMVAL(IVATEM,1)
1085 : ENDIF
1086 : *
1087 : IF(MOMATR.NE.0)THEN
1088 : NOMID=MOMATR
1089 : if(lsupma)SEGSUP NOMID
1090 : ENDIF
1091 : IF(MOCARA.NE.0)THEN
1092 : NOMID=MOCARA
1093 : SEGSUP NOMID
1094 : ENDIF
1095 : IF(MOSTRS.NE.0)THEN
1096 : NOMID=MOSTRS
1097 : if(lsupco)SEGSUP NOMID
1098 : ENDIF
1099 : IF(MOTEMP.NE.0)THEN
1100 : NOMID=MOTEMP
1101 : if(lsupte)SEGSUP NOMID
1102 : ENDIF
1103 : *
1104 : 999 CONTINUE
1105 : SEGDES IMODEL
1106 : IF (IERR.NE.0) GO TO 888
1107 : *
1108 : 500 CONTINUE
1109 : *
1110 : 888 CONTINUE
1111 : SEGDES MMODEL
1112 : IF(IERR.NE.0)THEN
1113 : IRET = 0
1114 : SEGSUP MCHELM
1115 : IPSTRS = 0
1116 : ELSE
1117 : IRET = 1
1118 : SEGDES MCHELM
1119 : IPSTRS = MCHELM
1120 : ENDIF
1121 :
1122 : RETURN
1123 : END
1124 :
1125 :
1126 :
1127 :
© Cast3M 2003 - All rights reserved.
Disclaimer