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