FTN4,L
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C     SOURCE PART NUMBER :  92067-18364 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C 
C 
C     ALTER,USER
C     ALTER,GROUP 
C     CALLING SEQUENCE: 
C        CALL ACALU(ITYPE)
C 
C        WHERE: ITYPE=1 FOR USER
C               ITYPE=2 FOR GROUP 
C 
C     ALTER,USER
C 
C     ACCOUNT NAME                FUNCTION
C 
C 
C      USER.GROUP          ALTER ONE ENTRY FOR ACCOUNT
C 
C      USER.@              ALTER ALL ENTRIES IN ALL GROUPS
C                           WITH NAME USER
C 
C      @.GROUP             ALTER ALL USERS OF GROUP 
C 
C 
C      @.@                 ALTER ALL USERS (DEFAULT)
C 
C     ALTER,GROUP 
C 
C     GROUP                ALTER "GROUP"
C 
C     @                    ALTER ALL GROUPS 
C 
C 
C     ACERRS:            -200  ACCOUNT NOT FOUND
C                        -201  NO FREE ACCOUNTS 
C                        -202  ACCOUNT WITH THIS NAME ALREADY EXISTS
C                        -203  INVALID ACCOUNT NAME 
C                        -204  INVALID PASSWORD 
C                        -206  INVALID FILE NAME
C                        -207  INVALID CAPABILITY 
C                        -208  INVALID DISC LIMIT 
C                        -209  INVALID SST ENTRY
C                        -210  CONFLICT IN SST DEFINITION 
C                        -211  USER OR GROUP ID NOT AVAILABLE 
C                        -212  INVALID NUMBER OF SST SPARES 
C                         FMP ACERR (READF,WRITF) 
C 
C 
      SUBROUTINE ACALU(ITYPE) ,92067-16361 REV.1940 790726  
      LOGICAL ISRCH,INUG
      DIMENSION MSNAM(5),MSGNM(6),MSGST(12),MSUPW(7),MSHFL(8) 
      DIMENSION MSCAP(8),MSMXD(12),MSSST(29),MSSPR(11)
      DIMENSION MSGNX(6),LUMS1(27),LUMS2(32)
      DIMENSION IUSER(5),IDMY(2),IRECG(2),IRECU(2),IRENG(2) 
      DIMENSION NAME(11),NAMEU(11),NAMEG(11)
      COMMON /ACOM1/NDCB(272),NBUF(128) 
      COMMON /ACOM6 /LOC(6),IRN,IPFLG 
      COMMON /ACOM7/IPBUF(11),ISTRC,JPBUF(11) 
      COMMON /ACOM9/IBUF(40),JBUF(96) 
      COMMON /ACOMA /ISRCH
      COMMON /ACOM4/ ICMND(40)
      COMMON /ACOM3/LIST(10),LDCB(144),LLIST,LLDCB(144),ITTY,ITDCB(144) 
      COMMON /ACOMD/ICLASS,KPB,KRR,KRRR,IDSES,MYCAP,MYDIR,MYGID 
      DATA IAT/2H@  / 
      DATA LPPG,I0,I6 /54,2HI0,2HI6 / 
      DATA MSNAM/2HUS,2HER,2H N,2HAM,2HE?/
      DATA MSGNM/2HGR,2HOU,2HP ,2HNA,2HME,2H? / 
      DATA MSGST/2HUS,2HE ,2HGR,2HOU,2HP ,2HSS,2HT ,2H(Y,2H O,
     1     2HR ,2HN),2H? /
      DATA MSUPW/2HUS,2HER,2H P,2HAS,2HSW,2HOR,2HD?/
      DATA MSHFL/2HUS,2HER,2H H,2HEL,2HLO,2H F,2HIL,2HE?/ 
      DATA MSCAP/2HUS,2HER,2H C,2HAP,2HAB,2HIL,2HIT,2HY?/ 
      DATA MSMXD/2HMA,2HXI,2HMU,2HM ,2HDI,2HSC,2H C,2HAR,2HTR,
     1     2HID,2HGE,2HS?/
      DATA MSSST/2HSS,2HT ,2HDE,2HFI,2HNI,2HTI,2HON,2H? ,2H(E,
     1     2HNT,2HER,2H S,2HES,2HSI,2HON,2H L,2HU,,2H S,2HYS, 
     2     2HTE,2HM ,2HLU,2H, ,2HOR,2H E,2HNT,2HER,2H /,2HE)/ 
      DATA MSSPR/2HNU,2HMB,2HER,2H O,2HF ,2HSS,2HT ,2HSP,2HAR,
     1     2HES,2H? / 
      DATA MSGNX/2HNE,2HXT,2H G,2HRO,2HUP,2H? / 
      DATA LUMS1/2HCO,2HNF,2HLI,2HCT,2H I,2HN ,2HSS,2HT ,2HDE,
     1     2HFI,2HNI,2HTI,2HON,2H -,2H A,2HSS,2HUM,2HIN,2HG , 
     2     2HUS,2HER,2H D,2HEF,2HIN,2HIT,2HIO,2HN / 
      DATA LUMS2/2HUS,2HER,2H: ,2HSE,2HS ,2HLU,2H  ,2H  ,2H, ,
     1     2HSY,2HS ,2HLU,2H  ,2H  ,2H  ,2H  ,2H G,2HRO,2HUP, 
     2     2H: ,2HSE,2HS ,2HLU,2H  ,2H  ,2H, ,2HSY,2HS ,2HLU, 
     3     2H  ,2H  ,2H  /
