SUBROUTINE TSTDIR ( dev, idev, uic, iuic, exist, mntd ) C+ C SUBROUTINE TSTDIR C C Environment: System Utility DEF C Env. Vsn: 01.00 C C Subroutine/Function Description: C C Trys to open the master directory file for the destination. C If this could not be opened, a MOU command is spawned. C C If the first file opens, close it and try to open the destination C directory file. If not, error message time. Otherwise, good status. C C Parameter List: C Name Type I/O Purpose C -------------------------- ------------- ------ ------------------------ C C Data Structures: C COMMON Blocks: [tbs] C C C Side effects: [tbs] C C C------------------------------------------------------------------------- C Environmental Requirements C C Re-compile Procedure: [tbs] C Compile Command: [tbs] C Library: [tbs] C Modules called: [tbs] C C Test Procedures: C Test Data Files: [tbs] C Test Scripts: [tbs] C Documents: [tbs] C C Module Documentation: C Help File: [tbs] C Document File: [tbs] C C Required Logicals: [tbs] C C Required Files: [tbs] C C C Written By: [tbs] C KMS Fusion, Inc. C P.O. Box 1567 C Ann Arbor, Mich. 48106 C C Ident: [tbs] C Date: [tbs] C C C Change Log: C Date Initials Ident Description C [dd-mmm-yy] [tbs] [tbs] [tbs......] C---------------------------------------------------------------------------- C- C IDENT /xxxxxx/ C CHARACTER*80 dev, + uic CHARACTER*80 filnam CHARACTER*3 grp, usr CHARACTER*5 diruic CHARACTER*4 dirext C LOGICAL exist, + mntd C INTEGER*2 idev, + iuic INTEGER*2 len C DATA len/3/ DATA diruic/'[0,0]'/ DATA dirext/'.DIR'/ C C Executable begins here. C endfil = idev filnam(1:endfil) = dev(1:idev) ! Push in device name. filnam(endfil+1:endfil+5) = diruic(1:5) ! Push in dir uic. endfil = endfil + 5 ! loclft = INDEX ( uic(1:iuic), '[' ) ! locrt = INDEX ( uic(1:iuic), ']' ) ! loccom = INDEX ( uic(1:iuic), ',' ) ! IF ( loccom .GT. 0 ) THEN ! Found a comma. iend = loccom-loclft-1 ! grp(1:iend) = ! + uic(loclft+1:loccom-1) ! CALL INSZER ( grp, iend, ! + len, ids ) ! IF ( ids .GT. 0 ) THEN ! filnam(endfil+1:endfil+len) = ! + grp(1:len) ! endfil = endfil + len ! iend = locrt - loccom - 1 ! usr(1:iend) = ! + uic(loccom+1:locrt-1) ! CALL INSZER ( usr, iend, len, ids ) ! IF ( ids .GT. 0 ) THEN ! filnam(endfil+1:endfil+len) = ! usr(1:len) ! endfil = endfil + len ! filnam(endfil+1:endfil+4) = ! + dirext(1:4) ! END IF ! END IF ! ELSE ! No comma. filnam(endfil+1:endfil+iuic) = ! + uic(1:iuic) ! filnam(endfil+iuic+1:endfil+iuic+4) = ! + dirext(1:4) ! endfil = endfil + iuic + 4 ! ids = 1 END IF ! IF ( ids .GT. 0 ) THEN ! No errors so far... OPEN ( UNIT = tstlun, ! + FILE = filnam(1:lenfil), ! + STATUS = 'old', ! + FORM = 'UNFORMATTED', ! + RECORDTYPE = 'fixed', ! + RECL = 4, ! + READONLY, SHARED, ! + ERR = 9900 ) ! END IF ! 9000 CONTINUE CLOSE ( UNIT = tstlun ) RETURN 9900 CONTINUE CALL ERRSNS ( errnum, prim, sec, iunit )! Get error value. IF ( prim .EQ. -16 ) THEN ! Privilege violation. ids = -2 ! Must mount device. ELSE ! ids = -1 ! END