Télécharger iface3.eso

Retour à la liste

Numérotation des lignes :

  1. C IFACE3 SOURCE JC220346 16/11/29 21:15:17 9221
  2. C---------------------------------------------------------------------|
  3. C |
  4. FUNCTION IFACE3(IP,JP,KP)
  5. C |
  6. C CETTE SUBROUTINE RECHERCHE LA FACETTE IFC QUI CONTIENT |
  7. C LES TROIS POINTS IP, JP ET KP. CETTE FACETTE PEUT ETRE |
  8. C CARREE OU TRIANGULAIRE. |
  9. C - IRET=1 SI IFC EXISTE |
  10. C - IRET=0 SI IFC N'EXISTE PAS |
  11. C - IRET=-1 SI IFC a existe et n'existe plus |
  12. C |
  13. C---------------------------------------------------------------------|
  14. C
  15. IMPLICIT INTEGER(I-N)
  16. IMPLICIT REAL*8(A-H,O-Z)
  17. -INC TDEMAIT
  18. -INC CCOPTIO
  19. C
  20. DO 100 I=1,40
  21. IF=NPF(I,IP)
  22. IF (IF.EQ.0) GOTO 130
  23. DO 110 J=1,40
  24. IF (NPF(J,JP).EQ.0) GOTO 100
  25. IF (IF.NE.NPF(J,JP)) GOTO 110
  26. DO 120 K=1,40
  27. IF (NPF(K,KP).EQ.0) GOTO 100
  28. IF (IF.NE.NPF(K,KP)) GOTO 120
  29. GOTO 130
  30. 120 CONTINUE
  31. GOTO 100
  32. 110 CONTINUE
  33. 100 CONTINUE
  34. IF=0
  35. 130 CONTINUE
  36. * if (if.eq.0) then
  37. * do 200 jf=1,nfcmax
  38. * do 201 j=1,4
  39. * lp=nfc(j,jf)
  40. * if (lp.eq.0) goto 201
  41. * if (ip.ne.lp.and.jp.ne.lp.and.jp.ne.kp) goto 200
  42. *201 continue
  43. * write (6,*) ' tentative de reutilisation d''une facette '
  44. * stop
  45. *200 continue
  46. * endif
  47. IFACE3=IF
  48. C FIN DE LA SUBROUTINE FACE3
  49. END
  50.  
  51.  
  52.  
  53.  

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