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 16 : CALL KPUSH(IS,JS,NS,KG(1),KG(2)) KPA00060 17 : NINT = 0 KPA00070 18 : KBITM(KG(1),KG(2)) = 2 KPA00080 19 : C KPA00090 20 : 1 CONTINUE KPA00100 21 : IF (NS.EQ.0) THEN KPA00110 22 : RETURN KPA00120 23 : ELSE KPA00130 23 : CALL KPOP(IS,JS,NS,IP,JP) KPA00140 24 : 11 CONTINUE KPA00150 25 : 26 : IF(NINT.GE.NMAX) RETURN 27 : NINT = NINT + 1 KPA00160 28 : IINT(1,NINT) = IP KPA00170 29 : IINT(2,NINT) = JP KPA00180 30 : 30 : CALL KADJ(IP,JP,KBITM,NR,NADJ,IADJ,JADJ) KPA00190 31 : IF (NADJ.EQ.0) THEN KPA00200 32 : GOTO 1 KPA00210 33 : ELSE KPA00220 34 : IF(NADJ.GE.2) THEN KPA00230 35 : DO 111 K = 2,NADJ KPA00240 36 : IP = IADJ(K) KPA00250 37 : JP = JADJ(K) KPA00260 37 : CALL KPUSH(IS,JS,NS,IP,JP) KPA00270 38 : KBITM(IP,JP) = 2 KPA00290 39 : 111 CONTINUE KPA00300 40 : ENDIF KPA00310 41 : IP = IADJ(1) KPA00320 42 : JP = JADJ(1) KPA00330 43 : KBITM(IP,JP) = 2 KPA00340 44 : GOTO 11 KPA00350 45 : ENDIF KPA00360 46 : ENDIF KPA00370 47 : END KPA00380 48 : 49 :
© Cast3M 2003 - All rights reserved.
Disclaimer