Sources Esope | Cast3M

noisin
C NOISIN    SOURCE    PV        21/12/18    07:15:09     11240          
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 PPARAM
-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    IF (IVERB.EQ.1) 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
        IF (IVERB.EQ.1) 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
       noisin=0
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