*
* $Id$
*
* $Log$
* Revision 1.1  1996/03/08 15:44:30  mclareni
* Initial revision
*
*
#include "cspack/pilot.h"
      SUBROUTINE XZPUTR(LOCAL,REMOTE,CHOPT,IRC)
#include "cspack/czunit.inc"
#include "cspack/hcmail.inc"
#include "cspack/czsock.inc"
#include "cspack/zmach.inc"
#include "cspack/pawc.inc"
      DIMENSION IQ(2),Q(2),LQ(8000)
      EQUIVALENCE (LQ(1),LMAIN),(IQ(1),LQ(9)),(Q(1),IQ(1))
C
#include "cspack/rzclun.inc"
      COMMON /RZCL/  LTOP,LRZ0,LCDIR,LRIN,LROUT,LFREE,LUSED,LPURG
     +,              LTEMP,LCORD,LFROM
#include "cspack/quest.inc"
      CHARACTER*8  CHTAG(100)
      CHARACTER*80 CHFILE
      CHARACTER*90 CHFORM
      CHARACTER*12 CHDATE
      CHARACTER*8  DELTIM
      CHARACTER*1  CHOPE
      CHARACTER*4  CHOPRZ
      DIMENSION IHTAG(2)
      PARAMETER (KUP=5,KPW1=7,KNCH=9,KDATEC=10,KDATEM=11,KQUOTA=12,
     +           KRUSED=13,KWUSED=14,KMEGA=15,KIRIN=17,KIROUT=18,
     +           KRLOUT=19,KIP1=20,KNFREE=22,KNSD=23,KLD=24,KLB=25,
     +           KLS=26,KLK=27,KLF=28,KLC=29,KLE=30,KNKEYS=31,
     +           KNWKEY=32,KKDES=33,KNSIZE=253,KEX=6,KNMAX=100)
      CHARACTER*(*) LOCAL,REMOTE
      DIMENSION ITEST(50)
*
*_______________________________________
#include "cspack/czopts.inc"
#include "cspack/czopen.inc"
      IRC = 0
 
      IF(IDEBXZ.GE.1) PRINT *,'XZPUTR. enter for ',
     +   LOCAL,' ',REMOTE,' ',CHOPT
*
*        Open local RZ file
*
      IQUEST(1) = 0
      IOPEN     = 0
      CHFILE    = LOCAL
      NREC      = 0
      NWKEY     = 0
      CHFORM    = ' '
      LRECL     = 0
 
      IF(IOPTA.EQ.0) THEN
         CHOPRZ = ' '
         LCHPRZ = 0
         IF(IOPTE.NE.0) THEN
            CHOPRZ = 'X'
            LCHPRZ = 1
         ENDIF
 
         IF(IOPTC.NE.0) THEN
            LCHPRZ = LCHPRZ + 1
            CHOPRZ(LCHPRZ:LCHPRZ) = 'P'
         ENDIF
 
         CALL RZOPEN(LUNXZI,'RZ',LOCAL,CHOPRZ,LRECL,ISTAT)
         IF(ISTAT.NE.0) GOTO 50
      ENDIF
 
      CHOPRZ = ' '
      IF(IQUEST(12).NE.0) CHOPRZ = 'X'
 
      CALL RZFILE(LUNXZI,'RZ',CHOPRZ)
      IF(IQUEST(1).NE.0)THEN
         CLOSE(LUNXZI)
         GOTO 50
      ENDIF
 
      IF(INDEX(CHOPT,'S').NE.0) THEN
         CALL RZSTAT('//RZ',99,' ')
         NWORDS = IQUEST(12)
      ENDIF
 
      IF(INDEX(CHOPT,'L').NE.0) CALL RZLDIR(' ',CHOPT)
*
*        Send message to remote machine with the file parameters
*
      CHOPE = ' '
      IF(INDEX(CHOPT,'N').NE.0) CHOPE = 'N'
      IF(INDEX(CHOPT,'X').NE.0) CHOPE = 'X'
      LCHOPE = LENOCC(CHOPE)
      IF(IOPTC.NE.0) THEN
         CHOPE(LCHOPE+1:LCHOPE+1) = 'C'
         LCHOPE = LCHOPE + 1
      ENDIF
      IF(INDEX(CHOPT,'R').NE.0.OR.IRELAT.NE.0)
     +               CHOPE(LCHOPE+1:LCHOPE+1) = 'L'
 
      NCHR = LENOCC(REMOTE)
      CHMAIL='PUTRZ:'//REMOTE(1:NCHR)//' '//CHOPE
