SUBROUTINE RDLNK(KFILD,KFILDO,NEW,LIST,CCALL,NSTA,ND1) C C FEBRUARY 2000 DREWRY MDL MOS-2000 C MAY 2000 ALLEN CREATED THIS SUBROUTINE FROM PARTS C OF U630, AND ALLOWED THE USER TO C PASS IN A STATION LIST RATHER THAN C READING IT IN FROM AN INPUT FILE. C C PURPOSE C THIS SUBROUTINE WILL TAKE AN INPUT STATION LIST THAT C IS SENT IN THROUGH "LIST", PLACE IT IN CCALL(,1) AND C SEARCH THROUGH THE LINKS IN THE STATION DICTIONARY. C C IF NEW=1 : IF THE STATION IN LIST C MATCHES ANY OF THE LINKS IN THE DICTIONARY, THE ENTRY C IN THE LEFT MOST COLUMN OF THE DICTIONARY WILL BE PUT C INTO CCALL(,1). C THIS OPTION GIVES YOU THE NEWEST CALL LETTERS C IN CCALL(,1). C C IF NEW=0 : IF THE STATION IN LIST MATCHES ANY C OF THE LINKS IN THE DICTIONARY, THE CCALL(,1) REMAINS C UNCHANGED (IT CONTAINS YOUR INPUT LIST), AND ANY C LINKS ARE SAVED IN COLUMNS 2-6 OF CCALL. C THIS OPTION KEEPS YOUR INPUT CALL LETTERS C IN CCALL(,1). C C DATA SET USE C KFILDO - UNIT NUMBER OF DIAGNOSTIC OUTPUT FILE. (OUTPUT) C KFILD - UNIT NUMBER OF STATION DICTIONARY (J=2). (INPUT) C C VARIABLES C C CCALL(ND1,6) = CALL LETTERS OF THE STATIONS IN THE EQUATION FILE. C CDICTMP = VARIABLE USED TO READ STATION IDS FROM THE STATION DICTIONARY. C COLDFL = FLAG READ FROM THE STATION DICTIONARY INDICATING IF THE C CALL LETTERS OF THAT PARTICULAR ROW ARE THE OLDER C VERSIONS OF A DIFFERENT ROW, AND CONSEQUENTLY SHOULD NOT C BE USED. C CTMPNAM = STORES A STATION NAME READ FROM THE STATION DICTIONARY. C DIRNAM = HOLDS THE NAMES OF THE MASTER STATION LIST AND C STATION DICTIONARY. C I = LOOP CONTROL VARIABLE. C IOS = IOSTAT RETURN. C J = LOOP CONTROL VARIABLE. C LINK = STATION LIST THAT YOU WANT TO FIND LINKS FOR. C K = LOOP CONTROL VARIABLE. C KFILD = UNIT NUMBER OF STATION DICTIONARY. C NEW = 0 WHEN THE CALL LETTERS FROM THE INPUT LIST C ARE TO BE OUTPUT/RETAINED. C = 1 WHEN THE NEWEST CALL LETTERS ARE TO BE OUTPUT. C NSTA = NUMBER OF STATIONS READ FROM THE EQUATION FILE. C C NONSYSTEM SUBROUTINES CALLED C IMPLICIT NONE C INTEGER :: KFILD,KFILDO,IFILCNT,ITMPVAR,IOS, 2 I, J, K,IFOUND,NSTA,IOSTAT,NEW,ND1 C CHARACTER*1 :: COLDFL CHARACTER*8 :: CCALL, CDICTMP, LIST CHARACTER*20 :: CTMPNAM C DIMENSION CDICTMP(6) DIMENSION IFOUND(ND1) DIMENSION CCALL(ND1,6), LIST(ND1) C C INITIALIZE THE CCALL ARRAY. SET CCALL(J,1) TO THE C LIST YOU SENT IN IN LIST C DO I=1,ND1 CCALL(I,1)=LIST(I) DO J=2,6 CCALL(I,J)=' ' ENDDO ENDDO C C READ IN THE REMAINING 5 FIELDS OF THE EQUATION FILE STATION C CALL LETTER ARRAY FROM THE DICTIONARY. IFILCNT = 0 DO I = 1,6 CDICTMP(I) = ' ' ENDDO STADIC: DO READ(KFILD, '(A8,1X,A8,1X,A20,42X,A1,1X,A8,1X,A8,1X,A8, 1 1X,A8)', IOSTAT=IOS, END=100) CDICTMP(1), CDICTMP(2), 2 CTMPNAM, COLDFL, CDICTMP(3), CDICTMP(4), CDICTMP(5), 3 CDICTMP(6) C C CHECK THE VALUES READ FROM EACH LINE OF THE STATION DICTIONARY C AGAINST THOSE IN THE STATION LIST UNTIL A MATCH IS FOUND OR THE C STATION LIST IS FINISHED. J = 1 DO IF (J .GT. NSTA) EXIT IF (((CCALL(J,1) .EQ. CDICTMP(1)) .OR. 1 (CCALL(J,1) .EQ. CDICTMP(2)) .OR. 2 (CCALL(J,1) .EQ. CDICTMP(3)) .OR. 3 (CCALL(J,1) .EQ. CDICTMP(4)) .OR. 4 (CCALL(J,1) .EQ. CDICTMP(5)) .OR. 5 (CCALL(J,1) .EQ. CDICTMP(6))) .AND. 6 (COLDFL .NE. 'O')) THEN C C FILLS IN THE FIELDS OF CCALL ACCORDING TO THE ORDER IN C THE STATION DICTIONARY. IF (NEW .EQ. 1) THEN CCALL(J,1) = CDICTMP(1) CCALL(J,2) = CDICTMP(2) CCALL(J,3) = CDICTMP(3) CCALL(J,4) = CDICTMP(4) CCALL(J,5) = CDICTMP(5) CCALL(J,6) = CDICTMP(6) ELSE C FILLS THE REMAINING FIELDS IN CCALL, LEAVING THE C FIRST FIELD ALONE, PRESERVING THE CALL LETTERS WHICH C WERE READ FROM THE EQUATION FILE AND WHICH WILL BE OUTPUT. ITMPVAR = 2 DO K = 1,6 C IF THE STATION ID IS THE SAME AS THE ID IN THE C FIRST COLUMN OF CCALL, IT IS SKIPPED OVER, BECAUSE C THAT ID WILL BE LEFT IN THE FIRST COLUMN. IF (CCALL(J,1) .EQ. CDICTMP(K)) THEN CYCLE ELSE CCALL(J,ITMPVAR) = CDICTMP(K) ITMPVAR = ITMPVAR + 1 ENDIF END DO ENDIF IFILCNT = IFILCNT + 1 EXIT END IF J = J + 1 ENDDO C CHECKS IF ALL OF THE STATIONS HAVE BEEN FOUND IN THE DICTIONARY. IF (IFILCNT .EQ. NSTA) EXIT ENDDO STADIC C 100 RETURN END