C DYNE25    SOURCE    CHAT      05/01/12    23:16:03     5004           
      SUBROUTINE DYNE25(IBAS,KCPR,IK)                                           
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
*--------------------------------------------------------------------*          
*                                                                    *          
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *          
*     ________________________________________________               *          
*                                                                    *          
*     Recherche des points de r{f{rence d{finis par les points       *          
*     rep}res de la base modale.                                     *          
*                                                                    *          
*     Param}tres:                                                    *          
*                                                                    *          
* e   IBAS    Table repr{sentant une base modale                     *          
*  s  KCPR    Segment des points                                     *          
* es  IK      Compteur                                               *          
*                                                                    *          
*     Auteur, date de cr{ation:                                      *          
*                                                                    *          
*     Lionel VIVAN, le 24 octobre 1989.                              *          
*                                                                    *          
*--------------------------------------------------------------------*          
-INC CCOPTIO                                                                    
-INC SMCOORD                                                                    
*                                                                               
      SEGMENT,ICPR(XCOOR(/1)/(IDIM+1))                                          
*                                                                               
      LOGICAL L0,L1                                                             
      CHARACTER*4  MO2                                                          
      CHARACTER*8  TYPRET,CHARRE                                                       
*                                                                               
      ICPR = KCPR                                                               
*                                                                               
      IMODE = 0                                                                 
 10   CONTINUE                                                                  
      ITBMOD = 0                                                                
      IMODE = IMODE + 1                                                         
      TYPRET = ' '                                                              
      CALL ACCTAB(IBAS,'ENTIER',IMODE,X0,' ',L0,IP0,                            
     &                  TYPRET,I1,X1,CHARRE,L1,ITBMOD)                             
      IF (IERR.NE.0) RETURN                                                     
      IF (ITBMOD.NE.0) THEN                                                     
         CALL ACCTAB(ITBMOD,'MOT',I0,X0,'SOUSTYPE',L0,IP0,                      
     &               'MOT',I1,X1,MO2,L1,IP1)                                    
         IF (IERR.NE.0) RETURN                                                  
         IF (MO2.EQ.'MODE') THEN                                                
*                                                                               
*           Le point rep}re nous {choit                                         
*                                                                               
            CALL ACCTAB(ITBMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0,               
     &                         'POINT',I1,X1,' ',L1,KNOE)                       
            IF (IERR.NE.0) RETURN                                               
            IF (KNOE.NE.0) THEN                                                 
               IF (ICPR(KNOE).EQ.0) THEN                                        
                  IK = IK + 1                                                   
                  ICPR(KNOE) = IK                                               
      IF (IIMPI.EQ.333) THEN                                                    
      WRITE(IOIMP,*)'DYNE25 : basemo. ICPR(',KNOE,')=',ICPR(KNOE)               
      ENDIF                                                                     
               ENDIF                                                            
            ENDIF                                                               
         ELSE                                                                   
            CALL ERREUR(314)                                                    
            RETURN                                                              
         ENDIF                                                                  
         GOTO 10                                                                
      ENDIF                                                                     
*                                                                               
      END