1 : C ZEROP SOURCE CHAT 11/03/16 21:34:11 6902
2 : SUBROUTINE ZEROP(IPMODL,MOT,IPCHEL)
3 : C_______________________________________________________________________
4 : C
5 : C OPERATEUR MCHAML A ZERO
6 : C
7 : C Entr{es:
8 : C ________
9 : C
10 : C IPMODL Pointeur sur un MMODEL
11 : C MOT Mot indiquant le type du MCHAML @ cr{er
12 : C
13 : C Sorties:
14 : C ________
15 : C
16 : C IPCHEL Pointeur sur un MCHAML r{sultat @ ZERO
17 : C
18 : C Passage aux nouveaux chamelems par i.monnier le 30.8.90
19 : C
20 : C_______________________________________________________________________
21 : *
22 : IMPLICIT INTEGER(I-N)
23 : -INC SMMODEL
24 : -INC SMCHAML
25 : -INC CCOPTIO
26 : -INC SMLREEL
27 : *
28 : C
29 : SEGMENT INFO
30 : INTEGER INFELL(JG)
31 : ENDSEGMENT
32 : ** pile modeles elementaires
33 : segment limode(0)
34 : *
35 : PARAMETER (NMOT=24)
36 : CHARACTER*8 LISMOT(NMOT),MOT
37 : CHARACTER*50 LISTIT(NMOT)
38 : INTEGER MSUPPO(NMOT)
39 : CHARACTER*8 CMATE
40 : LOGICAL lsupre
41 : *
42 : DATA LISMOT / 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
43 : 1 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
44 : 1 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
45 : 1 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
46 : 1 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
47 : 1 'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
48 : *
49 : * LES MATERIAUX ET CARACTERISTIQUES SONT MIS AUX NOEUDS
50 : *
51 : * 'NOEUD ', 'GRAVITE ', 'RIGIDITE', 'MASSE ',
52 : DATA MSUPPO / 1 , 2 , 3 , 4 ,
53 : * 'STRESSES', 'DEPLACEM', 'FORCES ', 'REACTUAL',
54 : 1 5 , 1 , 1 , 1 ,
55 : * 'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
56 : 1 3 , 5 , 5 , 5 ,
57 : * 'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
58 : 1 1 , 1 , 5 , 5 ,
59 : * 'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
60 : 1 3 , 5 , 5 , 5 ,
61 : * 'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
62 : 1 5 , 5 , 1 , 5/
63 : *
64 : DATA LISTIT / 'NOEUD*', 'GRAVITE*', 'RIGIDITE*', 'MASSE*',
65 : 1 'STRESSES*', 'DEPLACEMENTS*', 'FORCES*',
66 : 1 'REACTUALISATION*', 'FORCES VOLUMIQUES*',
67 : 1 'GRADIENT*', 'CONTRAINTES*', 'DEFORMATIONS*',
68 : 1 'CARACTERISTIQUES*', 'CARACTERISTIQUES*',
69 : 1 'TEMPERATURES*', 'CONTRAINTES PRINCIPALES*',
70 : 1 'MATRICE DE HOOKE*', 'MATRICE DE HOOKE TANGENTE*',
71 : 1 'DILATATIONS*', 'VARIABLES INTERNES*',
72 : 1 'GRADIENT DE FLEXION*','VON MISES*',
73 : 1 'VARIABLES INTERNES MICROSTRUCTURES*',
74 : 1 'DEFORMATIONS INELASTIQUES*'/
75 : *
76 : INATU=0
77 : NHRM=NIFOUR
78 : *
79 : MMODEL=IPMODL
80 : SEGACT MMODEL
81 : NSOUS=KMODEL(/1)
82 : * garder la formulation mecanique et creer modele equivalent
83 : segini limode
84 : do im = 1,NSOUS
85 : imodel = kmodel(im)
86 : segact imodel
87 : if (formod(1).eq.'MELANGE'.AND.matmod(1).EQ.'PARALLELE') then
88 : segini,imode1=imodel
89 : imodel = imode1
90 : formod(1) = 'MECANIQUE'
91 : matmod(1) = 'ELASTIQUE'
92 : MN3 = INFMOD(/1)
93 : NFOR = FORMOD(/2)
94 : NOBMOD = IVAMOD(/1)
95 : NMAT = 2
96 : segadj imodel
97 : matmod(2) = 'ISOTROPE'
98 : limode(**) = imodel
99 : else
100 : if( nefmod.ne.22.and.formod(1).ne.'LIAISON') then
101 : limode(**) = imodel
102 : endif
103 : endif
104 : enddo
105 : segdes mmodel
106 : * test non redondance
107 : N1 = 1
108 : if (limode(/1).gt.1) then
109 : do 1161 it1 = limode(/1),2,-1
110 : imode1 = limode(it1)
111 : segact imode1
112 : do it2 = (it1 - 1) ,1,-1
113 : imode2 = limode(it2)
114 : segact imode2
115 : if (imode1.imamod.eq.imode2.imamod.and.
116 : & imode1.conmod.eq.imode2.conmod) then
117 : limode(it1) = 0
118 : goto 1161
119 : endif
120 : enddo
121 : N1 = N1 + 1
122 : 1161 continue
123 : endif
124 :
125 : is1 = 0
126 : if (limode(/1).gt.0) then
127 : segini,mmodel
128 : do is = 1,limode(/1)
129 : if (limode(is).gt.0) then
130 : is1 = is1 + 1
131 : kmodel(is1) = limode(is)
132 : endif
133 : enddo
134 : else
134 : call erreur(26)
135 : return
136 : endif
137 : NSOUS=KMODEL(/1)
138 : *
139 : * CREATION DU MCHELM
140 : *
140 : CALL PLACE(LISMOT,NMOT,IPLAC,MOT)
141 : DO 50 IO=1,50
142 : IF (LISTIT(IPLAC)(IO:IO).EQ.'*') GOTO 60
143 : 50 CONTINUE
144 : 60 L1=IO-1
145 : N1=NSOUS
146 : IF (MSUPPO(IPLAC).EQ.0) THEN
147 : N3=3
148 : ELSE
149 : N3=6
150 : ENDIF
151 : SEGINI MCHELM
152 : IPCHEL=MCHELM
153 : TITCHE=LISTIT(IPLAC)(1:L1)
154 : IFOCHE=IFOUR
155 : *
156 : * BOUCLE SUR LES SOUS-ZONES
157 : *
158 : DO 100 ISOUS=1,NSOUS
159 : *
160 : IMODEL=KMODEL(ISOUS)
161 : SEGACT IMODEL
162 : IPMAIL=IMAMOD
163 : MELE =NEFMOD
164 : IF(INFMOD(/1).NE.0) THEN
165 : NPINT=INFMOD(1)
166 : ELSE
167 : NPINT = 0
168 : ENDIF
169 : MFR=NUMMFR(MELE)
170 : IMACHE(ISOUS)=IPMAIL
171 : CONCHE(ISOUS)=CONMOD
172 : INFCHE(ISOUS,1)=0
173 : INFCHE(ISOUS,2)=0
174 : INFCHE(ISOUS,3)=NHRM
175 : IF (N3.GT.3) THEN
176 : INFCHE(ISOUS,5)=0
177 : ENDIF
178 : MOCOMP=0
179 : NOBL=0
180 : NFAC=0
181 : *
182 : if(infmod(/1).lt.2+msuppo(iplac) ) then
182 : CALL ELQUOI(MELE,0,MSUPPO(IPLAC),IPINF,IMODEL)
183 : INFO=IPINF
184 : MINTE=INFELL(11)
185 : NSTRS=INFELL(16)
186 : segsup info
187 : else
188 : MINTE=INFMOD(2+msuppo(iplac))
189 : NSTRS=INFELE(16)
190 : endif
191 :
192 : IF (N3.GT.3) THEN
193 : INFCHE(ISOUS,4)=MINTE
194 : INFCHE(ISOUS,6)=MSUPPO(IPLAC)
195 : ENDIF
196 : *
197 : * AIGUILLAGE SUIVANT MOT CLE
198 : *
199 : lsupre=.true.
200 : GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
201 : 1 99,20,21,99,23,24) IPLAC
202 : *
203 : 99 MOTERR(1:8)='CHAMELEM'
203 : CALL ERREUR(302)
204 : SEGDES IMODEL
205 : SEGDES MMODEL
206 : SEGSUP MCHELM
207 : RETURN
208 : *
209 : 1 NBROBL=1
210 : NBRFAC=0
211 : NOBL=1
212 : SEGINI NOMID
213 : MOCOMP=NOMID
214 : LESOBL(1)='SCAL'
215 : GOTO 120
216 : *
217 : 2 NBROBL=1
218 : NBRFAC=0
219 : NOBL=1
220 : SEGINI NOMID
221 : MOCOMP=NOMID
222 : LESOBL(1)='MAHO'
223 : GOTO 120
224 : *
225 : 6 if(lnomid(1).ne.0) then
226 : nomid=lnomid(1)
227 : segact nomid
228 : mocomp=nomid
229 : nobl=lesobl(/2)
230 : nfac=lesfac(/2)
231 : lsupre=.false.
232 : else
232 : CALL IDDEPL(MFR,IFOUR,MOCOMP,NOBL,NFAC)
233 : endif
234 : GOTO 120
235 : *
236 : 7 if(lnomid(2).ne.0) then
237 : nomid=lnomid(2)
238 : segact nomid
239 : mocomp=nomid
240 : nobl=lesobl(/2)
241 : nfac=lesfac(/2)
242 : lsupre=.false.
243 : else
243 : CALL IDFORC(MFR,IFOUR,MOCOMP,NOBL,NFAC)
244 : endif
245 : GOTO 120
246 : *
247 : 10 if(lnomid(3).ne.0) then
248 : nomid=lnomid(3)
249 : segact nomid
250 : mocomp=nomid
251 : nobl=lesobl(/2)
252 : nfac=lesfac(/2)
253 : lsupre=.false.
254 : else
254 : CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
255 : endif
256 : GOTO 120
257 : *
258 : 11 if(lnomid(4).ne.0) then
259 : nomid=lnomid(4)
260 : segact nomid
261 : mocomp=nomid
262 : nobl=lesobl(/2)
263 : nfac=lesfac(/2)
264 : lsupre=.false.
265 : else
265 : CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
266 : endif
267 : GOTO 120
268 : *
269 : 12 if(lnomid(5).ne.0) then
270 : nomid=lnomid(5)
271 : mocomp=nomid
272 : segact nomid
273 : nobl=lesobl(/2)
274 : nfac=lesfac(/2)
275 : lsupre=.false.
276 : else
276 : CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
277 : endif
278 : GOTO 120
279 : *
280 : 13 if(lnomid(6).ne.0) then
281 : nomid=lnomid(6)
282 : mocomp=nomid
283 : segact nomid
284 : nobl=lesobl(/2)
285 : nfac=lesfac(/2)
286 : lsupre=.false.
287 : else
287 : CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
288 : endif
289 : GOTO 120
290 : *
291 : 14 if(lnomid(7).ne.0) then
292 : nomid=lnomid(7)
293 : mocomp=nomid
294 : segact nomid
295 : nobl=lesobl(/2)
296 : nfac=lesfac(/2)
297 : lsupre=.false.
298 : else
298 : CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
299 : endif
300 : GOTO 120
301 : *
302 : 15 if(lnomid(8).ne.0) then
303 : nomid=lnomid(8)
304 : mocomp=nomid
305 : segact nomid
306 : nobl=lesobl(/2)
307 : nfac=lesfac(/2)
308 : lsupre=.false.
309 : else
309 : CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
310 : endif
311 : GOTO 120
312 : *
313 : 16 if(lnomid(9).ne.0) then
314 : nomid=lnomid(9)
315 : segact nomid
316 : mocomp=nomid
317 : nobl=lesobl(/2)
318 : nfac=lesfac(/2)
319 : lsupre=.false.
320 : else
320 : CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
321 : endif
322 : GOTO 120
323 : *
324 : 20 if(lnomid(10).ne.0) then
325 : nomid=lnomid(10)
326 : segact nomid
327 : mocomp=nomid
328 : nobl=lesobl(/2)
329 : nfac=lesfac(/2)
330 : lsupre=.false.
331 : else
331 : CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
332 : endif
333 : *
334 : NFOR=FORMOD(/2)
335 : NMAT=MATMOD(/2)
335 : * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INATU)
336 : CMATE = CMATEE
337 : MATE = IMATEE
338 : INATU = INATUU
339 : C
340 : C Dans le cas d'une loi 'NON_LINEAIRE' 'UTILISATEUR', il peut ne
341 : C pas y avoir de variables internes
342 : C Dans ce cas UNIQUEMENT on declare artificiellement une variable
343 : C interne bidon afin de creer un MCHAML de travail permettant une
344 : C prise en charge du modele externe dans COMP coherente avec celle
345 : C des autres modeles
346 : C
347 : IF (NOBL.EQ.0.AND.NFAC.EQ.0.AND.
348 : & INATU.LT.0.AND.INATU.GT.-100) THEN
349 : NBROBL=1
350 : NBRFAC=0
351 : NOBL=1
352 : SEGINI NOMID
353 : MOCOMP=NOMID
354 : LESOBL(1)='VARI'
355 : ENDIF
356 : GOTO 120
357 : *
358 : 21 if(lnomid(11).ne.0) then
359 : nomid=lnomid(11)
360 : segact nomid
361 : mocomp=nomid
362 : nobl=lesobl(/2)
363 : nfac=lesfac(/2)
364 : lsupre=.false.
365 : else
365 : CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
366 : endif
367 : GOTO 120
368 : *
369 : 23 if(lnomid(12).ne.0) then
370 : nomid=lnomid(12)
371 : segact nomid
372 : mocomp=nomid
373 : nobl=lesobl(/2)
374 : nfac=lesfac(/2)
375 : lsupre=.false.
376 : else
376 : CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
377 : endif
378 : GOTO 120
379 : *
380 : 24 if(lnomid(13).ne.0) then
381 : nomid=lnomid(13)
382 : segact nomid
383 : mocomp=nomid
384 : nobl=lesobl(/2)
385 : nfac=lesfac(/2)
386 : lsupre=.false.
387 : else
387 : CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
388 : endif
389 : GOTO 120
390 : *
391 : 120 CONTINUE
392 : IF (NOBL.EQ.0.AND.NFAC.EQ.0) THEN
393 : SEGDES IMODEL
394 : SEGDES MMODEL
395 : SEGSUP MCHELM
395 : CALL ERREUR(404)
396 : RETURN
397 : ENDIF
398 : NOMID=MOCOMP
399 : SEGACT NOMID
400 : N2=NOBL+NFAC
401 : SEGINI MCHAML
402 : ICHAML(ISOUS)=MCHAML
403 : C
404 : IF (NOBL.GT.0) THEN
405 : C
406 : DO 130 IO=1,NOBL
407 : NOMCHE(IO)=LESOBL(IO)
408 : IF (IPLAC.EQ.17.OR.IPLAC.EQ.18) THEN
409 : TYPCHE(IO)='POINTEURLISTREEL'
410 : N1PTEL=0
411 : N1EL=0
412 : N2PTEL=1
413 : N2EL=1
414 : SEGINI MELVAL
415 : IELVAL(IO)=MELVAL
416 : JG=1
417 : SEGINI MLREEL
418 : IELCHE(1,1)=MLREEL
419 : SEGDES MLREEL
420 : SEGDES MELVAL
421 : ELSE IF (IPLAC.EQ.20.AND.CMATE.EQ.'SECTION')THEN
422 : TYPCHE(IO)='POINTEURMCHAML '
423 : N1PTEL=0
424 : N1EL=0
425 : N2PTEL=1
426 : N2EL=1
427 : SEGINI MELVAL
428 : IELVAL(IO)=MELVAL
429 : IELCHE(1,1)=0
430 : SEGDES MELVAL
431 : ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.74.AND.IO.GT.1) THEN
432 : *
433 : * MODELE DE MAXWELL - COMPOSANTES AUTRES QUE EPSE
434 : *
435 : TYPCHE(IO)='POINTEURLISTREEL'
436 : N1PTEL=0
437 : N1EL=0
438 : N2PTEL=1
439 : N2EL=1
440 : SEGINI MELVAL
441 : IELVAL(IO)=MELVAL
442 : JG=NSTRS
443 : SEGINI MLREEL
444 : IELCHE(1,1)=MLREEL
445 : SEGDES MLREEL
446 : SEGDES MELVAL
447 :
448 : ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.106) THEN
449 : *
450 : * MODELE MAXOTT COMPOSANTE AUTRES QUE REAL*8
451 : *
452 : IF((IFOUR.EQ.2.AND.MFR.EQ.1)
453 : & .AND.IO.GT.21) THEN
454 : TYPCHE(IO)='POINTEURLISTREEL'
455 : N1PTEL=0
456 : N1EL=0
457 : N2PTEL=1
458 : N2EL=1
459 : SEGINI MELVAL
460 : IELVAL(IO)=MELVAL
461 : JG=NSTRS
462 : SEGINI MLREEL
463 : IELCHE(1,1)=MLREEL
464 : SEGDES MLREEL
465 : SEGDES MELVAL
466 : ELSE IF((IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
467 : & IFOUR.EQ.0.OR.IFOUR.EQ.1)
468 : & .AND.IO.GT.16) THEN
469 : TYPCHE(IO)='POINTEURLISTREEL'
470 : N1PTEL=0
471 : N1EL=0
472 : N2PTEL=1
473 : N2EL=1
474 : SEGINI MELVAL
475 : IELVAL(IO)=MELVAL
476 : JG=NSTRS
477 : SEGINI MLREEL
478 : IELCHE(1,1)=MLREEL
479 : SEGDES MLREEL
480 : SEGDES MELVAL
481 : ELSE IF((IFOUR.EQ.-2.OR.(IFOUR.EQ.2.AND.
482 : & (MFR.EQ.3.OR.MFR.EQ.9)))
483 : & .AND.IO.GT.13) THEN
484 : TYPCHE(IO)='POINTEURLISTREEL'
485 : N1PTEL=0
486 : N1EL=0
487 : N2PTEL=1
488 : N2EL=1
489 : SEGINI MELVAL
490 : IELVAL(IO)=MELVAL
491 : JG=NSTRS
492 : SEGINI MLREEL
493 : IELCHE(1,1)=MLREEL
494 : SEGDES MLREEL
495 : SEGDES MELVAL
496 : ELSE
497 : TYPCHE(IO)='REAL*8'
498 : N1PTEL=1
499 : N1EL=1
500 : N2PTEL=0
501 : N2EL=0
502 : SEGINI MELVAL
503 : IELVAL(IO)=MELVAL
504 : SEGDES MELVAL
505 : ENDIF
506 : ELSE
507 : TYPCHE(IO)='REAL*8'
508 : N1PTEL=1
509 : N1EL=1
510 : N2PTEL=0
511 : N2EL=0
512 : SEGINI MELVAL
513 : IELVAL(IO)=MELVAL
514 : SEGDES MELVAL
515 : ENDIF
516 : 130 CONTINUE
517 : C
518 : ENDIF
519 : C
520 : IF (NFAC.GT.0) THEN
521 : C
522 : DO 140 IO=1,NFAC
523 :
524 : IF(INATU.EQ.106) THEN
525 : NOMCHE(IO+NOBL)=LESFAC(IO)
526 : TYPCHE(IO+NOBL)='POINTEURLISTREEL'
527 : N1PTEL=0
528 : N1EL=0
529 : N2PTEL=1
530 : N2EL=1
531 : SEGINI MELVAL
532 : IELVAL(IO+NOBL)=MELVAL
533 : JG=NSTRS
534 : SEGINI MLREEL
535 : IELCHE(1,1)=MLREEL
536 : SEGDES MLREEL
537 : SEGDES MELVAL
538 :
539 : ELSE IF (INATU.EQ.74) THEN
540 : *
541 : * MODELE DE MAXWELL - SUITE
542 : *
543 : NOMCHE(IO+NOBL)=LESFAC(IO)
544 : TYPCHE(IO+NOBL)='POINTEURLISTREEL'
545 : N1PTEL=0
546 : N1EL=0
547 : N2PTEL=1
548 : N2EL=1
549 : SEGINI MELVAL
550 : IELVAL(IO+NOBL)=MELVAL
551 : JG=NSTRS
552 : SEGINI MLREEL
553 : IELCHE(1,1)=MLREEL
554 : SEGDES MLREEL
555 : SEGDES MELVAL
556 : ELSE
557 : NOMCHE(IO+NOBL)=LESFAC(IO)
558 : TYPCHE(IO+NOBL)='REAL*8'
559 : N1PTEL=1
560 : N1EL=1
561 : N2PTEL=0
562 : N2EL=0
563 : SEGINI MELVAL
564 : IELVAL(IO+NOBL)=MELVAL
565 : SEGDES MELVAL
566 :
567 : ENDIF
568 :
569 : 140 CONTINUE
570 : C
571 : ENDIF
572 :
573 : CMATE = CMATEE
574 : MATE = IMATEE
575 : INATU = INATUU
576 : if ((iplac.eq.11.or.iplac.eq.20).and.
577 : &(cmate.eq.'MODAL'.or.cmate.eq.'STATIQUE')) then
578 : N2 = 1
579 : segadj mchaml
580 : endif
581 : C
582 : 510 CONTINUE
583 : SEGDES IMODEL
584 : SEGDES MCHAML
585 : if(lsupre) SEGSUP NOMID
586 : 100 CONTINUE
587 : SEGDES MMODEL
588 : segsup mmodel,limode
589 : SEGDES MCHELM
590 : RETURN
591 : END
592 :
593 :
594 :
595 :
596 :
597 :
598 :
599 :
600 :
601 :
602 :
603 :
604 :
605 :
606 :
607 :
608 :
609 :
610 :
611 :
612 :
613 :
614 :
615 :
616 :
© Cast3M 2003 - All rights reserved.
Disclaimer