*
* $Id$
*
* $Log$
* Revision 1.5  1998/09/25 09:25:31  mclareni
* Modifications for the Mklinux port flagged by CERNLIB_PPC
*
* Revision 1.4  1997/10/23 13:26:27  mclareni
* NT mods
*
* Revision 1.3  1997/09/02 08:46:27  mclareni
* WINNT mods, mostly cpp defines
*
* Revision 1.2  1997/01/17 08:56:17  gunter
* call vxinvb for linux too.
*
* Revision 1.1.1.1  1996/03/08 15:44:31  mclareni
* Cspack
*
*
#include "cspack/pilot.h"
      SUBROUTINE XZPUTF(LOCAL,REMOTE,LRECL,LFORM,RRECL,RFORM,CHOPT,IRC)
*              A - local file has already been opened
#include "cspack/hcmail.inc"
#include "cspack/czunit.inc"
#include "cspack/czsock.inc"
#include "cspack/zmach.inc"
#include "cspack/pawc.inc"
#if defined(CERNLIB_IBMVM)
      CHARACTER*13  CHTIME
      CHARACTER*1   RECFM
      CHARACTER*255 CHFILE,CHTEMP
#endif
      CHARACTER*(*) LOCAL,REMOTE,LFORM,RFORM
      DIMENSION IQ(2),Q(2),LQ(8000)
      EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
#include "cspack/quest.inc"
      CHARACTER*4  CHOPE,CHOPO
      CHARACTER*80 CARD
      CHARACTER*8  DELTIM
      DIMENSION    IUHEAD(400)
      DIMENSION    IOCR(100)
      PARAMETER (JBIAS=2)
      PARAMETER (MEGA=1024*1024)
      COMMON/FZSTAT/INFLUN,INFSTA,INFOFZ(40)
      INTEGER      RRECL
      DIMENSION    ITEST(5)
#if defined(CERNLIB_IPSC)
      DATA         IPATT/'0123CDEF'X/
#elif defined(CERNLIB_WINNT)
      DATA         IPATT/Z'0123CDEF'/
#elif defined(CERNLIB_DECS) || defined(CERNLIB_LINUX) 
      DATA         IPATT/Z'0123CDEF'/
#elif defined(CERNLIB_VAX)
      DATA         IPATT/Z0123CDEF/
#endif
#include "cspack/czopts.inc"
#include "cspack/czopen.inc"
      IRC = 0
      NCHL = LENOCC(LOCAL)
      NCHR = LENOCC(REMOTE)
      LENL = LENOCC(LFORM)
      LENR = LENOCC(RFORM)
 
      IF(IOPTC.NE.0) THEN
         LENR = LENR + 1
         RFORM(LENR:LENR) = 'C'
      ENDIF
 
      IF(LENL.EQ.0) THEN
         LFORM = 'Z'
         LENL  = 1
      ENDIF
 
      IF(LENR.EQ.0) THEN
         RFORM = LFORM
         LENR  = LENL
      ENDIF
 
      IF(IDEBXZ.GE.3)
     +PRINT *,'XZPUTF. enter for ',LOCAL(1:NCHL),' ',REMOTE(1:NCHR),
     +        LRECL,' ',LFORM,RRECL,' ',RFORM,CHOPT
 
      CHOPE = ' '
      IF(INDEX(LFORM(1:LENL),'A').NE.0) THEN
*
*     Exchange file format, ASCII mapping
*
         LRECL = 80
         CHOPE = 'F'
 
      ELSEIF(INDEX(LFORM(1:LENL),'X').NE.0) THEN
         IF(INDEX(LFORM(1:LENL),'D').NE.0) CHOPE = 'D'
      ELSEIF(INDEX(LFORM(1:LENL),'Z').NE.0) THEN
         CHOPE = 'V'
      ENDIF
 
      LOPT = LENOCC(CHOPE) + 1
      IF(IOPTC.NE.0) CHOPE(LOPT:LOPT) = 'C'
 
      IF(IOPTA.EQ.0) THEN