C 
C     SET IDG TO NO CHANGE
C 
      IDG=-1
      NAMEG(2)=2H/
C 
C     PARSE ACCOUNT NAME
C 
      JERR=0
      CALL PARSN(NAME,ICMND,80,ISTRC,JERR)
      IF(JERR.NE.0) GO TO 2800
C 
C     TEST FOR USER.GROUP FORMAT
C 
      IF(LBYTE(NAME(1)).NE.0) GO TO 90
      NAME(7 )=2HGE 
      NAME(8 )=2HNE 
      NAME(9 )=2HRA 
      NAME(10)=2HL
      NAME(11)=2H 
C 
C     IF GROUP MOVE NAME(2) TO NAME(7)
C 
   90 GO TO (110,100),ITYPE 
  100 DO 101 I=2,6
  101 NAME(I+5)=NAME(I) 
      NAME(2)=0 
C 
C     SAVE RESET VALUES FOR LOOP
C 
  110 IU=NAME(2)
      IG=NAME(7)
C 
C     CHECK TO SEE IF ACCOUNT EXISTS
C 
      CALL ACFDA(NAME(2),NAME(7),IDIRN,IDMY,IDMY,JERR)
      NAME(2)=IU
      NAME(7)=IG
      IF(JERR.NE.0) GO TO 2900
C 
C     MAKE SURE HE IS DOING HIS GROUP 
C 
      CALL ACDIR(1,IDIRN,IBUF,IERR) 
C 
C     SET MAXIMUM CAPABILITY
C 
      MAXCAP=63 
      IF(IDSES.EQ.7777B) GO TO 120
      MAXCAP=62 
      IF(IG.NE.IAT.AND.MYGID.EQ.IBUF(13)) GO TO 120 
      JERR=46 
      GO TO 2900
C 
C 
C     TELL NO CHANGE AND DEFAULT ANSWERS
C 
  120 CALL ACWRI(42HENTER " " FOR DEFAULT OR /  FOR NO CHANGE ,21)
      INUG=.TRUE. 
      IRENG(1)=-1 
      NAMEU(2)=2H/
      IF(IU.EQ.IAT.OR.IG.EQ.IAT) GO TO 1000 
C 
C     IF GROUP "GENERAL" CANT CHANGE NAME 
C 
      IF(IBUF(12).EQ.0.AND.IBUF(13).EQ.3) GO TO 1000
