C COMCHO    SOURCE    CHAT      05/01/12    22:14:23     5004           
      SUBROUTINE COMCHO                                                         
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C                                                                               
C=======================================================================        
C   = CALCUL DU NOMBRE DE CHOCS DANS CHAQUE COURBE D'UN OBJET DE TYPE  =        
C   = EVOLUTION. LE RESULTAT EST UNE LISTENTI.                         =        
C   =                                                                  =        
C   =     SYNTAXE : NCHO = COMT EVOL DECL ;                            =        
C   =                                                                  =        
C   =                                                                  =        
C   = NCHO   :  OBJET DE TYPE LISTENTI RESULTAT                        =        
C   = EVOL   :  OBJET DE TYPE EVOLUTIO CONTENANT LES SIGNAUX A TRAITER =        
C   = DECL   :  OBJET DE TYPE FLOTTANT % NIVEAU MAXI DES CHOCS         =        
C   =           DEFINISSANT LE SEUIL D'ACQUISITION                     =        
C=======================================================================        
C                                                                               
-INC CCOPTIO                                                                    
-INC SMEVOLL                                                                    
-INC SMLREEL                                                                    
-INC SMLENTI                                                                    
C                                                                               
C                                                                               
      CALL LIROBJ('EVOLUTIO',IPEVO,1,IRET)                                      
      IF(IERR.NE.0) GOTO 100                                                    
C                                                                               
      CALL LIRREE(DECLEN,0,IDECL)                                               
      IF(IERR.NE.0) GOTO 100                                                    
      IF((DECLEN.LT.0.D0).OR.(DECLEN.GT.100.D0))THEN                            
          MOTERR(1:8)='DECLENCH'                                                
          REAERR(1)=DECLEN                                                      
          REAERR(2)=0.D0                                                        
          REAERR(3)=100.D0                                                      
          CALL ERREUR(42)                                                       
          GOTO 100                                                              
      ENDIF                                                                     
C                                                                               
      MEVOLL=IPEVO                                                              
      SEGACT MEVOLL                                                             
C                                                                               
C BOUCLE SUR LES COURBES                                                        
C                                                                               
      NC=IEVOLL(/1)                                                             
      JG=NC                                                                     
      SEGINI MLENTI                                                             
      IPORE=MLENTI                                                              
        DO 1 IC=1,NC                                                            
        KEVOLL=IEVOLL(IC)                                                       
        SEGACT KEVOLL                                                           
        MLREE1=IPROGX                                                           
        SEGACT MLREE1                                                           
        MLREE2=IPROGY                                                           
        SEGACT MLREE2                                                           
        L1=MLREE1.PROG(/1)                                                      
        NCHO=0                                                                  
        NP=0                                                                    
        VMAX=0.D0                                                               
        MIN=1                                                                   
        MAX=L1                                                                  
C                                                                               
C CALCUL LE NIVEAU DE DECLENCHEMENT                                             
C                                                                               
          DO 21 I=1,L1                                                          
          FORC=ABS(MLREE2.PROG(I))                                              
          IF(FORC.GT.VMAX)VMAX=FORC                                             
  21      CONTINUE                                                              
        SEUIL=VMAX*DECLEN/100.D0                                                
        IF(IDECL.EQ.0)SEUIL=1.D-10                                              
        IF(IIMPI.EQ.1)WRITE(IOIMP,1000)SEUIL                                    
1000    FORMAT(' SEUIL D''ACQUISITION  : ',1PE12.5)                             
C                                                                               
C ELIMINE LE CHOC A CHEVAL SUR LE DEBUT DE L'ENREGISTREMENT                     
C                                                                               
        FORC=MLREE2.PROG(1)                                                     
        IF(ABS(FORC).GT.1.D-20) THEN                                            
              IF(IIMPI.EQ.1)WRITE(IOIMP,1001)                                   
1001          FORMAT(' CHOC A CHEVAL DEBUT DE BLOC ')                           
              DO 11 I=2,L1                                                      
              FORC=MLREE2.PROG(I)                                               
              IF(ABS(FORC).LE.1.D-20) THEN                                      
                  MIN=I                                                         
                  GOTO 12                                                       
              ENDIF                                                             
  11          CONTINUE                                                          
        ENDIF                                                                   
  12    CONTINUE                                                                
C                                                                               
C ELIMINE LE CHOC A CHEVAL SUR LA FIN DE L'ENREGISTREMENT                       
C                                                                               
        FORC=MLREE2.PROG(L1)                                                    
        IF(ABS(FORC).GT.1.D-20) THEN                                            
              IF(IIMPI.EQ.1)WRITE(IOIMP,1002)                                   
1002          FORMAT(' CHOC A CHEVAL FIN DE BLOC ')                             
              DO 13 I=1,L1                                                      
              FORC=MLREE2.PROG(L1-I)                                            
              IF(ABS(FORC).LE.1.D-20) THEN                                      
                  MAX=L1-I                                                      
                  GOTO 14                                                       
              ENDIF                                                             
  13          CONTINUE                                                          
        ENDIF                                                                   
  14    CONTINUE                                                                
C                                                                               
C COMPTE LE NOMBRE DE CHOCS                                                     
C                                                                               
          DO 20 I=MIN,MAX                                                       
          FORC=ABS(MLREE2.PROG(I))                                              
          IF(FORC.GT.SEUIL) THEN                                                
              IF(IIMPI.EQ.1)WRITE(IOIMP,1003)FORC,I                             
1003          FORMAT(' VALEUR = ',1PE12.5,' > SEUIL AU PT ',I5)                 
              IF(NP.EQ.0) NCHO=NCHO+1                                           
              NP=1                                                              
          ELSE                                                                  
              NP=0                                                              
          ENDIF                                                                 
  20      CONTINUE                                                              
C                                                                               
C DESACTIVE TOUT                                                                
C                                                                               
        SEGDES MLREE1,MLREE2                                        
        SEGDES KEVOLL                                                     
C                                                                               
        LECT(IC)=NCHO                                                           
C                                                                               
   1    CONTINUE                                                                
      SEGDES MEVOLL                                                       
      SEGDES MLENTI                                                             
C                                                                               
      CALL ECROBJ('LISTENTI',IPORE)                                             
C                                                                               
 100  CONTINUE                                                                  
      RETURN                                                                    
      END