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 365 of file message.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod2
      USE names_and_titles_mod, ONLY: ncharline100
C-----------------------------------------------
C Usage sample :
C      USE MESSAGE_MOD 
C ...
C      CALL ANCMSG(MSGID=9999,ANMODE=ANINFO_BLIND,
C     .               I1=28,C1='TIME STEP COMPUTATION',C2='SHELL')
C ...         ...         ...         ...         ...
C  ANMODE=ANINFO/ANINFO_BLIND
C         ANINFO write both title and description in standard output and listing
C         ANINFO_BLIND do not write description in standard output
C ...         ...         ...         ...         ...
C  It is recommended to use ANINFO for sensitive messages.
C ...         ...         ...         ...         ...
C  engine_message_description.txt extract :
C ...
C  /MESSAGE/9999/TITLE
C  \n ** ERROR DURING %s\n
C
C  /MESSAGE/9999/DESCRIPTION
C        DURING COMPUTATION IT APPEARS THAT
C        %s ELEMENT ID=%d HAD A TIME STEP EQUAL TO ZERO
C        ENGINE WILL STOP
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
#include      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MSGID,ANMODE,MSGTYPE 
      integer
     .                 i1,i2,i3,i4,
     .                 i5,i6,i7,i8,i9
      my_real
     .                 r1,r2,r3,r4,
     .                 r5,r6,r7,r8,r9
      CHARACTER(*)
     .                 C1,C2,C3,C4,
     .                 C5,C6,C7,C8,C9
      OPTIONAL ::       
     .                 msgtype, ! Warning : MSGTYPE is not optional in the Starter 
     .                          ! but is is not supported in the engine
     .                 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
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER             IBUF(10)
      my_real             rbuf(10)
      CHARACTER(LEN=NCHARLINE100):: CBUF(10)
C
      CHARACTER(LEN=NCHARLINE100):: TMPLINE,MYFMT,TMPBUF
      CHARACTER(LEN=NCHAROUT) ::  TMPOUT
      INTEGER ITYPE,ILINE,I,I0,J,J0,SBUFMSG(2),IFILE,IOLD,
     .        INDXI,INDXR,INDXC,INDXTMPOUT,BUFLEN,
     .        STMP
      CHARACTER(LEN=NCHARLINE100):: BUFMSG(2,100),BUFFMT(2,100)
C
      WRITE(istdo,'(/A,I10)')'MESSAGE ID : ',msgid
      IF (iout/=0) THEN
        WRITE(iout,'(/A,I10)')'MESSAGE ID : ',msgid
      END IF
      ibuf=0
      rbuf=zero
      cbuf=' '
C
      indxi=0
      indxr=0
      indxc=0
C
      tmpout=' '
      indxtmpout=0
      tmpbuf=' '
C
      IF (PRESENT(i1)) THEN
        ibuf(1)=i1
        IF (PRESENT(i2)) THEN
          ibuf(2)=i2
          IF (PRESENT(i3)) THEN
            ibuf(3)=i3
            IF (PRESENT(i4)) THEN
              ibuf(4)=i4
              IF (PRESENT(i5)) THEN
                ibuf(5)=i5
                IF (PRESENT(i6)) THEN
                  ibuf(6)=i6
                  IF (PRESENT(i7)) THEN
                    ibuf(7)=i7
                    IF (PRESENT(i8)) THEN
                      ibuf(8)=i8
                      IF (PRESENT(i9)) THEN
                        ibuf(9)=i9
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
C
      IF (PRESENT(r1)) THEN
        rbuf(1)=r1
        IF (PRESENT(r2)) THEN
          rbuf(2)=r2
          IF (PRESENT(r3)) THEN
            rbuf(3)=r3
            IF (PRESENT(r4)) THEN
              rbuf(4)=r4
              IF (PRESENT(r5)) THEN
                rbuf(5)=r5
                IF (PRESENT(r6)) THEN
                  rbuf(6)=r6
                  IF (PRESENT(r7)) THEN
                    rbuf(7)=r7
                    IF (PRESENT(r8)) THEN
                      rbuf(8)=r8
                      IF (PRESENT(r9)) THEN
                        rbuf(9)=r9
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
C
      IF (PRESENT(c1)) THEN
        cbuf(1)=c1
        IF (PRESENT(c2)) THEN
          cbuf(2)=c2
          IF (PRESENT(c3)) THEN
            cbuf(3)=c3
            IF (PRESENT(c4)) THEN
              cbuf(4)=c4
              IF (PRESENT(c5)) THEN
                cbuf(5)=c5
                IF (PRESENT(c6)) THEN
                  cbuf(6)=c6
                  IF (PRESENT(c7)) THEN
                    cbuf(7)=c7
                    IF (PRESENT(c8)) THEN
                      cbuf(8)=c8
                      IF (PRESENT(c9)) THEN
                        cbuf(9)=c9
                      END IF
                    END IF
                  END IF
                END IF
              END IF
            END IF
          END IF
        END IF
      END IF
