CALL FMALLO (MEDIA,DENS,COMPACT,LIB,POOL,LBANK,CHOPT,VSN*,VID*,IRC*)
This routine allocates a new piece of medium of the type specified. The allocation is performed by calling the Tape Management System (TMS).
Example of using the routine FMALLO
CHARACTER*6 VSN,VID
*
* Allocate a 3480 from the pool XVPROD in the library SMCF_1
*
CALL FMALLO('3480','38K',' ','SMCF_1','XVPROD',LBANK,' ',
+VSN,VID,IRC)
IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMALLO'
CALL FMGVOL (GENAM,LBANK,KEYS,CHLIB,CHPOOL,CHFREE,CHOPT,IRC*)
This routine allocates a tape volume with sufficient space for the current file. The FATMEN bank is automatically updated with the volume information (FATMEN fields MVSNFA, MVIDFA and MFSQFA in the case of successful operation.
CALL FMGVID (IFREE,IMEDIA,CHLIB,CHPOOL,CHFREE,CHVSN,CHVID,IFILE,CHOPT,IRC*)
CALL FMVINF (CHVID,MB,NFILES,CHOPT,IRC*)
CALL FMPOOL (GENAM,LBANK,KEYS,CHPOOL,CHOPT,IRC*)
This routine allows you to transfer tape volumes between named pools in the Tape Management System (TMS). In addition, one can set or delete the TMS text or binary tags associated with the volume.
As an example of its use, one might wish to do the following:
Conversely, when returning the volume to XX_FREE, one would call FMPOOL with options 'UDT' to unlock (write-enable) the volume and to delete the TMS text tag.
Example of using the routine FMPOOL
CHARACTER*6 VSN,VID
CHARACTER*255 GENAM
*
* Create new bank ...
*
GENAM = '//CERN/DELPHI/DSTS/RUN123'
CALL FMBOOK(GENAM,KEYS,LBANK,LSUP,JBIAS,IRC)
*
* Allocate a 3480 from the pool XX_FREE in the library SMCF_1
*
CALL FMALLO('3480','38K',' ','SMCF_1','XX_FREE',LBANK,' ',
+VSN,VID,IRC)
IF(IRC.NE.0) PRINT *,'Return code ',IRC,' from FMALLO'
*
* ... write the data ...
*
* ...
*
* Now move the volume to XX_DSTS, write lock and set the TMS text
* tag to the generic name
*
CALL FMPOOL(GENAM,LBANK,KEYS,'XX_DSTS','LST',IRC)
CALL FMQVOL (GENAM,LBANK,KEYS,LIB*,MODEL*,DENS*,MNTTYP*,LABTYP*,IRC*)
This routine interfaces to the local Tape Management System and returns information on a given volume. Interfaces currently exist to the HEPVM TMS and VMTAPE.
If FATMEN has been installed without the TMS option, then default values will be returned. See the description of the FMEDIA routine for information on setting these default values. To allow this default information to be overridden on a volume by volume basis, FMQVOL calls a user exit FMUVOL which has exactly the same calling sequence. A dummy FMUVOL routine exists in PACKLIB.
Example of using the routine FMQVOL
CHARACTER*6 VID
* Definitions from FATMEN sequence TMSDEF
CHARACTER*6 DENS
CHARACTER*8 LIB
CHARACTER*4 LABTYP
CHARACTER*1 MNTTYP
CHARACTER*8 MODEL
CHARACTER*7 ROBMAN(2)
DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
*
* Obtain characteristics of volume corresponding to generic
* name GENAM
*
CALL FMQVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
IF(IRC.EQ.100) PRINT *,'Volume unknown to TMS'
IF(IC.EQ.0) THEN
ITYPE = 1
IF(MNTTYP.EQ.'M') ITYPE = 2
PRINT *,'Library = ',LIB,' model = ',MODEL//ROBMAN(ITYPE)
+ ,' density = ',DENS,' label type = ',LABTYP
ENDIF
Example of a user coded FMUVOL routine
SUBROUTINE FMUVOL(GENAM,LBANK,KEYS,LIB,MODEL,DENS,MNTTYP,LABTYP,IRC)
CHARACTER*255 GENAM
PARAMETER (LKEYFA=10)
DIMENSION KEYS(LKEYFA)
CHARACTER*6 VID
+CDE,FATTYP.
+CDE,TMSDEF.
CALL FMGETC(LBANK,VID,MVIDFA,6,IRC)
*
* Return codes (HEPVM TMS convention)
* 0 ok
* 8 Syntax error
* 12 Access denied
* 100 Volume does not exist
* 312 Volume unavailable
*
* The following test is CERN specific!!!
*
IF((VID(1:1).EQ.'I').AND.(ICNUM(VID,2,6).EQ.7)) THEN
LIB = 'SMCF_1'
MODEL = 'SMCF'
MNTTYP= 'R'
ENDIF
END
CALL FMQMED (GENAM,*LBANK*,*KEYS*,IMEDIA*,IROBOT*,IRC*)
Example of using the routine FMQMED
PARAMETER (LURCOR=200000)
COMMON/CRZT/IXSTOR,IXDIV,IFENCE(2),LEV,LEVIN,BLVECT(LURCOR)
DIMENSION LQ(999),IQ(999),Q(999)
EQUIVALENCE (IQ(1),Q(1),LQ(9)),(LQ(1),LEV)
*
COMMON /USRLNK/LUSRK1,LUSRBK,LUSRLS
*
COMMON /QUEST/IQUEST(100)
*
* Start of FATMEN sequence FATPARA
*
** *** Data set bank mnemonics
*
* Keys
PARAMETER ( MKSRFA= 1, MKFNFA= 2, MKCLFA=7, MKMTFA=8
1 ,MKLCFA= 9, MKNBFA=10, NKDSFA=10 )
*
** *** Bank offsets
*
PARAMETER ( MFQNFA= 1, MHSNFA= 65, MCPLFA= 67, MMTPFA= 68
1 ,MLOCFA= 69, MHSTFA= 70, MHOSFA= 74
2 ,MVSNFA= 77, MVIDFA= 79, MVIPFA= 81, MDENFA= 82
3 ,MVSQFA= 83, MFSQFA= 84, MSRDFA= 85, MERDFA= 86
4 ,MSBLFA= 87, MEBLFA= 88, MRFMFA= 89, MRLNFA= 90
5 ,MBLNFA= 91, MFLFFA= 92, MFUTFA= 93, MCRTFA= 94
6 ,MCTTFA= 95, MLATFA= 96, MCURFA= 97, MCIDFA= 99
7 ,MCNIFA=101, MCJIFA=103, MFPRFA=105, MSYWFA=106
8 ,MUSWFA=116, MUCMFA=126, NWDSFA=145
9 ,MFSZFA=MSYWFA,MUSCFA=MSYWFA+1)
* End of FATMEN sequence FATPARA
CHARACTER*6 DENS
CHARACTER*8 LIB
CHARACTER*4 LABTYP
CHARACTER*1 MNTTYP
CHARACTER*8 MODEL
CHARACTER*7 ROBMAN(2)
DATA ROBMAN(1)/'-Robot '/,ROBMAN(2)/'-Manual'/
PARAMETER (LKEYFA=10)
PARAMETER (MAXFIL=3000)
DIMENSION KEYS(LKEYFA,MAXFIL)
CHARACTER*255 FILES(MAXFIL)
CHARACTER*8 THRONG
CHARACTER*255 TOPDIR
CHARACTER*26 CHOPT
CHARACTER*8 DSN
*
*
* Initialise ZEBRA
*
CALL MZEBRA(-3)
CALL MZSTOR(IXSTOR,'/CRZT/','Q',IFENCE,LEV,BLVECT(1),BLVECT(1),
+ BLVECT(5000),BLVECT(LURCOR))
CALL MZLOGL(IXSTOR,-3)
*
* *** Define user division and link area like:
*
CALL MZDIV (IXSTOR, IXDIV, 'USERS', 50000, LURCOR, 'L')
CALL MZLINK (IXSTOR, '/USRLNK/', LUSRK1, LUSRLS, LUSRK1)
*
* Units for FATMEN RZ/FZ files
*
LUNRZ = 1
LUNFZ = 2
*
* Initialise FATMEN
*
CALL FMINIT(IXSTOR,LUNRZ,LUNFZ,'//CERN/delphi',IRC)
CALL FMLOGL(1)
*
* Get list of file names
*
JCONT = 0
1 CONTINUE
CALL FMLFIL('//CERN/DELPHI/P01_*/RAWD/NONE/Y90V00/E*/L*/*',
+FILES,KEYS,NFOUND,MAXFIL,JCONT,IRC)
IF(IRC.EQ.-1) THEN
JCONT = 1
ELSE
JCONT = 0
ENDIF
PRINT *,NFOUND,' files found'
DO 10 I=1,NFOUND
LENF = LENOCC(FILES(I))
PRINT *,'Processing ',FILES(I)(1:LENF)
LBANK = 0
CALL FMQMED(FILES(I)(1:LENF),LBANK,KEYS(1,I),IMEDIA,IROBOT,IRC)
*
* Remove this entry if it corresponds to a tape in a (the) robot
*
IF(IROBOT.NE.1) GOTO 10
CALL FMSHOW(FILES(I)(1:LENF),LBANK,KEYS(1,I),'MG',IRC)
GOTO 10
*
* Write enable the freed volume
*
CALL FMULOK(FILES(I)(1:LENF),LBANK,KEYS(1,I),' ',IRC)
IF(IRC.NE.0) THEN
PRINT *,'Return code ',IRC,' from FMULOK for ',
+ FILES(I)(1:LENF)
GOTO 10
ENDIF
*
* and return it to the pool XX_DSTS
*
CALL FMPOOL(FILES(I)(1:LENF),LBANK,KEYS(1,I),
+ 'XX_RAWD',' ',IRC)
IF(IRC.NE.0) THEN
PRINT *,'Return code ',IRC,' from FMPOOL for ',
+ FILES(I)(1:LENF)
GOTO 10
ENDIF
CALL FMRM(FILES(I)(1:LENF),LBANK,KEYS(1,I),IRC)
IF(IRC.NE.0) THEN
PRINT *,'Return code ',IRC,' from FMRM for ',
+ FILES(I)(1:LENF)
GOTO 10
ENDIF
10 CONTINUE
IF(JCONT.NE.0) GOTO 1
*
* Terminate cleanly
*
CALL FMEND(IRC)
END