1 : C HOOK2D SOURCE AM 12/03/15 21:24:56 7321
2 : SUBROUTINE HOOK2D(IPMODE,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
3 : 1 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
4 : 2 LHOOK,LHOO2,LW,LASURF,IPORE,IRET)
5 : C_______________________________________________________________________
6 : C
7 : C Calcul de la matrice de HOOKE
8 : C
9 : C Entr{es:
10 : C ________
11 : C
12 : C IPMODE Pointeur sur un segment imodel
13 : C CMATE Type du mat{riau (isotrope, orthotrope .....)
14 : C INAT Numero de plasticite
15 : C MFR Numero de formulation
16 : C IVAMAT Pointeur sur un tableau de MELVAL de MATERIAU
17 : C NMATT Nombre de composantes de materiau
18 : C IVACAR Pointeur sur un tableau de MELVAL de CARACTERISTIQUES
19 : C NCARR Nombre de composantes de caracteristiques
20 : C NPINT Nombre de points d integration
21 : C IVARI Pointeur sur un tableau de MELVAL de VARIABLES INTERNES
22 : C NVART Nombre de composantes de variables internes
23 : C IVAHOO Pointeur sur le MELVAL de HOOKE
24 : C NBPGAU Nombre de points d integration
25 : C LHOOK Taille de la matrice de HOOKE
26 : C LHOO2 Taille au carre de la matrice de HOOKE
27 : C LW Taille du tableau de travail WORK
28 : C LASURF 1 si on veut la matrice en surface de ref, 0 sinon
29 : C IPORE dimension pour milieux poreux
30 : C
31 : C Sorties:
32 : C ________
33 : C
34 : C IRET=1 OU 0 suivant succes ou pas
35 : C
36 : C
37 : C CODE L EBERSOLT MAI 84
38 : C
39 : C Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90
40 : C ADDITION DES MATERIAUX ORTHOTROPE ET ANISOTROPE
41 : C PAR P.DOWLATYARI DEC. 90
42 : C_______________________________________________________________________
43 : C
44 : IMPLICIT INTEGER(I-N)
45 : IMPLICIT REAL*8(A-H,O-Z)
46 : -INC SMCHAML
47 : -INC SMLREEL
48 : -INC CCHAMP
49 : -INC CCOPTIO
50 : -INC SMMODEL
51 : -INC SMELEME
52 : -INC SMCOORD
53 : -INC SMINTE
54 : *
55 : SEGMENT MPTVAL
56 : INTEGER IPOS(NS) ,NSOF(NS)
57 : INTEGER IVAL(NCOSOU)
58 : CHARACTER*16 TYVAL(NCOSOU)
59 : ENDSEGMENT
60 : *
61 : SEGMENT WRK2
62 : REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
63 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM)
64 : REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
65 : ENDSEGMENT
66 : *
67 : SEGMENT WRK4
68 : REAL*8 SHPWRK(6,NBNN), BGENE(NSTRS,LRE)
69 : REAL*8 BPSS(3,3), XEL(3,NBNN)
70 : ENDSEGMENT
71 : *
72 : SEGMENT TRAV
73 : REAL*8 VALCAR(LW),VALMAT(NMATT),VAR(NVART)
74 : REAL*8 DDHOOK(LHOOK,LHOOK),DDHOMU(LHOOK,LHOOK)
75 : REAL*8 COBMA(LHOOK)
76 : ENDSEGMENT
77 : C
78 : DIMENSION CRIGI(12),CMASS(12),S(20)
79 : CHARACTER*8 CMATE
80 : PARAMETER(XZER=0.D0,X774=.774596669241483D0)
81 : C
82 : IRET=1
83 : IGAU=0
84 : IB =0
85 : IMODEL=IPMODE
86 : MELE=NEFMOD
87 : C
88 : C RECUPERATION DES TAILLES DE TABLEAUX
89 : C
90 : MELVAL=IVAHOO
91 : NBPTEL=IELCHE(/1)
92 : NEL =IELCHE(/2)
93 : MPTVAL=IVAMAT
94 : NBGMAT = 0
95 : NELMAT = 0
96 : DO 1000 IM=1,NMATT
97 : IF(IVAL(IM).NE.0)THEN
98 : MELVAL=IVAL(IM)
99 : IF(CMATE.EQ.'SECTION')THEN
100 : NBGMAT=MAX(NBGMAT,IELCHE(/1))
101 : NELMAT=MAX(NELMAT,IELCHE(/2))
102 : ELSE
103 : NBGMAT=MAX(NBGMAT,VELCHE(/1))
104 : NELMAT=MAX(NELMAT,VELCHE(/2))
105 : ENDIF
106 : ENDIF
107 : 1000 CONTINUE
108 : MPTVAL=IVACAR
109 : DO 1001 IO=1,NCARR
110 : IF(IVAL(IO).NE.0)THEN
111 : MELVAL=IVAL(IO)
112 : IF (CMATE.EQ.'SECTION') THEN
113 : NBGMAT=MAX(NBGMAT,IELCHE(/1))
114 : NELMAT=MAX(NELMAT ,IELCHE(/2))
115 : ELSE
116 : NBGMAT=MAX(NBGMAT,VELCHE(/1))
117 : NELMAT=MAX(NELMAT ,VELCHE(/2))
118 : ENDIF
119 : ENDIF
120 : 1001 CONTINUE
121 : IF (IVARI.NE.0) THEN
122 : MPTVAL=IVARI
123 : DO 1002 IO=1,NVART
124 : IF(IVAL(IO).NE.0)THEN
125 : MELVAL=IVAL(IO)
126 : IF (CMATE.EQ.'SECTION') THEN
127 : NBGMAT=MAX(NBGMAT,IELCHE(/1))
128 : NELMAT=MAX(NELMAT ,IELCHE(/2))
129 : ELSE
130 : NBGMAT=MAX(NBGMAT,VELCHE(/1))
131 : NELMAT=MAX(NELMAT ,VELCHE(/2))
132 : ENDIF
133 : ENDIF
134 : 1002 CONTINUE
135 : ENDIF
136 : C
137 : C INITIALISATION DES TABLEAUX DE TRAVAIL
138 : C
139 : IF(MFR.EQ.15.AND.NBPGAU.EQ.1) THEN
140 : DO 10 I=1,NBPGAU
141 : S(I)= XZER
142 : 10 CONTINUE
143 : ELSE IF(MFR.EQ.15.AND.NBPGAU.EQ.3) THEN
144 : DO 11 I=1,NBPGAU
145 : S(1)=-X774
146 : S(2)= XZER
147 : S(3)= X774
148 : 11 CONTINUE
149 : ENDIF
150 : *
151 : NMAT1=NMATT
152 : * cette sequence est presente car la troisieme composante
153 : * (eventuellement) obligatoire est la septieme composante du materiau
154 : IF(INAT.EQ.26) NMATT=NMATT+4
155 : SEGINI TRAV
156 : *
157 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
158 : 1 CMATE.EQ.'UNIDIREC').OR.(MFR.EQ.55)) THEN
159 : C RENSEIGNEMENTS SUR LE MAILLAGE
160 : MELEME=IMAMOD
161 : SEGACT MELEME
162 : NBNN=NUM(/1)
163 : SEGINI WRK2
164 : *
165 : IF(MFR.EQ.55)THEN
166 : LRE=NBNN*IDIM
167 : NSTRS=LHOOK
168 : SEGINI,WRK4
169 : ENDIF
170 : *
171 : ENDIF
172 : C
173 : C
174 : C
175 : IF (((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
176 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33))
177 : 1 .OR.(MFR.EQ.55)) THEN
178 : C
179 : C RENSEIGNEMENTS SUR LE MAILLAGE
180 : C
181 : NBNO=NBNN
182 : IF(MFR.EQ.33) NBNO=IPORE
183 : *
184 : * RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
185 : * L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
186 : IELE=NUMGEO(MELE)
186 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
187 : MINTE2=IPT1
188 : SEGACT MINTE2
189 : ENDIF
190 : C
191 : C Boucle sur les elements
192 : C
193 : DO 1100 IB=1,NEL
194 : C
195 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
196 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
197 : C
198 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
199 : C
199 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
200 : C
201 : C CALCUL DES AXES LOCAUX
202 : C
203 : NBSH=MINTE2.SHPTOT(/2)
203 : CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
204 : if (nbsh.eq.-1) then
204 : call erreur(525)
205 : return
206 : endif
207 : ENDIF
208 : C
209 : C Boucle sur les points
210 : C
211 : DO 1100 IGAU=1,NBPTEL
212 : C
213 : MPTVAL=IVAMAT
214 : DO 1005 IM=1,NMAT1
215 : IF (IVAL(IM).NE.0) THEN
216 : MELVAL=IVAL(IM)
217 : IBMN=MIN(IB ,VELCHE(/2))
218 : IGMN=MIN(IGAU,VELCHE(/1))
219 : VALMAT(IM)=VELCHE(IGMN,IBMN)
220 : ELSE
221 : VALMAT(IM)=0.D0
222 : ENDIF
223 : 1005 CONTINUE
224 : *
225 : * cette sequence est presente car la troisieme composante
226 : * (eventuellement) obligatoire est la septieme composante du materiau
227 : IF(INAT.EQ.26) THEN
228 : VALMAT(7)=VALMAT(3)
229 : DO 1006 ICOMP=3,6
230 : VALMAT(ICOMP)=0.D0
231 : 1006 CONTINUE
232 : ENDIF
233 : C
234 : IF(INAT.EQ.26.OR.INAT.EQ.29.OR.INAT.EQ.30.OR.
235 : . INAT.EQ.62.OR.INAT.EQ.64.OR.INAT.EQ.65.OR.INAT.EQ.118) THEN
236 : MPTVAL=IVARI
237 : DO 1007 IM=1,NVART
238 : IF (IVAL(IM).NE.0) THEN
239 : MELVAL=IVAL(IM)
240 : IBMN=MIN(IB ,VELCHE(/2))
241 : IGMN=MIN(IGAU,VELCHE(/1))
242 : VAR(IM)=VELCHE(IGMN,IBMN)
243 : ELSE
244 : VAR(IM)=0.D0
245 : ENDIF
246 : 1007 CONTINUE
247 : ENDIF
248 : C
249 :
250 : IF(MFR.EQ.61)THEN
251 : DO ICOMP=1,NCARR
252 : MPTVAL=IVACAR
253 : MELVAL=IVAL(ICOMP)
254 : IF (MELVAL.NE.0) THEN
255 : IBMN=MIN(IB ,VELCHE(/2))
256 : IGMN=MIN(IGAU,VELCHE(/1))
257 : VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
258 : ELSE
259 : VALCAR(ICOMP)=0.D0
260 : ENDIF
261 : ENDDO
262 : ENDIF
263 :
264 : C
265 : IF(MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.15.
266 : 1 OR.MFR.EQ.17) THEN
267 : C
268 : C ON CHERCHE LES CARACTERISTIQUES DE L ELEMENT IB
269 : C
270 : IF(CMATE.EQ.'SECTION') THEN
271 : C
272 : MPTVAL=IVAMAT
273 : MELVAL=IVAL(1)
274 : IBMN=MIN(IB ,IELCHE(/2))
275 : IGMN=MIN(IGAU,IELCHE(/1))
276 : IPMODL=IELCHE(IGMN,IBMN)
277 : MELVAL=IVAL(2)
278 : IBMN=MIN(IB ,IELCHE(/2))
279 : IGMN=MIN(IGAU,IELCHE(/1))
280 : IPCAR=IELCHE(IGMN,IBMN)
280 : CALL FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
281 : C
282 : ELSEIF (MFR.EQ.15) THEN
283 : C
284 : IE=1
285 : DO 7030 IC=1,3,2
286 : MPTVAL=IVACAR
287 : DO 7030 ICOMP=1,NCARR
288 : MELVAL=IVAL(ICOMP)
289 : IF (MELVAL.NE.0) THEN
290 : IGMN=MIN(IC,VELCHE(/1))
291 : IBMN=MIN(IB,VELCHE(/2))
292 : VALCAR(IE)=VELCHE(IGMN,IBMN)
293 : ELSE
294 : VALCAR(IE)=0.D0
295 : ENDIF
296 : IE=IE+1
297 : 7030 CONTINUE
298 : C
299 : ELSE
300 : C
301 : DO 1010 ICOMP=1,NCARR
302 : MPTVAL=IVACAR
303 : MELVAL=IVAL(ICOMP)
304 : IF (MELVAL.NE.0) THEN
305 : IBMN=MIN(IB ,VELCHE(/2))
306 : IGMN=MIN(IGAU,VELCHE(/1))
307 : VALCAR(ICOMP)=VELCHE(IGMN,IBMN)
308 : ELSE
309 : VALCAR(ICOMP)=0.D0
310 : ENDIF
311 : 1010 CONTINUE
312 : ENDIF
313 : ENDIF
314 : C
315 : IF(MFR.EQ.27.OR.MFR.EQ.49) THEN
316 : C
317 : C ON CHERCHE LA SECTION DE L'ELEMENT IB
318 : C
319 : MPTVAL=IVACAR
320 : MELVAL=IVAL(1)
321 : IF (MELVAL.NE.0) THEN
322 : IBMN=MIN(IB ,VELCHE(/2))
323 : IGMN=MIN(IGAU,VELCHE(/1))
324 : SECT=VELCHE(IGMN,IBMN)
325 : ELSE
326 : SECT=0.D0
327 : ENDIF
328 : ENDIF
329 : C
330 : C ON CHERCHE L'EPAISSEUR DU JOINT GENERALISE IB
331 : C
332 : IF(MFR.EQ.55) THEN
333 : MPTVAL=IVACAR
334 : MELVAL=IVAL(1)
335 : IF (MELVAL.NE.0) THEN
336 : IBMN=MIN(IB ,VELCHE(/2))
337 : IGMN=MIN(IGAU,VELCHE(/1))
338 : EPAIST=VELCHE(IGMN,IBMN)
339 : ELSE
340 : EPAIST=0.D0
341 : ENDIF
342 : C
343 : IF(EPAIST.EQ.0.D0) THEN
343 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
344 : IF(MELE.EQ.170)THEN
344 : CALL JO2LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
344 : CALL BJO2GN(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
345 : . MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,XDPGE,YDPGE,IERT)
346 : ELSEIF(MELE.EQ.171)THEN
346 : CALL JT3LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
346 : CALL BJT3G(IGAU,MFR,IFOUR,NIFOUR,XE,XEL,BPSS,
347 : . MINTE2.SHPTOT,SHPWRK,EPAIST,BGENE,DJAC,IERT)
348 : ELSEIF(MELE.EQ.172)THEN
348 : CALL JO4LOC(XE,MINTE2.SHPTOT,NBNN,XEL,BPSS,NOQUAL)
348 : CALL BJO4G(IGAU,XE,XEL,BPSS,MINTE2.SHPTOT,SHPWRK,EPAIST,
349 : . BGENE,DJAC,IERT)
350 : ENDIF
351 : ENDIF
352 : ENDIF
353 :
354 : C
355 : C Prise en compte de l'epaisseur et de l'excentrement
356 : C dans le cas des coques minces avec ou sans cisaillement
357 : C transverse
358 : C
359 : IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
360 : 1 OR.CMATE.EQ.'UNIDIREC').AND.
361 : 2 (MFR.EQ.3.OR.MFR.EQ.9)) THEN
362 : MPTVAL=IVACAR
363 : MELVAL=IVAL(1)
364 : IF (MELVAL.NE.0) THEN
365 : IBMN=MIN(IB ,VELCHE(/2))
366 : IGMN=MIN(IGAU,VELCHE(/1))
367 : EPAIST=VELCHE(IGMN,IBMN)
368 : ELSE
368 : CALL ERREUR(527)
369 : IRET=0
370 : GOTO 9000
371 : ENDIF
372 : C
373 : IF(LASURF.EQ.0) THEN
374 : EXCEN = 0.D0
375 : ELSE
376 : MELVAL=IVAL(2)
377 : IF (MELVAL.NE.0) THEN
378 : IBMN=MIN(IB ,VELCHE(/2))
379 : IGMN=MIN(IGAU,VELCHE(/1))
380 : EXCEN=VELCHE(IGMN,IBMN)
381 : ELSE
382 : EXCEN=0.D0
383 : ENDIF
384 : ENDIF
385 : ENDIF
386 :
387 : C_______________________________________________________________________
388 : C
389 : C TRAITEMENT SUIVANT TYPE DE MATERIAU
390 : C_______________________________________________________________________
391 : C
392 : IF (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ZONE_COH') THEN
392 : CALL HOOKIS(VALMAT,VALCAR,VAR,MFR,IB,IGAU,EXCEN,EPAIST,
393 : + INAT,MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,
394 : + S,SECT,LHOOK,DDHOMU,DDHOOK,
395 : + COBMA,XMOB,IRET)
396 : C
397 : ELSE IF (CMATE.EQ.'ORTHOTRO') THEN
397 : CALL HOOKOR(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
398 : + MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
399 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
400 : + COBMA,XMOB,IRET)
401 : C
402 : ELSE IF (CMATE.EQ.'ANISOTRO') THEN
402 : CALL HOOKAN(VALMAT,IB,IGAU,MFR,IFOUR,KCAS,NBGMAT,NELMAT,
403 : + SECT,LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOOK,
404 : + MELE,COBMA,XMOB,IRET)
405 : C
406 : ELSE IF (CMATE.EQ.'UNIDIREC') THEN
406 : CALL HOOKUN(VALMAT,IB,IGAU,MFR,EXCEN,EPAIST,
407 : + MELE,NPINT,IFOUR,KCAS,NBGMAT,NELMAT,SECT,LHOOK,
408 : + TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,DDHOOK,
409 : + COBMA,XMOB,IRET)
410 : C
411 : ELSE IF (CMATE.EQ.'HOMOGENE') THEN
411 : CALL HOOKHO(VALMAT,IB,IGAU,MFR,NBGMAT,NELMAT,SECT,
412 : + LHOOK,DDHOOK,IRET)
413 : C
414 : ELSE IF (CMATE.EQ.'SECTION') THEN
414 : CALL HOOKSE(VALMAT,IB,IGAU,MFR,CRIGI,IFOUR,
415 : + NBGMAT,NELMAT,SECT,LHOOK,DDHOOK,IRET)
416 : C
417 : ENDIF
418 : C
419 : IF (IRET.EQ.0) THEN
420 : IF (MFR.EQ.3.AND.NPINT.NE.0) THEN
420 : CALL ERREUR(251)
421 : ELSE
422 : MOTERR(1:8)=NOMFR(MFR/2+1)
422 : CALL ERREUR(193)
423 : ENDIF
424 : GOTO 1200
425 : ENDIF
426 : C
427 :
428 : C
429 : C REMPLISSAGE DU SEGMENT IVAHOO
430 : C
431 : JG=LHOO2
432 : SEGINI MLREEL
433 : MELVAL=IVAHOO
434 : IELCHE(IGAU,IB)=MLREEL
435 : KO=0
436 : DO 1015 IO=1,LHOOK
437 : DO 1015 JO=1,LHOOK
438 : KO=KO+1
439 : PROG(KO)=DDHOOK(IO,JO)
440 : 1015 CONTINUE
441 : ** SEGDES MLREEL
442 : 1100 CONTINUE
443 : C
444 : 1200 CONTINUE
445 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
446 : 1 CMATE.EQ.'UNIDIREC').AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
447 : ** SEGDES MINTE2
448 : ENDIF
449 : *
450 : 9000 CONTINUE
451 : IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
452 : 1 CMATE.EQ.'UNIDIREC')) THEN
453 : ** SEGDES MELEME
454 : SEGSUP WRK2
455 : ENDIF
456 : IF (MFR.EQ.55) SEGSUP WRK4
457 : SEGSUP TRAV
458 : RETURN
459 : END
460 :
461 :
462 :
463 :
464 :
465 :
466 :
467 :
468 :
469 :
470 :
471 :
472 :
473 :
474 :
475 :
476 :
477 :
478 :
479 :
480 :
481 :
482 :
483 :
484 :
© Cast3M 2003 - All rights reserved.
Disclaimer