C 
C     SAVE USER ID
C 
C 
      INUG=.FALSE.
      IDOLD=IBUF(12)
      GO TO (400,420),ITYPE 
C 
C     PROMPT FOR USER NAME
C 
  390 CALL ACERR(-202)
  400 CALL ACPRM(20HNEW USER NAME OR / ?  ,10)
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(NAMEU,IBUF,80,ICHAR,IERR)
      IF(NAMEU(2).EQ.2H/A.OR.NAMEU(2).EQ.2H/E) RETURN 
      IF(NAMEU(1).EQ.0) NAMEU(2)=2H/
      IF((IERR.EQ.0.OR.NAMEU(2).EQ.2H/ ).AND.NAMEU(2).NE.2H@ )
     1 GO TO 410
      CALL ACERR(-203)
      GO TO 400 
C 
C     PROMPT FOR NEW GROUP
C 
  405 CALL ACERR(IERR)
  410 IDG=-1
      IF(IDOLD.EQ.7777B.OR.IDSES.NE.7777B) GO TO 465
      CALL ACPRM(16HNEW GROUP OR / ?   ,8)
      GO TO 430 
C 
C     PROMPT FOR NEW GROUP NAME 
C 
  415 CALL ACERR(-202)
  420 CALL ACPRM(22HNEW GROUP NAME OR / ?  ,11) 
  430 CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(NAMEG,IBUF,80,ICHAR,IERR)
      IF(NAMEG(2).EQ.2H/A.OR.NAMEG(2).EQ.2H/E) RETURN 
      IF(NAMEG(1).NE.0) GO TO 435 
      NAMEG(1)=3400B
      NAMEG(2)=2HGE 
      NAMEG(3)=2HNE 
      NAMEG(4)=2HRA 
      NAMEG(5)=2HL
  435 IF((IERR.EQ.0.OR.NAMEG(2).EQ.2H/ ).AND.NAMEG(2).NE.2H@ )
     1 GO TO 440
      CALL ACERR(-203)
      GO TO (410,420),ITYPE 
C 
C     GET ADDRESS OF NEW GROUP ACCOUNT
C 
  440 IUSER(1)=0
      IF(NAMEG(2).EQ.2H/ ) GO TO 465
      CALL ACFDA(IUSER,NAMEG(2),IDGR,IDMY,IRENG,IERR) 
      IF(IERR.NE.0) GO TO (405,1000),ITYPE
      GO TO (450,415),ITYPE 
C 
C     SEE IF ACCOUNT ALREADY EXISTS 
C 
  450 IF(NAMEU(2).EQ.2H/ ) GO TO 460
      CALL ACFDA(NAMEU(2),NAMEG(2),IDMY,IDMY,IDMY,IERR) 
      GO TO 470 
  465 IF(NAMEU(2).EQ.2H/ ) GO TO 1000 
      CALL ACFDA(NAMEU(2),NAME(7),IDMY,IDMY,IDMY,IERR)
      IF(IERR.EQ.-200) GO TO 1000 
      GO TO 390 
  460 CALL ACFDA(NAME(2),NAMEG(2),IDMY,IDMY,IDMY,IERR)
  470 IF(IERR.NE.-200) GO TO 390
      CALL ACDIR(1,IDGR,IBUF,IERR)
      IDG=IBUF(13)
      IRG=IBUF(14)
C 
 1000 IGSST=1 
      ID=0
      GO TO (1105,1450),ITYPE 
C 
C     ALTER USER PROMPTS
C 
C 
C     PROMPT FOR WHETHER TO USE GROUP SST 
C 
 1105 CALL ACPRM(MSGST,12)
C 
C     READ AND PARSE FOR Y OR N 
C 
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,JERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A) RETURN 
C 
C     SET IGSST TO: 
C                   0        FOR NO GROUP SST 
C                   100000B  FOR GROUP SST
C                   1        FOR SAME AS PREVIOUS 
C 
      ITEMP=JPBUF(2)/256
      IF(ITEMP.EQ.131B) IGSST=100000B 
      IF(ITEMP.EQ.116B) IGSST=0 
