Numérotation des lignes :

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=0CC      RECHERCHE DE JFCC      ----------------       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              ENDIF100    CONTINUE130    CONTINUE       IF (JFSAUV.NE.0) GOTO 110C120    IF (IVERB.EQ.1) WRITE(6,1010)IFC,IP,JP1010   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=0C       return110    CONTINUE         NOISIN=JFSAUVC       WRITE(6,1000)JF,IFCC1000   FORMAT(' +++',I3,' EST VOISINE DE ',I3)C       RETURNCC      FIN DE LA SUBROUTINE VOISIN       END     

© Cast3M 2003 - Tous droits réservés.
Mentions légales