C DEGSUR    SOURCE    CHAT      05/01/12    22:41:07     5004           
C  ETUDIE S'IL Y A LIEU DE DEGENERER  DES ELEMENTS DANS LE CAS D'UNE            
C  SURFACE ENGENDRE PAR ROTATION (POINT SUR L'AXE APPARTENANT A LA              
C  LIGNE                                                                        
C                                                                               
      SUBROUTINE DEGSUR(MELEME,IP1,IP2)                                         
      IMPLICIT INTEGER(I-N)
-INC SMELEME                                                                    
-INC CCOPTIO                                                                    
      SEGMENT IDEG(NBNNL,NBELX)                                                 
      DIMENSION IREF(4)                                                         
C  MELEME EST ACTIF ET DOIT L'ETRE EN RETOUR                                    
      SEGACT MELEME                                                             
      IF (IDIM.EQ.2) IP2=IP1                                                    
      IP1R=IP1                                                                  
      IP2R=IP2                                                                  
      IPT1=LISREF(1)                                                            
      IPT3=LISREF(3)                                                            
      SEGACT IPT1,IPT3                                                          
C  Y A T IL LIEU DE DEGENERER DES ELEMENTS. ON EXAMINE LE COTE INITIAL          
C  PAR RAPPORT AUX POINTS DEFINISSANT L'AXE DE LA ROTATION                      
C  ON EN PROFITE POUR IDENTIFIER LES POINTS DU COTE 3 CONCERNES                 
C  SI LA DEGENERESCENCE CE FAIT SUR UNE EXTREMITE ON SUPPRIME LE COTE           
C  CORRESPONDANT                                                                
      NREF=4                                                                    
      IREF(1)=LISREF(1)                                                         
      IREF(2)=LISREF(2)                                                         
      IREF(3)=LISREF(3)                                                         
      IREF(4)=LISREF(4)                                                         
      NBNN=IPT1.NUM(/1)                                                         
      NBNNL=NBNN                                                                
      IPAS=NBNN-1                                                               
      NBELX=IPT1.NUM(/2)                                                        
      SEGINI IDEG                                                               
      DO 5 I=1,NBNNL                                                            
      DO 5 J=1,NBELX                                                            
      IDEG(I,J)=0                                                               
   5  CONTINUE                                                                  
      NBDEG=0                                                                   
      DO 10 J=1,NBELX                                                           
      DO 10 I=1,NBNN,IPAS                                                       
      IP=IPT1.NUM(I,J)                                                          
      IF (IP.NE.IP1R.AND.IP.NE.IP2R) GOTO 10                                    
      IDEG(I,J)=IP                                                              
      NBDEG=NBDEG+1                                                             
      IPT3.NUM(NBNN+1-I,NBELX+1-J)=IP                                           
      IF (I.NE.1.OR.J.NE.1) GOTO 11                                             
      IPT4=IREF(4)                                                              
      SEGSUP IPT4                                                               
      NREF=3                                                                    
      GOTO 10                                                                   
  11  IF (I.NE.NBNN.OR.J.NE.NBELX) GOTO 10                                      
      IPT2=IREF(2)                                                              
      SEGSUP IPT2                                                               
      NREF=NREF-1                                                               
      IREF(2)=IREF(3)                                                           
      IREF(3)=IREF(4)                                                           
  10  CONTINUE                                                                  
      SEGDES IPT1,IPT3                                                          
      IF (NBDEG.NE.0) GOTO 20                                                   
      SEGSUP IDEG                                                               
      RETURN                                                                    
  20  CONTINUE                                                                  
      NBELI=NUM(/2)                                                             
      NBELY=NBELI/NBELX                                                         
      IPT1=MELEME                                                               
C  IPT1 OBJET INITIAL  MELEME OBJET FINAL                                       
C  IPT3 TRIANGLES FINAUX IPT4 QUADRANGLES FINAUX                                
      IF (ITYPEL.LE.6) GOTO 500                                                 
C  CAS DES QUADRILATERES                                                        
      NBELET=NBDEG*NBELY                                                        
      NBELEQ=NBELI-NBELET                                                       
      IF (NBELEQ.EQ.0) GOTO 50                                                  
      NBELEM=NBELEQ                                                             
      NBSOUS=0                                                                  
      NBREF=0                                                                   
      NBNNQ=IPT1.NUM(/1)                                                        
      NBNN=NBNNQ                                                                
      SEGINI IPT4                                                               
      IPT4.ITYPEL=IPT1.ITYPEL                                                   
      NBELEM=NBELET                                                             
      NBNNT=(NBNNQ*3)/4                                                         
      NBNN=NBNNT                                                                
      SEGINI IPT3                                                               
      IPT3.ITYPEL=IPT1.ITYPEL-4                                                 
      NBSOUS=2                                                                  
      NBREF=NREF                                                                
      NBNN=0                                                                    
      NBELEM=0                                                                  
      SEGINI MELEME                                                             
      LISOUS(1)=IPT3                                                            
      LISOUS(2)=IPT4                                                            
      DO 40 I=1,NREF                                                            
      LISREF(I)=IREF(I)                                                         
  40  CONTINUE                                                                  
      GOTO 70                                                                   
  50  CONTINUE                                                                  
      NBELEM=NBELET                                                             
      NBNNT=(IPT1.NUM(/1)*3)/4                                                  
      NBNN=NBNNT                                                                
      NBSOUS=0                                                                  
      NBREF=NREF                                                                
      SEGINI IPT3                                                               
      MELEME=IPT3                                                               
C  EVENTUELS PROBLEMES D'OPTIMISATION                                           
      IPT4=IPT3                                                                 
      IPT3.ITYPEL=IPT1.ITYPEL-4                                                 
      DO 60 I=1,NREF                                                            
      IPT3.LISREF(I)=IREF(I)                                                    
  60  CONTINUE                                                                  
  70  CONTINUE                                                                  
C  IL FAUT MAINTENANT REMPLIR CORRECTEMENT IPT3 ET IPT4                         
      IL3=0                                                                     
      IL4=0                                                                     
      DO 100 K=1,NBELY                                                          
      DO 100 JJ=1,IPT1.NUM(/2)                                                  
      J=JJ+(K-1)*NBELY                                                          
      IF (IDEG(1,JJ).EQ.0) GOTO 105                                             
C  ON DEGENERE LE PREMIER POINT                                                 
      IL3=IL3+1                                                                 
      DO 101 I=1,NBNNT                                                          
      IPT3.NUM(I,IL3)=IPT1.NUM(I,J)                                             
 101  CONTINUE                                                                  
      IPT3.ICOLOR(IL3)=IPT1.ICOLOR(J)                                           
      GOTO 100                                                                  
 105  IF (IDEG(NBNNL,JJ).EQ.0) GOTO 110                                         
C  OM DEGENERE LE DEUXIEME POINT                                                
      IL3=IL3+1                                                                 
      IF (NBNNT.NE.3) GOTO 107                                                  
      DO 106 I=1,3                                                              
      II=I                                                                      
      IF (II.EQ.3) II=4                                                         
      IPT3.NUM(I,IL3)=IPT1.NUM(II,J)                                            
 106  CONTINUE                                                                  
      IPT3.ICOLOR(IL3)=IPT1.ICOLOR(J)                                           
      GOTO 100                                                                  
 107  CONTINUE                                                                  
      DO 108 I=1,6                                                              
      II=I                                                                      
      IF (II.GT.3) II=I+2                                                       
      IPT3.NUM(I,IL3)=IPT1.NUM(II,J)                                            
 108  CONTINUE                                                                  
      IPT3.ICOLOR(IL3)=IPT1.ICOLOR(J)                                           
      GOTO 100                                                                  
 110  CONTINUE                                                                  
C  ON RECOPIE LE QUADRILATERE                                                   
      IL4=IL4+1                                                                 
      DO 111 I=1,NBNNQ                                                          
      IPT4.NUM(I,IL4)=IPT1.NUM(I,J)                                             
 111  CONTINUE                                                                  
      IPT4.ICOLOR(IL4)=IPT1.ICOLOR(J)                                           
      GOTO 100                                                                  
 100  CONTINUE                                                                  
      SEGDES IPT4,IPT3                                                          
 500  CONTINUE                                                                  
      RETURN                                                                    
      END