PROGRAM SPAMSA
C	PROGRAM MODIFIED BY G. GUELFI 25-FEB-84
C
C	MODIFIED BECAUSE GSACOR CHANGED ORIGINAL DATA
C	SPASMA NOW PERFORMS DROP OFF CORRECTION PLUS NINE POINT SMOOTH
C	AND ORIGINAL DATA IS UNCHANGED
C
C
C
C
C
C	SPASMA 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 HRTSMA
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/ ISAVE0,ISAVE1,ISTUDY,INEW,NEWSTD(4)
	1,N1,NFRMS,LFRAME,NWDRD,NBLKS
	LOGICAL*1 ADMIN(512),DEV(4),LFNAM(8),TITLE(6),ITITLE(12)
	LOGICAL*1 IDATAB(4096)
	INTEGER*2 ICNT(256),ICNT2(256),IP(75)
	DIMENSION CURVE(128),IDATA(4096),B(3,42)
	EQUIVALENCE (FNAM,LFNAM),(ICNT,STUDY),(IDATA,IDATAB,B)
	REAL*8 HRTSMA,STUDY
	DATA HRTSMA/12RHRTHRTSMASAV/
	DATA SY1/3RSY1/,SY3/3RSY3/
	DATA TITLE/'S','P','A','M','S','A'/
	DATA NEWSTD/3RSY1,3RPRO,3RCES,3RX00/
	CALL CNTXSW
	CALL GAMSTP(ADMIN,TITLE)
3	CALL SAVOP(0,ISAVE0,ICNT,IERR)
C
C	OPEN STUDY FOR DATA EXTRACTION
C
	CALL CRTFIL(STUDY,ILKIN,ISTUDY,1)
	ITP = 0
	CALL READW(256,ICNT,ITP,ISTUDY)
	CALL FGADM1(ICNT,IP,B)
	MDOFF = IP(6)
	NFRMS = IP(11)
	NBKFRM = 2**IP(12)
	NWDRD = NBKFRM*256
C	TYPE *,'WORDS IN STUDY',NWDRD,NFRMS,MDOFF
	NBLKS = MDOFF + 16*NFRMS	!NUMBER BLOCKS FOR 64*64 WORD
C
C	LOOKUP / CREATE  PROCES.X00
C
	INEW = IGETC()
	ILKOUT = LOOKUP(INEW,NEWSTD)		!GET LENGTH OF FILE
	IF (ILKOUT.EQ.NBLKS) GOTO 15		!PROCES.X00 FOUND
	CALL CLOSEC(INEW)
	CALL IFREEC(INEW)
	CALL IGETC(INEW)
C
C	CREATE PROCES.X00
C
	CALL CRTFIL(NEWSTD,NBLKS,INEW,-1)
15	ITP = MDOFF
	DO 5 I = 1,NFRMS
D	WRITE(7,400)ITP,I,NFRMS
400	FORMAT(6I6)
	CURVE(I) = 0.
	CALL READW(NWDRD,IDATA,ITP,ISTUDY)
	IF (NWDS.EQ.4096) GOTO 4
	DO 7 L = 1,4096
7	CURVE(I) = CURVE(I) + IBYTE(IDATAB(L))
	GOTO 5
4	DO 6 L = 1,4096
	CURVE(I) = CURVE(I) + IDATA(L)
6	CONTINUE
D	WRITE(7,300)CURVE(I)
5	CONTINUE
300	FORMAT(' DATA',F20.10)
	CALL READW(256,ICNT2,0,ISAVE0)
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,17)
17	FORMAT(' USE MR FOUR - AUTOMATIC FAILED',//)
	CALL GAMCA(IDATA,9)
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	CALL SAVOP(1,ISAVE1,IDATA,IERR)
	DO 33 I = 1,4
33	IDATA(I) = NEWSTD(I)
	ITP = 0
	CALL WRITW(256,IDATA,ITP,ISAVE1)
	CALL WRITW(256,CURVE,5,ISAVE1)
	N1=MDOFF
C
C	NOTE MAX OF 60 WORDS CAN BE TRANSMITTED BY CHAIN
C	BUT PROBLEMS WERE EXPERIENCED WITH RPAH FGAMMA
C	SO ONLY 13 WORDS TRANSMITTED NOW INSTEAD OF 58
C
C
	CALL CHAIN(HRTSMA,ISAVE0,13)
	END