OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
summsg.F File Reference
#include "implicit_f.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine summsg ()

Function/Subroutine Documentation

◆ summsg()

subroutine summsg

Definition at line 32 of file summsg.F.

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
max
#define max(a, b)
Definition macros.h:21
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