OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
c3inmas.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "remesh_c.inc"
#include "scr03_c.inc"
#include "scr12_c.inc"
#include "scr17_c.inc"
#include "vect01_c.inc"
#include "drape_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine c3inmas (x, xreftg, ixtg, geo, pm, ms, tiner, thke, partsav, v, ipart, mstg, intg, ptg, igeo, imat, iprop, area, etnod, nshnod, sttg, sh3tree, mcp, mcptg, temp, sh3trim, isubstack, nlay, elbuf_str, stack, thki, rnoise, drape, perturb, ix1, ix2, ix3, nintemp, x2, x3, y3, idrape, indx)

Function/Subroutine Documentation

◆ c3inmas()

subroutine c3inmas ( x,
xreftg,
integer, dimension(nixtg,*) ixtg,
geo,
pm,
ms,
tiner,
thke,
partsav,
v,
integer, dimension(*) ipart,
mstg,
intg,
ptg,
integer, dimension(npropgi,*) igeo,
integer imat,
integer iprop,
area,
etnod,
integer, dimension(*) nshnod,
sttg,
integer, dimension(ksh3tree,*) sh3tree,
mcp,
mcptg,
temp,
integer, dimension(*) sh3trim,
integer isubstack,
integer nlay,
type(elbuf_struct_), target elbuf_str,
type (stack_ply) stack,
thki,
rnoise,
type (drape_), dimension(numelc_drape + numeltg_drape), target drape,
integer, dimension(nperturb) perturb,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, intent(in) nintemp,
x2,
x3,
y3,
integer idrape,
integer, dimension (stdrape) indx )

