One may frequently wish to perform the same operation on multiple datasets, or on multiple catalogue entries. For example, we may wish to reset the user words for all entries corresponding to Monte Carlo data. This can be done in a simple way by
The following example shows how this can be done using the novice interface.
Modifying the user words
PARAMETER (MAXFIL=100)
PARAMETER (LKEYFA=10)
CHARACTER*255 CHFILES(MAXFIL),GENAME
DIMENSION KEYS(LKEYFA,MAXFIL)
*
** *** 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)
PARAMETER (LURCOR=200000)
COMMON/FAT/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 /QUEST/IQUEST(100)
DIMENSION IVECT(10)
*
* Initialise FATMEN and Zebra
*
LUNRZ = 1
LUNFZ = 2
CALL FMSTRT(LUNRZ,LUNFZ,'//CERN/OPAL',IRC)
GENAME = '//CERN/OPAL/SIMD/DDST/PASS3/*/*'
LG = LENOCC(GENAME)
*
* Find all entries that match
*
ICONT = 0
IFLAG = 1
10 CONTINUE
CALL FMLFIL(GENAME(1:LG),CHFILES,KEYS,NFOUND,MAXFIL,ICONT,IRC)
*
DO 20 J=1,NFOUND
LF = LENOCC(CHFILES(J))
LBANK = 0
PRINT *,'Processing ',CHFILES(J)(1:LF)
*
* Read entry from catalogue
*
CALL FMGETK(CHFILES(J)(1:LF),LBANK,KEYS(1,J),IRC)
*
* here we could add checks on the bank contents
*
* Store vector IVECT at offset MUSWFA, length 10
*
CALL FMPUTV(LBANK,IVECT,MUSWFA,10,IRC)
*
* and write back to the catalogue
*
CALL FMMOD(CHFILES(J)(1:LF),LBANK,IFLAG,IRC)
*
* drop bank
*
CALL MZDROP(IXSTOR,LBANK,' ')
20 CONTINUE
IF(ICONT.NE.0) GOTO 10
CALL FMEND(IRC)
END
The following example finds all generic-names that match a pattern containing wild cards, and then deletes all entries corresponding to tapes that are mounted robotically. The tape volumes are write-enabled and moved to a TMS pool so that they can be allocated for future use.
Example of processing multiple entries in FORTRAN
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)
*
* IRC = -1 indicates that there are more files found than
* fit in FILES(MAXFIL). Calling FMLFIL again with JCONT^=0 will
* return the next MAXFIL matches
*
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)
IF(IROBOT.NE.1) GOTO 10
*
* Display media information and the full generic-name for this entry
*
CALL FMSHOW(FILES(I)(1:LENF),LBANK,KEYS(1,I),'MG',IRC)
*
* Unlock (write-enable) corresponding tape 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
*
* Move to 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
*
* and remove the entry from the FATMEN catalogue
*
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
*
* any more files?
*
IF(JCONT.NE.0) GOTO 1
*
* Terminate cleanly
*
CALL FMEND(IRC)
END