1 : C KALPBG SOURCE MAGN 10/05/31 21:15:10 6679
2 : SUBROUTINE KALPBG(NOME,DISCR,IZFFM)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 : C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
6 : C
7 : C CE SOUS PROGRAMME CREE DES OBJETS DE TYPE FONFORM OU FONFORM0
8 : C SUIVANT QUE ITYPI = 1 OU 0 ET CONTENANT LES FONCTIONS DE FORME
9 : C DU TYPE D'ELEMENT CONSIDERE
10 : C
11 : C ARGUMENTS D'ENTREE NOMI CHARACTER*8 TYPE ELEMENT DS TYPELT
12 : C (COMMON CCHAMTR)
13 : C ITYPI ENTIER 1 INTEGRATION NORMALE
14 : C 0 SOUS INTEGRATION
15 : C NOM2= PRP1 -> vitesses quadratiques pression P1
16 : C NOM2= PRP0 -> vitesses quadratiques pression P0
17 : C NOM2= PFP1 -> vitesses quadratiques pression P1 C
18 : C NOM2= MCP1 -> vitesses Iso-P2 pression P1
19 : C NOM2= MCP0 -> vitesses Iso-P2 pression P0
20 : C NOM2= MCF1 -> vitesses Iso-P2 pression P1/Q1 C
21 : C
22 : C IZFFM POINTEUR DE L'OBJET CR{{
23 : C
24 : C IES=IDIM EST LA DIMENSION DE L ESPACE DE CALCUL
25 : C NES EST LA DIMENSION DE L ESPACE DE L ELEMENT DE REFERENC
26 : C NP NB DE PTS DE L ELEMENT
27 : C MP NB DE PTS PRESSION
28 : C NPG NB DE PTS D'INTEGRATION POUR LA VITESSE
29 : C MPG NB DE PTS D'INTEGRATION POUR LA PRESSION
30 : C
31 : C FN(NP,NPG) ) ELEMENT DE REF
32 : C GR(NES,NP,NPG) )
33 : C FM(MP,NPG) )
34 : C GM(NES,MP,NPG) )
35 : C
36 : C HR(IES,NP,NPG) ) GRADIENT DANS LE REPERE GLOBAL DEFINI ICI
37 : C MAIS CHARGE DANS LES CALJ..
38 : C IES=NES SI L ELEMENT EST DROIT
39 : C IES=IES SI L ELEMENT EST GAUCHE
40 : C PG(NPG)
41 : C
42 : C -----------------------------------------------------------------
43 : C***
44 : C
45 : C Modification du 12/01/99 : les elements dont les fonctions de formes
46 : C n'existent pas sont en commentaires
47 : C Cela correspond aux subroutines suivantes : PB602, PB802, PRPB15,
48 : C PB2003
49 : C***
50 : * 15/06/00 : ajout tétraèdre quadratique par gounand
51 : *
52 : *
53 : REAL*8 X(64),Y(64),Z(64)
54 : PARAMETER (NBELT=21)
55 : CHARACTER*8 NOME,DISCR,TYPELT(NBELT),NOM1
56 : CHARACTER*4 NOM2
57 : -INC CCOPTIO
58 : -INC SIZFFB
59 : POINTEUR IZF1.IZFFM,IZF2.IZFFM
60 : CBEGININCLUDE SELREF
61 : SEGMENT ELREF
62 : CHARACTER*(LNNOM) NOMLRF
63 : CHARACTER*(LNFORM) FORME
64 : CHARACTER*(LNTYPL) TYPEL
65 : CHARACTER*(LNESP) ESPACE
66 : INTEGER DEGRE
67 : REAL*8 XCONOD(NDIMEL,NBNOD)
68 : INTEGER NPQUAF(NBDDL)
69 : INTEGER NUMCMP(NBDDL)
70 : INTEGER QUENOD(NBDDL)
71 : INTEGER ORDDER(NDIMEL,NBDDL)
72 : POINTEUR MBPOLY.POLYNS
73 : ENDSEGMENT
74 : SEGMENT ELREFS
75 : POINTEUR LISEL(0).ELREF
76 : ENDSEGMENT
77 : CENDINCLUDE SELREF
78 : POINTEUR MYLRFS.ELREFS
79 : POINTEUR ELVIT.ELREF
80 : POINTEUR ELPRES.ELREF
81 : CBEGININCLUDE SFALRF
82 : SEGMENT FALRF
83 : CHARACTER*(LNNFA) NOMFA
84 : INTEGER NUQUAF(NBLRF)
85 : POINTEUR ELEMF(NBLRF).ELREF
86 : ENDSEGMENT
87 : SEGMENT FALRFS
88 : POINTEUR LISFA(0).FALRF
89 : ENDSEGMENT
90 : CENDINCLUDE SFALRF
91 : POINTEUR MYFALS.FALRFS
92 : CBEGININCLUDE SPOGAU
93 : SEGMENT POGAU
94 : CHARACTER*(LNNPG) NOMPG
95 : CHARACTER*(LNTPG) TYPMPG
96 : CHARACTER*(LNFPG) FORLPG
97 : INTEGER NORDPG
98 : REAL*8 XCOPG(NDLPG,NBPG)
99 : REAL*8 XPOPG(NBPG)
100 : ENDSEGMENT
101 : SEGMENT POGAUS
102 : POINTEUR LISPG(0).POGAU
103 : ENDSEGMENT
104 : CENDINCLUDE SPOGAU
105 : POINTEUR MYPGS.POGAUS
106 : POINTEUR PGCOUR.POGAU
107 : CBEGININCLUDE SMCHAEL
108 : SEGMENT MCHAEL
109 : POINTEUR IMACHE(N1).MELEME
110 : POINTEUR ICHEVA(N1).MCHEVA
111 : ENDSEGMENT
112 : SEGMENT MCHEVA
113 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
114 : ENDSEGMENT
115 : SEGMENT LCHEVA
116 : POINTEUR LISCHE(NBCHE).MCHEVA
117 : ENDSEGMENT
118 : CENDINCLUDE SMCHAEL
119 : POINTEUR FFPGV.MCHEVA
120 : POINTEUR DFFPGV.MCHEVA
121 : POINTEUR FFPGP.MCHEVA
122 : POINTEUR DFFPGP.MCHEVA
123 : C
124 : DATA TYPELT/'SEG2 ','TRI3 ','QUA4 ',
125 : & 'PRI6 ','CUB8 ','TET4 ','PYR5 ',
126 : C speciaux iso-P2 p1/p0
127 : & 'TRI6 ','PR18 ','TE10 ','PY14xxxx',
128 : C quadratiques
129 : & 'SEG3 ','TRI7 ','QUA9 ',
130 : & 'PR21 ','CU27 ','TE15 ','PY19xxxx',
131 : C lineaires b
132 : & 'TRI4 ','TET5 ',
133 : C cubiques
134 : & 'SEG4 '/
135 : C***
136 : *
137 : * Initialisation du segment contenant les informations sur les
138 : * éléments de référence.
139 : *
140 : * SEGINI MYLRFS.LISEL(*)
141 : IMPR=0
141 : CALL INLRFS(MYLRFS,IMPR,IRET)
142 : IF (IRET.NE.0) GOTO 9999
143 : *
144 : * Initialisation du segment contenant les informations sur les
145 : * méthodes d'intégration (type Gauss).
146 : *
147 : * SEGINI MYPGS.LISPG(*)
147 : CALL INPGS(MYPGS,IMPR,IRET)
148 : IF (IRET.NE.0) GOTO 9999
149 : *
150 : IZFFM=0
151 : IF(DISCR.EQ.'FONFORM0')THEN
152 : ITYPI=0
153 : ELSEIF(DISCR.EQ.'FONFORM ')THEN
154 : ITYPI=1
155 : ELSEIF(DISCR.EQ.'LOBATTO ')THEN
156 : ITYPI=2
157 : ELSE
158 : C Impossible d'utiliser cet opérateur pour la formulation %m1:8
159 : MOTERR(1:8) = DISCR
159 : CALL ERREUR(193)
160 : RETURN
161 : ENDIF
162 : C
163 : IES=IDIM
164 : NOM1=NOME(1:4)//' '
165 : NOM2=NOME(5:8)
166 : C WRITE(6,*)'KALPBG NOM1=',NOM1,' NOM2=',NOM2,':'
166 : CALL OPTLI(IP,TYPELT,NOM1,NBELT)
167 : C
168 : IF(IP.EQ.0)THEN
169 : WRITE(6,1981)NOME
170 : 1981 FORMAT(/10X,' SUB KALPBG : ',1X,A8,' TYPE D''ELEMENT NON ENCORE PR
171 : &EVU')
172 : RETURN
173 : ENDIF
174 : C
175 : GO TO (
176 : & 201 ,302 ,402 ,603 ,803 ,403 ,503 ,
177 : & 612 , 1813, 1013,1413,
178 : & 301 ,702 ,902 ,2103,2703,1503,1903,
179 : & 9402,9503,
180 : & 401),IP
181 : C
182 : C
183 : C100 CONTINUE
184 : C? NP=1
185 : C? NES=0
186 : C? NG=1
187 : C? NPG=1
188 : C? N1=0
189 : C? N2=2
189 : C? CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
189 : C? CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
190 : C? KZHR(1)=IPKKZZ
191 : C? NOMEL=TYPELT(IP)
192 : C? FN(1,1)=1.D0
193 : C? GO TO 1
194 : C************************** ELEMENTS LINE ******************************
195 :
196 : C SEG2
197 : 201 CONTINUE
198 : NP=2
199 : MP=1
200 : IF(NOM2.EQ.'P1P1')MP=2
201 : NES=1
202 : NG=2
203 : NPG=2
204 : IF(ITYPI.EQ.0)NG=1
205 : IF(ITYPI.EQ.0)NPG=1
206 : N1=1
207 : N2=2
207 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
207 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
207 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
208 : KZHR(1)=IPKKZZ
209 : KZHR(2)=IPKKZ2
210 : NOMEL=TYPELT(IP)
210 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
211 : KTP(1)=IZF1
211 : CALL PB201
212 : &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
213 : GO TO 1
214 :
215 : C TRI3
216 : 302 CONTINUE
217 : NP=3
218 : MP=1
219 : IF(NOM2.EQ.'P1P1')MP=3
220 : NES=2
221 : NPG=7
222 : IF(ITYPI.EQ.0)NPG=1
223 : IF(ITYPI.EQ.2)NPG=3
224 : N1=1
225 : N2=2
225 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
225 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
225 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
226 : KZHR(1)=IPKKZZ
227 : KZHR(2)=IPKKZ2
228 : NOMEL=TYPELT(IP)
228 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
229 : KTP(1)=IZF1
229 : CALL PB302
230 : &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI)
231 : GO TO 1
232 :
233 : C QUA4
234 : 402 CONTINUE
235 : NP=4
236 : MP=1
237 : IF(NOM2.EQ.'P1P1')MP=4
238 : NES=2
239 : NG=2
240 : NPG=4
241 : IF(ITYPI.EQ.0)NG=1
242 : IF(ITYPI.EQ.0)NPG=1
243 : N1=1
244 : N2=2
244 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
244 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
244 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
245 : KZHR(1)=IPKKZZ
246 : KZHR(2)=IPKKZ2
247 : NOMEL=TYPELT(IP)
247 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
248 : KTP(1)=IZF1
248 : CALL PB402
249 : &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
250 : GO TO 1
251 :
252 : C PRI6
253 : 603 CONTINUE
254 : NP=6
255 : MP=1
256 : IF(NOM2.EQ.'P1P1')MP=6
257 : NES=3
258 : NPG=6
259 : IF(ITYPI.EQ.0)NPG=1
260 : N1=1
261 : N2=2
261 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
261 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
261 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
262 : KZHR(1)=IPKKZZ
263 : KZHR(2)=IPKKZ2
263 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
264 : KTP(1)=IZF1
265 : NOMEL=TYPELT(IP)
265 : CALL PB603
266 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
267 : GOTO 1
268 :
269 : C CUB8
270 : 803 CONTINUE
271 : NP=8
272 : MP=1
273 : IF(NOM2.EQ.'P1P1')MP=8
274 : NES=3
275 : NG=2
276 : NPG=8
277 : IF(ITYPI.EQ.0)NG=1
278 : IF(ITYPI.EQ.0)NPG=1
279 : N1=1
280 : N2=2
280 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
280 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
280 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
281 : KZHR(1)=IPKKZZ
282 : KZHR(2)=IPKKZ2
282 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
283 : KTP(1)=IZF1
284 : NOMEL=TYPELT(IP)
284 : CALL PB803
285 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
286 : GO TO 1
287 :
288 : C TET4
289 : 403 CONTINUE
290 : NP=4
291 : MP=1
292 : IF(NOM2.EQ.'P1P1')MP=4
293 : NES=3
294 : NPG=4
295 : IF(ITYPI.EQ.0)NPG=1
296 : N1=1
297 : N2=2
297 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
297 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
297 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
298 : KZHR(1)=IPKKZZ
299 : KZHR(2)=IPKKZ2
299 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
300 : KTP(1)=IZF1
301 : NOMEL=TYPELT(IP)
301 : CALL PB403
302 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
303 : GO TO 1
304 :
305 : C PYR5
306 : 503 CONTINUE
307 : NP=5
308 : MP=1
309 : IF(NOM2.EQ.'P1P1')MP=5
310 : NES=3
311 : NPG=5
312 : IF(ITYPI.EQ.0)NPG=1
313 : N1=1
314 : N2=2
314 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
314 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
314 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
315 : KZHR(1)=IPKKZZ
316 : KZHR(2)=IPKKZ2
316 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
317 : KTP(1)=IZF1
318 : NOMEL=TYPELT(IP)
318 : CALL PB503
319 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
320 : GO TO 1
321 :
322 : C************************** ELEMENTS LINB ******************************
323 :
324 : C TRI4
325 : 9402 CONTINUE
326 : IMPR=0
326 : CALL FILRF('H1D1TR4',MYLRFS,ELVIT,IMPR,IRET)
327 : IF (IRET.NE.0) GOTO 9999
327 : CALL FILRF('H1D1TR3',MYLRFS,ELPRES,IMPR,IRET)
328 : IF (ITYPI.EQ.0) THEN
328 : CALL FIPG('GAT2-1-1',MYPGS,PGCOUR,IMPR,IRET)
329 : IF (IRET.NE.0) GOTO 9999
330 : ELSE
330 : CALL FIPG('GAT2-7-12',MYPGS,PGCOUR,IMPR,IRET)
331 : IF (IRET.NE.0) GOTO 9999
332 : ENDIF
333 : *
334 : * Calculons les fns de forme de réf. et leurs dérivées aux
335 : * points de Gauss pour chaque type d'éléments...
336 : *
336 : CALL KFNREF(ELVIT,PGCOUR,
337 : $ FFPGV,DFFPGV,
338 : $ IMPR,IRET)
339 : IF (IRET.NE.0) GOTO 9999
339 : CALL KFNREF(ELPRES,PGCOUR,
340 : $ FFPGP,DFFPGP,
341 : $ IMPR,IRET)
342 : IF (IRET.NE.0) GOTO 9999
343 : SEGACT PGCOUR
344 : SEGACT FFPGV
345 : SEGACT DFFPGV
346 : SEGACT FFPGP
347 : SEGACT DFFPGP
348 : NP =DFFPGV.VELCHE(/2)
349 : NES=DFFPGV.VELCHE(/4)
350 : NPG=DFFPGV.VELCHE(/5)
351 : MP =DFFPGP.VELCHE(/2)
352 : N1=1
353 : N2=2
353 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
353 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
353 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
354 : KZHR(1)=IPKKZZ
355 : KZHR(2)=IPKKZ2
355 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
356 : KTP(1)=IZF1
357 : NOMEL=TYPELT(IP)
357 : CALL BB302(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,
358 : $ FFPGV.VELCHE,DFFPGV.VELCHE,
359 : $ FFPGP.VELCHE,DFFPGP.VELCHE,
360 : $ X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
361 : SEGSUP FFPGV
362 : SEGSUP DFFPGV
363 : SEGSUP FFPGP
364 : SEGSUP DFFPGP
365 : SEGDES PGCOUR
366 : C NP=4
367 : C MP=3
368 : C NES=2
369 : C NPG=7
370 : C IF(ITYPI.EQ.0)NPG=1
371 : C MPG=NPG
372 : C N1=1
373 : C N2=2
373 : C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
373 : C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
373 : C CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
374 : C KZHR(1)=IPKKZZ
375 : C KZHR(2)=IPKKZ2
376 : C NOMEL=TYPELT(IP)
376 : C CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1)
377 : C KTP(1)=IZF1
377 : C CALL BB302(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,MPG)
378 : GO TO 1
379 :
380 : C TET5
381 : 9503 CONTINUE
382 : NP=5
383 : MP=4
384 : NES=3
385 : NPG=4
386 : IF(ITYPI.EQ.0)NG=1
387 : IF(ITYPI.EQ.0)NPG=1
388 : MPG=NPG
389 : N1=1
390 : N2=2
390 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
390 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
390 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
391 : KZHR(1)=IPKKZZ
392 : KZHR(2)=IPKKZ2
393 : NOMEL=TYPELT(IP)
393 : CALL ZDFM(MP,MPG,NES,IES,0,1,IZF1,1)
394 : KTP(1)=IZF1
394 : CALL BB403(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
395 : GO TO 1
396 :
397 : C************************** ELEMENTS MACRO *****************************
398 :
399 : C TRI6 Iso-P2 P1/P0
400 : 612 CONTINUE
401 :
402 : NP=6
403 : MP=3
404 : IF(NOM2.EQ.'MCP0')MP=1
405 : IF(NOM2.EQ.'MCP1')MP=3
406 : IF(NOM2.EQ.'MCF1')MP=3
407 : IF(ITYPI.EQ.0)MP=1
408 : NES=2
409 : NPG=7
410 : C NPG=3
411 : N1=1
412 : N2=2
412 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
412 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
412 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
413 : KZHR(1)=IPKKZZ
414 : KZHR(2)=IPKKZ2
415 : NOMEL=TYPELT(IP)
415 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
416 : KTP(1)=IZF1
416 : CALL PB342
417 : &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2)
418 : GO TO 1
419 :
420 : C QUA9 Iso-P2 P1/P0
421 : 912 CONTINUE
422 :
423 : MP=3
424 : IF(NOM2.EQ.'MCP0')MP=1
425 : IF(NOM2.EQ.'MCP1')MP=3
426 : IF(NOM2.EQ.'MCF1')MP=4
427 : IF(ITYPI.EQ.0)MP=1
428 : NP=9
429 : NES=2
430 : NG=2
431 : NPG=16
432 : N1=1
433 : N2=2
433 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
433 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
433 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
434 : KZHR(1)=IPKKZZ
435 : KZHR(2)=IPKKZ2
436 : NOMEL=TYPELT(IP)
436 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
437 : KTP(1)=IZF1
437 : CALL PB442
438 : &(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
439 : GO TO 1
440 :
441 : C CU27 Iso-P2 P1/P0
442 : 2713 CONTINUE
443 :
444 : MP=4
445 : IF(NOM2.EQ.'MCP0')MP=1
446 : IF(NOM2.EQ.'MCP1')MP=4
447 : IF(NOM2.EQ.'MCF1')MP=8
448 : IF(ITYPI.EQ.0)MP=1
449 : NP=27
450 : NES=3
451 : NG=2
452 : NPG=64
453 : C NG=1
454 : C NPG=8
455 : N1=1
456 : N2=2
456 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
456 : CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
456 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
457 : KZHR(1)=IPKKZZ
458 : KZHR(2)=IPKKZ2
459 : NOMEL=TYPELT(IP)
459 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
460 : KTP(1)=IZF1
460 : CALL PB883
461 : &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
462 : GO TO 1
463 :
464 : C PR18 Iso-P2 P1/P0
465 : 1813 CONTINUE
466 :
467 : MP=4
468 : IF(NOM2.EQ.'MCP0')MP=1
469 : IF(NOM2.EQ.'MCP1')MP=4
470 : IF(NOM2.EQ.'MCF1')MP=6
471 : IF(ITYPI.EQ.0)MP=1
472 : NP=18
473 : NES=3
474 : NG=6
475 : NPG=48
476 : C NG=1
477 : C NPG=8
478 : N1=1
479 : N2=2
479 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
479 : CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
479 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
480 : KZHR(1)=IPKKZZ
481 : KZHR(2)=IPKKZ2
482 : NOMEL=TYPELT(IP)
482 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
483 : KTP(1)=IZF1
483 : CALL PB663
484 : &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
485 : GO TO 1
486 :
487 : C TE10 Iso-P2 P1/P0
488 : 1013 CONTINUE
489 :
490 : MP=4
491 : IF(NOM2.EQ.'MCP0')MP=1
492 : IF(NOM2.EQ.'MCP1')MP=4
493 : IF(NOM2.EQ.'MCF1')MP=4
494 : IF(ITYPI.EQ.0)MP=1
495 : NP=10
496 : NES=3
497 : C NG=4
498 : C NPG=32
499 : NG=1
500 : NPG=8
501 : N1=1
502 : N2=2
502 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
502 : CALL ZDFM(NP,NPG,NES,IES,0 ,0 ,IPKKZZ,0)
502 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
503 : KZHR(1)=IPKKZZ
504 : KZHR(2)=IPKKZ2
505 : NOMEL=TYPELT(IP)
505 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
506 : KTP(1)=IZF1
506 : CALL PB443
507 : &(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
508 : GO TO 1
509 :
510 : C PY14 Iso-P2 P1/P0
511 : 1413 CONTINUE
512 : GO TO 1
513 :
514 : C************************** ELEMENTS QUAF ******************************
515 :
516 : C SEG3
517 : 301 CONTINUE
518 :
519 : MP=2
520 : IF(NOM2.EQ.'PRP0')MP=1
521 : IF(NOM2.EQ.'PRP1')MP=2
522 : IF(NOM2.EQ.'PFP1')MP=2
523 : IF(NOM2.EQ.'P1P1')MP=2
524 : NP=3
525 : NES=1
526 : NG=3
527 : NPG=3
528 : IF(ITYPI.EQ.0)THEN
529 : NG=2
530 : NPG=2
531 : ENDIF
532 : IF(NOM2.EQ.'MCF1')THEN
533 : NG=4
534 : NPG=4
535 : ENDIF
536 : N1=1
537 : N2=2
537 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
537 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
537 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
538 : KZHR(1)=IPKKZZ
539 : KZHR(2)=IPKKZ2
540 : NOMEL=TYPELT(IP)
540 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
541 : KTP(1)=IZF1
541 : CALL PB301
542 : &(XREF,X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
543 : GO TO 1
544 :
545 : C TRI7
546 : 702 CONTINUE
547 :
548 : MP=3
549 : IF(NOM2.EQ.'PRP0')MP=1
550 : IF(NOM2.EQ.'PRP1')MP=3
551 : IF(NOM2.EQ.'PFP1')MP=3
552 : NP=7
553 : NES=2
554 : NPG=7
555 : IF(ITYPI.EQ.0)NPG=1
556 : N1=1
557 : N2=2
557 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
557 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
557 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
558 : KZHR(1)=IPKKZZ
559 : KZHR(2)=IPKKZ2
559 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
560 : KTP(1)=IZF1
561 : NOMEL=TYPELT(IP)
561 : CALL PB702
562 : &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG,NOM2,ITYPI)
563 : GO TO 1
564 :
565 : C QUA9
566 : 902 CONTINUE
567 :
568 : IF(NOM2(1:2).EQ.'MC')GO TO 912
569 : MP=3
570 : IF(NOM2.EQ.'PRP0')MP=1
571 : IF(NOM2.EQ.'PRP1')MP=3
572 : IF(NOM2.EQ.'PFP1')MP=4
573 : IF(NOM2.EQ.'PRQ1')MP=4
574 : NP=9
575 : NES=2
576 : NG=4
577 : NPG=16
578 : IF(ITYPI.EQ.0)NG=3
579 : IF(ITYPI.EQ.0)NPG=9
580 : IF(ITYPI.EQ.2)NG=3
581 : IF(ITYPI.EQ.2)NPG=9
582 : N1=1
583 : N2=2
583 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
583 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
583 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
584 : KZHR(1)=IPKKZZ
585 : KZHR(2)=IPKKZ2
585 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
586 : KTP(1)=IZF1
587 : NOMEL=TYPELT(IP)
587 : CALL PB902
588 : &(XREF,X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2,ITYPI)
589 : GO TO 1
590 :
591 : C PR21
592 : 2103 CONTINUE
593 :
594 : MP=4
595 : IF(NOM2.EQ.'PRP0')MP=1
596 : IF(NOM2.EQ.'PRP1')MP=4
597 : IF(NOM2.EQ.'PFP1')MP=6
598 : NP=21
599 : NES=3
600 : NG=3
601 : NGT=7
602 : NPG=NG*NGT
603 : N1=1
604 : N2=2
604 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
604 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
604 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
605 : KZHR(1)=IPKKZZ
606 : KZHR(2)=IPKKZ2
606 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
607 : KTP(1)=IZF1
608 : NOMEL=TYPELT(IP)
608 : CALL PB2103
609 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG,NOM2)
610 : GO TO 1
611 :
612 : C CU27
613 : 2703 CONTINUE
614 :
615 : IF(NOM2(1:2).EQ.'MC')GO TO 2713
616 : MP=4
617 : IF(NOM2.EQ.'PRP0')MP=1
618 : IF(NOM2.EQ.'PRP1')MP=4
619 : IF(NOM2.EQ.'PFP1')MP=8
620 : NP=27
621 : NES=3
622 : NG=3
623 : NPG=27
624 : IF(ITYPI.EQ.0)NG=2
625 : IF(ITYPI.EQ.0)NPG=8
626 : N1=1
627 : N2=2
627 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
627 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
627 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
628 : KZHR(1)=IPKKZZ
629 : KZHR(2)=IPKKZ2
629 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
630 : KTP(1)=IZF1
631 : NOMEL=TYPELT(IP)
631 : CALL PB2703
632 : &(XREF,X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,NOM2)
633 : GO TO 1
634 :
635 : C TE15
636 : 1503 CONTINUE
637 : IMPR=0
637 : CALL FILRF('H1D2TE15',MYLRFS,ELVIT,IMPR,IRET)
638 : IF (IRET.NE.0) GOTO 9999
639 : IF (NOM2.EQ.'PRP0') THEN
639 : CALL FILRF('L2D0TE1',MYLRFS,ELPRES,IMPR,IRET)
640 : IF (IRET.NE.0) GOTO 9999
641 : ELSEIF (NOM2.EQ.'PRP1') THEN
641 : CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET)
642 : IF (IRET.NE.0) GOTO 9999
643 : ELSEIF (NOM2.EQ.'PFP1') THEN
643 : CALL FILRF('H1D1TE4',MYLRFS,ELPRES,IMPR,IRET)
644 : IF (IRET.NE.0) GOTO 9999
645 : ELSE
645 : CALL FILRF('L2D1TE4',MYLRFS,ELPRES,IMPR,IRET)
646 : IF (IRET.NE.0) GOTO 9999
647 : ENDIF
647 : CALL FIPG('GPT3-7-64',MYPGS,PGCOUR,IMPR,IRET)
648 : IF (IRET.NE.0) GOTO 9999
649 : *
650 : * Calculons les fns de forme de réf. et leurs dérivées aux
651 : * points de Gauss pour chaque type d'éléments...
652 : *
652 : CALL KFNREF(ELVIT,PGCOUR,
653 : $ FFPGV,DFFPGV,
654 : $ IMPR,IRET)
655 : IF (IRET.NE.0) GOTO 9999
655 : CALL KFNREF(ELPRES,PGCOUR,
656 : $ FFPGP,DFFPGP,
657 : $ IMPR,IRET)
658 : IF (IRET.NE.0) GOTO 9999
659 : SEGACT PGCOUR
660 : SEGACT FFPGV
661 : SEGACT DFFPGV
662 : SEGACT FFPGP
663 : SEGACT DFFPGP
664 : NP =DFFPGV.VELCHE(/2)
665 : NES=DFFPGV.VELCHE(/4)
666 : NPG=DFFPGV.VELCHE(/5)
667 : MP =DFFPGP.VELCHE(/2)
668 : N1=1
669 : N2=2
669 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
669 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
669 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
670 : KZHR(1)=IPKKZZ
671 : KZHR(2)=IPKKZ2
671 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
672 : KTP(1)=IZF1
673 : NOMEL=TYPELT(IP)
673 : CALL PB1503(XREF,PGCOUR.XCOPG,PGCOUR.XPOPG,
674 : $ FFPGV.VELCHE,DFFPGV.VELCHE,
675 : $ FFPGP.VELCHE,DFFPGP.VELCHE,
676 : $ X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
677 : SEGSUP FFPGV
678 : SEGSUP DFFPGV
679 : SEGSUP FFPGP
680 : SEGSUP DFFPGP
681 : SEGDES PGCOUR
682 : GO TO 1
683 :
684 : C PY19
685 : 1903 CONTINUE
686 : GO TO 1
687 :
688 : C************************** ELEMENTS QUAD ******************************
689 :
690 : C TRI6
691 : 602 CONTINUE
692 :
693 : C MP=3
694 : C NP=6
695 : C NES=2
696 : C NPG=7
697 : C IF(ITYPI.EQ.0)NPG=1
698 : C N1=1
699 : C N2=2
699 : C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
699 : C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
700 : C KZHR(1)=IPKKZZ
700 : C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
701 : C KTP(1)=IZF1
702 : C NOMEL=TYPELT(IP)
702 : C CALL PB602(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NPG)
703 : GO TO 1
704 :
705 : C QUA8
706 : 802 CONTINUE
707 :
708 : C MP=4
709 : C NP=8
710 : C NES=2
711 : C NG=3
712 : C NPG=9
713 : C IF(ITYPI.EQ.0)NG=2
714 : C IF(ITYPI.EQ.0)NPG=4
715 : C N1=1
716 : C N2=2
716 : C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
716 : C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
717 : C KZHR(1)=IPKKZZ
717 : C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
718 : C KTP(1)=IZF1
719 : C NOMEL=TYPELT(IP)
719 : C CALL PB802(X,Y,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)
720 : GO TO 1
721 :
722 : C PR15
723 : 11503 CONTINUE
724 :
725 : C MP=6
726 : C NP=15
727 : C NES=3
728 : C NG=3
729 : C NGT=7
730 : C NPG=NG*NGT
731 : C N1=1
732 : C N2=2
732 : C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
732 : C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
733 : C KZHR(1)=IPKKZZ
733 : C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
734 : C KTP(1)=IZF1
735 : C NOMEL=TYPELT(IP)
735 : C CALL PBPR15(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NGT,NPG)
736 : GO TO 1
737 :
738 : C CU20
739 : 2003 CONTINUE
740 :
741 : C MP=8
742 : C NP=20
743 : C NES=3
744 : C NG=3
745 : C NPG=27
746 : C IF(ITYPI.EQ.0)NG=2
747 : C IF(ITYPI.EQ.0)NPG=8
748 : C N1=1
749 : C N2=2
749 : C CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
749 : C CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
750 : C KZHR(1)=IPKKZZ
750 : C CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
751 : C KTP(1)=IZF1
752 : C NOMEL=TYPELT(IP)
752 : C CALL PB2003(X,Y,Z,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG)
753 : GO TO 1
754 :
755 : C TE10
756 : 1003 CONTINUE
757 : GO TO 1
758 :
759 : C************************** ELEMENTS CUBIC *****************************
760 :
761 : C SEG4
762 : 401 CONTINUE
763 :
764 : MP=3
765 : IF(NOM2.EQ.'PRP0')MP=1
766 : IF(NOM2.EQ.'PRP2')MP=3
767 : NP=4
768 : NES=1
769 : NG=4
770 : NPG=4
771 : IF(ITYPI.EQ.0)NG=3
772 : IF(ITYPI.EQ.0)NPG=3
773 : MPG=NPG
774 : N1=1
775 : N2=2
775 : CALL ZDFM(NP,NPG,NES,IES,N1,N2,IZFFM,1)
775 : CALL ZDFM(NP,NPG,NES,IES,0,0,IPKKZZ,0)
775 : CALL ZDFM(MP,NPG,NES,IES,0,0,IPKKZ2,0)
776 : KZHR(1)=IPKKZZ
777 : KZHR(2)=IPKKZ2
778 : NOMEL=TYPELT(IP)
778 : CALL ZDFM(MP,NPG,NES,IES,0,1,IZF1,1)
779 : KTP(1)=IZF1
779 : CALL PB401(X,PG,FN,GR,IZF1.FN,IZF1.GR,NES,NP,MP,NG,NPG,MPG)
780 : GO TO 1
781 :
782 :
783 : 1 CONTINUE
784 : SEGACT MYLRFS*MOD
785 : SEGSUP MYLRFS.LISEL(*)
786 : SEGSUP MYLRFS
787 : SEGACT MYPGS*MOD
788 : SEGSUP MYPGS.LISPG(*)
789 : SEGSUP MYPGS
790 : C write(6,*)' Retour KALPBG'
791 : RETURN
792 : *
793 : * Error handling
794 : *
795 : 9999 CONTINUE
796 : WRITE(IOIMP,*) 'An error was detected in kalpbg.eso'
797 : * 153 2
798 : * Opération illicite dans ce contexte
798 : CALL ERREUR(153)
799 : RETURN
800 : END
801 :
802 :
803 :
804 :
805 :
806 :
© Cast3M 2003 - All rights reserved.
Disclaimer