#if defined(CERNLIB_IBMVM)
*
*     Get file information
*
      CHTEMP = LOCAL(1:NCHL)
      CALL CTRANS('.',' ',CHTEMP,1,NCHL)
      CALL VMQFIL(CHTEMP(1:NCHL),RECFM,LBLK,NRECS,
     +   NBLOCKS,CHTIME,ISTAT,IRC)
*
*     Get file mode
*
      INQUIRE(FILE='/'//CHTEMP(1:NCHL),NAME=CHFILE)
      LCHF = LENOCC(CHFILE)
*
*     OS simulation? Assume VBS...
*
      IF(CHFILE(LCHF:LCHF).EQ.'4') THEN
         WRITE(CHFILE,9002) LUNXZI,CHTEMP(1:NCHL),LBLK
9002     FORMAT('FILEDEF ',I2,' DISK ',A,
     +          ' (RECFM VBS LRECL 32756 BLOCK ',I6)
         LCHF = LENOCC(CHFILE)
         CALL VMCMS(CHFILE(1:LCHF),IRC)
         IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. rc from ',
     +      CHFILE(1:LCHF),' = ',IRC
         OPEN(LUNXZI,STATUS='OLD',FORM='UNFORMATTED',IOSTAT=IRC)
      ELSE
         CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
      ENDIF
#endif
#if !defined(CERNLIB_IBMVM)
      LCHOPE = LENOCC(CHOPE) + 1
      IF(IOPTC.NE.0) CHOPE(LCHOPE:LCHOPE) = 'C'
      CALL SZOPEN(LUNXZI,LOCAL(1:NCHL),LRECL,CHOPE,IRC)
#endif
      IF(IRC.NE.0) THEN
         PRINT *,'XZPUTF. cannot open local file'
         GOTO 95
      ENDIF
      ENDIF
 
      IF((INDEX(LFORM(1:LENL),'X').NE.0).AND.(LRECL.EQ.0)) THEN
*
*     Get record length from file
*
         IF(INDEX(CHOPE,'D').EQ.0) THEN
            READ(LUNXZI) ITEST
            REWIND(LUNXZI)
         ELSE
            READ(LUNXZI,REC=1) ITEST
         ENDIF
#if defined(CERNLIB_VAX)||defined(CERNLIB_DECS) || (defined(CERNLIB_LINUX) && !defined(CERNLIB_PPC)) || defined(CERNLIB_WINNT)
         IF(ITEST(1).NE.IPATT) CALL VXINVB(ITEST(5),1)
#endif
#if !defined(CERNLIB_CRAY)
         LRECL = JBYT(ITEST(5),1,24) * 4
#endif
#if defined(CERNLIB_CRAY)
         LRECL = JBYT(ITEST(3),1,24) * 4
#endif
      ENDIF
 
      IF((INDEX(LFORM(1:LENL),'Z').NE.0).AND.(LRECL.EQ.0)) THEN
         IF(IDEBXZ.GE.-3) PRINT *,'XZPUTF. record length for ',
     +      'native FZ file defaulted to 3600 bytes'
         LRECL = 3600
      ENDIF
 
      IF(RRECL.EQ.0) RRECL = LRECL
      IF(LRECL.EQ.0) THEN
         PRINT *,'XZPUTF. the record length (in bytes) must be given'
         IRC = 1
         RETURN
      ENDIF
 
      CALL FZFILE(LUNXZI,LRECL/4,LFORM(1:LENL))
 
      CALL FZLOGL(LUNXZI,IDEBXZ)
      CALL FZLOGL(LUNFZO,IDEBXZ)
 
      WRITE(CARD,9001) REMOTE(1:NCHR),RRECL,RFORM(1:LENR)
 9001 FORMAT('PUTFZ:',A,' ',I6,A4)
      CALL CZPUTA(CARD,ISTAT)
*
*     Verify that FZ file has been opened by server
*
      CALL CZGETA(CHMAIL,ISTAT)
      IF(ISTAT.NE.0)GO TO 90
      IF(CHMAIL(1:2).NE.'OK')GO TO 90
*
*     Perform the transfer
*
      CALL CZRTIM(DELTIM)
      CALL TIMED(T)
      NR = 0
    1 CONTINUE
      NUH = 400
      CALL FZIN(LUNXZI,IHDIV,LSUP,JBIAS,' ',NUH,IUHEAD)
      IF((IQUEST(1).LT.0).OR.(IQUEST(1).GE.4)) GOTO 2
      IF(IQUEST(1).EQ.0) THEN
         IEVENT = IQUEST(11)
      ENDIF
*
*     start of run
*
      IF(IQUEST(1).EQ.1) THEN
         IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read start of run'
         IF(IOPTR.NE.0) GOTO 1
         CALL FZRUN(LUNFZO,IQUEST(11),NUH,IUHEAD)
         GOTO 1
*
*     end of run
*
      ELSEIF(IQUEST(1).EQ.2) THEN
         IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read end of run'
         IF(IOPTR.NE.0) GOTO 1
         CALL FZRUN(LUNFZO,-1,NUH,IUHEAD)
         GOTO 1
*
*     ZEBRA eof
*
      ELSEIF(IQUEST(1).EQ.3) THEN
         IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read end of file'
         IF(IOPTZ.NE.0) GOTO 1
         CALL FZENDO(LUNFZO,'E')
         GOTO 2
      ENDIF
 
      IF(IDEBXZ.GE.3) PRINT *,'XZPUTF. read ',IQUEST(14),
     +   ' data words + ',NUH,' words of user header'
      CALL UCOPY(IQUEST(21),IOCR(1),MIN(IQUEST(20),100))
      CHOPO = 'L'
      IF(IQUEST(14).EQ.0) CHOPO = 'Z'
      CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,CHOPO,IOCR(1),NUH,IUHEAD)
      IF(CHOPO.EQ.'L') CALL MZDROP(IHDIV,LSUP,' ')
      GOTO 1
    2 CONTINUE
      IUHEAD(1) = 999
      IEVENT    = 1
      IOCR(1)   = 2
      CALL FZOUT(LUNFZO,IHDIV,LSUP,IEVENT,'Z',IOCR(1),1,IUHEAD)
      CALL FZENDO(LUNFZO,'F')
      IF(IDEBXZ.GE.0) PRINT 2000
 2000 FORMAT(' File transfer completed')
