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 INTEGER IGBR, JGBR, IOK
72 CHARACTER MESS*40
73 CHARACTER(LEN=NCHARKEY) :: KEY2, KEY3
74C=======================================================================
75 nfilsol=0
76 numsol =0
77 numquad=0
78 numshel=0
79 numtrus=0
80 numbeam=0
81 numspri=0
82 numsh3n=0
83 nvshell0 = 33
84 nushell0 = 4
85 nortshel0 = 5
86 nvar_shell = 0
87 nubeam0 = 4
88 nubeam = 0
89 nvbeam = 0
90 nvspri = 0
91 nvtruss = 0
92 nvsh_stra =0
93!
94 IF (isigi==3.OR.isigi==4.OR.isigi==5) THEN
95C
96C FICHIER Y000, Block CONTROL
97C
98 rewind(iin5)
99C
100 300 READ(iin5,fmt='(A)',END=309,ERR=399)line
101 IF(line(1:8)/='/CONTROL')GOTO 300
102 READ(iin5,fmt='(A)',END=309,ERR=399)line
103 305 READ(iin5,fmt='(A)',END=309,ERR=399)line
104 IF(line(1:1)=='#')GOTO 305
105C
106 IF (ioutp_fmt==2) THEN
107 IF(line(1:8)==' ')GOTO 305
108C
109 ELSE
110 IF(line(1:10)==' ')GOTO 305
111 END IF
112C
113 IF(line(1:1)=='/')GOTO 309
114 306 READ(iin5,fmt='(A)',END=309,ERR=399)line
115 IF(line(1:1)=='#')GOTO 306
116C
117 IF (ioutp_fmt==2) THEN
118 IF(line(1:8)==' ')GOTO 306
119C
120 ELSE
121 IF(line(1:10)==' ')GOTO 306
122 END IF
123C
124 IF(line(1:1)=='/')GOTO 309
125 IF (ioutp_fmt==2) THEN
126 READ(line,'(8I8)')
127 . numsol,numquad,numshel,numtrus,numbeam,numspri,numsh3n,
128 . numsphy
129C
130 ELSE
131 READ(line,'(8I10)')
132 . numsol,numquad,numshel,numtrus,numbeam,numspri,numsh3n,
133 . numsphy
134C
135 END IF
136 309 CONTINUE
137C
138 iufacyld = 0
139 iushell = 0
140 nushell = 0
141 nvshell1 = 0
142 nvshell2 = 0
143 iusolid = 0
144 nusolid = 0
145 nvsolid1 = 0
146 nvsolid2 = 0
147 nvsolid3 = 0
148 nvsolid4 = 0
149 nvsolid5 = 0
150 nvsolid6 = 0
151 rewind(iin4)
152 400 READ(iin4,fmt='(A)',END=449,ERR=449)line
153 IF(line(1:8)=='/ENDDATA')THEN
154 rewind(iin4)
155 GO TO 409
156 ENDIF
157 IF(line(1:28)/='/SHELL /SCALAR /USERS')GOTO 400
158 READ(iin4,fmt='(A)',END=449,ERR=449)line
159 iushell = 1
160C
161 i = 0
162 j = 0
163 405 READ(iin4,fmt='(A)',END=449,ERR=449)line
164 IF(line(1:1)=='#')GOTO 405
165 IF(line(1:1)=='/')GOTO 410
166 j=j+1
167 i=i+1
168 IF(j>numshel+numsh3n) GOTO 410
169 IF(ioutp_fmt==2)THEN
170 READ(line,fmt='(4I8)')ihbe,nip,npg,nuvar
171 ELSE
172 READ(line,fmt='(4I10)')ihbe,nip,npg,nuvar
173 ENDIF
174 nushell = max(nushell,max(1,npg)*max(1,nip)*nuvar + nushell0)
175 nd = mod(nuvar,6)
176 nu = (nuvar - nd)/6
177 IF(nd/=0) nu = nu +1
178 IF(nuvar < 6) nu = 1
179C --- coque standard.
180 DO j1 = 1,nu * max(1,nip)*max(1,npg)
181 406 READ(iin4,fmt='(A)',END=449,ERR=449)line
182 IF(line(1:1)=='#')GOTO 406
183 IF(line(1:1)=='/')GOTO 410
184 ENDDO
185 GO TO 405
186 449 CONTINUE
187C-----------------------------------------------------------------
188C FICHIER Ynnn
189C stress/full
190C NIP + THK + ENER + STRESS + EPS PLASTIC
191C-----------------------------------------------------------------
192 409 READ(iin4,fmt='(A)',END=443,ERR=399)line
193 IF(line(1:8)=='/ENDDATA')THEN
194 rewind(iin4)
195 GOTO 425
196 ENDIF
197 410 IF(line(1:33)/='/SHELL /TENSOR /STRESS_FUL')GOTO 409
198C
199 READ(iin4,fmt='(A)',END=443,ERR=499)line
200C
201 i = 0
202 j = 0
203C
204 411 READ(iin4,fmt='(A)',END=443,ERR=499)line
205 IF(line(1:1)=='#')GOTO 411
206 IF(line(1:1)=='/')GOTO 443
207 j=j+1
208 i=i+1
209C
210 IF(j>numshel+numsh3n) GOTO 420
211 IF (ioutp_fmt==2) THEN
212 READ(line,'(2I8)')nip,npg
213 ELSE
214 READ(line,fmt=fmt_2i) nip,npg
215 ENDIF
216C
217 READ(iin4,fmt='(A)',END=443,ERR=499)line
218 IF(nip==0)THEN
219 nvar_shell = max(nvar_shell, max(1,npg)*9)
220 ELSE
221 nvar_shell = max(nvar_shell, max(1,nip)*max(1,npg)*6)
222 ENDIF
223C
224 nvshell = nvar_shell
225 IF (npg==0.OR.npg==1)THEN
226 IF(nip==0)THEN
227 READ(iin4,fmt='(A)',END=443,ERR=399)line
228 READ(iin4,fmt='(A)',END=443,ERR=399)line
229 ELSE
230 DO k=1,nip
231 READ(iin4,fmt='(A)',END=443,ERR=399)line
232 ENDDO
233 ENDIF
234 ELSEIF(npg>1) THEN
235 IF(nip==0)THEN
236 DO n=1,npg
237 READ(iin4,fmt='(A)',END=443,ERR=399)line
238 READ(iin4,fmt='(A)',END=443,ERR=399)line
239 ENDDO
240 ELSE
241c PT = 60
242 DO k=1,nip
243 DO n=1,npg
244 READ(iin4,fmt='(A)',END=443,ERR=399)line
245C PT = PT + 6
246 ENDDO
247 ENDDO
248 ENDIF
249 ELSE
250 ENDIF
251 GO TO 411
252 443 CONTINUE
253 rewind(iin4)
254C /solid/tensor/stress/full
255c -----
256C STRESS FULL + ELstoplastic + energy+ RHO in each point integration
257 425 READ(iin4,fmt='(A)',END=429,ERR=399)line
258 IF(line(1:8) == '/ENDDATA')THEN
259 rewind(iin4)
260 GOTO 429
261 ENDIF
262 420 IF(line(1:30) /= '/SOLID /TENSOR /STR_FUL')GOTO 425
263 READ(iin4,fmt='(A)',END=429,ERR=399)line
264C
265 i = 0
266 j = 0
267 426 READ(iin4,fmt='(A)',END=429,ERR=399)line
268 IF(line(1:1) == '#')GOTO 426
269 IF(line(1:1) == '/')GOTO 429
270 i=i+1
271 IF(i > numsol+numquad) GOTO 450
272
273 IF (ioutp_fmt == 2) THEN
274 READ(line,'(3I8)')nip,nums,jjhbe
275 ELSE
276 READ(line,'(3I10)')nip,nums, jjhbe
277 ENDIF
278 nvsolid1 = max(nvsolid1,nip*9 + 4)
279 IF((nums == 8.OR.nums == 4).AND.jjhbe == 0)THEN
280C
281 READ(iin4,fmt='(A)',END=429,ERR=399)line
282 IF(nip == 1)THEN
283 READ(iin4,fmt='(A)',END=429,ERR=399)line
284 READ(iin4,fmt='(A)',END=429,ERR=399)line
285 ELSE
286 DO k=1,nip
287 READ(iin4,fmt='(A)',END=429,ERR=399)line
288 READ(iin4,fmt='(A)',END=429,ERR=399)line
289 ENDDO
290 ENDIF
291 ELSEIF(nums == 10 .OR. nums == 16 .OR. nums == 20.OR.
292 . (nums == 8.AND.jjhbe == 14) .or .(nums == 8.AND.jjhbe == 17).OR.
293 . ((nums == 6.OR.nums == 8) .AND. (jjhbe==15 .or. jjhbe==12)))THEN
294C
295 DO k=1,nip
296 READ(iin4,fmt='(A)',END=429,ERR=399)line
297 READ(iin4,fmt='(A)',END=429,ERR=399)line
298 ENDDO
299 ENDIF
300 GO TO 426
301C
302 429 CONTINUE
303 rewind(iin4)
304C
305
306
307 230 READ(iin4,fmt='(A)',END=235,ERR=399)line
308 IF(line(1:8)=='/ENDDATA')THEN
309 rewind(iin4)
310 GOTO 430
311 ENDIF
312 232 IF(line(1:33)/='/SOLID /TENSOR /STRESS')GOTO 230
313 READ(iin4,fmt='(A)',END=235,ERR=399)line
314C
315 nvsolid1 = max(nvsolid1, 6)
316 235 CONTINUE
317 rewind(iin4)
318
319C
320 430 READ(iin4,fmt='(A)',END=435,ERR=399)line
321 IF(line(1:8)=='/ENDDATA')THEN
322 rewind(iin4)
323 GOTO 444
324 ENDIF
325 432 IF(line(1:33)/='/SOLID /TENSOR /STRAIN_FUL')GOTO 430
326 READ(iin4,fmt='(A)',END=435,ERR=399)line
327C
328 i = 0
329 j = 0
330 434 READ(iin4,fmt='(A)',END=435,ERR=399)line
331 IF(line(1:1)=='#')GOTO 434
332 IF(line(1:1)=='/')GOTO 435
333 j=j+1
334 i=i+1
335 IF(i>numsol+numquad) GOTO 435
336 IF (ioutp_fmt==2) THEN
337 READ(line,'(3I8)')nip,nums,nels
338 ELSE
339 READ(line,'(3I10)')nip,nums, nels
340 ENDIF
341 nvsolid2 = max(nvsolid2, max(1,nip)*6)
342 DO kk = 1, nels
343 DO k=1,nip
344 READ(iin4,fmt='(A)',END=435,ERR=399)line
345 ENDDO
346 ENDDO
347 GOTO 434
348 435 CONTINUE
349 rewind(iin4)
350C Brick ( variables users)
351 444 READ(iin4,fmt='(A)',END=499,ERR=499)line
352 IF(line(1:8)=='/ENDDATA')THEN
353 rewind(iin4)
354 GOTO 498
355 ENDIF
356 450 IF(line(1:28)/='/SOLID /SCALAR /USERS')GOTO 444
357 READ(iin4,fmt='(A)',END=498,ERR=399)line
358 iusolid = 1
359 i = 0
360 455 READ(iin4,fmt='(A)',END=498,ERR=399)line
361 IF(line(1:1)=='#')GOTO 455
362 IF(line(1:1)=='/')GOTO 498
363 IF(ioutp_fmt==2)THEN
364 READ(line,'(4I8)')nums,nip,nuvar,jjhbe
365 ELSE
366 READ(line,'(4I10)')nums,nip,nuvar,jjhbe
367 ENDIF
368 nusolid = max(nusolid,nip*nuvar)
369 i=i+1
370 nd = mod(nuvar,6)
371 nu = (nuvar - nd)/6
372 IF(nd/=0) nu = nu + 1
373 IF(nuvar < 6) nu = max(1,nip)
374 IF(i>numsol+numquad) GOTO 498
375 IF (nuvar==0) GOTO 455
376 DO j1 = 1,nu * max(1,nip)
377 459 READ(iin4,fmt='(A)',END=498,ERR=399)line
378 IF(line(1:1)=='#')GOTO 459
379 IF(line(1:1)=='/')GOTO 498
380 ENDDO
381cc ENDIF
382 GO TO 455
383 498 CONTINUE
384 499 CONTINUE
385 nvshell = nvshell + nvshell0
386 rewind(iin4)
387 ENDIF
388!-----------
389 RETURN
390 399 CONTINUE
391 CALL ancmsg(msgid=557, msgtype=msgerror, anmode=aninfo_blind_1)
392 999 CALL freerr(3)
393 RETURN
394 END
395
396!||====================================================================
397!|| uel2sys ../starter/source/initial_conditions/inista/yctrl.F
398!||--- called by ------------------------------------------------------
399!|| hm_read_inistate_d00 ../starter/source/elements/initia/hm_read_inistate_d00.F
400!|| hm_yctrl ../starter/source/elements/initia/hm_yctrl.F
401!|| iniboltprel ../starter/source/loads/bolt/iniboltprel.f
402!|| initag_preload_a ../starter/source/loads/general/preload/hm_read_preload_axial.f90
403!|| initia ../starter/source/elements/initia/initia.F
404!|| lec_inistate_tri ../starter/source/elements/initia/lec_inistate_tri.F
405!|| lecfill ../starter/source/elements/initia/lecfill.F
406!||====================================================================
407 INTEGER FUNCTION uel2sys(IU,KSYSUSR,NUMEL)
408C INTERNAL ID FROM USER ID IU (0 IF IT DOES NOT EXIST)
409C-----------------------------------------------
410C I m p l i c i t T y p e s
411C-----------------------------------------------
412#include "implicit_f.inc"
413C-----------------------------------------------
414C D u m m y A r g u m e n t s
415C-----------------------------------------------
416 INTEGER iu,ksysusr(*),numel
417C-----------------------------------------------
418C L o c a l V a r i a b l e s
419C-----------------------------------------------
420 INTEGER jinf, jsup, j
421 IF (numel == 0) THEN
422 uel2sys=0
423 RETURN
424 ENDIF
425 jinf=1
426 jsup=numel
427 j=max(1,numel/2)
428 10 IF(jsup<=jinf.AND.(iu-ksysusr(j))/=0) THEN
429 uel2sys=0
430 RETURN
431 ENDIF
432 IF((iu-ksysusr(j))==0)THEN
433C >CASE IU=USR SEARCH IS ENDING
434 uel2sys=ksysusr(j+numel)
435 RETURN
436 ELSE IF (iu-ksysusr(j)<0) THEN
437C >CASE IU<USR
438 jsup=j-1
439 ELSE
440C >CASE IU>USR
441 jinf=j+1
442 ENDIF
443 j=max(1,(jsup+jinf)/2)
444 GO TO 10
445 END
iniboltprel
subroutine iniboltprel(ixs, ipreload, preload, vpreload, iflag_bpreload)
Definition iniboltprel.F:34
max
#define max(a, b)
Definition macros.h:21
groupdef_mod
Definition groupdef_mod.F:662
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
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
freerr
subroutine freerr(it)
Definition freform.F:506
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:408