C
C	SUBROUTINE CSTUDY
C
C	FUNCTION
C		TO CREATE N GAMMA GATED STUDIES FROM
C		A STUDY ADDRESSED BY SAVE AREA "0"
C
C	WRITTEN BY G.GUELF1 JUL-81
C
C	CALL CSTUDY(NFILES,ISTUDY,ICHANS,MDOFF,NFRAME,TITLE,NEWSTY)
C
C
C	WHERE
C
C		NFILES	NUMBER OF STUDIES TO BE CREATED
C		ISTUDY	I/O CHANNEL FOR ORIGINAL DATA
C		ICHANS	I/O CHANNEL FOR EACH FILE
C		MDOFF	STARTING BLOCK NO. OF GAMMA DATA
C		NFRAME	NO. OF FRAME IN STUDY
C		TITLE	NEW STUDY TITLE
C		NEWSTY	NEW STUDY RAD50 NAME
C
C
	SUBROUTINE CSTUDY(NFILES,ISTUDY,ICHANS,MDOFF,NFRAME,TITLE,NEWSTY)
	DIMENSION IQQ(256),ICHANS(1)
	INTEGER*2 SY1,SY3
	LOGICAL*1 BIQ(512),SNAME(12),TITLE(12)
	EQUIVALENCE (IQQ,BIQ,STNAME)
	REAL *8 STNAME,SVAR00,NEWSTY
	DATA SVAR00/12RSVASVAR00SYS/
	DATA SY3/3RSY3/,SY1/3RSY1/
C
C	OPEN SAVE AREAS 0
C
	CALL CRTFIL(SVAR00,53,ISAVE0,1)
C
C	GET STUDY NAME
C
	ITP = 0
	CALL READW(256,IQQ,ITP,ISAVE0)
C
C	OPEN STUDY FOR DATA EXTRACTION
C
	CALL CRTFIL(STNAME,ISTYLN,ISTUDY,1)
	ITP = 0
	CALL READW(256,IQQ,ITP,ISTUDY)
C
C	CHECK IF STUDY DYNAMIC
C
C	WRITE(7,400)BIQ(190),IQQ(117),IQQ(107)
400	FORMAT(O6,2I6)
	IF (BIQ(190).LE.0.AND.IQQ(117).EQ.1)GOTO 9
	WRITE(7,200)
200	FORMAT(' STUDY MUST BE A DYNAMIC AND HAVE ONLY ONE GROUP'//)
	DO 8 I = 1,10
	J = I - 1
	CALL CLOSEC(J)
8	CALL IFREEC(J)
	CALL BGAMMA('')
9	NFRAME = IQQ(116)
	MDOFF = IQQ(107)
C
C	CREATE NEW STUDY FILES
C
	ITP = 0
	CALL READW(256,IQQ,ITP,ISAVE0)
	CALL CLOSEC(ISAVE0)
	CALL IFREEC(ISAVE0)
C
C	CHECK GAMMA DEVICE GE SY3 THEN DIRECT TO SY1
C
	IF (IQQ(1).GE.SY3) IQQ(1) = SY1
	CALL R50ASC(12,STNAME,SNAME)
	DO 10 I = 1,NFILES
4	IF (SNAME(12).NE.'9') GOTO 5
	SNAME(12) = "57
	IF (SNAME(11).EQ.'9') SNAME(11) = "57
	IF (SNAME(11).NE.'9') SNAME(11) = SNAME(11) + 1
5	SNAME(12) = SNAME(12) + 1
	CALL IRAD50(12,SNAME,NEWSTY)
	CALL CRTFIL(NEWSTY,NUMBKS,ICHANS(I),1)
	CALL CLOSEC(ICHANS(I))
	CALL IFREEC(ICHANS(I))
	IF (NUMBKS.EQ.-2) GOTO 6
C
C	FILE EXITS GET NEW EXTENSION NUMBER
C
	GOTO 4
C
C	CREATE NEW FILE
C
6	IBLKS = ISTYLN
	CALL CRTFIL(NEWSTY,IBLKS,ICHANS(I),0)
	IRD = 0
	IWT = 0
	DO 7  II = 1,MDOFF-1
	CALL READW(256,IQQ,IRD,ISTUDY)
C	IF (II.EQ.1) IQQ(118) = "031061
	IF (II.EQ.1) CALL HDCHG(IQQ,TITLE)
	CALL WRITW(256,IQQ,IWT,ICHANS(I))
7	CONTINUE
C	TITLE(12) = TITLE(12) + 1
10	CONTINUE
	RETURN
	END
