SUBROUTINE RDNEI(KFILDO,KFILNI,IP8,ICALL,CCALL,NAME,NSTA, 1 LOCNEI,DSTNEI,ND1,MAXSTA, 2 ICALLD,CCALLD,ND5,L3264W, 3 ISTOP,IER) C C DECEMBER 2007 GLAHN MDL MOS-2000 C REVISED FROM RDPRS C FEBRUARY 2008 GLAHN MADE 1506, 1507 /D DIAGNOSTIC C JULY 2008 GLAHN CHECKING NOPAR LE MAXSTA AT 114 C DECEMBER 2008 GLAHN REVISED PURPOSE C DECEMBER 2008 GLAHN CHANGED IEND TO K IN DO 147 LOOP; C INSERTED **** BELOW C OCTOBER 2012 ENGLE CHANGED READ STATEMENTS INVOLVING C STATION CALL LETTERS TO READ INTO C CCALLD INSTEAD OF ICALLD. C APRIL 2015 GLAHN MODIFIED COMMENT ABOVE PURPOSE C C**************************** C IT APPEARS THIS ROUTINE, WHICH IS CALLED IN U155 WHEN C KFILNI IS NOT ZERO, IS NO LONGER NEEDED, ALONG WITH THE C SLOT IN U155.CN FILE FOR IT. IF A FILE WERE PROVIDED C THERE, OF THE FORMAT OF THE U179 NEIGHBORS FILE, IT C WOULD BE READ BY RDNEI, BUT THE DATA WOULD GO NOWHERE. C C RATHER, IT IS CALLED IN U155 TO READ BOGUS LIST. C**************************** C C PURPOSE C RDNEI READS THE LIST OF NEIGHBORS FOR EACH STATION C AND KEYS THE LIST READ TO THE LIST USED IN THIS ANALYSIS C RUN. THIS LIST APPLIES TO THE WHOLE U155 RUN (SEE ABOVE). C C DATA SET USE C KFILDO - UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILNI - UNIT NUMBER WHERE PAIRS RESIDE. (INPUT) C IP(8) - UNIT NUMBERS FOR OPTIONAL ASCII OUTPUT C (OUTPUT) C C VARIABLES C KFILDO = UNIT NUMBER OF OUTPUT (PRINT) FILE. (OUTPUT) C KFILNI = UNIT NUMBER WHERE PAIRS RESIDE. WHEN = 0, C THERE IS NO PAIRS LIST. (INPUT) C IP8 = THE STATIONS AND THEIR NEIGHBORS AS READ ARE C WRITTEN TO IP8 IF NOT ZERO. (OUTPUT) C ICALL(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,NSTA). C NOTE THAT THIS REQUIRES TWO 32-BIT C WORDS TO HOLD THE DESCRIPTION BUT ONLY ONE C 64-BIT WORD. EQUIVALENCED TO CCALL( ). C CCALL(K) = 8-CHARACTER STATION CALL LETTERS (K=1,NSTA). C NOTE THAT THE SUBSTITUTE STATIONS IN CCALL( , ) C IN THE CALLING PROGRAM ARE NOT USED. C (CHARACTER*8) (INPUT) C NAME(K) = NAMES OF STATIONS (K=1,NSTA). (CHARACTER*20) C (INPUT) C NSTA = THE NUMBER OF STATIONS BEING DEALT WITH. THE C NUMBER OF VALUES IN CCALL( , ), ETC. (INPUT) C LOCNEI(K,J) = FOR EACH STATION READ INTO CCALLD(K) (K=1,LSTA) C THE LOCATONS IN THAT CCALLD LIST WHERE THE C NEIGHBORS EXIST (J=1,NOPAR). C (OUTPUT) C DSTNEI(K,J) = DISTANCES OF BASE STATION TO THE NEIGHBOR C STATIONS (J=1,NOPAR) (K=1,LSTA) C (OUTPUT) C ND1 = MAXIMUM NUMBER OF STATIONS THAT CAN BE DEALT C WITH. 1ST DIMENSION LOCNEI( , ), NOPAR( , ), C DIMENSION OF CCALL( ), AND SECOND DIMENSION C OF ICALL( , ). (INPUT) C MAXSTA = THE MAXIMUM NUMBER OF NEIGHBORS A STATION C CAN HAVE. 2ND DIMSNSION OF LOCNEI( , ) AND C DSTNEI( , ). (INPUT) C ICALLD(L,K) = 8 STATION CALL LETTERS AS CHARACTERS IN AN C INTEGER VARIABLE (L=1,L3264W) (K=1,LSTA). C NOTE THAT THIS REQUIRES TWO 32-BIT C WORDS TO HOLD THE DESCRIPTION BUT ONLY ONE C 64-BIT WORD. EQUIVALENCED TO CCALLD( ). C (INTERNAL) C CCALLD(K) = 8-CHARACTER STATION CALL LETTERS (K=1,LSTA). C NOTE THAT THE SUBSTITUTE STATIONS ARE NOT USED. C EQUIVALNECED TO ICALLD( , ). (CHARACTER*8) C (INTERNAL) C ND5 = SECOND DIMENSION OF ICALLD( , ) AND DIMENSION C OF CCALLD( ). (INPUT) C (INPUT) C L3264W = NUMBER OF WORDS IN 64 BITS (EITHER 1 OR 2). C (INPUT) C ISTOP = 0 MEANS THE PROGRAM IS RUNNING OK UP TO THIS C POINT. WHENEVER AN ERROR OCCURS THAT SHOULD C HALT THE PROGRAM AFTER INPUT DIAGNOSTICS ARE C PRINTED, ISTOP IS SET = ISTOP+1. (INPUT-OUTPUT) C IER = STATUS RETURN. C 0 = GOOD RETURN. C 777 = FATAL ERROR. C (OUTPUT) C LSTA = THE NUMBER OF STATIONS WITH NEIGHBORS READ IN. C (INTERNAL) C NOPAR = NUMBER OF NEIGHBORS FOR THE STATION BEING READ. C (INTERNAL) C 1 2 3 4 5 6 7 X C C NONSYSTEM SUBROUTINES USED C NONE C CHARACTER*4 STATE CHARACTER*8 CCALL(ND1) CHARACTER*8 CCALLD(ND5) CHARACTER*20 NAME(ND1) C DIMENSION ICALL(L3264W,ND1) DIMENSION LOCNEI(ND1,MAXSTA),DSTNEI(ND1,MAXSTA) DIMENSION ICALLD(L3264W,ND5) DIMENSION IALOC(ND1),LOCTMP(ND1,MAXSTA),DSTTMP(ND1,MAXSTA) C IALOC( ), LOCTMP( , ) AND DSTTMP( , ) ARE AUTOMATIC ARRAYS. C C READ THE FIRST RECORD. THIS IS THE NUMBER OF STATIONS C THAT HAVE NEIGHBORS. C IER=0 C IF(KFILNI.EQ.0)THEN C C THERE IS NO NEIGHBORS LIST. C GO TO 180 ENDIF C IF(IP8.NE.0)THEN WRITE(IP8,103) 103 FORMAT(/,' **********OUTPUT FROM RDNEI**********') ENDIF C C INIITILIZE LOCNEI( , ) AND DSTNEI( , ). C DO 105 J=1,MAXSTA DO 104 K=1,ND1 LOCNEI(K,J)=999999 DSTNEI(K,J)=9999. 104 CONTINUE 105 CONTINUE C DO 106 K=1,NSTA IALOC(K)=999999 106 CONTINUE C STATE=' 108' READ(KFILNI,IOSTAT=IOS,ERR=900,END=900)LSTA C DIAGNOSTIC FOR LSTA AND MAXSTA READ IS PRINTED IN U155. C C MAKE SURE THERE IS ROOM IN ARRAYS FOR LSTA STATIONS. C IF(LSTA.GT.ND1)THEN WRITE(KFILDO,110)LSTA,ND1 110 FORMAT(/,' ****NUMBER OF STATIONS =',I6,' FOR WHICH', 1 ' NEIGHBORS ARE TO BE READ EXCEEDS ND1 =',I6, 2 '. FATAL ERROR IN RDNEI.') ISTOP=ISTOP+1 IER=777 GO TO 180 ENDIF C C READ LSTA RECORDS IN PAIRS. THE FIRST OF THE PAIR HOLDS C CALL LETTERS OF THE STATION THAT HAS NEIGHBORS [CCALLD( )] C AND THE NUMBER OF NEIGHBORS FOR THAT STATION [NOPAR( )]. C C THE SECOND OF THE PAIR HOLDS (1) THE LOCATION OF EACH STATION C OF THE PAIR IN THE CCALLD( ) LIST AND (2) THE HORIZONTAL C DISTANCE DSTNEI( ) FROM THE STATION IN CCALLD( ) TO ITS PAIR. C DSTNEI( ) IS IN GRID UNITS. NOTE THAT U179 WHICH CREATED C THE LIST READ HAS TO BE RUN WITH THE SAME GRID SPACING AS C U155. C DO 120 L=1,LSTA STATE=' 111' CINTEL C READ(KFILNI,IOSTAT=IOS,ERR=900,END=900) C 1 (ICALLD(J,L),J=1,L3264W),NOPAR READ(KFILNI,IOSTAT=IOS,ERR=900,END=900)CCALLD(L),NOPAR CINTEL C D WRITE(KFILDO,1105)CCALLD(L),NOPAR D1105 FORMAT(/,' AT 1105 IN RDNEI--CCALLD(L),NOPAR', D 1 2X,A8,I8) C IF(CCALLD(L).EQ.'999999 ')THEN WRITE(KFILDO,112)L-1 112 FORMAT(/,' ****TERMINATOR ENCOUNTERED BEFORE LSTA STATIONS', 1 ' READ IN RDNEI. STATIONS READ =',I6, 2 '. COUNT AS FATAL.') ISTOP=ISTOP+1 IER=777 GO TO 180 ENDIF C IF(NOPAR.EQ.9999)THEN C C THIS STATION HAS NO NEIGHBORS LIST. LOCNEI( , ) AND C DSTNEI( , ) HAVE BEEN INITIALIZED, SO NO NEED TO C SET THEM HERE. C WRITE(KFILDO,113)CCALL(L),NAME(L) 113 FORMAT(/,' ****STATION ',A8,2X,A20, 1 ' HAS NO NEIGHBORS LIST. PROCEEDING.') ISTOP=ISTOP+1 C ELSEIF(NOPAR.GT.MAXSTA)THEN WRITE(KFILDO,114)NOPAR,MAXSTA 114 FORMAT(/,' ****NOPAR = ',I5,' IN RDNEI GT MAXSTA = ',I5, 1 '. COUNT AS FATAL.') ISTOP=ISTOP+1 IER=777 GO TO 180 ELSE C C THIS STATION HAS A NEIGHBORS LIST. C STATE=' 114' READ(KFILNI,IOSTAT=IOS,ERR=900,END=900) 1 (LOCNEI(L,J),DSTNEI(L,J),J=1,NOPAR) C NOPAR SHOULD NEVER EXCEED MAXSTA. C D WRITE(KFILDO,1141)(LOCNEI(L,J),DSTNEI(L,J), D 1 J=1,NOPAR) D1141 FORMAT(' LOCNEI( , ) AND DSTNEI( , ) READ', D 1 8(I8,F8.1)) C ENDIF C IF(IP8.NE.0)THEN WRITE(IP8,115)CCALLD(L),(LOCNEI(L,J),DSTNEI(L,J),J=1,NOPAR) 115 FORMAT(' STATION ',A8,' READ, LOCNEI( , ) AND DSTNEI( , ) ARE', 1 8(I8,F8.1)) ENDIF C 120 CONTINUE C C READ THE TERMINATOR. C IF(LSTA+1.LE.ND5)THEN STATE=' 125' CINTEL C READ(KFILNI,IOSTAT=IOS,ERR=900,END=900) C 1 (ICALLD(J,LSTA+1),J=1,L3264W) READ(KFILNI,IOSTAT=IOS,ERR=900,END=900)CCALLD(LSTA+1) CINTEL D WRITE(KFILDO,125)CCALLD(LSTA+1) D125 FORMAT(/' AT 125 IN RDNEI--CCALLD(LSTA+1)',2X,A8) C IF(CCALLD(LSTA+1).NE.'999999 ')THEN WRITE(KFILDO,127)LSTA 127 FORMAT(/,' ****TERMINATOR NOT FOUND AT END OF LSTA =',I6, 1 ' STATIONS IN RDNEI. COUNT AS FATAL.') ISTOP=ISTOP+1 IER=777 GO TO 180 ELSE WRITE(KFILDO,129)LSTA,MAXSTA 129 FORMAT(/,' DATA READ SUCCESSFULLY IN RDNEI FOR LSTA =',I6, 1 ' STATIONS. ARRAYS LOCNEI( ), AND DSTNEI( )', 2 ' EACH HAVE MAXSTA =',I4,' ENTIRES.') ENDIF C ELSE WRITE(KFILDO,130)ND5 130 FORMAT(/,' ****NO ROOM IN ICALLD( , ) TO READ TERMINATOR.', 1 ' COUNT THIS AS A FATAL ERROR. INCREASE ND5 = ', 2 I6,' BY 1') ISTOP=ISTOP+1 IER=777 GO TO 180 ENDIF C C CHANGE THE LINKS IN LOCNEI( ) FROM REFERENCE TO THE LSTA C INPUT LIST TO THE NSTA ANALYSIS LIST. ALSO ORDER C LOCNEI( , ) AND DSTNEI( , ) ACCORDING TO THE NSTA LIST C RATHER THAN THE LSTA LIST. C ISTART=1 IEND=NSTA C DO 150 L=1,LSTA C 140 DO 147 K=ISTART,IEND C IF(CCALLD(L).EQ.CCALL(K))THEN IALOC(K)=L C IF(ISTART.GT.1)THEN ISTART=K C ISTART = K RATHER THAN K + 1 TO CIRCUMVENT C END OF ARRAY PROBLEMS. IEND=NSTA GO TO 150 ENDIF C ENDIF C 147 CONTINUE C IF(ISTART.GT.1)THEN IEND=ISTART ISTART=1 GO TO 140 ENDIF C 150 CONTINUE C C THE NEIGHBORS LIST IN CCALLD( ) MAY NOT HAVE A MATCH FOR C THE SPECIFIC SET OF STATIONS IN CCALL( ). THAT IS OK. C C TRANSFER DATA FROM INCOMING ARRAYS TO TEMPERATORY ARRAY. C DO 152 K=1,NSTA DO 151 J=1,MAXSTA C IF(IALOC(K).EQ.999999)THEN WRITE(KFILDO,1505)CCALL(K),NAME(K) 1505 FORMAT(/,' ****STATION ',A8,A20,' HAS NO NEIGHBOR LIST', 1 ' IN RDNEI.') ELSE D IF(LOCNEI(K,J).NE.999999)THEN D WRITE(KFILDO,1506)K,J,IALOC(K), D 1 LOCNEI(IALOC(K),J),DSTNEI(IALOC(K),J), D 2 CCALLD(LOCNEI(K,J)) D1506 FORMAT(' AT 1506 IN RDNEI--K,J,IALOC(K),', D 1 'LOCNEI(IALOC(K)),J),DSTNEI(IALOC(K),J),', D 2 'CCALLD(LOCNEI(K,J))',/,4I6,F8.2,2X,A8) D ELSE D WRITE(KFILDO,1507)K,J D1507 FORMAT(' KEY = 999999 AT K,J =',2I4) D ENDIF C LOCTMP(K,J)=LOCNEI(IALOC(K),J) DSTTMP(K,J)=DSTNEI(IALOC(K),J) ENDIF C 151 CONTINUE 152 CONTINUE C C TRANSFER DATA FROM TEMPORARY TO PERMANENT ARRAYS. C DO 155 K=1,NSTA DO 154 J=1,MAXSTA LOCNEI(K,J)=LOCTMP(K,J) DSTNEI(K,J)=DSTTMP(K,J) 154 CONTINUE 155 CONTINUE C D DO 160 L=1,NSTA D WRITE(KFILDO,157)CCALL(K),(LOCNEI(K,J),DSTNEI(K,J),J=1,MAXSTA) D157 FORMAT(/,' STATIONS AND LINKS FOR THE NEIGHBORS.',/, D 1 2X,A8,2X,A20,7(I6,F8.1)) C THIS FORMAT WILL ACCOMMODATE MAXSTA = 7 WITHOUT REPEATING. C THAT SHOULD BE SUFFICIENT. D160 CONTINUE C 180 RETURN C C ERROR STOP BELOW IS FOR ERRORS OF CONTROL INFORMATION INPUT. C 900 CALL IERX(KFILDO,KFILDO,IOS,'RDNEI',STATE) WRITE(KFILDO,901) 901 FORMAT(/,' ****FATAL SYSTEM ROUTINE ERROR IN RDNEI.') ISTOP=ISTOP+1 IER=777 GO TO 180 END