1 : C CALP2 SOURCE CHAT 11/03/16 21:16:20 6902
2 : SUBROUTINE CALP2(IPTR1,IPTR2,IPMODL,LOC,IPTR4)
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8 (A-H,O-Z)
5 : *-----------------------------------------------------------
6 : *
7 : * APPELE PAR CALP
8 : *
9 : * AUTEUR : J.BRUN (AVRIL 90)
10 : *
11 : * PARTIE CALCUL EN PEAU DES DEFORMATIONS
12 : *
13 : *-----------------------------------------------------------
14 : * PARAMETRES :
15 : * IPTR1 : POINTEUR SUR UN MCHAML DE TYPE CONTRAINTE
16 : * IPTR2 : POINTEUR SUR UN MCHAML DE TYPE CARACTERISTIQUE
17 : * IPMODL : POINTEUR SUR UN SEGMENT MMODEL
18 : * LOC : MOT CLE INDIQUANT LE PLAN DE SORTIE DES R{SULTATS
19 : * SUPE PEAU SUP
20 : * MOYE PLAN MOYEN
21 : * INFE PEAU INF
22 : * IPTR4 : POINTEUR SUR UN MCHMAL DU MEME TYPE QUE CELUI D'IPTR1
23 : * (SORTIE)
24 : *
25 : -INC SMMODEL
26 : -INC SMCHAML
27 : -INC SMELEME
28 : -INC CCOPTIO
29 : -INC CCHAMP
30 : -INC CCGEOME
31 : -INC SMCOORD
32 : -INC SMINTE
33 : *
34 : SEGMENT MPTVAL
35 : INTEGER IPOS(NS) ,NSOF(NS)
36 : INTEGER IVAL(NCOSOU)
37 : CHARACTER*16 TYVAL(NCOSOU)
38 : ENDSEGMENT
39 : *
40 : SEGMENT NOTYPE
41 : CHARACTER*16 TYPE(NBTYPE)
42 : ENDSEGMENT
43 : *
44 : PARAMETER ( NINF=3 )
45 : INTEGER INFOS(NINF)
46 : CHARACTER*4 LOC
47 : CHARACTER*(NCONCH) CONM
48 : LOGICAL LSUPNO
49 : C
50 : IPTR4 = 0
51 : IF (LOC.EQ.'SUPE') THEN
52 : I_LOC = 1
53 : ELSE IF (LOC.EQ.'MOYE') THEN
54 : I_LOC = 2
55 : ELSE IF (LOC.EQ.'INFE') THEN
56 : I_LOC = 3
57 : ELSE
57 : CALL ERREUR(5)
58 : RETURN
59 : ENDIF
60 : C
61 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE DEFORMATIONS
62 : C
62 : CALL QUESUP(IPMODL,IPTR1,5,0,ISUP1,IRET)
63 : IF (ISUP1.GT.1) RETURN
64 : C
65 : C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
66 : C
66 : CALL QUESUP(IPMODL,IPTR2,3,0,ISUP2,IRET1)
67 : IF (ISUP2.GT.1) RETURN
68 :
69 : NHRM=NIFOUR
70 : C
71 : C ACTIVATION DU MODELE
72 : C
73 : MMODEL=IPMODL
74 : SEGACT MMODEL
75 : NSOUS=KMODEL(/1)
76 : C
77 : C CREATION DU MCHELM
78 : C
79 : N1=NSOUS
80 : L1=12
81 : N3=6
82 : SEGINI MCHELM
83 : TITCHE='DEFORMATIONS'
84 : IFOCHE=IFOUR
85 :
86 : *----------------------------------------------------------
87 : * TRAITEMENT POUR CHAQUE SOUS ZONE DU MODELE ORIGINE
88 : *
89 : DO 1 NS=1,NSOUS
90 :
91 : * INITIALISATION
92 : IVADEF=0
93 : IVACAR=0
94 : MODEFO=0
95 : MOCARA=0
96 : lsupno=.false.
97 :
98 : IMODEL=KMODEL(NS)
99 : SEGACT IMODEL
100 : MELE=NEFMOD
100 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
101 : MFR=INFELE(13)
102 : NBPGAU=INFELE(4)
103 : * MINTE=INFELE(11)
104 : minte=infmod(7)
105 : IPMING=MINTE
106 : IPPORE=0
107 : IF(MFR.EQ.33) IPPORE=NBNNE(NUMGEO(MELE))
108 : *
109 : MELEME=IMAMOD
110 : SEGACT MELEME
111 : NBELEM=NUM(/2)
112 : SEGDES MELEME
113 : IPMAIL=IMAMOD
114 : CONM =CONMOD
115 : IMACHE(NS)=IPMAIL
116 : CONCHE(NS)=CONMOD
117 : C
118 : C COQUE INTEGREE OU PAS ?
119 : C
120 : IF(INFMOD(/1).NE.0)THEN
121 : NPINT=INFMOD(1)
122 : ELSE
123 : NPINT=0
124 : ENDIF
125 : IF (NPINT.NE.0)THEN
126 : IF (I_LOC.EQ.2) THEN
127 : IF (MOD(INFMOD(1),2).EQ.0) THEN
127 : CALL ERREUR(722)
128 : RETURN
129 : ENDIF
130 : IENT1=(INFMOD(1)+1)/2
131 : IERR1=0
131 : CALL EXTRSK(IPTR1,IMODEL,NS,MCHELM,IENT1,IERR1)
132 : IF (IERR1.NE.0) GO TO 9990
133 : GO TO 1
134 : ELSE IF (I_LOC.EQ.1) THEN
135 : IENT1=INFMOD(1)
136 : IERR1=0
136 : CALL EXTRSK(IPTR1,IMODEL,NS,MCHELM,IENT1,IERR1)
137 : IF (IERR1.NE.0) GO TO 9990
138 : GO TO 1
139 : ELSE IF (I_LOC.EQ.3) THEN
140 : IERR1=0
140 : CALL EXTRSK(IPTR1,IMODEL,NS,MCHELM,1,IERR1)
141 : IF (IERR1.NE.0) GO TO 9990
142 : GO TO 1
143 : ENDIF
144 : ENDIF
145 : C
146 : C CREATION DU TABLEAU INFOS
147 : C
147 : CALL IDENT(IPMAIL,CONM,IPTR1,IPTR2,INFOS,IRTD)
148 : IF (IRTD.EQ.0) GOTO 9990
149 : C
150 : INFCHE(NS,1)=1
151 : INFCHE(NS,2)=0
152 : INFCHE(NS,3)=NHRM
153 : INFCHE(NS,4)=MINTE
154 : INFCHE(NS,5)=1
155 : INFCHE(NS,6)=5
156 : C____________________________________________________________________
157 : C
158 : C RECHERCHE DES NOMS DE COMPOSANTES
159 : C____________________________________________________________________
160 : C
161 : if(lnomid(5).ne.0) then
162 : nomid=lnomid(5)
163 : segact nomid
164 : ndef=lesobl(/2)
165 : nfac=lesfac(/2)
166 : modefo=nomid
167 : else
168 : lsupno=.true.
168 : CALL IDDEFO(IMODEL,IFOUR,MODEFO,NDEF,NFAC)
169 : endif
170 : C
171 : C VERIFICATION DE LEUR PRESENCE
172 : C____________________________________________________________________
173 : C
174 : NBTYPE=1
175 : SEGINI NOTYPE
176 : MOTYPE=NOTYPE
177 : TYPE(1)='REAL*8'
177 : CALL KOMCHA(IPTR1,IPMAIL,CONM,MODEFO,MOTYPE,1,INFOS,3,IVADEF)
178 : SEGSUP NOTYPE
179 : IF (IERR.NE.0) GOTO 9990
180 : *
181 : SEGACT,MINTE
182 : IF (ISUP1.EQ.1) THEN
182 : CALL VALCHE(IVADEF,NDEF,IPMING,IPPORE)
183 : ENDIF
184 : C
185 : C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
186 : C
187 : N1PTEL=0
188 : N1EL=0
189 : MPTVAL=IVADEF
190 : DO 110 IO=1,NDEF
191 : MELVAL=IVAL(IO)
192 : N1PTEL=MAX(N1PTEL,VELCHE(/1))
193 : N1EL =MAX(N1EL ,VELCHE(/2))
194 : 110 CONTINUE
195 : NBGSTR=N1PTEL
196 : IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
197 : N1PTEL=1
198 : ELSE
199 : N1PTEL=NBPGAU
200 : ENDIF
201 : NBPTEL=N1PTEL
202 : NEL=N1EL
203 : C____________________________________________________________________
204 : C
205 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES *
206 : C____________________________________________________________________
207 : C
208 : NBROBL=0
209 : NBRFAC=0
210 : NOMID=0
211 : IVECT=0
212 : *
213 : * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
214 : *
215 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
216 : NBROBL=1
217 : NBRFAC=1
218 : SEGINI NOMID
219 : LESOBL(1)='EPAI'
220 : LESFAC(1)='EXCE'
221 : *
222 : NBTYPE=1
223 : SEGINI NOTYPE
224 : TYPE(1)='REAL*8'
225 : *
226 : * CARACTERISTIQUES POUR LES POUTRES
227 : *
228 : ELSE IF (MFR.EQ.7 ) THEN
229 : NBROBL=2
230 : NBRFAC=0
231 : SEGINI NOMID
232 : LESOBL(1)='DY '
233 : LESOBL(2)='DZ '
234 : *
235 : NBTYPE=1
236 : SEGINI NOTYPE
237 : TYPE(1)='REAL*8'
238 : *
239 : * CARACTERISTIQUES POUR LES TUYAUX
240 : *
241 : ELSE IF (MFR.EQ.13) THEN
242 : NBROBL=2
243 : NBRFAC=2
244 : SEGINI NOMID
245 : LESOBL(1)='EPAI'
246 : LESOBL(2)='RAYO'
247 : LESFAC(1)='RACO'
248 : LESFAC(2)='PRES'
249 : *
250 : NBTYPE=1
251 : SEGINI NOTYPE
252 : TYPE(1)='REAL*8'
253 : ENDIF
254 : *
255 : MOCARA=NOMID
256 : NCARA=NBROBL
257 : NCARF=NBRFAC
258 : NCARR=NCARA+NCARF
259 : IF (MOCARA.NE.0) THEN
260 : MOTYPE=NOTYPE
260 : CALL KOMCHA(IPTR2,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,
261 : $ IVACAR)
262 : SEGSUP NOTYPE
263 : IF (IERR.NE.0) GOTO 9990
264 : *
265 : IF (ISUP2.EQ.1) THEN
265 : CALL VALCHE(IVACAR,NCARR,IPMING,IPPORE)
266 : ENDIF
267 : ENDIF
268 :
269 : N2=6
270 : SEGINI MCHAML
271 : ICHAML(NS)=MCHAML
272 : NOMCHE(1)='EPXX'
273 : TYPCHE(1)='REAL*8'
274 : NOMCHE(2)='EPYY'
275 : TYPCHE(2)='REAL*8'
276 : NOMCHE(3)='EPZZ'
277 : TYPCHE(3)='REAL*8'
278 : NOMCHE(4)='RTXY'
279 : TYPCHE(4)='REAL*8'
280 : NOMCHE(5)='RTYZ'
281 : TYPCHE(5)='REAL*8'
282 : NOMCHE(6)='RTXZ'
283 : TYPCHE(6)='REAL*8'
284 : N2PTEL=0
285 : N2EL=0
286 :
287 : *-----------------------------------------------------------
288 : * CHAQUE MELVAL = COMPOSANTE SELON SIGMA
289 : *
290 : SEGINI MELVA1,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6
291 : IELVAL(1)=MELVA1
292 : IELVAL(2)=MELVA2
293 : IELVAL(3)=MELVA3
294 : IELVAL(4)=MELVA4
295 : IELVAL(5)=MELVA5
296 : IELVAL(6)=MELVA6
297 : *
298 : *--
299 : * BRANCHEMENT SELON ELEMENT FINI
300 : *--
301 : * COQ3,COQ2,DKT
302 : IF ((MELE.EQ.27).OR.(MELE.EQ.28).OR.(MELE.EQ.44)) GOTO 3000
303 : * POUTRE
304 : IF (MELE.EQ.29) GOTO 2000
305 : * COQ4 ,DST
306 : IF (MELE.EQ.49.OR.MELE.EQ.93) GOTO 5000
307 : *--
308 : * AUCUNE CREATION CAR NE SAIT PAS FAIRE POUR L'ELEMENT
309 : *--
310 : MOTERR(1:4) =NOMTP(MELE)
311 : MOTERR(5:12)='CALP '
311 : CALL ERREUR(86)
312 : SEGSUP MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
313 : GOTO 9990
314 : *
315 : *-----------------------------------------------------------
316 : * POUTRE+DEFORMATION
317 : *-----------------------------------------------------------
318 : 2000 CONTINUE
319 : DO 2010 N2=1,NEL
320 : DO 2011 N1=1,NBPTEL
321 : *
322 : MPTVAL=IVADEF
323 : *
324 : MELVAL=IVAL(1)
325 : EPS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
326 : *
327 : MELVAL=IVAL(2)
328 : GXY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
329 : *
330 : MELVAL=IVAL(3)
331 : GXZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
332 : *
333 : MELVAL=IVAL(4)
334 : CX=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
335 : *
336 : MELVAL=IVAL(5)
337 : CY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
338 : *
339 : MELVAL=IVAL(6)
340 : CZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
341 : *
342 : MPTVAL=IVACAR
343 : *
344 : MELVAL=IVAL(1)
345 : PY=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
346 : MELVAL=IVAL(2)
347 : PZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
348 : *
349 : * CALCUL DES CONTRAINTES REELLES
350 : MELVA1.VELCHE(N1,N2)=EPS-(PY*CZ)+(PZ*CY)
351 : MELVA2.VELCHE(N1,N2)=0.
352 : MELVA3.VELCHE(N1,N2)=0.
353 : MELVA4.VELCHE(N1,N2)=GXY
354 : MELVA5.VELCHE(N1,N2)=0.
355 : MELVA6.VELCHE(N1,N2)=GXZ
356 : 2011 CONTINUE
357 : 2010 CONTINUE
358 : *
359 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
360 : *
361 : GOTO 510
362 : *
363 : *-----------------------------------------------------------
364 : * COQ2,COQ3,DKT + DEFORMATIONS
365 : *-----------------------------------------------------------
366 : 3000 CONTINUE
367 : IF (IFOUR.EQ.2.OR.IFOUR.EQ.1) THEN
368 : DO 3010 N2=1,NEL
369 : DO 3011 N1=1,NBPTEL
370 : *
371 : MPTVAL=IVADEF
372 : *
373 : MELVAL=IVAL(1)
374 : EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
375 : *
376 : MELVAL=IVAL(2)
377 : EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
378 : *
379 : MELVAL=IVAL(3)
380 : GAST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
381 : *
382 : MELVAL=IVAL(4)
383 : RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
384 : *
385 : MELVAL=IVAL(5)
386 : RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
387 : *
388 : MELVAL=IVAL(6)
389 : RTST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
390 : *
391 : MPTVAL=IVACAR
392 : *
393 : MELVAL=IVAL(1)
394 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
395 : *
396 : IF (I_LOC.EQ.3) THEN
397 : r_z = 0.5 * EPAI
398 : MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
399 : MELVA2.VELCHE(N1,N2)=EPTT-r_z*RTTT
400 : MELVA3.VELCHE(N1,N2)=0.
401 : MELVA4.VELCHE(N1,N2)=GAST-r_z*RTST
402 : MELVA5.VELCHE(N1,N2)=0.
403 : MELVA6.VELCHE(N1,N2)=0.
404 : ELSE IF (I_LOC.EQ.1) THEN
405 : r_z = 0.5 * EPAI
406 : MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
407 : MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
408 : MELVA3.VELCHE(N1,N2)=0.
409 : MELVA4.VELCHE(N1,N2)=GAST+r_z*RTST
410 : MELVA5.VELCHE(N1,N2)=0.
411 : MELVA6.VELCHE(N1,N2)=0.
412 : ELSE IF (I_LOC.EQ.2) THEN
413 : MELVA1.VELCHE(N1,N2)=EPSS
414 : MELVA2.VELCHE(N1,N2)=EPTT
415 : MELVA3.VELCHE(N1,N2)=0.
416 : MELVA4.VELCHE(N1,N2)=GAST
417 : MELVA5.VELCHE(N1,N2)=0.
418 : MELVA6.VELCHE(N1,N2)=0.
419 : ENDIF
420 : 3011 CONTINUE
421 : 3010 CONTINUE
422 : ENDIF
423 : *
424 : IF (IFOUR.EQ.0) THEN
425 : DO 3012 N2=1,NEL
426 : DO 3013 N1=1,NBPTEL
427 : *
428 : MPTVAL=IVADEF
429 : *
430 : MELVAL=IVAL(1)
431 : EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
432 : *
433 : MELVAL=IVAL(2)
434 : EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
435 : *
436 : MELVAL=IVAL(3)
437 : RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
438 : *
439 : MELVAL=IVAL(4)
440 : RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
441 : *
442 : MPTVAL=IVACAR
443 : *
444 : MELVAL=IVAL(1)
445 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
446 : *
447 : IF (I_LOC.EQ.3) THEN
448 : r_z = 0.5 * EPAI
449 : MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
450 : MELVA2.VELCHE(N1,N2)=EPTT-r_z*RTTT
451 : MELVA3.VELCHE(N1,N2)=0.
452 : MELVA4.VELCHE(N1,N2)=0.
453 : MELVA5.VELCHE(N1,N2)=0.
454 : MELVA6.VELCHE(N1,N2)=0.
455 : ELSE IF (I_LOC.EQ.1) THEN
456 : r_z = 0.5 * EPAI
457 : MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
458 : MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
459 : MELVA3.VELCHE(N1,N2)=0.
460 : MELVA4.VELCHE(N1,N2)=0.
461 : MELVA5.VELCHE(N1,N2)=0.
462 : MELVA6.VELCHE(N1,N2)=0.
463 : ELSE IF (I_LOC.EQ.2) THEN
464 : MELVA1.VELCHE(N1,N2)=EPSS
465 : MELVA2.VELCHE(N1,N2)=EPTT
466 : MELVA3.VELCHE(N1,N2)=0.
467 : MELVA4.VELCHE(N1,N2)=0.
468 : MELVA5.VELCHE(N1,N2)=0.
469 : MELVA6.VELCHE(N1,N2)=0.
470 : ENDIF
471 : 3013 CONTINUE
472 : 3012 CONTINUE
473 : ENDIF
474 : *
475 : IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN
476 : DO 3014 N2=1,NEL
477 : DO 3015 N1=1,NBPTEL
478 : *
479 : MPTVAL=IVADEF
480 : *
481 : MELVAL=IVAL(1)
482 : EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
483 : *
484 : MELVAL=IVAL(2)
485 : EPZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
486 : *
487 : MELVAL=IVAL(3)
488 : RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
489 : *
490 : MELVAL=IVAL(4)
491 : RTZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
492 : *
493 : MPTVAL=IVACAR
494 : *
495 : MELVAL=IVAL(1)
496 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
497 : *
498 : IF (I_LOC.EQ.3) THEN
499 : r_z = 0.5 * EPAI
500 : MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
501 : MELVA2.VELCHE(N1,N2)=EPZZ-r_z*RTZZ
502 : MELVA3.VELCHE(N1,N2)=0.
503 : MELVA4.VELCHE(N1,N2)=0.
504 : MELVA5.VELCHE(N1,N2)=0.
505 : MELVA6.VELCHE(N1,N2)=0.
506 : ELSE IF (I_LOC.EQ.1) THEN
507 : r_z = 0.5 * EPAI
508 : MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
509 : MELVA2.VELCHE(N1,N2)=EPZZ+r_z*RTZZ
510 : MELVA3.VELCHE(N1,N2)=0.
511 : MELVA4.VELCHE(N1,N2)=0.
512 : MELVA5.VELCHE(N1,N2)=0.
513 : MELVA6.VELCHE(N1,N2)=0.
514 : ELSE IF (I_LOC.EQ.2) THEN
515 : MELVA1.VELCHE(N1,N2)=EPSS
516 : MELVA2.VELCHE(N1,N2)=EPZZ
517 : MELVA3.VELCHE(N1,N2)=0.
518 : MELVA4.VELCHE(N1,N2)=0.
519 : MELVA5.VELCHE(N1,N2)=0.
520 : MELVA6.VELCHE(N1,N2)=0.
521 : ENDIF
522 : 3015 CONTINUE
523 : 3014 CONTINUE
524 : ENDIF
525 : IF (IFOUR.EQ.-3) THEN
526 : DO 3016 N2=1,NEL
527 : DO 3017 N1=1,NBPTEL
528 : *
529 : MPTVAL=IVADEF
530 : *
531 : MELVAL=IVAL(1)
532 : EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
533 : *
534 : MELVAL=IVAL(2)
535 : EPZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
536 : *
537 : MELVAL=IVAL(3)
538 : RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
539 : *
540 : MELVAL=IVAL(4)
541 : RTZZ=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
542 : *
543 : MPTVAL=IVACAR
544 : *
545 : MELVAL=IVAL(1)
546 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
547 : *
548 : IF (I_LOC.EQ.3) THEN
549 : r_z = 0.5 * EPAI
550 : MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
551 : MELVA2.VELCHE(N1,N2)=0.
552 : MELVA3.VELCHE(N1,N2)=EPZZ-r_z*RTZZ
553 : MELVA4.VELCHE(N1,N2)=0.
554 : MELVA5.VELCHE(N1,N2)=0.
555 : MELVA6.VELCHE(N1,N2)=0.
556 : ELSE IF (I_LOC.EQ.1) THEN
557 : r_z = 0.5 * EPAI
558 : MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
559 : MELVA2.VELCHE(N1,N2)=0.
560 : MELVA3.VELCHE(N1,N2)=EPZZ+r_z*RTZZ
561 : MELVA4.VELCHE(N1,N2)=0.
562 : MELVA5.VELCHE(N1,N2)=0.
563 : MELVA6.VELCHE(N1,N2)=0.
564 : ELSE IF (I_LOC.EQ.2) THEN
565 : MELVA1.VELCHE(N1,N2)=EPSS
566 : MELVA2.VELCHE(N1,N2)=0.
567 : MELVA3.VELCHE(N1,N2)=EPZZ
568 : MELVA4.VELCHE(N1,N2)=0.
569 : MELVA5.VELCHE(N1,N2)=0.
570 : MELVA6.VELCHE(N1,N2)=0.
571 : ENDIF
572 : 3017 CONTINUE
573 : 3016 CONTINUE
574 : ENDIF
575 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
576 : GOTO 510
577 : *-----------------------------------------------------------
578 : * COQ4,DST + DEFORMATIONS
579 : *-----------------------------------------------------------
580 : 5000 CONTINUE
581 : DO 5010 N2=1,NEL
582 : DO 5011 N1=1,NBPTEL
583 : *
584 : MPTVAL=IVADEF
585 :
586 : MELVAL=IVAL(1)
587 : EPSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
588 : *
589 : MELVAL=IVAL(2)
590 : EPTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
591 : *
592 : MELVAL=IVAL(3)
593 : GAST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
594 : *
595 : MELVAL=IVAL(4)
596 : RTSS=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
597 :
598 : MELVAL=IVAL(5)
599 : RTTT=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
600 : *
601 : MELVAL=IVAL(6)
602 : RTST=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
603 : *
604 : MELVAL=IVAL(7)
605 : GASN=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
606 : *
607 : MELVAL=IVAL(8)
608 : GATN=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
609 : *
610 : MPTVAL=IVACAR
611 : *
612 : MELVAL=IVAL(1)
613 : EPAI=VELCHE(MIN(N1,VELCHE(/1)),MIN(N2,VELCHE(/2)))
614 : *
615 : IF (I_LOC.EQ.3) THEN
616 : r_z = 0.5 * EPAI
617 : MELVA1.VELCHE(N1,N2)=EPSS-r_z*RTSS
618 : MELVA2.VELCHE(N1,N2)=EPTT-r_z*RTTT
619 : MELVA3.VELCHE(N1,N2)=0.
620 : MELVA4.VELCHE(N1,N2)=GAST-r_z*RTST
621 : MELVA5.VELCHE(N1,N2)=GATN
622 : MELVA6.VELCHE(N1,N2)=GASN
623 : ELSE IF (I_LOC.EQ.1) THEN
624 : r_z = 0.5 * EPAI
625 : MELVA1.VELCHE(N1,N2)=EPSS+r_z*RTSS
626 : MELVA2.VELCHE(N1,N2)=EPTT+r_z*RTTT
627 : MELVA3.VELCHE(N1,N2)=0.
628 : MELVA4.VELCHE(N1,N2)=GAST+r_z*RTST
629 : MELVA5.VELCHE(N1,N2)=GATN
630 : MELVA6.VELCHE(N1,N2)=GASN
631 : ELSE IF (I_LOC.EQ.2) THEN
632 : MELVA1.VELCHE(N1,N2)=EPSS
633 : MELVA2.VELCHE(N1,N2)=EPTT
634 : MELVA3.VELCHE(N1,N2)=0.
635 : MELVA4.VELCHE(N1,N2)=GAST
636 : MELVA5.VELCHE(N1,N2)=GATN
637 : MELVA6.VELCHE(N1,N2)=GASN
638 : ENDIF
639 :
640 : 5011 CONTINUE
641 : 5010 CONTINUE
642 : *
643 : SEGDES MELVA1,MELVA2,MELVA2,MELVA3,MELVA4,MELVA5,MELVA6,MCHAML
644 : C_______________________________________________________________________
645 : C
646 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE NS
647 : C_______________________________________________________________________
648 : C
649 : 510 CONTINUE
650 : C
651 : 9990 CONTINUE
652 : SEGDES IMODEL
653 : SEGDES,MINTE
654 : *
655 : IF (ISUP1.EQ.1) THEN
655 : CALL DTMVAL(IVADEF,3)
656 : ELSE
656 : CALL DTMVAL(IVADEF,1)
657 : ENDIF
658 : *
659 : IF (ISUP2.EQ.1) THEN
659 : CALL DTMVAL(IVACAR,3)
660 : ELSE
660 : CALL DTMVAL(IVACAR,1)
661 : ENDIF
662 : NOMID=MODEFO
663 : IF (lsupno.and.MODEFO.NE.0)SEGSUP NOMID
664 : NOMID=MOCARA
665 : IF (MOCARA.NE.0) SEGSUP NOMID
666 :
667 : * EN CAS D'ERREUR
668 : IF (IERR.NE.0) THEN
669 : SEGSUP,MCHELM
670 : IPTR4 = 0
671 : GOTO 999
672 : ENDIF
673 :
674 : 1 CONTINUE
675 : *
676 : SEGDES,MCHELM
677 : IPTR4 = MCHELM
678 :
679 : 999 CONTINUE
680 : SEGDES,MMODEL
681 : *
682 : RETURN
683 : END
684 :
685 :
686 :
© Cast3M 2003 - All rights reserved.
Disclaimer