C NOISIN    SOURCE    PV        07/10/05    21:16:10     5890           
C---------------------------------------------------------------------|         
C                                                                     |         
       FUNCTION NOISIN(IP,JP,IFC)                                               
C                                                                     |         
C      CETTE SUBROUTINE CHERCHE LA FACETTE JFC VOISINE DE IFC,        |         
C      AYANT POUR SEGMENT COMMUN ›IP,JP!.                             |         
C      SI IL Y EN A PLUSIEURS ELLE PREND CELLE QUI FAIT LE PLUS PETIT |         
C      ANGLE                                                          |         
C                                                                     |         
C---------------------------------------------------------------------|         
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
       dimension icrash(1)
-INC CCOPTIO                                                                    
-INC TDEMAIT                                                                    
       JFSAUV=0                                                                 
C                                                                               
C      RECHERCHE DE JFC                                                         
C      ----------------                                                         
       DO 100 I=1,40
              JF=NPF(I,JP)                                                      
              IF (JF.EQ.0) GOTO 130                                             
              IF (JF.EQ.IFC) GOTO 100                                           
              IF (ISUCC(JF,JP).NE.IP) GOTO 100                                  
              IF (JFSAUV.EQ.0) THEN                                             
                JFSAUV=JF                                                       
              ELSE                                                              
                TETSAU=TETA(jfsauv,IFC,jP,iP)
*               TETSAU=TETA(IFC,JFSAUV,iP,jP)
*          write(6,*) ' noisin double facette voisine ',
*    #  tetsau,TETA(jf,IFC,jP,iP),jfsauv,jf
*          write (6,*) ' facette courante ',ifc
           kp=nfc(1,ifc)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(2,ifc)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(3,ifc)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(4,ifc)
*          if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
*          write (6,*) ' facette jfsauv ',jfsauv
           kp=nfc(1,jfsauv)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(2,jfsauv)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(3,jfsauv)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(4,jfsauv)
*          if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
*          write (6,*) ' facette jf  ',jf
           kp=nfc(1,jf)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(2,jf)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(3,jf)
*          write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
           kp=nfc(4,jf)
*          if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
                IF (TETA(jf,IFC,jP,iP).gT.TETSAU) JFSAUV=JF
*               IF (TETA(IFC,JF,iP,jP).GT.TETSAU) JFSAUV=JF
              ENDIF                                                             
100    CONTINUE                                                                 
130    CONTINUE                                                                 
       IF (JFSAUV.NE.0) GOTO 110                                                
C                                                                               
120    WRITE(6,1010)IFC,IP,JP                                                   
1010   FORMAT(' ERREUR |, LA FACETTE',I6,' N A PAS DE VOISINE',
     #        ' PAR LE SEGMENT ',2I6,'!')
*      write (6,*) ' liste des facettes restantes '
       DO 444 I=1,NFCMAX                                                        
*       IF (IFAT(I).EQ.1) GOTO 444
        WRITE (6,*)  I,IFAT(i),NFC(1,I),NFC(2,I),NFC(3,I),NFC(4,I)
 444  CONTINUE                                                                  
       i=100000000
       nfc(1,i)=1
*      CALL ERRTRA                                                              
C                                                                               
       return
110    CONTINUE                                                                 
         NOISIN=JFSAUV                                                          
C       WRITE(6,1000)JF,IFC                                                     
C1000   FORMAT(' +++',I3,' EST VOISINE DE ',I3)                                 
C                                                                               
       RETURN                                                                   
C                                                                               
C      FIN DE LA SUBROUTINE VOISIN                                              
       END