*
* $Id: fmpstg.F,v 1.1.1.1 1996/03/07 15:18:08 mclareni Exp $
*
* $Log: fmpstg.F,v $
* Revision 1.1.1.1 1996/03/07 15:18:08 mclareni
* Fatmen
*
*
#include "fatmen/pilot.h"
SUBROUTINE FMPSTG(GNAME,NNAMES,NFILES,NTAPES,CHOPT,IRC)
*
* CHOPT: F - stage only first tape
* H - wHole volume staging, as for FMOPEN
* L - override label with DCB information in catalogue
*
CHARACTER*(*) GNAME(NNAMES),CHOPT
CHARACTER*255 GENAM,FSQSTR,CHCOMM
#if defined(CERNLIB_UNIX)
INTEGER SYSTEMF
#endif
CHARACTER*6 VID,VSN,VIDOLD,VSNOLD,FSEQ
CHARACTER*40 DCB,DCBOLD
CHARACTER*4 RECFM,RECFMO,LABOLD
CHARACTER*8 CHOPTX,MODOLD
#include "fatmen/fmnkeys.inc"
DIMENSION KEYS(LKEYFA)
#include "fatmen/fatpara.inc"
#include "fatmen/fatbank.inc"
#include "fatmen/fatopt0.inc"
#include "fatmen/tmsdef.inc"
#include "fatmen/fatopt1.inc"
IRC = 0
NDONE = 0
NFILES = 0
NTAPES = 0
VIDOLD = ' '
RECFMO = ' '
LFLSTR = 0
LMXSTR = LEN(FSQSTR)
IF(IDEBFA.GE.1) WRITE(LPRTFA,9001) NNAMES,CHOPT
9001 FORMAT(' FMPSTG. enter for ',I6,' generic names, CHOPT = ',A)
#if defined(CERNLIB_UNIX)
IF(IOPTL.EQ.0) THEN
IF(IDEBFA.GE.0) WRITE(LPRTFA,9002)
9002 FORMAT(' FMPSTG. option L turned on for Unix systems')
IOPTL = 1
ENDIF
#endif
#if defined(CERNLIB_VAXVMS)
IF(IOPTL.NE.0) THEN
IF(IDEBFA.GE.0) WRITE(LPRTFA,9003)
9003 FORMAT(' FMPSTG. option L not currently supported on VMS systems')
IOPTL = 0
ENDIF
#endif
DO 20 I=1,NNAMES
LGN = LENOCC(GNAME(I))
GENAM = GNAME(I)(1:LGN)
CALL CLTOU(GENAM(1:LGN))
IF(IDEBFA.GE.1) WRITE(LPRTFA,9004) I,GENAM(1:LGN)
9004 FORMAT(' FMPSTG. processing generic name # ',I6,/,
+ ' (',A,')')
LBANK = 0
CALL FMGET(GENAM,LBANK,KEYS,IRC)
IF (IRC.NE.0) GOTO 999
*
* Is this entry a link?
*
IF(KEYS(MKLCFA).EQ.0) THEN
CALL UHTOC(IQ(LBANK+KOFUFA+MFQNFA),4,GENAM,NFQNFA)
NCH = LENOCC(GENAM)
IF(IDEBFA.GE.0) WRITE(LPRTFA,9005) GNAME(I)(1:LGN),
+ GENAM(1:NCH)
9005 FORMAT(' FMPSTG. ',A,' --> ',A)
NCH = LGN
CALL VZERO(KEYS,LKEYFA)
CALL MZDROP(IDIVFA,LBANK,'B')
LBANK = 0
CALL FMGET(GENAM,LBANK,KEYS,IRC)
IF (IRC.NE.0) GOTO 999
ENDIF
*
* Ignore disk files
*
IF(KEYS(MKMTFA).EQ.1) THEN
IF(IDEBFA.GE.2) WRITE(LPRTFA,9006) I
9006 FORMAT(' FMPSTG. generic name # ',I6,' points to a disk file',
+ ' - ignored')
GOTO 10
ENDIF
NFILES = NFILES + 1
CALL UHTOC(IQ(LBANK+KOFUFA+MVIDFA),4,VID,6)
LVID = LENOCC(VID)
CALL CLTOU(VID(1:LVID))
CALL UHTOC(IQ(LBANK+KOFUFA+MVSNFA),4,VSN,6)
LVSN = LENOCC(VSN)
CALL CLTOU(VID(1:LVSN))
CALL FMITOC(IQ(LBANK+KOFUFA+MFSQFA),FSEQ,LFSEQ)
IF(IDEBFA.GE.2) WRITE(LPRTFA,9007) VID(1:LVID),VSN(1:LVSN),
+ FSEQ(1:LFSEQ)
9007 FORMAT(' FMPSTG. processing VID: ',A,' VSN: ',A,' FSEQ: ',A)
*
* Option H - ignore if we have already seen this volume
*
IF(IOPTH.NE.0.AND.VID.NE.VIDOLD.AND.VSN.NE.VSNOLD) GOTO 10
*
* Set IQUEST(11) to media type in case volume unknown or
* TMS option not installed.
*
IQUEST(11) = IQ(LBANK+KOFUFA+MMTPFA)
CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
IF(IDEBFA.GE.3) THEN
PRINT *,'FMPSTG. return from FMQTMS with ', VID,'/',LIB,'/'
+ ,MODEL,'/',DENS,'/',MNTTYP,'/', LABTYP,'/',IC
ENDIF
LLAB = LENOCC(LABTYP)
*
* Get DCB information
*
CALL UHTOC(IQ(LBANK+KOFUFA+MRFMFA),4,RECFM,4)
LRECL = IQ(LBANK+KOFUFA+MRLNFA)*4
LBLOCK = IQ(LBANK+KOFUFA+MBLNFA)*4
#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_SHIFT))
IF(RECFM.EQ.'U') RECFM = 'F'
#endif
*
* Issue stage request is this is the last generic name or if
* we have switched to a new volume
*
IF(I.EQ.NNAMES.OR.
+ (VIDOLD.NE.' '.AND.VID.NE.VIDOLD.AND.VSN.NE.VSNOLD)) THEN
NTAPES = NTAPES + 1
IF(IOPTL.NE.0) THEN
*
* Add DCB information
*
#if !defined(CERNLIB_VAXVMS)
WRITE(DCB,9008) RECFM,LRECL,LBLOCK
#endif
#if defined(CERNLIB_UNIX)
9008 FORMAT(' -F ',A,' -L ',I5,' -b ',I5)
#endif
#if defined(CERNLIB_IBMVM)
9008 FORMAT(' RECFM ',A,' LRECL ',I5,' BLKSIZE ',I5)
#endif
ENDIF
*
* Issue stage request for the previous volume
*
#if defined(CERNLIB_IBMVM)
IF(IOPTH.NE.0) THEN
FSQSTR = '1-E'
LFLSTR = 3
ENDIF
CHCOMM = 'EXEC STAGE IN FT00F001 '//VSNOLD(1:LVSNO)//
+ '.'//FSQSTR(1:LFLSTR)//'.'//LABOLD(1:LLABO)//
+ '.'//VIDOLD(1:LVIDO)//' (NOWAIT)'
LCOMM = LENOCC(CHCOMM)
IF(IDEBFA.GE.0) WRITE(LPRTFA,9011) CHCOMM(1:LCOMM)
CALL VMCMS(CHCOMM(1:LCOMM),IRC)
IF(IRC.NE.0) THEN
IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) CHCOMM(1:LCOMM)
9009 FORMAT(' FMPSTG. return code ',I6,' from VMCMS for ',A)
GOTO 10
ENDIF
#endif
#if defined(CERNLIB_UNIX)
IF(IOPTH.NE.0) THEN
FSQSTR = '1-'
LFLSTR = 2
ENDIF
CHCOMM = 'stagein -G -v '//VSNOLD(1:LVSNO) // ' -q ' //
+ FSQSTR(1:LFLSTR) //' -V '//VIDOLD(1:LVIDO)//
#endif
#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_TMS))
+ ' -l '//LABOLD(1:LLABO) // ' -g '//MODOLD(1:LMODO)//
#endif
#if defined(CERNLIB_UNIX)
+ DCBOLD(1:LDCBO) // ' -w T'//VIDOLD(1:LVIDO)//' &'
LCOMM = LENOCC(CHCOMM)
IF(IDEBFA.GE.0) PRINT 9010,CHCOMM(1:LCOMM)
9010 FORMAT(' FMPSTG. executing ',A)
IRC = SYSTEMF(CHCOMM(1:LCOMM))
IF(IRC.NE.0) THEN
IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) CHCOMM(1:LCOMM)
9009 FORMAT(' FMPSTG. return code ',I6,' from SYSTEMF for ',A)
GOTO 10
ENDIF
#endif
#if defined(CERNLIB_VAXVMS)
IF(IOPTH.EQ.0) THEN
CHOPTX = 'Q'
ELSE
CHOPTX = 'HQ'
ENDIF
*
* call FMOPEN with option Q (assume VAXTAP in server mode)
*
CALL FMOPEN(GENAM(1:LGN),'FMPSTG',LBANK,CHOPTX,IRC)
IF(IRC.NE.0) THEN
IF(IDEBFA.GE.0) WRITE(LPRTFA,9009) GENAM(1:LGN)
9009 FORMAT(' FMPSTG. return code ',I6,' from FMOPEN for ',A)
GOTO 10
ENDIF
#endif
9011 FORMAT(' FMPSTG. executing ',A)
*
* IOPTF: just first volume
*
IF(IOPTF.NE.0) THEN
GOTO 10
ENDIF
NDONE = 0
ENDIF
*
* Build file sequence string
*
IF(IOPTH.EQ.0) THEN
IF(NDONE.EQ.0) THEN
FSQSTR = FSEQ(1:LFSEQ)
LFLSTR = LFSEQ
ELSE
IF(LFLSTR+1+LFSEQ.GT.LMXSTR) THEN
IF(IDEBFA.GE.-3) WRITE(LPRTFA,9012) LMXSTR
9012 FORMAT(' FMPSTG. error - list of files cannot exceed ',I6,
+ ' characters')
IRC = -1
GOTO 10
ENDIF
FSQSTR(LFLSTR+1:) = ','//FSEQ(1:LFSEQ)
LFLSTR = LFLSTR + LFSEQ + 1
ENDIF
ENDIF
VIDOLD = VID(1:LVID)
VSNOLD = VSN(1:LVSN)
RECFMO = RECFM
JRECL = LRECL
JBLOCK = LBLOCK
LABOLD = LABTYP(1:LLAB)
MODOLD = MODEL
#if !defined(CERNLIB_VAXVMS)
DCBOLD = DCB
#endif
LVIDO = LVID
LVSNO = LVSN
LLABO = LLAB
LMODO = LENOCC(MODOLD)
LDCBO = LENOCC(DCBOLD)
10 CONTINUE
CALL MZDROP(IDIVFA,LBANK,'B')
LBANK = 0
20 CONTINUE
999 END