*     IF((INDEX(CHOPT,'R').NE.0).OR.(IRELAT.NE.0))
*    +   CHMAIL = CHMAIL(1:LENOCC(CHMAIL)) // 'R '
 
      CALL CZPUTA(CHMAIL,ISTAT)
      IF(ISTAT.NE.0)GOTO 99
 
      IOPEN  = 1
      NREC   = IQ(LCDIR+KQUOTA)
      NWKEY  = IQ(LCDIR+KNWKEY)
      KTAGS  = KKDES+(NWKEY-1)/10+1
      LB     = IQ(LCDIR+KLB)
      LRECL  = IQ(LCDIR+LB+1)
      IDATEC = IQ(LCDIR+KDATEC)
      IDATEM = IQ(LCDIR+KDATEM)
*
*     Test if this file is in exchange mode
*
*     CALL RZIODO(LUNXZI,50,2,ITEST,1)
*SELF,IF=VAX,DECS.
*
*     CALL VXINVB(ITEST(9),1)
*     IMODEX = JBIT(ITEST(9),12)
*     IMODEX = IOR(ITEST(6),0)
*SELF,IF=-VAX,IF=-DECS.
*     IMODEX = ITEST(6)
*SELF.
*
#if defined(CERNLIB_UNIX)
      IF(INDEX(CHOPT,'X').NE.0) THEN
#endif
#if !defined(CERNLIB_UNIX)
      IF((IMODEX.NE.0).AND.(INDEX(CHOPT,'N').EQ.0)) THEN
#endif
*
*     Set NWKEY to indicate that this is an exchange mode transfer
*
         NWKEY = -1
         WRITE(CHMAIL,9002)NWKEY,NREC,LRECL,IDATEC,IDATEM
         CALL CZPUTA(CHMAIL,ISTAT)
         IF(ISTAT.NE.0)GOTO 40
*
*     Now transfer the file using XZPUTD
*
         CHOPE = ' '
         IF(INDEX(CHOPT,'S').NE.0) CHOPE = 'S'
         CALL XZPUTD(LOCAL,REMOTE,LRECL*4,CHOPE,IC)
         CALL RZEND('RZ')
         GOTO 99
      ELSE
         DO 10 I=1,NWKEY
            CALL ZITOH(IQ(LCDIR+KTAGS+2*I-2),IHTAG,2)
            CALL UHTOC(IHTAG,4,CHTAG(I),8)
            IKDES=(I-1)/10
            IKBIT1=3*I-30*IKDES-2
            IFORM=JBYT(IQ(LCDIR+KKDES+IKDES),IKBIT1,3)
            IF(IFORM.EQ.3)THEN
               CHFORM(I:I)='H'
            ELSEIF(IFORM.EQ.4) THEN
               CHFORM(I:I)='A'
            ELSEIF(IFORM.EQ.1) THEN
               CHFORM(I:I)='B'
            ELSE
               CHFORM(I:I)='I'
            ENDIF
   10    CONTINUE
         CHMAIL=' '
         WRITE(CHMAIL,9002)NWKEY,NREC,LRECL,IDATEC,IDATEM
 9002 FORMAT(5I10)
         CALL CZPUTA(CHMAIL,ISTAT)
         IF(ISTAT.NE.0)GOTO 40
         CALL CZPUTA(CHFORM,ISTAT)
         IF(NWKEY.EQ.0)GOTO 40
         DO 20 I=1,NWKEY
            CHMAIL=CHTAG(I)
            CALL CZPUTA(CHMAIL,ISTAT)
            IF(ISTAT.NE.0)GOTO 40
   20    CONTINUE
*
*          Verify that RZ file has been opened by server
*
         CALL CZGETA(CHMAIL,ISTAT)
         IF(ISTAT.NE.0)GOTO 40
         IF(CHMAIL(1:2).NE.'OK')GOTO 40
 
         IF(INDEX(CHOPT,'S').NE.0) THEN
            CALL CZRTIM(DELTIM)
            CALL TIMED(T)
         ENDIF
 
*
*          Now transfer the file
*
         CALL RZTOFZ(LUNFZO,'C')
         IF(IQUEST(1).NE.0) THEN
            PRINT 9003
 9003 FORMAT(' Error transferring file')
            IRC = 3
         ELSE
            IF(IDEBXZ.GE.0) PRINT 9004
 9004 FORMAT(' File transfer completed')
            IF(INDEX(CHOPT,'S').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
               NKILO = NWORDS*IQCHAW/1024
               RATE = FLOAT(NKILO)/FLOAT(NSECS)
               NR = 0
#include "cspack/xzstat.inc"
               PRINT *,' Transferred ',NKILO,' KB, rate = ',RATE,' KB/'
     +         //'S'
               PRINT *,' Elapsed time = ',DELTIM,' CP time = ',T,' '
     +         //'sec.'
            ENDIF
 
         ENDIF
      ENDIF
*
   30 IF(IOPEN.EQ.0)GOTO 99
      CALL RZEND('RZ')
      CLOSE(LUNXZI)
      GOTO 99
*
   40 PRINT *,' Cannot open remote file'
      IRC = 1
      GOTO 30
*
   50 PRINT *,' Cannot open local file'
      IRC = 2
*
  99  END
