Télécharger la plaquette Cast3M


fr en

Télécharger kparc.eso

Retour à la liste

Numérotation des lignes : 

kparc

  1. C KPARC     SOURCE    CB215821  25/04/22    21:15:09     12245          
  2.       SUBROUTINE  KPARC(KG,KBITM,NR,NINT,IINT,NMAX,IS,JS,NSTAC)
  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
  10. C     REM   TAILLE MAX DE STACK = NSTAC
  11. C     ***
  12. C
  13.       DIMENSION IINT(2,1)
  14.       DIMENSION KG(2),KBITM(NR,NR),IADJ(4),JADJ(4)
  15.       DIMENSION IS(NSTAC),JS(NSTAC)
  16.       NS = 0
  17.       CALL KPUSH(IS,JS,NS,KG(1),KG(2))
  18.       NINT = 0
  19.       KBITM(KG(1),KG(2)) = 2
  20. C
  21.  1    CONTINUE
  22.       IF (NS.EQ.0) THEN
  23.          RETURN
  24.       ELSE
  25.          CALL KPOP(IS,JS,NS,IP,JP)
  26.  11      CONTINUE
  27.  
  28.          IF(NINT.GE.NMAX) RETURN
  29.          NINT = NINT + 1
  30.          IINT(1,NINT) = IP
  31.          IINT(2,NINT) = JP
  32.  
  33.          CALL  KADJ(IP,JP,KBITM,NR,NADJ,IADJ,JADJ)
  34.          IF (NADJ.EQ.0) THEN
  35.            GOTO 1
  36.          ELSE
  37.            IF(NADJ.GE.2) THEN
  38.              DO 111 K = 2,NADJ
  39.                 IP = IADJ(K)
  40.                 JP = JADJ(K)
  41.                 CALL KPUSH(IS,JS,NS,IP,JP)
  42.                 KBITM(IP,JP) = 2
  43.  111         CONTINUE
  44.            ENDIF
  45.          IP = IADJ(1)
  46.          JP = JADJ(1)
  47.          KBITM(IP,JP) = 2
  48.          GOTO 11
  49.          ENDIF
  50.       ENDIF
  51.       END
  52.  
  53.  
  54.  
  55.  

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