C REPETE    SOURCE    CHAT      12/03/28    21:15:07     7340           
C  CET OPERATEUR INITIALISE LA FONCTION REPETER DE GIBIANE               
C  IL DOIT ETRE SUIVI DU NOM D'UN BLOC REPETER                           
C  SI CE BLOC EXISTE LIRNOM EST DEROUTE POUR LE LIRE                     
C  SI CE BLOC N'EXISTE PAS IL LE CREE ET LIRNOM LE REMPLIT               
C  A LA PREMIERE INTERPRETATION                                          
C  LE BLOC FINI PAR FIN "BLOC"                                           
C                                                                        
      SUBROUTINE REPETE                                                  
      IMPLICIT INTEGER(I-N)
-INC SMBLOC                                                              
-INC CCNOYAU                                                             
-INC CCOPTIO                                                             
      CHARACTER*(8) ICHA,INOM,ITCH,ICHC                                  
      CHARACTER*(9) ICHB                                                 
      MBC=0                                                              
      CALL LIROBJ('BLOC    ',MBLO1,0,IREBLO)  
      if( ireblo.ne.0)   imablu=jpoob2(imotlu)              
      IF(IREBLO.EQ.0)  THEN                                              
         CALL QUETYP(ICHA,1,IRETOU)                                      
         IF(IERR.NE.0) RETURN                                            
         IF(ICHA.EQ.'MOT     ') THEN                                     
            CALL LIRCHA(ICHB,1,IRETOU)                                   
            IF(ICHB(9:9).NE.' ') THEN                                    
               CALL ERREUR (315)                                         
               RETURN                                                    
            ENDIF                                                        
         ICHA=ICHB                                                       
         ELSE                                                            
            CALL LIROBJ(ICHA,IRE,1,IRETOU)                               
            CALL QUENOM ( ICHA)                                          
            IF(ICHA(1:1).EQ.' ') THEN                                    
              CALL ERREUR(315)                                           
              RETURN                                                     
            ENDIF                                                        
         ENDIF                                                           
      ENDIF                                                              
      CALL LIRENT(MBC,0,IRETOU)                                          
      IF (IERR.NE.0) RETURN                                              
*  TEST QUE L'INSTRUCTION EST EPUISEE - PROBLEME AVEC LA PRECOMPILATION  
*     CALL QUETYP(ITCH,0,IRETO)                                          
*     IF (IRETO.EQ.0) GOTO 20                                            
*     MOTERR(1:8)=ITCH                                                   
*     CALL LIRABJ(ITCH,IRET,1,IRETO)                                     
*     CALL QUENOM(ITCH)                                                  
*     MOTERR(9:16)=ITCH                                                  
*     CALL ERREUR(551)                                                   
*     RETURN                                                             
  20  CONTINUE                                                           
      MDEOBT=MDEOBJ                                                      
      MFIOBT=MFIOBJ                                                      
      MBLPRT=MBLPRO                                                      
      MTXBLC=MTXBL                                                       
      MARM = MARGUM                                                      
      IF (MBLSUP.NE.0) SEGDES MTXBLC 
      ISSPOT=ISPOTE
      SEGDES ISSPOT
      IRETCO=MOBJCO                                             
      SEGDES MBLOC                                                       
      MTEMP=MBLOC                                                        
      IF (IREBLO.EQ.0) GOTO 10                                           
C                                                                        
C  LE BLOC REPETER EXISTE DEJA                                           
C                                                                        
      segini,mbloc=MBLO1
      iouep2(imablu)=mbloc                                                   
      SEGACT MBLOC*MOD
      ISSPOT=ISPOTE
      SEGACT ISSPOT*MOD
*      write(6,*) 'ispote ipotem(1) ', ispote, ipotem(1)
      MOBJCO=IRETCO
      mdecip = mdeobt  - mdeobj
      do iou=1,ipotem(/1)
        ipotem(iou)=ipotem(iou)+mdecip
      enddo
      MDEOBJ=MDEOBT                                                       
      MFIOBJ=MFIOBT                                                      
      MBLPRO=MBLPRT                                                      
      MBLSUP=MTEMP                                                       
      MARGUM = MARM                                                      
      MTXBLC=MTXBL                                                       
      SEGACT MTXBLC                                                      
*      ILON= MTXBLC(/1)                                                  
      MBCOUR=0                                                           
      MBCONT=MBC                                                         
      MBFONC=0                                                           
      MBERR =0 
      ICHC=NCONBO
      ICONBO=1
      IIPROU=ICONBO
*      write(6,*)' bloc2 repete mbloc mdeobj lmnnom',mbloc,mdeobj,lmnnom
      CALL NOMENT(ICHC,IIPROU)                                           
      RETURN                                                             
  10  CONTINUE                                                           
C                                                                        
C  ON EST EN DEFINITION D'UN NOUVEAU BLOC                                
C                                                                        
      NBMOT=0                                                            
      SEGINI MBLOC 
      NVQTEM=20
      SEGINI ISSPOT  
      ISPOTE= ISSPOT
      NBNOMM=1200
      NINST=1200 
      IPVINN=3000                                                        
      SEGINI MTXBLC
      NINSTV=0
      IPVINV=0                                         
      MTXBL=MTXBLC                                                       
      MBLSUP=MTEMP                                                       
      MARGUM = MARM                                                      
      MBCONT=MBC                                                         
      MBLPRO=0                                                           
      MBCOUR=0                                                           
      MBFONC=1                                                           
      MBERR=0                                                            
      MDEOBJ=MDEOBT                                                      
      MFIOBJ=MFIOBT  
      MOBJCO=IRETCO 
*      write(6,*) 'creation de bloc mblo mde lmnn',mbloc,mdeobj,lmnnom                                                     
      CALL NOMOBJ('BLOC    ',ICHA,MBLOC)
      call savseg (mbloc)
      call savseg (ISSPOT)
      call savseg(MTXBLC)
      ICHC(1:1)='&'
      ICHC(2:8)=ICHA(1:7)
      NCONBO=ICHC
      ICONBO=1
      IIPROU=ICONBO
      CALL NOMENT(ICHC,IIPROU)                                           
      RETURN                                                             
      END