Esope source files

   1 : C TRBACK    SOURCE    BP208322  13/07/25    21:15:06     7805           
   2 :       SUBROUTINE TRBACK                                                  
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC CCOPTIO                                                             
   5 : -INC SMBLOC                                                              
   6 : -INC CCNOYAU
   7 : -INC CCASSIS                                                             
   8 :       CHARACTER*4 MFIN(4)                                                
   9 :       CHARACTER*8 CTYP                                                   
  10 :       DATA MFIN/'FIN ','REPE','FINP','FINM'/                             
  11 :       IIR=IERR                                                           
  12 :       IERR=0                                                             
  12 :       CALLGINT2  
  13 :                                                       
  14 : C      MTXBLC=MTXBL                                                      
  15 : C      SEGACT MTXBLC                                                     
  16 : C      MTXBLL=MTXBLC(MBCOUR)                                             
  17 : C      SEGACT MTXBLL                                                     
  18 :       INTERR(1)=MBCOUR                                                   
  19 : *     WRITE(6,FMT='(''  MBCOUR NUINST '',2I6)')MBCOUR,NUINST             
  20 : C      SEGDES MTXBLL                                                            
  20 :       CALL ERREUR(-253)                                                  
  20 :       CALL TRBAC 
  21 :       if(nbesc.ne.0) segact ipiloc 
  22 :       IERR=0 
  23 :       if(MISAUP.EQ.1) then
  23 :          CALL NOUTRU  
  24 :          MBFONC=1
  25 :          RETURN
  26 :       ENDIF                                                                         
  27 :    1  CONTINUE                                                           
  27 :       CALL NOUTRU                                                        
  28 :       LECTAB=1                                                     
  28 :       CALL LIRMOT(MFIN,4,IRETOU,0)
  29 :       if(nbesc.ne.0) segact ipiloc                                       
  30 :       IF (IRETOU.EQ.0) THEN                                              
  31 :            GOTO 1                                                        
  32 :       ELSEIF ( IRETOU.EQ.2) THEN                                         
  32 :            CALL REPETE                                                   
  33 :            MBCONT=1                                                      
  34 :            GO TO 1                                                       
  35 :       ELSEIF ( IRETOU.EQ.3.OR.IRETOU.EQ.4) THEN                          
  36 :             ILONG=LMNNOM                                                 
  37 :             MOTERR(1:8)=' '                                              
  38 :             IF(ILONG.EQ.0)  then
  39 :                  if(nbesc.ne.0) segdes ipiloc
  40 :                  RETURN                                                  
  41 :             ENDIF
  42 :             DO 10 I=1,ILONG                                              
  43 :             IF(INOOB1(I).EQ.1) GO TO 10                                
  44 :             IF(INOOB2(I).NE.'PROCEDUR')  GO TO 10                        
  45 :             IF(MBLPRO.NE.ipipr1(IOUEP2(I))) GO TO 10 
  46 :             IP=INOOB1(I)
  47 :             IDEBCH=IPCHAR(IP)
  48 :             IFINCH=IPCHAR(IP+1)-1                                   
  49 :             MOTERR(1:8)=ICHARA(IDEBCH:IFINCH)                            
  50 :             GO TO 11                                                     
  51 :    10       CONTINUE                                                     
  52 :    11       CONTINUE                                                     
  53 :            IERR=IIR                                                      
  53 :            CALLGINT2                                                     
  53 :            CALL FINPRO                                                   
  54 :            IIR=IERR                                                      
  55 :            IERR=0                                                        
  55 :            CALLGINT2                                                     
  56 :            IF(MBLSUP.NE.0.AND.MBFONC.EQ.0) THEN                          
  57 :            MTXBLC=MTXBL                                                  
  58 : C           MTXBLL=MTXBLC(MBCOUR)                                        
  59 : C           SEGACT MTXBLL                                                
  60 :            INTERR(1)= MBCOUR                                             
  60 :            CALL ERREUR(-255)                                             
  61 : C           SEGDES MTXBLL                                                
  62 :            ELSE                                                        
  62 :            CALL ERREUR(-254)                                             
  63 :            ENDIF                                                         
  63 :            CALL TRBAC   
  64 :            if(nbesc.ne.0) segdes ipiloc                                  
  65 :            IF(MBLSUP.EQ.0.OR.MBFONC.NE.0) GO TO 2                        
  66 :       ELSEIF ( IRETOU.EQ.1) THEN                                         
  67 :            MBCONT=1                                                      
  67 :           CALL FIN                                                       
  68 :           IF (MBLSUP.EQ.0.OR.MBFONC.NE.0) GO TO 2                        
  69 :       ENDIF                                                              
  70 :       GO TO 1                                                            
  71 :    2  CONTINUE 
  72 :       if(nbesc.ne.0) segdes ipiloc                                       
  73 :       IERR=IIR                                                           
  73 :       CALLGINT2                                                          
  74 :       RETURN                                                             
  75 :       END     
  76 :  
  77 :  
  78 :  
  79 :  
  80 :