OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
yctrl.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!|| yctrl ../starter/source/initial_conditions/inista/yctrl.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.f
29!||--- uses -----------------------------------------------------
30!|| format_mod ../starter/share/modules1/format_mod.F90
31!|| message_mod ../starter/share/message_module/message_mod.F
32!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
33!||====================================================================
34 SUBROUTINE yctrl(IGRBRIC)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE groupdef_mod
39 USE message_mod
40 USE names_and_titles_mod , ONLY : ncharkey
41 USE format_mod , ONLY : fmt_2i
42 USE reader_old_mod , ONLY : line
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C G l o b a l P a r a m e t e r s
49C-----------------------------------------------
50 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scry_c.inc"
55#include "scr16_c.inc"
56#include "scr17_c.inc"
57#include "com01_c.inc"
58#include "com04_c.inc"
59#include "units_c.inc"
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER
64 . I,J,NGAUSS,NLAYER ,
65 . NUMS,NIP,NUVAR,JJHBE,J1,NU,IP,N,NPSOLID,
66 . K,IHBE,NPG,ND,NVAR_SHELL,NPT,NE,
67 . NVSHELL0,NUSHELL0,NORTSHEL0,NUSOLID0,NELS,KK,JJ,
68 . ISOLNOD,ISOLID,IFRAM,IORTH,IREP,IGTYP,ISH3N,NDIR,NLAYERS,
69 . UID,SUB_ID,NLAY,NPTR,NPTS,NPTT,IFAIL,IRUPT_TYP,NVAR_RUPT,
70 . ILAY,IMAT,NPT_MAX,NUBEAM0,NVSH_STRA,ISMSTR
71 CHARACTER MESS*40
72 CHARACTER(LEN=NCHARKEY) :: KEY2, KEY3
73C=======================================================================
74 nfilsol=0
75 numsol =0
76 numquad=0
77 numshel=0
78 numtrus=0
79 numbeam=0
80 numspri=0
81 numsh3n=0
82 nvshell0 = 33
83 nushell0 = 4
84 nortshel0 = 5
85 nvar_shell = 0
86 nubeam0 = 4
87 nubeam = 0
88 nvbeam = 0
89 nvspri = 0
90 nvtruss = 0
91 nvsh_stra =0
92!
93 IF (isigi==3.OR.isigi==4.OR.isigi==5) THEN
94C
95C Y000 FILE, Block CONTROL
96C
97 rewind(iin5)
98C
99 300 READ(iin5,fmt='(A)',END=309,ERR=399)line
100 IF(line(1:8)/='/CONTROL')GOTO 300
101 READ(iin5,fmt='(A)',END=309,ERR=399)line
102 305 READ(iin5,fmt='(A)',END=309,ERR=399)line
103 IF(line(1:1)=='#')GOTO 305
104C
105 IF (ioutp_fmt==2) THEN
106 IF(line(1:8)==' ')GOTO 305
107C
108 ELSE
109 IF(line(1:10)==' ')GOTO 305
110 END IF
111C
112 IF(line(1:1)=='/')GOTO 309
113 306 READ(iin5,fmt='(A)',END=309,ERR=399)line
114 IF(line(1:1)=='#')GOTO 306
115C
116 IF (ioutp_fmt==2) THEN
117 IF(line(1:8)==' ')GOTO 306
118C
119 ELSE
120 IF(line(1:10)==' ')GOTO 306
121 END IF
122C
123 IF(line(1:1)=='/')GOTO 309
124 IF (ioutp_fmt==2) THEN
125 READ(line,'(8I8)')
126 . numsol,numquad,numshel,numtrus,numbeam,numspri,numsh3n,
127 . numsphy
128C
129 ELSE
130 READ(line,'(8I10)')
131 . numsol,numquad,numshel,numtrus,numbeam,numspri,numsh3n,
132 . numsphy
133C
134 END IF
135 309 CONTINUE
136C
137 iufacyld = 0
138 iushell = 0
139 nushell = 0
140 nvshell1 = 0
141 nvshell2 = 0
142 iusolid = 0
143 nusolid = 0
144 nvsolid1 = 0
145 nvsolid2 = 0
146 nvsolid3 = 0
147 nvsolid4 = 0
148 nvsolid5 = 0
149 nvsolid6 = 0
150 rewind(iin4)
151 400 READ(iin4,fmt='(A)',END=449,ERR=449)line
152 IF(line(1:8)=='/ENDDATA')THEN
153 rewind(iin4)
154 GO TO 409
155 ENDIF
156 IF(line(1:28)/='/SHELL /SCALAR /USERS')GOTO 400
157 READ(iin4,fmt='(A)',END=449,ERR=449)line
158 iushell = 1
159C
160 i = 0
161 j = 0
162 405 READ(iin4,fmt='(A)',END=449,ERR=449)line
163 IF(line(1:1)=='#')GOTO 405
164 IF(line(1:1)=='/')GOTO 410
165 j=j+1
166 i=i+1
167 IF(j>numshel+numsh3n) GOTO 410
168 IF(ioutp_fmt==2)THEN
169 READ(line,fmt='(4I8)')ihbe,nip,npg,nuvar
170 ELSE
171 READ(line,fmt='(4I10)')ihbe,nip,npg,nuvar
172 ENDIF
173 nushell = max(nushell,max(1,npg)*max(1,nip)*nuvar + nushell0)
174 nd = mod(nuvar,6)
175 nu = (nuvar - nd)/6
176 IF(nd/=0) nu = nu +1
177 IF(nuvar < 6) nu = 1
178C --- standard shell.
179 DO j1 = 1,nu * max(1,nip)*max(1,npg)
180 406 READ(iin4,fmt='(A)',END=449,ERR=449)line
181 IF(line(1:1)=='#')GOTO 406
182 IF(line(1:1)=='/')GOTO 410
183 ENDDO
184 GO TO 405
185 449 CONTINUE
186C-----------------------------------------------------------------
187C Ynnn FILE
188C stress/full
189C NIP + THK + ENER + STRESS + EPS PLASTIC
190C-----------------------------------------------------------------
191 409 READ(iin4,fmt='(A)',END=443,ERR=399)line
192 IF(line(1:8)=='/ENDDATA')THEN
193 rewind(iin4)
194 GOTO 425
195 ENDIF
196 410 IF(line(1:33)/='/SHELL /TENSOR /STRESS_FUL')GOTO 409
197C
198 READ(iin4,fmt='(A)',END=443,ERR=499)line
199C
200 i = 0
201 j = 0
202C
203 411 READ(iin4,fmt='(A)',END=443,ERR=499)line
204 IF(line(1:1)=='#')GOTO 411
205 IF(line(1:1)=='/')GOTO 443
206 j=j+1
207 i=i+1
208C
209 IF(j>numshel+numsh3n) GOTO 420
210 IF (ioutp_fmt==2) THEN
211 READ(line,'(2I8)')nip,npg
212 ELSE
213 READ(line,fmt=fmt_2i) nip,npg
214 ENDIF
215C
216 READ(iin4,fmt='(A)',END=443,ERR=499)line
217 IF(nip==0)THEN
218 nvar_shell = max(nvar_shell, max(1,npg)*9)
219 ELSE
220 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
221 ENDIF
222C
223 nvshell = nvar_shell
224 IF (npg==0.OR.npg==1)THEN
225 IF(nip==0)THEN
226 READ(iin4,fmt='(A)',END=443,ERR=399)line
227 READ(iin4,fmt='(A)',END=443,ERR=399)line
228 ELSE
229 DO k=1,nip
230 READ(iin4,fmt='(A)',END=443,ERR=399)line
231 ENDDO
232 ENDIF
233 ELSEIF(npg>1) THEN
234 IF(nip==0)THEN
235 DO n=1,npg
236 READ(iin4,fmt='(A)',END=443,ERR=399)line
237 READ(iin4,fmt='(A)',END=443,ERR=399)line
238 ENDDO
239 ELSE
240c PT = 60
241 DO k=1,nip
242 DO n=1,npg
243 READ(iin4,fmt='(A)',END=443,ERR=399)line
244C PT = PT + 6
245 ENDDO
246 ENDDO
247 ENDIF
248 ELSE
249 ENDIF
250 GO TO 411
251 443 CONTINUE
252 rewind(iin4)
253C /solid/tensor/stress/full
254c -----
255C STRESS FULL + ELstoplastic + energy+ RHO in each point integration
256 425 READ(iin4,fmt='(A)',END=429,ERR=399)line
257 IF(line(1:8) == '/ENDDATA')THEN
258 rewind(iin4)
259 GOTO 429
260 ENDIF
261 420 IF(line(1:30) /= '/SOLID /TENSOR /STR_FUL')GOTO 425
262 READ(iin4,fmt='(A)',END=429,ERR=399)line
263C
264 i = 0
265 j = 0
266 426 READ(iin4,fmt='(A)',END=429,ERR=399)line
267 IF(line(1:1) == '#')GOTO 426
268 IF(line(1:1) == '/')GOTO 429
269 i=i+1
270 IF(i > numsol+numquad) GOTO 450
271
272 IF (ioutp_fmt == 2) THEN
273 READ(line,'(3I8)')nip,nums,jjhbe
274 ELSE
275 READ(line,'(3I10)')nip,nums, jjhbe
276 ENDIF
277 nvsolid1 = max(nvsolid1,nip*9 + 4)
278 IF((nums == 8.OR.nums == 4).AND.jjhbe == 0)THEN
279C
280 READ(iin4,fmt='(A)',END=429,ERR=399)line
281 IF(nip == 1)THEN
282 READ(iin4,fmt='(A)',END=429,ERR=399)line
283 READ(iin4,fmt='(A)',END=429,ERR=399)line
284 ELSE
285 DO k=1,nip
286 READ(iin4,fmt='(A)',END=429,ERR=399)line
287 READ(iin4,fmt='(A)',END=429,ERR=399)line
288 ENDDO
289 ENDIF
290 ELSEIF(nums == 10 .OR. nums == 16 .OR. nums == 20.OR.
291 . (nums == 8.AND.jjhbe == 14) .or .(nums == 8.AND.jjhbe == 17).OR.
292 . ((nums == 6.OR.nums == 8) .AND. (jjhbe==15 .or. jjhbe==12)))THEN
293C
294 DO k=1,nip
295 READ(iin4,fmt='(A)',END=429,ERR=399)line
296 READ(iin4,fmt='(A)',END=429,ERR=399)line
297 ENDDO
298 ENDIF
299 GO TO 426
300C
301 429 CONTINUE
302 rewind(iin4)
303C
304
305
306 230 READ(iin4,fmt='(A)',END=235,ERR=399)line
307 IF(line(1:8)=='/ENDDATA')THEN
308 rewind(iin4)
309 GOTO 430
310 ENDIF
311 232 IF(line(1:33)/='/SOLID /TENSOR /STRESS')GOTO 230
312 READ(iin4,fmt='(A)',END=235,ERR=399)line
313C
314 nvsolid1 = max(nvsolid1, 6)
315 235 CONTINUE
316 rewind(iin4)
317
318C
319 430 READ(iin4,fmt='(A)',END=435,ERR=399)line
320 IF(line(1:8)=='/ENDDATA')THEN
321 rewind(iin4)
322 GOTO 444
323 ENDIF
324 432 IF(line(1:33)/='/SOLID /TENSOR /STRAIN_FUL')GOTO 430
325 READ(iin4,fmt='(A)',END=435,ERR=399)line
326C
327 i = 0
328 j = 0
329 434 READ(iin4,fmt='(A)',END=435,ERR=399)line
330 IF(line(1:1)=='#')GOTO 434
331 IF(line(1:1)=='/')GOTO 435
332 j=j+1
333 i=i+1
334 IF(i>numsol+numquad) GOTO 435
335 IF (ioutp_fmt==2) THEN
336 READ(line,'(3I8)')nip,nums,nels
337 ELSE
338 READ(line,'(3I10)')nip,nums, nels
339 ENDIF
340 nvsolid2 = max(nvsolid2, max(1,nip)*6)
341 DO kk = 1, nels
342 DO k=1,nip
343 READ(iin4,fmt='(A)',END=435,ERR=399)line
344 ENDDO
345 ENDDO
346 GOTO 434
347 435 CONTINUE
348 rewind(iin4)
349C Brick ( variables users)
350 444 READ(iin4,fmt='(A)',END=499,ERR=499)line
351 IF(line(1:8)=='/ENDDATA')THEN
352 rewind(iin4)
353 GOTO 498
354 ENDIF
355 450 IF(line(1:28)/='/SOLID /SCALAR /USERS')GOTO 444
356 READ(iin4,fmt='(A)',END=498,ERR=399)line
357 iusolid = 1
358 i = 0
359 455 READ(iin4,fmt='(A)',END=498,ERR=399)line
360 IF(line(1:1)=='#')GOTO 455
361 IF(line(1:1)=='/')GOTO 498
362 IF(ioutp_fmt==2)THEN
363 READ(line,'(4I8)')nums,nip,nuvar,jjhbe
364 ELSE
365 READ(line,'(4I10)')nums,nip,nuvar,jjhbe
366 ENDIF
367 nusolid = max(nusolid,nip*nuvar)
368 i=i+1
369 nd = mod(nuvar,6)
370 nu = (nuvar - nd)/6
371 IF(nd/=0) nu = nu + 1
372 IF(nuvar < 6) nu = max(1,nip)
373 IF(i>numsol+numquad) GOTO 498
374 IF (nuvar==0) GOTO 455
375 DO j1 = 1,nu * max(1,nip)
376 459 READ(iin4,fmt='(A)',END=498,ERR=399)line
377 IF(line(1:1)=='#')GOTO 459
378 IF(line(1:1)=='/')GOTO 498
379 ENDDO
380cc ENDIF
381 GO TO 455
382 498 CONTINUE
383 499 CONTINUE
384 nvshell = nvshell + nvshell0
385 rewind(iin4)
386 ENDIF
387!-----------
388 RETURN
389 399 CONTINUE
390 CALL ancmsg(msgid=557, msgtype=msgerror, anmode=aninfo_blind_1)
391 999 CALL freerr(3)
392 RETURN
393 END
394
395!||====================================================================
396!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
397!||--- called by ------------------------------------------------------
398!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
399!|| hm_yctrl ../starter/source/elements/initia/hm_yctrl.f
400!|| iniboltprel ../starter/source/loads/bolt/iniboltprel.F
401!|| initag_preload_a ../starter/source/loads/general/preload/hm_read_preload_axial.F90
402!|| initia ../starter/source/elements/initia/initia.f
403!|| lec_inistate_tri ../starter/source/elements/initia/lec_inistate_tri.F
404!|| lecfill ../starter/source/elements/initia/lecfill.F
405!||====================================================================
406 INTEGER FUNCTION uel2sys(IU,KSYSUSR,NUMEL)
407C INTERNAL ID FROM USER ID IU (0 IF IT DOES NOT EXIST)
408C-----------------------------------------------
409C I m p l i c i t T y p e s
410C-----------------------------------------------
411#include "implicit_f.inc"
412C-----------------------------------------------
413C D u m m y A r g u m e n t s
414C-----------------------------------------------
415 INTEGER iu,ksysusr(*),numel
416C-----------------------------------------------
417C L o c a l V a r i a b l e s
418C-----------------------------------------------
419 INTEGER jinf, jsup, j
420 IF (numel == 0) THEN
421 uel2sys=0
422 RETURN
423 ENDIF
424 jinf=1
425 jsup=numel
426 j=max(1,numel/2)
427 10 IF(jsup<=jinf.AND.(iu-ksysusr(j))/=0) THEN
428 uel2sys=0
429 RETURN
430 ENDIF
431 IF((iu-ksysusr(j))==0)THEN
432C >CASE IU=USR SEARCH IS ENDING
433 uel2sys=ksysusr(j+numel)
434 RETURN
435 ELSE IF (iu-ksysusr(j)<0) THEN
436C >CASE IU<USR
437 jsup=j-1
438 ELSE
439C >CASE IU>USR
440 jinf=j+1
441 ENDIF
442 j=max(1,(jsup+jinf)/2)
443 GO TO 10
444 END
hm_yctrl
subroutine hm_yctrl(unitab, lsubmodel, igrbric, ixc, ixtg, ptshel, ptsh3n, nusphcel)
Definition hm_yctrl.F:41
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine, lsigi, lsigsp, srnoise, nprw, lprw, rwstif_pen, sln_pen)
Definition initia.F:198
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:668
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
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:895
freerr
subroutine freerr(it)
Definition freform.F:501
starter
program starter
Definition starter.F:39
yctrl
subroutine yctrl(igrbric)
Definition yctrl.F:35
uel2sys
integer function uel2sys(iu, ksysusr, numel)
Definition yctrl.F:407