*
* $Id: fmqvol.F,v 1.1.1.1 1996/03/07 15:18:15 mclareni Exp $
*
* $Log: fmqvol.F,v $
* Revision 1.1.1.1 1996/03/07 15:18:15 mclareni
* Fatmen
*
*
#include "fatmen/pilot.h"
SUBROUTINE FMQVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,
+ IRC)
*
* Routine to interface to the TMS. Check if:
* 1) Volume is available (F)
* 2) Volume is in manual/robot library
* 3) Volume is readable/writable by current account
*
* Return codes: 0 ok
* 8 Syntax error
* 12 Access denied
* 100 Volume does not exist
* 312 Volume unavailable on current system
* 315 Volume unavailable on any system
*
#include "fatmen/faust.inc"
CHARACTER*(*) GENAM
PARAMETER (LKEYFA=10)
DIMENSION KEYS(LKEYFA)
#include "fatmen/fatbank.inc"
#include "fatmen/fatpara.inc"
CHARACTER*15 VID,XVID
CHARACTER*8 VIP
#include "fatmen/fattyp.inc"
#include "fatmen/tmsrep.inc"
CHARACTER*132 LINE,CHLINE
#include "fatmen/tmsdef0.inc"
#include "fatmen/fatvidp.inc"
#include "fatmen/tmsdef1.inc"
NFQVOL = NFQVOL + 1
LGN = LENOCC(GENAM)
IQUEST(1) = 0
JMEDIA = KEYS(MKMTFA)
#if defined(CERNLIB_TMS)
IF(LBANK.EQ.0) THEN
IF(IDEBFA.GE.0) PRINT *,'FMQVOL. get bank for ',GENAM(1:LGN)
CALL FMGETK(GENAM(1:LGN),LBANK,KEYS,IRC)
IF(IRC.NE.0) THEN
IF(IDEBFA.GE.0)
+ PRINT *,'FMQVOL. Return code ',IRC,' from FMGETK'
IRC = 1
RETURN
ENDIF
ELSE
IF(IDEBFA.GE.0)
+ PRINT *,'FMQVOL. enter for user supplied bank for ',
+ GENAM(1:LGN)
ENDIF
VID = ' '
CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
LVID = LENOCC(VID)
#endif
#if (defined(CERNLIB_PREFIX))&&(defined(CERNLIB_TMS))
*
* Generate eXtended VID - with VID prefix
*
JP = IQ(LBANK+KOFUFA+MVIPFA)
IF(JP.NE.0) THEN
LVIP = LENOCC(PREVID(JP))
VIP = PREVID(JP)(1:LVIP)
XVID = PREVID(JP)(1:LVIP) // '.' // VID(1:LVID)
LXVID = LENOCC(XVID)
ELSE
XVID = VID
LXVID = LVID
LVIP = 0
ENDIF
VID = XVID
LVID = LXVID
#endif
#if !defined(CERNLIB_TMS)
IF(IDEBFA.GE.3) PRINT *,'FMQVOL. TMS option not installed.',
+ ' Default values for LIB/MODEL/DENS/LABTYP/MNTTYP taken'
IRC = 0
IQUEST(1) = -1
LIB = '*Unknown'
MODEL = 'CT1 '
DENS = '38K'
LABTYP = 'SL'
MNTTYP = 'M'
*
* Take values from sequence FATTYP is media type is known
*
IF(JMEDIA.NE.0) THEN
MODEL = CHMGEN(JMEDIA)
DENS = CHMDEN(JMEDIA)
LABTYP = CHMLAB(JMEDIA)
MNTTYP = CHMMNT(JMEDIA)
#endif
#if (defined(CERNLIB_CERN))&&(!defined(CERNLIB_TMS))
*
* The following test is CERN specific!!!
*
IF(JMEDIA.EQ.2.AND.
+ (VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
LIB = '3485_2'
MODEL = 'SMCF'
MNTTYP= 'R'
ENDIF
#endif
#if !defined(CERNLIB_TMS)
ENDIF
#endif
#if (!defined(CERNLIB_TMS))&&(defined(CERNLIB_VMTAPE))&&(defined(CERNLIB_VMTMC))
*
* Check and see if this tape is in the VMTAPE catalogue
*
CALL VMCMS('VMTAPE LIST '//VID(1:LVID)
+ //' (SHORT STACK LIFO',IRC))
IF(IRC.NE.0) THEN
IF(IDEBFA.GE.-3) PRINT *,'FMQVOL. error ',IRC,' from VMTAPE '
+ 'command.'
ELSE
CALL VMRTRM(CHLINE,LLINE)
IF(IDEBFA.GE.0) PRINT *,'FMQVOL. reply from VMTAPE = ',
+ CHLINE(1:LLINE)
ENDIF
#endif
#if !defined(CERNLIB_TMS)
*
* Now call user exit to allow user to override these values
*
CALL FMUVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
RETURN
#endif
#if defined(CERNLIB_TMS)
IRC = 0
*
*VID Library Slot Model Dens R R R R A A csn sstr estr labtyp
* i o e a v l
* n b a c a l
* g o l k i o
* ? t ? e l w
* ? d ? ?
* W M L U U D
*28901 3485_2 00000000 3480 38000 W R R U A A 00000000 00000 00000 SL
10 CONTINUE
*
I = LENREP
*
CALL FMSREQ('TMS ',
#endif
#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
+ 'QVOL '//VID(1:LVID)
#endif
#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_SHIFT))&&(defined(CERNLIB_CERN))
+ //' (GENERIC SHIFT'
#endif
#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
+ 'Q VID '//VID(1:LVID)
#endif
#if defined(CERNLIB_TMS)
+ ,IRC,TMSREP,I)
#endif
#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_TMSTEST))
IF(IRC.EQ.100) THEN
IF(IDEBFA.GE.0) PRINT *,'FMQVOL. volume ',VID,
+ ' unknown to TMS'
#endif
#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_TMSTEST))
IF(IRC.EQ.100) THEN
IF(IDEBFA.GE.0) PRINT *,'FMQVOL. volume ',VID,
+ ' unknown to TMS - defaults assumed'
LIB = '*Unknown'
MODEL = 'CT1 '
IF(JMEDIA.NE.0) MODEL = CHMGEN(JMEDIA)
DENS = '38K'
LABTYP = 'SL'
MNTTYP = 'M'
IF((VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
LIB = 'SMCF'
MNTTYP= 'R'
ENDIF
IRC = 0
#endif
#if defined(CERNLIB_TMS)
RETURN
ELSE
#endif
#if (defined(CERNLIB_TMS))&&(!defined(CERNLIB_QVID))
LIB = TMSREP(1)(8:15)
MODEL = TMSREP(1)(26:33)
DENS = TMSREP(1)(35:40)
LABTYP = TMSREP(1)(75:76)
MNTTYP = TMSREP(1)(44:44)
#endif
#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))
LINE = TMSREP(1)
CALL CSQMBL(LINE ,1,LENOCC(LINE))
CALL FMWORD(LIB ,5,' ',LINE,IRC)
CALL FMWORD(MODEL ,2,' ',LINE,IRC)
CALL FMWORD(DENS ,3,' ',LINE,IRC)
CALL FMWORD(LABTYP,4,' ',LINE,IRC)
MNTTYP = 'M'
IF(LIB(1:2).EQ.'CR') MNTTYP = 'R'
*
* Libraries beginning * are by definition unavailable (apparently)
*
IF(LIB(1:1).EQ.'*') THEN
IRC = 312
RETURN
ENDIF
#endif
#if (defined(CERNLIB_TMS))&&(defined(CERNLIB_QVID))&&(defined(CERNLIB_DESPARATE))
*
* To determine if volume is available, must issue TMS Q LIBRARY...
* e.g.
*
*SYSREQ TMS Q LIBRARY HP_LPOOL
*Library Czar Group R A L S M Target Retain Racks Slots Spare
*-------- -------- -------- - - - - - -------- ------ ------ -------- --------
*HP_LPOOL *None *None N N N N N *None 0 0 10000 9521
*123456789_123456789_123456789_123456789_123456789_123456789_123456789_123456789
*CP Lear Production Data at Liverpool
I = LENREP
*
CALL FMSREQ('TMS ',
+ 'Q LIBRARY '//LIB
+ IRC,TMSREP,I)
IF(I.NE.3) THEN
PRINT *,'FMQVOL. unexpected reply from TMS QUERY LIBRARY'
DO 11 J=1,I
PRINT *,'FMQVOL. ',TMSREP(J)(1:LENOCC(TMSREP(J)))
11 CONTINUE
ELSE
*
* Look for ACTIVE:N
*
IF(TMSREP(3)(30:30).EQ.'N') IRC = 312
ENDIF
#endif
#if defined(CERNLIB_TMS)
IF(INDEX(DENS,'38000').NE.0) DENS = '38K'
ENDIF
*
#endif
END