SUBROUTINE SETBAS(WHO)
C
C      DETERMINE THE DEFENSE SHIELDS EACH BASE WILL HAVE
C
	INCLUDE 'TRKCOMMON.FTN'
	REAL LAUNCH
	INTEGER SCAN,WHOM,CREW,HYPER,TORPS,WHO
	LOGICAL*1 THRU,XSHIP,CLOAK,CLON,OK,FBASE,DONE
	BYTE MESSAG,INITLS
	INTEGER*4 ENREM,TOTEN
C
C
	DO 20500 K=1,IUNIMX
C
	IOFF=(K-1)*20
	GOTO 20000
C
10001	DONE = .FALSE.
	DO 10100 I=1,ICNTRL(1)
	IF (ENREM.LE.0) GOTO 10005
	IF (IBASE(WHO,IOFF+(I*2)).EQ.0) GOTO 10005
	WRITE (5,10002) ENREM,I
10002	FORMAT (' ',I7,' UNITS LEFT -- ENTER ENERGY FOR BASE ',I2,': ',$)
	CALL GETINT(BASEN(WHO,IOFF/2+I),OK,0,10000)
	IF (.NOT.OK) BASEN(WHO,IOFF/2+I)=RCNTRL(1)
	ENREM = ENREM - BASEN(WHO,IOFF/2+I)
	IF (ENREM.LE.0) BASEN(WHO,IOFF/2+I) = BASEN(WHO,IOFF/2+I)+ENREM
	IF (ENREM.LE.0) ENREM = 0
	GOTO 10100
C
10005	IF (.NOT.DONE) WRITE (5,10006)
10006	FORMAT (' ALL REMAINING BASE SHIELDS WILL BE SET TO 0 ')
	DONE = .TRUE.
	BASEN(WHO,IOFF/2+I)=0
10100	CONTINUE
C
C	DISPLAY THE BASE INFORMATION
C
20000	WRITE (5,20001) "33,"33,"33,"33,K,"33
20001	FORMAT (' ',A1,'[0;0H',A1,'[0J',A1,'[1;22H',A1,'[7m',
	1  ' BASE CONFIGURATION FOR UNIVERSE #',I1,' ',A1,'[0m')
	TOTEN = 0
C
	DO 10110 I=1,ICNTRL(1)
	IROW=I+3
	IF (I.GT.5) IROW=I-2
	ICOL=8
	IF (I.GT.5) ICOL=48
	IF (IBASE(WHO,IOFF+(I*2)-1).GT.0) GOTO 200
	WRITE (5,101) "33,IROW,ICOL,I
101	FORMAT (' ',A1,'[',I2.2,';',I2.2,'H** BASE ',I2,' IS INACTIVE **')
	GOTO 10110
200	WRITE (5,10101) "33,IROW,ICOL,I,BASEN(WHO,IOFF/2+I)
10101	FORMAT (' ',A1,'[',I2.2,';',I2.2,'HBASE #',I2,
	1  ' -- SHIELDS ',I5)
	TOTEN = TOTEN + BASEN(WHO,IOFF/2+I)
10110	CONTINUE
C
	ENREM = TOTEN
	WRITE (5,10200) "33
10200	FORMAT (' ',A1,'[10;1HDO YOU WISH TO CHANGE ANY VALUES? ',$)
	CALL YESNO(OK)
	WRITE (5,10201)
10201	FORMAT (/)
	IF (OK) GOTO 10001
C
20500	CONTINUE
C
	RETURN
	END