[u/mrichter/AliRoot.git] / MINICERN / packlib / zebra / rz / rzpass.F

*
* $Id$
*
* $Log$
* Revision 1.2  1996/04/24 17:27:04  mclareni
* Extend the include file cleanup to dzebra, rz and tq, and also add
* dependencies in some cases.
*
* Revision 1.1.1.1  1996/03/06 10:47:26  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE RZPASS(CHPASS,CHOPT)
*
************************************************************************
*
*        To declare or change the password
* Input:
*   CHPASS  Character string specifying the password.
*   CHOPT   Character string specifying the options desired:
*           ' '   Specifies the password
*           'S'   Set  or  change the password  (to  change the password a
*                 previous  call  to  RZPASS  specifying  the  old password
*                 must have been made).
*
* Called by <USER>
*
*  Author  : R.Brun DD/US/PD
*  Written : 12.04.86
*  Last mod: 12.04.86
*
************************************************************************
#include "zebra/rzcl.inc"
#include "zebra/rzclun.inc"
#include "zebra/rzk.inc"
      CHARACTER*(*) CHPASS,CHOPT
*
*-----------------------------------------------------------------------
*

#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"

      IQUEST(1)=0
      CALL UOPTC(CHOPT,'S',IOPTS)
*
      NHPWD=LEN(CHPASS)
      IF(NHPWD.GT.8)NHPWD=8
      IF(CHPASS.EQ.' ')NHPWD=0
      CALL VBLANK(IHPWD,2)
      IF(NHPWD.GT.0)CALL UCTOH(CHPASS,IHPWD,4,NHPWD)
      CALL ZHTOI(IHPWD,IHPWD,2)
*
      IF(IOPTS.NE.0)THEN
         IFLAG=0
         CALL RZMODS('RZPASS',IFLAG)
         IF(IFLAG.NE.0)GO TO 99
         IF(NHPWD.GT.0)CALL UCOPY(IHPWD,IQ(KQSP+LCDIR+KPW1),2)
         CALL SBYT(NHPWD,IQ(KQSP+LCDIR+KPW1+2),6,5)
      ENDIF
*
*             Remove lock for CWD if passwork OK
*
      IF(JBYT(IQ(KQSP+LCDIR+KPW1+2),6,5).NE.0)THEN
         IF(JBIT(IQ(KQSP+LTOP),1).EQ.0)THEN
            IF(IQ(KQSP+LCDIR+KPW1  ).EQ.IHPWD(1).AND.
     +         IQ(KQSP+LCDIR+KPW1+1).EQ.IHPWD(2))THEN
               CALL SBIT0(IQ(KQSP+LCDIR),1)
            ENDIF
         ENDIF
      ENDIF
*
  99  RETURN
      END
Commit	Line	Data
fe4da5cc	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