1 : C HOOK2P SOURCE AM 12/03/15 21:25:22 7321
2 : SUBROUTINE HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRET )
3 : C_______________________________________________________________________
4 : C
5 : C Entr{es:
6 : C ________
7 : C
8 : C IPMODL Pointeur sur un MMODEL
9 : C IPCHE1 Pointeur sur un MCHAML de caracteristiques
10 : C IPCHE2 Pointeur sur un MCHAML de variables internes(FACULTATIF)
11 : C LASURF Flag de pr{sence du mot cl{ REFE
12 : C
13 : C Sorties:
14 : C ________
15 : C
16 : C IPCHOO Pointeur sur un MCHAML de matrice de HOOKE
17 : C IRET 1 si tout OK 0 sinon
18 : C
19 : C CODE L.EBERSOLT SEPT 84
20 : C
21 : C Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90
22 : C_______________________________________________________________________
23 : C
24 : IMPLICIT INTEGER(I-N)
25 : IMPLICIT REAL*8(A-H,O-Z)
26 :
27 : -INC CCOPTIO
28 : -INC CCHAMP
29 : -INC CCGEOME
30 :
31 : -INC SMCHAML
32 : -INC SMMODEL
33 : -INC SMINTE
34 : *
35 : SEGMENT NOTYPE
36 : CHARACTER*16 TYPE(NBTYPE)
37 : ENDSEGMENT
38 : *
39 : SEGMENT MPTVAL
40 : INTEGER IPOS(NS) ,NSOF(NS)
41 : INTEGER IVAL(NCOSOU)
42 : CHARACTER*16 TYVAL(NCOSOU)
43 : ENDSEGMENT
44 : *
45 : CHARACTER*8 CMATE
46 : CHARACTER*(NCONCH) CONM
47 : PARAMETER ( NINF=3)
48 : INTEGER INFOS(NINF)
49 : LOGICAL lsupva,lsupma
50 : C
51 : IRET = 0
52 : *
53 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
54 : *
55 : * AM 16/5/08 REDUCTION PRELABLE DU CHAMP SUR LE MODELE MECA
56 : *
56 : call reduaf(ipche1,ipmodl,ipche10,0,iretou,kerr)
56 : if (iretou.ne.1) call erreur(kerr)
57 : if (ierr.ne.0) return
58 : ipche1=ipche10
59 :
59 : CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETCA)
60 : IF (ISUP.GT.1) THEN
60 : call erreur(329)
61 : RETURN
62 : ENDIF
63 : *
64 : * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
65 : *
66 : IF (IPCHE2.NE.0) THEN
66 : call reduaf(ipche2,ipmodl,ipche20,0,iretou,kerr)
66 : if (iretou.ne.1) call erreur(kerr)
67 : if (ierr.ne.0) return
68 : ipche2=ipche20
68 : CALL QUESUP(IPMODL,IPCHE2,3,0,ISUP2,IRETVI)
69 : IF (ISUP2.GT.1) THEN
69 : call erreur(329)
70 : RETURN
71 : ENDIF
72 : ENDIF
73 : C
74 : C ACTIVATION DU MODELE
75 : C
76 : MMODEL=IPMODL
77 : SEGACT MMODEL
78 : NSOUS=KMODEL(/1)
79 : C
80 : C INITIALISATION DU CHAPEAU DES MATRICES DE HOOKE
81 : C
82 : N1=NSOUS
83 : L1=16
84 : N3=6
85 : SEGINI MCHELM
86 : IPCHOO=MCHELM
87 : TITCHE='MATRICE DE HOOKE'
88 : IFOCHE=IFOUR
89 : C
90 : C BOUCLE SUR LES SOUS ZONES DU MAILLAGE
91 : C
92 : DO 100 ISOUS=1,NSOUS
93 : IVAMAT=0
94 : IVACAR=0
95 : IVARI=0
96 : IVAHOO=0
97 : MOMATR=0
98 : MOCARA=0
99 : NVART=0
100 : IPMINT=0
101 : C
102 : C TRAITEMENT DU MODELE
103 : C
104 : IMODEL=KMODEL(ISOUS)
105 : SEGACT IMODEL
106 : MELE=NEFMOD
107 : IPMAIL=IMAMOD
108 : CONM =CONMOD
109 : C
110 : C CREATION DU TABLEAU INFOS
111 : C
111 : CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
112 : IF (IRTD.EQ.0) GOTO 9990
113 : C
114 : * NFOR=FORMOD(/2)
115 : * NMAT=MATMOD(/2)
115 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
116 : CMATE = CMATEE
117 : MATE = IMATEE
118 : INAT = INATUU
119 : * IF (CMATE.EQ.' ') THEN
119 : * CALL ERREUR(251)
120 : * SEGSUP MCHELM
121 : * SEGDES MMODEL,IMODEL
122 : * RETURN
123 : * ENDIF
124 : C
125 : C COQUE INTEGREE OU PAS ?
126 : C
127 : IF(INFMOD(/1).NE.0)THEN
128 : NPINT=INFMOD(1)
129 : ELSE
130 : NPINT=0
131 : ENDIF
132 : C
133 : C REMPLISSAGE DE MCHELM DE HOOKE
134 : C
135 : IMACHE(ISOUS)=IPMAIL
136 : CONCHE(ISOUS)=CONMOD
137 : C
138 : C INFORMATION ELEMENT FINI
139 : C
139 : * CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
140 : * IF (IERR.NE.0) THEN
141 : * SEGDES IMODEL,MMODEL
142 : * SEGSUP MCHELM
143 : * RETURN
144 : * ENDIF
145 : * INFO=IPINF
146 : NBPGAU=INFELE(6)
147 : LHOOK=INFELE(10)
148 : MFR =INFELE(13)
149 : IPPORE=0
150 : IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
151 : LW =INFELE(7)
152 : IPORE = INFELE(8)
153 : *
154 : * CAS DES DKT INTEGRES
155 : *
156 : IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4
157 : *
158 : LHOO2=LHOOK*LHOOK
159 : * MINTE=INFELE(11)
160 : MINTE=INFMOD(5)
161 : IPMINT=MINTE
162 : SEGACT,MINTE
163 : C
164 : INFCHE(ISOUS,1)=0
165 : INFCHE(ISOUS,2)=0
166 : INFCHE(ISOUS,3)=NIFOUR
167 : INFCHE(ISOUS,4)=IPMINT
168 : INFCHE(ISOUS,5)=0
169 : INFCHE(ISOUS,6)=3
170 : C
171 : C CREATION DU MCHAML DE HOOKE
172 : C
173 : IF((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
174 : & CMATE.NE.'ISOTROPE')THEN
175 : N2=3
176 : SEGINI MCHAML
177 : NOMCHE(1)='MAHO'
178 : NOMCHE(2)='V1X '
179 : NOMCHE(3)='V1Y '
180 : TYPCHE(1)='POINTEURLISTREEL'
181 : TYPCHE(2)='REAL*8'
182 : TYPCHE(3)='REAL*8'
183 : ELSE
184 : N2=1
185 : SEGINI MCHAML
186 : NOMCHE(1)='MAHO'
187 : TYPCHE(1)='POINTEURLISTREEL'
188 : ENDIF
189 : ICHAML(ISOUS)=MCHAML
190 : C
191 : * TRAITEMENT DES CHAMPS DE MATERIAU
192 : *
193 : lsupma=.true.
194 : IF (FORMOD(1).EQ.'MECANIQUE') THEN
195 : IF (CMATE.EQ.'ISOTROPE') THEN
196 : IF(INAT.EQ.26.AND.IPCHE2.NE.0) THEN
197 : NBROBL=3
198 : NBRFAC=0
199 : SEGINI NOMID
200 : MOMATR=NOMID
201 : LESOBL(1)='YOUN'
202 : LESOBL(2)='NU '
203 : LESOBL(3)='DC '
204 : ELSE IF (INAT.EQ.62.AND.IPCHE2.NE.0) THEN
205 : NBROBL=4
206 : NBRFAC=0
207 : SEGINI NOMID
208 : MOMATR=NOMID
209 : LESOBL(1)='YOUN'
210 : LESOBL(2)='NU '
211 : LESOBL(3)='F '
212 : LESOBL(4)='FC '
213 : ELSE IF (INAT.EQ.64.AND.IPCHE2.NE.0) THEN
214 : NBROBL=3
215 : NBRFAC=0
216 : SEGINI NOMID
217 : MOMATR=NOMID
218 : LESOBL(1)='YOUN'
219 : LESOBL(2)='NU '
220 : LESOBL(3)='FF '
221 : ELSE
222 : NBROBL=2
223 : NBRFAC=0
224 : SEGINI NOMID
225 : MOMATR=NOMID
226 : IF (MFR.EQ.35) THEN
227 : LESOBL(1)='KS '
228 : LESOBL(2)='KN '
229 : ELSE IF(MFR.EQ.53) THEN
230 : NBROBL=1
231 : SEGADJ,NOMID
232 : LESOBL(1)='KS '
233 : ELSE
234 : LESOBL(1)='YOUN'
235 : LESOBL(2)='NU '
236 : ENDIF
237 : ENDIF
238 : NMATR=NBROBL
239 : NMATF=NBRFAC
240 : ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
241 : IF (MFR.EQ.3) THEN
242 : * COQUES MINCES
243 : NBROBL=6
244 : NBRFAC=0
245 : SEGINI NOMID
246 : MOMATR=NOMID
247 : LESOBL(1)='YG1 '
248 : LESOBL(2)='YG2 '
249 : LESOBL(3)='NU12'
250 : LESOBL(4)='G12 '
251 : LESOBL(5)='V1X '
252 : LESOBL(6)='V1Y '
253 : ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
254 : * COQUES AVEC CISAILLEMENT TRANSVERSE
255 : NBROBL=8
256 : NBRFAC=0
257 : SEGINI NOMID
258 : MOMATR=NOMID
259 : LESOBL(1)='YG1 '
260 : LESOBL(2)='YG2 '
261 : LESOBL(3)='NU12'
262 : LESOBL(4)='G12 '
263 : LESOBL(5)='G23 '
264 : LESOBL(6)='G13 '
265 : LESOBL(7)='V1X '
266 : LESOBL(8)='V1Y '
267 : ELSE IF (MFR.EQ.75) THEN
268 : *
269 : * JOINT UNIDIMENSIONNEL JOI1
270 : *
271 : IF(IDIM.EQ.3)THEN
272 : NBROBL=12
273 : NBRFAC=0
274 : SEGINI NOMID
275 : MOMATR=NOMID
276 : LESOBL(1)='V1X '
277 : LESOBL(2)='V1Y '
278 : LESOBL(3)='V1Z '
279 : LESOBL(4)='V2X '
280 : LESOBL(5)='V2Y '
281 : LESOBL(6)='V2Z '
282 : LESOBL(7)='KN '
283 : LESOBL(8)='KS1 '
284 : LESOBL(9)='KS2'
285 : LESOBL(10)='QN '
286 : LESOBL(11)='QS1 '
287 : LESOBL(12)='QS2 '
288 : *
289 : ELSE IF(IDIM.EQ.2)THEN
290 : NBROBL=5
291 : NBRFAC=0
292 : SEGINI NOMID
293 : MOMATR=NOMID
294 : LESOBL(1)='V1X '
295 : LESOBL(2)='V1Y '
296 : LESOBL(3)='KN '
297 : LESOBL(4)='KS '
298 : LESOBL(5)='QS'
299 : ENDIF
300 : *
301 : ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
302 : * ELEMENTS MASSIFS
303 : IF(IDIM.EQ.3)THEN
304 : * ELEMENTS 3D
305 : NBROBL=15
306 : NBRFAC=0
307 : SEGINI NOMID
308 : MOMATR=NOMID
309 : LESOBL(1)='YG1 '
310 : LESOBL(2)='YG2 '
311 : LESOBL(3)='YG3 '
312 : LESOBL(4)='NU12'
313 : LESOBL(5)='NU23'
314 : LESOBL(6)='NU13'
315 : LESOBL(7)='G12 '
316 : LESOBL(8)='G23 '
317 : LESOBL(9)='G13 '
318 : LESOBL(10)='V1X '
319 : LESOBL(11)='V1Y '
320 : LESOBL(12)='V1Z '
321 : LESOBL(13)='V2X '
322 : LESOBL(14)='V2Y '
323 : LESOBL(15)='V2Z '
324 : ELSE IF (IDIM.EQ.2) THEN
325 : IF(IFOUR.EQ.-2) THEN
326 : * CONT. PLANE
327 : NBROBL=9
328 : NBRFAC=0
329 : SEGINI NOMID
330 : MOMATR=NOMID
331 : LESOBL(1)='YG1 '
332 : LESOBL(2)='YG2 '
333 : LESOBL(3)='NU12 '
334 : LESOBL(4)='G12'
335 : LESOBL(5)='V1X '
336 : LESOBL(6)='V1Y '
337 : LESOBL(7)='YG3 '
338 : LESOBL(8)='NU23'
339 : LESOBL(9)='NU13'
340 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
341 : * DEFORMATION PLANE ,AXISYMETRIE
342 : NBROBL=9
343 : NBRFAC=0
344 : SEGINI NOMID
345 : MOMATR=NOMID
346 : LESOBL(1)='YG1 '
347 : LESOBL(2)='YG2 '
348 : LESOBL(3)='YG3 '
349 : LESOBL(4)='NU12'
350 : LESOBL(5)='NU23'
351 : LESOBL(6)='NU13'
352 : LESOBL(7)='G12 '
353 : LESOBL(8)='V1X '
354 : LESOBL(9)='V1Y '
355 : ELSE IF (IFOUR.EQ.1) THEN
356 : * AXISYMETRIE DE FOURIER
357 : NBROBL=11
358 : NBRFAC=0
359 : SEGINI NOMID
360 : MOMATR=NOMID
361 : LESOBL(1)='YG1 '
362 : LESOBL(2)='YG2 '
363 : LESOBL(3)='YG3 '
364 : LESOBL(4)='NU12'
365 : LESOBL(5)='NU23'
366 : LESOBL(6)='NU13'
367 : LESOBL(7)='G12 '
368 : LESOBL(8)='G23 '
369 : LESOBL(9)='G13 '
370 : LESOBL(10)='V1X '
371 : LESOBL(11)='V1Y '
372 : ENDIF
373 : ENDIF
374 : ELSE IF (MFR.EQ.35) THEN
375 : * ELEMENTS JOINTS
376 : IF (IFOUR.EQ.2) THEN
377 : NBROBL=5
378 : NBRFAC=0
379 : SEGINI NOMID
380 : MOMATR=NOMID
381 : LESOBL(1)='KS1 '
382 : LESOBL(2)='KS2 '
383 : LESOBL(3)='KN '
384 : LESOBL(4)='V1X '
385 : LESOBL(5)='V1Y '
386 : ENDIF
387 : ENDIF
388 : NMATR=NBROBL
389 : NMATF=NBRFAC
390 : ELSEIF (CMATE.EQ.'ANISOTRO') THEN
391 : IF(MFR.EQ.75)THEN
392 : * JOINT UNIDIMESIONNEL JOI1
393 : IF(IDIM.EQ.3)THEN
394 : NBROBL=27
395 : NBRFAC=0
396 : SEGINI NOMID
397 : MOMATR=NOMID
398 : LESOBL(1)='V1X '
399 : LESOBL(2)='V1Y '
400 : LESOBL(3)='V1Z '
401 : LESOBL(4)='V2X '
402 : LESOBL(5)='V2Y '
403 : LESOBL(6)='V2Z '
404 : LESOBL(7)='D11 '
405 : LESOBL(8)='D22 '
406 : LESOBL(9)='D33 '
407 : LESOBL(10)='D44 '
408 : LESOBL(11)='D55 '
409 : LESOBL(12)='D66 '
410 : LESOBL(13)='D21 '
411 : LESOBL(14)='D31 '
412 : LESOBL(15)='D32 '
413 : LESOBL(16)='D41 '
414 : LESOBL(17)='D42 '
415 : LESOBL(18)='D43 '
416 : LESOBL(19)='D51 '
417 : LESOBL(20)='D52 '
418 : LESOBL(21)='D53 '
419 : LESOBL(22)='D54 '
420 : LESOBL(23)='D61 '
421 : LESOBL(24)='D62 '
422 : LESOBL(25)='D63 '
423 : LESOBL(26)='D64 '
424 : LESOBL(27)='D65 '
425 : ELSE IF(IDIM.EQ.2)THEN
426 : NBROBL=8
427 : NBRFAC=0
428 : SEGINI NOMID
429 : MOMATR=NOMID
430 : LESOBL(1)='V1X '
431 : LESOBL(2)='V1Y '
432 : LESOBL(3)='D11 '
433 : LESOBL(4)='D22 '
434 : LESOBL(5)='D33 '
435 : LESOBL(6)='D21 '
436 : LESOBL(7)='D31 '
437 : LESOBL(8)='D32 '
438 : ENDIF
439 : *
440 : ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
441 : * ELEMENTS MASSIFS
442 : IF(IDIM.EQ.3)THEN
443 : * ELEMENTS 3D
444 : IF (IFOUR.EQ.2) THEN
445 : NBROBL=27
446 : NBRFAC=0
447 : SEGINI NOMID
448 : MOMATR=NOMID
449 : LESOBL(1)='D11 '
450 : LESOBL(2)='D21 '
451 : LESOBL(3)='D22 '
452 : LESOBL(4)='D31 '
453 : LESOBL(5)='D32 '
454 : LESOBL(6)='D33 '
455 : LESOBL(7)='D41 '
456 : LESOBL(8)='D42 '
457 : LESOBL(9)='D43 '
458 : LESOBL(10)='D44 '
459 : LESOBL(11)='D51 '
460 : LESOBL(12)='D52 '
461 : LESOBL(13)='D53 '
462 : LESOBL(14)='D54 '
463 : LESOBL(15)='D55 '
464 : LESOBL(16)='D61 '
465 : LESOBL(17)='D62 '
466 : LESOBL(18)='D63 '
467 : LESOBL(19)='D64 '
468 : LESOBL(20)='D65 '
469 : LESOBL(21)='D66 '
470 : LESOBL(22)='V1X '
471 : LESOBL(23)='V1Y '
472 : LESOBL(24)='V1Z '
473 : LESOBL(25)='V2X '
474 : LESOBL(26)='V2Y '
475 : LESOBL(27)='V2Z '
476 : ENDIF
477 : ELSE IF (IDIM.EQ.2) THEN
478 : IF (IFOUR.EQ.-2) THEN
479 : * CONTRAINTE PLANE
480 : NBROBL=12
481 : NBRFAC=0
482 : SEGINI NOMID
483 : MOMATR=NOMID
484 : LESOBL(1)='D11 '
485 : LESOBL(2)='D21 '
486 : LESOBL(3)='D22 '
487 : LESOBL(4)='D41 '
488 : LESOBL(5)='D42 '
489 : LESOBL(6)='D44 '
490 : LESOBL(7)='V1X '
491 : LESOBL(8)='V1Y '
492 : LESOBL(9)='D31 '
493 : LESOBL(10)='D32 '
494 : LESOBL(11)='D33 '
495 : LESOBL(12)='D43 '
496 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
497 : * DEFORMATION PLANE ,AXISYMETRIE
498 : NBROBL=12
499 : NBRFAC=0
500 : SEGINI NOMID
501 : MOMATR=NOMID
502 : LESOBL(1)='D11 '
503 : LESOBL(2)='D21 '
504 : LESOBL(3)='D22 '
505 : LESOBL(4)='D31 '
506 : LESOBL(5)='D32 '
507 : LESOBL(6)='D33 '
508 : LESOBL(7)='D41 '
509 : LESOBL(8)='D42 '
510 : LESOBL(9)='D43 '
511 : LESOBL(10)='D44 '
512 : LESOBL(11)='V1X '
513 : LESOBL(12)='V1Y '
514 : ELSE IF (IFOUR.EQ.1) THEN
515 : * AXISYMETRIE DE FOURIER
516 : NBROBL=15
517 : NBRFAC=0
518 : SEGINI NOMID
519 : MOMATR=NOMID
520 : LESOBL(1)='D11 '
521 : LESOBL(2)='D21 '
522 : LESOBL(3)='D22 '
523 : LESOBL(4)='D31 '
524 : LESOBL(5)='D32 '
525 : LESOBL(6)='D33 '
526 : LESOBL(7)='D41 '
527 : LESOBL(8)='D42 '
528 : LESOBL(9)='D43 '
529 : LESOBL(10)='D44 '
530 : LESOBL(11)='D55 '
531 : LESOBL(12)='D65 '
532 : LESOBL(13)='D66 '
533 : LESOBL(14)='V1X '
534 : LESOBL(15)='V1Y '
535 : ENDIF
536 : ENDIF
537 : ENDIF
538 : NMATR=NBROBL
539 : NMATF=NBRFAC
540 : ELSEIF (CMATE.EQ.'UNIDIREC') THEN
541 : IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
542 : IF (MFR.EQ.1) THEN
543 : NBROBL=7
544 : ELSE
545 : NBROBL=9
546 : ENDIF
547 : NBRFAC=0
548 : SEGINI NOMID
549 : MOMATR=NOMID
550 : LESOBL(1)='YOUN'
551 : LESOBL(2)='V1X '
552 : LESOBL(3)='V1Y '
553 : LESOBL(4)='V1Z '
554 : LESOBL(5)='V2X '
555 : LESOBL(6)='V2Y '
556 : LESOBL(7)='V2Z '
557 : IF (MFR.EQ.33) THEN
558 : LESOBL(8)='COB '
559 : LESOBL(9)='MOB '
560 : ENDIF
561 : ELSE
562 : IF (MFR.EQ.33) THEN
563 : NBROBL=5
564 : ELSE
565 : NBROBL=3
566 : ENDIF
567 : NBRFAC=0
568 : SEGINI NOMID
569 : MOMATR=NOMID
570 : LESOBL(1)='YOUN'
571 : LESOBL(2)='V1X '
572 : LESOBL(3)='V1Y '
573 : IF (MFR.EQ.33) THEN
574 : LESOBL(4)='COB '
575 : LESOBL(5)='MOB '
576 : ENDIF
577 : ENDIF
578 : NMATR=NBROBL
579 : NMATF=NBRFAC
580 : *
581 : ELSEIF (CMATE.EQ.'ZONE_COH') THEN
582 : NBROBL=0
583 : NBRFAC=0
584 : IF (MFR.EQ.77) THEN
585 : NBROBL=2
586 : SEGINI NOMID
587 : MOMATR=NOMID
588 : LESOBL(1)='KS '
589 : LESOBL(2)='KN '
590 : ENDIF
591 : NMATR=NBROBL
592 : NMATF=NBRFAC
593 : *
594 : ELSE
595 : if(lnomid(6).ne.0) then
596 : nomid=lnomid(6)
597 : segact nomid
598 : momatr=nomid
599 : nmatr=lesobl(/2)
600 : nmatf=lesfac(/2)
601 : lsupma=.false.
602 : else
603 : lsupma=.true.
603 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
604 : endif
605 : ENDIF
606 : ELSE
607 : if(lnomid(6).ne.0) then
608 : nomid=lnomid(6)
609 : segact nomid
610 : momatr=nomid
611 : nmatr=lesobl(/2)
612 : nmatf=lesfac(/2)
613 : lsupma=.false.
614 : else
615 : lsupma=.true.
615 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
616 : endif
617 : ENDIF
618 : *
619 : IF (CMATE.EQ.'SECTION') THEN
620 : NBTYPE=3
621 : SEGINI NOTYPE
622 : TYPE(1)='POINTEURMMODEL'
623 : TYPE(2)='POINTEURMCHAML'
624 : TYPE(3)='POINTEURLISTREEL'
625 : ELSE
626 : NBTYPE=1
627 : SEGINI NOTYPE
628 : TYPE(1)='REAL*8'
629 : ENDIF
630 : MOTYPE=NOTYPE
630 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
631 : SEGSUP NOTYPE
632 : IF (IERR.NE.0) GOTO 9990
633 : NMATT=NMATR+NMATF
634 : *
635 : IF (MOMATR.NE.0.AND.ISUP.EQ.1) THEN
635 : CALL VALCHE (IVAMAT,NMATT,IPMINT,IPPORE)
636 : ENDIF
637 : C____________________________________________________________________
638 : C
639 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
640 : C____________________________________________________________________
641 : C
642 : NBROBL=0
643 : NBRFAC=0
644 : NBTYPE=0
645 : *
646 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
647 : *
648 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
649 : NBROBL=1
650 : NBRFAC=1
651 : SEGINI NOMID
652 : MOCARA=NOMID
653 : LESOBL(1)='EPAI'
654 : LESFAC(1)='EXCE'
655 : *
656 : * SECTION POUR LES BARRES
657 : *
658 : ELSE IF (MFR.EQ.27) THEN
659 : NBROBL=1
660 : SEGINI NOMID
661 : MOCARA=NOMID
662 : LESOBL(1)='SECT'
663 : *
664 : * EPAISSEUR POUR LES JOINTS GENERALISES
665 : *
666 : ELSE IF (MFR.EQ.55) THEN
667 : CcPPj NBROBL=1
668 : CcPPj NBRFAC=0
669 : CcPPj SEGINI NOMID
670 : CcPPj MOCARA=NOMID
671 : CcPPj LESOBL(1)='EPAI'
672 : NBROBL=0
673 : NBRFAC=1
674 : SEGINI NOMID
675 : MOCARA=NOMID
676 : LESFAC(1)='EPAI'
677 : *
678 : * CARACTERISTIQUES POUR LES POUTRES
679 : *
680 : ELSE IF (MFR.EQ.7 ) THEN
681 : IF (CMATE.NE.'SECTION') THEN
682 : IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
683 : NBROBL=2
684 : NBRFAC=1
685 : SEGINI NOMID
686 : MOCARA=NOMID
687 : LESOBL(1)='SECT'
688 : LESOBL(2)='INRZ'
689 : LESFAC(1)='SECY'
690 : ELSE
691 : NBROBL=4
692 : NBRFAC=2
693 : SEGINI NOMID
694 : MOCARA=NOMID
695 : LESOBL(1)='TORS'
696 : LESOBL(2)='INRY'
697 : LESOBL(3)='INRZ'
698 : LESOBL(4)='SECT'
699 : LESFAC(1)='SECY'
700 : LESFAC(2)='SECZ'
701 : ENDIF
702 : ENDIF
703 : *
704 : * CARACTERISTIQUES POUR LES TUYAUX
705 : *
706 : ELSE IF (MFR.EQ.13) THEN
707 : NBROBL=2
708 : NBRFAC=3
709 : SEGINI NOMID
710 : MOCARA=NOMID
711 : LESOBL(1)='EPAI'
712 : LESOBL(2)='RAYO'
713 : LESFAC(1)='RACO'
714 : LESFAC(2)='PRES'
715 : LESFAC(3)='CISA'
716 : *
717 : * CARACTERISTIQUES POUR LES LINESPRING
718 : *
719 : ELSE IF (MFR.EQ.15) THEN
720 : NBROBL=5
721 : SEGINI NOMID
722 : MOCARA=NOMID
723 : LESOBL(1)='EPAI'
724 : LESOBL(2)='FISS'
725 : LESOBL(3)='VX '
726 : LESOBL(4)='VY '
727 : LESOBL(5)='VZ '
728 : *
729 : * CARACTERISTIQUES POUR LES TUYAUX FISSURES
730 : *
731 : ELSE IF (MFR.EQ.17) THEN
732 : NBROBL=9
733 : SEGINI NOMID
734 : MOCARA=NOMID
735 : LESOBL(1)='RAYO'
736 : LESOBL(2)='EPAI'
737 : LESOBL(3)='VX '
738 : LESOBL(4)='VY '
739 : LESOBL(5)='VZ '
740 : LESOBL(6)='VXF '
741 : LESOBL(7)='VYF '
742 : LESOBL(8)='VZF '
743 : LESOBL(9)='ANGL'
744 : *
745 : * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
746 : *
747 : ELSE IF (MFR.EQ.37) THEN
748 : IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
749 : NBROBL=4
750 : SEGINI NOMID
751 : MOCARA=NOMID
752 : LESOBL(1)='SCEL'
753 : LESOBL(2)='SFLU'
754 : LESOBL(3)='EPS '
755 : LESOBL(4)='XINE'
756 : ELSE
757 : NBROBL=3
758 : SEGINI NOMID
759 : MOCARA=NOMID
760 : LESOBL(1)='SCEL'
761 : LESOBL(2)='SFLU'
762 : LESOBL(3)='EPS '
763 : ENDIF
764 : *
765 : * CARACTERISTIQUE MACRO_EL (element CIFL)
766 : *
767 : ELSE IF (MFR.EQ.61)THEN
768 : NBRFAC=0
769 : NBROBL=2
770 : SEGINI NOMID
771 : MOCARA=NOMID
772 : LESOBL(1)= 'SECT'
773 : LESOBL(2)= 'INRZ'
774 : C
775 : ENDIF
776 : *
777 : IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN
778 : NBTYPE=1
779 : SEGINI NOTYPE
780 : MOTYPE=NOTYPE
781 : TYPE(1)='REAL*8'
781 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
782 : SEGSUP NOTYPE
783 : IF (IERR.NE.0) GOTO 9990
784 : NOMID=MOCARA
785 : SEGDES NOMID
786 : ENDIF
787 : NCARA=NBROBL
788 : NCARF=NBRFAC
789 : NCARR=NCARA+NCARF
790 : *
791 : IF (MOCARA.NE.0.AND.ISUP.EQ.1) THEN
791 : CALL VALCHE (IVACAR,NCARR,IPMINT,IPPORE)
792 : ENDIF
793 : segdes mchaml
794 : *
795 : * DANS LE CAS DE L'ELEMENT DST, JOT3 ET JOI4 ORTHO. ON STOCKE EGALEMENT
796 : * V1X ET V1Y
797 : *
798 : IF ((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
799 : & CMATE.NE.'ISOTROPE')THEN
800 : MPTVAL=IVAMAT
801 : IF(CMATE.EQ.'ORTHOTRO')THEN
802 : IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
803 : MELVA1=IVAL(4)
804 : ELSE
805 : MELVA1=IVAL(7)
806 : ENDIF
807 : ELSE
808 : MELVA1=IVAL(2)
809 : ENDIF
810 : SEGINI,MELVAL=MELVA1
811 : IELVAL(2)=MELVAL
812 : SEGDES MELVAL
813 : IF(CMATE.EQ.'ORTHOTRO')THEN
814 : IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
815 : MELVA1=IVAL(5)
816 : ELSE
817 : MELVA1=IVAL(8)
818 : ENDIF
819 : ELSE
820 : MELVA1=IVAL(3)
821 : ENDIF
822 : SEGINI,MELVAL=MELVA1
823 : IELVAL(3)=MELVAL
824 : SEGDES MELVAL
825 : ENDIF
826 : C____________________________________________________________________
827 : C
828 : * TRAITEMENT DES CHAMPS DE VARIABLES INTERNES *
829 : C____________________________________________________________________
830 : C
831 : lsupva=.true.
832 : IF (IPCHE2.NE.0) THEN
833 : if(lnomid(10).ne.0) then
834 : nomid=lnomid(10)
835 : segact nomid
836 : movari=nomid
837 : nvari=lesobl(/2)
838 : nvarf=lesfac(/2)
839 : lsupva=.false.
840 : else
840 : CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
841 : endif
842 : IF (MOVARI.EQ.0) THEN
843 : MOTERR(1:4)='VARI'
844 : MOTERR(5:8)=NOMTP(MELE)
844 : CALL ERREUR (76)
845 : GOTO 9990
846 : ENDIF
847 : NVART=NVARI+NVARF
848 : *
849 : NBTYPE=1
850 : SEGINI NOTYPE
851 : MOTYPE=NOTYPE
852 : TYPE(1)='REAL*8'
852 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,
853 : 1 INFOS,3,IVARI)
854 : SEGSUP NOTYPE
855 : IF (IERR.NE.0) GOTO 9990
856 : *
857 : IF (ISUP2.EQ.1) THEN
857 : CALL VALCHE(IVARI,NVART,IPMINT,IPPORE)
858 : ENDIF
859 : ENDIF
860 : C____________________________________________________________________
861 : *
862 : * RECHERCHE DES DIMENSIONS DU MELVAL DE HOOKE
863 : *
864 : C____________________________________________________________________
865 : N2PTEL=0
866 : N2EL=0
867 : MPTVAL=IVAMAT
868 : DO 40 IO=1,NMATT
869 : IF(IVAL(IO).NE.0)THEN
870 : MELVAL=IVAL(IO)
871 : IF (CMATE.EQ.'SECTION') THEN
872 : N2PTEL=MAX(N2PTEL,IELCHE(/1))
873 : N2EL =MAX(N2EL ,IELCHE(/2))
874 : ELSE
875 : N2PTEL=MAX(N2PTEL,VELCHE(/1))
876 : N2EL =MAX(N2EL ,VELCHE(/2))
877 : ENDIF
878 : ENDIF
879 : 40 CONTINUE
880 : MPTVAL=IVACAR
881 : DO 41 IO=1,NCARR
882 : IF(IVAL(IO).NE.0)THEN
883 : MELVAL=IVAL(IO)
884 : IF (CMATE.EQ.'SECTION') THEN
885 : N2PTEL=MAX(N2PTEL,IELCHE(/1))
886 : N2EL =MAX(N2EL ,IELCHE(/2))
887 : ELSE
888 : N2PTEL=MAX(N2PTEL,VELCHE(/1))
889 : N2EL =MAX(N2EL ,VELCHE(/2))
890 : ENDIF
891 : ENDIF
892 : 41 CONTINUE
893 : IF (IPCHE2.NE.0) THEN
894 : MPTVAL=IVARI
895 : DO 42 IO=1,NVART
896 : IF(IVAL(IO).NE.0)THEN
897 : MELVAL=IVAL(IO)
898 : IF (CMATE.EQ.'SECTION') THEN
899 : N2PTEL=MAX(N2PTEL,IELCHE(/1))
900 : N2EL =MAX(N2EL ,IELCHE(/2))
901 : ELSE
902 : N2PTEL=MAX(N2PTEL,VELCHE(/1))
903 : N2EL =MAX(N2EL ,VELCHE(/2))
904 : ENDIF
905 : ENDIF
906 : 42 CONTINUE
907 : ENDIF
908 : C
909 : IF (N2PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
910 : N2PTEL=1
911 : ELSE
912 : N2PTEL=NBPGAU
913 : ENDIF
914 : *
915 : * INITIALISATION DU MELVAL DE HOOKE
916 : *
917 : N1PTEL=0
918 : N1EL=0
919 : SEGINI MELVAL
920 : IVAHOO=MELVAL
921 : IELVAL(1)=MELVAL
922 : *
923 : KCAS=1
924 : IF (IPCHE2.EQ.0) INAT=0
924 : CALL HOOK2D(IMODEL,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
925 : 1 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
926 : 2 LHOOK,LHOO2,LW,LASURF,IPORE,IRTD)
927 : C
928 : IF (IRTD.LE.0 ) GOTO 9990
929 : C
930 : C____________________________________________________________________
931 : C
932 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
933 : C____________________________________________________________________
934 : C
935 : 510 CONTINUE
936 : SEGDES,MINTE
937 : SEGDES IMODEL
938 : MELVAL=IVAHOO
939 : SEGDES MELVAL
940 : *
941 : IF (ISUP.EQ.1) THEN
941 : CALL DTMVAL(IVAMAT,3)
941 : CALL DTMVAL(IVACAR,3)
942 : ELSE
942 : CALL DTMVAL(IVAMAT,1)
942 : CALL DTMVAL(IVACAR,1)
943 : ENDIF
944 : *
945 : NOMID=MOCARA
946 : IF (MOCARA.NE.0) SEGSUP NOMID
947 : NOMID=MOMATR
948 : if(lsupma)SEGSUP NOMID
949 : *
950 : IF(IPCHE2.NE.0) THEN
951 : IF (ISUP2.EQ.1) THEN
951 : CALL DTMVAL(IVARI,3)
952 : ELSE
952 : CALL DTMVAL(IVARI,1)
953 : ENDIF
954 : NOMID=MOVARI
955 : if(lsupva)SEGSUP NOMID
956 : ENDIF
957 : C
958 : C ERREUR LE MATERIAU PAS ENCORE IMPLEMENTE POUR LA
959 : C FORMULATION MFR ET L OPTION IFOUR
960 : C
961 : IF(IERR.NE.0) THEN
962 : MOTERR(1:8)=CMATE
963 : * MOTERR(9:12)=NOMFR(MFR/2+1) MFR PAS DEFINI PV
964 : INTERR(1)=IFOUR
964 : CALL ERREUR(81)
965 : GOTO 888
966 : ENDIF
967 : 100 CONTINUE
968 :
969 : IRET = 1
970 : *
971 : 888 CONTINUE
972 : SEGDES MCHELM
973 : 666 CONTINUE
974 : RETURN
975 : *
976 : * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
977 : *
978 : 9990 CONTINUE
979 : IRET = 0
980 :
981 : IF (IPMINT.NE.0) SEGDES,MINTE
982 : IF (ISUP.EQ.1) THEN
982 : CALL DTMVAL(IVAMAT,3)
982 : CALL DTMVAL(IVACAR,3)
983 : ELSE
983 : CALL DTMVAL(IVAMAT,1)
983 : CALL DTMVAL(IVACAR,1)
984 : ENDIF
985 : *
986 : NOMID=MOCARA
987 : IF (MOCARA.NE.0) SEGSUP NOMID
988 : NOMID=MOMATR
989 : IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
990 : *
991 : IF (IPCHE2.NE.0.AND.IVARI.NE.0) THEN
992 : IF (ISUP2.EQ.1) THEN
992 : CALL DTMVAL(IVARI,3)
993 : ELSE
993 : CALL DTMVAL(IVARI,1)
994 : ENDIF
995 : NOMID=MOVARI
996 : if(lsupva)SEGSUP NOMID
997 : ENDIF
998 : *
999 : IF(IVAHOO.NE.0) THEN
1000 : MELVAL=IVAHOO
1001 : SEGSUP MELVAL
1002 : ENDIF
1003 : SEGDES IMODEL
1004 : SEGSUP MCHAML
1005 : *
1006 : SEGDES MMODEL
1007 : IF (IPCHE1.NE.0) THEN
1008 : MCHEL1=IPCHE1
1009 : SEGDES MCHEL1
1010 : ENDIF
1011 : SEGSUP MCHELM
1012 :
1013 : RETURN
1014 : END
1015 :
1016 :
1017 :
1018 :
1019 :
© Cast3M 2003 - All rights reserved.
Disclaimer