C 
C     ALTER,USER PROMPTS
C 
      CALL ACPRM(MSUPW,7) 
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL PARSN(LDCB,IBUF,80,ICHAR,JERR) 
      IF(JERR.EQ.0) GO TO 1140
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(LDCB(2).EQ.2H/A) RETURN
      IF(LDCB(2).EQ.2H/ ) GO TO 1180
 1110 CALL ACERR(-204)
      GO TO 110 
C 
C     PASSWORD CAN'T BE IN USER.GROUP FORMAT
C 
 1140 IF(IAND(LDCB(1),255).NE.0) GO TO 1110 
 1170 LDCB(1)=LDCB(1)/256 
      IF(ITLOG.EQ.0.OR.LDCB(1).GT.0) GO TO 1200 
 1180 LDCB(1)=-1
C 
C     PROMPT FOR USER HELLO FILE
C 
 1200 CALL ACPRM(MSHFL,8) 
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL NAMR(LDCB(7),IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(LDCB(7).EQ.2H/A) RETURN
C     CHECK IF NULL OR BLANK (DEFAULT TO NO HELLO FILE) 
C 
      ITEMP=IAND(LDCB(10),3)
C 
      LDCB(10)=LDCB(11) 
      LDCB(11)=LDCB(12) 
      IF(ITEMP.NE.0) GO TO 1208 
      LDCB(7)=2H
      LDCB(8)=2H
      LDCB(9)=2H
C 
C     CHECK IF ASCII
C 
 1208 IF(ITEMP.NE.1) GO TO 1300 
      CALL ACERR(-206)
      GO TO 1200
C 
C     PROMPT FOR USER CAPABILITY
C 
 1300 CALL ACPRM(MSCAP,8) 
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL NAMR(LDCB(12),IBUF,80,ICHAR) 
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(LDCB(12).EQ.2H/A) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT CAPABILITY TO 30)
C 
      ITEMP=IAND(LDCB(15),3)
      IF(LDCB(12).NE.2H/ ) GO TO 1305 
      LDCB(12)=-1 
      GO TO 1400
C 
C     CHECK IF INTEGER, 1-63
C 
 1305 IF(ITEMP.LE.1) GO TO 1320 
 1310 CALL ACERR(-207)
      GO TO 1300
 1320 IF(ITEMP.EQ.0) LDCB(12)=30
      IF(LDCB(12).LE.0) GO TO 1310
      IF(LDCB(12).GT.MAXCAP) GO TO 1310 
C 
C     PROMPT FOR MAXIMUM DISC CARTRIDGES
C 
 1400 CALL ACPRM(MSMXD,12)
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL NAMR(LDCB(13),IBUF,80,ICHAR) 
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(LDCB(13).EQ.2H/A) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT LIMIT TO 2)
C 
      ITEMP=IAND(LDCB(16),3)
      IF(LDCB(13).NE.2H/ ) GO TO 1405 
      LDCB(13)=-1 
      GO TO 1450
C 
C     CHECK FOR INTEGER BETWEEN 0 AND 60
C 
 1405 IF(ITEMP.LE.1) GO TO 1420 
 1410 CALL ACERR(-208)
      GO TO 1400
 1420 IF(ITEMP.EQ.0) LDCB(13)=2 
      IF((LDCB(13).GT.60).OR.(LDCB(13).LT.0)) GO TO 1410
C 
C     PROMPT FOR USER SST DEFINITION
C 
 1450 ICL=29
      KNDX=14 
 1500 CALL ACPRM(MSSST,ICL) 
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO END SST DEFINITION 
C 
      IF(JPBUF(1).EQ.2H/E.OR.JPBUF(1).EQ.2H/  ) GO TO 1600
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO NO USER SST)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(KNDX.NE.33) GO TO 1510 
      IF(ITEMP.EQ.0) GO TO 1600 
