C FIN       SOURCE    PV        06/04/21    21:15:09     5418           
      SUBROUTINE FIN                                                     
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO                                                             
-INC CCNOYAU                                                             
-INC SMBLOC                                                              
      CHARACTER*40 MESS
      CHARACTER*8 ICHC                                       
      DATA MESS/'ARRET DU PROGRAMME GIBI NIVEAU D''ERREUR:'/             
      IF (IERR.EQ.0) THEN                                                
      CALL LIROBJ('BLOC    ',IRET,0,IRETOU)                              
      IF (IRETOU.EQ.1) GOTO 10                                           
      ENDIF                                                              
      WRITE (IOIMP,1) MESS,IERMAX                                        
   1  FORMAT (///,1X,10(1H*),5X,A40,I4,5X,10(1H*))                       
      IF (IIMPI.NE.0) CALL OOODMP(0)                                     
      CALL OOOSTP  
      call flush(IOIMP) 
***   if (iermax.eq.3) call abort                                                     
      IF (IERMAX.EQ.1) STOP 4                                            
      IF (IERMAX.EQ.2) STOP 8 
      IF (IERMAX.EQ.3) STOP 12                                           
      STOP                                                               
  10  CONTINUE                                                           
      IF (MBLOC.NE.IRET)   THEN                                          
         CALL ERREUR(154)                                                
         RETURN                                                          
      ENDIF                                                              
* MISE A BLANC DU NOM DE LA BOUCLE AFIN DE NE PAS LA REUTILISER          
      IPLAC = JPOOB2(IMOTLU)                                             
      INOOB1(IPLAC)=1 
C
C  si c'est la premiere fois on ajuste le segment
C 
      IF(MBFONC.NE.0) THEN
         MTXBLC=MTXBL 
         NINST=NINSTV+1
         IPVINN=MTXBA(NINST)
         NBNOMM=LMTXBM(NINST)
         IF(IIMPI.EQ.1756) WRITE(IOIMP,1788)NINST,IPVINN,NBNOMM
 1788    FORMAT(' apres ajustement NINST IPVINN NBNOMM',3I8)
         SEGADJ MTXBLC 
      ENDIF                                                     
      MBCOUR=0                                                           
      MBFONC=0                                                           
      MBCONT=MBCONT-1 
      ICONBO=ICONBO+1
      ICHC= NCONBO
      IIPROU=ICONBO
      CALL NOMENT(ICHC,IIPROU )                                          
      IF (MBCONT.NE.0.AND.MBERR.EQ.0) RETURN                             
      MBCONT=1                                                           
      MBER1=MBERR                                                        
      MBLO1=MBLOC                                                        
      IF (MBLSUP.EQ.0) CALL ERREUR(5)                                    
      IF (IERR.NE.0) RETURN                                              
      MTXBLC=MTXBL                                                       
      SEGDES MTXBLC                                                      
      MBLOC=MBLSUP
      ISSPOT=MBLO1.ISPOTE
      SEGDES ISSPOT                                                      
      SEGDES MBLO1                                                       
      SEGACT MBLOC*MOD
      ISSPOT=ISPOTE
      SEGACT ISSPOT*MOD
      MTXBLC=MTXBL                                                       
      CALL NOUTRU                                                        
      IF (MBLSUP.NE.0) SEGACT MTXBLC                                     
      MBERR=MBER1                                                        
      RETURN                                                             
      END