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

Go to the source code of this file.

Functions/Subroutines

subroutine ancmsg (msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9)

Function/Subroutine Documentation

◆ ancmsg()

subroutine ancmsg ( integer msgid,
integer, optional msgtype,
integer anmode,
integer, optional i1,
integer, optional i2,
integer, optional i3,
integer, optional i4,
integer, optional i5,
integer, optional i6,
integer, optional i7,
integer, optional i8,
integer, optional i9,
optional r1,
optional r2,
optional r3,
optional r4,
optional r5,
optional r6,
optional r7,
optional r8,
optional r9,
character(*), optional c1,
character(*), optional c2,
character(*), optional c3,
character(*), optional c4,
character(*), optional c5,
character(*), optional c6,
character(*), optional c7,
character(*), optional c8,
character(*), optional c9 )

Definition at line 364 of file message.F.

371C-----------------------------------------------
372C M o d u l e s
373C-----------------------------------------------
374 USE message_mod2
375 USE names_and_titles_mod, ONLY: ncharline100
376C-----------------------------------------------
377C Usage sample :
378C USE MESSAGE_MOD
379C ...
380C CALL ANCMSG(MSGID=9999,ANMODE=ANINFO_BLIND,
381C . I1=28,C1='TIME STEP COMPUTATION',C2='SHELL')
382C ... ... ... ... ...
383C ANMODE=ANINFO/ANINFO_BLIND
384C ANINFO write both title and description in standard output and listing
385C ANINFO_BLIND do not write description in standard output
386C ... ... ... ... ...
387C It is recommended to use ANINFO for sensitive messages.
388C ... ... ... ... ...
389C engine_message_description.txt extract :
390C ...
391C /MESSAGE/9999/TITLE
392C \n ** ERROR DURING %s\n
393C
394C /MESSAGE/9999/DESCRIPTION
395C DURING COMPUTATION IT APPEARS THAT
396C %s ELEMENT ID=%d HAD A TIME STEP EQUAL TO ZERO
397C ENGINE WILL STOP
398C-----------------------------------------------
399C I m p l i c i t T y p e s
400C-----------------------------------------------
401#include "implicit_f.inc"
402C-----------------------------------------------
403C C o m m o n B l o c k s
404C-----------------------------------------------
405#include "units_c.inc"
406#include "comlock.inc"
407C-----------------------------------------------
408C D u m m y A r g u m e n t s
409C-----------------------------------------------
410 INTEGER MSGID,ANMODE,MSGTYPE
411 integer
412 . i1,i2,i3,i4,
413 . i5,i6,i7,i8,i9
414 my_real
415 . r1,r2,r3,r4,
416 . r5,r6,r7,r8,r9
417 CHARACTER(*)
418 . C1,C2,C3,C4,
419 . C5,C6,C7,C8,C9
420 OPTIONAL ::
421 . msgtype, ! Warning : MSGTYPE is not optional in the Starter
422 . ! but is is not supported in the engine
423 . i1,i2,i3,i4,
424 . i5,i6,i7,i8,i9,
425 . r1,r2,r3,r4,
426 . r5,r6,r7,r8,r9,
427 . c1,c2,c3,c4,
428 . c5,c6,c7,c8,c9
429C-----------------------------------------------
430C L o c a l V a r i a b l e s
431C-----------------------------------------------
432 INTEGER IBUF(10)
433 my_real rbuf(10)
434 CHARACTER(LEN=NCHARLINE100):: CBUF(10)
435C
436 CHARACTER(LEN=NCHARLINE100):: TMPLINE,MYFMT,TMPBUF
437 CHARACTER(LEN=NCHAROUT) :: TMPOUT
438 INTEGER ITYPE,ILINE,I,I0,J,J0,SBUFMSG(2),IFILE,IOLD,
439 . INDXI,INDXR,INDXC,INDXTMPOUT,BUFLEN,
440 . STMP
441 CHARACTER(LEN=NCHARLINE100):: BUFMSG(2,100),BUFFMT(2,100)
442C
443 WRITE(istdo,'(/A,I10)')'MESSAGE ID : ',msgid
444 IF (iout/=0) THEN
445 WRITE(iout,'(/A,I10)')'MESSAGE ID : ',msgid
446 END IF
447 ibuf=0
448 rbuf=zero
449 cbuf=' '
450C
451 indxi=0
452 indxr=0
453 indxc=0
454C
455 tmpout=' '
456 indxtmpout=0
457 tmpbuf=' '
458C
459 IF (PRESENT(i1)) THEN
460 ibuf(1)=i1
461 IF (PRESENT(i2)) THEN
462 ibuf(2)=i2
463 IF (PRESENT(i3)) THEN
464 ibuf(3)=i3
465 IF (PRESENT(i4)) THEN
466 ibuf(4)=i4
467 IF (PRESENT(i5)) THEN
468 ibuf(5)=i5
469 IF (PRESENT(i6)) THEN
470 ibuf(6)=i6
471 IF (PRESENT(i7)) THEN
472 ibuf(7)=i7
473 IF (PRESENT(i8)) THEN
474 ibuf(8)=i8
475 IF (PRESENT(i9)) THEN
476 ibuf(9)=i9
477 END IF
478 END IF
479 END IF
480 END IF
481 END IF
482 END IF
483 END IF
484 END IF
485 END IF
486C
487 IF (PRESENT(r1)) THEN
488 rbuf(1)=r1
489 IF (PRESENT(r2)) THEN
490 rbuf(2)=r2
491 IF (PRESENT(r3)) THEN
492 rbuf(3)=r3
493 IF (PRESENT(r4)) THEN
494 rbuf(4)=r4
495 IF (PRESENT(r5)) THEN
496 rbuf(5)=r5
497 IF (PRESENT(r6)) THEN
498 rbuf(6)=r6
499 IF (PRESENT(r7)) THEN
500 rbuf(7)=r7
501 IF (PRESENT(r8)) THEN
502 rbuf(8)=r8
503 IF (PRESENT(r9)) THEN
504 rbuf(9)=r9
505 END IF
506 END IF
507 END IF
508 END IF
509 END IF
510 END IF
511 END IF
512 END IF
513 END IF
514C
515 IF (PRESENT(c1)) THEN
516 cbuf(1)=c1
517 IF (PRESENT(c2)) THEN
518 cbuf(2)=c2
519 IF (PRESENT(c3)) THEN
520 cbuf(3)=c3
521 IF (PRESENT(c4)) THEN
522 cbuf(4)=c4
523 IF (PRESENT(c5)) THEN
524 cbuf(5)=c5
525 IF (PRESENT(c6)) THEN
526 cbuf(6)=c6
527 IF (PRESENT(c7)) THEN
528 cbuf(7)=c7
529 IF (PRESENT(c8)) THEN
530 cbuf(8)=c8
531 IF (PRESENT(c9)) THEN
532 cbuf(9)=c9
533 END IF
534 END IF
535 END IF
536 END IF
537 END IF
538 END IF
539 END IF
540 END IF
541 END IF
542C
543 DO itype=1,2
544 IF (ALLOCATED(messages(itype,msgid)%MESSAGE)) THEN
545 DO iline=1,messages(itype,msgid)%SMESSAGE
546 tmpout=' '
547 tmpbuf=' '
548 tmpline=messages(itype,msgid)%MESSAGE(iline)
549 buflen=0
550 indxtmpout=0
551 i=1
552 iold=1
553! DO J0=1,LEN_TRIM(TMPLINE)
554! IF (TMPLINE(J0:J0)=='/') THEN
555! TMPLINE(J0:J0)=CHAR(10)
556! END IF
557! END DO
558 DO WHILE (i+1<=len_trim(tmpline))
559 IF (tmpline(i:i)==achar(92)) then !'\') THEN
560 i=i+1
561 IF (i-2>=1) THEN
562 WRITE(tmpbuf,'(A,A)')tmpline(iold:i-2),tmpline(i:i)
563 buflen=i-2-iold+1+1
564 ELSE
565 WRITE(tmpbuf,'(A)')tmpline(i:i)
566 buflen=1
567 END IF
568 i=i+1
569 iold=i
570 ELSE IF (tmpline(i:i)=='%') THEN
571 i=i+1
572 IF (i-2>=1) THEN
573 WRITE(tmpbuf,'(A)')tmpline(iold:i-2)
574 buflen=i-2-iold+1
575 IF (buflen>0) THEN
576 tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen)
577 indxtmpout=indxtmpout+buflen
578 buflen=0
579 END IF
580 END IF
581 IF (tmpline(i:i)=='d') THEN
582 i=i+1
583 iold=i
584 myfmt='(I10)'
585 IF (indxi<10) indxi=indxi+1
586 WRITE(tmpbuf,myfmt)ibuf(indxi)
587 tmpbuf=adjustl(tmpbuf)
588 buflen=len_trim(tmpbuf)
589 ELSE IF (tmpline(i:i)=='f') THEN
590 i=i+1
591 iold=i
592 myfmt='(1PG20.13)'
593 IF (indxr<10) indxr=indxr+1
594 WRITE(tmpbuf,myfmt)rbuf(indxr)
595 tmpbuf=adjustl(tmpbuf)
596 buflen=len_trim(tmpbuf)
597 ELSE IF (tmpline(i:i)=='s') THEN
598 i=i+1
599 iold=i
600 myfmt='(A)'
601 IF (indxc<10) indxc=indxc+1
602 WRITE(tmpbuf,myfmt)cbuf(indxc)
603 tmpbuf=adjustl(tmpbuf)
604 buflen=len_trim(tmpbuf)
605 END IF
606 ELSE
607 i=i+1
608 END IF
609 IF (buflen>0) THEN
610 tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen)
611 indxtmpout=indxtmpout+buflen
612 buflen=0
613 END IF
614 END DO
615 IF (iold<=i) THEN
616 WRITE(tmpbuf,'(A)')
617 . tmpline(iold:len_trim(tmpline))
618 buflen=len_trim(tmpline)-iold+1
619 IF (buflen>0) THEN
620 tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen)
621 indxtmpout=indxtmpout+buflen
622 buflen=0
623 END IF
624 END IF
625! #include "lockon.inc"
626 IF (indxtmpout>0) THEN
627C do not write description on stdout in case ANINFO_BLIND
628 IF (anmode/=aninfo_blind.OR.itype==1) THEN
629 WRITE(istdo,'(A)')tmpout(1:indxtmpout)
630 END IF
631 IF (iout/=0) THEN
632 WRITE(iout,'(A)')tmpout(1:indxtmpout)
633 END IF
634 END IF
635! #include "lockoff.inc"
636 END DO
637 END IF
638 END DO
639 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
message_mod2
Definition message_mod2.F:30
message_mod2::aninfo_blind
integer aninfo_blind
Definition message_mod2.F:51
message_mod2::messages
type(tmessage), dimension(:,:), allocatable messages
Definition message_mod2.F:40
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002