trace_back.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "task_c.inc"
#include "warn_c.inc"
#include "lockon.inc"
#include "lockoff.inc"
#include "scr01_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Macros
#define	NSUB_MAX   21
#define	NIVEAU_MAX   10
#define	NLIGNES_MAX   20

Functions/Subroutines
subroutine	trace_in (nsub, itab, atab)
subroutine	trace_out (nsub)
integer function	trace_pile (inout)
subroutine	trace_cf (signal, iw)
subroutine	trace_print (line, ns_signal, iw)

Macro Definition Documentation

NIVEAU_MAX

#define NIVEAU_MAX   10

NLIGNES_MAX

#define NLIGNES_MAX   20

NSUB_MAX

#define NSUB_MAX   21

Function/Subroutine Documentation

trace_cf()

subroutine trace_cf	(	integer	signal,
		integer	iw )

Definition at line 198 of file trace_back.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER SIGNAL,IW
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER*132 LINE
C-----------------------------------------------
      CALL trace_print(line,signal,iw)
      RETURN

trace_in()

subroutine trace_in	(	integer	nsub,
		integer, dimension(*)	itab,
			atab )

Definition at line 36 of file trace_back.F.

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      "comlock.inc"
#include      "task_c.inc"
#include      "warn_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSUB,ITAB(*)
      my_real
     .   atab(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER*132 LINE
      CHARACTER*132 LINES( NSUB_MAX )
      INTEGER TRACE_PILE,LL( NSUB_MAX ) ,TYP( NSUB_MAX )
      EXTERNAL trace_pile
      INTEGER NIVEAU_PILE
      SAVE lines,ll,typ
      DATA lines /'RADIOSS ENGINE','SOLUTION PHASE: Processor=',
     .'MAIN LOOP: Cycle=','CONTACT INTERFACES','SORTIES L00 ANIM TH',
     .'INITIALIZATION','SPH INITIALIZATION','CONTACT INTERFACES SORT',
     .'GLOBAL USER WINDOW',
     .'CONCENTRADED LOAD','MONITORED VOLUME','ALE',
     .'SPH INTERNAL FORCES','INTERNAL FORCES','FORCE ASSEMBLING',
     .'READ INPUT FILE','READ RESTART FILE','TH INITIALIZATION',
     .'NO LICENSE',
     .'IMPLICIT','EIGENSOLVER'/
c                                  123456789012345678901234567890
      DATA ll /14,26,17,18,19,14,18,23,18,17,16, 3,19,15,16,15,17,17,10,-1,-1/
      DATA typ/ 1, 3, 2, 2, 1, 1, 1, 2, 2, 1, 1, 1, 1, 1, 1, 2, 2, 1, 1,-1,-1/
          
C-----------------------------------------------
      IF(itrace/=1)RETURN
      niveau_pile = trace_pile(1)
      IF(niveau_pile>=niveau_max-1)THEN
         CALL trace_print(line,-2,1)
         RETURN
      ENDIF
C-----------------------------------------------
      IF(nsub<=0.OR.nsub> nsub_max )THEN
          line=' ?????? '  
      ELSE
        GOTO(1,2,3)typ(nsub)
 1      CONTINUE
          line=lines(nsub)
          GOTO 999
 2      CONTINUE
          IF (parallel_section == 1) THEN
#include "lockon.inc"
           WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),itab(1)
#include "lockoff.inc"
          ELSE
           WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),itab(1)
          ENDIF
          GOTO 999
 3      CONTINUE
          IF (parallel_section == 1) THEN
#include "lockon.inc"
           WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),
     .                              itab(1)+1,'/',itab(2)
#include "lockoff.inc"
          ELSE
           WRITE(line,'(A,I5,A1,I5)')lines(nsub)(1:ll(nsub)),
     .                              itab(1)+1,'/',itab(2)
          ENDIF
          GOTO 999
C
 999    CONTINUE
      ENDIF
C-----------------------------------------------
      CALL trace_print(line,nsub,0)
C-----------------------------------------------
      RETURN
C

trace_out()

subroutine trace_out

(

integer

nsub

)

Definition at line 129 of file trace_back.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "warn_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSUB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER TRACE_PILE
      EXTERNAL trace_pile
      INTEGER NIVEAU_PILE
      CHARACTER*132 BLANC
C-----------------------------------------------
      IF(itrace/=1)RETURN
      blanc=' '
      CALL trace_print(blanc,nsub,-1)
      niveau_pile = trace_pile(-1)
C-----------------------------------------------
      RETURN

trace_pile()

