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