MINICERN/packlib/zebra/rz/rzpass.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:04  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:26  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZPASS(CHPASS,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *        To declare or change the password
  19 * Input:
  20 *   CHPASS  Character string specifying the password.
  21 *   CHOPT   Character string specifying the options desired:
  22 *           ' '   Specifies the password
  23 *           'S'   Set  or  change the password  (to  change the password a
  24 *                 previous  call  to  RZPASS  specifying  the  old password
  25 *                 must have been made).
  26 *
  27 * Called by <USER>
  28 *
  29 *  Author  : R.Brun DD/US/PD
  30 *  Written : 12.04.86
  31 *  Last mod: 12.04.86
  32 *
  33 ************************************************************************
  34 #include "zebra/rzcl.inc"
  35 #include "zebra/rzclun.inc"
  36 #include "zebra/rzk.inc"
  37       CHARACTER*(*) CHPASS,CHOPT
  38 *
  39 *-----------------------------------------------------------------------
  40 *
  41
  42 #include "zebra/q_jbit.inc"
  43 #include "zebra/q_jbyt.inc"
  44
  45       IQUEST(1)=0
  46       CALL UOPTC(CHOPT,'S',IOPTS)
  47 *
  48       NHPWD=LEN(CHPASS)
  49       IF(NHPWD.GT.8)NHPWD=8
  50       IF(CHPASS.EQ.' ')NHPWD=0
  51       CALL VBLANK(IHPWD,2)
  52       IF(NHPWD.GT.0)CALL UCTOH(CHPASS,IHPWD,4,NHPWD)
  53       CALL ZHTOI(IHPWD,IHPWD,2)
  54 *
  55       IF(IOPTS.NE.0)THEN
  56          IFLAG=0
  57          CALL RZMODS('RZPASS',IFLAG)
  58          IF(IFLAG.NE.0)GO TO 99
  59          IF(NHPWD.GT.0)CALL UCOPY(IHPWD,IQ(KQSP+LCDIR+KPW1),2)
  60          CALL SBYT(NHPWD,IQ(KQSP+LCDIR+KPW1+2),6,5)
  61       ENDIF
  62 *
  63 *             Remove lock for CWD if passwork OK
  64 *
  65       IF(JBYT(IQ(KQSP+LCDIR+KPW1+2),6,5).NE.0)THEN
  66          IF(JBIT(IQ(KQSP+LTOP),1).EQ.0)THEN
  67             IF(IQ(KQSP+LCDIR+KPW1  ).EQ.IHPWD(1).AND.
  68      +         IQ(KQSP+LCDIR+KPW1+1).EQ.IHPWD(2))THEN
  69                CALL SBIT0(IQ(KQSP+LCDIR),1)
  70             ENDIF
  71          ENDIF
  72       ENDIF
  73 *
  74   99  RETURN
  75       END