MINICERN/packlib/zebra/rz/rzmods.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:03  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:25  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZMODS(CHROUT,IFLAG)
  15 *
  16 ************************************************************************
  17 *
  18 *           Check if directory can be modified
  19 *           Enter directory in the list of modified directories
  20 *  Input:
  21 *    CHROUT  Name of the calling routine
  22 * Output:
  23 *   IFLAG   Status flag =0 if OK  1 otherwise
  24 *
  25 * Called by RZCOPY,RZDELK,RZDELT,RZMDIR,RZOUT,RZPASS,RZPURG,RZQUOT,RZVOUT
  26 *
  27 *  Author  : R.Brun DD/US/PD
  28 *  Written : 02.04.86
  29 *  Last mod: 04.10.90
  30 *
  31 ************************************************************************
  32 #include "zebra/zunit.inc"
  33 #include "zebra/rzcl.inc"
  34 #include "zebra/rzdir.inc"
  35       CHARACTER*255 CHPATH
  36       CHARACTER*6 CHROUT
  37 *
  38 *-----------------------------------------------------------------------
  39 *
  40 #include "zebra/q_jbit.inc"
  41 #include "zebra/q_jbyt.inc"
  42
  43 *
  44 *            Check permission
  45 *
  46       IF(JBIT(IQ(KQSP+LCDIR),1).NE.0)GO TO 90
  47       IF(IFLAG.EQ.0)THEN
  48          IF(LFREE.EQ.0)GO TO 90
  49          IF(IQ(KQSP+LFREE+1).EQ.0)GO TO 90
  50       ELSE
  51          IFLAG=0
  52       ENDIF
  53 *
  54       CALL SBIT1(IQ(KQSP+LCDIR),2)
  55       CALL SBIT1(IQ(KQSP+LTOP),2)
  56       GO TO 99
  57 *
  58   90  CONTINUE
  59 *
  60 *     Get current directory name
  61 *
  62       CALL RZPAFF(CHPAT,NLPAT,CHPATH)
  63       LPATH = LENOCC(CHPATH)
  64       IF(JBYT(IQ(KQSP+LTOP),15,3)-3.GE.-2) THEN
  65          WRITE(IQLOG,1000)CHROUT
  66          WRITE(IQLOG,*) '(',CHPATH(1:LPATH),')'
  67       ENDIF
  68       IFLAG=1
  69       IQUEST(1)=3
  70  1000 FORMAT(1X,A,'. No authorisation to write in that directory')
  71 *
  72   99  RETURN
  73       END