C******************************************************************************* C* * C* MINBAND * C* * C******************************************************************************* C C THIS PROGRAM FINDS A MINIMUM BANDWIDTH OF A SPARSE MATRIX BY USING C THE CUTHILL-MCKEE ALGORITHM. IT IS PRESENTLY (JULY, 1976) SET UP C USING THE HASHING ROUTINES GETFYL, FIND, SCANTR, AND KASH. THESE C ROUTINES ARE TO ACCESS THE PRESENT U.N.B. FILES OF DIRECTION, C DISTANCE AND AZIMUTH OBSERVATIONS. C C INPUT : C CARD 1 : 3 CODES UNDER FORMAT 3I1 C #1. 1 TO INCLUDE ALL STATIONS ON THE U.N.B. FILES C IN THE BANDWIDTH MINIMIZATION. C 0 IF YOU WISH TO LIST YOUR OWN STATION NUMBERS. C #2. 1 IF YOU WISH TO ADD A FULLY POPULATED PX MATRIX. C 0 IF YOU DON'T. C #3. 1 IF YOU WISH TO CHOSE YOUR OWN STARTING POINT C FOR THE ORDERING. C 0 IF YOU WANT THE PROGRAM TO CHOOSE THE FIRST C POINT OF MINIMUM DEGREE WHICH IT COMES ACROSS C AS THE STARTING POINT. C CARD 2: THE STARTING POINT (IF YOU CHOSE #3 ON CARD 1 TO BE 1) C UNDER FORMAT I9. IF #3 ON CARD 1 WAS 0 THEN THIS CARD C WILL BE EITHER : C 1) THE FIRST CARD IN THE LIST OF STATIONS YOU WISH C TO BE ORDERED (THIS ONLY IF #1 ON CARD 1 IS 0) C UNDER FORMAT I9. C 2) THE FIRST STATION NUMBER FOR THE PX STATIONS YOU C WISH TO ADD UNDER FORMAT I9. THIS WILL ONLY OCCUR C IF #1 ON CARD 1 IS 1 AND #2 ON CARD 1 IS 1. C C EXAMPLE: FIRST CARD - 110 C THE FIRST 1 INDICATES YOU WISH ALL STATIONS ON C FILE TO BE ORDERED. C THE SECOND 1 INDICATES THAT A FULL PX IS TO C BE ADDED. C THE ZERO SAYS THAT YOU WISH AUTOMATIC CHOICE OF C A STARTING POINT. C SECOND CARD WILL CONTAIN THE FIRST STATION C NUMBER IN THE PX MATRIX. C C NOTE : IF YOU LIST YOUR OWN STATION NUMBERS FOR ORDERING, THE C END OF THE LIST MUST BE FLAGGED BY A CARD WITH C -99999999 IN THE FIRST NINE COLUMNS. ALSO, THIS LIST C MUST PRECEDE THE LIST OF PX STATIONS. C FOR ORDERING MORE THAN 2000 POINTS, THE DIMENSIONING C IN THE MAIN PROGRAM MUST BE CHANGED. C C N.B. : THIS PROGRAM CANNOT BE USED TO ORDER MORE THAN 32767 POINTS C BECAUSE OF THE LIMATIONS ON INTEGER*2 COMPUTATIONS. C INTEGER*4 STNVEC(2000),ISNUM(800),NSTN2(30),ISLIST(1200), 1 N1VEC(700),N2VEC(700),PX(100) INTEGER*2 ITABLE(27,2000),DEGREE(2000),USE(2000),ISCAN(30), 1 NEWDEG(2000) DATA DEGREE/2000*0/ DATA USE/2000*0/ C C SET PARAMETERS FOR CALLING SUBROUTINES. C NPX=100 MAXWID=27 C C MAXIMUM NUMBER OF STATIONS. C NSTND=2000 C C DATA SET 'SE.GEODESY.STATIONS.MASTER' (OR EQUIVALENT) C NSTA=800 ISTUN=11 DEFINE FILE 11(800,230,E,M2) C C DATA SET 'SE.GEODESY.DIRECTON' (OR EQUIVALENT) C NDIR=1200 IDIRUN=4 DEFINE FILE 4(1200,442,E,M1) C C DATA SET 'SE.GEODESY.DIST&AZ' (OR EQUIVALENT) C NTERR=700 ITERUN=12 DEFINE FILE 12(700,145,E,M3) C C READ AND ECHO INFORMATION ON FIRST DATA CARD. C READ(5,1000)IALL,IPX,ISTART IF(IALL.EQ.1)PRINT 1020,ISTUN IF(IPX.EQ.1)PRINT 1030 IF(ISTART.EQ.1)READ(5,1010)ISTART IF(ISTART.GT.0)PRINT 1040,ISTART ICALL=0 C C SPECIAL CALL TO GETFYL TO READ ALL STATION NUMBERS INTO 'STNVEC'. C IF(IALL.EQ.1)CALL GETFYL(0,0,NSTA,ISNUM,ISTUN,STNVEC,I6,NSTND) IF(IALL.EQ.1)GO TO 20 C C CODE FOR READING THE LIST OF STATION NUMBERS TO BE ORDERED. C I6=1 5 READ(5,1010)STNVEC(I6) IF(STNVEC(I6).EQ.-99999999)GO TO 10 I6=I6+1 IF(I6.GT.NSTND)GO TO 60 GO TO 5 10 I6=I6-1 ICALL=1 C C VERIFY THAT THE STATION NUMBERS ARE ON FILE. C DO 15 I=1,I6 CALL GETFYL(STNVEC(I),ICALL,NSTA,ISNUM,ISTUN,STNVEC,I6,NSTND) ICALL=-1 15 CONTINUE C C IF THE FLAG IS 1, CALL THE SUBROUTINE TO ADD THE FULL PX MATRIX. C 20 IF(IPX.EQ.1)CALL ADDPX(NSTA,ISNUM,ISTUN,PX,NPX,DEGREE,MAXWID, 1STNVEC,I6,ITABLE,NSTND) JSCAN=0 ICALL=0 25 DO 50 I=1,I6 IOBS=1 NC=0 N1=0 INDIC=0 C C FIND THE STATIONS OBSERVED FROM THE STATION 'STNVEC(I)' BY DIRECTIONS. C 30 CALL FIND(STNVEC(I),NSTN2,NT,NC,ICALL,NSTND,NDIR,INDIC,IDIRUN, 1 STNVEC,I6,ISLIST) IF(NT.EQ.0)GO TO 42 35 DO 40 J=1,NT C C ENTER THE OBSERVATIONS INTO THE ADJACENCY TABLE. C CALL ENTER(STNVEC(I),NSTN2(J),IFAULT,DEGREE,I6,ITABLE,MAXWID, 1 STNVEC) IF(IFAULT.EQ.2.OR.IFAULT.EQ.3)STOP 200 C C IF THE OBSERVATION IS A DIRECTION, THEN CORRELATE THE 'TO' STATIONS. C IF(IOBS.NE.-1.AND.J.GT.1)CALL ENTER(NSTN2(J-1),NSTN2(J), 1 IFAULT,DEGREE,I6,ITABLE,MAXWID,STNVEC) IF(IFAULT.EQ.2.OR.IFAULT.EQ.3)STOP 200 40 CONTINUE 42 IF(IOBS.EQ.-1)GO TO 50 INDIC=INDIC+1 NC=NC-N1 N1=1 IF(NC.EQ.0)GO TO 45 GO TO 30 C C FIND THE STATIONS OBSERVED FROM THE PRESENT STATION 'STNVEC(I)' C BY DISTANCE AND AZIMUTH. C 45 CALL SCANTR(STNVEC(I),NSTN2,NT,JSCAN,NSTND,NTERR,ITERUN,STNVEC, 1 I6,N1VEC,N2VEC) IF(NT.EQ.0)GO TO 50 C C IOBS SET TO SIGNAL A DISTANCE OR AZIMUTH. C IOBS=-1 GO TO 35 50 CONTINUE C C CALL THE SUBROUTINE WHICH ACTUALLY DOES THE ORDERING. C CALL CUTHIL(ISTART,ITABLE,MAXWID,DEGREE,USE,ISCAN,NEWDEG,STNVEC, 1 I6) STOP 60 WRITE(6,1050)NSTND STOP 200 1000 FORMAT(3I1) 1010 FORMAT(I9) 1020 FORMAT(' ALL POINTS ON FILE #:',I3,' BEING ORDERED.') 1030 FORMAT(' FULL PX MATRIX REQUIRED.') 1040 FORMAT(' CHOSEN STARTING POINT= ',I9) 1050 FORMAT(/' MAXIMUM NUMBER OF POINTS :',I6,' EXCEEDED. DIMENSIONS MU 1ST BE CHANGED IN THE MAIN PROGRAM. PROGRAM TERMINATING IN M/PROG.' 2) END FUNCTION IFIND(I,STNVEC,I6) C C FUNCTION IFIND IS USED TO DETERMINE THE SEQUENCE NUMBER OF A STATION C NUMBER IN STNVEC. C C INPUT : I= STATION NUMBER FOR WHICH A SEQUENCE IS REQUIRED. C STNVEC= VECTOR TO BE SEARCHED FOR 'I'. C I6= SIZE OF 'STNVEC'. C C OUTPUT : THE SEQUENCE NUMBER VIA THE FUNCTION ARGUMENT IFIND. C INTEGER STNVEC(I6) C C SEARCH THE VECTOR FOR THE RIGHT NUMBER. C DO 10 J=1,I6 IF(STNVEC(J).EQ.I)GO TO 20 10 CONTINUE GO TO 30 C C SET IFIND EQUAL TO THE SEQUENCE NUMBER. C 20 IFIND=J RETURN C C IF THE SEARCH FAILS, SET IFIND=-1. C 30 IFIND=-1 RETURN END SUBROUTINE CUTHIL(ISTART,ITABLE,MAXWID,DEGREE,USE,ISCAN,NEWDEG, 1 STNVEC,I6) C C SUBROUTINE TO ORDER THE STATIONS BY MEANS OF THE CUTHILL-MCKEE C ALGORITHM. THIS ROUTINE ASSUMES THE EXISTENCE OF AN ADJACENCY C TABLE AS WELL AS A DEGREE TABLE. A STATION VECTOR 'STNVEC' IS ALSO C NEEDED TO CORRELATE REAL STATION NUMBERS WITH THEIR SEQUENCE C NUMBERS. C C INPUT : ISTART= OPTIONAL STARTING POINT. C I6= NUMBER OF POINTS BEING ORDERED. C STNVEC= VECTOR OF ACTUAL STATION NUMBERS DIMENSIONED AT LEAST C I6 IN THE MAIN PROGRAM. C ITABLE= TABLE OF CONNECTIONS WITH OTHER POINTS. C MAXWID= THE WIDTH OF 'ITABLE'. C DEGREE= VECTOR OF THE MAXIMUM DEGREE OF EACH POINT (I.E. THE C MAXIMUM # OF CONNECTIONS IT HAS WITH OTHER POINTS.) C C OUTPUT : USE= VECTOR WHICH WILL CONTAIN THE NEW SEQUENCE NUMBERS OF C THE POINTS. C C LOCAL : ISCAN= VECTOR FOR USE IN DECIDING WHICH POINT IS TO BE C ORDERED NEXT. C NEWDEG= DECREMENTED DEGREE TABLE. C LOGICAL*1 STAR/'X'/,SLASH/'1'/ LOGICAL*1 MATRIX(100,100)/10000*' '/ INTEGER STNVEC(I6) INTEGER*2 ITABLE(MAXWID,I6),DEGREE(I6),USE(I6),ISCAN(MAXWID), 1 NEWDEG(I6) C C NEWDEG IS INITIALIZED TO DEGREE. NEWDEG WILL CONTAIN THE DECREMENTED C DEGREE TABLE. C DO 5 I=1,I6 NEWDEG(I)=DEGREE(I) 5 CONTINUE C C DETERMINE WHETHER THE STARTING POINT OPTION HAS BEEN CHOSEN, AND C IF SO, ASSIGN THE FIRST POINT IT'S SEQUENCE NUMBER. C IF(ISTART.NE.0)I=IFIND(ISTART) IF(ISTART.NE.0)GO TO 30 C C CODE FOR AUTOMATIC CHOICE OF STARTING POINT. C C FIND THE MINIMUM DEGREE. C MINDEG=MAXWID DO 10 I=1,I6 10 IF(DEGREE(I).LT.MINDEG)MINDEG=DEGREE(I) IF(MINDEG.EQ.0)GO TO 200 C C CHOOSE THE STARTING POINT AS THE FIRST POINT OF MINIMUM DEGREE C ENCOUNTERED. C DO 20 I=1,I6 IF(DEGREE(I).EQ.MINDEG)GO TO 30 20 CONTINUE 30 IKOUNT=1 C C ASSIGN THE STARTING POINT THE NEW SEQUENCE NUMBER 1. C USE(I)=IKOUNT C C IFLAG IS THE COUNT OF POINTS ALREADY USED AS BASE POINTS FOR THE C ORDERING. C IFLAG=1 35 IFLAG=IFLAG+1 IF(IFLAG.GT.I6)GO TO 100 C C OBTAIN THE VECTOR OF DEGREES OF POINTS CONNECTED TO THE PRESENT C BASE POINT. C ITO=DEGREE(I) DO 40 J=1,ITO ISCAN(J)=NEWDEG(ITABLE(J,I)) C C IF THE POINT HAS ALREADY BEEN NUMBERED, ASSIGN IT A DEGREE OF 10000. C IF(USE(ITABLE(J,I)).NE.0)ISCAN(J)=10000 40 CONTINUE C C DETERMINE THE CONNECTED POINT OF LOWEST DEGREE AND NUMBER IT NEXT. C 70 INEXT=1 MINDEG=ISCAN(1) DO 75 J=1,ITO IF(ISCAN(J).LT.MINDEG)INEXT=J IF(ISCAN(J).LT.MINDEG)MINDEG=ISCAN(J) 75 CONTINUE C C IF ALL OF THE FREE CONNECTED POINTS TO THE PRESENT BASE POINT HAVE C BEEN ORDERED, BRANCH AROUND THE NUMBERING CODE. C IF(ISCAN(INEXT).EQ.10000)GO TO 80 C C NUMBER THE NEXT POINT. C 79 IKOUNT=IKOUNT+1 USE(ITABLE(INEXT,I))=IKOUNT C C DECREMENT THE NEWDEG TABLE. C LTO=DEGREE(ITABLE(INEXT,I)) DO 77 KK=1,LTO IPLACE=ITABLE(KK,ITABLE(INEXT,I)) NEWDEG(IPLACE)=NEWDEG(IPLACE)-1 77 CONTINUE C C SET THE DEGREE OF THE JUST NUMBERED POINT TO 10000. C ISCAN(INEXT)=10000 GO TO 70 C C DETERMINE THE NEXT BASE POINT. C 80 DO 90 J=1,I6 IF(USE(J).EQ.IFLAG)GO TO 95 90 CONTINUE STOP 200 95 I=J GO TO 35 C C ALL OF THE POINTS HAVE BEEN NUMBERED. DETERMINE THE ROW AND COLUMN C PROFILES AND PRINT THE OUTPUT. C 100 WRITE(6,1000) CSUM=0.0 RSUM=0.0 CSQ=0.0 RSQ=0.0 DO 110 I=1,I6 IDEG=DEGREE(I) IWIDE=0 ITALL=0 DO 105 J=1,IDEG INUM=ITABLE(J,I) IF((USE(INUM)-USE(I)).GT.IWIDE)IWIDE=USE(INUM)-USE(I) 105 IF((USE(I)-USE(INUM)).GT.ITALL)ITALL=USE(I)-USE(INUM) IWIDE=IWIDE+1 ITALL=ITALL+1 RSUM=RSUM+IWIDE CSUM=CSUM+ITALL RSQ=RSQ+IWIDE*IWIDE CSQ=CSQ+ITALL*ITALL 110 WRITE(6,1010)STNVEC(I),I,USE(I),ITALL,IWIDE RAVG=RSUM/I6 CAVG=CSUM/I6 RRMS=SQRT(RSQ/I6) CRMS=SQRT(CSQ/I6) WRITE(6,1030)RAVG,CAVG,RRMS,CRMS C C IF THE NUMBER OF POINTS IS LESS THAN 101, COMPUTE AND PRINT THE C CONNECTIVITY MATRIX. C IF(I6.GT.100)GO TO 130 DO 115 I=1,I6 ITO=DEGREE(I) DO 115 J=1,ITO 115 MATRIX(USE(I),USE(ITABLE(J,I)))=STAR WRITE(6,1040) DO 120 I=1,I6 DO 120 J=1,I6 IF(I.EQ.J)MATRIX(I,J)=SLASH 120 CONTINUE DO 125 I=1,I6 IF(MOD(I,10).EQ.1)PRINT 1050 PRINT 1060,(MATRIX(I,J),J=1,I6) 125 CONTINUE 130 RETURN 200 WRITE(6,1020) STOP 200 1000 FORMAT( /' POINT # OLD SEQUENCE # NEW SEQUENCE # COLUMN P 1ROFILE # ROW PROFILE #') 1010 FORMAT(' ',I9,10X,I4,10X,I4,12X,I4,15X,I4) 1020 FORMAT(' ---DISASTER. POINT WITH NO OBSERVATIONS FROM OR TO ENCOUN 1TERED. PROGRAM TERMINATING.') 1030 FORMAT(//' AVERAGE ROW PROFILE=',F7.2/' AVERAGE COLUMN PROFILE=', 1 F7.2/' RMS ROW PROFILE=',F7.2/' RMS COLUMN PROFILE=',F7.2) 1040 FORMAT(/' CONNECTIVITY MATRIX') 1050 FORMAT(1X) 1060 FORMAT(' ',10(1X,10A1)) END SUBROUTINE ADDPX(NSTAT,ISNUM,ISTUN,PX,NPX,DEGREE,MAXWID,STNVEC, 1 I6,ITABLE,NSTND) C C SUBROUTINE TO ADD A FULL PX MATRIX (THAT IS, EVERY PX POINT WILL C BE CORRELATED TO EVERY OTHER PX POINT). C C INPUT : NSTAT= NUMBER OF STATIONS ON SE.GEODESY.STATIONS.MASTER. C ISNUM= VECTOR OF STATIONS ON SE.GEODESY.STATIONS.MASTER C RETURNED FROM SUBROUTINE GETFYL. C ISTUN= UNIT NUMBER ON WHICH STATIONS ARE LOCATED. C DEGREE= VECTOR OF ACTUAL STATION NUMBERS. C I6= NUMBER OF STATIONS BEING ORDERED. C ITABLE= ARRAY OF CONNECTIONS WITH OTHER POINTS. C MAXWID= WIDTH OF 'ITABLE'. C STNVEC= VECTOR OF ACTUAL STATION NUMBERS (NEEDED TO CALL C OTHER ROUTINES). C NSTND= DECLARED DIMENSION OF 'STNVEC' IN THE CALLING PROGRAM. C C OUTPUT : PX= VECTOR OF PX STATION NUMBERS. C NPX= MAXIMUM EXPECTED NUMBER OF PX STATIONS. C INTEGER*2 ITABLE(MAXWID,I6),DEGREE(I6) INTEGER PX(NPX),STNVEC(I6),ISNUM(NSTAT) KOUNT=0 C C READ THE PX POINTS. C 5 KOUNT=KOUNT+1 IF(KOUNT.GT.NPX) GO TO 40 READ(5,1000,END=10)PX(KOUNT) GO TO 5 10 KOUNT=KOUNT-1 C C ECHO THE PX POINTS. C WRITE(6,1010) WRITE(6,1020)(PX(I),I=1,KOUNT) C C CHECK TO SEE THAT ALL OF THE PX POINTS ARE ON FILE. C DO 15 I=1,KOUNT CALL GETFYL(PX(I),-1,NSTAT,ISNUM,ISTUN,STNVEC,I6,NSTND) 15 CONTINUE C C MAKE AN ENTRY INTO THE ADJACENCY TABLE TO TIE EACH POINT WITH C EVERY OTHER POINT. C DO 30 I=1,KOUNT DO 25 J=2,KOUNT CALL ENTER(PX(1),PX(J),IFAULT,DEGREE,I6,ITABLE,MAXWID,STNVEC) IF(IFAULT.EQ.2.OR.IFAULT.EQ.3)STOP 200 25 CONTINUE IHOLD=PX(1) DO 20 K=2,KOUNT 20 PX(K-1)=PX(K) PX(KOUNT)=IHOLD 30 CONTINUE RETURN 40 WRITE(6,1030)NPX STOP 200 1000 FORMAT(I9) 1010 FORMAT(/' POINTS SELECTED AS PX'/) 1020 FORMAT(6X,I9) 1030 FORMAT(/' MORE THAN',I6,' PX POINTS SPECIFIED. MUST CHANGE NPX IN 1SUBROUTINE ADDPX. PROGRAM TERMINATING.') END C***********************************************************************00002040 C* *00002050 C* F U N C T I O N K A S H *00002060 C* *00002070 C***********************************************************************00002080 C 00002090 C 00002100 FUNCTION KASH(NSTN,N1) 00002110 C 00002120 C FUNCTION 'KASH' DETERMINES THE FIRST HASH ADDRESS FOR THE 00002130 C 'SE.GEODESY.DIRECTON' FILE (OR AN EQUIVALENT FILE). IT IS CALLED 00002140 C FROM SUBROUTINE FIND 00002150 C 00002160 C INPUT: NSTN='FROM STATION NUMBER AT WHICH DIRECTIONS OBSERVED 00002170 C N1 =COUNTER INDICATING WHICH DIRECTION SET IS TO BE 00002180 C FOUND (N1=0 FOR 1 ST SET, N1=1 FOR 2 ND SET ETC) 00002190 C 00002200 C OUTPUT:HASH ADDRESS VIA ARGUMENT KASH 00002210 C 00002220 C 00002230 C SUM DIGITS OF STATION NUMBER, RAISE TO POWER (N1+1) AND ADD TO TEN 00002240 C TIMES STATION NUMBER 00002250 C 00002260 NSUM=0 00002270 N=NSTN 00002280 DO 10 I=1,8 00002290 NSUM=NSUM+MOD(N,10) 00002300 10 N=N/10 00002310 ISTN=NSTN*10+NSUM**(N1+1) 00002320 C 00002330 C ADDRESS=REMAINDER OF ISTN/1197 UNLESS REMAINDER=0 THEN ADDRESS = 120000002340 C 00002350 KASH=MOD(ISTN,1197) 00002360 IF(KASH.EQ.0)KASH=1200 00002370 RETURN 00002380 END 00002390 SUBROUTINE GETFYL(NSTN,ICALL,NSTAT,ISNUM,ISTUN,STNVEC,I6,NSTND) C C THIS SUBROUTINE HAS A DUAL PURPOSE. IF THE OPTION OF USING ALL OF C THE STATIONS ON THE U.N.B. FILE 'SE.GEODESY.STATIONS.MASTER' (OR C EQUIVALENT) IS SPECIFIED, THEN ALL OF THE STATION NUMBERS ON THAT C FILE ARE READ INTO THE 'STNVEC'. THE OTHER PURPOSE OF THE ROUTINE IS C TO CHECK THAT STATION NUMBERS SPECIFIED FOR ORDERING OR PX STATIONS C ARE ON FILE. C C INPUT : NSTN= STATION NUMBER TO BE CHECKED. C ICALL= PARAMETER TO SIGNIFY THE USE OF THE OPTION OF ALL C STATION NUMBERS BEING ORDERED. ALSO USED TO SAVE C DISK I/O. ALL OF THE STATION NUMBERS ARE READ INTO C VECTOR 'ISNUM' ON THE FIRST CALL TO THIS ROUTINE. C NSTAT= NUMBER OF STATIONS ON 'SE.GEODESY.STATIONS.MASTER' C FILE (OR EQUIVALENT). C ISNUM= VECTOR OF ALL STATION NUMBERS ON FILE DIMENSIONED AT C LEAST NSTAT IN M/PROG. C ISTUN= FORTRAN UNIT NUMBER FOR STATIONS DATA SET. C NSTND= DECLARED DIMENSION OF 'STNVEC' IN THE CALLING PROGRAM. C C OUTPUT : STNVEC= VECTOR OF STATION NUMBERS READ FROM FILE 'ISTUN'. C I6= NUMBER OF STATIONS IN STNVEC. C C THIS OUTPUT ONLY OCCURS WHEN THIS ROUTINE IS BEING USED FOR C THE FIRST PURPOSE. C INTEGER ISNUM(NSTAT),STNVEC(NSTND) IF(ICALL.NE.0)GO TO 5 C C IF ICALL IS EQUAL TO ZERO, READ THE TOTAL LIST OF STATION NUMBERS ON C FILE INTO VECTOR 'STNVEC'. C II=0 I6=NSTAT DO 4 I=1,NSTAT II=II+1 IF(II.GT.NSTND)GO TO 30 READ(ISTUN'I,1020)STNVEC(II) IF(STNVEC(II).LE.0)I6=I6-1 4 IF(STNVEC(II).LE.0)II=II-1 5 IF(ICALL.LT.0)GO TO 7 C C IF ICALL IS .GE.0, READ THE STATION NUMBERS FROM THE FILE INTO VECTOR C 'ISNUM'. C DO 6 I=1,NSTAT 6 READ(ISTUN'I,1020)ISNUM(I) C C IF NSTN EQUALS ZERO, IT IS A SIGNAL THAT THE TOTAL AMOUNT OF STATIONS C OPTION WAS USED, SO RETURN TO THE M/PROG WITH THE VECTORS 'STNVEC' C AND 'ISNUM' NOW FULL. C IF(NSTN.EQ.0)RETURN C C IF ICALL IS .LT.0 THEN A CHECK IS BEING MADE TO SEE IF A NUMBER IS C ON FILE. C 7 J=0 MASH=MOD(NSTN,797) 10 IF(MASH.EQ.0)MASH=1 IF(ISNUM(MASH).NE.NSTN)GO TO 15 RETURN 15 MASH=MOD((MASH+NSTN),799) J=J+1 IF(J.LT.200)GO TO 10 IF(J.EQ.200)MASH=800 IF(J.EQ.201)MASH=799 IF(J.EQ.202)GO TO 20 GO TO 10 C C THE STATION NUMBER IS NOT ON FILE. C 20 PRINT 1010,NSTN STOP 200 30 WRITE(6,1030)NSTND STOP 200 1010 FORMAT('0',5X,'** ERROR ** STATION NUMBER ',I9,' IS NOT ON FILE %.') 1020 FORMAT(I9) 1030 FORMAT(/' MAXIMUM NUMBER OF POINTS : ',I6,' EXCEEDED. DIMENSIONS S 1HOULD BE CHANGED IN THE MAIN PROGRAM. TERMINATION IN ''GETFYL''.') END C***********************************************************************00002400 C* *00002410 C* S U B R O U T I N E S C A N T R *00002420 C* *00002430 C***********************************************************************00002440 C 00002450 C 00002460 SUBROUTINE SCANTR(NSTN1,NSTN2,K,ISCAN,NSTND,NTERR,ITERUN,NSTN3,NST % N,N1VEC,N2VEC) C 00002490 C SUBROUTINE 'SCANTR' FINDS THE ADDRESSES OF OBSERVATIONS ON THE 00002500 C 'SE.GEODESY.DIST&AZ' FILE (OR AN EQUIVALENT FILE) AT THE STATION 00002510 C 'NSTN1' -- IF THE 'TO' STATION IS NOT IN THE NETWORK THE ADDRESS 00002520 C OF THE OBSERVATION IS DELETED. 00002530 C 00002550 C INPUT: NSTN1 = 'FROM' STATION FOR WHICH OBSERVATIONS ARE REQUIRED 00002560 C ISCAN = PARAMETER FOR SAVING DISK I/O -- ON THE FIRST CALL 00002570 C TO THE SUBROUTINE THE 'FROM' AND 'TO' STATION 00002580 C NUMBERS ARE READ INTO VECTORS 'N1VEC' AND 'N2VEC' - 00002590 C THE VECTORS ARE THEN SCANNED RATHER THAN THE DISK - 00002600 C A VERY SIGNIFICANT TIME SAVING IS REALIZED USING 00002610 C THIS APPROACH 00002620 C NSTND = DECLARED DIMENSION OF VECTOR 'NSTN3' 00002630 C NTERR = NUMBER OF RECORDS ON THE 'SE.GEODESY.DIST&AZ' FILE 00002640 C NSTN = NUMBER OF STATIONS IN THE NETWORK BEING ADJUSTED 00002650 C NSTN3 = VECTOR OF NETWORK STATION NUMBERS - DIMENSIONED AT 00002660 C LEAST NSTND IN MAIN 00002670 C N1VEC = VECTOR AT LEAST NTERR LONG TO CONTAIN LIST OF 'FROM' 00002680 C STATIONS (SEE ISCAN ABOVE) 00002690 C N2VEC = VECTOR AT LEAST NTERR LONG TO CONTAIN LIST OF 'TO' 00002700 C STATIONS (SEE ISCAN ABOVE) 00002710 C ITERUN= FORTRAN UNIT NUMBER OF 'SE.GEODESY.DIST&AZ' FILE 00002720 C (IT MUST CORRESPOND TO THE DD AND DEFINE FILE) 00002730 C 00002740 C OUTPUT: NSTN2= VECTOR OF LENGTH 30 CONTAINING LIST OF 'TO' STATION 00002750 C NUMBERS (IN NETWORK) OBSERVED FROM 'NSTN1' 00002760 C K = NUMBER OF OBSERVED STATIONS (IN NETWORK) 00002770 C 00002800 C NOTE: THE HASHING ALGORITHM CANNOT BE USED TO FIND ADDRESSES SINCE 00002810 C IT DOES NOT FIND ALL OBSERVATIONS (IE. THERE IS AN ERROR IN 00002820 C THE HASHING ALGORITHM UNDER CERTAIN CIRCUMSTANCES) 00002830 C 00002840 DIMENSION NSTN2(30) DIMENSION NSTN3(NSTND),N1VEC(NTERR),N2VEC(NTERR) 00002850 C 00002860 C ON FIRST CALL TO SUBROUTINE READ 'FROM' AND 'TO' STATION NUMBERS 00002870 C INTO VECTORS N1VEC AND N2VEC 00002880 C 00002890 IF(ISCAN.NE.0)GO TO 20 00002900 ISCAN=ISCAN+1 00002910 DO 10 I=1,NTERR 00002920 10 READ(ITERUN'I,1000)N1VEC(I),N2VEC(I) 00002930 C 00002940 C SCAN VECTOR N1VEC FOR 'NSTN1' - STORE 'TO' STATION NUMBERS IN NSTN2, 00002950 C COUNT NUMBER OF TO STATIONS WITH K AND STORE ADDRESSES IN LOC 00002960 C 00002970 20 K=0 00002980 DO 40 I=1,NTERR 00002990 IF(N1VEC(I).NE.NSTN1)GO TO 40 00003000 K=K+1 00003010 NSTN2(K)=N2VEC(I) 00003020 C 00003040 C SCAN VECTOR OF NETWORK STATION NUMBERS -- IF TO STATION IS NOT IN 00003050 C NETWORK DELETE REFERENCE TO IT 00003060 C 00003070 DO 30 J=1,NSTN 00003080 IF(NSTN2(K).EQ.NSTN3(J))GO TO 40 00003090 IF(J.LT.NSTN)GO TO 30 00003100 K=K-1 00003110 30 CONTINUE 00003120 40 CONTINUE 00003130 RETURN 00003140 1000 FORMAT(2I9) 00003150 END 00003160 SUBROUTINE FIND(NSTN,NSTN2,M,N1,ICALL,NSTND,NDIR,INDIC,IDIRUN, % NSTN3,NSTN4,ISLIST) C C SUBROUTINE TO LOCATE A SET OF DIRECTIONS ON THE 'SE.GEODESY.DIRECTON' C FILE (OR EQUIVALENT) KNOWING THE FROM STATION NUMBER AND THE SET C COUNTER (N1). THE ROUTINE CHECKS THE LIST OF 'TO' STATIONS AGAINST C THE STATIONS IN THE NETWORK AND ELIMINATES ANY OBSERVATIONS TO C STATIONS NOT IN THE NETWORK. C C INPUT : NSTN= 'FROM' STATION NUMBER. C N1= SET COUNTER. FOR FIRST SET N1=0, FOR SECOND SET N1=1, ETC. C ICALL= PARAMETER FOR SAVING DISK I/O. ON THE FIRST CALL TO C 'FIND', A COPY OF THE 'FROM' STATION NUMBERS IS READ C INTO VECTOR 'ISLIST' TO SAVE DISK READS. C NSTND= DECLARED DIMENSION OF VECTOR NSTN3 (THE LIST OF C STATIONS IN THE NETWORK). C NDIR= NUMBER OF RECORDS ON THE DIRECTION FILE. C NSTN4= NUMBER OF STATIONS IN THE NETWORK. C INDIC= PARAMETER FOR CHECKING HASHING ALGORITHM. C NSTN3= LIST OF NETWORK STATION NUMBERS. C ISLIST= VECTOR DIMENSIONED 'NDIR' FOR LIST OF STATION NUMBERS. C IDIRUN= FORTRAN UNIT NUMBER FOR DIRECTION DATA SET (MUST C CORRESPOND TO DD AND DEFINE FILE STATEMENTS.) C C OUTPUT : NSTN2= VECTOR OF LENGTH 30 CONTAINING THE 'TO' STATION C NUMBERS. C M= NUMBER OF DIRECTIONS OBSERVED TO NETWORK STATIONS. C DIMENSION NSTN3(NSTND),NSTN2(30),MASHC(10),ISLIST(NDIR) IF(ICALL.NE.0)GO TO 6 C C ON FIRST CALL TO SUBROUTINE, READ THE STATION NUMBERS ON THE FILE C INTO ISLIST. C DO 3 I=1,NDIR 3 READ(IDIRUN'I,1010)ISLIST(I) ICALL=1 6 J=0 C C PERFORM HASH UP TO 200 TIMES. FIRST ADDRESS FOUND BY FUNCTION 'KASH'. C MASH=KASH(NSTN,N1) 10 IF(ISLIST(MASH).EQ.NSTN)GO TO 30 J=J+1 IF(J.GT.200)GO TO 120 20 MASH=MOD((NSTN+MASH),1193) IF(MASH.EQ.0)MASH=1200 GO TO 10 30 READ(IDIRUN'MASH,1000)N,NC,NT,(NSTN2(I),I=1,NT) C C CHECK HASHING ALGORITHM FOR ERRORS. IF IT HAS ERRED, RETURN TO C HASHING ALGORITHM TO CONTINUE. C IF(INDIC.NE.0)GO TO 40 MASHC(1)=MASH GO TO 60 40 DO 50 K=1,INDIC IF(MASHC(K).EQ.MASH)GO TO 20 50 CONTINUE MASHC(INDIC+1)=MASH C C DETERMINE NUMBER OF SETS FROM THIS STATION. C 60 IF(N1.EQ.0)N1=NC C C CHECK TO SEE IF ALL 'TO' STATIONS ARE IN THE NETWORK. IF THEY ARE C NOT, ELIMINATE THEM. C M=NT DO 90 K=1,NT IF(K.GT.M)GO TO 100 65 DO 80 J=1,NSTN4 IF(NSTN2(K).EQ.NSTN3(J))GO TO 90 IF(J.LT.NSTN4)GO TO 80 M=M-1 IF(M.EQ.0)RETURN DO 70 L=K,M 70 NSTN2(L)=NSTN2(L+1) 80 CONTINUE IF(M.GE.K)GO TO 65 90 CONTINUE 100 RETURN C C NO OBSERVATIONS IN THIS SET. SET M=0. C 120 WRITE(6,1020)NSTN M=0 RETURN 1000 FORMAT(I9,2I2,9X,15(I9,19X)) 1010 FORMAT(I9) 1020 FORMAT( /' STATION #',I9,' IS INTERSECTED.') END SUBROUTINE ENTER(IJ1,IJ2,IFAULT,DEGREE,I6,ITABLE,MAXWID,STNVEC) C C THIS SUBROUTINE ENTERS ELEMENTS INTO THE ADJACENCY TABLE FOR LATER C USE BY SUBROUTINE CUTHIL. ANY REDUNDANT ENTRIES ARE IGNORED. C IT ALSO BUILDS A DEGREE TABLE FOR USE BY 'CUTHIL'. C C INPUT : IJ1 AND IJ2= TWO CORRELATED STATIONS. C STNVEC= VECTOR OF ACTUAL STATION NUMBERS. C I6= NUMBER OF STATIONS BEING ORDERED. C MAXWID= MAXIMUM EXPECTED NUMBER OF CONNECTIONS FOR ONE POINT. C C OUTPUT: IFAULT= ERROR RETURN, WHICH, IF NOT EQUAL TO 1, MEANS AN C ERROR HAS OCCURRED. C DEGREE= VECTOR OF MAXIMUM NUMBER OF CONNECTIONS FOR EACH C STATION. C ITABLE= ARRAY OF ACTUAL CONNECTIONS TO OTHER STATIONS. C INTEGER*2 DEGREE(I6),ITABLE(MAXWID,I6) INTEGER STNVEC(I6) DATA KOUNT/0/ C C FIND THE SEQUENCE NUMBERS OF THE TWO CORRELATED STATIONS. C J=IFIND(IJ1,STNVEC,I6) IF(J.LE.0)GO TO 30 I=IFIND(IJ2,STNVEC,I6) IF(I.LE.0)GO TO 40 5 KOUNT=KOUNT+1 C C FIND THE PRESENT DEGREE OF THE 'J' STATION. IF GREATER THAN THE C LARGEST AVAILABLE SPACE, BRANCH AND PRINT AN APPROPRIATE MESSAGE. C INT=DEGREE(J) IF(INT.EQ.0)GO TO 15 IF(INT.EQ.MAXWID)GO TO 50 C C TEST THE TABLE FOR A REDUNDANT CORRELATION. C DO 10 K=1,INT ITEST=ITABLE(K,J) IF(I.EQ.ITEST)GO TO 20 10 CONTINUE C C MAKE THE ENTRY IN THE TABLE AT POSITION 'J' TO SAY THAT IT IS C CORRELATED TO 'I' AND INCREMENT THE DEGREE TABLE. C 15 ITABLE(INT+1,J)=I DEGREE(J)=DEGREE(J)+1 C C NOW MAKE AN ENTRY FOR POINT 'I'. C 20 K=J J=I I=K C C THIS STATEMENT CONTROLS THE LOOPING SO THAT IT IS ONLY DONE TWICE C FOR EVERY PAIR OF POINTS. C IF(MOD(KOUNT,2).NE.0)GO TO 5 IFAULT=1 RETURN 30 WRITE(6,1000)IJ1 IFAULT=2 RETURN 40 WRITE(6,1000)IJ2 IFAULT=2 RETURN 50 IF(MOD(KOUNT,2).EQ.0)GO TO 55 WRITE(6,1001)MAXWID,IJ1 IFAULT=3 RETURN 55 WRITE(6,1001)MAXWID,IJ2 IFAULT=3 RETURN 1000 FORMAT(' ','STATION # :',I9,' NOT IN ADJUSTMENT.') 1001 FORMAT(/' MORE THAN',I4,' CONNECTIONS TO STATION # :',I9,'. PROGRA 1M TERMINATING IN ''ENTER''.') END