1 : C SIGMAP SOURCE CHAT 11/05/24 21:16:13 6978
2 : SUBROUTINE SIGMAP(IBID2,IPMODL,IPCHP1,IPCHE1,IPCHE2,ICONV,IMAT,
3 : 1 IPSTRS,IRET)
4 : C_______________________________________________________________________
5 : C
6 : C OPERATEUR CONTRAINTES LINEAIRES APPELE PAR SIGMA
7 : C
8 : C Entr{es:
9 : C ________
10 : C
11 : C IPMODL Pointeur sur un MMODEL
12 : C IPCHP1 Pointeur sur un CHAMPOINT d{placements
13 : C IPCHE1 Pointeur sur un MCHAML de caract{ristiques
14 : C IPCHE2 Pointeur sur un MCHAML de HOOKE
15 : C ICONV Flag de conversion (1 si oui, 0 sinon)
16 : C IMAT Flag de HOOKE (2 si oui, 1 sinon)
17 : C
18 : C Sorties:
19 : C ________
20 : C
21 : C IPSTRS Pointeur sur un MCHAML de CONTRAINTES
22 : C IRET 1 ou 0 suivant succes ou pas
23 : C
24 : C AUTEURS L.EBERSOLT(JANVIER 84 ) POUR LE CALCUL
25 : C D.BROCHARD (FEVRIER 87 ) POUR LA MISE EN FORME
26 : C SIGMA-SIGMAP
27 : C Passage aux nouveaux chamelems par i.monnier le 7.6.90
28 : C
29 : C ELEMENTS MASSIFS ANISOTROPES PAR P.DOWLATYARI DEC. 90
30 : C_______________________________________________________________________
31 : C
32 : IMPLICIT INTEGER(I-N)
33 : IMPLICIT REAL*8(A-H,O-Z)
34 : *
35 : -INC CCOPTIO
36 : -INC CCHAMP
37 : -INC CCREEL
38 : -INC SMCHAML
39 : -INC SMCHPOI
40 : -INC SMELEME
41 : -INC SMCOORD
42 : -INC SMMODEL
43 : -INC SMINTE
44 : -INC SMLREEL
45 : C
46 : SEGMENT NOTYPE
47 : CHARACTER*16 TYPE(NBTYPE)
48 : ENDSEGMENT
49 : *
50 : SEGMENT MPTVAL
51 : INTEGER IPOS(NS) ,NSOF(NS)
52 : INTEGER IVAL(NCOSOU)
53 : CHARACTER*16 TYVAL(NCOSOU)
54 : ENDSEGMENT
55 : *
56 : CHARACTER*8 CMATE
57 : CHARACTER*(NCONCH) CONM
58 : PARAMETER ( NINF=3 )
59 : INTEGER INFOS(NINF)
60 : LOGICAL BDPGE,ldpge,lsupdp,lsupco,lsupma
61 : C
62 : IRET = 0
63 : IPSTRS = 0
64 : C
65 : NHRM=NIFOUR
66 : ISUP=0
67 : ISUP1=0
68 : MCHAML=0
69 : C
70 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE
71 : C
72 : IF (IMAT.EQ.2) THEN
72 : CALL QUESUP(IPMODL,IPCHE2,5,1,ISUP,IRETHO)
73 : IF (ISUP.NE.0) RETURN
74 : ENDIF
75 : C
76 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
77 : C
78 : IF (IPCHE1.NE.0) THEN
78 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRETCA)
79 : IF (ISUP1.GT.1) RETURN
80 : ENDIF
81 :
82 : C____________________________________________________________________
83 : C
84 : C ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT
85 : C____________________________________________________________________
86 : C
86 : CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHA1,1)
87 : IF (IERR.NE.0) RETURN
88 : C
89 : C ACTIVATION DU MODELE
90 : C
91 : MMODEL=IPMODL
92 : SEGACT MMODEL
93 : NSOUS=KMODEL(/1)
94 : C
95 : C CREATION DU MCHELM
96 : C
97 : C=============================================
98 : N1=NSOUS
99 : DO IJKL=1,NSOUS
100 : IMODEL=KMODEL(IJKL)
101 : SEGACT IMODEL
102 : IF (NEFMOD.EQ.22) N1=N1-1
103 : END DO
104 : C WRITE(*,*) 'NSOUS=',NSOUS
105 : C WRITE(*,*) 'N1=',N1
106 : C=============================================
107 : L1=11
108 : N3=6
109 : SEGINI MCHELM
110 : TITCHE='CONTRAINTES'
111 : IFOCHE=IFOUR
112 : C
113 : C Initialisations de quelques variables
114 : IF ((IFOUR.EQ.-3).OR.(IFOUR.GE.7.AND.IFOUR.LE.11).OR.
115 : . (IFOUR.EQ.14)) THEN
116 : BDPGE=.TRUE.
117 : ELSE
118 : BDPGE=.FALSE.
119 : ENDIF
120 : UZDPG=XZero
121 : RXDPG=XZero
122 : RYDPG=XZero
123 : C
124 : C____________________________________________________________________
125 : C
126 : C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
127 : C____________________________________________________________________
128 : C
129 : ISOUS=0
130 : DO 500 KISOUS=1,NSOUS
131 : *
132 : * INITIALISATION
133 : *
134 : IVAMAT=0
135 : IVACAR=0
136 : IVASTR=0
137 : IVADEP=0
138 : IPMING=0
139 : MOSTRS=0
140 : MODEPL=0
141 : MOMATR=0
142 : MOCARA=0
143 : C
144 : C ON RECUPERE L INFORMATION GENERALE
145 : C
146 : IMODEL=KMODEL(KISOUS)
147 : C* SEGACT IMODEL
148 : C=============================================
149 : MELE=NEFMOD
150 : if(MELE.eq.22) go to 500
151 : ISOUS=ISOUS+1
152 : C==============================================
153 : C
154 : C TRAITEMENT DU MODELE
155 : C
156 : IIPDPG=IPDPGE
157 : IPMAIL=IMAMOD
158 : CONM =CONMOD
159 : ideri=ideriv
160 : ireps2=0
161 : if(ideri.eq.2.and.ibid2.eq.0) ireps2=1
162 : IMACHE(ISOUS)=IPMAIL
163 : CONCHE(ISOUS)=CONMOD
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 : C
173 : C NATURE DU MATERIAU
174 : C
175 : * NFOR=FORMOD(/2)
176 : * NMAT=MATMOD(/2)
176 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
177 : CMATE = CMATEE
178 : MATE = IMATEE
179 : INAT = INATUU
180 : IF (CMATE.EQ.' ')THEN
180 : CALL ERREUR(251)
181 : GOTO 9990
182 : ENDIF
183 : C____________________________________________________________________
184 : C
185 : C INFORMATION SUR L'ELEMENT FINI
186 : C____________________________________________________________________
186 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
187 : * IF (IERR.NE.0) GOTO 9990
188 : * INFO=IPINF
189 : MFR =INFELE(13)
190 : IELE =INFELE(14)
191 : IPORE=INFELE(8)
192 : NBG =INFELE(6)
193 : NBGS =INFELE(4)
194 : NSTRS=INFELE(16)
195 : LRE =INFELE(9)
196 : LW =INFELE(7)
197 : LHOOK=INFELE(10)
198 : NDDL =INFELE(15)
199 : * MINTE=INFELE(11)
200 : MINTE=INFMOD(7)
201 : MINTE1=INFMOD(8)
202 : IPMINT=MINTE
203 : IPMIN1=MINTE1
204 : C
205 : ldpge = BDPGE
206 : IF (MFR.EQ.71 .OR. MFR.EQ.73) ldpge = .FALSE.
207 : C
208 : C CREATION DU TABLEAU INFOS
209 : C
209 : CALL IDENT(IPMAIL,CONM,IPCHA1,IPCHE1,INFOS,IRTD)
210 : IF (IRTD.EQ.0) GOTO 9990
211 : C
212 : INFCHE(ISOUS,1)=0
213 : INFCHE(ISOUS,2)=0
214 : INFCHE(ISOUS,3)=NHRM
215 : INFCHE(ISOUS,4)=MINTE
216 : INFCHE(ISOUS,5)=0
217 : INFCHE(ISOUS,6)=5
218 : C
219 : C INITIALISATION DE MINTE
220 : C
221 : if(mele.ne.260) then
222 : SEGACT MINTE
223 : NBPGAU=POIGAU(/1)
224 : endif
225 : C
226 : C ACTIVATION DU MELEME
227 : C
228 : MELEME=IPMAIL
229 : SEGACT MELEME
230 : NBNN =NUM(/1)
231 : NBELEM=NUM(/2)
232 : IPPORE=0
233 : IF(MFR.EQ.33) THEN
234 : IPPORE=NBNN
235 : ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN
236 : IPPORE=NBNN
237 : LHOOK=4
238 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.-3) LHOOK=6
239 : ENDIF
240 : LHOO2=LHOOK*LHOOK
241 : C
242 : C EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA
243 : C DEFORMATION PLANE GENERALISEE
244 : C
245 : IF (ldpge) THEN
245 : CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG)
246 : IF (IERR.NE.0) GOTO 9990
247 : ENDIF
248 : C____________________________________________________________________
249 : C
250 : C RECHERCHE DES NOMS DE COMPOSANTES
251 : C____________________________________________________________________
252 : C
253 : if(lnomid(4).ne.0) then
254 : lsupco=.false.
255 : nomid=lnomid(4)
256 : segact nomid
257 : mostrs=nomid
258 : nstr=lesobl(/2)
259 : nfac=lesfac(/2)
260 : else
261 : lsupco=.true.
261 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
262 : endif
263 : C
264 : if(lnomid(1).ne.0) then
265 : lsupdp=.false.
266 : nomid=lnomid(1)
267 : segact nomid
268 : modepl=nomid
269 : ndep=lesobl(/2)
270 : nfac=lesfac(/2)
271 : else
272 : lsupdp=.true.
272 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEP,NFAC)
273 : endif
274 : C____________________________________________________________________
275 : C
276 : C VERIFICATION DE LEUR PRESENCE
277 : C____________________________________________________________________
278 : C
279 : NBTYPE=1
280 : SEGINI NOTYPE
281 : MOTYPE=NOTYPE
282 : TYPE(1)='REAL*8'
282 : CALL KOMCHA(IPCHA1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP)
283 : SEGSUP NOTYPE
284 : IF (IERR.NE.0) GOTO 9990
285 : C
286 : C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
287 : C
288 : N1PTEL=NBGS
289 : N1EL=NBELEM
290 : NBPTEL=N1PTEL
291 : NEL=N1EL
292 : C
293 : C CREATION DU MCHAML DE LA SOUS ZONE
294 : C
295 : N2=NSTRS
296 : SEGINI MCHAML
297 : ICHAML(ISOUS)=MCHAML
298 : NS=1
299 : NCOSOU=NSTRS
300 : SEGINI MPTVAL
301 : IVASTR=MPTVAL
302 : NOMID=MOSTRS
303 : SEGACT NOMID
304 : DO 100 ICOMP=1,NSTRS
305 : NOMCHE(ICOMP)=LESOBL(ICOMP)
306 : TYPCHE(ICOMP)='REAL*8'
307 : N2PTEL=0
308 : N2EL=0
309 : SEGINI MELVAL
310 : IELVAL(ICOMP)=MELVAL
311 : IVAL(ICOMP)=MELVAL
312 : 100 CONTINUE
313 : C____________________________________________________________________
314 : C
315 : * RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL *
316 : C____________________________________________________________________
317 : *
318 : lsupma=.true.
319 : IF (IMAT.EQ.2) THEN
320 : IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
321 : NBROBL=3
322 : NBRFAC=0
323 : SEGINI NOMID
324 : LESOBL(1)='MAHO'
325 : LESOBL(2)='V1X '
326 : LESOBL(3)='V1Y '
327 : ELSE
328 : NBROBL=1
329 : NBRFAC=0
330 : SEGINI NOMID
331 : LESOBL(1)='MAHO'
332 : ENDIF
333 : MOMATR=NOMID
334 : NMATR=NBROBL
335 : NMATF=NBRFAC
336 : IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN
337 : NBTYPE=3
338 : SEGINI NOTYPE
339 : TYPE(1)='POINTEURLISTREEL'
340 : TYPE(2)='REAL*8'
341 : TYPE(3)='REAL*8'
342 : ELSE
343 : NBTYPE=1
344 : SEGINI NOTYPE
345 : TYPE(1)='POINTEURLISTREEL'
346 : ENDIF
347 : MOTYPE=NOTYPE
347 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
348 : SEGSUP NOTYPE
349 : IF (IERR.NE.0) GOTO 9990
350 : MPTVAL=IVAMAT
351 : MELVAL=IVAL(1)
352 : NBGMAT=IELCHE(/1)
353 : NELMAT=IELCHE(/2)
354 : NMATT=NMATR+NMATF
355 : ELSE
356 : C____________________________________________________________________
357 : *
358 : * SINON TRAITEMENT DES CHAMPS DE MATERIAU
359 : C____________________________________________________________________
360 : *
361 : IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN
362 : NBROBL=2
363 : NBRFAC=0
364 : SEGINI NOMID
365 : MOMATR=NOMID
366 : IF (MFR.EQ.35) THEN
367 : LESOBL(1)='KS '
368 : LESOBL(2)='KN '
369 : ELSE IF(MFR.EQ.53) THEN
370 : NBROBL=1
371 : SEGADJ,NOMID
372 : LESOBL(1)='KS '
373 : ELSE
374 : LESOBL(1)='YOUN'
375 : LESOBL(2)='NU '
376 : ENDIF
377 : NMATR=NBROBL
378 : NMATF=NBRFAC
379 : ELSE
380 : $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN
381 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
382 : NBROBL=7
383 : NBRFAC=0
384 : SEGINI NOMID
385 : MOMATR=NOMID
386 : LESOBL(1)='YOUN'
387 : LESOBL(2)='V1X '
388 : LESOBL(3)='V1Y '
389 : LESOBL(4)='V1Z '
390 : LESOBL(5)='V2X '
391 : LESOBL(6)='V2Y '
392 : LESOBL(7)='V2Z '
393 : ELSE
394 : NBROBL=3
395 : NBRFAC=0
396 : SEGINI NOMID
397 : MOMATR=NOMID
398 : LESOBL(1)='YOUN'
399 : LESOBL(2)='V1X '
400 : LESOBL(3)='V1Y '
401 : ENDIF
402 : NMATR=NBROBL
403 : NMATF=NBRFAC
404 : ELSE
405 : $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN
406 : IF (MELE.GE.79.AND.MELE.LE.83) THEN
407 : NBROBL=4
408 : NBRFAC=0
409 : SEGINI NOMID
410 : MOMATR=NOMID
411 : LESOBL(1)='YOUN'
412 : LESOBL(2)='NU '
413 : LESOBL(3)='COB '
414 : LESOBL(4)='MOB '
415 : ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN
416 : NBROBL=4
417 : NBRFAC=0
418 : SEGINI NOMID
419 : MOMATR=NOMID
420 : LESOBL(1)='KS '
421 : LESOBL(2)='KN '
422 : LESOBL(3)='COB '
423 : LESOBL(4)='MOB '
424 : ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN
425 : NBROBL=10
426 : NBRFAC=0
427 : SEGINI NOMID
428 : MOMATR=NOMID
429 : LESOBL(1)='YOUN'
430 : LESOBL(2)='NU '
431 : LESOBL(3)='COP1'
432 : LESOBL(4)='COP2'
433 : LESOBL(5)='CPP1'
434 : LESOBL(6)='CPP2'
435 : LESOBL(7)='KK11'
436 : LESOBL(8)='KK12'
437 : LESOBL(9)='KK21'
438 : LESOBL(10)='KK22'
439 : ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN
440 : NBROBL=17
441 : NBRFAC=0
442 : SEGINI NOMID
443 : MOMATR=NOMID
444 : LESOBL(1)='YOUN'
445 : LESOBL(2)='NU '
446 : LESOBL(3)='COP1'
447 : LESOBL(4)='COP2'
448 : LESOBL(5)='COP3'
449 : LESOBL(6)='CPP1'
450 : LESOBL(7)='CPP2'
451 : LESOBL(8)='CPP3'
452 : LESOBL(9)='KK11'
453 : LESOBL(10)='KK12'
454 : LESOBL(11)='KK13'
455 : LESOBL(12)='KK21'
456 : LESOBL(13)='KK22'
457 : LESOBL(14)='KK23'
458 : LESOBL(15)='KK31'
459 : LESOBL(16)='KK32'
460 : LESOBL(17)='KK33'
461 : ENDIF
462 : NMATR=NBROBL
463 : NMATF=NBRFAC
464 : *
465 : ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN
466 : NBROBL=6
467 : NBRFAC=0
468 : SEGINI NOMID
469 : MOMATR=NOMID
470 : LESOBL(1)='YG1 '
471 : LESOBL(2)='YG2 '
472 : LESOBL(3)='NU12'
473 : LESOBL(4)='G12 '
474 : LESOBL(5)='V1X '
475 : LESOBL(6)='V1Y '
476 : NMATR=NBROBL
477 : NMATF=NBRFAC
478 : *
479 : * ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
480 : * Pour l'instant, lnomid(6) ou appel a IDMATR suffisent.
481 : *
482 : ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
483 : lsupma = .true.
483 : CALL IDDILI(MATE,1,MOMATR,NMATR,NMATF)
484 : *
485 : * Autres cas :
486 : ELSE
487 : if(lnomid(6).ne.0) then
488 : nomid=lnomid(6)
489 : segact nomid
490 : momatr=nomid
491 : nmatr=lesobl(/2)
492 : nmatf=lesfac(/2)
493 : lsupma=.false.
494 : else
495 : lsupma=.true.
495 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
496 : endif
497 : ENDIF
498 : *
499 : IF (CMATE.EQ.'SECTION') THEN
500 : NBTYPE=3
501 : SEGINI NOTYPE
502 : TYPE(1)='POINTEURMMODEL'
503 : TYPE(2)='POINTEURMCHAML'
504 : TYPE(3)='POINTEURLISTREEL'
505 : ELSE
506 : NBTYPE=1
507 : SEGINI NOTYPE
508 : TYPE(1)='REAL*8'
509 : ENDIF
510 : MOTYPE=NOTYPE
511 : *
511 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
512 : SEGSUP NOTYPE
513 : IF (IERR.NE.0) GOTO 9990
514 : *
515 : NMATT=NMATR+NMATF
516 : * C
517 : IF(ISUP1.EQ.1)THEN
517 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE)
518 : IF(IERR.NE.0)THEN
519 : ISUP1=0
520 : GOTO 9990
521 : ENDIF
522 : ENDIF
523 : MPTVAL=IVAMAT
524 : NBGMAT = 0
525 : NELMAT = 0
526 : DO 1108 IM=1,NMATT
527 : IF(IVAL(IM).NE.0)THEN
528 : MELVAL=IVAL(IM)
529 : IF (CMATE.EQ.'SECTION') THEN
530 : NBGMAT=MAX(NBGMAT,IELCHE(/1))
531 : NELMAT=MAX(NELMAT,IELCHE(/2))
532 : ELSE
533 : NBGMAT=MAX(NBGMAT,VELCHE(/1))
534 : NELMAT=MAX(NELMAT,VELCHE(/2))
535 : ENDIF
536 : ENDIF
537 : 1108 CONTINUE
538 : ENDIF
539 : C____________________________________________________________________
540 : C
541 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
542 : C____________________________________________________________________
543 : C
544 : NBROBL=0
545 : NBRFAC=0
546 : MOCARA=0
547 : IVECT=0
548 : *
549 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
550 : *
551 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
552 : NBROBL=1
553 : NBRFAC=1
554 : SEGINI NOMID
555 : MOCARA=NOMID
556 : LESOBL(1)='EPAI'
557 : LESFAC(1)='EXCE'
558 : *
559 : NBTYPE=1
560 : SEGINI NOTYPE
561 : MOTYPE=NOTYPE
562 : TYPE(1)='REAL*8'
563 : *
564 : * SECTION POUR LES BARRES
565 : *
566 : ELSE IF (MFR.EQ.27) THEN
567 : NBROBL=1
568 : SEGINI NOMID
569 : MOCARA=NOMID
570 : LESOBL(1)='SECT'
571 : *
572 : NBTYPE=1
573 : SEGINI NOTYPE
574 : MOTYPE=NOTYPE
575 : TYPE(1)='REAL*8'
576 : *
577 : * section, excentrements et orientation pour les barres excentrees
578 : *
579 : ELSE IF (MFR.EQ.49) THEN
580 : NBROBL=6
581 : SEGINI NOMID
582 : MOCARA=NOMID
583 : LESOBL(1)='SECT'
584 : LESOBL(2)='EXCZ'
585 : LESOBL(3)='EXCY'
586 : LESOBL(4)='VX '
587 : LESOBL(5)='VY '
588 : LESOBL(6)='VZ '
589 : *
590 : NBTYPE=1
591 : SEGINI NOTYPE
592 : MOTYPE=NOTYPE
593 : TYPE(1)='REAL*8'
594 : *
595 : * raideurs locales et orientation pour l'element LIA2
596 : * de liaison a 2 noeuds
597 : *
598 : ELSE IF (MFR.EQ.51) THEN
599 : NBROBL=9
600 : SEGINI NOMID
601 : MOCARA=NOMID
602 : LESOBL(1)='RLUX'
603 : LESOBL(2)='RLUY'
604 : LESOBL(3)='RLUZ'
605 : LESOBL(4)='RLRX'
606 : LESOBL(5)='RLRY'
607 : LESOBL(6)='RLRZ'
608 : LESOBL(7)='VX '
609 : LESOBL(8)='VY '
610 : LESOBL(9)='VZ '
611 : *
612 : NBTYPE=1
613 : SEGINI NOTYPE
614 : MOTYPE=NOTYPE
615 : TYPE(1)='REAL*8'
616 : *
617 : * CARACTERISTIQUES POUR LES POUTRES
618 : *
619 : ELSE IF (MFR.EQ.7 ) THEN
620 : IF ((CMATE.EQ.'SECTION')) THEN
621 : NBROBL=0
622 : NBRFAC=1
623 : SEGINI NOMID
624 : MOCARA=NOMID
625 : LESFAC(1)='VECT'
626 : IVECT=1
627 : *
628 : NBTYPE=1
629 : SEGINI NOTYPE
630 : MOTYPE=NOTYPE
631 : TYPE(1)='POINTEURPOINT '
632 : *
633 : * CAS 2D
634 : *
635 : ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
636 : NBRFAC=1
637 : NBROBL=2
638 : SEGINI NOMID
639 : MOCARA=NOMID
640 : LESOBL(1)= 'SECT'
641 : LESOBL(2)= 'INRZ'
642 : LESFAC(1)= 'SECY'
643 : *
644 : NBTYPE=1
645 : SEGINI NOTYPE
646 : MOTYPE=NOTYPE
647 : TYPE(1)='REAL*8'
648 : *
649 : ELSE
650 : NBROBL=4
651 : NBRFAC=3
652 : SEGINI NOMID
653 : MOCARA=NOMID
654 : LESOBL(1)='TORS'
655 : LESOBL(2)='INRY'
656 : LESOBL(3)='INRZ'
657 : LESOBL(4)='SECT'
658 : LESFAC(1)='SECY'
659 : LESFAC(2)='SECZ'
660 : LESFAC(3)='VECT'
661 : IVECT=1
662 : *
663 : NBTYPE=7
664 : SEGINI NOTYPE
665 : MOTYPE=NOTYPE
666 : TYPE(1)='REAL*8'
667 : TYPE(2)='REAL*8'
668 : TYPE(3)='REAL*8'
669 : TYPE(4)='REAL*8'
670 : TYPE(5)='REAL*8'
671 : TYPE(6)='REAL*8'
672 : TYPE(7)='POINTEURPOINT '
673 : ENDIF
674 : *
675 : * CARACTERISTIQUES POUR LES TUYAUX
676 : *
677 : ELSE IF (MFR.EQ.13) THEN
678 : NBROBL=2
679 : NBRFAC=4
680 : SEGINI NOMID
681 : MOCARA=NOMID
682 : LESOBL(1)='EPAI'
683 : LESOBL(2)='RAYO'
684 : LESFAC(1)='RACO'
685 : LESFAC(2)='PRES'
686 : LESFAC(3)='CISA'
687 : LESFAC(4)='VECT'
688 : IVECT=1
689 : *
690 : NBTYPE=6
691 : SEGINI NOTYPE
692 : MOTYPE=NOTYPE
693 : TYPE(1)='REAL*8'
694 : TYPE(2)='REAL*8'
695 : TYPE(3)='REAL*8'
696 : TYPE(4)='REAL*8'
697 : TYPE(5)='REAL*8'
698 : TYPE(6)='POINTEURPOINT '
699 : *
700 : * CARACTERISTIQUES POUR LES LINESPRING
701 : *
702 : ELSE IF (MFR.EQ.15) THEN
703 : NBROBL=5
704 : SEGINI NOMID
705 : MOCARA=NOMID
706 : LESOBL(1)='EPAI'
707 : LESOBL(2)='FISS'
708 : LESOBL(3)='VX '
709 : LESOBL(4)='VY '
710 : LESOBL(5)='VZ '
711 : *
712 : NBTYPE=1
713 : SEGINI NOTYPE
714 : MOTYPE=NOTYPE
715 : TYPE(1)='REAL*8'
716 : *
717 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES
718 : *
719 : ELSE IF (MFR.EQ.17) THEN
720 : NBROBL=9
721 : SEGINI NOMID
722 : MOCARA=NOMID
723 : LESOBL(1)='RAYO'
724 : LESOBL(2)='EPAI'
725 : LESOBL(3)='VX '
726 : LESOBL(4)='VY '
727 : LESOBL(5)='VZ '
728 : LESOBL(6)='VXF '
729 : LESOBL(7)='VYF '
730 : LESOBL(8)='VZF '
731 : LESOBL(9)='ANGL'
732 : *
733 : NBTYPE=1
734 : SEGINI NOTYPE
735 : MOTYPE=NOTYPE
736 : TYPE(1)='REAL*8'
737 : *
738 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
739 : *
740 : ELSE IF (MFR.EQ.37) THEN
741 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
742 : NBROBL=4
743 : SEGINI NOMID
744 : MOCARA=NOMID
745 : LESOBL(1)='SCEL'
746 : LESOBL(2)='SFLU'
747 : LESOBL(3)='EPS '
748 : LESOBL(4)='XINE'
749 : ELSE
750 : NBROBL=3
751 : SEGINI NOMID
752 : MOCARA=NOMID
753 : LESOBL(1)='SCEL'
754 : LESOBL(2)='SFLU'
755 : LESOBL(3)='EPS '
756 : ENDIF
757 : *
758 : NBTYPE=1
759 : SEGINI NOTYPE
760 : MOTYPE=NOTYPE
761 : TYPE(1)='REAL*8'
762 : *
763 : *
764 : * EPAISSEUR POUR LES JOINTS GENERALISES
765 : *
766 : ELSE IF (MFR.EQ.55) THEN
767 : CcPPj NBROBL=1
768 : CcPPj NBRFAC=0
769 : CcPPj SEGINI NOMID
770 : CcPPj MOCARA=NOMID
771 : CcPPj LESOBL(1)='EPAI'
772 : NBROBL=0
773 : NBRFAC=1
774 : SEGINI NOMID
775 : MOCARA=NOMID
776 : LESFAC(1)='EPAI'
777 : *
778 : NBTYPE=1
779 : SEGINI NOTYPE
780 : MOTYPE=NOTYPE
781 : TYPE(1)='REAL*8'
782 : *
783 : * CARACTERISTIQUE MACRO_EL (element CIFL)
784 : *
785 : ELSE IF (MFR.EQ.61)THEN
786 : NBRFAC=0
787 : NBROBL=2
788 : SEGINI NOMID
789 : MOCARA=NOMID
790 : LESOBL(1)= 'SECT'
791 : LESOBL(2)= 'INRZ'
792 : *
793 : NBTYPE=1
794 : SEGINI NOTYPE
795 : MOTYPE=NOTYPE
796 : TYPE(1)='REAL*8'
797 : *
798 : ENDIF
799 : *
800 : IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
801 : *
801 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
802 : $ IVACAR)
803 : SEGSUP NOTYPE
804 : IF (IERR.NE.0) GOTO 9990
805 : IF (IVECT.EQ.1) THEN
806 : MPTVAL=IVACAR
807 : IF (IVAL(NBROBL+NBRFAC).EQ.0) THEN
808 : *
809 : * MOT CLE VECT EN CAS DE CONVERSION
810 : *
811 : IVECT=2
812 : NOMID=MOCARA
813 : SEGACT NOMID
814 : NBRFAC=NBRFAC+2
815 : SEGADJ NOMID
816 : MOCARA=NOMID
817 : LESFAC(NBRFAC-2)='VX '
818 : LESFAC(NBRFAC-1)='VY '
819 : LESFAC(NBRFAC )='VZ '
820 : *
821 : NBTYPE=1
822 : SEGINI NOTYPE
823 : MOTYPE=NOTYPE
824 : TYPE(1)='REAL*8'
825 : *
825 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
826 : $ IVACAR)
827 : SEGSUP NOTYPE
828 : IF (IERR.NE.0) GOTO 9990
829 : ENDIF
830 : ENDIF
831 : ENDIF
832 : *
833 : NCARA=NBROBL
834 : NCARF=NBRFAC
835 : NCARR=NCARA+NCARF
836 : IF(ISUP1.EQ.1.AND.(MOCARA.NE.0.AND.IPCHE1.NE.0))THEN
836 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE)
837 : IF(IERR.NE.0)THEN
838 : ISUP1=0
839 : GOTO 9990
840 : ENDIF
841 : ENDIF
842 : *
843 : C_______________________________________________________________________
844 : C
845 : C NUMERO DES ETIQUETTES :
846 : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
847 : C Les elements sont groupes comme suit :
848 : C - massif, poreux, joints poreux ------------------> sigma1
849 : C - coq3,dkt,coq4,coq8,coq2,joints -----------------> sigma2
850 : C - poutre,tuyau,linespring,tuyau fissure,barre ----> sigma3
851 : C et poutre de Timoschenko
852 : C_______________________________________________________________________
853 : C
854 : IF (MELE.LE.100)
855 : &GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
856 : 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99,
857 : 2 27,29,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99,
858 : 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4,99,99,99,99,99,99, 4, 4,
859 : 4 4, 4, 4,29,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99
860 : 5 ),MELE
861 : IF (MELE.LE.200)
862 : &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
863 : 1 4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
864 : 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
865 : 3 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
866 : 4 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34
867 : 5 ),MELE-100
868 : IF (MELE.LE.300)
869 : &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
870 : 1 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
871 : 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,
872 : 3 34,34,34,34,29),MELE-200
873 : C
874 : C CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4)
875 : C (JGI2 2D GENERALIZED)
876 : C (JGT3 AND JGI4 GENERALIZED)
877 : C
878 : 34 CONTINUE
879 : IF (MELE.GE.168.AND.MELE.LE.172)GOTO 27
880 : *
881 : IF (MELE.GE.173.AND.MELE.LE.190) GOTO 4
882 : C Elements mecaniques 1D (M1Dx)
883 : IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
884 : C
885 : IF (MELE.EQ.258.OR.MELE.EQ.260) GOTO 29
886 : C POUR les XFEM on fait un cas particuliers
887 : IF(MFR.EQ.63) THEN
887 : CALL SIGMAX (MATE,IMAT,NBGMAT,NELMAT,NMATT,CMATE,
888 : & IVAMAT,IMODEL,IREPS2,IVADEP,
889 : & IVASTR,UZDPG,RYDPG,RXDPG,IIPDPG,IRETER)
890 : * write(*,*) 'retour de SIGMAX'
891 : IF(IRETER.NE.0) RETURN
892 : GO TO 9990
893 : ENDIF
894 : C fin des XFEM
895 : C
896 : 99 CONTINUE
897 : MOTERR(1:4)=NOMTP(MELE)
898 : MOTERR(9:12)='SIGM'
898 : CALL ERREUR(86)
899 : GOTO 9990
900 : C_______________________________________________________________________
901 : C
902 : C massifs, poreux, joints poreux
903 : C_______________________________________________________________________
904 : C
905 : 4 CONTINUE
906 : IF (MFR.EQ.71) THEN
906 : CALL SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
907 : & LRE,MATE,IVAMAT,NMATT, IVASTR)
908 : ELSE IF (MFR.EQ.73) THEN
908 : CALL SIGDIF (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK,
909 : & LRE,MATE,IVAMAT,NMATT, IVASTR)
910 : ELSE
910 : CALL SIGMA1(MATE,IMAT,IPMAIL,IPMINT,MELE,IELE,IVADEP,
911 : & NBPTEL,LRE,NSTRS,IVAMAT,NBGMAT,NELMAT,LHOOK,NMATT,CMATE,
912 : & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVASTR,UZDPG,RYDPG,RXDPG
913 : & , IIPDPG)
914 : ENDIF
915 : GOTO 9990
916 : C_______________________________________________________________________
917 : C
918 : C coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D
919 : C_______________________________________________________________________
920 : C
921 : 27 CONTINUE
921 : CALL SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVAMAT,
922 : & LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,IPMIN1,
923 : & NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR
924 : & ,UZDPG,RYDPG,RXDPG,IIPDPG)
925 : GOTO 9990
926 : C_______________________________________________________________________
927 : C
928 : C poutres,tuyau,linespring,tuyau fissure,barre
929 : C_______________________________________________________________________
930 : C
931 : 29 CONTINUE
931 : CALL SIGMA3(IPMAIL,IVADEP,NDEP,IVACAR,NCARR,IPMINT,IVECT,IVAMAT,
932 : & MELE,IMAT,NELMAT,NBGMAT,LHOOK,CMATE,IREPS2,NBPTEL,NSTRS,
933 : & MFR,NMATT,NBPGAU,ISOUS,LRE,LW,IVASTR,UZDPG,RYDPG,RXDPG
934 : & , IIPDPG)
935 : GOTO 9990
936 : C____________________________________________________________________
937 : C
938 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
939 : C____________________________________________________________________
940 : C
941 : 9990 CONTINUE
942 : SEGDES MELEME
943 : if( mele.ne.260)SEGDES MINTE
944 : *
945 : IF(ISUP1.EQ.1.AND.IMAT.NE.2)THEN
945 : CALL DTMVAL(IVAMAT,3)
946 : ELSE
946 : CALL DTMVAL(IVAMAT,1)
947 : ENDIF
948 : *
949 : IF(ISUP1.EQ.1)THEN
949 : CALL DTMVAL(IVACAR,3)
950 : ELSE
950 : CALL DTMVAL(IVACAR,1)
951 : ENDIF
952 : *
953 : IF(IERR.NE.0)THEN
953 : CALL DTMVAL(IVASTR,3)
954 : ELSE
954 : CALL DTMVAL(IVASTR,1)
955 : ENDIF
956 : *
956 : CALL DTMVAL(IVADEP,1)
957 : *
958 : IF(MOMATR.NE.0)THEN
959 : NOMID=MOMATR
960 : if(lsupma)SEGSUP NOMID
961 : ENDIF
962 : *
963 : IF(MOCARA.NE.0)THEN
964 : NOMID=MOCARA
965 : SEGSUP NOMID
966 : ENDIF
967 : *
968 : IF(MOSTRS.NE.0)THEN
969 : NOMID=MOSTRS
970 : if(lsupco)SEGSUP NOMID
971 : ENDIF
972 : *
973 : IF(MODEPL.NE.0)THEN
974 : NOMID=MODEPL
975 : if(lsupdp)SEGSUP NOMID
976 : ENDIF
977 : C
978 : C DANS LE CAS D'ERREUR
979 : C
980 : IF(IERR.NE.0)THEN
981 : IF (MCHAML.NE.0) SEGSUP MCHAML
982 : GOTO 888
983 : ELSE
984 : SEGDES MCHAML
985 : ENDIF
986 : C
987 : 500 CONTINUE
988 :
989 : 888 CONTINUE
990 : IF (IERR.NE.0) THEN
991 : IRET = 0
992 : SEGSUP MCHELM
993 : IPSTRS = 0
994 : ELSE
995 : IRET = 1
996 : SEGDES MCHELM
997 : IPSTRS = MCHELM
998 : ENDIF
999 :
1000 : MMODEL=IPMODL
1001 : NSOUS=KMODEL(/1)
1002 : DO I=1,NSOUS
1003 : IMODEL=KMODEL(I)
1004 : SEGDES,IMODEL
1005 : END DO
1006 : SEGDES,MMODEL
1007 :
1007 : CALL DTCHAM(IPCHA1)
1008 :
1009 : RETURN
1010 : END
1011 :
1012 :
1013 :
1014 :
1015 :
© Cast3M 2003 - All rights reserved.
Disclaimer