C 
C     READ, PARSE AND VALIDATE SST ENTRY
C     SYSTEM LU MUST BE NUMERIC, 0-254
C     SESSION LU MUST BE NUMERIC, 4-63
C 
 1510 ISES=JPBUF(1)-1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
      ISYS=JPBUF(1) 
      IF(ISYS.EQ.2H- ) GO TO 1525 
      IF(ITEMP.NE.1) GO TO 1540 
      IF((ISYS.LT.0).OR.(ISYS.GT.254)) GO TO 1540 
      ISYS=2*IAND(ISYS-1,255) 
 1520 IF(IAND(JPBUF(4),3).NE.1) GO TO 1540
 1525 IF((ISES.LT.3).OR.(ISES.GT.62)) GO TO 1540
 1530 KNDX=KNDX+1 
      IF(ISYS.EQ.2H- ) ISYS=1 
      LDCB(KNDX)=(ISYS*128)+ISES
      ICL=8 
      GO TO 1500
 1540 CALL ACERR(-209)
      ICL=8 
      GO TO 1500
C 
C     PROMPT FOR SST SPARES 
C 
 1600 LDCB(14)=KNDX 
      ISPAR=-1
      GO TO (1605,1630),ITYPE 
C 
C     ALTER,USER PROMPTS
C 
 1605 CALL ACPRM(MSSPR,11)
      CALL ACREI(IBUF,JERR) 
      ICHAR=1 
      CALL NAMR(JPBUF,IBUF,80,ICHAR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(1).EQ.2H/A) RETURN 
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO 0)
C 
      ITEMP=IAND(JPBUF(4),3)
      IF(ITEMP.LE.1) GO TO 1620 
      IF(JPBUF(1).EQ.2H/ ) GO TO 1900 
 1610 CALL ACERR(-212)
      GO TO 1605
 1620 IF(ITEMP.EQ.0) JPBUF(1)=5 
      IF((JPBUF(1).LT.0).OR.(JPBUF(1).GT.60)) GO TO 1610
      ISPAR=JPBUF(1)
 1900 IF(INUG.OR.IDOLD.EQ.7777B) GO TO 1630 
C 
C     PROMPT FOR LINK TO EXISTING ACCOUNT 
C 
 1901 CALL ACWRI(30HLINK TO AN EXISTING ACCOUNT ?  ,15) 
      CALL ACWRI(30H(ANY MOUNTED DISCS WILL NOT BE ,15) 
      CALL ACWRI(30H  TRANSFERED WITH THE ACCOUNT) ,15) 
      CALL ACPRM(30HENTER / OR USER.GROUP/PASSWORD  ,15)
      CALL ACREI(IBUF,IERR) 
      ICHAR=1 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
C 
C     CHECK FOR REQUEST TO ABORT COMMAND
C 
      IF(JPBUF(2).EQ.2H/A.OR.JPBUF(2).EQ.2H/E) RETURN 
C 
C     CHECK FOR NO CHANGE 
C 
      IF(JPBUF(2).EQ.2H/ ) GO TO 1630 
C 
C     CHECK FOR ACERR 
C 
      IF(IERR.EQ.0) GO TO 1904
      CALL ACERR(-203)
      GO TO 1901
C 
C     CHECK FOR NULL OR BLANK (DEFAULT TO N), OR N
C 
 1904 IF(JPBUF(1).EQ.0) GO TO 1630
C 
C     SET IPFLG TO RESET ID BIT MAP 
C 
      IF(IPFLG.EQ.0) IPFLG=1
C 
C     NAME MUST BE IN USER.GROUP FORMAT 
C 
      IF(IAND(JPBUF(1),255).NE.0) GO TO 1920
 1910 CALL ACERR(-203)
      GO TO 1901
C 
C     CHECK IF USER.GROUP ACCOUNT EXISTS
C 
 1920 CALL ACGTU(JPBUF(2),JPBUF(7),NBUF,IOFST,IERR) 
      IF(IERR.EQ.0) GO TO 1925
      CALL ACERR(-200)
      GO TO 1901
