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