OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
trace_back.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#define NSUB_MAX 21
24#define NIVEAU_MAX 10
25#define NLIGNES_MAX 20
26!||====================================================================
27!|| trace_in ../engine/source/system/trace_back.F
28!||--- called by ------------------------------------------------------
29!|| radioss2 ../engine/source/engine/radioss2.F
30!|| resol ../engine/source/engine/resol.F
31!|| resol_head ../engine/source/engine/resol_head.F
32!||--- calls -----------------------------------------------------
33!|| trace_pile ../engine/source/system/trace_back.F
34!|| trace_print ../engine/source/system/trace_back.F
35!||====================================================================
36 SUBROUTINE trace_in(NSUB,ITAB,ATAB)
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "comlock.inc"
45#include "task_c.inc"
46#include "warn_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER NSUB,ITAB(*)
51 my_real
52 . atab(*)
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 CHARACTER*132 LINE
57 CHARACTER*132 LINES( NSUB_MAX )
58 INTEGER TRACE_PILE,LL( NSUB_MAX ) ,TYP( NSUB_MAX )
59 EXTERNAL trace_pile
60 INTEGER NIVEAU_PILE
61 SAVE lines,ll,typ
62 DATA lines /'RADIOSS ENGINE','SOLUTION PHASE: Processor=',
63 .'MAIN LOOP: Cycle=','CONTACT INTERFACES','SORTIES L00 ANIM TH',
64 .'INITIALIZATION','SPH INITIALIZATION','CONTACT INTERFACES SORT',
65 .'GLOBAL USER WINDOW',
66 .'CONCENTRADED LOAD','MONITORED VOLUME','ALE',
67 .'SPH INTERNAL FORCES','INTERNAL FORCES','FORCE ASSEMBLING',
68 .'READ INPUT FILE','READ RESTART FILE','TH INITIALIZATION',
69 .'NO LICENSE',
70 .'IMPLICIT','EIGENSOLVER'/
71c 123456789012345678901234567890
72 DATA ll /14,26,17,18,19,14,18,23,18,17,16, 3,19,15,16,15,17,17,10,-1,-1/
73 DATA typ/ 1, 3, 2, 2, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1,-1,-1/
74
75C-----------------------------------------------
76 IF(itrace/=1)RETURN
77 niveau_pile = trace_pile(1)
78 IF(niveau_pile>=niveau_max-1)THEN
79 CALL trace_print(line,-2,1)
80 RETURN
81 ENDIF
82C-----------------------------------------------
83 IF(nsub<=0.OR.nsub> nsub_max )THEN
84 line=' ?????? '
85 ELSE
86 GOTO(1,2,3)typ(nsub)
87 1 CONTINUE
88 line=lines(nsub)
89 GOTO 999
90 2 CONTINUE
91 IF (parallel_section == 1) THEN
92#include "lockon.inc"
93 WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),itab(1)
94#include "lockoff.inc"
95 ELSE
96 WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),itab(1)
97 ENDIF
98 GOTO 999
99 3 CONTINUE
100 IF (parallel_section == 1) THEN
101#include "lockon.inc"
102 WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),
103 . itab(1)+1,'/',itab(2)
104#include "lockoff.inc"
105 ELSE
106 WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),
107 . itab(1)+1,'/',itab(2)
108 ENDIF
109 GOTO 999
110C
111 999 CONTINUE
112 ENDIF
113C-----------------------------------------------
114 CALL trace_print(line,nsub,0)
115C-----------------------------------------------
116 RETURN
117C
118 END
119!||====================================================================
120!|| trace_out ../engine/source/system/trace_back.F
121!||--- called by ------------------------------------------------------
122!|| radioss2 ../engine/source/engine/radioss2.F
123!|| resol ../engine/source/engine/resol.F
124!|| resol_head ../engine/source/engine/resol_head.F
125!||--- calls -----------------------------------------------------
126!|| trace_pile ../engine/source/system/trace_back.F
127!|| trace_print ../engine/source/system/trace_back.F
128!||====================================================================
129 SUBROUTINE trace_out(NSUB)
130C-----------------------------------------------
131C I m p l i c i t T y p e s
132C-----------------------------------------------
133#include "implicit_f.inc"
134#include "warn_c.inc"
135C-----------------------------------------------
136C D u m m y A r g u m e n t s
137C-----------------------------------------------
138 INTEGER NSUB
139C-----------------------------------------------
140C L o c a l V a r i a b l e s
141C-----------------------------------------------
142 INTEGER TRACE_PILE
143 EXTERNAL trace_pile
144 INTEGER NIVEAU_PILE
145 CHARACTER*132 BLANC
146C-----------------------------------------------
147 IF(itrace/=1)RETURN
148 blanc=' '
149 CALL trace_print(blanc,nsub,-1)
150 niveau_pile = trace_pile(-1)
151C-----------------------------------------------
152 RETURN
153 END
154!||====================================================================
155!|| trace_pile ../engine/source/system/trace_back.F
156!||--- called by ------------------------------------------------------
157!|| trace_in ../engine/source/system/trace_back.F
158!|| trace_out ../engine/source/system/trace_back.F
159!|| trace_print ../engine/source/system/trace_back.F
160!||====================================================================
161 INTEGER FUNCTION trace_pile(INOUT)
162C-----------------------------------------------
163C I m p l i c i t T y p e s
164C-----------------------------------------------
165#include "implicit_f.inc"
166#include "comlock.inc"
167C-----------------------------------------------
168C C o m m o n B l o c k s
169C-----------------------------------------------
170#include "task_c.inc"
171#include "scr01_c.inc"
172C-----------------------------------------------
173C D u m m y A r g u m e n t s
174C-----------------------------------------------
175 INTEGER inout
176C-----------------------------------------------
177C L o c a l V a r i a b l e s
178C-----------------------------------------------
179 INTEGER niveau_pile(parasiz),it
180 DATA niveau_pile/parasiz*0/
181 SAVE niveau_pile
182 IF(itaskp1==0)THEN
183 it = 1
184 ELSE
185 it = itaskp1
186 ENDIF
187C-----------------------------------------------
188 niveau_pile(it) = niveau_pile(it) + inout
189 trace_pile = niveau_pile(it)
190C-----------------------------------------------
191 RETURN
192 END
193!||====================================================================
194!|| trace_cf ../engine/source/system/trace_back.F
195!||--- calls -----------------------------------------------------
196!|| trace_print ../engine/source/system/trace_back.F
197!||====================================================================
198 SUBROUTINE trace_cf(SIGNAL,IW)
199C-----------------------------------------------
200C I m p l i c i t T y p e s
201C-----------------------------------------------
202#include "implicit_f.inc"
203C-----------------------------------------------
204C D u m m y A r g u m e n t s
205C-----------------------------------------------
206 INTEGER SIGNAL,IW
207C-----------------------------------------------
208C L o c a l V a r i a b l e s
209C-----------------------------------------------
210 CHARACTER*132 LINE
211C-----------------------------------------------
212 CALL trace_print(line,signal,iw)
213 RETURN
214 END
215!||====================================================================
216!|| trace_print ../engine/source/system/trace_back.F
217!||--- called by ------------------------------------------------------
218!|| trace_cf ../engine/source/system/trace_back.F
219!|| trace_in ../engine/source/system/trace_back.F
220!|| trace_out ../engine/source/system/trace_back.F
221!||--- calls -----------------------------------------------------
222!|| ancmsg ../engine/source/output/message/message.F
223!|| arret ../engine/source/system/arret.F
224!|| trace_pile ../engine/source/system/trace_back.F
225!||--- uses -----------------------------------------------------
226!|| message_mod ../engine/share/message_module/message_mod.F
227!||====================================================================
228 SUBROUTINE trace_print(LINE,NS_SIGNAL,IW)
229C-----------------------------------------------
230C M o d u l e s
231C-----------------------------------------------
232 USE message_mod
233C-----------------------------------------------
234C I m p l i c i t T y p e s
235C-----------------------------------------------
236#include "implicit_f.inc"
237#include "comlock.inc"
238#include "task_c.inc"
239#include "scr01_c.inc"
240C-----------------------------------------------
241C C o m m o n B l o c k s
242C-----------------------------------------------
243#include "units_c.inc"
244C-----------------------------------------------
245C D u m m y A r g u m e n t s
246C-----------------------------------------------
247 CHARACTER*132 LINE
248 INTEGER NS_SIGNAL,IW
249C-----------------------------------------------
250C L o c a l V a r i a b l e s
251C-----------------------------------------------
252 INTEGER TRACE_PILE
253 EXTERNAL trace_pile
254 INTEGER NIVEAU_PILE,NLIGNES_PILE(0:NIVEAU_MAX,PARASIZ)
255 INTEGER CHECK_PILE(NIVEAU_MAX,PARASIZ)
256 CHARACTER*80 BLANC
257 CHARACTER*132 TEXT(NLIGNES_MAX,PARASIZ)
258 INTEGER I,IP,IL,NLIGNES,IT
259 LOGICAL :: FIRST_CALL = .true.
260 SAVE nlignes_pile,text,check_pile, first_call
261 INTEGER NS_SIGNAL1,IW1,LAST_IN
262C-----------------------------------------------
263 IF(first_call) THEN
264 first_call = .false.
265 nlignes_pile = 0
266 check_pile = 0
267 ENDIF
268C-----------------------------------------------
269 blanc=' '
270 niveau_pile = trace_pile(0)
271 last_in = niveau_pile
272 ns_signal1=ns_signal
273 iw1=iw
274 IF(itaskp1_def==0)THEN
275 it = 1
276 ELSE
277 it = itaskp1
278 ENDIF
279C
280 IF(iw1==0) THEN
281C------------------------------------------------------------------------
282C Ajout d'une ligne a TEXT (1 ou plusieurs X par descente de pile)
283C------------------------------------------------------------------------
284 nlignes_pile(niveau_pile,it)
285 . = nlignes_pile(niveau_pile,it) + 1
286 nlignes_pile(niveau_pile+1,it)
287 . = nlignes_pile(niveau_pile,it)
288 nlignes = nlignes_pile(niveau_pile,it)
289 text(nlignes,it)(1:niveau_pile) =blanc(1:niveau_pile)
290 text(nlignes,it)(niveau_pile+1:132)=line(1:132-niveau_pile)
291 check_pile(niveau_pile,it) = ns_signal
292 ELSEIF(iw1==-1) THEN
293C------------------------------------------
294C remonte de pile
295C------------------------------------------
296 IF(ns_signal1==check_pile(niveau_pile,it))THEN
297 nlignes_pile(niveau_pile,it)
298 . = nlignes_pile(niveau_pile-1,it)
299 ELSE
300 ns_signal1 = 4
301 iw1=1
302 ENDIF
303 ENDIF
304C
305 IF(iw1>0) THEN
306C------------------------------------------
307C Ecriture du Trace Back et Arret
308C------------------------------------------
309 IF(niveau_pile<=0)stop
310 nlignes = nlignes_pile(niveau_pile,it)
311 niveau_pile = trace_pile(-9999)
312C
313 IF(ns_signal1==-1)THEN
314 CALL ancmsg(msgid=40,anmode=aninfo)
315 ELSEIF(ns_signal1==-2)THEN
316 CALL ancmsg(msgid=41,anmode=aninfo)
317 ELSEIF(ns_signal1==1)THEN
318 CALL ancmsg(msgid=42,anmode=aninfo)
319 ELSEIF(ns_signal1==2)THEN
320 CALL ancmsg(msgid=43,anmode=aninfo)
321 ELSEIF(ns_signal1==3)THEN
322 CALL ancmsg(msgid=44,anmode=aninfo)
323 ELSEIF(ns_signal1==4)THEN
324 CALL ancmsg(msgid=45,anmode=aninfo,
325 . i1=ns_signal,
326 . i2=last_in)
327 ENDIF
328C
329 WRITE(iout,'(A,A)')' ',
330 .'+=============================================================+'
331
332 DO i=1,nlignes
333 WRITE(iout,'(A,A)')' | + ',text(i,it)
334 ENDDO
335 WRITE(iout,'(A,A)')' ',
336 .'+=============================================================+'
337 IF (ns_signal1/=4) THEN
338 CALL arret(6)
339 END IF
340 ENDIF
341C
342 RETURN
343 END
my_real
#define my_real
Definition cppsort.cpp:32
trace_pile
integer function trace_pile(inout)
Definition trace_back.F:162
trace_cf
subroutine trace_cf(signal, iw)
Definition trace_back.F:199
trace_out
subroutine trace_out(nsub)
Definition trace_back.F:130
trace_print
subroutine trace_print(line, ns_signal, iw)
Definition trace_back.F:229
trace_in
subroutine trace_in(nsub, itab, atab)
Definition trace_back.F:37
message_mod
Definition message_mod.F:1249
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