C 
C     CHECK THE PASSWORD (SKIP IF NO PASSWORD)
 1925 ITEMP=IAND(NBUF(IOFST+1),77777B)
      IF(ITEMP.EQ.0) GO TO 1950 
      CALL PARSN(JPBUF,IBUF,80,ICHAR,IERR)
      DO 1930 I=2,6 
      IF(JPBUF(I).NE.NBUF(IOFST+I)) GO TO 1940
 1930 CONTINUE
      GO TO 1950
 1940 CALL ACERR(-204)
      GO TO 1901
C 
C     GET THE USER ID FROM THE ACCOUNT ENTRY
C 
 1950 IDD=NBUF(IOFST+29)
      IF(IDD.GE.7776B) GO TO 1910 
      ID=IDD
C 
C     GET GROUP ACCOUNT 
C 
 1630 CALL RNRQ(1,IRN,ISTAT)
 1640 IUSER(1)=0
      CALL ACFDA(IUSER,NAME(7),IDIRN,IRECU,IRECG,JERR)
      IF(JERR.NE.0) GO TO 2600
      GO TO (1690,1645),ITYPE 
 1645 IF(INUG.OR.NAMEG(2).EQ.2H/ ) GO TO 1650 
C 
C     UPDATE DIRECTORY
C 
      CALL ACDIR(1,IDIRN,IBUF,IERR) 
      IBUF(1)=MBYTE(NAMEG(1)) 
      DO 1646 I=2,6 
      IBUF(I+5)=NAMEG(I)
 1646 CONTINUE
      CALL ACDIR(2,IDIRN,IBUF,IERR) 
 1650 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECG)
      IOFST=IRECG(2)
      NBU6=NBUF(IOFST+6)-1
      IF(NBU6.GE.0.OR.NBU6.LT.-63) NBU6=-1
      NBUF(IOFST+6)=NBU6
      CALL ACAST(NBUF(IOFST+6)) 
      CALL WRITF(NDCB,JERR,NBUF,128,IRECG)
C 
C     SET TO SEARCH ALL USERS OF GROUP
C 
      NAME(2)=IAT 
      IU=IAT
C 
C     GET USER ACCOUNT
C 
 1690 ISRCH=.FALSE. 
 1700 CALL ACFDA(NAME(2),NAME(7),IDIRN,IRECU,IRECG,JERR)
      IF(JERR.NE.0) GO TO 2500
C 
C     UPDATE DIRECTORY IF REQUIRED
C 
      IF(INUG)GO TO 4740
      CALL ACDIR(1,IDIRN,IBUF,IERR) 
      IF(NAMEU(2).EQ.2H/ ) GO TO 4710 
C 
C     UPDATE USER NAME
C 
      IBUF(1)=IAND(NAMEU(1),177400B)+LBYTE(IBUF(1)) 
      DO 4700 I=2,6 
      IBUF(I)=NAMEU(I)
 4700 CONTINUE
C 
C     UPDATE GROUP NAME 
C 
 4710 IF(NAMEG(2).EQ.2H/ ) GO TO 4730 
      IBUF(1)=IOR(IAND(IBUF(1),177400B),MBYTE(NAMEG(1)))
      DO 4720 I=2,6 
      IBUF(I+5)=NAMEG(I)
 4720 CONTINUE
C 
C     UPDATE ID'S 
C 
 4730 IF(IBUF(12).LT.7776B.AND.ID.NE.0) IBUF(12)=ID 
      IF(IDG.LT.0) GO TO 4735 
      IBUF(13)=IDG
      IBUF(14)=IRG
 4735 CALL ACDIR(2,IDIRN,IBUF,IERR) 
 4740 IOFST=IRECU(2)
      CALL READF(NDCB,JERR,NBUF,128,LEN,IRECU)
      DO 1705 I=1,64
 1705 JBUF(I)=NBUF(I+IOFST) 
      IF(0.LE.JBUF(1))GO TO 1715
      IRECC=IAND(JBUF(64),77777B) 
      JOFST=0 
      IF(JBUF(64).LT.0) JOFST=64
      CALL READF(NDCB,JERR,NBUF,128,LEN,IRECC)
