subroutine PARSE (INP, OUPNAM, DEVR, EXTR, LAST) c c This routine takes a filespec and provides the portions not c supplied by the input. c Subsequent calls to PARSE can be used to generate new filespecs c which differ from the original only in the extension. c c Version 1 20-JAN-82 c Original version, as described in "Sextant", summer, 1983. c c Version 2 17-AUG-83 c Added specification for new default device. c c Version 3 9-MAR-84 c c Converted to FORTRAN-77. c c Written by: R. W. Barnard c BIO/COMP Applications c P. O. Box 5342 c Albuquerque, NM 87185 c byte INP(1), OUPNAM(1), INPNAM(15), EXT(4), IEXT, NUL c external INDEX c data NUL /0/ c if (LAST.ne.0) then !DO AUXILLARY FILE KI= 1 !END-OF-DEV POINTER (DUMMY HERE) KO= 1 !END OF-DEV POINTER (DUMMY HERE) if (LAST.lt.0) then !DO ONLY EXT call COPDEV (DEVR, OUPNAM, KO) !DO BOTH DEV AND EXT - COPY DEFAULT KI= INDEX (INP, ':') !FIND END OF DEV IN INPUT SPEC LAST= -LAST !NEGATE LAST (IT WAS A FLAG) endif c !Copies over aux file from do 150 K= KI, LAST !APPROPRIATE STARTING POINT KPOINT= KO- KI+ K !(EITHER START OF DEVICE OUPNAM(KPOINT)= INP(K) !OR START OF FILENAME) 150 continue LAST= KPOINT !NEW LENGTH OF FILE SPEC go to 80 !Now go do extension endif c IEXT= .false. do 10 K= 1, 14 INPNAM(K)= INP(K) !NEED TO ADD NULL BYTE TO INPNAM 10 continue INPNAM(15)= NUL !FOR INDEX TO STOP THERE. c c Look for device. KOLON= INDEX (INPNAM, ':') !USE : TO INDICATE DEVICE GIVEN if (KOLON.eq.0) then !DEV GIVEN, SO GO COPY IT c !NEED TO USE DEFAULT, SO call COPDEV (DEVR, OUPNAM, KO) !COPY OVER DEVICE LAST= KO !CHARACTER POSITION IN OUPNAM else c do 30 K= 1, KOLON !COPY OVER THE DEVICE WHICH IS OUPNAM(K)= INPNAM(K) !GIVEN 30 continue LAST= KOLON !CHARACTER POSITION IN OUPNAM endif c c Work on filename now. 40 continue do 50 K= 1, 7 KI= KOLON+ K !Input pointer. KPOINT= K-1 !POS OF LAST ALPHA CHAR IN INPNAM if (INPNAM(KI).eq.'.') IEXT= .true. !EXT GIVEN IF (INPNAM(KI).eq.' '.or. IEXT) go to 60 !FILE NAME <6 CHAR & NO EXT 50 continue 60 do 70 K= 1, KPOINT !USE ACTUAL CHAR COUNT FROM INPNAM KI= KOLON+ K !INPUT POINTER KO= LAST+ K !OUTPUT POINTER OUPNAM(KO)= INPNAM(KI) !COPY OVER FILENAME 70 continue LAST= KO !TOTAL LENGTH OF OUPNAM W/O EXT c if (.not.IEXT) then !EXT GIVEN c !NO EXT - USE DEFAULT 80 call R50ASC (3, EXTR, EXT(2)) !BUILD EXT FROM RAD 50 EXT(1)= '.' !SPECIFICATIONS do 90 K= 1, 4 KO= LAST+K !OUTPUT POINTER OUPNAM(KO)= EXT(K) !COPY DEFAULT EXTENSION 90 continue else OUPNAM(LAST+1)= INPNAM(KI+1) !COPIES "." KOLON= KI !REDEFINE OFFSET IN INPUT do 110 K= 2, 4 !COPY OVER EXT WHICH IS GIVEN KI= KOLON+ K !OFFSET FOR INPNAM KO= LAST+ K !OFFSET FOR OUPNAM c Allows for full alphanumeric extensions of 1 - 3 characters. 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') !(OR NUMBER)! if (IEXT) go to 120 !SKIP IF NO ALPHA OR NUM (IE, END) OUPNAM(KO)= INPNAM(KI) !COPY 110 continue endif c 120 KO= KO+ 1 !LOCATION OF NEXT CHAR OUPNAM(KO)= NUL !NULL BYTE TO CLOSE return c end subroutine COPDEV (DEVR, OUPNAM, ICT) c c Copies over default device, and packs short device specs. c byte OUPNAM(1), DEV(4) c call R50ASC (3, DEVR, DEV) !BUILD BYTE SPECIFICATION DEV(4)= ':' !FROM RAD 50 SPEC ICT= 4 !DEFAULT END-OF-DEVICE LENGTH c c Check for 1- or 2-character devices. do 10 K= 2, 4 !STARTING AT THE END, CHECK TO SEE J= 5- K !IF ANY CHARS IN DEVICE ARE BLANK if (DEV(J).eq.' ') then !NO - BRANCH DEV(J)= DEV(J+1) !YES - COPY COLON BACK ONE SPACE ICT= ICT-1 !DECREMENT END-OF-DEVICE COUNTER endif 10 continue c do 20 K= 1, ICT !NO DEV GIVEN OUPNAM(K)= DEV(K) !USE DEFAULT DEVICE SPEC 20 continue return c end