SUBROUTINE PARSE (INPNAM, OUPNAM, DEVR, UICR, EXTR, LAST, KEY) C C R W BARNARD C ALBUQUERQUE, NM C VERSION OF 09-AUG-82 C INTEGER*2 UICR(2) BYTE INPNAM(1), OUPNAM(1), DEV(4), UIC(9), EXT(4), IEXT, INPEND DATA NUL /"0/ C DO 10 K=1,28 10 OUPNAM(K)=NUL !CLEAR OUTPUT ARRAY IF (KEY.GT.0) GO TO 240 !AUXILLARY FILE IEXT=.FALSE. C C CHECK FOR DEVICE DO 20 K= 2,4 KOLON= K !USE ":" TO INDICATE DEVICE GIVEN IF (INPNAM(K).EQ.':') GO TO 40 !DEV: GIVEN 20 CONTINUE CALL R50ASC (3, DEVR, DEV) !NO - BUILD BYTE DEV DEV(4)= ':' DO 30 K=1,4 30 OUPNAM(K)=DEV(K) !USE DEFAULT DEVICE SPEC KOLON= 0 !POSITION IN INPNAM FOR DEFAULT LAST= 4 !POSITION IN OUPNAM FOR DEFAULT GO TO 60 !WORK ON UIC NEXT 40 DO 50 K=1,KOLON !YES - DEV GIVEN 50 OUPNAM(K)= INPNAM(K) !COPY LAST= KOLON !POSITION IN OUTPUT FILE C C SEARCH FOR UIC 60 DO 70 K= 1,9 KI= KOLON+K !OFFSET FOR INPUT FILE IF (INPNAM(KI).EQ.']') GO TO 90 !UIC GIVEN 70 CONTINUE KI= KOLON !NO NEW OFFSET FOR INPUT CALL R50ASC (3, UICR(1), UIC(2)) !BUILD BYTE CALL R50ASC (3, UICR(2), UIC(6)) !UIC FROM UIC(1)= '[' !RAD-50 UIC(5)= ',' UIC(9)= ']' IF (UIC(2).EQ.' ') THEN !IF UIC IS BLANK, KO= LAST !USE PERSON'S DEFAULT GO TO 110 ENDIF DO 80 K=1,9 !USE DEFAULT UIC IN PROGRAM KO= LAST+K !OFFSET FOR OUTPUT OUPNAM(KO)= UIC(K) !COPY FROM DEFAULT IF (UIC(K).EQ.']') GO TO 110 !IN CASE OF SHORT DEFAULT UIC 80 CONTINUE GO TO 110 90 KE= KI !FIND OFFSET OF END OF UIC DO 100 K=1,KE !COPY OVER UIC PROVIDED KI= KOLON+K KO= LAST+K 100 OUPNAM(KO)= INPNAM(KI) !JUST COPY OVER UIC C 110 KOLON= KI !RESET KOLON TO NEW LENGTH LAST= KO !RESET LAST ALSO C C WORK ON FILENAME NOW DO 120 K= 1,15 KI= KOLON+K !NEXT POS IN INPNAM KPOINT= K-1 !COUNT OF LAST ALPHA CHAR IN INPNAM IF (INPNAM(KI).EQ.'.') IEXT=.TRUE. !EXT GIVEN INPEND= INPNAM(KI).EQ.' '.OR.INPNAM(KI).EQ.';' !< 6 CHAR OR VERS IF (INPEND.OR.IEXT) GO TO 130 !FILE NAME < 6 CHAR & NO EXT 120 CONTINUE 130 DO 140 K= 1,KPOINT !USE ACTUAL CHAR COUNT FROM INPNAM KI= KOLON+K KO= LAST+K !LOCATION IN OUPNAM (OFFSET IN INPNAM 140 OUPNAM(KO)= INPNAM(KI) !FOR DEFAULT FILENAME) LAST= KO !TOTAL LENGTH OF OUPNAM W/O EXT C IF (IEXT) GO TO 170 !EXT GIVEN 150 CALL R50ASC (3, EXTR, EXT(2)) !BUILD EXTENSION EXT(1)= '.' DO 160 K= 1,4 !NO EXT - USE DEFAULT KO= LAST+K !OFFSET FOR OUPNAM 160 OUPNAM(KO)= EXT(K) !COPY DEFAULT EXTENSION GO TO 190 !CHECK FOR INPUT FILE C 170 OUPNAM(LAST+1)= INPNAM(KI+1) !COPIES "." KOLON= KI !REDEFINE OFFSET IN INPUT DO 180 K= 2,4 !YES - COPY EXT KI= KOLON+K !OFFSET FOR INPNAM KO= LAST+K !OFFSET FOR OUPNAM IEXT= (INPNAM(KI).LT.'A'.OR.INPNAM(KI).GT.'Z') !LAST CHAR OF EXT 1 .AND. (INPNAM(KI).LT.'0'.OR.INPNAM(KI).GT.'9') IF (IEXT) GO TO 190 !SKIP IF NOT ALPHA OR NUM (IE, END) 180 OUPNAM(KO)= INPNAM(KI) !COPY C 190 IF (KEY.GT.0) GO TO 230 !SKIP EXCEPT FOR INPUT KOLON= KI !NEW OFFSET IN INPNAM (POSS A ";") DO 200 K=1,5 !CHECK FOR VERSION NUMBER KI= KOLON+K-1 !CAN'T BE "+1" BECAUSE OF ABOVE ^ IF (INPNAM(KI).EQ.';') GO TO 210 !USE ";" FOR VERSION 200 CONTINUE GO TO 230 !IF NO VERSION, SKIP OUT C 210 KOLON= KI-1 !FIND OFFSET OF START OF VERSION (;) DO 220 K= 1,5 KI= KOLON+K !NEXT POS IN INPNAM IEXT= INPNAM(KI).LT.'0'.OR.INPNAM(KI).GT.';' !CHECK FOR GOOD VALUE IF (IEXT) GO TO 230 !SKIP OUT FOR NON-NUMBER KO= KO+1 !INCREMENT KO IF VERSION IS PRESENT 220 OUPNAM(KO)= INPNAM(KI) !COPY C 230 KO= KO+1 !LOCATION OF NEXT OUP CHARACTER OUPNAM(KO)= NUL !NULL BYTE TO CLOSE RETURN C 240 DO 250 K= 1,LAST !COPIES OVER AUX FILE 250 OUPNAM(K)= INPNAM(K) !(DEV AND FILENAME) GO TO 150 !GO COPY EXTENSION END