Using the routine FMALLO to allocate a tape

The following example is taken from the CERN specific routine FMSMCF. This routine is called from FMOPEN if the option D is specified. It performs the following functions:

1. Checks to see if a copy of the specified dataset already exists in the robot (SMCF)
2. If not, a tape is allocated from the special pool ggFAT1, e.g. WSFAT1.
3. The FMCOPY routine is then invoked to copy the data and update the catalogue.

As soon as the catalogue has been updated, subsequent accesses will by default take the copy in the robot.

                  Using  FMALLO to allocate a tape
                                  

      SUBROUTINE FMSMCF(GENAME,LBANK,IRC)
*
*     Routine to make a copy of the dataset STAGEd in into the robot
*     using FMCOPY option 'S' (STAGE CHANGE)
*
+CDE,FATBANK.
+CDE,FATPARA.
+CDE,TMSDEF.
      CHARACTER*(*) GENAME
      CHARACTER*6   VSN,VID,CHACC
      PARAMETER (LKEYFA=10)
      DIMENSION KEYS(LKEYFA),KEYSR(LKEYFA)
      PARAMETER       (MAXKEY=1000)
      DIMENSION KEYSOU(LKEYFA,MAXKEY),KEYSIN(LKEYFA)
      INTEGER   FMACNT
*
      LGN = LENOCC(GENAME)
*
*     Save old bank address
*
      LOLDFA = LBANK
      LTDSFA = 0
*
*     First, check that a robot copy does not already exist
*
      CALL UCOPY(KEYS,KEYSIN,10)
*
*     Don't compare copy level or location code
*
      KEYSIN(MKCLFA) = -1
      KEYSIN(MKLCFA) = -1
      CALL FMSELK(GENAME(1:LGN),KEYSIN,KEYSOU,NMATCH,MAXKEY,IRC)
      IF(IDEBFA.GE.2)
     +PRINT *,'FMSMCF. found ',nmatch,' matches for media type 2'
      DO 10 I=1,NMATCH
      CALL FMGETK(GENAME(1:LGN),LBANKR,KEYSOU(1,I),IRC)
      CALL UHTOC(IQ(L+KOFUFA+MVIDFA),4,VID,6)
      LVID = LENOCC(VID)
      CALL FMQTMS(VID(1:LVID),LIB,MODEL,DENS,MNTTYP,LABTYP,IC)
      IF(MNTTYP.EQ.'R') THEN
         IF(IDEBFA.GE.0) PRINT *,'FMSMCF. robot copy already exists'
         RETURN
      ENDIF
10    CONTINUE
*
*     Lift new bank for the robot copy
*
      CALL FMLIFT(GENAME(1:LGN),KEYSR,'DISK',' ',IRC)
      CALL FMLINK(GENAME(1:LGN),LBANKR,' ',IRC)
*
*     Blindly copy old bank into new...
*
      CALL UCOPY(IQ(LBANK+KOFUFA+MFQNFA),IQ(LBANKR+KOFUFA+MFQNFA),
     +           NWDSFA)
*
*     and the keys...
*
      CALL UCOPY(KEYS,KEYSR,10)
*
*     Set last access date, date of cataloging and use count
*
      CALL DATIME(IDATE,ITIME)
      CALL FMPKTM(IDATE,ITIME,IPACK,IRC)
      IQ(LBANKR+KOFUFA+MCTTFA) = IPACK
      IQ(LBANKR+KOFUFA+MLATFA) = IPACK
      IQ(LBANKR+KOFUFA+MUSCFA) = 1
*
*     Now, allocate new tape
*
      IC = FMACNT(CHACC)
      CALL FMALLO('3480','38K',' ','SMCF_1',CHACC(5:6)//'_FAT1',
     +LBANKR,' ',VSN,VID,IRC)
      IF(IRC.NE.0) THEN
         IF(IDEBFA.GE.0) PRINT *,'FMSMCF. Cannot allocate robot tape'
         RETURN
         ELSE
         IF(IDEBFA.GE.0) PRINT *,'FMSMCF. allocated ',VSN,' ',VID,
     +                           ' (VSN/VID)'
      ENDIF
*
*     Do the copy
*
      CALL FMCOPY(GENAME,LOLDFA,KEYS,GENAME,LBANKR,KEYSR,'S',IRC)
      IF(IRC.NE.0) PRINT *,'FMSMCF. return code ',IRC,' from FMCOPY'
*
*     Restore bank address
*
      LBANK = LOLDFA
      END