C********************************************************************** C C SUBROUTINE RADCO C C PURPOSE: C TO CODE RT-11 DEVICE AND FILE NAME IN RADIX-50 FOR I/O. C C USAGE: C CALL RADCO(FN,RADFN,ERR) C C DESCRIPTION OF INPUT PARAMETERS: C FN - DEVICE AND FILE NAME C TYPE: ASCII C DIMENSION: 14 (LOGICAL*1) C C DESCRIPTION OF OUTPUT PARAMETERS: C RADFN - DEVICE AND FILE NAME IN RADIX-50 C TYPE: INTEGER C DIMENSION: 4 C ERR - ERROR INDICATOR C TYPE: LOGICAL*1 C C REMARKS: C NONE C C ERROR MESSAGES: C - FILE NAME SYNTAX ERROR C ERROR IN DEVICE OR FILE NAME. C C SUBROUTINE AND FUNCTION SUBPROGRAMS REQUIRED: C NONE C C METHOD: C SEMICOLON (:) AND DOT(.) ARE REMOVED, DEVICE NAME IS FILLED C UP WITH BLANKS UNTIL 3 CHARACTERS, IDEM WITH FILE NAME UNTIL C 6 CHARACTERS AND EXTENSION UNTIL 3 CHARACTERS. C THIS NEW STRING IS CODED TO RADIX-50 USING SYSLIB SUBROUTINE C IRAD50. C C REFERENCES: C NONE C C DATE/VERSION: C JANUARY 1980 C C AUTHORS: C S.P. LIE AND J.H.C. REIBER C THORAXCENTER, ERASMUS UNIVERSITY ROTTERDAM C C*********************************************************************** C C SUBROUTINE RADCO(FN,RADFN,ERR) C C INTEGER*2 RADFN(4) !DEV AND FILE NAME IN RADIX-50 INTEGER STATE !CURRENT STATE INTEGER CODE !CHARACTER CODE INTEGER L,M,N !HELP COUNTERS LOGICAL*1 FN(14) !DEVICE AND FILE NAME LOGICAL*1 NFN(14) !EXPANDED FILE NAME LOGICAL*1 DVFN(14) !HELP BUFFER LOGICAL*1 ERR !ERROR INDICATOR LOGICAL*1 CHAR !CHARACTER VALUE C C D WRITE(7,300) 300 FORMAT(' IN RADCO'//) 10 FORMAT(' '//' *** ERROR *** FILE NAME SYNTAX ERROR'//) C C DO 1 N=1,14 DVFN(N)= ' ' !INITIALIZE NFN(N) = ' ' 1 CONTINUE DO 2 L=1,4 IF(FN(L).EQ.':')GOTO 3 !LOOK FOR DEVICE NAME 2 CONTINUE L=0 DVFN(1)='S' !IF NO DEVICE NAME, DVFN(2)='Y' !ASSUMED FILE ON SYSTEM DEVICE DVFN(3)='0' !WAS SPACE NFN(1) = 'S' NFN(2)= 'Y' NFN(3) = '0' NFN(4) = ':' N = 4 GOTO 5 3 IF(L.NE.3.AND.L.NE.4)GOTO 12 DO 4 N=1,L-1 DVFN(N)=FN(N) !COPY DEVICE NAME NFN(N) = FN(N) 4 CONTINUE N = N + 1 NFN(N) = FN(N) !COPY : IF(DVFN(3).EQ.' ')GOTO 5 IF(DVFN(3).LT.'0'.OR.DVFN(3).GT.'9')GOTO 12 C C C PARSE FILE NAME C 5 N=N + 1 DO 15 I = L+1,14 NFN(N) = FN(I) N = N + 1 15 CONTINUE ERR=.FALSE. N=3 NN = 4 STATE=1 DO 11 M=1,10 CHAR=FN(M+L) !READ NEXT CHARACTER AND ENCODE CODE=0 IF(CHAR.EQ.' ')CODE=1 IF(CHAR.EQ.'.')CODE=2 IF(CHAR.GE.'0'.AND.CHAR.LE.'9')CODE=3 IF(CHAR.GE.'A'.AND.CHAR.LE.'Z')CODE=3 IF(CODE.EQ.0)GOTO 12 !BRANCH ON ILLEGAL CHARACTER IF(CODE.EQ.1)GOTO 11 !SKIP ON BLANK GOTO(6,7,9)STATE !TEST ON CURRENT STATE 6 IF(CODE.EQ.2)GOTO 12 !BRANCH ON ILLEGAL CHARACTER N=N+1 STATE=2 DVFN(N)=CHAR GOTO 11 7 IF(CODE.NE.2)GOTO 8 !TEST ON PERIOD OR ALFANUM. N=9 !FOUND PERIOD STATE=3 GOTO 11 8 IF(N.GE.9)GOTO 12 !TEST ON 6 CHAR FOR FILE NAME N=N+1 !FOUND ALFANUM DVFN(N)=CHAR GOTO 11 9 IF(CODE.EQ.2)GOTO 12 !BRANCH ON ILLEGAL CHARACTER N=N+1 IF(N.GT.12)GOTO 12 DVFN(N)=CHAR 11 CONTINUE IF(DVFN(4).EQ.' ')GOTO 12 !BRANCH ON NO FILE NAME CALL IRAD50(12,DVFN,RADFN) DO 14 I = 1,14 14 FN(I) = NFN(I) GOTO 13 12 WRITE(7,10) ERR=.TRUE. 13 RETURN END