C 
C     RELEASE ENTRY FOR 2ND PART
C 
      JJDIR=(IRECC-LOC(6))*2+1
      IF(JOFST.NE.0) JJDIR=JJDIR+1
C 
C     MOVE TO JBUF
C 
 1709 DO 1710 I=1,33
 1710 JBUF(63+I)=NBUF(I+JOFST)
C 
C     CLEAR BIT FOR 2ND HALF
C 
      JBUF(1)=IAND(JBUF(1),77777B)
C 
C     IF GROUP BYPASS USER UPDATES
C 
 1715 IGSSTS=IAND(JBUF(33),100000B) 
      ISPARS=IAND(JBUF(32),255) 
      GO TO (1720,1760),ITYPE 
C 
C     UPDATE PASSWORD 
C 
 1720 IF(LDCB(1).LT.0) GO TO 1730 
      DO 1725 J=1,6 
 1725 JBUF(J)=LDCB(J) 
C 
C     UPDATE HELLO FILE 
C 
 1730 IF(LDCB(7).EQ.2H/ ) GO TO 1750
      DO 1740 J=7,11
 1740 JBUF(J)=LDCB(J) 
C 
C     UPDATE CAPABILITY 
C 
 1750 IF(JBUF(29).GE.7776B) GO TO 1755
      IF(LDCB(12).GE.0) JBUF(22)=LDCB(12) 
C 
C     UPDATE NUMBER OF DISCS
C 
 1755 IF(LDCB(13).GE.0) JBUF(31)=LDCB(13) 
C 
C     UPDATE ID'S 
C 
      IF(JBUF(29).LT.7776B.AND.ID.NE.0) JBUF(29)=ID 
      IF(IDG.GE.0) JBUF(30)=IDG 
C 
C     UPDATE USER SST 
C 
      IF(IGSST.NE.1) IGSSTS=IGSST 
      IF(ISPAR.GE.0) ISPARS=ISPAR 
      JBU33=IAND(JBUF(33),77777B)-MBYTE(JBUF(32)) 
      JBUF(32)=0
      IF(JBU33.LT.0.OR.JBU33.GT.63) JBU33=0 
      JBUF(33)=JBU33
      CALL ACAST(JBUF(33))
C 
C     GET GROUP 
C 
 1760 KNDX=IAND(JBUF(33),77777B)+33-MBYTE(JBUF(32)) 
      IOFST=IRECG(2)
      IF(IRENG(1).EQ.-1) GO TO 1770 
      IOFST=IRENG(2)
      IRECG(1)=IRENG(1) 
 1770 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECG)
C 
C     MERGE IN THE GROUP SST
C 
      IGLEN=0 
C 
C     CHECK IF GROUP SST IS TO BE USED
C 
      IF(IGSSTS.EQ.0) GO TO 1890
      ICNT=IABS(NBUF(IOFST+6))
C 
C     CHECK FOR EMPTY GROUP SST 
C 
      IF(ICNT.LE.0.OR.ICNT.GT.64) GO TO 1890
      K=IOFST+6 
C 
C     VALIDATE EACH GROUP SST ENTRY 
C 
      DO 1880 I=1,ICNT
      ITEMP=IAND(NBUF(I+K),255) 
C 
C     CHECK FOR CONFLICTS OR DUPLICATE SST DEFINITIONS
C 
      IF(KNDX.LT.34) GO TO 1865 
      DO 1860 J=34,KNDX 
      ISES=IAND(JBUF(J),255)
      IF(ITEMP.NE.ISES) GO TO 1860