C
        DO itype=1,2
          IF (ALLOCATED(messages(itype,msgid)%MESSAGE)) THEN
            DO iline=1,messages(itype,msgid)%SMESSAGE  
              tmpout=' '
              tmpbuf=' '
              tmpline=messages(itype,msgid)%MESSAGE(iline)
              buflen=0
              indxtmpout=0
              i=1
              iold=1
!               DO J0=1,LEN_TRIM(TMPLINE)
!                 IF (TMPLINE(J0:J0)=='/') THEN
!                   TMPLINE(J0:J0)=CHAR(10)
!                 END IF
!               END DO
              DO WHILE (i+1<=len_trim(tmpline))
                IF (tmpline(i:i)==achar(92)) then !'\') THEN
                  i=i+1
                  IF (i-2>=1) THEN
                    WRITE(tmpbuf,'(A,A)')tmpline(iold:i-2),tmpline(i:i)
                    buflen=i-2-iold+1+1
                  ELSE
                    WRITE(tmpbuf,'(A)')tmpline(i:i)
                    buflen=1
                  END IF
                  i=i+1
                  iold=i
                ELSE IF (tmpline(i:i)=='%') THEN
                  i=i+1
                  IF (i-2>=1) THEN
                    WRITE(tmpbuf,'(A)')tmpline(iold:i-2)
                    buflen=i-2-iold+1
                    IF (buflen>0) THEN
                      tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen) 
                      indxtmpout=indxtmpout+buflen
                      buflen=0
                    END IF
                  END IF
                  IF (tmpline(i:i)=='d') THEN 
                    i=i+1
                    iold=i
                    myfmt='(I10)'
                    IF (indxi<10) indxi=indxi+1
                    WRITE(tmpbuf,myfmt)ibuf(indxi)
                    tmpbuf=adjustl(tmpbuf)
                    buflen=len_trim(tmpbuf)
                  ELSE IF (tmpline(i:i)=='f') THEN
                    i=i+1
                    iold=i
                    myfmt='(1PG20.13)'
                    IF (indxr<10) indxr=indxr+1
                    WRITE(tmpbuf,myfmt)rbuf(indxr)
                    tmpbuf=adjustl(tmpbuf)
                    buflen=len_trim(tmpbuf)
                  ELSE IF (tmpline(i:i)=='s') THEN
                    i=i+1
                    iold=i
                    myfmt='(A)'
                    IF (indxc<10) indxc=indxc+1 
                    WRITE(tmpbuf,myfmt)cbuf(indxc)
                    tmpbuf=adjustl(tmpbuf)
                    buflen=len_trim(tmpbuf)
                  END IF
                ELSE
                  i=i+1
                END IF
                IF (buflen>0) THEN
                  tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen)
                  indxtmpout=indxtmpout+buflen
                  buflen=0
                END IF
              END DO
              IF (iold<=i) THEN
                WRITE(tmpbuf,'(A)')
     .          tmpline(iold:len_trim(tmpline))
                buflen=len_trim(tmpline)-iold+1
                IF (buflen>0) THEN
                  tmpout=tmpout(1:indxtmpout)//tmpbuf(1:buflen)
                  indxtmpout=indxtmpout+buflen
                  buflen=0
                END IF
              END IF
! #include "lockon.inc"
              IF (indxtmpout>0) THEN
C               do not write description on stdout in case ANINFO_BLIND
                IF (anmode/=aninfo_blind.OR.itype==1) THEN
                  WRITE(istdo,'(A)')tmpout(1:indxtmpout)
                END IF
                IF (iout/=0) THEN
                  WRITE(iout,'(A)')tmpout(1:indxtmpout)
                END IF
              END IF
! #include "lockoff.inc"
            END DO
          END IF
        END DO
      RETURN