Télécharger noisin.eso

Retour à la liste

Numérotation des lignes :

  1. C NOISIN SOURCE JC220346 16/11/29 21:15:25 9221
  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.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC TDEMAIT
  20. JFSAUV=0
  21. C
  22. C RECHERCHE DE JFC
  23. C ----------------
  24. DO 100 I=1,40
  25. JF=NPF(I,JP)
  26. IF (JF.EQ.0) GOTO 130
  27. IF (JF.EQ.IFC) GOTO 100
  28. IF (ISUCC(JF,JP).NE.IP) GOTO 100
  29. IF (JFSAUV.EQ.0) THEN
  30. JFSAUV=JF
  31. ELSE
  32. TETSAU=TETA(jfsauv,IFC,jP,iP)
  33. * TETSAU=TETA(IFC,JFSAUV,iP,jP)
  34. * write(6,*) ' noisin double facette voisine ',
  35. * # tetsau,TETA(jf,IFC,jP,iP),jfsauv,jf
  36. * write (6,*) ' facette courante ',ifc
  37. kp=nfc(1,ifc)
  38. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  39. kp=nfc(2,ifc)
  40. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  41. kp=nfc(3,ifc)
  42. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  43. kp=nfc(4,ifc)
  44. * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  45. * write (6,*) ' facette jfsauv ',jfsauv
  46. kp=nfc(1,jfsauv)
  47. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  48. kp=nfc(2,jfsauv)
  49. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  50. kp=nfc(3,jfsauv)
  51. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  52. kp=nfc(4,jfsauv)
  53. * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  54. * write (6,*) ' facette jf ',jf
  55. kp=nfc(1,jf)
  56. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  57. kp=nfc(2,jf)
  58. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  59. kp=nfc(3,jf)
  60. * write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  61. kp=nfc(4,jf)
  62. * if (kp.ne.0) write (6,*) kp,xyz(1,kp),xyz(2,kp),xyz(3,kp)
  63. IF (TETA(jf,IFC,jP,iP).gT.TETSAU) JFSAUV=JF
  64. * IF (TETA(IFC,JF,iP,jP).GT.TETSAU) JFSAUV=JF
  65. ENDIF
  66. 100 CONTINUE
  67. 130 CONTINUE
  68. IF (JFSAUV.NE.0) GOTO 110
  69. C
  70. 120 IF (IVERB.EQ.1) WRITE(6,1010)IFC,IP,JP
  71. 1010 FORMAT(' ERREUR |, LA FACETTE',I6,' N A PAS DE VOISINE',
  72. # ' PAR LE SEGMENT ',2I6,'!')
  73. * write (6,*) ' liste des facettes restantes '
  74. DO 444 I=1,NFCMAX
  75. * IF (IFAT(I).EQ.1) GOTO 444
  76. IF (IVERB.EQ.1) WRITE(6,*) I,IFAT(i),NFC(1,I),NFC(2,I),NFC(3,I),
  77. & NFC(4,I)
  78. 444 CONTINUE
  79. i=100000000
  80. nfc(1,i)=1
  81. * CALL ERRTRA
  82. C
  83. return
  84. 110 CONTINUE
  85. NOISIN=JFSAUV
  86. C WRITE(6,1000)JF,IFC
  87. C1000 FORMAT(' +++',I3,' EST VOISINE DE ',I3)
  88. C
  89. RETURN
  90. C
  91. C FIN DE LA SUBROUTINE VOISIN
  92. END
  93.  
  94.  
  95.  
  96.  

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