1 : C GNFLP SOURCE CHAT 11/03/16 21:24:10 6902
2 : SUBROUTINE GNFLP(IPMODL,IPCHE1,IPCHP1,IPCHE2,IPCHP4,IRET)
3 : C_______________________________________________________________________
4 : C
5 : C IPMODL MMODEL
6 : C IPCHE1 MCHAML
7 : C IPCHE2 MCHAML de caract{ristiques (facultatif)
8 : C IPCHP4 CHPOINT resultat
9 : C IRET =1 OU 0 suivant succes ou pas (Message d'erreur)
10 : C_______________________________________________________________________
11 : C
12 : IMPLICIT INTEGER(I-N)
13 : IMPLICIT REAL*8(A-H,O-Z)
14 : C
15 : -INC CCOPTIO
16 : -INC CCHAMP
17 : -INC SMCHAML
18 : -INC SMCHPOI
19 : -INC SMELEME
20 : -INC SMCOORD
21 : -INC SMMODEL
22 : -INC SMINTE
23 : *
24 : SEGMENT INFO
25 : INTEGER INFELL(JG)
26 : ENDSEGMENT
27 :
28 : SEGMENT NOTYPE
29 : CHARACTER*16 TYPE(NBTYPE)
30 : ENDSEGMENT
31 : *
32 : SEGMENT MPTVAL
33 : INTEGER IPOS(NS) ,NSOF(NS)
34 : INTEGER IVAL(NCOSOU)
35 : CHARACTER*16 TYVAL(NCOSOU)
36 : ENDSEGMENT
37 : *
38 : CHARACTER*8 CMATE
39 : CHARACTER*(NCONCH) CONM
40 : PARAMETER ( NINF=3 )
41 : INTEGER INFOS(NINF)
42 : LoGICAL lsupfo
43 :
44 : IRET = 0
45 : IPCHP4 = 0
46 : IPCHE5 = 0
47 : *
48 : * Verification du lieu support du MCHAML
49 : *
50 : IF (IPCHE1.NE.0) THEN
50 : CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP1,IRET1)
51 : IF (ISUP1.GT.1) THEN
51 : CALL ERREUR(609)
52 : RETURN
53 : ENDIF
54 : IPCHM1 = IPCHE1
55 : *
56 : * PASSAGE DU CHPOINT EN MCHAML
57 : *
58 : ELSE
58 : CALL CHAME1(0,IPMODL,IPCHP1,'VOLUMIQUE',IPCHM1,1)
59 : IF (IERR.NE.0) RETURN
60 : ISUP1 = 1
61 : ENDIF
62 : *
63 : * Verification du lieu support du MCHAML de caracteristiques
64 : *
65 : IF (IPCHE2.NE.0) THEN
65 : CALL QUESUP(IPMODL,IPCHE2,3,1,ISUP2,IRET2)
66 : IF (ISUP2.GT.1) THEN
66 : CALL ERREUR(609)
67 : RETURN
68 : ENDIF
69 : ENDIF
70 : *_______________________________________________________________________
71 : *
72 : * ACTIVATION DU MODELE
73 : *_______________________________________________________________________
74 : *
75 : MMODEL=IPMODL
76 : SEGACT MMODEL
77 : NSOUS=KMODEL(/1)
78 : C Petite verification sur le MODELE : uniquement FORMULATION POREUX
79 : DO ISOUS = 1, NSOUS
80 : IMODEL=KMODEL(ISOUS)
81 : SEGACT,IMODEL
82 : NFOR=FORMOD(/2)
83 : IF (NFOR.EQ.1) THEN
84 : IF (FORMOD(1).NE.'POREUX') THEN
85 : MOTERR(1:8)=FORMOD(1)
85 : CALL ERREUR(193)
86 : GOTO 9900
87 : ENDIF
88 : C* ELSE IF (NFOR.GT.1) THEN
89 : ELSE
90 : MOTERR(1:8)=FORMOD(1)
90 : CALL ERREUR(193)
91 : GOTO 9900
92 : ENDIF
93 : ENDDO
94 : C
95 : C ACTIVATION DU CHAMP EN ENTREE
96 : C
97 : MCHEL1=IPCHM1
98 : SEGACT,MCHEL1
99 : C
100 : C INITIALISATION DU MCHELM DE VALEURS NODALES
101 : C
102 : L1=6
103 : N1=NSOUS
104 : N3=5
105 : SEGINI,MCHELM
106 : IPCHE5=MCHELM
107 : IFOCHE=IFOUR
108 : TITCHE='FORCES'
109 : C_______________________________________________________________________
110 : C
111 : C BOUCLE SUR LES SOUS ZONES
112 : C_______________________________________________________________________
113 : C
114 : DO 200 ISOUS=1,NSOUS
115 : C
116 : C INITIALISATION
117 : C
118 : IVACAR=0
119 : IVAFOR=0
120 : IVAVCO=0
121 : MOCARA=0
122 : MOFORC=0
123 : MOVECO=0
124 : C
125 : C TRAITEMENT DU MODELE
126 : C
127 : IMODEL=KMODEL(ISOUS)
128 : IIPDPG=IPDPGE
129 : MELE=NEFMOD
130 : IPMAIL=IMAMOD
131 : CONM =CONMOD
132 : C____________________________________________________________________
133 : C
134 : C ACTIVATION DU MELEME
135 : C
136 : MELEME=IPMAIL
137 : SEGACT MELEME
138 : NBNN=NUM(/1)
139 : NBELEM=NUM(/2)
140 : C
141 : C CREATION DU TABLEAU INFOS
142 : C
142 : CALL IDENT(IPMAIL,CONM,IPCHM1,IPCHE2,INFOS,IRTD)
143 : IF (IRTD.EQ.0) GOTO 9990
144 : C_______________________________________________________________________
145 : C
146 : C INFORMATIONS SUR L'ELEMENT FINI
147 : C_______________________________________________________________________
148 : C
149 : if(infmod(/1).lt.5) then
149 : CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
150 : IF (IERR.NE.0) GOTO 9990
151 : INFO=IPINF
152 : NBPGAU= INFELL(4)
153 : NBG = INFELL(6)
154 : MINTE = INFELL(11)
155 : MINTE1= INFELL(12)
156 : IPMINT= MINTE
157 : IPMIN1= MINTE1
158 : MFR = INFELL(13)
159 : LW = INFELL(7)
160 : IELE = INFELL(14)
161 : IPORE = INFELL(8)
162 : segsup info
163 : ELSE
164 : NBPGAU= INFELE(4)
165 : NBG = INFELE(6)
166 : * MINTE = INFELE(11)
167 : MINTE=INFMOD(5)
168 : MINTE1= INFMOD(8)
169 : IPMINT= MINTE
170 : IPMIN1= MINTE1
171 : MFR = INFELE(13)
172 : LW = INFELE(7)
173 : IELE = INFELE(14)
174 : IPORE = INFELE(8)
175 : ENDIF
176 : IPPORE=0
177 : IF(MFR.EQ.33) THEN
178 : IPPORE=NBNN
179 : IDECAP=1
180 : ELSE IF(MFR.EQ.57) THEN
181 : IPPORE=NBNN
182 : IDECAP=2
183 : ELSE IF(MFR.EQ.59) THEN
184 : IPPORE=NBNN
185 : IDECAP=3
186 : ENDIF
187 : NHRM = NIFOUR
188 : C
189 : SEGACT MINTE
190 : NBNO=SHPTOT(/2)
191 : C
192 : C RECOPIE DU MCHELM
193 : C
194 : IMACHE(ISOUS)=IPMAIL
195 : CONCHE(ISOUS)=CONMOD
196 : INFCHE(ISOUS,1)=0
197 : INFCHE(ISOUS,2)=0
198 : INFCHE(ISOUS,3)=NIFOUR
199 : INFCHE(ISOUS,4)=0
200 : INFCHE(ISOUS,5)=0
201 : C_______________________________________________________________________
202 : C
203 : C NOMS DE COMPOSANTES EN SORTIE
204 : C_______________________________________________________________________
205 : C
206 : if(lnomid(2).ne.0) then
207 : lsupfo=.false.
208 : moforc=lnomid(2)
209 : nomid=moforc
210 : segact nomid
211 : NFORC=lesobl(/2)
212 : nfac=lesfac(/2)
213 : else
214 : lsupfo=.true.
214 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NFAC)
215 : NOMID=MOFORC
216 : SEGACT NOMID
217 : endif
218 : NCOMP=IDECAP
219 : C
220 : C CREATION DU MCHAML
221 : C
222 : N2=NCOMP
223 : SEGINI MCHAML
224 : ICHAML(ISOUS)=MCHAML
225 : DO 110 ICOMP=1,NCOMP
226 : IPRDEC=NFORC-IDECAP+ICOMP
227 : NOMCHE(ICOMP)=LESOBL(IPRDEC)
228 : TYPCHE(ICOMP)='REAL*8'
229 : 110 CONTINUE
230 : *_______________________________________________________________________
231 : *
232 : * TRAITEMENT DU CHAMP DE VALEURS EN ENTREE
233 : *_______________________________________________________________________
234 : *
235 : * ON PREND TOUS LES NOMS DE FORCES COMME COMPOSANTES POSSIBLES
236 : * MAIS ON LES MET EN FACULTATIF
237 : *
238 : * CAS JOINTS
239 : *
240 : IF((MELE.GE.108.AND.MELE.LE.110).OR.
241 : . (MELE.GE.185.AND.MELE.LE.190)) THEN
242 :
243 : IF(IFOUR.LE.0) THEN
244 : * CAS PLAN
245 : NCOVEC=3
246 : ELSE IF (IFOUR.EQ.2) THEN
247 : * 3D
248 : NCOVEC=4
249 : ENDIF
250 : ELSE
251 :
252 : IF(IFOUR.LE.0) THEN
253 : * CONTRAINTES PLANES - DEFORMATIONS PLANES
254 : * DEFO PLAN GENE
255 : * AXISYMETRIQUE
256 : NCOVEC=2
257 :
258 : ELSE IF (IFOUR.GT.0) THEN
259 : * FOURIER
260 : * 3D
261 : NCOVEC=3
262 : ENDIF
263 : ENDIF
264 : *
265 : * PUIS ON CREE LE SEGMENT MOVECO
266 : *
267 : NBROBL=0
268 : NBRFAC=NCOVEC*IDECAP
269 : *
270 : NVECO=NBRFAC
271 : SEGINI NOMID
272 : MOVECO=NOMID
273 :
274 : IF((MELE.GE.108.AND.MELE.LE.110).OR.
275 : . (MELE.GE.185.AND.MELE.LE.190)) THEN
276 :
277 : DO 121 IPR=1,IDECAP
278 : IPRDEC = (IPR-1)*NCOVEC
279 : IF(IPR.EQ.1) THEN
280 : LESFAC(IPRDEC+1)='VCPH'
281 : LESFAC(IPRDEC+2)='VCPB'
282 : LESFAC(IPRDEC+3)='VCP1'
283 : IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCP2'
284 : ELSE IF(IPR.EQ.2) THEN
285 : LESFAC(IPRDEC+1)='VCQT'
286 : LESFAC(IPRDEC+2)='VCQB'
287 : LESFAC(IPRDEC+3)='VCQ1'
288 : IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCQ2'
289 : ELSE IF(IPR.EQ.3) THEN
290 : LESFAC(IPRDEC+1)='VCTT'
291 : LESFAC(IPRDEC+2)='VCTB'
292 : LESFAC(IPRDEC+3)='VCT1'
293 : IF(NCOVEC.EQ.4) LESFAC(IPRDEC+4)='VCT2'
294 : ENDIF
295 : 121 CONTINUE
296 :
297 : ELSE
298 : DO 120 IPR=1,IDECAP
299 : IPRDEC = (IPR-1)*NCOVEC
300 : IF(IPR.EQ.1) THEN
301 : LESFAC(IPRDEC+1)='VCP1'
302 : LESFAC(IPRDEC+2)='VCP2'
303 : IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCP3'
304 : ELSE IF(IPR.EQ.2) THEN
305 : LESFAC(IPRDEC+1)='VCQ1'
306 : LESFAC(IPRDEC+2)='VCQ2'
307 : IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCQ3'
308 : ELSE IF(IPR.EQ.3) THEN
309 : LESFAC(IPRDEC+1)='VCT1'
310 : LESFAC(IPRDEC+2)='VCT2'
311 : IF(NCOVEC.EQ.3) LESFAC(IPRDEC+3)='VCT3'
312 : ENDIF
313 : 120 CONTINUE
314 :
315 : ENDIF
316 : *
317 : * RECUPERATION DES COMPOSANTES PRESENTES
318 : *
319 : NBTYPE=1
320 : SEGINI NOTYPE
321 : MOTYPE=NOTYPE
322 : TYPE(1)='REAL*8'
322 : CALL KOMCHA(IPCHM1,IPMAIL,CONM,MOVECO,MOTYPE,0,INFOS,3,IVAVCO)
323 : SEGSUP NOTYPE
324 : IF (IERR.NE.0) GOTO 9991
325 : *
326 : * ON VERIFIE A POSTERIORI QU'ON A TROUVE QUELQUE CHOSE
327 : *
328 : MPTVAL = IVAVCO
329 : NCOSOU = IVAL(/1)
330 : DO 50 I=1,NCOSOU
331 : IF (IVAL(I).NE.0) GOTO 501
332 : 50 CONTINUE
333 : MOTERR(1:8)='VEC. COU'
334 : MOTERR(9:12)=NOMTP(MELE)
335 : MOTERR(13:20)='GNFL '
335 : CALL ERREUR(145)
336 : GO TO 9991
337 : 501 CONTINUE
338 : *
339 : * CHANGEMENT DE SUPPORT SI BESOIN
340 : *
341 : IF (ISUP1.EQ.1) THEN
341 : CALL VALCHE(IVAVCO,NVECO,IPMINT,IPPORE)
342 : IF (IERR.NE.0) THEN
343 : ISUP1 = 0
344 : GOTO 9991
345 : ENDIF
346 : ENDIF
347 : C____________________________________________________________________
348 : C
349 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
350 : C____________________________________________________________________
351 : *
352 : NCARA=0
353 : NCARF=0
354 :
355 : IF (IPCHE2.NE.0) THEN
356 : NBROBL=0
357 : NBRFAC=0
358 : *
359 : * EPAISSEUR DANS LE CAS MASSIF EN CONTRAINTES PLANES
360 : *
361 : IF((MFR.EQ.33.OR.MFR.EQ.57.OR.MFR.EQ.59)
362 : + .AND.IFOUR.EQ.-2)THEN
363 : NBROBL=0
364 : NBRFAC=1
365 : SEGINI NOMID
366 : MOCARA=NOMID
367 : LESFAC(1)='DIM3'
368 : *
369 : NBTYPE=1
370 : SEGINI NOTYPE
371 : TYPE(1)='REAL*8'
372 : ENDIF
373 : NCARA=NBROBL
374 : NCARF=NBRFAC
375 : NCARR=NCARA+NCARF
376 : *
377 : IF (MOCARA.NE.0) THEN
378 : MOTYPE=NOTYPE
378 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
379 : $ IVACAR)
380 : SEGSUP NOTYPE
381 : IF (IERR.NE.0) GOTO 9991
382 : *
383 : IF (ISUP2.EQ.1) THEN
383 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE)
384 : IF (IERR.NE.0) THEN
385 : ISUP2=0
386 : GOTO 9991
387 : ENDIF
388 : ENDIF
389 : ENDIF
390 : ENDIF
391 : C
392 : C TAILLES DE MELVAL
393 : C
394 : N1EL =NBELEM
395 : N1PTEL=NBNN
396 : N2PTEL=0
397 : N2EL=0
398 : NBPTEL=NBPGAU
399 : NEL =N1EL
400 : C
401 : C CREATION DU MELVAL DE FORCES NODALES
402 : C
403 : NS=1
404 : NCOSOU=NCOMP
405 : SEGINI MPTVAL
406 : IVAFOR=MPTVAL
407 : DO 100 ICOMP=1,NCOSOU
408 : SEGINI MELVAL
409 : IELVAL(ICOMP)=MELVAL
410 : IVAL(ICOMP)=MELVAL
411 : 100 CONTINUE
412 : C
413 : IF(MELE.GE.79.AND.MELE.LE.83) GO TO 4
414 : IF(MELE.GE.173.AND.MELE.LE.182) GO TO 4
415 : IF(MELE.GE.108.AND.MELE.LE.110) GO TO 4
416 : IF(MELE.GE.185.AND.MELE.LE.190) GO TO 4
417 : C
418 : 99 CONTINUE
419 : MOTERR(1:4)=NOMTP(MELE)
420 : MOTERR(5:8)='GNFL'
420 : CALL ERREUR(86)
421 : GOTO 9991
422 : C_______________________________________________________________________
423 : C
424 : C poreux
425 : C_______________________________________________________________________
426 : C
427 : 4 CONTINUE
427 : CALL GNFL1(IPMAIL,NVECO,NBPGAU,MELE,MFR,IVAVCO,IPMINT,IVACAR,
428 : & IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
429 : GOTO 510
430 : C_______________________________________________________________________
431 : C
432 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
433 : C_______________________________________________________________________
434 : 510 CONTINUE
435 : C
436 : 9991 CONTINUE
437 : SEGDES MINTE
438 : SEGDES MCHAML
439 : 9990 CONTINUE
440 : SEGDES MELEME
441 : C
442 : IF (ISUP1.EQ.1)THEN
442 : CALL DTMVAL(IVAVCO,3)
443 : ELSE
443 : CALL DTMVAL(IVAVCO,1)
444 : ENDIF
445 : IF (MOVECO.NE.0) THEN
446 : NOMID=MOVECO
447 : SEGSUP NOMID
448 : ENDIF
449 : C
449 : CALL DTMVAL(IVAFOR,1)
450 : IF (MOFORC.NE.0) THEN
451 : NOMID=MOFORC
452 : if (lsupfo) SEGSUP NOMID
453 : ENDIF
454 : C
455 : IF (IPCHE2.NE.0) THEN
456 : IF (ISUP2.EQ.1) THEN
456 : CALL DTMVAL(IVACAR,3)
457 : ELSE
457 : CALL DTMVAL(IVACAR,1)
458 : ENDIF
459 : IF (MOCARA.NE.0) THEN
460 : NOMID=MOCARA
461 : SEGSUP NOMID
462 : ENDIF
463 : ENDIF
464 : C
465 : IF (IERR.NE.0) GO TO 9999
466 : C
467 : 200 CONTINUE
468 :
469 : C_______________________________________________________________________
470 : C
471 : C TRANSFORMATION DU CHAMELEM EN CHPOINT
472 : C_______________________________________________________________________
473 : C
473 : CALL CHAMPO(IPCHE5,0,IPCHP4,IRET)
474 : IF (IERR.NE.0) GOTO 9999
474 : CALL DTCHAM(IPCHE5)
475 : C
476 : IRET = 1
477 : GOTO 9900
478 : C
479 : C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
480 : 9999 CONTINUE
481 : IRET = 0
482 : IPCHP4 = 0
483 : IF (IPCHE5.NE.0) SEGSUP,MCHELM
484 :
485 : C- Fin du sous-programme : gestion des segments
486 : 9900 CONTINUE
487 : C Desactivation du modele
488 : DO ISOUS = 1, NSOUS
489 : IMODEL=KMODEL(ISOUS)
490 : SEGDES,IMODEL
491 : ENDDO
492 : SEGDES,MMODEL
493 : C Destructions de segments si necessaire
493 : IF (IPCHE1.EQ.0) CALL DTCHAM(IPCHM1)
494 :
495 : RETURN
496 : END
497 :
498 :
499 :
© Cast3M 2003 - All rights reserved.
Disclaimer