C
C	SUBROUTINE CSTAT
C
C	FUNCTION
C		TO CREATE 1 STATIC GAMM STUDY FROM
C		A STUDY ADDRESSED BY SAVE AREA "0"
C
C	WRITTEN BY G.GUELFI MAR-84
C
C	CALL CSTAT(ISVARN,NFILES,ISTUDY,ICHANS,MDOFF,NFRAME,TITLE,NEWSTY)
C
C
C	WHERE
C
C		ISVARN	SAVE AREA TO BE OPENED
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 CSTAT(ISVARN,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,NEWSTY
	DATA SY1/3RSY1/,SY3/3RSY3/
C
C	OPEN SAVE AREAS N AND ZERO
C
	CALL SAVOP(ISVARN,ISAVEN,IQQ,IERR)
	ISAVE0 = ISAVEN
	IF (ISVARN.NE.0) CALL SAVOP(0,ISAVE0,IQQ,IERR)
C
C	GET STUDY NAME
C
	ITP = 0
	CALL READW(256,IQQ,ITP,ISAVEN)
C
C	OPEN STUDY FOR DATA EXTRACTION
C
	CALL CRTFIL(STNAME,ISTYLN,ISTUDY,1)
	ITP = 0
	CALL READW(256,IQQ,ITP,ISTUDY)
9	MDOFF = IQQ(107)
C
C	CREATE NEW STUDY FILES
C
	ITP = 0
	CALL READW(256,IQQ,ITP,ISAVEN)
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)
	NUMBKS = -2				!IGNORE FILE NOT FOUND
	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	ISTYLN = 17*NFRAME + 1
	CALL CRTFIL(NEWSTY,ISTYLN,ICHANS(I),0)
	IRD = 0
	IWT = 0
	DO 7  II = 1,MDOFF
	CALL READW(256,IQQ,IRD,ISTUDY)
	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
	ITP = 0
	CALL READW(256,IQQ,ITP,ISAVE0)
	STNAME=NEWSTY
	ITP = 0
	CALL WRITW(256,IQQ,ITP,ISAVE0)
	CALL CLOSEC(ISAVE0)
	CALL IFREEC(ISAVE0)
	RETURN
	END
