Télécharger kparc.eso

Retour à la liste

Numérotation des lignes :

  1. C KPARC SOURCE CHAT 05/01/13 01:03:56 5004
  2. SUBROUTINE KPARC(KG,KBITM,NR,NINT,IINT,NMAX,IS,JS,NSTAC) KPA00010
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C Calcul des facteurs de forme en 3D
  6. C sp appele par KREMPI
  7. C DETERMINATION DE L'ENSEMBLE DES POINTS INTERIEURS A UN CONTOUR
  8. C DONNE (DANS UNE BITMAP) REPERE PAR DES 1
  9. C KPA00040
  10. C REM TAILLE MAX DE STACK = NSTAC
  11. C ***
  12. C
  13. DIMENSION IINT(2,1) KPA00020
  14. DIMENSION KG(2),KBITM(NR,NR),IADJ(4),JADJ(4) KPA00020
  15. DIMENSION IS(NSTAC),JS(NSTAC) KPA000
  16. NS = 0 KPA00050
  17. CALL KPUSH(IS,JS,NS,KG(1),KG(2)) KPA00060
  18. NINT = 0 KPA00070
  19. KBITM(KG(1),KG(2)) = 2 KPA00080
  20. C KPA00090
  21. 1 CONTINUE KPA00100
  22. IF (NS.EQ.0) THEN KPA00110
  23. RETURN KPA00120
  24. ELSE KPA00130
  25. CALL KPOP(IS,JS,NS,IP,JP) KPA00140
  26. 11 CONTINUE KPA00150
  27.  
  28. IF(NINT.GE.NMAX) RETURN
  29. NINT = NINT + 1 KPA00160
  30. IINT(1,NINT) = IP KPA00170
  31. IINT(2,NINT) = JP KPA00180
  32.  
  33. CALL KADJ(IP,JP,KBITM,NR,NADJ,IADJ,JADJ) KPA00190
  34. IF (NADJ.EQ.0) THEN KPA00200
  35. GOTO 1 KPA00210
  36. ELSE KPA00220
  37. IF(NADJ.GE.2) THEN KPA00230
  38. DO 111 K = 2,NADJ KPA00240
  39. IP = IADJ(K) KPA00250
  40. JP = JADJ(K) KPA00260
  41. CALL KPUSH(IS,JS,NS,IP,JP) KPA00270
  42. KBITM(IP,JP) = 2 KPA00290
  43. 111 CONTINUE KPA00300
  44. ENDIF KPA00310
  45. IP = IADJ(1) KPA00320
  46. JP = JADJ(1) KPA00330
  47. KBITM(IP,JP) = 2 KPA00340
  48. GOTO 11 KPA00350
  49. ENDIF KPA00360
  50. ENDIF KPA00370
  51. END KPA00380
  52.  
  53.  
  54.  

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