GEANT321/gxint/gxrz.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:51  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GXRZ
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      RZEBRA control commands                                   *
  17 C.    *                                                                *
  18 C.    *       Authors:   R.Brun      **********                        *
  19 C.    *                  P.Zanarini  **********                        *
  20 C.    *                                                                *
  21 C.    ******************************************************************
  22 C.
  23 #include "geant321/gcbank.inc"
  24 #include "geant321/gcunit.inc"
  25 #include "geant321/gcxlun.inc"
  26 #include "geant321/gcflag.inc"
  27 #include "geant321/gcrz.inc"
  28       COMMON/QUEST/IQUEST(100)
  29       CHARACTER*20 CHDIR,CHOPT
  30       CHARACTER*64 CHPATH
  31       CHARACTER*64 CHKEY
  32       CHARACTER*8 CHTAG(20)
  33       DIMENSION KEYRZ(4)
  34       CHARACTER*32 CHPATL
  35       CHARACTER*(*) BSLASH
  36 #if defined(CERNLIB_BSLASH)
  37       PARAMETER (BSLASH='\\')
  38 #endif
  39 #if !defined(CERNLIB_BSLASH)
  40       PARAMETER (BSLASH='\')
  41 #endif
  42 C.
  43 C.    ------------------------------------------------------------------
  44 C.
  45       CALL KUPATL(CHPATL,NPAR)
  46 *
  47       IF (CHPATL.EQ.'PQUEST') THEN
  48          CALL KUGETI(IQ1)
  49          CALL KUGETI(IQ2)
  50          IF (NPAR.EQ.1) IQ2=IQ1
  51          DO 10 I=IQ1,IQ2
  52             WRITE(CHMAIL,10000)I,IQUEST(I),IQUEST(I)
  53             CALL GMAIL(0,0)
  54    10    CONTINUE
  55 10000 FORMAT(' IQUEST(',I2,')=',I10,2X,Z8)
  56 *
  57       ELSEIF (CHPATL.EQ.'FILE') THEN
  58          CALL KUGETI(LUN)
  59          CALL GXLUNF(LUN,1,IFREE)
  60          IF(IFREE.NE.0)GO TO 999
  61          CALL KUGETC(CHPATH,NCH)
  62          CALL KUGETC(CHOPT,NCH)
  63          CALL GRFILE(LUN,CHPATH,CHOPT)
  64          IF(INDEX(CHOPT,'I').NE.0.OR.INDEX(CHOPT,'O').NE.0)THEN
  65             LUNIT(LUN)=0
  66          ELSE
  67             LUNIT(LUN)=5
  68          ENDIF
  69 *
  70       ELSEIF (CHPATL.EQ.'REND') THEN
  71          CALL KUGETI(IRLUN)
  72          CALL GREND(IRLUN)
  73 *
  74       ELSEIF (CHPATL.EQ.'RZSAVE') THEN
  75          CALL RZSAVE
  76 *
  77       ELSEIF (CHPATL.EQ.'MDIR') THEN
  78          CALL HCDIR(CHDIR,'R')
  79          IF(CHDIR(3:6).EQ.'PAWC')THEN
  80             IPAW=1
  81          ELSE
  82             IPAW=0
  83          ENDIF
  84          CALL KUGETC(CHDIR,NCH)
  85          DO 20 I=1,NCH
  86             IF(CHDIR(I:I).EQ.'/'.OR.CHDIR(I:I).EQ.BSLASH)THEN
  87                WRITE(CHMAIL,10100)
  88 10100       FORMAT('Directory name cannot contain slash')
  89                CALL GMAIL(0,0)
  90                GOTO 999
  91             ENDIF
  92    20    CONTINUE
  93          IF(IPAW.NE.0)THEN
  94             CALL HMDIR(CHDIR,' ')
  95          ELSE
  96             CALL KUGETI(NWKEY)
  97             CALL KUGETC(CHOPT,NCH)
  98             DO 30 I=1,NWKEY
  99                CALL KUGETS(CHTAG(I),NCH)
 100    30       CONTINUE
 101             CALL RZMDIR(CHDIR,NWKEY,CHOPT,CHTAG)
 102          ENDIF
 103 *
 104       ELSEIF (CHPATL.EQ.'CDIR') THEN
 105          IF(NPAR.EQ.0)THEN
 106             CHOPT='P'
 107             CHPATH=' '
 108          ELSE
 109             CALL KUGETC(CHPATH,NCH)
 110             CHOPT=' '
 111             CALL KUGETC(CHOPT,NCH)
 112          ENDIF
 113          CALL HCDIR(CHPATH,CHOPT)
 114 *
 115       ELSEIF (CHPATL.EQ.'IN') THEN
 116          CALL KUGETC(CHKEY,NCH)
 117          CALL KUGETI(IDVERS)
 118          CALL KUGETC(CHOPT,NCH)
 119          CALL GRIN(CHKEY,IDVERS,CHOPT)
 120 *
 121       ELSEIF (CHPATL.EQ.'OUT') THEN
 122          CALL KUGETC(CHKEY,NCH)
 123          CALL KUGETI(IDVERS)
 124          CALL KUGETC(CHOPT,NCH)
 125          CALL GROUT(CHKEY,IDVERS,CHOPT)
 126 *
 127       ELSEIF (CHPATL.EQ.'LDIR') THEN
 128          CALL KUGETC(CHPATH,NCH)
 129          CHOPT='R'
 130          CALL KUGETC(CHOPT,NCH)
 131          IF(NCH.GT.0)CHOPT=CHOPT(1:NCH)//'R'
 132          CALL HLDIR(CHPATH,CHOPT)
 133 *
 134       ELSEIF (CHPATL.EQ.'PURGE') THEN
 135          CALL KUGETI(NKEEP)
 136          CALL RZPURG(NKEEP)
 137 *
 138       ELSEIF (CHPATL.EQ.'SCR') THEN
 139          CALL KUGETC(CHKEY,NCH)
 140          CALL KUGETI(IDVERS)
 141          CALL UCTOH(CHKEY,KEYRZ(1),4,4)
 142          KEYRZ(2)=IDVERS
 143          ICYCLE=9999
 144          CHOPT=' '
 145          CALL RZDELK(KEYRZ,ICYCLE,CHOPT)
 146 *
 147       ELSEIF (CHPATL.EQ.'LOCK') THEN
 148          CALL KUGETC(CHDIR,NCH)
 149          CALL RZLOCK(CHDIR)
 150 *
 151       ELSEIF (CHPATL.EQ.'FREE') THEN
 152          CALL KUGETC(CHDIR,NCH)
 153          CALL RZFREE(CHDIR)
 154 *
 155       ENDIF
 156   999 END