OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
frestat.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!|| frestat ../engine/source/input/frestat.F
25!||--- called by ------------------------------------------------------
26!|| freform ../engine/source/input/freform.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.f
30!|| fredec_8key_i ../engine/source/input/fredec_8key_i.F
31!|| state_init ../common_source/modules/output/state_file_mod.F90
32!|| wriusc2 ../engine/source/input/wriusc2.F
33!||--- uses -----------------------------------------------------
34!|| message_mod ../engine/share/message_module/message_mod.F
35!|| names_and_titles_mod ../common_source/modules/names_and_titles_mod.F
36!|| output_mod ../common_source/modules/output/output_mod.f90
37!|| sensor_mod ../common_source/modules/sensor_mod.F90
38!|| state_inimap_mod ../engine/share/modules/state_inimap_mod.F
39!||====================================================================
40 SUBROUTINE frestat(IKAD,KEY0,KSTATF,SENSORS,OUTPUT)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE state_inimap_mod
46 USE sensor_mod
47 USE names_and_titles_mod, ONLY: ncharline100,ncharkey,line120
48 USE output_mod
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER IKAD(0:*),
57 . KSTATF
58 CHARACTER KEY0(*)*5
59 TYPE (SENSORS_), INTENT(INOUT) :: SENSORS
60 TYPE(output_),INTENT(INOUT) :: OUTPUT
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "units_c.inc"
65#include "scr14_c.inc"
66#include "scr16_c.inc"
67#include "state_c.inc"
68C-----------------------------------------------
69C E x t e r n a l F u n c t i o n s
70C-----------------------------------------------
71 INTEGER NVAR
72C-----------------------------------------------
73C L o c a l V a r i a b l e s
74C-----------------------------------------------
75 INTEGER I, NBC, K, IKEY, IV2(10), J
76 CHARACTER(LEN=NCHARKEY)::KEY2
77 CHARACTER(LEN=NCHARKEY)::KEY3
78 CHARACTER(LEN=NCHARKEY)::KEY4
79 CHARACTER(LEN=NCHARKEY)::KEY5
80 CHARACTER(LEN=NCHARKEY)::KEY6
81 CHARACTER(LEN=NCHARKEY)::KEY7
82 CHARACTER(LEN=NCHARKEY)::KEY8
83 CHARACTER(LEN=NCHARLINE100)::CARTE
84 CHARACTER(LEN=LINE120) :: LINE
85 LOGICAL BOOL,IS_STAT_LSENS
86C-----------------------------------------------
87C S o u r c e L i n e s
88C-----------------------------------------------
89C-----------------------------------------------
90C Init OUTPUT%STATE
91C-----------------------------------------------
92 CALL state_init(output%STATE,mx_stat)
93C-----------------------------------------------
94 is_stat = .false.
95 is_stat_dt = .false.
96 is_stat_shell = .false.
97 is_stat_brick = .false.
98 is_stat_spring = .false.
99 is_stat_beam = .false.
100 is_stat_truss = .false.
101 is_stat_inimap1d = .false.
102 is_stat_inimap2d = .false.
103 is_stat_strf = .false.
104 is_stat_node = .false.
105 is_stat_lsens = .false.
106 is_stat_no_de = .false.
107 is_stat_inimap_file = .false.
108 is_stat_inimap_vp = .false.
109 is_stat_inimap_ve = .false.
110
111 ikey=kstatf
112
113 tstat0 = zero
114 dtstat0 = zero
115C-----MX_STAT=20
116 DO i = 1,mx_stat
117 stat_n(i) = 0
118 stat_c(i) = 0
119 stat_s(i) = 0
120 stat_r(i) = 0
121 stat_p(i) = 0
122 stat_t(i) = 0
123 ENDDO
124 DO i=1,mx_stat3
125 stat_inimap(i) = 0
126 ENDDO
127 nstatprt=0
128 nstatall=0
129
130 is_stat_inimap_single = .true.
131 is_stat_inimap_msg_already_displayed = .false.
132c---
133 IF (ikad(ikey) /= ikad(ikey+1)) THEN
134 k = 0
135 1175 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)')line
136 CALL fredec_8key_i(line,key2,key3,key4,key5,key6,key7,key8,nbc)
137 k=k+1
138 is_stat = .true.
139 IF (key2(1:5) == 'DT ') THEN
140 is_stat_dt = .true.
141 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
142 READ(iusc2,*)tstat0,dtstat0
143 k=k+1
144 IF (key3(1:3) == 'ALL') THEN
145 nstatprt = 0
146 nstatall = 1
147 IF (nbc /= 1) THEN
148 CALL ancmsg(msgid=73,anmode=aninfo,
149 . c1=key0(ikey),c2=line(1:35))
150 CALL arret(0)
151 ENDIF
152 ELSE
153 DO i=2,nbc
154 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
155 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
156 k=k+1
157 READ(iusc2,*,err=9990,END=9990)(IV2(J),J=1,NVAR(CARTE))
158 DO j=1,nvar(carte)
159 WRITE(iin,'(I10)')iv2(j)
160 nstatprt=nstatprt+1
161 ENDDO
162 ENDDO ! DO I=2,NBC
163 IF(nstatprt == 0)THEN
164 CALL ancmsg(msgid=289,anmode=aninfo)
165 CALL arret(0)
166 ENDIF
167 ENDIF
168 ELSEIF (key2(1:5) == 'STR_F') THEN
169 is_stat_strf = .true.
170 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
171 READ(iusc2,*,err=9990,END=9990)izipstrs
172 izipstrs = izipstrs + 1
173 ELSE
174 IF (key2(1:4) == 'NODE') THEN
175 is_stat_node = .true.
176 IF (key3(1:4) == 'TEMP') THEN
177 stat_n(1) = 1
178 ELSEIF (key3(1:3) == 'BCS') THEN
179 stat_n(2) = 1
180 ELSEIF (key3(1:3) == 'VEL') THEN
181 stat_n(3) = 1
182 ELSE
183 GOTO 9990
184 ENDIF
185 ELSEIF (key2(1:5) == 'SHELL') THEN
186 is_stat_shell = .true.
187 IF (key3(1:5) == 'OFF ') THEN
188 stat_c(1) = 1
189 ELSEIF (key3(1:5) == 'THICK') THEN
190 stat_c(2) = 1
191 ELSEIF (key3(1:5) == 'EPSP ') THEN
192 IF (key4(1:5) == 'FULL ') THEN
193 stat_c(3) = 1
194 ELSE
195 GOTO 9990
196 ENDIF
197 ELSEIF (key3(1:5) == 'STRES') THEN
198 IF (key4(1:5) == 'FULL ') THEN
199 stat_c(4) = 1
200 ELSEIF (key4(1:5) == 'GLOBF') THEN
201 stat_c(10) = 1
202 ELSE
203 GOTO 9990
204 ENDIF
205 ELSEIF (key3(1:5) == 'STRAI') THEN
206 IF (key4(1:5) == 'FULL ') THEN
207 stat_c(5) = 1
208 ELSEIF (key4(1:5) == 'GLOBF') THEN
209 stat_c(11) = 1
210 ELSE
211 GOTO 9990
212 ENDIF
213 ELSEIF (key3(1:3) == 'AUX') THEN
214 IF (key4(1:5) == 'FULL ') THEN
215 stat_c(6) = 1
216 ELSE
217 GOTO 9990
218 ENDIF
219 ELSEIF (key3(1:5) == 'ORTHL') THEN
220 stat_c(7) = 1
221 ELSEIF (key3(1:4) == 'FAIL') THEN
222 stat_c(8) = 1
223 ELSE
224 GOTO 9990
225 ENDIF ! IF (KEY3)
226 ELSEIF (key2(1:5) == 'BRICK') THEN
227 is_stat_brick = .true.
228 IF (key3(1:5) == 'STRES') THEN
229 IF (key4(1:5) == 'FULL ') THEN
230 stat_s(4) = 1
231 ELSEIF (key4(1:5) == 'GLOBF') THEN
232 stat_s(8) = 1
233 ELSE
234 GOTO 9990
235 ENDIF
236 ELSEIF (key3(1:5) == 'STRAI') THEN
237 IF (key4(1:5) == 'FULL ') THEN
238 stat_s(5) = 1
239 ELSEIF (key4(1:5) == 'GLOBF') THEN
240 stat_s(9) = 1
241 ELSE
242 GOTO 9990
243 ENDIF
244 ELSEIF (key3(1:3) == 'AUX') THEN
245 IF (key4(1:5) == 'FULL ') THEN
246 stat_s(6) = 1
247 ELSE
248 GOTO 9990
249 ENDIF
250 ELSEIF (key3(1:5) == 'ORTHO') THEN
251 IF (key4(1:5) == 'GLOBF ') THEN
252 stat_s(10) = 1
253 ELSE
254 stat_s(7) = 1
255 ENDIF
256 ELSEIF (key3(1:4) == 'FAIL') THEN
257 stat_s(11) = 1
258 ELSEIF (key3(1:4) == 'EREF') THEN
259 stat_s(13) = 1
260 ELSE
261 GOTO 9990
262 ENDIF
263 ELSEIF (key2(1:6) == 'SPHCEL') THEN
264 output%STATE%IS_STAT_SPH = .true.
265 IF (key3(1:4) == 'FULL') THEN
266 output%STATE%STAT_SPH(3) = 1
267 ELSE
268 CALL ancmsg(msgid=73,anmode=aninfo,
269 . c1=key0(ikey),c2=line(1:35))
270 ENDIF
271 ELSEIF (key2(1:5) == 'LSENS') THEN
272 is_stat_lsens = .true.
273 DO i=1,nbc
274 READ(iusc1,rec=ikad(ikey)+k,fmt='(A)',err=9990)carte
275 CALL wriusc2(ikad(ikey)+k,1,key0(ikey))
276 k=k+1
277 READ(iusc2,*,err=9990,END=9990)
278 . (sensors%STAT_TMP(j),j=1,nvar(carte))
279 sensors%NSTAT = sensors%NSTAT + nvar(carte)
280 ENDDO
281 ELSEIF (key2(1:5) == 'NO_DE') THEN
282 is_stat_no_de = .true.
283 stat_c(9) = 1
284 stat_s(12) = 1
285 stat_r(2) = 1
286 stat_p(2) = 1
287 stat_t(2) = 1
288 output%STATE%STAT_SPH(2) = 1
289 ELSEIF (key2(1:5) == 'SPRIN') THEN
290 is_stat_spring = .true.
291 IF (key3(1:4) == 'FULL') THEN
292 stat_r(1) = 1
293 ELSE
294 GOTO 9990
295 ENDIF
296 ELSEIF (key2(1:4) == 'BEAM') THEN
297 is_stat_beam = .true.
298 IF (key3(1:4) == 'FULL') THEN
299 stat_p(1) = 1
300 ELSEIF (key3(1:3) == 'AUX') THEN
301 stat_p(3) = 1
302 ELSE
303 GOTO 9990
304 ENDIF
305 ELSEIF (key2(1:5) == 'TRUSS') THEN
306 is_stat_truss = .true.
307 IF (key3(1:4) == 'FULL') THEN
308 stat_t(1) = 1
309 ELSE
310 GOTO 9990
311 ENDIF
312 ELSEIF (key2(1:8) == 'INIMAP1D') THEN
313 is_stat_inimap1d=.true.
314 state_inimap_call_number = 0
315 stat_inimap(1) = 1
316 IF(key3(1:5) == 'FILE ')THEN
317 stat_inimap(1) = 11
318 is_stat_inimap_file = .true.
319 ELSEIF(key3(1:2) == 'vp')THEN
320 IS_STAT_INIMAP_VP = .TRUE.
321 ELSEIF(KEY3(1:2) == 've')THEN
322 IS_STAT_INIMAP_VE = .TRUE.
323 ELSE
324 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,C1=KEY0(IKEY),C2=LINE(1:35))
325 CALL ARRET(0)
326 ENDIF
327 ELSEIF (KEY2(1:8) == 'inimap2d') THEN
328 IS_STAT_INIMAP2D=.TRUE.
329 STATE_INIMAP_CALL_NUMBER = 0
330 STAT_INIMAP(1) = 2
331 IF(KEY3(1:5) == 'file ')THEN
332 STAT_INIMAP(1) = 12
333 IS_STAT_INIMAP_FILE = .TRUE.
334 ELSEIF(KEY3(1:2) == 'vp')THEN
335 IS_STAT_INIMAP_VP = .TRUE.
336 ELSEIF(KEY3(1:2) == 've')THEN
337 IS_STAT_INIMAP_VE = .TRUE.
338 ELSE
339 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,C1=KEY0(IKEY),C2=LINE(1:35))
340 CALL ARRET(0)
341 ENDIF
342 ENDIF!KEY2
343 ENDIF !IF (KEY2)
344c
345 IF (IKAD(IKEY)+K /= IKAD(IKEY+1)) GOTO 1175
346
347 BOOL=.FALSE.
348 IF(IS_STAT_SHELL)BOOL=.TRUE.
349 IF(IS_STAT_BRICK)BOOL=.TRUE.
350 IF(IS_STAT_SPRING)BOOL=.TRUE.
351 IF(IS_STAT_BEAM)BOOL=.TRUE.
352 IF(IS_STAT_TRUSS)BOOL=.TRUE.
353 IF(IS_STAT_STRF)BOOL=.TRUE.
354 IF(IS_STAT_NODE)BOOL=.TRUE.
355 IF(IS_STAT_LSENS)BOOL=.TRUE.
356 IF(IS_STAT_NO_DE)BOOL=.TRUE.
357 IF(OUTPUT%STATE%IS_STAT_SPH)BOOL=.TRUE.
358
359 !do not export STATE FILE IF /STATE/INIMAP IS USED AS A SINGLE /STATE OPTION
360.AND..OR. IF(BOOL (IS_STAT_INIMAP2D IS_STAT_INIMAP1D))THEN
361 ! /STATE/INIMAP used with another /STATE/ option (SHELL,BRICK,..)
362 ! state file must be written
363 IS_STAT_INIMAP_SINGLE=.FALSE.
364.AND..NOT..AND..NOT. ELSEIF(IS_STAT_DT IS_STAT_INIMAP2D IS_STAT_INIMAP1D)THEN
365 ! /STATE/INIMAP not used but STATE/DT requires also to output .sta file
366 IS_STAT_INIMAP_SINGLE=.FALSE.
367 ENDIF !
368c
369 ENDIF ! IF (IKAD(IKEY) /= IKAD(IKEY+1))
370C-----------------------------------------------
371 NC_STAT = 0
372 DO I = 1,MX_STAT
373 NC_STAT = NC_STAT + STAT_C(I)
374 ENDDO
375C
376 RETURN
377C-----------------------------------------------
378 9990 CONTINUE
379 CALL ANCMSG(MSGID=73,ANMODE=ANINFO,
380 . C1=KEY0(IKEY),C2=LINE(1:35))
381 CALL ARRET(0)
382 END
fredec_8key_i
subroutine fredec_8key_i(cart, key2, key3, key4, key5, key6, key7, key8, nbc)
Definition fredec_8key_i.F:35
frestat
subroutine frestat(ikad, key0, kstatf, sensors, output)
Definition frestat.F:41
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::line120
integer, parameter line120
Definition names_and_titles_mod.F:1004
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
state_inimap_mod
Definition state_inimap_mod.F:38
state_inimap_mod::is_stat_inimap_vp
logical is_stat_inimap_vp
Definition state_inimap_mod.F:91
state_inimap_mod::is_stat_inimap_single
logical is_stat_inimap_single
Definition state_inimap_mod.F:88
state_inimap_mod::is_stat_inimap_file
logical is_stat_inimap_file
Definition state_inimap_mod.F:89
state_inimap_mod::is_stat_inimap_ve
logical is_stat_inimap_ve
Definition state_inimap_mod.F:92
state_inimap_mod::is_stat_inimap_msg_already_displayed
logical is_stat_inimap_msg_already_displayed
Definition state_inimap_mod.F:90
nvar
integer function nvar(text)
Definition nvar.F:32
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
arret
subroutine arret(nn)
Definition arret.F:87
wriusc2
subroutine wriusc2(irec, nbc, key0)
Definition wriusc2.F:60