OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
scinit3.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| atheri ../starter/source/ale/atheri.F
30!|| dtmain ../starter/source/materials/time_step/dtmain.F
31!|| failini ../starter/source/elements/solid/solide/failini.F
32!|| fretitl2 ../starter/source/starter/freform.F
33!|| matini ../starter/source/materials/mat_share/matini.F
34!|| sbulk3 ../starter/source/elements/solid/solide/sbulk3.F
35!|| sccoor3 ../starter/source/elements/thickshell/solidec/sccoor3.F
36!|| scderi3 ../starter/source/elements/thickshell/solidec/scderi3.F
37!|| scmorth3 ../starter/source/elements/thickshell/solidec/scmorth3.F
38!|| sczero3 ../starter/source/elements/thickshell/solidec/scinit3.F
39!|| sdlen3 ../starter/source/elements/solid/solide/sdlen3.F
40!|| sdlensh ../starter/source/elements/thickshell/solidec/scinit3.F
41!|| sigin20b ../starter/source/elements/solid/solide20/s20mass3.F
42!|| smass3 ../starter/source/elements/solid/solide/smass3.F
43!|| svalue0 ../starter/source/elements/thickshell/solidec/scinit3.F
44!||--- uses -----------------------------------------------------
45!|| detonators_mod ../starter/share/modules1/detonators_mod.F
46!|| message_mod ../starter/share/message_module/message_mod.F
47!||====================================================================
48 SUBROUTINE scinit3(ELBUF_STR,
49 . MAS ,IXS ,PM ,X ,MSS ,
50 . DETONATORS,GEO ,VEUL ,ALE_CONNECTIVITY,IPARG ,
51 . DTELEM ,SIGI ,NEL ,SKEW ,IGEO ,
52 . STIFN ,PARTSAV ,V ,IPARTS ,IPART ,
53 . SIGSP ,NSIGI ,MSNF ,MSSF ,IPM ,
54 . IUSER ,NSIGS ,VOLNOD ,BVOLNOD ,VNS ,
55 . BNS ,WMA ,PTSOL ,BUFMAT ,MCP ,
56 . MCPS ,TEMP ,NPF ,TF ,MSSA ,
57 . STRSGLOB ,STRAGLOB ,ORTHOGLOB ,FAIL_INI ,ILOADP,
58 . FACLOAD ,RNOISE ,PERTURB ,GLOB_THERM,MAT_PARAM)
59C-----------------------------------------------
60C D e s c r i p t i o n
61C Initialize 8-nodes thick shell HQEPH, co-rotational formulation
62C-----------------------------------------------
63C M o d u l e s
64C-----------------------------------------------
65 USE message_mod
66 USE elbufdef_mod
70 USE glob_therm_mod
71 USE matparam_def_mod
72 use element_mod , only : nixs
73C-----------------------------------------------
74C I m p l i c i t T y p e s
75C-----------------------------------------------
76#include "implicit_f.inc"
77C-----------------------------------------------
78C G l o b a l P a r a m e t e r s
79C-----------------------------------------------
80#include "mvsiz_p.inc"
81C-----------------------------------------------
82C C o m m o n B l o c k s
83C-----------------------------------------------
84#include "com04_c.inc"
85#include "param_c.inc"
86#include "scr12_c.inc"
87#include "scr17_c.inc"
88#include "scry_c.inc"
89#include "vect01_c.inc"
90C-----------------------------------------------
91C D u m m y A r g u m e n t s
92C-----------------------------------------------
93 INTEGER NEL,NSIGI, IUSER, NSIGS
94 INTEGER IXS(NIXS,*),IPARG(*),IPARTS(*),IPART(LIPART1,*),
95 . IPM(NPROPMI,*),PTSOL(*), NPF(*),IGEO(NPROPGI,*),
96 . STRSGLOB(*),STRAGLOB(*),ORTHOGLOB(*),FAIL_INI(*),PERTURB(NPERTURB)
97 my_real
98 . MAS(*), PM(NPROPM,*), X(*), GEO(NPROPG,*),
99 . VEUL(LVEUL,*), DTELEM(*),SIGI(NSIGS,*),SKEW(LSKEW,*),STIFN(*),
100 . PARTSAV(20,*), V(*), MSS(8,*),
101 . SIGSP(NSIGI, *),MSNF(*), MSSF(8,*), WMA(*),
102 . VOLNOD(*), BVOLNOD(*), VNS(8,*), BNS(8,*), BUFMAT(*),
103 . mcp(*),mcps(8,*),temp(*), tf(*), mssa(*),rnoise(nperturb,*)
104 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
105 INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
106 my_real,INTENT(IN) :: FACLOAD(LFACLOAD,*)
107 TYPE(detonators_struct_)::DETONATORS
108 TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
109 type (glob_therm_) ,intent(in) :: glob_therm
110 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
111C-----------------------------------------------
112C L o c a l V a r i a b l e s
113C-----------------------------------------------
114 INTEGER NF1, IBID, I, NLAY,IGTYP,NLYMAX,IS,NUVAR,IREP,NCC,JHBE,
115 . idef, ip, ipang, ipthk, ippos, ipmat,ig,im,mtn0,ipid1,
116 . nptr,npts,nptt,l_pla,l_sigb
117 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
118 . ix5(mvsiz), ix6(mvsiz), ix7(mvsiz), ix8(mvsiz)
119 INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ) , MAT0(MVSIZ)
120 CHARACTER(LEN=NCHARTITLE)::TITR1
121 my_real
122 . BID, FV, STI, ZI,WI
123 my_real
124 . v8loc(51,mvsiz),volu(mvsiz),dtx(mvsiz),vzl(mvsiz),vzq(mvsiz),
125 . x1(mvsiz),x2(mvsiz),x3(mvsiz),x4(mvsiz),x5(mvsiz),x6(mvsiz),
126 . x7(mvsiz),x8(mvsiz),y1(mvsiz),y2(mvsiz),y3(mvsiz),y4(mvsiz),
127 . y5(mvsiz),y6(mvsiz),y7(mvsiz),y8(mvsiz),z1(mvsiz),z2(mvsiz),
128 . z3(mvsiz),z4(mvsiz),z5(mvsiz),z6(mvsiz),z7(mvsiz),z8(mvsiz),
129 . rx(mvsiz) ,ry(mvsiz) ,rz(mvsiz) ,sx(mvsiz) ,
130 . sy(mvsiz) ,sz(mvsiz) ,tx(mvsiz) ,ty(mvsiz) ,
131 . tz(mvsiz) ,e1x(mvsiz),e1y(mvsiz),e1z(mvsiz),e2x(mvsiz),
132 . e2y(mvsiz),e2z(mvsiz),e3x(mvsiz),e3y(mvsiz),e3z(mvsiz),
133 . f1x(mvsiz) ,f1y(mvsiz) ,f1z(mvsiz) ,
134 . f2x(mvsiz) ,f2y(mvsiz) ,f2z(mvsiz) ,gama(6,mvsiz),
135 . rhocp(mvsiz) ,temp0(mvsiz),angle(mvsiz),dtx0(mvsiz),
136 . deltax(mvsiz), aire(mvsiz),llsh(mvsiz)
137 my_real, DIMENSION(8,MVSIZ) :: bid8mvsiz
138 my_real, DIMENSION(MVSIZ) :: bidmvsiz
139 my_real :: tempel(nel)
140C--------------------------------
141C-----------------------------------------------
142 TYPE(g_bufel_) ,POINTER :: GBUF
143 TYPE(BUF_LAY_) ,POINTER :: BUFLY
144 TYPE(L_BUFEL_) ,POINTER :: LBUF
145 TYPE(BUF_MAT_) ,POINTER :: MBUF
146C-----------------------------------------------
147 my_real
148 . w_gauss(9,9),a_gauss(9,9)
149C-----------------------------------------------
150 DATA w_gauss /
151 1 2. ,0. ,0. ,
152 1 0. ,0. ,0. ,
153 1 0. ,0. ,0. ,
154 2 1. ,1. ,0. ,
155 2 0. ,0. ,0. ,
156 2 0. ,0. ,0. ,
157 3 0.555555555555556,0.888888888888889,0.555555555555556,
158 3 0. ,0. ,0. ,
159 3 0. ,0. ,0. ,
160 4 0.347854845137454,0.652145154862546,0.652145154862546,
161 4 0.347854845137454,0. ,0. ,
162 4 0. ,0. ,0. ,
163 5 0.236926885056189,0.478628670499366,0.568888888888889,
164 5 0.478628670499366,0.236926885056189,0. ,
165 5 0. ,0. ,0. ,
166 6 0.171324492379170,0.360761573048139,0.467913934572691,
167 6 0.467913934572691,0.360761573048139,0.171324492379170,
168 6 0. ,0. ,0. ,
169 7 0.129484966168870,0.279705391489277,0.381830050505119,
170 7 0.417959183673469,0.381830050505119,0.279705391489277,
171 7 0.129484966168870,0. ,0. ,
172 8 0.101228536290376,0.222381034453374,0.313706645877887,
173 8 0.362683783378362,0.362683783378362,0.313706645877887,
174 8 0.222381034453374,0.101228536290376,0. ,
175 9 0.081274388361574,0.180648160694857,0.260610696402935,
176 9 0.312347077040003,0.330239355001260,0.312347077040003,
177 9 0.260610696402935,0.180648160694857,0.081274388361574/
178 DATA a_gauss /
179 1 0. ,0. ,0. ,
180 1 0. ,0. ,0. ,
181 1 0. ,0. ,0. ,
182 2 -.577350269189626,0.577350269189626,0. ,
183 2 0. ,0. ,0. ,
184 2 0. ,0. ,0. ,
185 3 -.774596669241483,0. ,0.774596669241483,
186 3 0. ,0. ,0. ,
187 3 0. ,0. ,0. ,
188 4 -.861136311594053,-.339981043584856,0.339981043584856,
189 4 0.861136311594053,0. ,0. ,
190 4 0. ,0. ,0. ,
191 5 -.906179845938664,-.538469310105683,0. ,
192 5 0.538469310105683,0.906179845938664,0. ,
193 5 0. ,0. ,0. ,
194 6 -.932469514203152,-.661209386466265,-.238619186083197,
195 6 0.238619186083197,0.661209386466265,0.932469514203152,
196 6 0. ,0. ,0. ,
197 7 -.949107912342759,-.741531185599394,-.405845151377397,
198 7 0. ,0.405845151377397,0.741531185599394,
199 7 0.949107912342759,0. ,0. ,
200 8 -.960289856497536,-.796666477413627,-.525532409916329,
201 8 -.183434642495650,0.183434642495650,0.525532409916329,
202 8 0.796666477413627,0.960289856497536,0. ,
203 9 -.968160239507626,-.836031107326636,-.613371432700590,
204 9 -.324253423403809,0. ,0.324253423403809,
205 9 0.613371432700590,0.836031107326636,0.968160239507626/
206C-----------------------------------------------
207C S o u r c e L i n e s
208C=======================================================================
209 gbuf => elbuf_str%GBUF
210 lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
211 mbuf => elbuf_str%BUFLY(1)%MAT(1,1,1)
212 bufly => elbuf_str%BUFLY(1)
213 nptr = elbuf_str%NPTR
214 npts = elbuf_str%NPTS
215 nptt = elbuf_str%NPTT
216 nlay = elbuf_str%NLAY
217C
218 jeul = iparg(11)
219 irep = iparg(35)
220 igtyp = iparg(38)
221 jhbe = iparg(23)
222 nf1=nft+1
223 IF (jcvt==1.AND.isorth/=0) jcvt=2
224 IF (igtyp /= 22) isorth = 0
225 ibid = 0
226 idef = 0
227C
228 DO i=1,nel
229 rhocp(i) = pm(69,ixs(1,nft+i))
230 temp0(i) = pm(79,ixs(1,nft+i))
231 ENDDO
232 CALL sccoor3(x ,ixs(1,nf1),geo ,mat ,pid ,ngl ,
233 . ix1 ,ix2 ,ix3 ,ix4 ,ix5 ,ix6 ,ix7 ,ix8 ,
234 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
235 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
236 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
237 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
238 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
239 . f1x ,f1y ,f1z ,f2x ,f2y ,f2z ,temp0, temp,glob_therm%NINTEMP)
240 IF (igtyp == 21 .OR. igtyp == 22) THEN
241 DO i=1,nel
242 angle(i) = geo(1,pid(i))
243 END DO
244 CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,gbuf%GAMA ,
245 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
246 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
247 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,1 ,
248 . orthoglob,ptsol,nel)
249 IF (igtyp == 22) THEN
250 nlymax= 200
251 ipang = 200
252 ipthk = ipang+nlymax
253 ippos = ipthk+nlymax
254 ipmat = 100
255 ig=pid(1)
256 mtn0=mtn
257 DO i=1,nel
258 mat0(i) = mat(i)
259 dtx0(i) = ep20
260 ENDDO
261 END IF
262 END IF
263 CALL scderi3(nel,gbuf%VOL,jeul,veul(1,nf1),geo ,
264 . vzl ,vzq ,ngl ,pid ,
265 . x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
266 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
267 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 , volu)
268C
269 CALL sdlen3(x1 ,x2 ,x3 ,x4 ,x5 ,x6 ,x7 ,x8 ,
270 . y1 ,y2 ,y3 ,y4 ,y5 ,y6 ,y7 ,y8 ,
271 . z1 ,z2 ,z3 ,z4 ,z5 ,z6 ,z7 ,z8 ,
272 . deltax, volu)
273 IF (idttsh > 0) THEN
274 CALL sdlensh(nel,llsh,
275 . x1, x2, x3, x4, x5, x6, x7, x8,
276 . y1, y2, y3, y4, y5, y6, y7, y8,
277 . z1, z2, z3, z4, z5, z6, z7, z8)
278 DO i=1,nel
279 IF (gbuf%IDT_TSH(i)>0)
280 . deltax(i)=max(llsh(i),deltax(i))
281 ENDDO
282 END IF
283C
284 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
285 DO i=1,nel
286 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
287 . + temp(ixs(4,i)) + temp(ixs(5,i))
288 . + temp(ixs(6,i)) + temp(ixs(7,i))
289 . + temp(ixs(8,i)) + temp(ixs(9,i)))
290 ENDDO
291 ELSE
292 tempel(1:nel) = temp0(1:nel)
293 END IF
294!
295 ip=0
296 CALL matini(pm ,ixs ,nixs ,x ,
297 . geo ,ale_connectivity ,detonators ,iparg ,
298 . sigi ,nel ,skew ,igeo ,
299 . ipart ,iparts ,
300 . mat ,ipm ,nsigs ,numsol ,ptsol ,
301 . ip ,ngl ,npf ,tf ,bufmat ,
302 . gbuf ,lbuf ,mbuf ,elbuf_str ,iloadp ,
303 . facload, deltax ,tempel ,mat_param )
304C
305 IF (igtyp == 22) CALL sczero3(gbuf%RHO,gbuf%SIG,gbuf%EINT,nel)
306C----------------------------------------
307C Thermal initialization
308 IF(jthe /=0) CALL atheri(mat,pm,gbuf%TEMP)
309C------------------------
310C Loop on integration points
311 DO is=1,nlay
312C
313 lbuf => elbuf_str%BUFLY(is)%LBUF(1,1,1)
314 mbuf => elbuf_str%BUFLY(is)%MAT(1,1,1)
315 l_pla = elbuf_str%BUFLY(is)%L_PLA
316 l_sigb= elbuf_str%BUFLY(is)%L_SIGB
317C
318 IF (igtyp == 22) THEN
319 zi = geo(ippos+is,ig)
320 wi = geo(ipthk+is,ig)
321 im=igeo(ipmat+is,ig)
322 mtn=nint(pm(19,im))
323 DO i=1,nel
324 mat(i)=im
325 angle(i) = geo(ipang+is,pid(i))
326 ENDDO
327 ELSE
328 zi = a_gauss(is,nlay)
329 wi = w_gauss(is,nlay)
330 ENDIF
331 DO i=1,nel
332 lbuf%VOL0DP(i) = half*wi*(gbuf%VOL(i)+vzl(i)*zi)
333 lbuf%VOL(i) = lbuf%VOL0DP(i)
334 ENDDO
335 IF (igtyp == 22)
336 . CALL scmorth3(pid ,geo ,igeo ,skew ,irep ,lbuf%GAMA ,
337 . rx ,ry ,rz ,sx ,sy ,sz ,tx ,ty ,tz ,
338 . e1x ,e1y ,e1z ,e2x ,e2y ,e2z ,e3x ,e3y ,e3z ,
339 . ngl ,angle,nsigi,sigsp,nsigs,sigi ,ixs(1,nf1) ,is ,
340 . orthoglob,ptsol,nel)
341C
342 IF (jthe == 0 .and. glob_therm%NINTEMP > 0) THEN
343 DO i=1,nel
344 tempel(i) = one_over_8 *(temp(ixs(2,i)) + temp(ixs(3,i))
345 . + temp(ixs(4,i)) + temp(ixs(5,i))
346 . + temp(ixs(6,i)) + temp(ixs(7,i))
347 . + temp(ixs(8,i)) + temp(ixs(9,i)))
348 ENDDO
349 ELSE
350 tempel(1:nel) = temp0(1:nel)
351 END IF
352!
353 CALL matini(pm ,ixs ,nixs ,x ,
354 . geo ,ale_connectivity ,detonators ,iparg ,
355 . sigi ,nel ,skew ,igeo ,
356 . ipart ,iparts,
357 . mat ,ipm ,nsigs ,numsol ,ptsol,
358 . is ,ngl ,npf ,tf ,bufmat,
359 . gbuf ,lbuf ,mbuf ,elbuf_str,iloadp,
360 . facload, deltax ,tempel ,mat_param )
361c
362 nuvar = elbuf_str%BUFLY(is)%NVAR_MAT
363 IF(mtn>=28)THEN
364 idef =1
365 ELSE
366 IF(mtn == 14 .OR. mtn == 12)THEN
367 idef =1
368 ELSEIF(mtn == 24)THEN
369 idef =1
370 ELSEIF(istrain == 1)THEN
371 IF(mtn == 1)THEN
372 idef =1
373 ELSEIF(mtn == 2)THEN
374 idef =1
375 ELSEIF(mtn == 4)THEN
376 idef =1
377 ELSEIF(mtn == 3.OR.mtn == 6.OR.mtn == 10.OR.
378 . mtn == 21.OR.mtn == 22.OR.mtn == 23.
379 . or.mtn == 49)THEN
380 idef =1
381 ENDIF
382 ENDIF
383 ENDIF
384c
385 CALL sigin20b(lbuf%SIG,
386 . pm, lbuf%VOL,sigsp,sigi,lbuf%EINT,lbuf%RHO,mbuf%VAR ,
387 . lbuf%STRA,ixs ,nixs,nsigi, is, nuvar,nel,iuser,idef,
388 . nsigs,strsglob,straglob,jhbe,igtyp,x,gbuf%GAMA,
389 . mat ,lbuf%PLA,l_pla,ptsol,lbuf%SIGB,l_sigb,ipm ,
390 . bufmat,lbuf%VOL0DP)
391 IF(igtyp == 22) THEN
392C
393 aire(:) = zero
394 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
395 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
396 . volu, dtx , igeo ,igtyp)
397C Average density, stresses, ...
398 CALL svalue0(
399 . lbuf%RHO,lbuf%VOL,lbuf%OFF,lbuf%SIG,lbuf%EINT,dtx,
400 . gbuf%RHO,gbuf%VOL,gbuf%OFF,gbuf%SIG,gbuf%EINT,dtx0,
401 . nel )
402 ENDIF
403 ENDDO ! IS=1,NLAY
404C----------------
405 IF(igtyp == 22) THEN
406 mtn=mtn0
407 DO i=1,nel
408 mat(i)=mat0(i)
409 ENDDO
410 ENDIF
411C----------------------------------------
412C Masses initialization
413 bid8mvsiz(1:8,1:mvsiz) = zero
414 bidmvsiz(1:mvsiz) = zero
415 CALL smass3(
416 . gbuf%RHO ,mas ,partsav ,x ,v ,
417 . iparts(nf1),mss(1,nf1),volu ,
418 . msnf ,mssf(1,nf1),bid ,
419 . bid ,bid8mvsiz ,wma ,rhocp ,mcp ,
420 . mcps(1,nf1),mssa ,bidmvsiz ,bidmvsiz ,gbuf%FILL,
421 . ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8)
422C----------------------------------------
423C Failure model initialization
424 CALL failini(elbuf_str,nptr,npts,nptt,nlay,
425 . ipm,sigsp,nsigi,fail_ini ,
426 . sigi,nsigs,ixs,nixs,ptsol,rnoise,perturb,bufmat)
427C------------------------------------------
428C Assemble nodal volumes and moduli for interface stiffness
429C Warning : IX1, IX2 ... IX8 <=> NC(MVSIZ,8)
430 IF(i7stifs/=0)THEN
431 ncc=8
432 CALL sbulk3(volu ,ix1 ,ncc,mat,pm ,
433 2 volnod,bvolnod,vns(1,nf1),bns(1,nf1),bid,
434 3 bid ,gbuf%FILL)
435 ENDIF
436C------------------------------------------
437C Time Step element
438 aire(:) = zero
439 CALL dtmain(geo ,pm ,ipm ,pid ,mat ,fv ,
440 . lbuf%EINT ,lbuf%TEMP ,lbuf%DELTAX ,lbuf%RK ,lbuf%RE ,bufmat, deltax, aire,
441 . volu, dtx , igeo ,igtyp)
442C
443 IF(igtyp == 22) THEN
444 DO i=1,nel
445 dtx(i)=dtx0(i)
446 ENDDO
447 ENDIF
448C
449 DO i=1,nel
450 IF (ixs(10,i+nft) /= 0) THEN
451 IF (igtyp < 20 .OR. igtyp > 22) THEN
452 ipid1=ixs(nixs-1,i+nft)
453 CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid1),ltitr)
454 CALL ancmsg(msgid=226,
455 . msgtype=msgerror,
456 . anmode=aninfo_blind_1,
457 . i1=igeo(1,ipid1),
458 . c1=titr1,
459 . i2=igtyp)
460 ENDIF
461 ENDIF
462 dtelem(nft+i)=dtx(i)
463C STI = 0.25 * RHO * VOL / (DT*DT)
464 sti = fourth * gbuf%FILL(i) * gbuf%RHO(i) * volu(i) /
465 . max(em20,dtx(i)*dtx(i))
466 stifn(ixs(2,i+nft))=stifn(ixs(2,i+nft))+sti
467 stifn(ixs(3,i+nft))=stifn(ixs(3,i+nft))+sti
468 stifn(ixs(4,i+nft))=stifn(ixs(4,i+nft))+sti
469 stifn(ixs(5,i+nft))=stifn(ixs(5,i+nft))+sti
470 stifn(ixs(6,i+nft))=stifn(ixs(6,i+nft))+sti
471 stifn(ixs(7,i+nft))=stifn(ixs(7,i+nft))+sti
472 stifn(ixs(8,i+nft))=stifn(ixs(8,i+nft))+sti
473 stifn(ixs(9,i+nft))=stifn(ixs(9,i+nft))+sti
474 END DO
475C-----------
476 RETURN
477 END SUBROUTINE scinit3
478!||====================================================================
479!|| svalue0 ../starter/source/elements/thickshell/solidec/scinit3.F
480!||--- called by ------------------------------------------------------
481!|| ig3dinit3 ../starter/source/elements/ige3d/ig3dinit3.F
482!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
483!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
484!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
485!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
486!||====================================================================
487 SUBROUTINE svalue0(RHO ,VOL ,OFF ,SIG ,EINT ,DTX ,
488 . RHOG,VOLG,OFFG,SIGG,EINTG,DTXG,
489 . NEL )
490C
491C-----------------------------------------------
492C I m p l i c i t T y p e s
493C-----------------------------------------------
494#include "implicit_f.inc"
495C-----------------------------------------------
496C D u m m y A r g u m e n t s
497C-----------------------------------------------
498 INTEGER NEL
499 my_real
500 . rho(*), vol(*),sig(nel,6),eint(*),off(*),dtx(*),
501 . sigg(nel,6),eintg(*),rhog(*),offg(*),volg(*),dtxg(*)
502C-----------------------------------------------
503C L o c a l V a r i a b l e s
504C-----------------------------------------------
505 INTEGER I
506 my_real
507 . FAC
508C
509 DO I=1,nel
510 fac = off(i)*vol(i)/volg(i)
511 sigg(i,1) = sigg(i,1) + fac * sig(i,1)
512 sigg(i,2) = sigg(i,2) + fac * sig(i,2)
513 sigg(i,3) = sigg(i,3) + fac * sig(i,3)
514 sigg(i,4) = sigg(i,4) + fac * sig(i,4)
515 sigg(i,5) = sigg(i,5) + fac * sig(i,5)
516 sigg(i,6) = sigg(i,6) + fac * sig(i,6)
517 rhog(i) = rhog(i) + fac * rho(i)
518 eintg(i) = eintg(i) + fac * eint(i)
519 dtxg(i) = min(dtxg(i),dtx(i))
520 ENDDO
521C
522 RETURN
523 END SUBROUTINE svalue0
524C.....
525!||====================================================================
526!|| sczero3 ../starter/source/elements/thickshell/solidec/scinit3.F
527!||--- called by ------------------------------------------------------
528!|| ig3dinit3 ../starter/source/elements/ige3d/ig3dinit3.F
529!|| s6cinit3 ../starter/source/elements/thickshell/solide6c/s6cinit3.F
530!|| s8cinit3 ../starter/source/elements/thickshell/solide8c/s8cinit3.F
531!|| s8zinit3 ../starter/source/elements/solid/solide8z/s8zinit3.F
532!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
533!||====================================================================
534 SUBROUTINE sczero3(RHOG,SIGG,EINTG,NEL)
535C-----------------------------------------------
536C I m p l i c i t T y p e s
537C-----------------------------------------------
538#include "implicit_f.inc"
539C-----------------------------------------------
540C D u m m y A r g u m e n t s
541C-----------------------------------------------
542 INTEGER NEL
543 my_real
544 . SIGG(NEL,6),EINTG(*),RHOG(*)
545C-----------------------------------------------
546C L o c a l V a r i a b l e s
547C-----------------------------------------------
548 INTEGER I
549C
550 DO I=1,nel
551 sigg(i,1) = zero
552 sigg(i,2) = zero
553 sigg(i,3) = zero
554 sigg(i,4) = zero
555 sigg(i,5) = zero
556 sigg(i,6) = zero
557 rhog(i) = zero
558 eintg(i) = zero
559 ENDDO
560C
561 RETURN
562 END SUBROUTINE sczero3
563!||====================================================================
564!|| sdlensh ../starter/source/elements/thickshell/solidec/scinit3.F
565!||--- called by ------------------------------------------------------
566!|| scinit3 ../starter/source/elements/thickshell/solidec/scinit3.F
567!||--- calls -----------------------------------------------------
568!|| clsys3 ../starter/source/elements/thickshell/solidec/scinit3.F
569!||====================================================================
570 SUBROUTINE sdlensh(NEL,LLSH,
571 . X1, X2, X3, X4, X5, X6, X7, X8,
572 . Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
573 . Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8)
574C-----------------------------------------------
575C I m p l i c i t T y p e s
576C-----------------------------------------------
577#include "implicit_f.inc"
578C-----------------------------------------------
579C G l o b a l P a r a m e t e r s
580C-----------------------------------------------
581#include "mvsiz_p.inc"
582C-----------------------------------------------
583C C o m m o n B l o c k s
584C-----------------------------------------------
585#include "scr17_c.inc"
586C-----------------------------------------------
587C D u m m y A r g u m e n t s
588C-----------------------------------------------
589 INTEGER :: NEL
590 my_real,DIMENSION(MVSIZ),INTENT(IN) ::
591 . X1, X2, X3, X4, X5, X6, X7, X8,
592 . Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8,
593 . Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8
594 my_real,DIMENSION(MVSIZ),INTENT(OUT) :: LLSH
595C-----------------------------------------------
596C L o c a l V a r i a b l e s
597C-----------------------------------------------
598 INTEGER I, J, N
599 my_real
600 . RX(MVSIZ),RY(MVSIZ),RZ(MVSIZ),SX(MVSIZ),SY(MVSIZ),SZ(MVSIZ),
601 . VQ(MVSIZ,3,3), LXYZ0(3),DETA1(MVSIZ),XX,YY,ZZ,
602 . XL2(MVSIZ),XL3(MVSIZ),XL4(MVSIZ),YL2(MVSIZ),
603 . YL3(MVSIZ),YL4(MVSIZ),ZL1(MVSIZ),AREA(MVSIZ),
604 . xn(mvsiz,4) , yn(mvsiz,4) , zn(mvsiz,4)
605 my_real
606 . al1,al2,ll(mvsiz),corel(2,4)
607 my_real
608 . x13,x24,y13,y24,l13,l24,c1,c2,thkly,posly,
609 . fac,visce,rx1,ry1,sx1,sy1,s1,fac1,fac2,faci,fac11,facdt
610C=======================================================================
611 DO i=1,nel
612 xn(i,1) = half*(x1(i)+x5(i))
613 yn(i,1) = half*(y1(i)+y5(i))
614 zn(i,1) = half*(z1(i)+z5(i))
615 xn(i,2) = half*(x2(i)+x6(i))
616 yn(i,2) = half*(y2(i)+y6(i))
617 zn(i,2) = half*(z2(i)+z6(i))
618 xn(i,3) = half*(x3(i)+x7(i))
619 yn(i,3) = half*(y3(i)+y7(i))
620 zn(i,3) = half*(z3(i)+z7(i))
621 xn(i,4) = half*(x4(i)+x8(i))
622 yn(i,4) = half*(y4(i)+y8(i))
623 zn(i,4) = half*(z4(i)+z8(i))
624 ENDDO
625C------g1,g2 :
626 DO i=1,nel
627 rx(i)=xn(i,2)+xn(i,3)-xn(i,1)-xn(i,4)
628 ry(i)=yn(i,2)+yn(i,3)-yn(i,1)-yn(i,4)
629 rz(i)=zn(i,2)+zn(i,3)-zn(i,1)-zn(i,4)
630 sx(i)=xn(i,3)+xn(i,4)-xn(i,1)-xn(i,2)
631 sy(i)=yn(i,3)+yn(i,4)-yn(i,1)-yn(i,2)
632 sz(i)=zn(i,3)+zn(i,4)-zn(i,1)-zn(i,2)
633 ENDDO
634C------Local elem. base:
635 CALL clsys3(rx, ry, rz, sx, sy, sz,
636 . vq, deta1,nel ,mvsiz)
637C------ Global -> Local Coordinate FOURTH=0.25 ;
638 DO i=1,nel
639 lxyz0(1)=fourth*(xn(i,1)+xn(i,2)+xn(i,3)+xn(i,4))
640 lxyz0(2)=fourth*(yn(i,1)+yn(i,2)+yn(i,3)+yn(i,4))
641 lxyz0(3)=fourth*(zn(i,1)+zn(i,2)+zn(i,3)+zn(i,4))
642 xx=xn(i,2)-xn(i,1)
643 yy=yn(i,2)-yn(i,1)
644 zz=zn(i,2)-zn(i,1)
645 xl2(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
646 yl2(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
647 xx=xn(i,2)-lxyz0(1)
648 yy=yn(i,2)-lxyz0(2)
649 zz=zn(i,2)-lxyz0(3)
650 zl1(i)=vq(i,1,3)*xx+vq(i,2,3)*yy+vq(i,3,3)*zz
651C
652 xx=xn(i,3)-xn(i,1)
653 yy=yn(i,3)-yn(i,1)
654 zz=zn(i,3)-zn(i,1)
655 xl3(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
656 yl3(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
657C
658 xx=xn(i,4)-xn(i,1)
659 yy=yn(i,4)-yn(i,1)
660 zz=zn(i,4)-zn(i,1)
661 xl4(i)=vq(i,1,1)*xx+vq(i,2,1)*yy+vq(i,3,1)*zz
662 yl4(i)=vq(i,1,2)*xx+vq(i,2,2)*yy+vq(i,3,2)*zz
663 area(i)=fourth*deta1(i)
664 ENDDO
665 fac = two
666 facdt = five_over_4
667C-------same as QBAT
668 IF (idt1sol>0) facdt =four_over_3
669C---- compute COREL(2,4) mean surface and area
670 DO i=1,nel
671 lxyz0(1)=fourth*(xl2(i)+xl3(i)+xl4(i))
672 lxyz0(2)=fourth*(yl2(i)+yl3(i)+yl4(i))
673 corel(1,1)=-lxyz0(1)
674 corel(1,2)=xl2(i)-lxyz0(1)
675 corel(1,3)=xl3(i)-lxyz0(1)
676 corel(1,4)=xl4(i)-lxyz0(1)
677 corel(2,1)=-lxyz0(2)
678 corel(2,2)=yl2(i)-lxyz0(2)
679 corel(2,3)=yl3(i)-lxyz0(2)
680 corel(2,4)=yl4(i)-lxyz0(2)
681 x13=(corel(1,1)-corel(1,3))*half
682 x24=(corel(1,2)-corel(1,4))*half
683 y13=(corel(2,1)-corel(2,3))*half
684 y24=(corel(2,2)-corel(2,4))*half
685C
686 l13=x13*x13+y13*y13
687 l24=x24*x24+y24*y24
688 al1=max(l13,l24)
689 c1 =corel(1,2)*corel(2,4)-corel(2,2)*corel(1,4)
690 c2 =corel(1,1)*corel(2,3)-corel(2,1)*corel(1,3)
691 al2 =max(abs(c1),abs(c2))/area(i)
692 rx1=x24-x13
693 ry1=y24-y13
694 sx1=-x24-x13
695 sy1=-y24-y13
696 c1=sqrt(rx1*rx1+ry1*ry1)
697 c2=sqrt(sx1*sx1+sy1*sy1)
698 s1=fourth*(max(c1,c2)/min(c1,c2)-one)
699 fac1=min(half,s1)+one
700 fac2=area(i)/(c1*c2)
701 fac2=3.413*max(zero,fac2-0.7071)
702 fac2=0.78+0.22*fac2*fac2*fac2
703 faci=two*fac1*fac2
704 s1 = sqrt(faci*(facdt+al2)*al1)
705 s1 = max(s1,em20)
706 llsh(i) = area(i)/s1
707 ENDDO
708C
709 RETURN
710 END SUBROUTINE sdlensh
711!||====================================================================
712!|| clsys3 ../starter/source/elements/thickshell/solidec/scinit3.F
713!||--- called by ------------------------------------------------------
714!|| sdlensh ../starter/source/elements/thickshell/solidec/scinit3.F
715!|| sdlensh14 ../starter/source/elements/thickshell/solide8c/sdlensh14.F
716!||====================================================================
717 SUBROUTINE clsys3(RX, RY, RZ, SX, SY, SZ, VQ, DET, NEL,MVSIZ)
718C-----------------------------------------------
719C I m p l i c i t T y p e s
720C-----------------------------------------------
721#include "implicit_f.inc"
722C-----------------------------------------------
723C D u m m y A r g u m e n t s
724C-----------------------------------------------
725 INTEGER ,INTENT(IN) :: NEL,MVSIZ
726C
727 my_real,DIMENSION(MVSIZ),INTENT(IN) ::
728 . RX , RY , RZ,
729 . SX , SY , SZ
730 my_real,DIMENSION(MVSIZ),INTENT(OUT) :: DET
731 my_real,DIMENSION(MVSIZ,3,3),INTENT(OUT) :: VQ
732C-----------------------------------------------
733C C o m m o n B l o c k s
734C-----------------------------------------------
735C---------+---------+---+---+--------------------------------------------
736C VAR | SIZE |TYP| RW| DEFINITION
737C---------+---------+---+---+--------------------------------------------
738C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
739C RX | NEL | R | R | X-of covariant vector g1
740C RY | NEL | R | R | Y-of covariant vector g1
741C RZ | NEL | R | R | Z-of covariant vector g1
742C SX | NEL | R | R | X-of covariant vector g2
743C SY | NEL | R | R | Y-of covariant vector g2
744C SZ | NEL | R | R | Z-of covariant vector g2
745C VQ |3*3*NEL | R | W | Local elem sys bases
746C DET | NEL | R | W | det of g1 ^ g2
747C---------+---------+---+---+--------------------------------------------
748C-----------------------------------------------
749C L o c a l V a r i a b l e s
750C-----------------------------------------------
751 INTEGER I
752C
753 my_real
754 . E1X(NEL), E1Y(NEL), E1Z(NEL),
755 . E2X(NEL), E2Y(NEL), E2Z(NEL),
756 . E3X(NEL), E3Y(NEL), E3Z(NEL),
757 . C1,C2,CC,C1C1,C2C2,C1_1,C2_1
758C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
759 DO I=1,nel
760C---------E3------------
761 e3x(i) = ry(i) * sz(i) - rz(i) * sy(i)
762 e3y(i) = rz(i) * sx(i) - rx(i) * sz(i)
763 e3z(i) = rx(i) * sy(i) - ry(i) * sx(i)
764 det(i) = sqrt(e3x(i)*e3x(i) + e3y(i)*e3y(i) + e3z(i)*e3z(i))
765C ----- EM20=1.0E-20
766 det(i) = max(em20,det(i))
767 e3x(i) = e3x(i) / det(i)
768 e3y(i) = e3y(i) / det(i)
769 e3z(i) = e3z(i) / det(i)
770 ENDDO
771C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
772 DO i=1,nel
773 c1c1 = rx(i)*rx(i) + ry(i)*ry(i) + rz(i)*rz(i)
774 c2c2 = sx(i)*sx(i) + sy(i)*sy(i) + sz(i)*sz(i)
775C ----- ZERO=0., ONE=1.0
776 IF(c1c1 /= zero) THEN
777 c2_1 = sqrt(c2c2/max(em20,c1c1))
778 c1_1 = one
779 ELSEIF(c2c2 /= zero)THEN
780 c2_1 = one
781 c1_1 = sqrt(c1c1/max(em20,c2c2))
782 END IF
783 e1x(i) = rx(i)*c2_1+(sy(i)*e3z(i)-sz(i)*e3y(i))*c1_1
784 e1y(i) = ry(i)*c2_1+(sz(i)*e3x(i)-sx(i)*e3z(i))*c1_1
785 e1z(i) = rz(i)*c2_1+(sx(i)*e3y(i)-sy(i)*e3x(i))*c1_1
786 ENDDO
787C
788 DO i=1,nel
789 c1 = sqrt(e1x(i)*e1x(i) + e1y(i)*e1y(i) + e1z(i)*e1z(i))
790 IF ( c1 /= zero) c1 = one / max(em20,c1)
791 e1x(i) = e1x(i)*c1
792 e1y(i) = e1y(i)*c1
793 e1z(i) = e1z(i)*c1
794 e2x(i) = e3y(i) * e1z(i) - e3z(i) * e1y(i)
795 e2y(i) = e3z(i) * e1x(i) - e3x(i) * e1z(i)
796 e2z(i) = e3x(i) * e1y(i) - e3y(i) * e1x(i)
797 ENDDO
798 DO i=1,nel
799 vq(i,1,1)=e1x(i)
800 vq(i,2,1)=e1y(i)
801 vq(i,3,1)=e1z(i)
802 vq(i,1,2)=e2x(i)
803 vq(i,2,2)=e2y(i)
804 vq(i,3,2)=e2z(i)
805 vq(i,1,3)=e3x(i)
806 vq(i,2,3)=e3y(i)
807 vq(i,3,3)=e3z(i)
808 ENDDO
809C-----------
810 RETURN
811 END SUBROUTINE clsys3
subroutine atheri(mat, pm, temp)
Definition atheri.F:42
#define my_real
Definition cppsort.cpp:32
subroutine dtmain(geo, pm, ipm, pid, mat, fv, eint, temp, deltax, rk, re, bufmat, ddeltax, aire, vol, dtx, igeo, igtyp)
Definition dtmain.F:68
subroutine failini(elbuf_str, nptr, npts, nptt, nlay, ipm, sigsp, nsigi, fail_ini, sigi, nsigs, ix, nix, pt, rnoise, perturb, mat_param)
Definition failini.F:44
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
subroutine matini(pm, ix, nix, x, geo, ale_connectivity, detonators, iparg, sigi, nel, skew, igeo, ipart, ipartel, mat, ipm, nsig, nums, pt, ipt, ngl, npf, tf, bufmat, gbuf, lbuf, mbuf, elbuf_str, iloadp, facload, ddeltax, tempel, mat_param)
Definition matini.F:83
integer, parameter nchartitle
subroutine sigin20b(sig, pm, vol, sigsp, sigi, eint, rho, uvar, eps, ix, nix, nsigi, ipt, nuvar, nel, iuser, idef, nsigs, strsglob, straglob, jhbe, igtyp, x, bufgama, mat, epsp, l_pla, pt, sigb, l_sigb, ipm, bufmat, voldp)
Definition s20mass3.F:351
subroutine sbulk3(volu, nc, nnc, mat, pm, volnod, bvolnod, vns, bns, vnsx, bnsx, fill)
Definition sbulk3.F:43
subroutine sccoor3(x, ixs, geo, mxt, ngeo, ngl, ix1, ix2, ix3, ix4, ix5, ix6, ix7, ix8, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, rx, ry, rz, sx, sy, sz, tx, ty, tz, r11, r21, r31, r12, r22, r32, r13, r23, r33, f1x, f1y, f1z, f2x, f2y, f2z, temp0, temp, nintemp)
Definition sccoor3.F:43
subroutine sczero3(rhog, sigg, eintg, nel)
Definition scinit3.F:535
subroutine sdlensh(nel, llsh, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8)
Definition scinit3.F:574
subroutine scinit3(elbuf_str, mas, ixs, pm, x, mss, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, nel, skew, igeo, stifn, partsav, v, iparts, ipart, sigsp, nsigi, msnf, mssf, ipm, iuser, nsigs, volnod, bvolnod, vns, bns, wma, ptsol, bufmat, mcp, mcps, temp, npf, tf, mssa, strsglob, straglob, orthoglob, fail_ini, iloadp, facload, rnoise, perturb, glob_therm, mat_param)
Definition scinit3.F:59
subroutine svalue0(rho, vol, off, sig, eint, dtx, rhog, volg, offg, sigg, eintg, dtxg, nel)
Definition scinit3.F:490
subroutine clsys3(rx, ry, rz, sx, sy, sz, vq, det, nel, mvsiz)
Definition scinit3.F:718
subroutine scmorth3(pid, geo, igeo, skew, irep, gama, rx, ry, rz, sx, sy, sz, tx, ty, tz, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, ngl, angle, nsigi, sigsp, nsigs, sigi, ixs, ilay, orthoglob, pt, nel)
Definition scmorth3.F:40
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3.F:44
subroutine sdlen3(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, deltax, voln)
Definition sdlen3.F:41
subroutine scderi3(nel, vol, jeul, veul, geo, vzl, vzq, ngl, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, det)
Definition scderi3.F:37
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:895
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799