SUBROUTINE DELLOG(IER) C C***************************************************************************** C C PURPOSE: TO DELETE AN ACCOUNT AND/OR PROJECTS FROM THE LOG-FILE. C C***************************************************************************** C LOGICAL*1 RECHDR(10),YN INTEGER ISAV1(32),ISAV2(32) INCLUDE 'LOGHDR.ADM' INCLUDE 'LOGVBL.ADM' INCLUDE 'LOGPR1.ADM' INCLUDE 'LOGPR2.ADM' C C DATA RECHDR/'[',3*0,',',3*0,']',0/ C C C C***************************************************************************** C C PRESET ERROR CODE, ASK FOR UIC AND ENCODE IT. C C***************************************************************************** C IER=-1 5 WRITE(6,10) 10 FORMAT('$ENTER GROUP,MEMBER: ') READ(5,20,END=1000,ERR=5) IGR,MEM 20 FORMAT(2O6) ENCODE(3,30,RECHDR(2),ERR=5) IGR 30 FORMAT(O3) ENCODE(3,30,RECHDR(6),ERR=5) MEM DO 35 I=2,8 35 IF(RECHDR(I).EQ.32) RECHDR(I)=48 C C***************************************************************************** C C SEE IF UIC EXISTS. IF NOT PRINT WARNING AND TRY AGAIN. C C***************************************************************************** C IFOUND=0 DO 50 I=1,30 DO 40 J=1,9 IF(RECHDR(J).NE.LRCHDR(J,I)) GO TO 50 40 CONTINUE IFOUND=I GO TO 100 50 CONTINUE WRITE(6,60) (RECHDR(I),I=1,9) 60 FORMAT(/' *** WARNING *** ',9A1,' NOT FOUND'/) GO TO 5 C C C***************************************************************************** C C UIC FOUND, SO READ PROPER "VBN" BLOCK (2...5) TO HAVE THE VBN'S OF THE C PROJECTS AVAILABLE. C C***************************************************************************** C 100 IVBN=(IFOUND-1)/8+2 MUIC=MOD(IFOUND-1,8)+1 READ(1'IVBN,ERR=1000,END=1000) IBFVBL C C***************************************************************************** C C PRINT ALL PROJECTS INVOLVED. C C***************************************************************************** C JP=0 DO 150 I=1,32 LVBN=IRCVBL(I,MUIC) IF(LVBN.EQ.0) GO TO 150 JP=JP+1 ISAV1(JP)=LVBN ISAV2(JP)=I READ(1'LVBN,ERR=1000,END=1000) IBFPR1 WRITE(6,110) JP,PRONAM 110 FORMAT(1X,I2,': ',32A1) 150 CONTINUE C C C***************************************************************************** C C IF NO PROJECTS FOUND FOR THIS UIC, ASK WHETHER OR NOT TO DELETE THIS C ACCOUNT. C C***************************************************************************** C IF(JP.GT.0) GO TO 200 WRITE(6,160) (RECHDR(I),I=1,9) 160 FORMAT(/' *** WARNING *** NO PROJECTS FOUND FOR ',9A1/, $'$',16X,'DELETE THIS ACCOUNT? [Y/N]: ') READ(5,170,END=1000) YN 170 FORMAT(A1) IF(YN.EQ.'Y') GO TO 300 GO TO 999 C C C***************************************************************************** C C ASK FOR PROJECT TO DELETE (BY NUMBER). C C IF 0... EXIT C IF <0, DELETE ALL C IF >32, TRY AGAIN. C C***************************************************************************** C 200 WRITE(6,210) JP 210 FORMAT('$DELETE WHICH PROJECT [1-',I2,', 0=DON''T, -1=ALL]: ') READ(5,220,END=1000) IPROJ 220 FORMAT(I5) IF(IPROJ.EQ.0) GO TO 999 IF(IPROJ.LT.0) GO TO 300 IF(IPROJ.GT.JP) GO TO 200 C C***************************************************************************** C C HERE TO DELETE PROJECT NUMBER "IPROJ". C C IF SOMEBODY IS LOGGED IN FOR THIS PROJECT, CLEAR THE ENTRY IN BLOCK #1 C AFTER HAVING TOLD THE OPERATOR. C C CLEAR THE VBN IN "VBN" BLOCK AND DECREMENT THE NUMBER OF PROJECTS FOR C THIS ACCOUNT (IN BLOCK #1). C C CLEAR THE PROJECT BLOCKS. C C JUMP TO UPDATE FIRST AND CURRENT "VBN" BLOCK. C C***************************************************************************** C DO 230 I=1,256 230 IBFPR1(1)=0 DO 240 I=1,16 IF(IBFHDR(I).NE.ISAV1(IPROJ)) GO TO 240 IBFHDR(I)=0 WRITE(6,235) I-1 235 FORMAT(/' *** WARNING *** TT',I1,': IS LOGGED IN FOR THIS ONE. PROJECT $ DELETED'/) 240 CONTINUE WRITE(1'ISAV1(IPROJ),ERR=1000) IBFPR1 WRITE(1'ISAV1(IPROJ)+1,ERR=1000) IBFPR1 IRCVBL(ISAV2(IPROJ),MUIC)=0 IRCHDR(8,IFOUND)=IRCHDR(8,IFOUND)-1 GO TO 500 C C C***************************************************************************** C C HERE TO DELETE AN ACCOUNT AND ALL OF ITS PROJECTS. C C CLEAR THE UIC RECORD IN BLOCK #1. C C CLEAR ALL PROJECT BLOCKS INVOLVED AND SEE IF ANYONE WAS LOGGED ON FOR C THAT ONE. IF SO, TELL THE OPERATOR AND DELETE IT ANYWAY. C C***************************************************************************** C 300 IRCHDR(1,IFOUND)=0 DO 305 I=1,256 305 IBFPR1(I)=0 DO 310 I=1,32 LVBN=IRCVBL(I,MUIC) IF(LVBN.EQ.0) GO TO 310 DO 306 K=1,16 IF(IBFHDR(K).NE.LVBN) GO TO 306 IBFHDR(K)=0 WRITE(6,235) K-1 306 CONTINUE WRITE(1'LVBN,ERR=1000) IBFPR1 WRITE(1'LVBN+1,ERR=1000) IBFPR1 IRCVBL(I,MUIC)=0 310 CONTINUE C C C***************************************************************************** C C WRITE FIRST AND CURRENT "VBN" BLOCK TO DISK. C C SET ERROR CODE TO SUCCESS. C C***************************************************************************** C 500 WRITE(1'1,ERR=1000) IBFHDR WRITE(1'IVBN,ERR=1000) IBFVBL 999 IER=1 C C 1000 RETURN END