OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
summsg.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!|| summsg ../starter/source/output/message/summsg.F
25!||--- called by ------------------------------------------------------
26!|| anprint ../starter/source/output/analyse/analyse_arret.F
27!|| arret ../starter/source/system/arret.F
28!||--- calls -----------------------------------------------------
29!||--- uses -----------------------------------------------------
30!|| message_mod ../starter/share/message_module/message_mod.F
31!||====================================================================
32 SUBROUTINE summsg()
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE message_mod
37 USE names_and_titles_mod , ONLY : ncharline
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "units_c.inc"
49C-----------------------------------------------
50C L o c a l V a r i a b l e s
51C-----------------------------------------------
52 INTEGER IEND,CPT,MODE,I,J,NBERR,NBWARN,K,CPTWARN,CPTERR
53 INTEGER ITAB(5,IWARN+IERR), WORK(70000), INDEX_WARN(5*(IWARN+IERR)),
54 . INDEX_ERR(5*(IWARN+IERR)),ITRI_WARN(5,IWARN+IERR+1),
55 . ITRI_ERR(5,IWARN+IERR+1),IOPTIONTYPE(50,IWARN+IERR),
56 . INDEXOPT(50*(IWARN+IERR)),INDEXOPT_1(50*(IWARN+IERR)),
57 . W_CPT_TYP(IWARN+IERR),E_CPT_TYP(IWARN+IERR),
58 . W_OPTION_INDEX(IWARN+IERR+2),E_OPTION_INDEX(IWARN+IERR+2)
59 CHARACTER*20 TITLE(IWARN+IERR)
60 CHARACTER*30 W_OPTION_TYPE(IWARN+IERR),
61 . E_OPTION_TYPE(IWARN+IERR)
62 CHARACTER*200 TMPIN
63 CHARACTER*60 OPTIONTYPE(IWARN+IERR)
64 CHARACTER(LEN=NCHARLINE) :: MYFMT,TMP_CHAR
65 CHARACTER*59 , DIMENSION(:), ALLOCATABLE :: SUM_WARN,SUM_ERR
66C-----------------------------------------------
67 rewind(res_check)
68c///////////////////////////////////
69c WARNING(s)
70c///////////////////////////////////
71 cpt = 0
72 w_cpt_typ(1:iwarn+ierr) = 0
73 indexopt = 0
74 indexopt_1 = 0
75 index_warn = 0
76 w_option_index(1:iwarn+ierr+2) = 0
77 itri_warn = 0
78
79
80 iend = 0
81 DO WHILE(cpt < iwarn)
82 READ(res_check,'(A)',END=110) tmpin
83 IF(tmpin(1:9)== 'W_OPTION=')THEN
84 cpt = cpt + 1
85 indexopt_1(cpt) = cpt
86 index_warn(cpt) = cpt
87 READ(tmpin(10:110),'(A)') optiontype(cpt)
88 DO i=1,50
89 ioptiontype(i,cpt) = ichar(optiontype(cpt)(i:i))
90 ENDDO
91c
92 READ(res_check,'(A)',END=110) tmpin
93 READ(tmpin(13:23),'(I10)') itab(2,cpt)
94 itri_warn(2,cpt) = itab(2,cpt)
95c
96 READ(res_check,'(A)',END=110) tmpin
97 READ(tmpin(11:21),'(I10)') itab(3,cpt)
98c
99 READ(res_check,'(A)',END=110) tmpin
100 READ(tmpin(8:108),'(A)') title(cpt)
101c
102 READ(res_check,'(A)',END=110) tmpin
103 READ(tmpin(8:18),'(I10)') itab(4,cpt)
104 READ(res_check,'(A)',END=110) tmpin
105 READ(tmpin(10:20),'(I10)') itab(5,cpt)
106 ENDIF
107 ENDDO
108110 iend = 1
109C
110 IF (cpt /= iwarn) THEN
111 DO WHILE(cpt < iwarn)
112 cpt = cpt + 1
113 indexopt_1(cpt) = cpt
114 index_warn(cpt) = cpt
115 optiontype(cpt) = 'NO CATEGORY'
116 DO i=1,50
117 ioptiontype(i,cpt) = ichar(optiontype(cpt)(i:i))
118 itri_warn(2,cpt) = 0
119 itab(4,cpt) = 9998
120 itab(5,cpt) = 1
121 ENDDO
122 ENDDO
123 ENDIF
124c
125 mode = 0
126 CALL my_orders( mode, work, ioptiontype, indexopt_1, cpt , 50)
127
128 DO i=1,cpt
129 indexopt(i) = indexopt_1(i)
130 ENDDO
131 j = 1
132 DO i=2,cpt
133 IF( optiontype(indexopt(i))(1:50) ==
134 . optiontype(indexopt(i-1))(1:50) ) THEN
135 indexopt(i) = indexopt(i-1)
136 ENDIF
137 ENDDO
138c
139 DO i=1,cpt
140 itab(1,i) = indexopt(i)
141 itri_warn(1,i) = itab(1,i)
142 itri_warn(2,i) = 1
143 itri_warn(3,i) = itab(4,indexopt_1(i))
144 itri_warn(4,i) = 1
145 itri_warn(5,i) = 1
146 ENDDO
147C
148 mode=0
149 CALL my_orders( mode, work, itri_warn, index_warn, cpt , 5)
150
151
152c
153 rewind(res_check)
154c
155 j = 1
156 IF(iwarn /=0) THEN
157 w_cpt_typ(j) = w_cpt_typ(j) + 1
158 w_option_type(j) = optiontype(indexopt(index_warn(1)))
159 w_option_index(j) = 1
160 ENDIF
161 DO i=2,cpt
162 IF( itab(1,index_warn(i)) /= itab(1,index_warn(i-1)) ) THEN
163 j = j+1
164 w_option_index(j) = i
165 ENDIF
166 w_cpt_typ(j) = w_cpt_typ(j) + 1
167 w_option_type(j) = optiontype(indexopt(index_warn(i)))
168 ENDDO
169 w_option_index(j+1) = cpt+1
170c
171 DO i=2,cpt
172 IF(itri_warn(3,index_warn(i)) == itri_warn(3,index_warn(i-1)) ) THEN
173 itri_warn(4,index_warn(i)) = itri_warn(4,index_warn(i-1)) + 1
174 ENDIF
175 ENDDO
176 cptwarn = cpt
177c
178 nbwarn = 0
179 IF(iwarn /=0) index_warn(w_option_index(j+1)) = cpt + 1
180c
181c///////////////////////////////////
182c ERROR(s)
183c///////////////////////////////////
184 cpt = 0
185 e_cpt_typ(1:iwarn+ierr) = 0
186 indexopt = 0
187 indexopt_1 = 0
188 index_err = 0
189 e_option_index(1:iwarn+ierr+2) = 0
190 itri_err = 0
191
192
193 iend = 0
194 DO WHILE(cpt < ierr)
195 READ(res_check,'(A)',END=120) tmpin
196 IF(tmpin(1:9)== 'E_OPTION=')THEN
197 cpt = cpt + 1
198 indexopt_1(cpt) = cpt
199 index_err(cpt) = cpt
200 READ(tmpin(10:110),'(A)') optiontype(cpt)
201 DO i=1,50
202 ioptiontype(i,cpt) = ichar(optiontype(cpt)(i:i))
203 ENDDO
204c
205 READ(res_check,'(A)',END=110) tmpin
206 READ(tmpin(13:23),'(I10)') itab(2,cpt)
207 itri_err(2,cpt) = itab(2,cpt)
208c
209 READ(res_check,'(A)',END=110) tmpin
210 READ(tmpin(11:21),'(I10)') itab(3,cpt)
211c
212 READ(res_check,'(A)',END=110) tmpin
213 READ(tmpin(8:108),'(A)') title(cpt)
214c
215 READ(res_check,'(A)',END=110) tmpin
216 READ(tmpin(8:18),'(I10)') itab(4,cpt)
217 READ(res_check,'(a)',END=110) TMPIN
218 READ(TMPIN(10:20),'(i10)') ITAB(5,CPT)
219 ENDIF
220 ENDDO
221120 IEND = 1
222c
223 IF (CPT /= IERR) THEN
224 DO WHILE(CPT < IERR)
225 CPT = CPT + 1
226 INDEXOPT_1(CPT) = CPT
227 INDEX_ERR(CPT) = CPT
228 OPTIONTYPE(CPT) = 'no category'
229 DO I=1,50
230 IOPTIONTYPE(I,CPT) = ICHAR(OPTIONTYPE(CPT)(I:I))
231 ITRI_ERR(2,CPT) = 0
232 ITAB(4,CPT) = 9998
233 ITAB(5,CPT) = 1
234 ENDDO
235 ENDDO
236 ENDIF
237c
238 MODE = 0
239 CALL MY_ORDERS( MODE, WORK, IOPTIONTYPE, INDEXOPT_1, CPT , 50)
240
241 DO I=1,CPT
242 INDEXOPT(I) = INDEXOPT_1(I)
243 ENDDO
244 J = 1
245 DO I=2,CPT
246 IF( OPTIONTYPE(INDEXOPT(I))(1:50) ==
247 . OPTIONTYPE(INDEXOPT(I-1))(1:50) ) THEN
248 INDEXOPT(I) = INDEXOPT(I-1)
249 ENDIF
250 ENDDO
251c
252 DO I=1,CPT
253 ITAB(1,I) = INDEXOPT(I)
254 ITRI_ERR(1,I) = ITAB(1,I)
255 ITRI_ERR(2,I) = 1
256 ITRI_ERR(3,I) = ITAB(4,INDEXOPT_1(I))
257 ITRI_ERR(4,I) = 1
258 ITRI_ERR(5,I) = 1
259 ENDDO
260C
261 MODE=0
262 CALL MY_ORDERS( MODE, WORK, ITRI_ERR, INDEX_ERR, CPT , 5)
263
264
265c
266 REWIND(RES_CHECK)
267c
268 J = 1
269 IF(IERR /=0) THEN
270 E_CPT_TYP(J) = E_CPT_TYP(J) + 1
271 E_OPTION_TYPE(J) = OPTIONTYPE(INDEXOPT(INDEX_ERR(1)))
272 E_OPTION_INDEX(J) = 1
273 ENDIF
274 DO I=2,CPT
275 IF( ITAB(1,INDEX_ERR(I)) /= ITAB(1,INDEX_ERR(I-1)) ) THEN
276 J = J+1
277 E_OPTION_INDEX(J) = I
278 ENDIF
279 E_CPT_TYP(J) = E_CPT_TYP(J) + 1
280 E_OPTION_TYPE(J) = OPTIONTYPE(INDEXOPT(INDEX_ERR(I)))
281 ENDDO
282 E_OPTION_INDEX(J+1) = CPT+1
283c
284 DO I=2,CPT
285 IF(ITRI_ERR(3,INDEX_ERR(I)) == ITRI_ERR(3,INDEX_ERR(I-1)) ) THEN
286 ITRI_ERR(4,INDEX_ERR(I)) = ITRI_ERR(4,INDEX_ERR(I-1)) + 1
287 ENDIF
288 ENDDO
289 CPTERR = CPT
290c
291 NBERR = 0
292 IF(IERR /=0) INDEX_ERR(E_OPTION_INDEX(J+1)) = CPT + 1
293c
294c///////////////////////////////////
295c OUTPUT
296c///////////////////////////////////
297 ALLOCATE(SUM_WARN(CPTWARN*10),SUM_ERR(CPTERR*10))
298 IF( IERR + IWARN /= 0 ) THEN
299c
300 IF(CPTWARN /= 0) THEN
301 NBWARN = NBWARN + 1
302 WRITE(TMP_CHAR ,'(a)') ' '
303 DO I=1,58
304 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
305 ENDDO
306 ENDIF
307c
308 DO J=1,IERR+IWARN
309 IF(W_CPT_TYP(J) /= 0) THEN
310 NBWARN = NBWARN + 1
311 WRITE(TMP_CHAR ,'(2x,a,a,5x,i6,1x,a)') '---',
312 . W_OPTION_TYPE(J),W_CPT_TYP(J),'warning(s) '
313 DO I=1,58
314 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
315 ENDDO
316c
317 NBWARN = NBWARN + 1
318 WRITE(TMP_CHAR ,'(7x,a)') '|'
319 DO I=1,58
320 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
321 ENDDO
322c
323 NBWARN = NBWARN + 1
324 WRITE(TMP_CHAR ,'(7x,a)') '|'
325 DO I=1,58
326 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
327 ENDDO
328c
329 DO K=W_OPTION_INDEX(J),W_OPTION_INDEX(J+1)-1
330 IF(ITRI_WARN(3,INDEX_WARN(K+1)) /= ITRI_WARN(3,INDEX_WARN(K)) )THEN
331 NBWARN = NBWARN + 1
332 IF(ITRI_WARN(3,INDEX_WARN(K)) /= 9998) THEN
333 WRITE(TMP_CHAR ,'(7x,a,i6,x,a,i6)') '|---',
334 . ITRI_WARN(4,INDEX_WARN(K)),'warning id : ',ITRI_WARN(3,INDEX_WARN(K))
335 ELSE
336 WRITE(TMP_CHAR ,'(7x,a,i6,a)') '|---',
337 . ITRI_WARN(4,INDEX_WARN(K)),'warning id : no id '
338 ENDIF
339 DO I=1,58
340 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
341 ENDDO
342 IF (ALLOCATED(MESSAGES(1,ITRI_WARN(3,INDEX_WARN(K)))%MESSAGE)) THEN
343 NBWARN = NBWARN + 1
344 WRITE(TMP_CHAR ,'(7x,a,a)') '| ',
345 . MESSAGES(1,ITRI_WARN(3,INDEX_WARN(K)))%MESSAGE(1)(1:50)
346 DO I=1,58
347 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
348 ENDDO
349 ENDIF
350c
351 NBWARN = NBWARN + 1
352 WRITE(TMP_CHAR ,'(7x,a)') '|'
353 DO I=1,58
354 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
355 ENDDO
356 ENDIF
357c
358 ENDDO
359c
360 NBWARN = NBWARN + 1
361 WRITE(TMP_CHAR ,'(a)') ' '
362 DO I=1,58
363 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
364 ENDDO
365 NBWARN = NBWARN + 1
366 WRITE(TMP_CHAR ,'(a)') ' '
367 DO I=1,58
368 SUM_WARN(NBWARN)(I:I) = TMP_CHAR(I:I)
369 ENDDO
370C
371 ENDIF
372 ENDDO
373C
374c
375 IF(CPTERR /= 0)THEN
376 NBERR = NBERR + 1
377 WRITE(TMP_CHAR ,'(a)') ' '
378 DO I=1,58
379 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
380 ENDDO
381 ENDIF
382 DO J=1,IERR+IWARN
383 IF(E_CPT_TYP(J) /= 0) THEN
384 NBERR = NBERR + 1
385 WRITE(TMP_CHAR ,'(2x,a,a,5x,i6,1x,a)') '---',
386 . E_OPTION_TYPE(J),E_CPT_TYP(J),' error(s) '
387 DO I=1,58
388 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
389 ENDDO
390c
391 NBERR = NBERR+ 1
392 WRITE(TMP_CHAR ,'(7x,a)') '|'
393 DO I=1,58
394 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
395 ENDDO
396c
397 NBERR = NBERR+ 1
398 WRITE(TMP_CHAR ,'(7x,a)') '|'
399 DO I=1,58
400 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
401 ENDDO
402c
403 DO K=E_OPTION_INDEX(J),E_OPTION_INDEX(J+1)-1
404 IF(ITRI_ERR(3,INDEX_ERR(K+1)) /= ITRI_ERR(3,INDEX_ERR(K)) )THEN
405 NBERR = NBERR + 1
406C
407 IF(ITRI_ERR(3,INDEX_ERR(K)) /= 9998) THEN
408 WRITE(TMP_CHAR ,'(7x,a,i6,x,a,i6)') '|---',
409 . ITRI_ERR(4,INDEX_ERR(K)),' error id : ',ITRI_ERR(3,INDEX_ERR(K))
410 ELSE
411 WRITE(TMP_CHAR ,'(7x,a,i6,a)') '|---',
412 . ITRI_ERR(4,INDEX_ERR(K)),' error id : no id '
413 ENDIF
414C
415 DO I=1,58
416 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
417 ENDDO
418c
419 IF (ALLOCATED(MESSAGES(1,ITRI_ERR(3,INDEX_ERR(K)))%MESSAGE)) THEN
420 NBERR = NBERR + 1
421 WRITE(TMP_CHAR ,'(7x,a,a)') '| ',
422 . MESSAGES(1,ITRI_ERR(3,INDEX_ERR(K)))%MESSAGE(1)(1:50)
423 DO I=1,58
424 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
425 ENDDO
426 ENDIF
427c
428 NBERR = NBERR + 1
429 WRITE(TMP_CHAR ,'(7x,a)') '|'
430 DO I=1,58
431 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
432 ENDDO
433 ENDIF
434 ENDDO
435c
436 NBERR = NBERR + 1
437 WRITE(TMP_CHAR ,'(a)') ' '
438 DO I=1,58
439 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
440 ENDDO
441 NBERR = NBERR + 1
442 WRITE(TMP_CHAR ,'(a)') ' '
443 DO I=1,58
444 SUM_ERR(NBERR)(I:I) = TMP_CHAR(I:I)
445 ENDDO
446C
447 ENDIF
448 ENDDO
449C
450 WRITE(IOUT,'(/)')
451 MYFMT='(a)'
452 WRITE(IOUT,MYFMT)'----------------------------------------------
453 .----------------------------------------------------------------------
454 .----'
455 WRITE(IOUT,MYFMT)'| error(s) summary
456 . | warning(s) summary
457 . |'
458 WRITE(IOUT,MYFMT)'----------------------------------------------
459 .----------------------------------------------------------------------
460 .----'
461 DO I=1,MAX(NBERR,NBWARN)
462 TMP_CHAR = ''
463 TMP_CHAR(1:1) = '|'
464 IF (I <= NBERR) THEN
465 DO J=2,59
466 TMP_CHAR(J:J) = SUM_ERR(I)(J-1:J-1)
467 ENDDO
468 ELSE
469 DO J=2,59
470 TMP_CHAR(J:J) = ' '
471 ENDDO
472 ENDIF
473 TMP_CHAR(61:61) = '|'
474 IF (I <= NBWARN) THEN
475 DO J=62,119
476 TMP_CHAR(J:J) = SUM_WARN(I)(J-61:J-61)
477 ENDDO
478 ELSE
479 DO J=62,119
480 TMP_CHAR(J:J) = ' '
481 ENDDO
482 ENDIF
483 TMP_CHAR(120:120) = '|'
484 WRITE(IOUT,MYFMT)TMP_CHAR(1:120)
485 ENDDO
486 MYFMT='(a)'
487 WRITE(IOUT,MYFMT)'----------------------------------------------
488 .----------------------------------------------------------------------
489 .----'
490 WRITE(IOUT,'(/)')
491 WRITE(IOUT,'(/)')
492 ENDIF
493 DEALLOCATE(SUM_WARN,SUM_ERR)
494
495
496
497
498
499 RETURN
500 END SUBROUTINE
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
summsg
subroutine summsg()
Definition summsg.F:33