PROGRAM EXPAND
C
C	VERSION 2.2
C
C
C	FUNCTION
C		TO EXPAND BYTE GROUPS INTO WORD MODE
C
C	N.B.	IF ORIGINAL STUDY ON DISK SY3 OR HIGHER CREATED STUDY
C		IS STORED ON SY1
C
	INTEGER*2 STUDY(4),XSTUDY(4),NEWSTY(4),NWDWRT(13)
	REAL*4 B(3,42)
	INTEGER*2 MAT(4096),IP(75),ADMN(256)
	LOGICAL*1 BMAT(4096),TITLE(12),BADMN(512)
	1 ,BYTFLG(13)
	EQUIVALENCE (XSTUDY,ADMN,BADMN)
	EQUIVALENCE (MAT,BMAT),(MAT(2048),B)
	DATA IT /5/
	IBUFSZ=4096		!NUMBER OF WORDS
C
C	OPEN SAVE AREA 0 TO GET STUDY NAME
C
	CALL SAVOP(0,ISAVE0,ADMN,IERR)
	DO 1 I = 1,4
1	STUDY(I)=XSTUDY(I)
C
C	OPEN STUDY
C
	CALL CRTFIL(STUDY,IBLKS,ISTUDY,1)
	IRD=0
	CALL READW(256,ADMN,IRD,ISTUDY)
C
C	CHECK IF STUDY DYNAMIC
C
	IF(BADMN(190).NE.0)GO TO 740
C
	CALL FGADM1(ADMN,IP,B)
	NGROUP=ADMN(117)
	JJ=11
	MDOFF=IP(6)
	DO 400 I=1,NGROUP
	IF(MOD(IP(JJ+1),2).GT.0) GO TO 450
	JJ=JJ+5
400	CONTINUE
	GO TO 720
450	CONTINUE
	JBLKS=IBLKS*2
	CALL CRTSTY(STUDY,NSTUDY,JBLKS,NEWSTY,STUDY(1))
	JJ=11
	IRD=MDOFF
	IWRT=MDOFF
	NBLKS=MDOFF
	DO 700 I=1,NGROUP
D	TYPE *,MOD(IP(JJ+1),2)
	BYTFLG(I)=MOD(IP(JJ+1),2)
	NBKFRM=2**IP(JJ+1)
	NWDRD=NBKFRM*256
	NRDFRM=NWDRD/IBUFSZ	!MAX0(1,IBUFSZ/NWDRD)
	NWDRD=MIN0(NWDRD,4096)
	NBYTRD=NWDRD*2
	NFRAME=IP(JJ)
	NBKGRP=NFRAME*NBKFRM
	NBLKS=NBLKS+NBKGRP*(BYTFLG(I)+1)
D	TYPE *,NBLKS,NBKGRP,NFRAME,NBYTRD,NWDRD,NRDFRM
D	TYPE *,NWDRD,NBKFRM,BYTFLG(I),I
C
C	 WRITE MATRIX DATA TO NEW STUDY
C
	NWDWRT(I)=NWDRD*(BYTFLG(I)+1)
	DO 600 J=1,NFRAME
	DO 600 K=1,NRDFRM
D	TYPE *,' EXP',NFRAME,NRDFRM,NWDRD,NBYTRD
	CALL READW(NWDRD,BMAT,IRD,ISTUDY)
	IF(BYTFLG(I).EQ.0) GO TO 560
	DO 550 L=NBYTRD,1,-1
	MAT(L)=IBYTE(BMAT(L))
550	CONTINUE
	CALL WRITW(NWDWRT(I),MAT,IWRT,NSTUDY)
	GO TO 600
560	CALL WRITW(NWDWRT(I),BMAT,IWRT,NSTUDY)
600	CONTINUE
	JJ=JJ+5
700	CONTINUE
C
C	UPDATE ADMIN BLOCK
C
	IRD=0
	CALL READW(256,ADMN,IRD,ISTUDY)
	ADMN(98)=NBLKS
	J=239
	DO 710 K=1,NGROUP
	IF(BYTFLG(K)) BADMN(J)=BADMN(J)+1
	J=J+17
710	CONTINUE
C
C	CHANGE TITLE TO INDICATE EXPANDED FILE
C
	DO 705 I = 97,97+11	!SHOULD BE 11
	IF (BADMN(I).EQ."200) GOTO 707
705	CONTINUE
	I = 106
707	IF ((I+3).GE.110) I = 106
	BADMN(I) = ' '
	BADMN(I+1) = 'E'
	BADMN(I+2) = 'X'
	BADMN(I+3) = "200
	IWRT = 0
	CALL WRITW(256,ADMN,IWRT,NSTUDY)
	DO 715 J=1,MDOFF-1
	CALL READW(256,ADMN,IRD,ISTUDY)
	CALL WRITW(256,ADMN,IWRT,NSTUDY)
715	CONTINUE
C
C	LOAD SVAR00 WITH NEW STUDY AND MATRIX SIZES
C
	ITP = 0
	CALL READW(256,ADMN,ITP,ISAVE0)
	ADMN(84) = NWDWRT(1)		!WORD MODE
	JJ = 120
	DO 717 I = 1,NGROUP
	IF (BYTFLG(I)) ADMN(JJ)=ADMN(JJ)*2
717	JJ = JJ + 5
	ITP = 0
	CALL WRITW(256,ADMN,ITP,ISAVE0)
	CALL FIXSV0(ISAVE0,NSTUDY,NEWSTY,MAT,ADMN)
	GO TO 900
720	CONTINUE
D	WRITE(IT,730)
730	FORMAT(' STUDY ALREADY WORD FORMAT')
	GO TO 900
740	WRITE(IT,750)
750	FORMAT(' STUDY NON-DYNAMIC')
	GO TO 900
760	WRITE(IT,770)IDEL
770	FORMAT(' DELETE STUDY ERROR ',I2)
	GO TO 900
780	WRITE(IT,790)IREN
790	FORMAT(' RENAME FILE ERROR ',I2)
C
C	CLOSE ALL CHANNELS
C
900	DO 910 I = 1,14
	N = I - 1
	CALL CLOSEC(N)
910	CALL IFREEC(N)
	CALL BGAMMA('CA')
	END