The following example shows how individual records of a FORTRAN direct-access file may be accessed remotely.
Example of remote access of records in direct-access file
common/pawc/paw(50000) parameter (lrecl=4096) dimension buff(lrecl) * * Initialise ZEBRA the easy way (get HBOOK to do it for us...) * call hlimit(50000) * * Open the file /fatmen/fmopal/cern.fatrz on node fatcat * The record length is 4096 bytes * call xzopen(80,'/fatmen/fmopal/cern.fatrz','fatcat', + lrecl,'D',irc) open(81,file='opal.fatrz',access='direct',recl=lrecl) nrec = 0 * * Now read each record in turn. Error is assumed to be end of file * 10 continue nrec = nrec + 1 call xzread(80,buff,nrec,lrecl,ngot,' ',irc) if(irc.eq.0) then write(81,rec=nrec) buff goto 10 endif * * Terminate * call xzclos(80,' ',irc) close (81) end
The following program demonstrates file transfer using the FORTRAN callable routines. This program is used to transfer updates to the FATMEN catalogue, which are distributed as ZEBRA FZ files in ASCII exchange format, between CERNVM and the FATMEN server. It performs the following functions:
Example of file transfer using FORTRAN callable routines
PROGRAM FATCAT *CMZ : 21/02/91 16.24.17 by Jamie Shiers *-- Author : Jamie Shiers 21/02/91 * Program to move updates between CERNVM and FATCAT * PARAMETER (NMAX=100) CHARACTER*64 FILES(NMAX) CHARACTER*8 FATUSR,FATNOD,REMUSR,REMNOD CHARACTER*64 REMOTE CHARACTER*12 CHTIME CHARACTER*8 CHUSER,CHPASS CHARACTER*80 CHMAIL,LINE COMMON/PAWC/PAW(50000) PARAMETER (IPRINT=6) PARAMETER (IDEBUG=3) PARAMETER (LUNI=1) PARAMETER (LUNO=2) COMMON /QUEST/ IQUEST(100) COMMON/SLATE/IS(6),IDUMM(34) * * Initialise ZEBRA * CALL HLIMIT(50000) * * Initialise XZ * CALL XZINIT(IPRINT,IDEBUG,LUNI,LUNO) * * Open connection to FATCAT... * CALL CZOPEN('zserv','FATCAT',IRC) 1 CALL VMCMS('EXEC FATSERV',IRC) IF(IRC.EQ.3) GOTO 2 IF(IRC.NE.0) THEN PRINT *,'FATCAT. error ',IRC,' from FATSERV. Stopping...' GOTO 99 ENDIF * * Get the user and node name for this file... * CALL VMCMS('GLOBALV SELECT *EXEC STACK FATADDR',IC) CALL VMRTRM(LINE,IEND) ISTART = ICFNBL(LINE,1,IEND) CALL FMWORD(FATUSR,0,' ',LINE(ISTART:IEND),IC) LFAT = LENOCC(FATUSR) CALL FMWORD(FATNOD,1,' ',LINE(ISTART:IEND),IC) LNOD = LENOCC(FATNOD) PRINT *,'FATCAT. Update received from ',FATUSR(1:LFAT), ' at ', + FATNOD(1:LNOD) CALL DATIME(ID,IT) WRITE(CHTIME,'(I6.6,I4.4,I2.2)') ID,IT,IS(6) * * Now put this file... * This assumes the FATCAT naming convention: /fatmen/fmgroup, * e.g. /fatmen/fml3 * REMOTE = '/fatmen/'//FATUSR(1:LFAT)// + '/todo/'//FATUSR(1:LFAT)//'_' + //FATNOD(1:LNOD)//'.'//CHTIME LREM = LENOCC(REMOTE) CALL XZPUTA('FATMEN.RDRFILE.A',REMOTE(1:LREM),' ',IC) IF(IC.NE.0) THEN PRINT *,'FATCAT. error ',IC,' sending update from ', + FATUSR,' at ',FATNOD,' to FATCAT' CALL VMCMS('#CP LOGOFF',IC) ENDIF CALL VMCMS('ERASE FATMEN RDRFILE A',IC) * * Are there any files for us to get? * 2 CONTINUE ICONT = 0 NFILES = 0 CALL XZLS('/fatmen/fm*/tovm/*',FILES,NMAX,NFILES,ICONT,' ',IC) IF(ICONT.NE.0) THEN PRINT *,'FATSRV. too many files - excess names ', + 'will be flushed' * 10 CONTINUE CALL CZGETA(CHMAIL,ISTAT) LCH = LENOCC(CHMAIL) IF(CHMAIL(1:1).EQ.'0') THEN * * Nop * ELSEIF(CHMAIL(1:1).EQ.'1') THEN ELSEIF(CHMAIL(1:1).EQ.'2') THEN GOTO 10 ELSEIF(CHMAIL(1:1).EQ.'3') THEN IQUEST(1) = 1 IRC = 1 ELSEIF(CHMAIL(1:1).EQ.'E') THEN IQUEST(1) = -1 IRC = -1 ELSEIF(CHMAIL(1:1).EQ.'V') THEN GOTO 10 ELSE IQUEST(1) = 1 IRC = 1 ENDIF * ENDIF DO 3 I=1,NFILES LF = LENOCC(FILES(I)) CALL CLTOU(FILES(I)) * * Fix for the case when there are no files... * IF((NFILES.EQ.1).AND. + (INDEX(FILES(I)(1:LF),'DOES NOT EXIST').NE.0)) GOTO 1 * * Remote file syntax is /fatmen/fm*/tovm * ISLASH = INDEXB(FILES(I)(1:LF),'/') IF(INDEX(FILES(I)(ISLASH+1:LF),FATNOD(1:LNOD)).NE.0) THEN PRINT *,'FATCAT. skipping update for ',FATNOD(1:LNOD), + '(',FILES(I)(1:LF),')' GOTO 3 ENDIF * * Get the name of the server for whom this update is intended... * ISTART = INDEX(FILES(I)(1:LF),'/FM') + 1 IEND = INDEX(FILES(I)(ISTART:LF),'/') REMUSR = FILES(I)(ISTART:ISTART+IEND-2) LREM = LENOCC(REMUSR) PRINT *,'FATCAT. update found for ',REMUSR(1:LREM), + '(',FILES(I)(1:LF),')' CALL XZGETA('FATMEN.UPDATE.B',FILES(I)(1:LF),' ',IC) IF(IC.NE.0) THEN PRINT *,'FATCAT. error ',IC,' retrieving update' GOTO 99 ENDIF CALL VMCMS('EXEC SENDFILE FATMEN UPDATE B TO ' + //REMUSR(1:LREM),IC) CALL XZRM(FILES(I)(1:LF),IC) IF(IC.NE.0) PRINT *,'FATCAT. error ',IC,' deleting file ', + '(',FILES(I)(1:LF),')' 3 CONTINUE * * Wait for some action... * GOTO 1 99 CALL CZCLOS(ISTAT) END