PROGRAM SPAMSM
C	PROGRAM MODIFIED BY G. GUELFI FEB-85
C
C	TO COPE WITH BTYE GSA STUDIES
C
C
C	PROGRAM MODIFIED BY G. GUELFI 25-FEB-83
C
C	MODIFIED BECAUSE GSACOR CHANGED ORIGINAL DATA
C	SPASM4 NOW PERFORMS DROP OFF CORRECTION PLUS NINE POINT SMOOTH
C	THE OUTPUT FILE IS STORED IN PROCESS.X00
C	AND ORIGINAL DATA IS UNCHANGED
C
C
C
C	FEB-85
C
C		PROGRAM MODIFIED TO COPE WITH COMPRESSED GATED STUDIES
C
C
C
C
C	SPASM4 OPENS FILES AND ASK FOR OPERATOR TO MARK POINT BEFORE
C	DROPOFF OCCURS .
C	PROCES.X00 IS OPENED AND ALL BLOCKS EXCEPT MATRIX DATA ISC
C	WRITTEN FROM ORIGINAL FILE TO PROCES.X00 BEFORE CHAINING TO HRTSMH
C
C
C	INPUT FILE SPECS ARE READ FROM SAVE AREA 0, WHICH IS MODIFIED
C	SO THAT SPASMO CAN BE CALLED BY A GAMMA-11 MACRO AND THE MACRO
C	CONTINUE EXECUTION WITH THE OUTPUT FROM SPASMO.
C
C	J.P.JONES, R.R.PRICE, M.L.BORN, AND F.D.ROLLO
C	DIVISION OF NUCLEAR MEDICINE
C	VANDERBILT UNIVERSITY MEDICAL CENTER
C	NASHVILLE, TENNESSEE  37232
	COMMON /MAIN/ICH1,ICHC,ICH2,ICH,OUTF,N1,NFRMS,LFRAME
	LOGICAL*1 ADMIN(512),DEV(4),LFNAM(8),TITLE(6)
	INTEGER*2 ICNT(256),SA0(4),SA1(4),INF(4),OUTF(4)
	INTEGER*2 WT1,WT2,WT3,FNAM(4),ICNT2(256)
	INTEGER SY1,SY3
	DIMENSION CURVE(128)
	EQUIVALENCE (FNAM,LFNAM)
	REAL*8 HRTSMH
	DATA SA0/3RSVA,3RSVA,3RR00,3RSYS/
	DATA SA1/3RSVA,3RSVA,3RR01,3RSYS/
	DATA OUTF/3RSY1,3RPRO,3RCES,3RX00/
	DATA HRTSMH/12RHRTHRTSMHSAV/
	DATA SY1/3RSY1/,SY3/3RSY3/
	DATA TITLE/'S','P','A','M','S','M'/
	CALL CNTXSW
	CALL GAMSTP(ADMIN,TITLE)
3	ICH1 = IGETC()
	IL=LOOKUP(ICH1,SA0)
	IF(IL.LT.1)STOP'?-SPASMO-CANNOT FIND SAVE AREA 0'
	IR=IREADW(256,ICNT,0,ICH1)
	NFRMS=ICNT(119)
	ICHC=IGETC()
	IL=LOOKUP(ICHC,SA1)
	IF(IL.LT.1)STOP'?-SPASMO-CANNOT FIND SAVE AREA 1'
	IR = IREADW(256,ICNT2,0,ICHC)
	IR = IREADW(256,CURVE,1,ICHC)
C
C	LOCATE DROP-OFF IE FIRST POINT FROM END WITH ZERO
C	OR POSITIVE GRADIENT
C
	LFRAME = NFRMS
	DO 10 I = NFRMS,1,-1
	IF ((CURVE(I-1)-CURVE(I)).GE.0)GOTO 10
	LFRAME = I
	GOTO 21
10	CONTINUE
21	IF (LFRAME.GE.15) GOTO 24
	WRITE(7,5)
5	FORMAT(' MARK LAST POINT BEFORE FALL OFF - AUTOMATIC FAILED',//)
C	ICNT2(184) = 1
	CALL FGPLOT(ICNT2,CURVE)
	CALL FGPICK(LFRAME,IY)
C
C	CHECK GAMMA DEVICE IF GT SY3 THEN MAKE SY1
C
24	DO 26 I=1,4
	INF(I)=ICNT(I)
26	ICNT(249+I)=ICNT(I)
	IW=IWRITW(256,ICNT,0,ICH1)
14	OUTF(1)=INF(1)
	IF (OUTF(1).GE.SY3) OUTF(1) = SY1
C
C	COMPLIE WITH /D IF CHOICE OF OUTPUT DISK REQUIRED ?
C
D	WRITE(7,11)
11	FORMAT('$WHICH SYSTEM DISC UNIT FOR PROCESSED FILE?   ')
D	READ(5,12) DEV(3)
12	FORMAT(A1)
D	I=IRAD50(3,DEV,OUTF)
D	IF(I.NE.3) GO TO 14
D	I=IFETCH(OUTF)
D	IF(I.GT.0) GO TO 14
13	MAX=ICNT(87)
	ICH2=IGETC()
	ILKIN=LOOKUP(ICH2,INF)		!LENGTH OF INPUT FILE
C	TYPE *,ILKIN,ICH2,' LOKUP ERR AND CHANNEL'
	IF(ILKIN.LT.1) STOP '? - SPASMO-CANNOT FIND INPUT FILE'
	IOFF=ICNT(75)
	DO 16 I=1,4
	IF(OUTF(I).NE.INF(I)) GO TO 17
16	CONTINUE
	GO TO 18
17	ICH3=IGETC()
	ILOUT = LOOKUP (ICH3,OUTF)
	NBLKS = IOFF + 16*NFRMS
	IF (ILOUT.EQ.NBLKS) GOTO 15	!PROCES.X00 FOUND 
	CALL CLOSEC(ICH3)
	CALL IFREEC(ICH3)
	CALL IGETC(ICH3)
C
C	CREATE PROCES.X00
C
	IE=IENTER(ICH3,OUTF,NBLKS)
	IF(IE.LT.IL) STOP '? - SPASMO-CANNOT CREATE OUTPUT FILE'
15	ICH=ICH3
	IR=IREADW(256,ADMIN,0,ICH2)
	IW=IWRITW(256,ADMIN,0,ICH3)
	N1=2
	DO 27 I=2,IOFF
	IR=IREADW(256,ADMIN,N1,ICH2)
	IW=IWRITW(256,ADMIN,N1,ICH3)
27	N1=N1+1
	GO TO 19
18	ICH=ICH2
19	NFRMS=ICNT(119)
	DO 25 I=1,4
25	ICNT(I)=OUTF(I)
	IW=IWRITW(256,ICNT,0,ICH1)
	N1=IOFF
C
C	NOTE MAX OF 60 WORDS CAN BE TRANSMITTED BY CHAIN
C	BUT PROBLEMS WERE EXPERIENCED WITH RPAH FGAMMA
C	SO ONLY 11 WORDS TRANSMITTED NOW INSTEAD OF 58
C
C
	CALL CHAIN(HRTSMH,ICH1,11)
	END