PROGRAM HRTSMA
C	WRITTEN BY G. GUELFI 25-FEB-83
C
C
C
C	PROGRAM HRTSMA PERFORMS DROPOFF CORRECTION TO ORIGINAL DATA
C
C	PROGRAM HRTSMA THEN PERFORMS 9-POINT WEIGHTED SMOOTHING ON 64X64
C	WORD MODE IMAGES. THE OUTPUT FILE IS WRITTEN TO PROCES.X00, WHICH
C	CAN ALSO BE INPUT. THE WEIGHTS HAVE THE FOLLOWING POSITIONS
C	IN THE 3X3 SMOOTHING SUBARRAY:
C		 1    2    1
C		 2    4    2
C		 1    2    1
C
C
C
C	COMMON PARAMETERS
C
C	ICH1	 SVAR00
C	ICH2	 ORIGINAL DATA
C	ICH	 OUTPUT FILE
C	FILE	OUTPUT FILE NAME
C	N1	STARTING BLOCK FOR ORIGINAL DATA
C	NFRMS	NUMBER OF FRAMES
C	LFRAME	LAST FRAME BEFORE DROPOFF CORRECTION OCCURS
C	CURVE	TOTAL COUNTS OF FRAMES
C
	COMMON /MAIN/ICH1,ICHC,ICH2,ICH,FILE,N1,NFRMS,LFRAME
	1,NWDS,NBLKS
	VIRTUAL VGAMMA(4096)
	INTEGER*2 FILE(4),IBUFF(4096),ADMN(256),IP(75),VGAMMA
	DIMENSION CURVE(32),B(3,42)
	LOGICAL*1 TITLE(12),BIQ(512),IBUFFB(4096),ADMNB(512)
	REAL*8 GAMMAM
	EQUIVALENCE (IBUFF,IBUFFB,B),(ADMN,ADMNB)
	DATA GAMMAM/12RSY0GAMMAMSYS/
	DATA TITLE/'P','H','A','S','E',' ','D','P','-','S','M','H'/
C
C	READ IN STORED PARAMETERS
C	N.B. ONLY 60 WORDS CAN BE TRANSMITTED BY RCHAIN IE TO CURVE(25)
C	CURVE(20) WAS ZEROED WHEN 58 WORDS TRANSMITTED NOW ONLY 
C	13 TRANSMITTED . CURVE EXTRACTED FROM SVAR01 .
C
	CALL CNTXSW
	CALL RCHAIN(ICHAIN,ICH1,13)
	CALL READW(64,CURVE,5,ICHC)
	CALL CRTFIL(GAMMAM,-1,IGAMMM,1)		!IGNORE -1 ERROR FOR LOOKUP
	CALL VREADW(VGAMMA,IBUFF,4096,4096,IGAMMM,0)
	CLAST = CURVE(LFRAME)
C
C	READ ADMN DATA
C
	ITP = 0
	CALL READW(256,ADMN,ITP,ICH2)
	CALL FGADM1(ADMN,IP,B)
	N2=N1
C	WRITE(7,3000)N2,LFRAME,NFRMS
3000	FORMAT(6I6)
	DO 20 N=1,NFRMS
C	WRITE(7,200)N,CURVE(N),CURVE(LFRAME),LFRAME
200	FORMAT(I6,2F20.6,I6)
	CALL READW(NWDS,IBUFF,N1,ICH2)
	IF (MOD(IP(12),2).EQ.0) GOTO 19
	DO 18 I = 4096,1,-1
18	IBUFF(I) = IBYTE(IBUFFB(I))
19	IF (N.LE.LFRAME) GOTO 22
	FACTOR = CLAST/CURVE(N)
	SUM = 0.
	DO 21 I = 1,4096
21	IBUFF(I) = INT(FACTOR*FLOAT(IBUFF(I)))
22	CALL S9PT(IBUFF,64,MAXVAL)
	SUM= 0.
	IC = 0
	ITP = 0
C	CALL READW(4096,IBUFF,ITP,IGAMMM)
	DO 31 I = 1,4096
	IGAMM = VGAMMA(I)
	IF (IGAMM.AND."2) SUM= SUM + IBUFF(I)
	IF (IGAMM.AND."2) IC = IC + 1
31	CONTINUE
	CURVE(N) = SUM
C	WRITE(7,300)SUM,CURVE(N),IC
300	FORMAT(' ',2F20.0,I6)
20	CALL WRITW(4096,IBUFF,N2,ICH)
C
C	CHANGE TITLE PROCES.X00
C
	N2 = 0
	CALL READW(256,IBUFF,N2,ICH)
	CALL HDCHG(IBUFF,TITLE)
C
C	FLAG WORD STATUS FOR NEW STUDY
C
	IF (MOD(IP(12),2).EQ.0) GOTO 24
	ADMN(98) = NBLKS
	ADMNB(239) = ADMNB(239) + 1
24	N2 = 0
	CALL WRITW(256,ADMN,N2,ICH)
	CALL FIXSVH(ICH1,ICH,FILE,TITLE,IBUFF,ADMN,ADMNB,4096)
	CALL SAVOP(6,ISAVE6,BIQ,IERR)
	ITP = 0
	CALL READW(256,IBUFF,ITP,ICHC)
	ITP = 0
	CALL WRITW(256,IBUFF,ITP,ISAVE6)
	ITP = 5
	CALL WRITW(NFRMS*2,CURVE,ITP,ISAVE6)
C
C	CLOSE ALL CHANNELS
C
	DO 25 J = 1,14
	I = J - 1
	CALL CLOSEC(I)
25	CALL IFREEC(I)
	TYPE *,'RET TO BGAMMA'
	NLINE = -1
	CALL GAMCA(IBUFF,NLINE)
	END