*
*     Call FZINFO to get NWORDS, NMEGA transferred
*
      CALL FZINFO(LUNXZI)
      CALL FZENDI(LUNXZI,'T')
      IF(INFLUN.NE.LUNXZI) THEN
         PRINT *,'XZPUTF. error obtaining FZINFO for LUN = ',LUNXZI
         MBYTES = 0
      ELSE
         MBYTES = (INFOFZ(19) + INFOFZ(20)/MEGA)*IQCHAW
      ENDIF
 
      CLOSE(LUNXZI)
 
      CALL CZRTIM(DELTIM)
      CALL TIMED(T)
 
      IF(INDEX(CHOPT,'S').NE.0) THEN
         READ(DELTIM,'(I2,1X,I2,1X,I2)') IHOUR,IMIN,ISEC
         NSECS = ISEC + IMIN*60 + IHOUR*3600
         IF(NSECS.LE.0) NSECS = 1
         RATE   = FLOAT(MBYTES)*1000./FLOAT(NSECS)
         NKILO  = MBYTES/1024
#include "cspack/xzstat.inc"
         PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/S'
         PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' sec.'
      ENDIF
 
*
   80 CLOSE(LUNXZI)
      GO TO 99
*
   90 PRINT *,' Cannot open remote file'
      IRC = 1
      CALL FZENDI(LUNXZI,'T')
      GO TO 80
*
   95 PRINT *,' Cannot open local file'
      IRC = 2
*
   99 END
