C PROGRAM BNDETEST.FT C ---------------- C C C ####SUBROUTINE BNDETEST C C C C PETER LEMKIN C IMAGE PROCESSING UNIT, DCBD C NATIONAL CANCER INSTITUTE C NATIONAL INSTITUTES OF HEALTH C 9000 ROCKVILLE PIKE C BETHESDA, MD. 20014 C C NOV 21, 1977 C JULY 21, 1977 C JULY 16, 1977 C JULY 12, 1977 C JULY 5, 1977 C JULY 1, 1977 C JUNE 29, 1977 C C C C INTRODUCTION C ------------ C FOR IZ=0 C -------- C IF NOT /D C THEN C CALL THE CD FOR A SEMANTIC LABELING. C NOTE: THE KINFILE ARRAY IS LEFT INTACT (NULL DENOTES EOL) C SETUP SEMANTIC LABEL TEST TABLE ENTRY C FROM 1ST, 2ND KINFILE ENTRIES. C C ELSE C GET CHAIN CODE DIFFERENCE LABELING SIZE RANGE C *THLOW,THHIGH,SCALE,CORNERITY TH,HEURISTIC TH C (WHERE: /1 AND /2 NEGATE THLOW AND THHIGH RESPECTIVELY) C WHERE SCALE IS MULTIPLIED AS 1/SCALE; C THE RANGE RESULT IS RETURNED IN [FA:FB], C THE CORNERITY THRESHOLD IS RETURNED IN IX, C THE HEURISTIC THRESHOLD IS RETURNED IN IY. C C FOR IZ=1 C -------- C IF /C/D/V C THEN CHAIN TO "BSPLIT.SV" C ELSE RETURN C OPDEFS C ------ S OPDEF TADI 1400 S OPDEF ISZI 2400 S OPDEF DCAI 3400 C C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF KRS 6034 S OPDEF BSW 7002 C C S OPDEF LDXP 6443 S OPDEF LDYP 6444 C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C C C USE OF IBUFi C ------------ C IBUF1[1:8] - CHAIN CODE HISTOGRAM C IBUF1[10:19] - CHAIN CODE DIFFERENCE HISTOGRAM C IBUF1[21:28] - AVG CHAIN CODE HISTOGRAM C IBUF1[30:39] - AVG CHAIN CODE DIFF HIST. C C IBUF2[1:689] - SEMANTIC LABEL TEST ARRAY C DIMENSION KNUM(5),ITHRS(2) EQUIVALENCE(KNUM(4),ITHRS(1)) C DIMENSION ICSAV(5) DIMENSION KNAME(3) EQUIVALENCE(KNAME,PNAME) C DIMENSION IB4SAV(80) C SET UP DOUBLE TEST TABLE C IF S1<==KINFILE[1:3] IN PTABLE ENTRY I C THEN IVAL(1)<==I ELSE IVAL(1)<==0; C IF S1="?" C THEN IVAL(1)<==-1; C C IF S2<==INFILE[5:7] IN PTABLE ENTRY J C THEN IVAL(2)<==J ELSE IVAL(2)<==0; C IF S2="?" C THEN IVAL(2)<==-1; C ELSE NOP; C S ENTRY BNDET S CPAGE 2 S BNDET, BLOCK 2 C C C IF IZ=0 C THEN DO [E] ELSE DO [S]; S TAD \IZ S SZA CLA S JMP \1000 /[S]; C C C [E.0] GET INPUT SPACE=' ' C IF /D THEN GET CHAIN CODE DIFFERENCE RANGE C RATHER THAN RLM SEMANTIC LABELS IDSW=ISW(4) IF(IDSW)99,98,99 98 WRITE(1,100)SPACE, 100 FORMAT(' RLM SPEC (0/90)=',A1) GOTO 90 C 99 WRITE(1,101)SPACE, 101 FORMAT(' THL,THH,(SC,CRN,HUR)=',A1) C C SAVE ICNUM AND ISW 90 DO 50 I=1,5 50 ICSAV(I)=ICNUM(I) DO 51 I=1,36 51 IB4SAV(I)=ISW(I) C CALL BCDSPEC C C SAVE ICNUM IN CASE NEED IT C ALSO SAVE /1 AND /2 ISW1=ISW(28) ISW2=ISW(29) C C RESTORE ICNUM AND ISW DO 60 I=1,5 KNUM(I)=ICNUM(I) 60 ICNUM(I)=ICSAV(I) DO 61 I=1,36 61 ISW(I)=IB4SAV(I) C C C IF /D C THEN GET [FA:FB] AND RETURN IF(IDSW)200,201,200 C GET [FA:FB] C NOTE: /1 NEGATES FA, /2 NEGATES FB. 200 SC=1.0/FLOAT(MAX(1,KNUM(3))) FA=FLOAT(KNUM*(1-2*ISW1))*SC FB=FLOAT(KNUM(2)*(1-2*ISW2))*SC C GET THE CORNERITY SIZING IX=MAX(1,ITHRS) S TAD \ITHRS# S DCA \IY C DO 210 INDEX=1,3,2 210 WRITE(INDEX,203)FA,FB,IX,IY 203 FORMAT(' CCD SIZING [',F5.2,':',F5.2,']', 1/,' CRN >',I5,', HUR >',I5) GOTO 2047 C C C IF KINFILE=NULL C THEN RETURN C ELSE CONTINUE S\201, TAD \KINFILE S SNA CLA S JMP \2047 /DONE C WRITE(3,202)(KINFILE(I),I=1,3),(KINFILE(I),I=5,7) 202 FORMAT(' [0] ',3A2,'/ [90] ',3A2) C C C [E.1] FIND SWITCH VALUES C ZERO SWITCHES IVAL=0 S DCA \IVAL# C IX=1 DO 2003 IY=1,5,4 DO 2002 IZ=1,3 2002 KNAME(IZ)=KINFILE(IZ+(IY-1)) C IF KNAME="?" C THEN IVAL(IX)=-1, GOTO 2003; S TAD \KNAME S AND (7700 S TAD (-7700 /"?@" S SZA CLA S JMP \2004 /NEQ "?" IVAL(IX)=-1 GOTO 2003 C 2004 DO 2001 I=1,26 IZ=(I-1) IZ=IZ+IZ+IZ S TAD \IZ S TAD PTABLE S TAD (-1 /SINCE AUTO INDEX S DCA 11 S CLA CMA S TAD PKNAME S DCA 12 C C TEST S TAD I 11 S CIA S TAD I 12 S SZA CLA S JMP \2001 C S TAD I 11 S CIA S TAD I 12 S SZA CLA S JMP \2001 C S TAD I 11 S CIA S TAD I 12 S SZA CLA S JMP \2001 C C YES IVAL(IX)=I GOTO 2003 2001 CONTINUE C C ERROR! 2010 WRITE(1,2011) WRITE(3,2011) 2011 FORMAT(' ?ILL RLM LABEL!') S JMP \2047 2003 IX=2 C C C [E.2] FILL MATRIX S TAD \IVAL# S DCA \IZ C IF IVAL(1)=0 OR IVAL(2)=0 C THEN RETURN (IGNORE) S TAD \IVAL S SNA CLA S JMP \2010 /IGNORE S TAD \IVAL# S SNA CLA S JMP \2010 /IGNORE C C IF IVAL(1) NEQ -1 AND IVAL(2) NEQ -1 C THEN IBUF2(IVAL,IVAL(2))<==1; S TAD \IVAL S SPA CLA S JMP \2006 /NO S TAD \IVAL# S SPA CLA S JMP \2006 /NO IBUF2((IZ-1)*27+IVAL)=1 S JMP \2047 C C IF IVAL(1) = -1 AND IVAL(2) NEQ -1 C THEN FOR I<==1:26 DO IBUF2(I,IVAL(2))<==1; S\2006, TAD \IVAL S SMA CLA S JMP \2007 /NO S TAD \IVAL# S SPA CLA S JMP \2007 /NO DO 2008 I=1,26 2008 IBUF2((IZ-1)*27+I)=1 S JMP \2047 C C IF IVAL(1) NEQ -1 AND IVAL(2) = -1 C THEN FOR I<==1:26 DO IBUF2(IVAL(1),I)<==1; S\2007, TAD \IVAL S SPA CLA S JMP \2047 /NO S TAD \IVAL# S SMA CLA S JMP \2047 /NO DO 2009 I=1,26 2009 IBUF2((I-1)*27+IVAL)=1 C C RETURN S \2047, RETRN BNDET C C C [S] IF /V/D/C AND IBUF4(178) > 0 C THEN CHAIN TO "BSPLIT" 1000 IZ=ISW(22)+ISW(4)+ISW(3)-3 S TAD \IZ S SZA CLA S JMP \2047 C CURSYM='BSPLIT' IP=62 C FIRST SAVE IBUF4 QUEUE DO 1010 IZ=1,79 1010 IB4SAV(IZ)=IBUF4(IZ+177) C CALL BSEARCH C C RESTORE IBUF4 QUEUE DO 1011 IZ=1,79 1011 IBUF4(IZ+177)=IB4SAV(IZ) C S TAD \IP S SNA CLA S JMP \1004 /FAILED C CALL CHAIN(CURSYM) C C FAILED 1004 WRITE(3,1005) 1005 FORMAT(' BSPLIT.SV NOT FOUND') CALL CHAIN('BMON2') C C************** P A R A M E T E R S ************* S PKNAME, \KNAME S PIBUF1, \IBUF1 S PIBUF2, \IBUF2 S PTABLE, TABLE C S CPAGE 121 S TABLE, BLOCK 0 S TEXT /CGLHSP/ S TEXT /CGRHSP/ S TEXT /CPALFT/ S TEXT /CPARHT/ S TEXT /CPNLFT/ S TEXT /CPNRHT/ S TEXT /CMPUNY/ S TEXT /DUP-PT/ S TEXT /EXALFT/ S TEXT /EXARHT/ S TEXT /EXNLFT/ S TEXT /EXNRHT/ S TEXT /HAIREP/ S TEXT /IMPLFT/ S TEXT /IMPRHT/ S TEXT /IMPLFH/ S TEXT /IMPRHH/ S TEXT /INCDPT/ S TEXT /MRGLFT/ S TEXT /MRGRHT/ S TEXT /NEWRUN/ S TEXT /NULPNT/ S TEXT /SPCW*L/ S TEXT /SPCW*R/ S TEXT /SPCCWL/ S TEXT /SPCCWR/ S TEXT /NULOVF/ END