CTITLESAMRKR -- DRIVER ROUTINE FOR THE BORROWING CODE 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. O'NEILL 00000020 CA DESIGNER D. O'NEILL 00000030 CA LANGUAGE S/370 FORTRAN H 00000040 CA WRITTEN 02-23-84 00000050 C REVISED 04-02-86 PKC. ADDED CHECK FOR SEQUENTIAL LINES GOING 00000060 C INTO BORROWING PROGRAM. 00000061 C REVISED 04-04-86 PKC. ADDED BINPRT FLAG SO WILL PRINT PROGRESS 00000062 C REPORT EVERY BIN. 00000063 C REVISED 03-11-88 TJT. ADDED BORROWING INTO EMPTY BINS. 00000064 C ADDED TABLE OF TRACE HEADER VALUES TO 00000064 C REDUCE DISK I/O. 00000064 C REVISED 02-05-90 TJT. FIX MIDPT X,Y-- BORROWING INTO EMPTY BINS. 00000064 C REVISED MM-DD-YY PROGRAMMER 00000064 CA 00000070 CA 00000080 CA CALL SAMRKR (CDPDA, MNXDST, BINWRK, LASTLN, THISLN, NEXTLN, 00000090 CA MNDP, MXDP, MNLNC, MNLN, MXLN, NDPS, SDPN, MAXTRC, 00000100 CA NORDER, DFOLD, ETRCS, EQUIV, KPPRNT, NUMSLT, MNDPR, 00000110 CA MXDPR, MNLNR, MXLNR, MEMTAB, NCORE, MEMCHG, SAVCHG, 00000110 CA MIDXY, FRSTLN, *) 00000110 CA 00000120 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000130 CA 00000140 CA IN CDPDA I4 DISK ADDRESS TABLE OF GATHERED TRACES 00000150 CA IN MNXDST I4 MINIMUM OFFSET FOR BORROWING 00000160 CA IN BINWRK I4 WORK ARRAY FOR HEADER INFORMATION 00000170 CA IN LASTLN I4 HEADER INFORMATION FOR LAST LINE PROCESSED00000180 CA IN THISLN I4 HEADER INFORMATION FOR THIS LINE 00000190 CA IN NEXTLN I4 HEADER INFORMATION FOR NEXT LINE 00000200 CA IN MNDP I4 MINIMUM DEPTH POINT TO PROCESS 00000210 CA IN MXDP I4 MAXIMUM DEPTH POINT TO PROCESS 00000220 CA IN MNLNC I4 MINIMUM LINE NO. USED FOR INDEXING 00000230 CA IN MNLN I4 MINIMUM LINE NO. TO PROCESS 00000240 CA IN MXLN I4 MAXIMUM LINE NO. TO PROCESS 00000250 CA IN NDPS I4 NUMBER OF DEPTH POINTS PER LINE 00000260 CA IN SDPN I4 STARTING DEPTH POINT NUMBER 00000270 CA IN MAXTRC I4 MAXIMUM TRACE FOLD PER BIN 00000280 CA IN NORDER I4 ASCENDING/DESCENDING TRACE ORDER FLAG 00000290 CA IN DFOLD I4 DESIRED FOLD IN BIN 00000310 CA IN ETRCS I4 NUMBER OF EQUIVALENT TRACES 00000320 CA IN EQUIV I4 ARRAY CONTAINING EQUIVALENT TRACES 00000330 CA IN KPPRNT I4 FORTRAN PRINTER UNIT 00000340 CA IN NUMSLT I4 NUMBER OF SELECTED BORROWING AREAS 00000340 CA IN MNDPR I4 MINIMUM DEPTH POINT RANGE 00000340 CA IN MXDPR I4 MAXIMUM DEPTH POINT RANGE 00000340 CA IN MNLNR I4 MINIMUM 3-D LINE NO. RANGE 00000340 CA IN MXLNR I4 MAXIMUM 3-D LINE NO. RANGE 00000340 CA IN MEMTAB I4 TABLE OF 8 WORD TRACE HEADERS 00000340 CA IN NCORE I4 POINTER TO WHICH MEMORY PAGE IS IN CORE 00000340 CA IN MEMCHG I4 FLAG SET IF DATA CHANGES IN MEMORY TABLE 00000340 CA IN SAVCHG I4 FLAG USED TO RESTORE HEADERS 00001020 CA TO DISK IN MAINLINE 00001020 CA 00000350 CA THIS ROUTINE SETS UP THE TABLES NECESSARY TO DO THE BORROWING 00000360 CA AND DRIVES THE ROUTINES THAT DO THE BORROWING. 00000370 CAEND 00000380 C 00000390 C EJECT 00000400 C LOCAL OR INTERNAL ARRAYS 00000410 C 00000420 C ARGUMENT TYPE LENGTH DESCRIPTION 00000430 C CDPDA I4 VAR. DISK ADDRESS OF FIRST TRACE 00000450 C EQUIV I4 (ETRCS, EQUIVALENCE ARRAY OF TRACE NUMBERS 00000460 C DFOLD) 00000470 C BINWRK I4 11,MAXTRC WORK ARRAY FOR HEADER INFORMATION 00000471 C LASTLN I4 (11, LIKE BINWRK; FOR THE LINE PREVIOUS TO THE 00000490 C MAXTRC) LINE BEING TREATED WITH BORROWING 00000500 C NEXTLN I4 (11, LIKE BINWRK; FOR THE LINE SUBSEQUENT TO THE 00000501 C MAXTRC) LINE BEING TREATED WITH BORROWING; NEXTLN IS 00000502 C IDENTICAL WITH BINWRK 00000503 C THISLN (11, LIKE BINWRK; FOR THE LINE BEING TREATED 00000510 C MAXTRC) WITH BORROWING 00000520 C TRCHDR I4 THL ARRAY INTO WHICH THE TRACE HEADER IS READ 00000521 C 00000560 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00000570 C 00000580 C ARGUMENT TYPE DESCRIPTION 00000590 C DA I4 DISK ADDRESS FOR A TRACE HEADER 00000591 C BIN I4 COUNTER FOR OUTER DO LOOP; BIN BEING TREATED 00000600 C NDA I4 1, INDEX FOR TRACE HEADER DISK LOCATION 00000610 C LINE I4 COUNTER FOR INNER DO LOOP; LINE BEING TREATED 00000620 C MNDP I4 MINIMUM 'DEPTH POINT' (I.E., BIN) NUMBER 00000630 C MNLN I4 MINIMUM 3D LINE NUMBER 00000631 C MXDP I4 MAXIMUM 'DEPTH POINT' (I.E., BIN) NUMBER 00000632 C MXLN I4 MAXIMUM 3D LINE NUMBER 00000633 C NDPS I4 NUMBER OF 'DEPTH POINTS' (I.E., BINS) IN LINE 00000634 C NTLL I4 NUMBER OF TRACES IN LASTLN 00000635 C NTNL I4 NUMBER OF TRACES IN NEXTLN 00000636 C NTTL I4 NUMBER OF TRACES IN THISLN 00000637 C SDPN I4 STARTING 'DEPTH POINT' (I.E., BIN) NUMBER 00000638 C DFOLD I4 NUMBER OF TRACES IN AN IDEAL BIN 00000640 C ETRCS I4 NUMBER OF TRACE NUMBERS THAT ARE EQUIVALENT 00000650 C INDEX I4 COUNTER FOR NUMBER OF TRACE HEADERS READ SO FAR 00000660 C NASSN I4 8, INDEX FOR OUTPUT OF "SAASGN" 00000661 C 1 => TRACE BELONGS IN THIS BIN 00000662 C -1 => TRACE IS REDUNDANT 00000663 C 2 => TRACE HAS BEEN BORROWED 00000664 C NOT WRITTEN TO THSYR7 00000665 C NMEMB I4 NUMBER OF MEMBERS (1ST INDEX OF ARRAYS) 00000666 C NTRCS I4 NUMBER OF TRACES IN BIN 00000667 C BINLOC I4 USED IN COMPUTING DISK ADDRESS FOR NEXT HEADER 00000668 C KPPRNT I4 FORTRAN UNIT NUMBER FOR PRINTED OUTPUT 00000670 C LASTRC I4 VALUE FROM TRACE HEADER INDICATING THAT THE 00000680 C TRACE READ IS THE LAST IN THE BIN GATHER;=-9999 00000690 C MAXTRC I4 MAXIMUM NUMBER OF TRACES PER BIN 00000710 C NHCDPN I4 3, INDEX FOR 3D BIN NUMBER (THCDPN) 00000720 C NHLNM1 I4 4, INDEX FOR 1ST WORD OF LINE NAME (THLNAM) 00000800 C NHLNM2 I4 5, INDEX FOR 2ND WORD LINE NAME 00000810 C NHLNNO I4 2, INDEX FOR 3D LINE NUMBER (THLNNO) 00000811 C NHMDPX I4 9, INDEX FOR BIN CENTER X-COORD (THMDPX) 00000812 C REWRITTEN IF NASSN = 2, WHEN BIN NUMBER IS CHANGED 00000813 C NHMDPY I4 10, INDEX FOR BIN CENTER Y-COORD (THMDPY) 00000814 C REWRITTEN IF NASSN = 2, WHEN BIN NUMBER IS CHANGED 00000815 C NHORTN I4 7, INDEX FOR TRACE NUMBER (THORTN) 00000830 C NLINES I4 NUMBER OF LINES TREATED IN THIS PASS OF BINS 00000930 C NORDER I4 VARIABLE USED IN FINDING RELATIVE LINE NUMBERS 00000950 C 1 = LOWEST RECEIVER NUMBER = NEAREST OFFSET 00000960 C -1 = HIGHEST RECEIVER NUMBER = NEAREST OFFSET 00000970 C NRLINE I4 6, INDEX FOR OUTPUT OF "SARELN" - RELATIVE LINE NO. 00000971 C PRNTSW I4 PRINT ENABLE SWITCH; 1 = PRINT 00001020 C SAVCHG I4 FLAG USED TO RESTORE HEADERS TO DISK IN MAINLINE 00001020 C TESTSW I4 SWITCH ALLOWING TESTING OF THE FIRST TRACE 00001060 C HEADER TO ENSURE THAT IT IS IN RANGE 00001070 C 00001080 C OTHER SUBROUTINES AND FUNCTIONS CALLED: 00001090 C SABSRT => BUBBLE SORTER 00001100 C SARELN => DETERMINES RELATIVE LINE NUMBERS 00001110 C SAASGN => ASSIGNS FLAGS TO ASSIGNED AND REDUNDANT TRACES 00001120 C SABORW => PERFORMS BORROWING OF REDUNDANT TRACES 00001130 C 00001140 C SPACE LIMITATIONS: BORROWING: 500 TRACES/BIN 00001150 C 00001160 C EJECT 00001170 SUBROUTINE SAMRKR(CDPDA, MNXDST, BINWRK, LASTLN, THISLN, NEXTLN, 00001180 * MNDP, MXDP, MNLNC, MNLN, MXLN, NDPS, SDPN, MAXTRC, NORDER, 00001190 * DFOLD, ETRCS, EQUIV, KPPRNT, NUMSLT, MNDPR, MXDPR, MNLNR, 00001200 * MXLNR, MEMTAB, NCORE, MEMCHG, SAVCHG, MIDXY, FRSTLN, *) 00001200 IMPLICIT INTEGER (A-Z) 00001210 INTEGER CDPDA(1) 00001220 INTEGER BINWRK (11,MAXTRC) 00001230 INTEGER LASTLN (11,MAXTRC) 00001240 INTEGER THISLN (11,MAXTRC) 00001250 INTEGER NEXTLN (11,MAXTRC) 00001260 INTEGER EQUIV (ETRCS, DFOLD) 00001270 INTEGER MNDPR (1) INTEGER MXDPR (1) INTEGER MNLNR (1) INTEGER MXLNR (1) INTEGER MEMTAB (1) INTEGER MIDXY (1) CJT INTEGER TRCHDR (190) 00001280 CPC INTEGER TIMEX, TIMEY, TIMEAS, TIMEBR, TIMEBL, TIMERL 00001300 CPC INTEGER TIMEBG, TIMEMD, TIMEND 00001310 CPC 00001340 CPC TIMEX = 0 00001350 CPC TIMEAS = 0 00001360 CPC TIMEBR = 0 00001370 CPC TIMEBL = 0 00001380 CPC TIMERL = 0 00001390 CPC TIMEBG = 0 00001400 CPC TIMEMD = 0 00001410 CPC TIMEND = 0 00001420 CPC TIMETL = 0 00001430 CDEBUG 00001440 CPC CALL CLOCK(TIMEX,TIMETL) 00001450 CPC WRITE (KPPRNT, 91919) TIMEX, TIMETL 00001460 CPC19 FORMAT(3X,'TIMEX ',I10,' TIMETL ',I10) 00001470 CDEBUG 00001480 C 00001490 C SET SOME PARAMETERS 00001500 C 00001510 C LOCATIONS OF INFORMATION IN "BINWRK" 00001520 NDA=1 00001530 NHLNNO=2 00001540 NHCDPN=3 00001550 NHLNM1=4 00001560 NHLNM2=5 00001570 NRLINE=6 00001580 NHORTN=7 00001590 NASSN=8 00001600 NHMDPX=9 00001610 NHMDPY=10 00001620 NHXDST=11 00001620 NMEMB=11 00001630 C INITIALIZE VALUES 00001640 SAVCHG = 0 00001650 C LAST TRACE FLAG VALUE 00001680 LASTRC=-9999 00001690 C SWITCH ALLOWING COMPARISON OF READ LINE & BIN WITH DESIRED 00001700 TESTSW=0 00001710 C NUMBER OF EQUIVALENCIES PER TRACE NUMBER 00001720 C (E.G., IF 1=2, 3=4, 5=6, ETC., THEN ETRCS=2) 00001730 ETRCS=2 00001740 C 00001750 C CYCLE THROUGH ALL LINES AND ALL BINS OR SELECT AN AREA 00001760 C 00001770 DO 205 IS = 1, NUMSLT C DEFAULT TO ALL LINES OR ALL BINS IF NOT INPUT... IF(MNDPR(IS) .EQ. 0) MNDPR(IS) = MNDP IF(MXDPR(IS) .EQ. 0) MXDPR(IS) = MXDP IF(MNLNR(IS) .EQ. 0) MNLNR(IS) = MNLN IF(MXLNR(IS) .EQ. 0) MXLNR(IS) = MXLN C LMNDP = MNDPR(IS) LMXDP = MXDPR(IS) LMNLN = MNLNR(IS) LMXLN = MXLNR(IS) WRITE(KPPRNT,9160) LMNDP, LMXDP, LMNLN, LMXLN C DO 200 BIN = LMNDP,LMXDP 00001780 NTLL = 0 00001650 NTTL = 0 00001660 NTNL = 0 00001670 NLINES = 0 00001790 BINPRT = 1 00001791 C 00001800 DO 160 LINE = LMNLN,LMXLN 00001810 CPC 00001820 CPC CALL CLOCK(TIMEX,TIMEY) 00001830 CPC 00001840 C 00001850 C SET VALUE OF PRNTSW FOR THIS LINE & BIN 00001860 PRNTSW=0 00001880 CTJT IF(BIN .EQ. 302) PRNTSW = 1 00001900 CTJT IF(BIN .EQ. 678) PRNTSW = 1 00001900 5 CONTINUE 00001920 C 00001930 C********************************************************************** 00001940 C * 00001950 C READ NEEDED INFORMATION FROM TRACE HEADERS * 00001960 C * 00001970 C********************************************************************** 00001980 C 00001990 C SETUP FOR READING VALUES FROM TRACE HEADER 00002000 C 00002010 INDEX = 0 00002020 NTRCS = 0 00002030 BINLOC = (LINE-MNLNC) * NDPS + BIN - SDPN + 1 00002040 DA = CDPDA(BINLOC) 00002050 IF (PRNTSW .EQ. 1) WRITE(KPPRNT, 8889) 00002060 CPC IF (BIN .GT. 202 .AND. BIN .LT. 208) 00002070 CPC * WRITE(KPPRNT, 8889) 00002080 8889 FORMAT (/5X,'NDA LNNO CDPN LINENAME RLINE ORTN', 00002090 * ' ASSN MDPX MDPY DA') 00002100 CPC 00002120 C 00002120 C IF EMPTY BIN -- SKIP READING TRACE HEADERS 00002120 C 00002120 IF(DA.EQ.LASTRC) GO TO 45 00002131 10 INDEX = INDEX+1 00002140 IF (INDEX .GT. MAXTRC) WRITE(KPPRNT, 9000 ) MAXTRC, BIN, LINE 00002150 IF (INDEX .GT. MAXTRC) GO TO 160 00002170 BINWRK (NDA, INDEX) = DA 00002180 C 00002197 CJT CALL FOGMRD(TRCHDR, DA, *250 ) 00002198 C C GET HEADER WORDS FROM MEMORY TABLE C MEM = ((DA-1) * 8) + 1 PAGE = MEM/8000 MEM = MEM - (PAGE * 8000) PAGE = PAGE + 1 IF(PAGE .NE. NCORE) * CALL SAMEMT(MEMTAB(1), NCORE, PAGE, MEMCHG) DA = MEMTAB(MEM) BINWRK(NHLNM1,INDEX) = MEMTAB(MEM+1) BINWRK(NHLNM2,INDEX) = MEMTAB(MEM+2) BINWRK(NHORTN,INDEX) = MEMTAB(MEM+3) / 100000 BINWRK(NHLNNO,INDEX) = * MEMTAB(MEM+3) - BINWRK(NHORTN,INDEX) * 100000 BINWRK(NHCDPN,INDEX) = MEMTAB(MEM+4) BINWRK(NHXDST,INDEX) = MEMTAB(MEM+5) BINWRK(NHMDPX,INDEX) = MEMTAB(MEM+6) BINWRK(NHMDPY,INDEX) = MEMTAB(MEM+7) NTRCS = NTRCS + 1 00002200 C 00002210 C OBTAIN NEEDED VALUES FROM TRACE HEADER 00002220 C 00002230 CJT CALL USRTHV(TRCHDR, 'THGATH ', DA) 00002240 CJT CALL USRTHV(TRCHDR, 'THLNAM ', BINWRK(NHLNM1,INDEX)) 00002250 CPC CALL USRTHV(TRCHDR, 'THAYR2 ', BINWRK(NHLNM2,INDEX)) 00002260 CJT CALL USRTHV(TRCHDR, 'THORTN ', BINWRK(NHORTN,INDEX)) 00002270 CJT CALL USRTHV(TRCHDR, 'THCDPN ', BINWRK(NHCDPN,INDEX)) 00002280 CJT CALL USRTHV(TRCHDR, 'THLNNO ', BINWRK(NHLNNO,INDEX)) 00002290 CJT CALL USRTHV(TRCHDR, 'THMDPX ', BINWRK(NHMDPX,INDEX)) 00002300 CJT CALL USRTHV(TRCHDR, 'THMDPY ', BINWRK(NHMDPY,INDEX)) 00002310 CPC 00002320 15 IF (PRNTSW .EQ. 1) 00002330 CPC IF (BIN .GT. 202 .AND. BIN .LT. 208) 00002340 * WRITE(KPPRNT, 8000) (BINWRK(I,INDEX),I=1,10),DA 00002350 8000 FORMAT (1X,I7,1X,I5,1X,I5,3X,2A4,1X,I5,1X,I5,1X,I5, 00002360 * 1X,I9,1X,I9,1X,I7) 00002370 CPC 00002380 C 00002390 C TEST THAT CALCULATED LINE & BIN = LINE & BIN FROM TRACE HEADER 00002400 C 00002410 IF(TESTSW .NE. 0) GO TO 20 00002420 IF(BINWRK(NHCDPN,INDEX) .NE. BIN) GO TO 280 00002430 IF(BINWRK(NHLNNO,INDEX) .NE. LINE) GO TO 290 00002440 TESTSW = 1 00002450 20 IF(DA .NE. LASTRC) GO TO 10 00002460 C PRINT FOR SDSF VEIWING 00002470 IF (BINPRT .EQ. 0) GO TO 30 00002480 WRITE(KPPRNT, 9010 ) BIN 00002490 BINPRT = 0 00002491 C 00002500 30 CONTINUE 00002510 C 00002520 C********************************************************************** 00002530 C * 00002540 C CHECK EACH TRACE FOR REDUNDANCY WITHIN THE BIN * 00002550 C * 00002560 C********************************************************************** 00002570 C 00002580 C INITIALIZE THE RELATIVE LINE AND ASSIGN FIELDS TO ZERO 00002590 C 00002600 DO 40 INIT = 1,NTRCS 00002610 BINWRK(NRLINE,INIT) = 0 00002620 BINWRK(NASSN,INIT) = 0 00002630 40 CONTINUE 00002640 C 00002650 C SORT THE TRACES INTO RECEIVER NUMBER ORDER 00002660 C 00002670 CPC CALL CUMTIM(TIMEBG, TIMEX, TIMEY) 00002680 CALL SABSRT(BINWRK, NMEMB, NTRCS, NHORTN, NORDER, PRNTSW, 00002690 * KPPRNT, *210 ) 00002700 CPC CALL CUMTIM(TIMEBL, TIMEX, TIMEY) 00002710 C 00002720 C DETERMINE RELATIVE LINE NUMBER FOR EACH TRACE 00002730 C 00002740 CALL SARELN(BINWRK, NMEMB, NTRCS, NHLNM1, NHLNM2, NRLINE, 00002750 * PRNTSW,KPPRNT, *220 ) 00002760 CPC CALL CUMTIM(TIMERL, TIMEX, TIMEY) 00002770 C 00002780 C EXAMINE SORTED TRACES FOR DUPLICATE OFFSETS AND MARK EACH TRACE 00002790 C 00002800 CALL SAASGN(BINWRK, NMEMB, NTRCS, NHORTN, NRLINE, NASSN, 00002810 * DFOLD, ETRCS, EQUIV, NHXDST, MNXDST, 00002820 * PRNTSW, KPPRNT, *230 ) 00002820 CPC CALL CUMTIM(TIMEAS, TIMEX, TIMEY) 00002830 C 00002840 C IF EMPTY BIN COME DIRECTLY HERE 00002840 C 00002840 45 CONTINUE C 00002840 C WRITE RESULTS TO PAPER 00002850 C 00002860 IF(PRNTSW.NE.1)GO TO 50 00002870 WRITE(KPPRNT, 9020 )LINE,BIN,NTRCS 00002880 WRITE(KPPRNT, 9030 ) 00002890 WRITE(KPPRNT, 9040 )((BINWRK(K,J),K=2,NMEMB),J=1,NTRCS) 00002900 50 CONTINUE 00002920 C 00002930 C********************************************************************** 00002940 C * 00002950 C PERFORM BORROWING * 00002960 C * 00002970 C********************************************************************** 00002980 C 00002990 C REWRITE COPIES OF BINWRK FOR THE LAST THREE LINES FOR BORROWING 00003000 C 00003010 NLINES = NLINES + 1 00003030 NTLL = NTTL 00003040 NTTL = NTNL 00003050 NTNL = NTRCS 00003060 C 00003070 DO 90 J = 1, NMEMB 00003080 C 00003090 DO 60 I = 1, NTLL 00003100 LASTLN(J,I) = THISLN(J,I) 00003110 CJT IF (LASTLN(NASSN,I) .EQ. 1) LINELL = LASTLN(NHLNNO,I) 00003111 60 CONTINUE 00003120 C 00003130 DO 70 I = 1, NTTL 00003140 THISLN(J,I) = NEXTLN(J,I) 00003150 CJT IF (THISLN(NASSN,I) .EQ. 1) LINETL = THISLN(NHLNNO,I) 00003151 70 CONTINUE 00003160 C 00003170 DO 80 I = 1, NTNL 00003180 NEXTLN(J,I) = BINWRK(J,I) 00003190 CJT IF (NEXTLN(NASSN,I) .EQ. 1) LINENL = NEXTLN(NHLNNO,I) 00003191 80 CONTINUE 00003200 C 00003210 90 CONTINUE 00003220 C 00003230 CJT IF (LINELL+1 .NE. LINETL .OR. 00003231 CJT * LINETL+1 .NE. LINENL) GO TO 160 00003232 C 00003233 C CALL BORROWING 00003240 C 00003250 IF(NLINES .LT. 2) GO TO 160 00003260 CPC CALL CUMTIM(TIMEMD, TIMEX, TIMEY) 00003270 C 00003271 CALL SABORW(LASTLN,THISLN,NEXTLN,NTLL,NTTL,NTNL,NHLNNO, 00003280 * NHLNM1,NHLNM2,NRLINE,NHORTN,NASSN,NHMDPX,NHMDPY,NMEMB, 00003290 * NORDER,DFOLD,ETRCS,EQUIV,LINE,BIN,PRNTSW,KPPRNT, 00003300 * MIDXY, FRSTLN, NDPS, SDPN, *240) 00003300 C 00003310 CPC CALL CUMTIM(TIMEBR, TIMEX, TIMEY) 00003320 C 00003330 C********************************************************************** 00003340 C * 00003350 C WRITE INFORMATION TO TRACE HEADERS * 00003360 C * 00003370 C********************************************************************** 00003380 C 00003390 C WRITE REDUNDANCY/BORROWED MARKER AND AMENDED BIN CENTER COORDINATES 00003400 C 00003410 IF (NTLL .EQ. 0) GO TO 120 00003420 CJT IF (NTLL .EQ. 1 .AND. LASTLN(NDA,1) .EQ. LASTRC) GO TO 120 00003421 C 00003430 DO 110 IWTH = 1, NTLL 00003440 IF(LASTLN(NASSN,IWTH).NE.2) GO TO 110 00003480 DA = LASTLN(NDA,IWTH) 00003450 MEM = ((DA-1) * 8) + 1 PAGE = MEM/8000 MEM = MEM - (PAGE*8000) PAGE = PAGE + 1 IF(PAGE .NE. NCORE) * CALL SAMEMT(MEMTAB(1), NCORE, PAGE, MEMCHG) MEMTAB(MEM) = 0 MEMTAB(MEM+5) = LASTLN(NHLNNO,IWTH) MEMTAB(MEM+6) = LASTLN(NHMDPX,IWTH) MEMTAB(MEM+7) = LASTLN(NHMDPY,IWTH) MEMCHG = 1 SAVCHG = 1 C CJT CALL FOGMRD(TRCHDR, DA, *260 ) 00003460 CPC CALL USSTHV (TRCHDR, 'THSYR7 ', LASTLN(NASSN,IWTH)) 00003470 CJT CALL USSTHV (TRCHDR, 'THMDPX ', LASTLN(NHMDPX,IWTH)) 00003490 CJT CALL USSTHV (TRCHDR, 'THMDPY ', LASTLN(NHMDPY,IWTH)) 00003510 CJT CALL USSTHV (TRCHDR, 'THLNNO ', LASTLN(NHLNNO,IWTH)) 00003530 CJT CALL FOGMWD(TRCHDR, DA-1, *270 ) 00003540 110 CONTINUE 00003550 C 00003560 120 CONTINUE 00003570 C 00003580 C WRITE RESULTS TO PAPER 00003590 C 00003600 IF(PRNTSW .NE. 1) GO TO 130 00003610 WRITE(KPPRNT, 9050 ) LINE, BIN, NTRCS 00003620 WRITE(KPPRNT, 9030 ) 00003630 WRITE(KPPRNT, 9040 ) ((LASTLN(K,J),K=2,NMEMB),J=1,NTLL) 00003640 130 CONTINUE 00003650 CPC 00003660 CPC CALL CUMTIM (TIMEND, TIMEX, TIMEY) 00003670 CPC 00003680 CPC 00003790 CPC CALL CUMTIM (TIMEND, TIMEX, TIMEY) 00003800 CPC 00003810 C 00003820 C********************************************************************** 00003830 C * 00003840 C WRITE OUT FINAL FLAGS AND FINISH UP * 00003850 C * 00003860 C********************************************************************** 00003870 C 00003880 160 CONTINUE 00003890 C 00003900 C IF BORROWING WAS PERFORMED, WRITE FINAL TWO LINES' WORTH OF INFO 00003910 C 00003920 C 00003940 C WRITE THISLN CHANGES 00003950 C 00003960 IF (NTTL .EQ. 0) GO TO 180 00003970 CJT IF (NTTL .EQ. 1 .AND. THISLN(NDA,1) .EQ. LASTRC) GO TO 180 00003971 C 00003980 DO 170 IWTH = 1, NTTL 00003990 IF(THISLN(NASSN,IWTH).NE.2) GO TO 170 00004030 DA = THISLN(NDA,IWTH) 00004000 MEM = ((DA-1) * 8) + 1 PAGE = MEM/8000 MEM = MEM - (PAGE*8000) PAGE = PAGE + 1 IF(PAGE .NE. NCORE) * CALL SAMEMT(MEMTAB(1), NCORE, PAGE, MEMCHG) MEMTAB(MEM) = 0 MEMTAB(MEM+5) = THISLN(NHLNNO,IWTH) MEMTAB(MEM+6) = THISLN(NHMDPX,IWTH) MEMTAB(MEM+7) = THISLN(NHMDPY,IWTH) MEMCHG = 1 SAVCHG = 1 C CJT CALL FOGMRD (TRCHDR, DA, *260 ) 00004010 CPC CALL USSTHV (TRCHDR, 'THSYR7 ', THISLN(NASSN,IWTH)) 00004020 CJT CALL USSTHV (TRCHDR, 'THMDPX ', THISLN(NHMDPX,IWTH)) 00004040 CJT CALL USSTHV (TRCHDR, 'THMDPY ', THISLN(NHMDPY,IWTH)) 00004060 CJT CALL USSTHV (TRCHDR, 'THLNNO ', THISLN(NHLNNO,IWTH)) 00004080 CJT CALL FOGMWD (TRCHDR, DA-1, *270 ) 00004090 170 CONTINUE 00004100 C 00004110 180 CONTINUE 00004120 C 00004130 C WRITE NEXTLN CHANGES 00004140 C 00004150 IF (NTNL .EQ. 0) GO TO 200 00004160 CJT IF (NTNL .EQ. 1 .AND. NEXTLN(NDA,1) .EQ. LASTRC) GO TO 200 00004161 C 00004170 DO 190 IWTH = 1, NTNL 00004180 IF(NEXTLN(NASSN,IWTH).NE.2) GO TO 190 00004220 DA = NEXTLN(NDA,IWTH) 00004190 MEM = ((DA-1) * 8) + 1 PAGE = MEM/8000 MEM = MEM - (PAGE*8000) PAGE = PAGE + 1 IF(PAGE .NE. NCORE) * CALL SAMEMT(MEMTAB(1), NCORE, PAGE, MEMCHG) MEMTAB(MEM) = 0 MEMTAB(MEM+5) = NEXTLN(NHLNNO,IWTH) MEMTAB(MEM+6) = NEXTLN(NHMDPX,IWTH) MEMTAB(MEM+7) = NEXTLN(NHMDPY,IWTH) MEMCHG = 1 SAVCHG = 1 C CJT CALL FOGMRD (TRCHDR, DA, *260 ) 00004200 CPC CALL USSTHV (TRCHDR, 'THSYR7 ', NEXTLN(NASSN,IWTH)) 00004210 CJT CALL USSTHV (TRCHDR, 'THMDPX ', NEXTLN(NHMDPX,IWTH)) 00004230 CJT CALL USSTHV (TRCHDR, 'THMDPY ', NEXTLN(NHMDPY,IWTH)) 00004250 CJT CALL USSTHV (TRCHDR, 'THLNNO ', NEXTLN(NHLNNO,IWTH)) 00004270 CJT CALL FOGMWD (TRCHDR, DA-1, *270 ) 00004280 190 CONTINUE 00004290 C 00004300 200 CONTINUE 00004310 205 CONTINUE 00004310 C C C IF THERE WERE CHANGES - THEN FOGM.. FILE NEEDS TO BE C UPDATED IN THE MAINLINE WHILE SAVE TAPE IS BEING PERFORMED C C CPC 00004320 CPC CALL CLOCK (TIMEX, TIMETL) 00004330 CPC WRITE (KPPRNT, 8900) TIMEX, TIMEBL, TIMERL, TIMEAS, TIMEBR, 00004340 CPC * TIMEBG, TIMEMD, TIMEND, TIMETL 00004350 C8900 FORMAT(3X,'TOTAL TIME ',I10,' SABSRT ',I10,' SARELN ',I10, 00004360 CPC * ' SAASGN ',I10,' SABORW ',I10,/3X,' TIMEBG ',I10, 00004370 CPC * ' TIMEMD ',I10,' TIMEND ',I10,' TIMETL ',I10) 00004380 C 00004390 RETURN 00004400 C 00004410 C************************ 00004420 C * 00004430 C ERROR MESSAGE SECTION * 00004440 C * 00004450 C************************ 00004460 C 00004470 C ERROR FROM SORTING SUBROUTINE SABSRT 00004480 C 00004490 210 WRITE(KPPRNT, 9060 ) 00004500 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004510 GO TO 300 00004520 C 00004530 C ERROR FROM RELATIVE LINE DETERMINING SUBROUTINE SARELN 00004540 C 00004550 220 WRITE(KPPRNT, 9080 ) 00004560 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004570 GO TO 300 00004580 C 00004590 C ERROR FROM TRACE ASSIGNMENT SUBROUTINE SAASGN 00004600 C 00004610 230 WRITE(KPPRNT, 9090 ) 00004620 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004630 GO TO 300 00004640 C 00004650 C ERROR FROM TRACE REASSIGNMENT SUBROUTINE SABORW 00004660 C 00004670 240 WRITE(KPPRNT, 9100 ) 00004680 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004690 GO TO 300 00004700 C 00004710 C ERROR FROM UTILITY SUBROUTINE FOGMRD (FIRST ONE) 00004720 C 00004730 C 250 WRITE(KPPRNT, 9110 ) 00004740 C WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004750 C GO TO 300 00004760 C 00004770 C ERROR FROM UTILITY SUBROUTINE FOGMRD (SECOND ONE) 00004780 C 00004790 C 260 WRITE(KPPRNT, 9120 ) 00004800 C WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004810 C GO TO 300 00004820 C 00004830 C ERROR FROM UTILITY SUBROUTINE FOGMWD 00004840 C 00004850 C 270 WRITE(KPPRNT, 9130 ) 00004860 C WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, DA, INDEX 00004870 C GO TO 300 00004880 C 00004890 C CALCULATED AND READ BIN NUMBERS DO NOT AGREE 00004900 C 00004910 280 WRITE(KPPRNT, 9140 ) 00004920 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, 00004930 * BINWRK(NDA,INDEX), INDEX 00004940 WRITE(KPPRNT, 8000) (BINWRK(I,INDEX),I=1,10),DA 00002350 GO TO 300 00004950 C 00004960 C CALCULATED AND READ LINE NUMBERS DO NOT AGREE 00004970 C 00004980 290 WRITE(KPPRNT, 9150 ) 00004990 WRITE(KPPRNT, 9070 ) MNLN, MXLN, LINE, MNDP, MXDP, BIN, 00005000 * BINWRK(NDA,INDEX), INDEX 00005010 C 00005021 300 RETURN1 00005022 C 00005030 C FORMAT STATEMENTS 00005040 C 00005050 9000 FORMAT(//' SAMRKR MAX FOLD GREATER THAN ',I5,' FOR BIN ',I5, 00005090 * ' LINE ',I5) 00005100 C 00005101 9010 FORMAT(' BORROWING IN PROGRESS FOR BIN ',I5) 00005110 C 00005111 9020 FORMAT('0','SAMRKR RESULTS AFTER SAASGN, LINE ',I5, 00005120 * ' BIN ',I5,' TRACES = ',I5) 00005130 C 00005131 9030 FORMAT(' ','THLNNO THCDPN LINENAME RELLIN THORTN ASSIGN', 00005140 * ' THMDPX THMDPY THXDST'/) 00005150 C 00005151 9040 FORMAT(2I7,2X,2A4,3I7,3I10) 00005160 C 00005171 9050 FORMAT('0','SAMRKR LASTLN RESULTS FOR 3D LINE ',I5, 00005180 * ' BIN ',I5,' TRACES = ',I5) 00005190 C 00005191 9060 FORMAT(//' ','SAMRKR : SUBROUTINE SABSRT FAILED'//) 00005200 C 00005201 9070 FORMAT(' ',' MNLN = ',I10,' MXLN = ',I10,' LINE = ',I10, 00005210 * /' ',' MNDP = ',I10,' MXDP = ',I10,' BIN = ',I10, 00005220 * /' ',' DISK ADDRESS AT ABEND: DA = ',I10, 00005230 * /' ',' INDEX = ',I10//) 00005230 C 00005231 9080 FORMAT(//' ','SAMRKR : SUBROUTINE SARELN FAILED'//) 00005240 C 00005241 9090 FORMAT(//' ','SAMRKR : SUBROUTINE SAASGN FAILED'//) 00005250 C 00005251 9100 FORMAT(//' ','SAMRKR : SUBROUTINE SABORW FAILED'//) 00005260 C 00005261 C9110 FORMAT(//' ','SAMRKR : UTILITY SUBROUTINE FOGMRD FAILED'//) 00005270 C 00005271 C9120 FORMAT(//' ','SAMRKR : UTILITY SUBROUTINE FOGMRD FAILED'//) 00005280 C 00005281 C9130 FORMAT(//' ','SAMRKR : UTILITY SUBROUTINE FOGMWD FAILED'//) 00005290 C 00005291 9140 FORMAT(//' ','SAMRKR : CALCULATED AND READ BIN NUMBERS', 00005300 * ' DO NOT AGREE. INVOKE BIN CONTENTS LISTING OPTION.'//) 00005310 C 00005311 9150 FORMAT(//' ','SAMRKR : CALCULATED AND READ LINE NUMBERS', 00005320 * ' DO NOT AGREE. INVOKE BIN CONTENTS LISTING OPTION.'//) 00005330 C 00005311 9160 FORMAT(///' PROCESSING BINS ',I5,' TO ',I5,10X, 00005320 * 'LINES ',I5,' TO ',I5,///) 00005320 C 00005331 END 00005340