1 : C NOISIN SOURCE PV 07/10/05 21:16:10 5890 2 : C---------------------------------------------------------------------| 3 : C | 4 : FUNCTION NOISIN(IP,JP,IFC) 5 : C | 6 : C CETTE SUBROUTINE CHERCHE LA FACETTE JFC VOISINE DE IFC, | 7 : C AYANT POUR SEGMENT COMMUN ›IP,JP!. | 8 : C SI IL Y EN A PLUSIEURS ELLE PREND CELLE QUI FAIT LE PLUS PETIT | 9 : C ANGLE | 10 : C | 11 : C---------------------------------------------------------------------| 12 : C 13 : IMPLICIT INTEGER(I-N) 14 : IMPLICIT REAL*8(A-H,O-Z) 15 : dimension icrash(1) 16 : -INC CCOPTIO 17 : -INC TDEMAIT 18 : JFSAUV=0 19 : C 20 : C RECHERCHE DE JFC 21 : C ---------------- 22 : DO 100 I=1,40 23 : JF=NPF(I,JP) 24 : IF (JF.EQ.0) GOTO 130 25 : IF (JF.EQ.IFC) GOTO 100 26 : IF (ISUCC(JF,JP).NE.IP) GOTO 100 27 : IF (JFSAUV.EQ.0) THEN 28 : JFSAUV=JF 29 : ELSE 30 : TETSAU=TETA(jfsauv,IFC,jP,iP) 31 : * TETSAU=TETA(IFC,JFSAUV,iP,jP) 32 : * write(6,*) ' noisin double facette voisine ', 33 : * # tetsau,TETA(jf,IFC,jP,iP),jfsauv,jf 34 : * write (6,*) ' facette courante ',ifc 35 : kp=nfc(1,ifc) 36 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 37 : kp=nfc(2,ifc) 38 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 39 : kp=nfc(3,ifc) 40 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 41 : kp=nfc(4,ifc) 42 : * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 43 : * write (6,*) ' facette jfsauv ',jfsauv 44 : kp=nfc(1,jfsauv) 45 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 46 : kp=nfc(2,jfsauv) 47 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 48 : kp=nfc(3,jfsauv) 49 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 50 : kp=nfc(4,jfsauv) 51 : * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 52 : * write (6,*) ' facette jf ',jf 53 : kp=nfc(1,jf) 54 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 55 : kp=nfc(2,jf) 56 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 57 : kp=nfc(3,jf) 58 : * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 59 : kp=nfc(4,jf) 60 : * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp) 61 : IF (TETA(jf,IFC,jP,iP).gT.TETSAU) JFSAUV=JF 62 : * IF (TETA(IFC,JF,iP,jP).GT.TETSAU) JFSAUV=JF 63 : ENDIF 64 : 100 CONTINUE 65 : 130 CONTINUE 66 : IF (JFSAUV.NE.0) GOTO 110 67 : C 68 : 120 WRITE(6,1010)IFC,IP,JP 69 : 1010 FORMAT(' ERREUR |, LA FACETTE',I6,' N A PAS DE VOISINE', 70 : # ' PAR LE SEGMENT ',2I6,'!') 71 : * write (6,*) ' liste des facettes restantes ' 72 : DO 444 I=1,NFCMAX 73 : * IF (IFAT(I).EQ.1) GOTO 444 74 : WRITE (6,*) I,IFAT(i),NFC(1,I),NFC(2,I),NFC(3,I),NFC(4,I) 75 : 444 CONTINUE 76 : i=100000000 77 : nfc(1,i)=1 77 : * CALL ERRTRA 78 : C 79 : return 80 : 110 CONTINUE 81 : NOISIN=JFSAUV 82 : C WRITE(6,1000)JF,IFC 83 : C1000 FORMAT(' +++',I3,' EST VOISINE DE ',I3) 84 : C 85 : RETURN 86 : C 87 : C FIN DE LA SUBROUTINE VOISIN 88 : END 89 : 90 :
© Cast3M 2003 - All rights reserved.
Disclaimer