Definition at line 38 of file c3inmas.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE elbufdef_mod
50 USE message_mod
51 USE stack_mod
52 USE drape_mod
53 USE names_and_titles_mod , ONLY : nchartitle
54C----------------------------------------------
55C INITIALISATION DES MASSES ET INERTIES NODALES
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "com04_c.inc"
68#include "param_c.inc"
69#include "remesh_c.inc"
70#include "scr03_c.inc"
71#include "scr12_c.inc"
72#include "scr17_c.inc"
73#include "vect01_c.inc"
74#include "drape_c.inc"
75C-----------------------------------------------
76C D u m m y A r g u m e n t s
77C-----------------------------------------------
78 INTEGER IXTG(NIXTG,*),IPART(*),IMAT,IPROP,
79 . IGEO(NPROPGI,*),IGTYP, NSHNOD(*), SH3TREE(KSH3TREE,*),
80 . SH3TRIM(*),ISUBSTACK,NLAY,IDRAPE,
81 . PERTURB(NPERTURB)
82 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ)
83 INTEGER, DIMENSION (STDRAPE) :: INDX
84 INTEGER ,INTENT(IN) :: NINTEMP
85 my_real
86 . x(3,*), geo(npropg,*), pm(npropm,*), ms(*), tiner(*),thke(*),
87 . v(3,*),partsav(20,*),mstg(*),intg(*),ptg(3,*),
88 . etnod(*), sttg(*),mcp(*),mcptg(*),temp(*),xreftg(3,3,*),thki(*),
89 . rnoise(nperturb,*), area(mvsiz)
90 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
91 TYPE (STACK_PLY) :: STACK
92 TYPE (DRAPE_), DIMENSION(NUMELC_DRAPE + NUMELTG_DRAPE), TARGET :: DRAPE
93C-----------------------------------------------
94C L o c a l V a r i a b l e s
95C-----------------------------------------------
96 INTEGER I,J,K,N,IP,I1,I2,I3,I4,IPTHK,IPMAT,IPPOS,MATLY,IDPROP,
97 . IPID,IPPID,IIGEO,IADI,IADR,IPANG,NTHK,IGMAT,ILAY,NPTT,
98 . IT,MAX_NPTT,IINT,IPID_LY,IPGMAT,IPOS,IPT,IPT_ALL,NSLICE,IE,
99 . NLAY_MAX
100 INTEGER ID
101 CHARACTER(LEN=NCHARTITLE) :: TITR
102 my_real xx,yy,zz,xy,yz,zx,zshift
103 my_real x2(mvsiz), x3(mvsiz), y3(mvsiz),
104 . rho(mvsiz), thk(mvsiz), em(mvsiz), xi(mvsiz),
105 . p1, p2, p3, aa, bb, cc, a2, b2, c2, xin, ems, msl, xil,
106 . mst,dms,ins,posly,thkly,thickt, et,emscp(mvsiz),rhocp(mvsiz),
107 . ems_nptt,ms_nptt,pos_0,thinning,scale,thick_drape
108 my_real, DIMENSION(:) , ALLOCATABLE :: thk_it, pos_it
109 my_real, DIMENSION(:,:), ALLOCATABLE :: laypos, ratio_thkly
110C-----------------------------------------------
111 TYPE (DRAPE_PLY_) , POINTER :: DRAPE_PLY
112C-----------------------------------------------
113 my_real
114 . a_gauss(9,9),w_gauss(9,9)
115C-----------------------------------------------
116 DATA a_gauss /
117 1 0. ,0. ,0. ,
118 1 0. ,0. ,0. ,
119 1 0. ,0. ,0. ,
120 2 -.577350269189626,0.577350269189626,0. ,
121 2 0. ,0. ,0. ,
122 2 0. ,0. ,0. ,
123 3 -.774596669241483,0. ,0.774596669241483,
124 3 0. ,0. ,0. ,
125 3 0. ,0. ,0. ,
126 4 -.861136311594053,-.339981043584856,0.339981043584856,
127 4 0.861136311594053,0. ,0. ,
128 4 0. ,0. ,0. ,
129 5 -.906179845938664,-.538469310105683,0. ,
130 5 0.538469310105683,0.906179845938664,0. ,
131 5 0. ,0. ,0. ,
132 6 -.932469514203152,-.661209386466265,-.238619186083197,
133 6 0.238619186083197,0.661209386466265,0.932469514203152,
134 6 0. ,0. ,0. ,
135 7 -.949107912342759,-.741531185599394,-.405845151377397,
136 7 0. ,0.405845151377397,0.741531185599394,
137 7 0.949107912342759,0. ,0. ,
138 8 -.960289856497536,-.796666477413627,-.525532409916329,
139 8 -.183434642495650,0.183434642495650,0.525532409916329,
140 8 0.796666477413627,0.960289856497536,0. ,
141 9 -.968160239507626,-.836031107326636,-.613371432700590,
142 9 -.324253423403809,0. ,0.324253423403809,
143 9 0.613371432700590,0.836031107326636,0.968160239507626/
144 DATA w_gauss /
145 1 2. ,0. ,0. ,
146 1 0. ,0. ,0. ,
147 1 0. ,0. ,0. ,
148 2 1. ,1. ,0. ,
149 2 0. ,0. ,0. ,
150 2 0. ,0. ,0. ,
151 3 0.555555555555556,0.888888888888889,0.555555555555556,
152 3 0. ,0. ,0. ,
153 3 0. ,0. ,0. ,
154 4 0.347854845137454,0.652145154862546,0.652145154862546,
155 4 0.347854845137454,0. ,0. ,
156 4 0. ,0. ,0. ,
157 5 0.236926885056189,0.478628670499366,0.568888888888889,
158 5 0.478628670499366,0.236926885056189,0. ,
159 5 0. ,0. ,0. ,
160 6 0.171324492379170,0.360761573048139,0.467913934572691,
161 6 0.467913934572691,0.360761573048139,0.171324492379170,
162 6 0. ,0. ,0. ,
163 7 0.129484966168870,0.279705391489277,0.381830050505119,
164 7 0.417959183673469,0.381830050505119,0.279705391489277,
165 7 0.129484966168870,0. ,0. ,
166 8 0.101228536290376,0.222381034453374,0.313706645877887,
167 8 0.362683783378362,0.362683783378362,0.313706645877887,
168 8 0.222381034453374,0.101228536290376,0. ,
169 9 0.081274388361574,0.180648160694857,0.260610696402935,
170 9 0.312347077040003,0.330239355001260,0.312347077040003,
171 9 0.260610696402935,0.180648160694857,0.081274388361574/
172C=======================================================================
173 igtyp = nint(geo(12,iprop))
174 igmat = igeo(98,iprop)
175 max_nptt = 1
176 IF(igtyp == 51 .OR. igtyp == 52) THEN
177 DO ilay=1,nlay ! NPT
178 max_nptt = max(max_nptt ,elbuf_str%BUFLY(ilay)%NPTT)
179 ENDDO
180 ALLOCATE(thk_it(max_nptt),pos_it(max_nptt))
181 ELSE
182 ALLOCATE(thk_it(0),pos_it(0))
183 ENDIF
184 nlay_max = max(nlay, npt)
185 ALLOCATE( laypos(nlay_max*max_nptt,mvsiz),ratio_thkly(nlay_max*max_nptt,mvsiz) )
186 IF ((igtyp == 17 .OR. igtyp == 51) .AND. igmat < 0) THEN
187 DO i=lft,llt
188 IF (ndrape == 0) THEN
189 IF (thke(i)== zero) THEN
190 thk(i) = stack%GEO(1,isubstack)
191 thke(i)= thk(i)
192 ELSE
193 thk(i)=thke(i)
194 ENDIF
195 thki(i) = stack%GEO(1,isubstack)
196 ELSEIF (ndrape > 0) THEN
197 thk(i) = thke(i)
198 thki(i)= thk(i)
199 ENDIF ! IF (NDRAPE == 0)
200c
201 IF (nperturb /= 0) THEN
202 DO j=1,nperturb
203 IF (perturb(j) == 1 .AND.
204 . rnoise(j,numelc+i+nft) /= zero) THEN
205 thk(i) = thk(i) * rnoise(j,numelc+i+nft)
206 thke(i) = thke(i) * rnoise(j,numelc+i+nft)
207 thki(i) = thki(i) * rnoise(j,numelc+i+nft)
208 ENDIF
209 ENDDO
210 ENDIF
211c
212 rho(i)= pm(89,imat)
213 rhocp(i) = pm(69,imat)
214 IF(thk(i)==zero.AND.igtyp/=0)THEN
215 CALL ancmsg(msgid=495,
216 . msgtype=msgerror,
217 . anmode=aninfo_blind_1,
218 . i1=ixtg(6,i))
219 ENDIF
220 ENDDO
221 ELSEIF (igtyp == 52 .OR.
222 . ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0)) THEN
223 DO i=lft,llt
224 IF (ndrape == 0) THEN
225 IF (thke(i)== zero) THEN
226 thk(i) = stack%GEO(1,isubstack)
227 thke(i)= thk(i)
228 ELSE
229 thk(i)=thke(i)
230 ENDIF
231 thki(i) = stack%GEO(1,isubstack)
232 ELSEIF (ndrape > 0) THEN
233 thk(i) = thke(i)
234 thki(i)= thk(i)
235 ENDIF ! IF (NDRAPE == 0)
236c
237 IF (nperturb /= 0) THEN
238 DO j=1,nperturb
239 IF (perturb(j) == 1 .AND.
240 . rnoise(j,numelc+i+nft) /= zero) THEN
241 thk(i) = thk(i) * rnoise(j,numelc+i+nft)
242 thke(i) = thke(i) * rnoise(j,numelc+i+nft)
243 thki(i) = thki(i) * rnoise(j,numelc+i+nft)
244 ENDIF
245 ENDDO
246 ENDIF
247c
248 rho(i) = stack%PM(1,isubstack)
249 rhocp(i) = stack%PM(15,isubstack)* rho(i)/stack%PM(14,isubstack)
250 IF (thk(i) == zero .AND. igtyp /= 0) THEN
251 CALL ancmsg(msgid=495,
252 . msgtype=msgerror,
253 . anmode=aninfo_blind_1,
254 . i1=ixtg(6,i))
255 ENDIF
256 ENDDO
257 ELSE
258 DO i=lft,llt
259 IF(thke(i)==zero)THEN
260 thk(i) =geo(1,iprop)
261 thke(i)=thk(i)
262 ELSE
263 thk(i)=thke(i)
264 ENDIF
265 thki(i) =geo(1,iprop)
266c
267 IF (nperturb /= 0) THEN
268 DO j=1,nperturb
269 IF (perturb(j) == 1 .AND.
270 . rnoise(j,numelc+i+nft) /= zero) THEN
271 thk(i) = thk(i) * rnoise(j,numelc+i+nft)
272 thke(i) = thke(i) * rnoise(j,numelc+i+nft)
273 thki(i) = thki(i) * rnoise(j,numelc+i+nft)
274 ENDIF
275 ENDDO
276 ENDIF
277c
278 rho(i)= pm(89,imat)
279 rhocp(i) = pm(69,imat)
280 IF(thk(i)==zero.AND.igtyp/=0)THEN
281 CALL ancmsg(msgid=495,
282 . msgtype=msgerror,
283 . anmode=aninfo_blind_1,
284 . i1=ixtg(6,i))
285 ENDIF
286 ENDDO
287 ENDIF
288C----------------------------------------------
289C MASSES ELEMENTAIRES
290C----------------------------------------------
291 IF (igtyp==11 .OR. igtyp==16) THEN
292 ipthk = 300
293 ippos = 400
294 ipmat = 100
295 DO i=lft,llt
296 em(i)=zero
297 DO n=1,npt
298 i1=ipthk+n
299 i2=ipmat+n
300 thickt = geo(200,iprop)
301 thkly = geo(i1,iprop)*thk(i)
302 matly = igeo(i2,iprop)
303 em(i) = em(i) + pm(89,matly)*thkly*area(i)
304 ENDDO
305C--- Test stability condition for mass
306 mst = rho(i)*thk(i)*area(i)
307 dms = abs(em(i)-mst)/mst
308C! for igty=11 ---> IGMAT=-1 (old G-mat), 1 for new g-mat
309C! for igtyp=16 --->IGMAT= 0
310C! for igtyp=17 --->IGMAT= 0
311 IF(igmat <= 0) THEN
312 IF (dms > em02) THEN
313 idprop = nint(geo(40,iprop))
314 CALL fretitl2(titr,
315 . igeo(npropgi-ltitr+1,iprop),ltitr)
316 CALL ancmsg(msgid=519,
317 . msgtype=msgwarning,
318 . anmode=aninfo_blind_2,
319 . i1=igeo(1,iprop),
320 . c1=titr,i2=ixtg(nixtg,nft+i),
321 . r1=em(i),r2=mst)
322 ENDIF
323 ENDIF
324 ENDDO
325 ELSEIF (igtyp == 17) THEN
326 ippid = 2
327 ipmat = ippid + npt
328 ipang = 1
329 ipthk = ipang + npt
330 ippos = ipthk + npt
331 nthk = ippos + npt
332 IF(idrape == 0) THEN
333 DO i=lft,llt
334 em(i)=zero
335 DO n=1,npt
336 i1=ipthk + n
337 i2=ippid + n
338 i3=ipmat + n
339 thickt = stack%GEO(1,isubstack)
340 thkly = stack%GEO(i1,isubstack)*thk(i)
341 matly = stack%IGEO(i3,isubstack)
342 em(i) = em(i) + pm(89,matly)*thkly*area(i)
343 ENDDO
344C--- Test stability condition for mass
345 mst = rho(i)*thk(i)*area(i)
346 dms = abs(em(i)-mst)/mst
347 IF(igmat < 0) THEN
348 IF (dms > em02) THEN
349 idprop = nint(geo(40,iprop))
350 CALL fretitl2(titr,
351 . igeo(npropgi-ltitr+1,iprop),ltitr)
352 CALL ancmsg(msgid=519,
353 . msgtype=msgwarning,
354 . anmode=aninfo_blind_2,
355 . i1=igeo(1,iprop),
356 . c1=titr,i2=ixtg(nixtg,nft+i),
357 . r1=em(i),r2=mst)
358 ENDIF
359 ENDIF
360 ENDDO
361 ELSE ! IDRAPE > 0
362 DO i=lft,llt
363 em(i)=zero
364 ie = indx(nft + i)
365 IF(ie == 0) THEN
366 DO n=1,npt
367 i1=ipthk + n
368 i2=ippid + n
369 i3=ipmat + n
370 thickt = stack%GEO(1,isubstack)
371 thkly = stack%GEO(i1,isubstack)*thk(i)
372 matly = stack%IGEO(i3,isubstack)
373 em(i) = em(i) + pm(89,matly)*thkly*area(i)
374 ENDDO
375 ELSE
376 thick_drape = drape(ie)%THICK
377 scale = thk(i)/thick_drape
378 DO n=1,npt
379 i1=ipthk + n
380 i2=ippid + n
381 i3=ipmat + n
382 ip = drape(ie)%INDX_PLY(n)
383 IF(ip > 0) THEN
384 drape_ply => drape(ie)%DRAPE_PLY(ip)
385 nslice = drape_ply%NSLICE
386 thinning = drape_ply%RDRAPE(1,1) ! one slice by layer
387 thickt = stack%GEO(1,isubstack)
388 thkly = stack%GEO(i1,isubstack)*thickt
389 matly = stack%IGEO(i3,isubstack)
390 thkly = thkly*thinning*scale
391 matly = stack%IGEO(i3,isubstack)
392 em(i) = em(i) + pm(89,matly)*thkly*area(i)
393 ELSE
394 thickt = stack%GEO(1,isubstack)
395 thkly = stack%GEO(i1,isubstack)*thickt*scale
396 matly = stack%IGEO(i3,isubstack)
397 matly = stack%IGEO(i3,isubstack)
398 em(i) = em(i) + pm(89,matly)*thkly*area(i)
399 ENDIF
400 ENDDO
401 ENDIF ! IE
402C--- Test stability condition for mass
403 mst = rho(i)*thk(i)*area(i)
404 dms = abs(em(i)-mst)/mst
405 IF(igmat < 0) THEN
406 IF (dms > em02) THEN
407 idprop = nint(geo(40,iprop))
408 CALL fretitl2(titr,
409 . igeo(npropgi-ltitr+1,iprop),ltitr)
410 CALL ancmsg(msgid=519,
411 . msgtype=msgwarning,
412 . anmode=aninfo_blind_2,
413 . i1=igeo(1,iprop),
414 . c1=titr,i2=ixtg(nixtg,nft+i),
415 . r1=em(i),r2=mst)
416 ENDIF
417 ENDIF
418 ENDDO
419 ENDIF ! DRAPE
420 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
421 ipang = 1
422 ippid = 2
423 ipmat = ippid + nlay ! NPT
424 ipthk = ipang + nlay ! NPT
425 ippos = ipthk + nlay ! NPT
426 nthk = ippos + nlay ! NPT
427 !
428 ipos = igeo(99,iprop)
429 thickt = stack%GEO(1,isubstack)
430 zshift = geo(199,iprop)
431 IF(ipos == 2 ) zshift = - zshift /max(thickt,em20)
432 IF(idrape == 0) THEN
433 DO i=lft,llt
434 scale = thk(i)/thickt
435 em(i)=zero
436 ipt_all = 0
437 DO ilay=1,nlay ! NPT
438 nptt = elbuf_str%BUFLY(ilay)%NPTT
439 i1=ipthk + ilay
440 i2=ippid + ilay
441 i3=ipmat + ilay
442 thickt = stack%GEO(1,isubstack)
443 thkly = stack%GEO(i1,isubstack)*thickt
444 ipid_ly= stack%IGEO(i2,isubstack)
445 matly = stack%IGEO(i3,isubstack)
446 ipid = stack%IGEO(ippid,isubstack) ! or IPID = IX(NIXC-1,NFT+I)
447 iint = igeo(47,iprop)
448 IF (iint == 1) THEN ! uniform distribution - by default
449 DO it=1,nptt
450 thk_it(it) = thkly/nptt ! equally distribution of NPTT through layer
451 ENDDO
452 ELSEIF (iint == 2) THEN ! Gauss distribution
453 DO it=1,nptt
454 thk_it(it) = half*thkly*w_gauss(it,nptt)
455 ENDDO
456 ENDIF
457 !SCALE = THK(I)/THICKT
458 DO it=1,nptt
459 thk_it(it) = thk_it(it)*scale
460 ems_nptt = pm(89,matly)*thk_it(it)*area(i)
461 em(i) = em(i) + ems_nptt
462 ENDDO
463C----
464 ENDDO
465C--- Test stability condition for mass
466 mst = rho(i)*thk(i)*area(i)
467 dms = abs(em(i)-mst)/mst
468 IF(igtyp == 51 .AND.igmat < 0) THEN
469 IF (dms > em02) THEN
470 idprop = nint(geo(40,iprop))
471 CALL fretitl2(titr,
472 . igeo(npropgi-ltitr+1,iprop),ltitr)
473 CALL ancmsg(msgid=519,
474 . msgtype=msgwarning,
475 . anmode=aninfo_blind_2,
476 . i1=igeo(1,iprop),
477 . c1=titr,i2=ixtg(nixtg,nft+i),
478 . r1=em(i),r2=mst)
479 ENDIF
480 ENDIF
481 ENDDO
482 ELSE ! IDRAPE > 0
483 thickt = stack%GEO(1,isubstack)
484 DO i=lft,llt
485 em(i)=zero
486 ie = indx(nft + i)
487 ipt_all = 0
488 scale = thk(i)/thickt
489 IF(ie == 0) THEN
490 DO ilay=1,nlay ! NPT
491 nptt = elbuf_str%BUFLY(ilay)%NPTT
492 i1=ipthk + ilay
493 i2=ippid + ilay
494 i3=ipmat + ilay
495 ipid = stack%IGEO(i2,isubstack) ! or IPID = IX(NIXC-1,NFT+I)
496 iint = igeo(47,iprop)
497 thickt = stack%GEO(1,isubstack)
498 IF(iint == 1) THEN
499 thickt = stack%GEO(1,isubstack)
500 thkly = stack%GEO(i1,isubstack)*thickt
501 ipid_ly= stack%IGEO(i2,isubstack)
502 matly = stack%IGEO(i3,isubstack)
503 DO it=1,nptt
504 thk_it(it) = thkly/nptt ! uniform distribution of NPTT through layer
505 ENDDO
506 ELSEIF(iint == 2)THEN
507 thickt = stack%GEO(1,isubstack)
508 thkly = stack%GEO(i1,isubstack)*thickt
509 ipid_ly= stack%IGEO(i2,isubstack)
510 matly = stack%IGEO(i3,isubstack)
511 DO it=1,nptt
512 thk_it(it) = half*thkly*w_gauss(it,nptt) ! G Gauss distribution of NPTT through layer
513 ENDDO
514 ENDIF ! iint
515C
516 DO it=1,nptt
517 thk_it(it) = scale*thk_it(it)
518 ems_nptt = pm(89,matly)*thk_it(it)*area(i)
519 em(i) = em(i) + ems_nptt
520 ENDDO
521 ENDDO ! NLAY
522 ELSE ! IE > 0
523 ipt_all = 0
524 thick_drape = drape(ie)%THICK
525 scale = thk(i)/thick_drape
526 DO ilay=1,nlay ! NPT
527 nptt = elbuf_str%BUFLY(ilay)%NPTT
528 i1=ipthk + ilay
529 i2=ippid + ilay
530 i3=ipmat + ilay
531 ipid = stack%IGEO(i2,isubstack) ! or IPID = IX(NIXC-1,NFT+I)
532 iint = igeo(47,iprop)
533 thickt = stack%GEO(1,isubstack)
534 ip = drape(ie)%INDX_PLY(ilay)
535 IF(ip == 0) THEN
536 thickt = stack%GEO(1,isubstack)
537 thkly = stack%GEO(i1,isubstack)*thickt
538 ipid_ly= stack%IGEO(i2,isubstack)
539 matly = stack%IGEO(i3,isubstack)
540 IF(iint == 1) THEN
541 DO it=1,nptt
542 thk_it(it) = thkly/nptt
543 ENDDO ! nptt
544 ELSEIF(iint == 2)THEN
545 DO it=1,nptt
546 thk_it(it) = half*thkly*w_gauss(it,nptt) ! Gauss distribution of NPTT through laye r
547 ENDDO ! nptt
548 ENDIF ! iint
549 ELSE
550 drape_ply => drape(ie)%DRAPE_PLY(ip)
551 nslice = drape_ply%NSLICE !NPTT
552 thickt = stack%GEO(1,isubstack)
553 thkly = stack%GEO(i1,isubstack)*thickt
554 ipid_ly= stack%IGEO(i2,isubstack)
555 matly = stack%IGEO(i3,isubstack)
556 IF(iint == 1) THEN
557 DO it=1,nptt
558 thinning = drape_ply%RDRAPE(it,1)
559 thk_it(it) = thkly*thinning/nptt
560 ENDDO ! nptt
561 ELSEIF(iint == 2)THEN
562 DO it=1,nptt
563 thinning = drape_ply%RDRAPE(it,1)
564 thk_it(it) = half*thkly*w_gauss(it,nptt)*thinning ! Gauss distribution of NPTT through layer
565 ENDDO ! nptt
566 ENDIF ! iint
567 ENDIF
568 DO it=1,nptt
569 thk_it(it) = scale*thk_it(it)
570 ems_nptt = pm(89,matly)*thk_it(it)*area(i)
571 em(i) = em(i) + ems_nptt
572 ENDDO
573 ENDDO ! NLAY
574 ENDIF !IE
575C--- Test stability condition for mass
576 mst = rho(i)*thk(i)*area(i)
577 dms = abs(em(i)-mst)/mst
578 IF(igtyp == 51 .AND.igmat < 0) THEN
579 IF (dms > em02) THEN
580 idprop = nint(geo(40,iprop))
581 CALL fretitl2(titr,
582 . igeo(npropgi-ltitr+1,iprop),ltitr)
583 CALL ancmsg(msgid=519,
584 . msgtype=msgwarning,
585 . anmode=aninfo_blind_2,
586 . i1=igeo(1,iprop),
587 . c1=titr,i2=ixtg(nixtg,nft+i),
588 . r1=em(i),r2=mst)
589 ENDIF
590 ENDIF
591 ENDDO ! LFT,LLT
592 ENDIF ! IDRAPE
593 ELSE
594 DO i=lft,llt
595 em(i) = rho(i)*thk(i)*area(i)
596 ENDDO
597 DO i=lft,llt
598 emscp(i)=rhocp(i)*thk(i)*area(i)
599 ENDDO
600 ENDIF
601C----------------------------------------------
602C INERTIES ELEMENTAIRES
603C----------------------------------------------
604 IF (igtyp==11 .OR. igtyp==16) THEN
605 DO i=lft,llt
606 xi(i)=zero
607 DO n=1,npt
608 i1=ipthk+n
609 i2=ipmat+n
610 i3=ippos+n
611 thickt= geo(200,iprop)
612 thkly = geo(i1,iprop)*thk(i)
613 posly = geo(i3,iprop)*thk(i)
614 matly = igeo(i2,iprop)
615 msl = pm(89,matly)*thkly*area(i)
616 xil = msl*(area(i)/nine_over_2+thkly*thkly*one_over_12+posly*posly)
617 xi(i) = xi(i) + xil
618 ENDDO
619C--- Test stability condition for inertia
620 IF(igmat <= 0) THEN !
621 ins = em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
622 dms = abs(xi(i)-ins)/ins
623 IF(dms > em02) THEN
624 idprop = nint(geo(40,iprop))
625 CALL fretitl2(titr,
626 . igeo(npropgi-ltitr+1,iprop),ltitr)
627 CALL ancmsg(msgid=520,
628 . msgtype=msgwarning,
629 . anmode=aninfo_blind_2,
630 . i1=igeo(1,iprop),
631 . c1=titr,i2=ixtg(nixtg,nft+i))
632 ENDIF
633 ENDIF
634 ENDDO
635 ELSEIF (igtyp == 17) THEN
636 ipos = igeo(99,iprop)
637 thickt = stack%GEO(1,isubstack)
638 zshift = geo(199,iprop)
639 IF(ipos == 2 ) zshift = - zshift /max(thickt,em20)
640 IF(idrape == 0 ) THEN
641 DO i=lft,llt
642 xi(i)=zero
643 DO n=1,npt
644 i1 =ippid + n
645 i2 =ipmat + n
646 i3 =ipthk + n
647 i4 =ippos + n
648 thickt= stack%GEO(1,isubstack)
649 thkly = stack%GEO(i3,isubstack)*thk(i)
650 posly = stack%GEO(i4,isubstack)*thk(i)
651 matly = stack%IGEO(i2,isubstack)
652 msl = pm(89,matly)*thkly*area(i)
653 xil = msl*(area(i)/nine_over_2+thkly*thkly*one_over_12+posly*posly)
654 xi(i) = xi(i) + xil
655 ENDDO
656C--- Test stability condition for inertia
657 ins = em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
658 dms = abs(xi(i)-ins)/ins
659
660 IF(igmat <= 0) THEN !
661 IF(dms > em02) THEN
662 idprop = nint(geo(40,iprop))
663 CALL fretitl2(titr,
664 . igeo(npropgi-ltitr+1,iprop),ltitr)
665 CALL ancmsg(msgid=520,
666 . msgtype=msgwarning,
667 . anmode=aninfo_blind_2,
668 . i1=igeo(1,iprop),
669 . c1=titr,i2=ixtg(nixtg,nft+i))
670 ENDIF
671 ENDIF
672 ENDDO
673 ELSE !IDRAPE > 0
674 DO i=lft,llt
675 xi(i)=zero
676 ie = indx(nft + i)
677 IF(ie == 0) THEN
678 DO n=1,npt
679 i1 =ippid + n
680 i2 =ipmat + n
681 i3 =ipthk + n
682 i4 =ippos + n
683 thickt= stack%GEO(1,isubstack)
684 thkly = stack%GEO(i3,isubstack)*thk(i)
685 posly = stack%GEO(i4,isubstack)*thk(i)
686 matly = stack%IGEO(i2,isubstack)
687 msl = pm(89,matly)*thkly*area(i)
688 xil = msl*(area(i)/nine_over_2+thkly*thkly*one_over_12+posly*posly)
689 xi(i) = xi(i) + xil
690 ENDDO
691 ELSE ! IE > 0
692 thick_drape = drape(ie)%THICK
693 scale = thk(i)/thick_drape
694 DO n=1,npt
695 ip = drape(ie)%INDX_PLY(n)
696 i1 =ippid + n
697 i2 =ipmat + n
698 i3 =ipthk + n
699 i4 =ippos + n
700 IF(ip == 0 ) THEN
701 thkly = stack%GEO(i3,isubstack)*thickt
702 matly = stack%IGEO(i2,isubstack)
703 ratio_thkly(n,i) = thkly/ thick_drape
704 ELSE
705 drape_ply => drape(ie)%DRAPE_PLY(ip)
706 thinning = drape_ply%RDRAPE(1,1)
707 thkly = stack%GEO(i3,isubstack)*thickt
708 thkly = thkly*thinning
709 matly = stack%IGEO(i2,isubstack)
710 ratio_thkly(n,i) = thkly/thick_drape
711 ENDIF
712 IF (n == 1) THEN
713 laypos(n,i) = zshift + half*ratio_thkly(n,i)
714 ELSE
715 laypos(n,i) = laypos(n-1,i) + half*(ratio_thkly(n,i)+ratio_thkly(n-1,i))
716 ENDIF ! IF (N == 1)
717 posly = laypos(n,i)*thk(i)
718 thkly = thkly*scale
719 msl = pm(89,matly)*thkly*area(i)
720 xil = msl*(area(i)/nine_over_2+thkly*thkly*one_over_12+posly*posly)
721 xi(i) = xi(i) + xil
722 ENDDO
723 ENDIF ! IE
724C--- Test stability condition for inertia
725 ins = em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
726 dms = abs(xi(i)-ins)/ins
727
728 IF(igmat <= 0) THEN !
729 IF(dms > em02) THEN
730 idprop = nint(geo(40,iprop))
731 CALL fretitl2(titr,
732 . igeo(npropgi-ltitr+1,iprop),ltitr)
733 CALL ancmsg(msgid=520,
734 . msgtype=msgwarning,
735 . anmode=aninfo_blind_2,
736 . i1=igeo(1,iprop),
737 . c1=titr,i2=ixtg(nixtg,nft+i))
738 ENDIF
739 ENDIF
740 ENDDO
741 ENDIF ! IDRAPE
742 ELSEIF (igtyp == 51 .OR. igtyp == 52) THEN
743 ipang = 1
744 ippid = 2
745 ipmat = ippid + nlay ! NPT
746 ipthk = ipang + nlay ! NPT
747 ippos = ipthk + nlay ! NPT
748 nthk = ippos + nlay ! NPT
749 !!
750
751 ipos = igeo(99,iprop)
752 thickt = stack%GEO(1,isubstack)
753 zshift = geo(199,iprop)
754 IF(ipos == 2 ) zshift = - zshift /max(thickt,em20)
755 IF(idrape == 0) THEN
756 thickt = stack%GEO(1,isubstack)
757 DO i=lft,llt
758 xi(i)=zero
759 ipt_all = 0
760 scale = thk(i)/thickt
761 DO ilay=1,nlay ! NPT
762 nptt = elbuf_str%BUFLY(ilay)%NPTT
763 i1 =ippid + ilay
764 i2 =ipmat + ilay
765 i3 =ipthk + ilay
766 i4 =ippos + ilay
767 ipid_ly = stack%IGEO(i1,isubstack)
768 matly = stack%IGEO(i2,isubstack)
769 iint = igeo(47,iprop)
770 IF(iint == 1) THEN
771 thickt = stack%GEO(1,isubstack)
772 thkly = stack%GEO(i3,isubstack)*thickt
773 DO it=1,nptt
774 ipt = ipt_all + it
775 thk_it(it) = thkly/nptt
776 ratio_thkly(ipt,i) = thk_it(it)/thickt
777 IF (ipt == 1) THEN
778 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
779 ELSE
780 laypos(ipt,i) = laypos(ipt-1,i) +
781 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
782 ENDIF ! IF (N == 1)
783 pos_it(it) = laypos(ipt,i)*thk(i)
784 ENDDO
785 ELSEIF(iint == 2) THEN
786 thickt = stack%GEO(1,isubstack)
787 thkly = stack%GEO(i3,isubstack)*thickt
788 DO it=1,nptt
789 ipt = ipt_all + it
790 thk_it(it) = half*thkly*w_gauss(it,nptt)
791 ratio_thkly(ipt,i) = thk_it(it)/thickt
792 IF (ipt == 1) THEN
793 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
794 ELSE
795 laypos(ipt,i) = laypos(ipt-1,i) +
796 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
797 ENDIF ! IF (N == 1)
798 pos_it(it) = laypos(ipt,i)*thk(i)
799 ENDDO
800 ENDIF ! iit
801 !SCALE = THK(I)/THICKT
802 DO it=1,nptt
803 ms_nptt = pm(89,matly)*thk_it(it)*area(i)
804 thk_it(it) = thk_it(it)*scale
805 xil = ms_nptt*(area(i)/nine_over_2+thk_it(it)*thk_it(it)*one_over_12 +
806 . pos_it(it)*pos_it(it))
807 xi(i) = xi(i) + xil
808 ENDDO
809 ipt_all = ipt_all + nptt
810 ENDDO ! NLAY
811C Test stability condition for inertia
812 ins = em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
813 dms = abs(xi(i)-ins)/ins
814 IF(igtyp == 51 .AND. igmat < 0) THEN
815 IF (dms > em02) THEN
816 idprop = nint(geo(40,iprop))
817 CALL fretitl2(titr,
818 . igeo(npropgi-ltitr+1,iprop),ltitr)
819 CALL ancmsg(msgid=520,
820 . msgtype=msgwarning,
821 . anmode=aninfo_blind_2,
822 . i1=igeo(1,iprop),
823 . c1=titr,i2=ixtg(nixtg,nft+i))
824 ENDIF
825 ENDIF
826 ENDDO ! LFT,LLT
827 ELSE ! IDRAPE > 0
828 thickt = stack%GEO(1,isubstack)
829 DO i=lft,llt
830 xi(i)=zero
831 ipt_all = 0
832 ie = indx(nft + i)
833 scale = thk(i)/thickt
834 IF(ie == 0) THEN
835 DO ilay=1,nlay ! NPT
836 nptt = elbuf_str%BUFLY(ilay)%NPTT
837 i1 =ippid + ilay
838 i2 =ipmat + ilay
839 i3 =ipthk + ilay
840 i4 =ippos + ilay
841 ipid_ly = stack%IGEO(i1,isubstack)
842 matly = stack%IGEO(i2,isubstack)
843 iint = igeo(47,iprop)
844 IF(iint == 1) THEN
845 thickt = stack%GEO(1,isubstack)
846 thkly = stack%GEO(i3,isubstack)*thickt
847 DO it=1,nptt
848 ipt = ipt_all + it
849 thk_it(it) = thkly/nptt
850 ratio_thkly(ipt,i) = thk_it(it)/thickt
851 IF (ipt == 1) THEN
852 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
853 ELSE
854 laypos(ipt,i) = laypos(ipt-1,i) +
855 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
856 ENDIF ! IF (N == 1)
857 pos_it(it) = laypos(ipt,i)*thk(i)
858 ENDDO
859 ELSEIF(iint == 2) THEN
860 thickt = stack%GEO(1,isubstack)
861 thkly = stack%GEO(i3,isubstack)*thickt
862 DO it=1,nptt
863 ipt = ipt_all + it
864 thk_it(it) = half*thkly*w_gauss(it,nptt)
865 ratio_thkly(ipt,i) = thk_it(it)/thickt
866 IF (ipt == 1) THEN
867 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
868 ELSE
869 laypos(ipt,i) = laypos(ipt-1,i) +
870 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
871 ENDIF ! IF (N == 1)
872 pos_it(it) = laypos(ipt,i)*thk(i)
873 ENDDO
874 ENDIF ! iit
875 DO it=1,nptt
876 thk_it(it) = scale*thk_it(it)
877 ms_nptt = pm(89,matly)*thk_it(it)*area(i)
878 xil = ms_nptt*(area(i)/nine_over_2+thk_it(it)*thk_it(it)*one_over_12 +
879 . pos_it(it)*pos_it(it))
880 xi(i) = xi(i) + xil
881 ENDDO
882 ipt_all = ipt_all + nptt
883 ENDDO ! NLAY
884 ELSE ! IE > 0
885 ipt_all = 0
886 thick_drape = drape(ie)%THICK
887 scale = thk(i)/thick_drape
888 DO ilay=1,nlay ! NPT
889 ip = drape(ie)%INDX_PLY(ilay)
890 nptt = elbuf_str%BUFLY(ilay)%NPTT
891 i1 =ippid + ilay
892 i2 =ipmat + ilay
893 i3 =ipthk + ilay
894 i4 =ippos + ilay
895 ipid_ly = stack%IGEO(i1,isubstack)
896 matly = stack%IGEO(i2,isubstack)
897 iint = igeo(47,iprop)
898 IF(ip > 0) THEN
899 drape_ply => drape(ie)%DRAPE_PLY(ip)
900 nslice = drape_ply%NSLICE ! NPTT
901 IF(iint == 1) THEN
902 thickt = stack%GEO(1,isubstack)
903 thkly = stack%GEO(i3,isubstack)*thickt
904 DO it=1,nptt
905 ipt = ipt_all + it
906 thinning = drape_ply%RDRAPE(it,1)
907 thk_it(it) = thkly*thinning/nptt
908 ratio_thkly(ipt,i) = thk_it(it)/thick_drape
909 IF (ipt == 1) THEN
910 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
911 ELSE
912 laypos(ipt,i) = laypos(ipt-1,i) +
913 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
914 ENDIF ! IF (N == 1)
915 pos_it(it) = laypos(ipt,i)*thk(i)
916 ENDDO
917 ELSEIF(iint == 2) THEN
918 thickt = stack%GEO(1,isubstack)
919 thkly = stack%GEO(i3,isubstack)*thickt
920 DO it=1,nptt
921 ipt = ipt_all + it
922 thinning = drape_ply%RDRAPE(it,1)
923 thk_it(it) = half*thkly*w_gauss(it,nptt)*thinning
924 ratio_thkly(ipt,i) = thk_it(it)/thick_drape
925 IF (ipt == 1) THEN
926 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
927 ELSE
928 laypos(ipt,i) = laypos(ipt-1,i) +
929 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
930 ENDIF ! IF (N == 1)
931 pos_it(it) = laypos(ipt,i)*thk(i)
932 ENDDO
933 ENDIF ! iit
934 ELSE ! IP == 0
935 IF(iint == 1) THEN
936 thickt = stack%GEO(1,isubstack)
937 thkly = stack%GEO(i3,isubstack)*thickt
938 DO it=1,nptt
939 ipt = ipt_all + it
940 thk_it(it) = thkly/nptt
941 ratio_thkly(ipt,i) = thk_it(it)/thick_drape
942 IF (ipt == 1) THEN
943 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
944 ELSE
945 laypos(ipt,i) = laypos(ipt-1,i) +
946 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
947 ENDIF ! IF (N == 1)
948 pos_it(it) = laypos(ipt,i)*thk(i)
949 ENDDO
950 ELSEIF(iint == 2) THEN
951 thickt = stack%GEO(1,isubstack)
952 thkly = stack%GEO(i3,isubstack)*thickt
953 DO it=1,nptt
954 ipt = ipt_all + it
955 thk_it(it) = half*thkly*w_gauss(it,nptt)
956 ratio_thkly(ipt,i) = thk_it(it)/thick_drape
957 IF (ipt == 1) THEN
958 laypos(ipt,i) = zshift + half*ratio_thkly(ipt,i)
959 ELSE
960 laypos(ipt,i) = laypos(ipt-1,i) +
961 . half*(ratio_thkly(ipt,i)+ratio_thkly(ipt-1,i))
962 ENDIF ! IF (N == 1)
963 pos_it(it) = laypos(ipt,i)*thk(i)
964 ENDDO
965 ENDIF ! iit
966 ENDIF
967 DO it=1,nptt
968 thk_it(it) = scale*thk_it(it)
969 ms_nptt = pm(89,matly)*thk_it(it)*area(i)
970 xil = ms_nptt*(area(i)/nine_over_2+thk_it(it)*thk_it(it)*one_over_12 +
971 . pos_it(it)*pos_it(it))
972 xi(i) = xi(i) + xil
973 ENDDO
974 ipt_all = ipt_all + nptt
975 ENDDO ! NLAY
976 ENDIF ! ie
977C Test stability condition for inertia
978 ins = em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
979 dms = abs(xi(i)-ins)/ins
980 IF(igtyp == 51 .AND. igmat < 0) THEN
981 IF (dms > em02) THEN
982 idprop = nint(geo(40,iprop))
983 CALL fretitl2(titr,
984 . igeo(npropgi-ltitr+1,iprop),ltitr)
985 CALL ancmsg(msgid=520,
986 . msgtype=msgwarning,
987 . anmode=aninfo_blind_2,
988 . i1=igeo(1,iprop),
989 . c1=titr,i2=ixtg(nixtg,nft+i))
990 ENDIF
991 ENDIF
992 ENDDO ! LFT,LLT
993 ENDIF ! IDRAPE
994 ELSE
995 DO i=lft,llt
996C--- Exact: XIN = EMS*(AREA(I)/(6.*SQRT(3.))+THK(I)*THK(I)/12.)
997C--- Compatibilite avec coques 4 noeuds:
998 xi(i)=em(i)*(area(i)/nine_over_2+thk(i)*thk(i)*one_over_12)
999 ENDDO
1000 ENDIF
1001C---------------------------------------------------
1002C INITIALISATION DES MASSES ET INERTIES NODALES
1003C---------------------------------------------------
1004C mass and inertia spmd parith/on + adaptive meshing
1005 IF(jthe == 0 ) THEN
1006 DO i=lft,llt
1007 mstg(i)=em(i)
1008 intg(i)=xi(i)
1009 END DO
1010 ELSE
1011 DO i=lft,llt
1012 mstg(i)=em(i)
1013 intg(i)=xi(i)
1014 mcptg(i) = emscp(i)
1015 END DO
1016 ENDIF
1017C
1018 DO i=lft,llt
1019 aa = x2(i)
1020 a2 = aa**2
1021 b2 = (x2(i)-x3(i))**2 + y3(i)**2
1022 bb = sqrt(b2)
1023 c2 = x3(i)**2 + y3(i)**2
1024 cc = sqrt(c2)
1025 p1 = acos((a2 + c2 - b2)/(two * aa * cc)) / pi
1026 p2 = acos((a2 + b2 - c2)/(two * aa * bb)) / pi
1027 p3 = acos((b2 + c2 - a2)/(two * bb * cc)) / pi
1028 ptg(1,i)=p1
1029 ptg(2,i)=p2
1030 ptg(3,i)=p3
1031 IF ( ( ((a2 + c2 - b2)/(two * aa * cc) <= -one) .OR.
1032 . ( (a2 + c2 - b2)/(two * aa * cc) >= one) .OR.
1033 . ( (a2 + b2 - c2)/(two * aa * bb) <= -one) .OR.
1034 . ( (a2 + b2 - c2)/(two * aa * bb) >= one) .OR.
1035 . ( (b2 + c2 - a2)/(two * bb * cc) <= -one) .OR.
1036 . ( (b2 + c2 - a2)/(two * bb * cc) >= one)) .AND.
1037 . lsh3trim /= 0 ) THEN
1038 IF (sh3trim(nft+i) /= -1) CALL ancmsg(msgid=750,
1039 . msgtype=msgerror,
1040 . anmode=aninfo,
1041 . i1=ixtg(6,nft+i))
1042 ELSEIF ( ( ((a2 + c2 - b2)/(two * aa * cc) <= -one) .OR.
1043 . ( (a2 + c2 - b2)/(two * aa * cc) >= one) .OR.
1044 . ( (a2 + b2 - c2)/(two * aa * bb) <= -one) .OR.
1045 . ( (a2 + b2 - c2)/(two * aa * bb) >= one) .OR.
1046 . ( (b2 + c2 - a2)/(two * bb * cc) <= -one) .OR.
1047 . ( (b2 + c2 - a2)/(two * bb * cc) >= one)) .AND.
1048 . lsh3trim == 0 ) THEN
1049 CALL ancmsg(msgid=750,
1050 . msgtype=msgerror,
1051 . anmode=aninfo,
1052 . i1=ixtg(6,nft+i))
1053 ENDIF
1054 END DO
1055C
1056C-----
1057 IF(nadmesh==0)THEN
1058 IF (nxref == 0) THEN
1059 DO i=lft,llt
1060 p1 = ptg(1,i)
1061 p2 = ptg(2,i)
1062 p3 = ptg(3,i)
1063 ems = em(i)
1064 xin = xi(i)
1065C
1066 i1 = ix1(i)
1067 i2 = ix2(i)
1068 i3 = ix3(i)
1069C
1070 ip=ipart(i)
1071 partsav(1,ip)=partsav(1,ip) + ems
1072 partsav(2,ip)=partsav(2,ip) + ems*
1073 . (x(1,i1)*p1+x(1,i2)*p2+x(1,i3)*p3)
1074 partsav(3,ip)=partsav(3,ip) + ems*
1075 . (x(2,i1)*p1+x(2,i2)*p2+x(2,i3)*p3)
1076 partsav(4,ip)=partsav(4,ip) + ems*
1077 . (x(3,i1)*p1+x(3,i2)*p2+x(3,i3)*p3)
1078 xx = (x(1,i1)*x(1,i1)*p1+x(1,i2)*x(1,i2)*p2
1079 . +x(1,i3)*x(1,i3)*p3)
1080 xy = (x(1,i1)*x(2,i1)*p1+x(1,i2)*x(2,i2)*p2
1081 . +x(1,i3)*x(2,i3)*p3)
1082 yy = (x(2,i1)*x(2,i1)*p1+x(2,i2)*x(2,i2)*p2
1083 . +x(2,i3)*x(2,i3)*p3)
1084 yz = (x(2,i1)*x(3,i1)*p1+x(2,i2)*x(3,i2)*p2
1085 . +x(2,i3)*x(3,i3)*p3)
1086 zz = (x(3,i1)*x(3,i1)*p1+x(3,i2)*x(3,i2)*p2
1087 . +x(3,i3)*x(3,i3)*p3)
1088 zx = (x(3,i1)*x(1,i1)*p1+x(3,i2)*x(1,i2)*p2
1089 . +x(3,i3)*x(1,i3)*p3)
1090 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1091 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1092 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1093 partsav(8,ip) =partsav(8,ip) - ems * xy
1094 partsav(9,ip) =partsav(9,ip) - ems * yz
1095 partsav(10,ip)=partsav(10,ip) - ems * zx
1096C
1097 partsav(11,ip)=partsav(11,ip) + ems*
1098 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1099 partsav(12,ip)=partsav(12,ip) + ems*
1100 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1101 partsav(13,ip)=partsav(13,ip) + ems*
1102 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1103 partsav(14,ip)=partsav(14,ip) + half * ems *
1104 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1105 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1106 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1107 ENDDO
1108 ELSE
1109 DO i=lft,llt
1110 p1 = ptg(1,i)
1111 p2 = ptg(2,i)
1112 p3 = ptg(3,i)
1113 ems = em(i)
1114 xin = xi(i)
1115C
1116 i1 = ix1(i)
1117 i2 = ix2(i)
1118 i3 = ix3(i)
1119 ip=ipart(i)
1120C
1121 partsav(1,ip)=partsav(1,ip) + ems
1122 partsav(2,ip)=partsav(2,ip) + ems*
1123 . (p1*xreftg(1,1,i)+p2*xreftg(2,1,i)+p3*xreftg(3,1,i))
1124 partsav(3,ip)=partsav(3,ip) + ems*
1125 . (p1*xreftg(1,2,i)+p2*xreftg(2,2,i)+p3*xreftg(3,2,i))
1126 partsav(4,ip)=partsav(4,ip) + ems*
1127 . (p1*xreftg(1,3,i)+p2*xreftg(2,3,i)+p3*xreftg(3,3,i))
1128 xx = p1*xreftg(1,1,i)**2
1129 . + p2*xreftg(2,1,i)**2
1130 . + p3*xreftg(3,1,i)**2
1131 xy = p1*xreftg(1,1,i)*xreftg(1,2,i)
1132 . + p2*xreftg(2,1,i)*xreftg(2,2,i)
1133 . + p3*xreftg(3,1,i)*xreftg(3,2,i)
1134 yy = p1*xreftg(1,2,i)**2
1135 . + p2*xreftg(2,2,i)**2
1136 . + p3*xreftg(3,2,i)**2
1137 yz = p1*xreftg(1,2,i)*xreftg(1,3,i)
1138 . + p2*xreftg(2,2,i)*xreftg(2,3,i)
1139 . + p3*xreftg(3,2,i)*xreftg(3,3,i)
1140 zz = p1*xreftg(1,3,i)**2
1141 . + p2*xreftg(2,3,i)**2
1142 . + p3*xreftg(3,3,i)**2
1143 zx = p1*xreftg(1,3,i)*xreftg(1,1,i)
1144 . + p2*xreftg(2,3,i)*xreftg(2,1,i)
1145 . + p3*xreftg(3,3,i)*xreftg(3,1,i)
1146C
1147 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1148 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1149 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1150 partsav(8,ip) =partsav(8,ip) - ems * xy
1151 partsav(9,ip) =partsav(9,ip) - ems * yz
1152 partsav(10,ip)=partsav(10,ip) - ems * zx
1153C
1154 partsav(11,ip)=partsav(11,ip) + ems*
1155 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1156 partsav(12,ip)=partsav(12,ip) + ems*
1157 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1158 partsav(13,ip)=partsav(13,ip) + ems*
1159 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1160 partsav(14,ip)=partsav(14,ip) + half * ems *
1161 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1162 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1163 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1164 ENDDO
1165 ENDIF
1166 ELSEIF (istatcnd==0)THEN
1167 IF (nxref == 0) THEN
1168 DO i=lft,llt
1169 n=nft+i
1170 IF(sh3tree(3,n) >= 0)THEN
1171 p1 = ptg(1,i)
1172 p2 = ptg(2,i)
1173 p3 = ptg(3,i)
1174 ems = em(i)
1175 xin = xi(i)
1176C
1177 i1 = ix1(i)
1178 i2 = ix2(i)
1179 i3 = ix3(i)
1180 ip = ipart(i)
1181C
1182 partsav(1,ip)=partsav(1,ip) + ems
1183 partsav(2,ip)=partsav(2,ip) + ems*
1184 . (x(1,i1)*p1+x(1,i2)*p2+x(1,i3)*p3)
1185 partsav(3,ip)=partsav(3,ip) + ems*
1186 . (x(2,i1)*p1+x(2,i2)*p2+x(2,i3)*p3)
1187 partsav(4,ip)=partsav(4,ip) + ems*
1188 . (x(3,i1)*p1+x(3,i2)*p2+x(3,i3)*p3)
1189 xx = (x(1,i1)*x(1,i1)*p1+x(1,i2)*x(1,i2)*p2
1190 . +x(1,i3)*x(1,i3)*p3)
1191 xy = (x(1,i1)*x(2,i1)*p1+x(1,i2)*x(2,i2)*p2
1192 . +x(1,i3)*x(2,i3)*p3)
1193 yy = (x(2,i1)*x(2,i1)*p1+x(2,i2)*x(2,i2)*p2
1194 . +x(2,i3)*x(2,i3)*p3)
1195 yz = (x(2,i1)*x(3,i1)*p1+x(2,i2)*x(3,i2)*p2
1196 . +x(2,i3)*x(3,i3)*p3)
1197 zz = (x(3,i1)*x(3,i1)*p1+x(3,i2)*x(3,i2)*p2
1198 . +x(3,i3)*x(3,i3)*p3)
1199 zx = (x(3,i1)*x(1,i1)*p1+x(3,i2)*x(1,i2)*p2
1200 . +x(3,i3)*x(1,i3)*p3)
1201C
1202 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1203 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1204 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1205 partsav(8,ip) =partsav(8,ip) - ems * xy
1206 partsav(9,ip) =partsav(9,ip) - ems * yz
1207 partsav(10,ip)=partsav(10,ip) - ems * zx
1208C
1209 partsav(11,ip)=partsav(11,ip) + ems*
1210 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1211 partsav(12,ip)=partsav(12,ip) + ems*
1212 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1213 partsav(13,ip)=partsav(13,ip) + ems*
1214 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1215 partsav(14,ip)=partsav(14,ip) + half * ems *
1216 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1217 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1218 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1219 END IF
1220 END DO
1221 ELSE
1222 DO i=lft,llt
1223 n=nft+i
1224 IF (sh3tree(3,n) >= 0)THEN
1225 p1 = ptg(1,i)
1226 p2 = ptg(2,i)
1227 p3 = ptg(3,i)
1228 ems = em(i)
1229 xin = xi(i)
1230C
1231 i1 = ix1(i)
1232 i2 = ix2(i)
1233 i3 = ix3(i)
1234 ip = ipart(i)
1235C
1236 partsav(1,ip)=partsav(1,ip) + ems
1237 partsav(2,ip)=partsav(2,ip) + ems*
1238 . (p1*xreftg(1,1,i)+p2*xreftg(2,1,i)+p3*xreftg(3,1,i))
1239 partsav(3,ip)=partsav(3,ip) + ems*
1240 . (p1*xreftg(1,2,i)+p2*xreftg(2,2,i)+p3*xreftg(3,2,i))
1241 partsav(4,ip)=partsav(4,ip) + ems*
1242 . (p1*xreftg(1,3,i)+p2*xreftg(2,3,i)+p3*xreftg(3,3,i))
1243 xx = p1*xreftg(1,1,i)**2
1244 . + p2*xreftg(2,1,i)**2
1245 . + p3*xreftg(3,1,i)**2
1246 xy = p1*xreftg(1,1,i)*xreftg(1,2,i)
1247 . + p2*xreftg(2,1,i)*xreftg(2,2,i)
1248 . + p3*xreftg(3,1,i)*xreftg(3,2,i)
1249 yy = p1*xreftg(1,2,i)**2
1250 . + p2*xreftg(2,2,i)**2
1251 . + p3*xreftg(3,2,i)**2
1252 yz = p1*xreftg(1,2,i)*xreftg(1,3,i)
1253 . + p2*xreftg(2,2,i)*xreftg(2,3,i)
1254 . + p3*xreftg(3,2,i)*xreftg(3,3,i)
1255 zz = p1*xreftg(1,3,i)**2
1256 . + p2*xreftg(2,3,i)**2
1257 . + p3*xreftg(3,3,i)**2
1258 zx = p1*xreftg(1,3,i)*xreftg(1,1,i)
1259 . + p2*xreftg(2,3,i)*xreftg(2,1,i)
1260 . + p3*xreftg(3,3,i)*xreftg(3,1,i)
1261C
1262 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1263 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1264 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1265 partsav(8,ip) =partsav(8,ip) - ems * xy
1266 partsav(9,ip) =partsav(9,ip) - ems * yz
1267 partsav(10,ip)=partsav(10,ip) - ems * zx
1268C
1269 partsav(11,ip)=partsav(11,ip) + ems*
1270 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1271 partsav(12,ip)=partsav(12,ip) + ems*
1272 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1273 partsav(13,ip)=partsav(13,ip) + ems*
1274 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1275 partsav(14,ip)=partsav(14,ip) + half * ems *
1276 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1277 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1278 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1279 END IF
1280 END DO
1281 ENDIF
1282 ELSE
1283 IF (nxref == 0) THEN
1284 DO i=lft,llt
1285 n=nft+i
1286 IF(sh3tree(3,n) == 0 .OR. sh3tree(3,n) == -1 )THEN
1287 p1 = ptg(1,i)
1288 p2 = ptg(2,i)
1289 p3 = ptg(3,i)
1290 ems = em(i)
1291 xin = xi(i)
1292C
1293 i1 = ix1(i)
1294 i2 = ix2(i)
1295 i3 = ix3(i)
1296 ip = ipart(i)
1297C
1298 partsav(1,ip)=partsav(1,ip) + ems
1299 partsav(2,ip)=partsav(2,ip) + ems*
1300 . (x(1,i1)*p1+x(1,i2)*p2+x(1,i3)*p3)
1301 partsav(3,ip)=partsav(3,ip) + ems*
1302 . (x(2,i1)*p1+x(2,i2)*p2+x(2,i3)*p3)
1303 partsav(4,ip)=partsav(4,ip) + ems*
1304 . (x(3,i1)*p1+x(3,i2)*p2+x(3,i3)*p3)
1305 xx = (x(1,i1)*x(1,i1)*p1+x(1,i2)*x(1,i2)*p2
1306 . +x(1,i3)*x(1,i3)*p3)
1307 xy = (x(1,i1)*x(2,i1)*p1+x(1,i2)*x(2,i2)*p2
1308 . +x(1,i3)*x(2,i3)*p3)
1309 yy = (x(2,i1)*x(2,i1)*p1+x(2,i2)*x(2,i2)*p2
1310 . +x(2,i3)*x(2,i3)*p3)
1311 yz = (x(2,i1)*x(3,i1)*p1+x(2,i2)*x(3,i2)*p2
1312 . +x(2,i3)*x(3,i3)*p3)
1313 zz = (x(3,i1)*x(3,i1)*p1+x(3,i2)*x(3,i2)*p2
1314 . +x(3,i3)*x(3,i3)*p3)
1315 zx = (x(3,i1)*x(1,i1)*p1+x(3,i2)*x(1,i2)*p2
1316 . +x(3,i3)*x(1,i3)*p3)
1317C
1318 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1319 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1320 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1321 partsav(8,ip) =partsav(8,ip) - ems * xy
1322 partsav(9,ip) =partsav(9,ip) - ems * yz
1323 partsav(10,ip)=partsav(10,ip) - ems * zx
1324C
1325 partsav(11,ip)=partsav(11,ip) + ems*
1326 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1327 partsav(12,ip)=partsav(12,ip) + ems*
1328 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1329 partsav(13,ip)=partsav(13,ip) + ems*
1330 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1331 partsav(14,ip)=partsav(14,ip) + half * ems *
1332 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1333 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1334 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1335 END IF
1336 END DO
1337 ELSE
1338 DO i=lft,llt
1339 n=nft+i
1340 IF(sh3tree(3,n) == 0 .OR. sh3tree(3,n) == -1 )THEN
1341 p1 = ptg(1,i)
1342 p2 = ptg(2,i)
1343 p3 = ptg(3,i)
1344 ems = em(i)
1345 xin = xi(i)
1346C
1347 i1 = ix1(i)
1348 i2 = ix2(i)
1349 i3 = ix3(i)
1350 ip = ipart(i)
1351C
1352 partsav(1,ip)=partsav(1,ip) + ems
1353 partsav(2,ip)=partsav(2,ip) + ems*
1354 . (p1*xreftg(1,1,i)+p2*xreftg(2,1,i)+p3*xreftg(3,1,i))
1355 partsav(3,ip)=partsav(3,ip) + ems*
1356 . (p1*xreftg(1,2,i)+p2*xreftg(2,2,i)+p3*xreftg(3,2,i))
1357 partsav(4,ip)=partsav(4,ip) + ems*
1358 . (p1*xreftg(1,3,i)+p2*xreftg(2,3,i)+p3*xreftg(3,3,i))
1359 xx = p1*xreftg(1,1,i)**2
1360 . + p2*xreftg(2,1,i)**2
1361 . + p3*xreftg(3,1,i)**2
1362 xy = p1*xreftg(1,1,i)*xreftg(1,2,i)
1363 . + p2*xreftg(2,1,i)*xreftg(2,2,i)
1364 . + p3*xreftg(3,1,i)*xreftg(3,2,i)
1365 yy = p1*xreftg(1,2,i)**2
1366 . + p2*xreftg(2,2,i)**2
1367 . + p3*xreftg(3,2,i)**2
1368 yz = p1*xreftg(1,2,i)*xreftg(1,3,i)
1369 . + p2*xreftg(2,2,i)*xreftg(2,3,i)
1370 . + p3*xreftg(3,2,i)*xreftg(3,3,i)
1371 zz = p1*xreftg(1,3,i)**2
1372 . + p2*xreftg(2,3,i)**2
1373 . + p3*xreftg(3,3,i)**2
1374 zx = p1*xreftg(1,3,i)*xreftg(1,1,i)
1375 . + p2*xreftg(2,3,i)*xreftg(2,1,i)
1376 . + p3*xreftg(3,3,i)*xreftg(3,1,i)
1377C
1378 partsav(5,ip) =partsav(5,ip) + xin + ems * (yy+zz)
1379 partsav(6,ip) =partsav(6,ip) + xin + ems * (zz+xx)
1380 partsav(7,ip) =partsav(7,ip) + xin + ems * (xx+yy)
1381 partsav(8,ip) =partsav(8,ip) - ems * xy
1382 partsav(9,ip) =partsav(9,ip) - ems * yz
1383 partsav(10,ip)=partsav(10,ip) - ems * zx
1384C
1385 partsav(11,ip)=partsav(11,ip) + ems*
1386 . (v(1,i1)*p1+v(1,i2)*p2+v(1,i3)*p3)
1387 partsav(12,ip)=partsav(12,ip) + ems*
1388 . (v(2,i1)*p1+v(2,i2)*p2+v(2,i3)*p3)
1389 partsav(13,ip)=partsav(13,ip) + ems*
1390 . (v(3,i1)*p1+v(3,i2)*p2+v(3,i3)*p3)
1391 partsav(14,ip)=partsav(14,ip) + half * ems *
1392 . ((v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1))*p1
1393 . +(v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))*p2
1394 . +(v(1,i3)*v(1,i3)+v(2,i3)*v(2,i3)+v(3,i3)*v(3,i3))*p3)
1395 END IF
1396 END DO
1397 ENDIF
1398 END IF
1399C-----
1400 IF(jthe > 0 ) THEN
1401 IF(nintemp > 0 ) THEN
1402 DO i= lft,llt
1403 IF(temp(ix1(i))== zero) temp(ix1(i)) = pm(79,imat)
1404 IF(temp(ix2(i))== zero) temp(ix2(i)) = pm(79,imat)
1405 IF(temp(ix3(i))== zero) temp(ix3(i)) = pm(79,imat)
1406 ENDDO
1407 ELSE
1408 DO i=lft,llt
1409 temp(ix1(i))= pm(79,imat)
1410 temp(ix2(i))= pm(79,imat)
1411 temp(ix3(i))= pm(79,imat)
1412 ENDDO
1413 ENDIF
1414 ENDIF
1415C----------------------------------------------
1416C INITIALISATION DES RIGIDITES NODALES POUR INTERFACES
1417C----------------------------------------------
1418 IF (igtyp == 52 .OR. ((igtyp == 17 .OR. igtyp == 51) .AND. igmat > 0))THEN
1419 IF(i7stifs/=0)THEN
1420 DO i=lft,llt
1421 et=stack%PM(2,isubstack)*thk(i)
1422 sttg(i)=et
1423 nshnod(ix1(i))=nshnod(ix1(i))+1
1424 nshnod(ix2(i))=nshnod(ix2(i))+1
1425 nshnod(ix3(i))=nshnod(ix3(i))+1
1426 ENDDO
1427 ENDIF
1428 ELSEIF(igtyp == 11 .AND. igmat > 0) THEN
1429 ipgmat = 700
1430 IF(i7stifs/=0)THEN
1431 DO i=lft,llt
1432 et=geo(ipgmat +2 ,iprop)*thk(i)
1433 sttg(i)=et
1434 nshnod(ix1(i))=nshnod(ix1(i))+1
1435 nshnod(ix2(i))=nshnod(ix2(i))+1
1436 nshnod(ix3(i))=nshnod(ix3(i))+1
1437 ENDDO
1438 ENDIF
1439 ElSE
1440 IF(i7stifs/=0)THEN
1441 DO i=lft,llt
1442 et=pm(20,imat)*thk(i)
1443 sttg(i)=et
1444 nshnod(ix1(i))=nshnod(ix1(i))+1
1445 nshnod(ix2(i))=nshnod(ix2(i))+1
1446 nshnod(ix3(i))=nshnod(ix3(i))+1
1447 ENDDO
1448 ENDIF
1449 ENDIF ! IGMAT
1450 DEALLOCATE(thk_it,pos_it, laypos,ratio_thkly )
1451C-----------
1452 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
max
#define max(a, b)
Definition macros.h:21
drape_mod
Definition drape_mod.F:54
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
stack_mod
Definition stack_mod.F:72
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804