C 
C     FOUND MATCHING SESSION LU - IF DUPLICATE DEFINITION 
C     IGNORE IT, ELSE REPORT SST CONFLICT 
C 
      IF(JBUF(J).EQ.NBUF(I+K)) GO TO 1880 
      GO TO 1870
 1860 CONTINUE
C 
C     MOVE GROUP SST ENTRY TO USER
C 
 1865 KNDX=KNDX+1 
      JBUF(KNDX)=NBUF(I+K)
      IGLEN=IGLEN+1 
      GO TO 1880
C 
C     CONFLICT BETWEEN USER AND GROUP SST DEFINITION
C 
C 
C     PRINT THE CONFLICTING LU DEFINITIONS
C 
 1870 CALL ACWRI(NAME(2),5) 
      CALL ACWRI(NAME(7),5) 
      ISYSG=(NBUF(I+K)/256)+1 
      ISYSU=(JBUF(J)/256)+1 
      CALL ACITA(ISES+1,LUMS2(7),2) 
      CALL ACITA(ISYSU,LUMS2(13),3) 
      CALL ACITA(ISYSG,LUMS2(30),3) 
      LUMS2(24)=LUMS2(7)
      LUMS2(25)=LUMS2(8)
      CALL ACWRI(LUMS1,27)
      CALL ACWRI(LUMS2,32)
 1880 CONTINUE
C 
C     WRITE SST LENGTH WORDS
C 
1890  IF(ISPARS+JBUF(31).LE.67) GO TO 1891
      ISPARS=67-JBUF(31)
      CALL ACERR(-212)
 1891 JBUF(32)=(IGLEN*256)+ISPARS 
      JBUF(33)=IOR(IGSSTS,KNDX-33)
C 
C     UPDATE ACCOUNT
C 
      IF(JJDIR.GE.0) CALL ACPGA(-1,JJDIR,0) 
      IF(KNDX.LT.64) GO TO 2100 
      CALL ACFDF(IDIRN,IRECN,JOFST,JERR,2)
      IF(JERR.NE.0) GO TO 2900
C 
C     RESERVE DIRECTORY  ENTRY FO 2ND PART
C 
      CALL ACPGA(-2,IDIRN,0)
C 
C     BUILD LAST PART OF SST
C 
      CALL READF(NDCB,JERR,NBUF,128,LEN,IRECN)
      DO 2000 I=1,33
 2000 NBUF(I+JOFST)=JBUF(I+63)
      CALL WRITF(NDCB,JERR,NBUF,128,IRECN)
C 
C     SET UP POINTER TO 2ND PART
C 
      IF(JOFST.NE.0) IRECN=100000B+IRECN
      JBUF(64)=IRECN
C 
C     SET BIT FOR 2ND PART
C 
      JBUF(1)=IOR(JBUF(1),100000B)
C 
C     UPDATE FIRST PART 
C 
 2100 CALL READF(NDCB,JERR,NBUF,128,LEN,IRECU)
      IOFST=IRECU(2)
      DO 2200 I=1,64
 2200 NBUF(I+IOFST)=JBUF(I) 
      CALL WRITF(NDCB,JERR,NBUF,128,IRECU)
C 
C     GO BACK AND SEARCH REST OF DIRECTORY
C 
      ISRCH=.TRUE.
      NAME(2)=IU
      IF(IU.EQ.IAT) GO TO 1700
 2500 NAME(7)=IG
      ISRCH=.TRUE.
      IF(IG.EQ.IAT) GO TO 1640
 2600 IF(ID.NE.0) CALL ACSID
      CALL RNRQ(4,IRN,ISTAT)
      ISRCH=.FALSE. 
      RETURN
C 
C     ACERR RETURN
C 
 2800 JERR=-203 
 2900 CALL ACERR(JERR)
C 
C     UNLOCK RN 
C 
      CALL RNRQ(40004B,IRN,ISTAT) 
      GO TO 3000
2999  CONTINUE
C 
C     FINISHED
C        SO CLEAN UP
C 
 3000 ISRCH=.FALSE. 
      RETURN
      END