integer function trace_pile

(

integer

inout

)

Definition at line 161 of file trace_back.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include "comlock.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "task_c.inc"
#include      "scr01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER INOUT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NIVEAU_PILE(PARASIZ),IT
      DATA niveau_pile/parasiz*0/
      SAVE niveau_pile
      IF(itaskp1==0)THEN
        it = 1
      ELSE
        it = itaskp1
      ENDIF
C-----------------------------------------------
      niveau_pile(it) = niveau_pile(it) + inout
      trace_pile = niveau_pile(it)
C-----------------------------------------------
      RETURN

trace_print()

subroutine trace_print	(	character*132	line,
		integer	ns_signal,
		integer	iw )

Definition at line 228 of file trace_back.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "comlock.inc"
#include      "task_c.inc"
#include      "scr01_c.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      CHARACTER*132 LINE
      INTEGER NS_SIGNAL,IW
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER TRACE_PILE
      EXTERNAL trace_pile
      INTEGER NIVEAU_PILE,NLIGNES_PILE(0:NIVEAU_MAX,PARASIZ)
      INTEGER CHECK_PILE(NIVEAU_MAX,PARASIZ)
      CHARACTER*80 BLANC
      CHARACTER*132 TEXT(NLIGNES_MAX,PARASIZ)
      INTEGER I,NLIGNES,IT
      LOGICAL :: FIRST_CALL = .true.
      SAVE nlignes_pile,text,check_pile, first_call
      INTEGER NS_SIGNAL1,IW1,LAST_IN
C-----------------------------------------------
      IF(first_call) THEN
        first_call = .false.
        nlignes_pile = 0
        check_pile = 0
      ENDIF
C-----------------------------------------------
      blanc=' '
      niveau_pile = trace_pile(0)
      last_in = niveau_pile
      ns_signal1=ns_signal
      iw1=iw
      IF(itaskp1_def==0)THEN
        it = 1
      ELSE
        it = itaskp1
      ENDIF
C
      IF(iw1==0) THEN
C------------------------------------------------------------------------
C       adding a line to TEXT (1 or more X per stack descent)
C------------------------------------------------------------------------
        nlignes_pile(niveau_pile,it) 
     .         = nlignes_pile(niveau_pile,it) + 1
        nlignes_pile(niveau_pile+1,it)
     .         = nlignes_pile(niveau_pile,it)
        nlignes = nlignes_pile(niveau_pile,it)
        text(nlignes,it)(1:niveau_pile)    =blanc(1:niveau_pile)
        text(nlignes,it)(niveau_pile+1:132)=line(1:132-niveau_pile)
        check_pile(niveau_pile,it) = ns_signal
      ELSEIF(iw1==-1) THEN
C------------------------------------------
C       stack ascent
C------------------------------------------
        IF(ns_signal1==check_pile(niveau_pile,it))THEN
          nlignes_pile(niveau_pile,it) 
     .           = nlignes_pile(niveau_pile-1,it)
        ELSE
          ns_signal1 = 4
          iw1=1
        ENDIF
      ENDIF
C
      IF(iw1>0) THEN
C------------------------------------------
C       writing the Trace Back and stopping
C------------------------------------------
        IF(niveau_pile<=0)stop
        nlignes = nlignes_pile(niveau_pile,it)
        niveau_pile = trace_pile(-9999)
C
        IF(ns_signal1==-1)THEN
          CALL ancmsg(msgid=40,anmode=aninfo)
        ELSEIF(ns_signal1==-2)THEN
          CALL ancmsg(msgid=41,anmode=aninfo)
        ELSEIF(ns_signal1==1)THEN
          CALL ancmsg(msgid=42,anmode=aninfo)
        ELSEIF(ns_signal1==2)THEN
          CALL ancmsg(msgid=43,anmode=aninfo)
        ELSEIF(ns_signal1==3)THEN
          CALL ancmsg(msgid=44,anmode=aninfo)
        ELSEIF(ns_signal1==4)THEN
          CALL ancmsg(msgid=45,anmode=aninfo,
     .                i1=ns_signal,
     .                i2=last_in)
        ENDIF
C
        WRITE(iout,'(A,A)')'      ',
     .'+=============================================================+'
 
        DO i=1,nlignes
          WRITE(iout,'(A,A)')'      | + ',text(i,it)
        ENDDO
        WRITE(iout,'(A,A)')'      ',
     .'+=============================================================+'
        IF (ns_signal1/=4) THEN
          CALL arret(6)
        END IF
      ENDIF
C
      RETURN