C ERRE      SOURCE    JC220346  14/01/31    21:15:05     7939           
      SUBROUTINE ERRE                                                           
*_______________________________________________________________________        
*                                                                               
*                 OPERATEUR ERRE                                                
*                 --------------                                                
*                                                                               
*  PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 02/91                        
*                                                                               
*_______________________________________________________________________        
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*                                                                               
-INC CCOPTIO     
-INC SMTEXTE                                                                    
-INC SMLCHPO
-INC SMLREEL 
-INC SMLENTI 
-INC SMLMOTS 
*                                                                               
      CHARACTER AUX*73
      LOGICAL ZAVEC
*                                                                               
      AUX=' '                                                                   
*                                                                               
      CALL LIRCHA(AUX,0,IRETOU)                                                 
      IF (IRETOU.EQ.0) GOTO 250
      CALL LENCHA(AUX,LAUX)
      ZAVEC=(AUX(1:LAUX).EQ.'AVEC')
      IF (ZAVEC) GOTO 250
      WRITE(IOIMP,11) AUX                                                       
  11  FORMAT(/,(1X,A73))                                                        
      CALL ERREUR(308)                                                          
      RETURN     
*                                                                               
 250  CALL LIRENT (KENT,0,IRETOU)                                               
      IF (IRETOU.EQ.0) GOTO 255   
*     MOT-CLE "AVEC"
      IF (ZAVEC) THEN     
*         MOTERR = 40 PREMIERS CARACTERES D'UNE CHAINE
          CALL LIRCHA(MOTERR,0,IRET)
*         INTERR = ENTIER OU LISTE D'ENTIERS
          CALL LIRENT(INTERR(1),0,IRET)
          IF (IRET.EQ.0) THEN
              CALL LIROBJ('LISTENTI',MLENTI,0,IRET)
              IF (IRET.NE.0) THEN
                  SEGACT,MLENTI
                  NN=MIN(LECT(/1),SIZE(INTERR))
                  DO I=1,NN
                      INTERR(I)=LECT(I)
                  ENDDO
                  SEGDES,MLENTI
              ENDIF
          ENDIF
*         REAERR = ENTIER OU LISTE D'ENTIERS
          CALL LIRREE(REAERR(1),0,IRET)
          IF (IRET.EQ.0) THEN
              CALL LIROBJ('LISTREEL',MLREEL,0,IRET)
              IF (IRET.NE.0) THEN
                  SEGACT,MLREEL
                  NN=MIN(PROG(/1),SIZE(REAERR))
                  DO I=1,NN
                      REAERR(I)=PROG(I)
                  ENDDO
                  SEGDES,MLREEL
              ENDIF
          ENDIF
*         BOOERR = LOGIQUE OU LISTE DE MOTS
          CALL LIRLOG(BOOERR(1),0,IRET)
          IF (IRET.EQ.0) THEN
              CALL LIROBJ('LISTMOTS',MLMOTS,0,IRET)
              IF (IRET.NE.0) THEN
                  SEGACT,MLMOTS
                  NN=MIN(MOTS(/2),SIZE(BOOERR))
                  DO I=1,NN
                      IF ((MOTS(I).EQ.'VRAI') .OR.
     &                    (MOTS(I).EQ.'V'   ) .OR.
     &                    (MOTS(I).EQ.'TRUE') .OR.
     &                    (MOTS(I).EQ.'T'   )) THEN
                          BOOERR(I)=.TRUE.
                      ELSE
                          BOOERR(I)=.FALSE.
                      ENDIF
                  ENDDO
                  SEGDES,MLMOTS
              ENDIF
          ENDIF
      ENDIF
      CALL ERREUR(KENT)                                                         
      RETURN

 255  CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU)                                     
      IF (IRETOU.EQ.0) GOTO 256                                                 
      CALL LIROBJ('CHPOINT ',IPO2,1,IRETOU)                                     
      IF (IERR.NE.0) RETURN     
      IRET = -2                                        
      CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0)
      IF (IRET.EQ.0) RETURN                                                      
      CALL ECROBJ('CHPOINT ',IRET)
      CALL MAXIMU(1)
      RETURN                                                                    

 256  CALL LIROBJ('LISTCHPO',IPO1,0,IRETOU)                                     
      IF (IRETOU.EQ.0) GOTO 260                                                 
      CALL LIROBJ('LISTCHPO',IPO2,1,IRETOU)                                     
      IF (IERR.NE.0) RETURN
     
        mlchp1 = ipo1
        mlchp2 = ipo2
      segact mlchp1, mlchp2
      if (mlchp1.ichpoi(/1).ne.mlchp2.ichpoi(/1)) call erreur(3)
      if (ierr.ne.0) return
      JG = mlchp1.ichpoi(/1)
      segini mlreel
      do ii = 1 ,jg
        IRET = -2            
        ipo1 = mlchp1.ichpoi(ii) 
        ipo2 = mlchp2.ichpoi(ii)                           
        CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0)
        IF (IRET.EQ.0) RETURN                                                      
        CALL ECROBJ('CHPOINT ',IRET)
        CALL MAXIMU(1)
        call lirree(xx,1,iretou)
        if (ierr.ne.0) return
        prog(ii) = xx
      enddo
      call ECROBJ('LISTREEL',mlreel)
      RETURN                                                                    
                                                 
*_______________________________________________________________________        
*                                                                               
*  CALCUL D'ERREUR   ( VERSION BARZIC ET RICHARD )                              
*_______________________________________________________________________        
*                                                                               
 260  CONTINUE                                                                  
      CALL LIROBJ('MMODEL',IPMODL,1,IRETM)                                      
      IF (IERR.NE.0) RETURN
*                                                                               
      CALL LIROBJ('MCHAML',IPCHE1,1,IRETOU)                                  
      IF (IERR.NE.0)RETURN                                                   
      CALL LIROBJ('MCHAML',IPCHE2,1,IRETOU)                                  
      IF (IERR.NE.0) RETURN                                                  
*                                                                               
      CALL RNGCHA (IPCHE1,IPCHE2,'CONTRAINTES','CARACTERISTIQUES'        
     1                   ,IPCH1,IPCH2)                                        
      IF(IPCH1.EQ.0.OR.IPCH2.EQ.0)THEN                                  
         IF(IPCH1.EQ.0)THEN
             MOTERR(1:16)='CONTRAINTES     '
         ELSE
             MOTERR(1:16)='CARACTERISTIQUES'
         ENDIF                                                               
         CALL ERREUR(565)
         RETURN
      ENDIF           
*                                                                               
      CALL ERRARE(IPMODL,IPCH1,IPCH2,XERR,IPCHRR)                             
*                                                                               
      IF (IPCHRR.NE.0) THEN                                                     
         CALL ECROBJ('MCHAML',IPCHRR)                                        
         CALL ECRREE(XERR)                                                      
      ENDIF                                                                     

      RETURN                                                                    
      END