*
* $Id: xzputa.F,v 1.1.1.1 1996/03/08 15:44:31 mclareni Exp $
*
* $Log: xzputa.F,v $
* Revision 1.1.1.1 1996/03/08 15:44:31 mclareni
* Cspack
*
*
#include "cspack/pilot.h"
SUBROUTINE XZPUTA(LOCAL,REMOTE,CHOPT,IRC)
*
* Transfer the text file LOCAL to the remote node as REMOTE
* CHOPT: V - remote file is created with V format (IBM)
* S - statistics on the file transfer are printed
* A - local file has already been opened
*
#include "cspack/czunit.inc"
#include "cspack/hcmail.inc"
#include "cspack/czsock.inc"
#include "cspack/czbuff.inc"
#include "cspack/quest.inc"
INTEGER SSENDSTR
CHARACTER*(*) REMOTE,LOCAL
CHARACTER*8 CHOPTT
CHARACTER*255 CHLINE
CHARACTER*255 CHFILE
CHARACTER*8 DELTIM
CHARACTER*3077 CHLEN
DIMENSION NCC(1024)
#include "cspack/czoptd.inc"
DATA NCC/1024*-1/
DATA NENTRY/0/
#include "cspack/czoptu.inc"
#include "cspack/czopen.inc"
#if defined(CERNLIB_IBM)
*
* Allow file transfer of RECFM V files
*
IF(NENTRY.EQ.0) THEN
CALL ERRSET(212,256,-1,1,1)
NENTRY = 1
ENDIF
#endif
IRC = 0
* IMAX = 16240
* IF(IPROT.EQ.1) IMAX = 432
IMAX = 16320
IF(IPROT.EQ.1) IMAX = 512
*
* Open local text file
*
IOPTV=0
CHFILE=LOCAL
ISTAT = 0
IF(IOPTA.EQ.0) THEN
#if defined(CERNLIB_UNIX)
IF(IOPTC.EQ.0) CALL CUTOL(CHFILE)
#endif
#if (defined(CERNLIB_UNIX))&&(!defined(CERNLIB_APOLLO))&&(!defined(CERNLIB_OS9))
OPEN(UNIT=LUNXZI,FILE=CHFILE,FORM='FORMATTED',STATUS='OLD',
+ IOSTAT=ISTAT)
IF(ISTAT.NE.0) GOTO 95
#endif
#if (defined(CERNLIB_UNIX))&&(defined(CERNLIB_APOLLO)||defined(CERNLIB_OS9))
OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='READONLY',IOSTAT=ISTAT)
IF(ISTAT.NE.0) GOTO 95
#endif
#if defined(CERNLIB_VAXVMS)
OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',READONLY,IOSTAT=ISTAT)
IF(ISTAT.NE.0) GOTO 95
#endif
#if defined(CERNLIB_IBMMVS)
CALL KUOPEN(LUNXZI,CHFILE(1:LENOCC(CHFILE)),'OLD',ISTAT)
IF(ISTAT.NE.0) GOTO 95
#endif
#if defined(CERNLIB_IBMVM)
CHFILE='STATE '//LOCAL
DO 2 I=7,64
IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
2 CONTINUE
CALL VMCMS(CHFILE,ISTAT)
IF(ISTAT.NE.0) GOTO 95
C
CHFILE='/'//LOCAL
NCH=LENOCC(CHFILE)
DO 5 I=1,NCH
IF(CHFILE(I:I).EQ.'.')CHFILE(I:I)=' '
5 CONTINUE
OPEN(UNIT=LUNXZI,FILE=CHFILE,STATUS='OLD',IOSTAT=ISTAT,
+ FORM='UNFORMATTED')
IF(ISTAT.NE.0) GOTO 95
#endif
ENDIF
*
* Send message to remote machine with the file parameters
*
NCHR=LENOCC(REMOTE)
NCHO=LENOCC(CHOPT)
CHOPTT = CHOPT
IF(NCHO.EQ.0) THEN
CHOPTT = ' '
NCHO = 1
ENDIF
CHMAIL='PUTA :'//REMOTE(1:NCHR)//' '//CHOPTT(1:NCHO)
CALL CZPUTA(CHMAIL,IRC)
IF(IRC.NE.0)GOTO 99
*
* Verify that text file has been opened by server
*
CALL CZGETA(CHMAIL,ISTAT)
IF(ISTAT.NE.0)GOTO 90
IF(CHMAIL(1:2).NE.'OK')GOTO 90
*
* Now transfer the file
*
NR = 0
IF(IOPTS.NE.0) THEN
CALL TIMED(T)
CALL CZRTIM(DELTIM)
ENDIF
IEND = 0
10 NLINES = 1
NTOT = 0
I1 = 1
ICONT = 0
20 CONTINUE
#if defined(CERNLIB_IBMVM)
READ(LUNXZI,NUM=NCH,END=50,ERR=50)CHLINE
#endif
#if !defined(CERNLIB_IBMVM)
READ(LUNXZI,'(A)',END=50,ERR=50)CHLINE
NCH=LENOCC(CHLINE)
#endif
NR = NR + NCH
*
* Do we have room for this record in the current buffer?
*
IF(I1+NCH-1.GT.IMAX) THEN
ICONT = 1
IF(NLINES.LE.1024)NCC(NLINES)=-1
GOTO 30
ENDIF
IF(NCH.EQ.0)THEN
NCC(NLINES)=0
ELSE
NCC(NLINES)=NCH
I2=I1+NCH-1
CHBUF(I1:I2)=CHLINE(1:NCH)
I1=I2+1
NTOT=NTOT+NCH
ENDIF
IF(I1+NCH-1.GT.IMAX)THEN
IF(NLINES.LT.1024)NCC(NLINES+1)=-1
GOTO 30
ENDIF
NLINES=NLINES+1
IF(NLINES.LE.1024)GOTO 20
*
30 CONTINUE
#if (!defined(CERNLIB_CRAY))&&(!defined(CERNLIB_CONVEX))
WRITE(CHLEN,1000)NTOT,NCC
1000 FORMAT(I5,4I3,255I3,255I3,255I3,255I3)
#endif
#if defined(CERNLIB_CRAY)||defined(CERNLIB_CONVEX)
WRITE(CHLEN(1:5),1000)NTOT
1000 FORMAT(I5)
IOFF = 6
JOFF = 1
DO 11 II=1,16
WRITE(CHLEN(IOFF:IOFF+95),'(32I3)') (NCC(JJ),JJ=JOFF,JOFF+31)
IOFF = IOFF + 96
JOFF = JOFF + 32
11 CONTINUE
#endif
NTOTAL = 3077
#if defined(CERNLIB_DECNET)
*
* DECnet...
*
IF(IPROT.EQ.1) THEN
CALL CZDPTS(CHLEN,NTOTAL,ISTAT)
IF(ISTAT.NE.0) GOTO 97
ELSE
#endif
#if !defined(CERNLIB_IBM)||defined(CERNLIB_TCPSOCK)
*
* TCP/IP (with socket library)
*
NBYTES=SSENDSTR(ISKOUT,CHLEN,NTOTAL)
#endif
#if (defined(CERNLIB_IBM))&&(!defined(CERNLIB_TCPSOCK))
*
* TCP/IP on IBM without socket library->PASCAL version of TCPAW
*
CALL SSEND(ISKOUT,CHLEN,NTOTAL,NBYTES)
IF(NBYTES.LT.NTOTAL) GOTO 97
#endif
#if defined(CERNLIB_DECNET)
ENDIF
#endif
CALL CZPUTC(NTOT,ISTAT)
IF(ISTAT.NE.0)GOTO 97
*
* Still a record in the current buffer?
*
IF(ICONT.NE.0) THEN
ICONT = 0
NCC(1) = NCH
CHBUF(1:NCH) = CHLINE(1:NCH)
I1 = NCH + 1
NTOT = NCH
NLINES = 2
GOTO 20
ENDIF
IF(IEND.EQ.0)GOTO 10
*
CLOSE(LUNXZI)
IF(IDEBXZ.GE.0) PRINT 2000
2000 FORMAT(' File transfer completed')
NKILO = NR / 1024
IF(IOPTS.NE.0)THEN
CALL CZRTIM(DELTIM)
CALL TIMED(T)
READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
NSECS = ISEC + IMIN*60 + IHOUR*3600
IF(NSECS.LE.0) NSECS = 1
RATE = FLOAT(NKILO)/FLOAT(NSECS)
#include "cspack/xzstat.inc"
WRITE(IXPRNT,*) ' Transferred ',NR,' bytes, transfer rate = ',
+ RATE,' KB/S'
WRITE(IXPRNT,*) ' Elapsed time = ',DELTIM,' CP time = ',T,
+ ' sec.'
ENDIF
GOTO 99
*
50 IEND=1
NCC(NLINES)=-2
GOTO 30
*
90 WRITE(IXPRNT,*) 'Cannot open remote file'
IRC = 1
CLOSE(LUNXZI)
GOTO 99
*
95 WRITE(IXPRNT,*) 'Cannot open local file'
IRC = 2
GOTO 99
*
97 WRITE(IXPRNT,*) 'Problems in transferring file'
IRC = 3
CLOSE(LUNXZI)
*
99 END