PROGRAM HRTSMH
C	WRITTEN BY G. GUELFI 25-FEB-83
C
C
C
C	PROGRAM HRTSMH PERFORMS DROPOFF CORRECTION TO ORIGINAL DATA
C
C	PROGRAM HRTSMH 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
	INTEGER*2 FILE(4),IBUFF(4096),ADMN(256),IP(75)
	DIMENSION CURVE(32),B(3,42)
	LOGICAL*1 TITLE(12),ADMNB(512),IBUFFB(4096)
	EQUIVALENCE (ADMN,ADMNB),(IBUFF,IBUFFB,B)
	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	11 TRANSMITTED . CURVE EXTRACTED FROM SVAR01 .
C
	CALL CNTXSW
	CALL RCHAIN(ICHAIN,ICH1,11)
	CALL READW(64,CURVE,1,ICHC)
C
C	READ ADMN BLOCK
C
	CALL READW(256,ADMN,ITP,N1)
	CALL FGADM1(ADMN,IP,B)
	NBKFRM = 2**IP(12)
	NMDWDS = NBKFRM*256
	TYPE *,NMDWDS,NBKFRM,IP(11),IP(12)
C
C	SMOOTH DATA
C
	N2=N1
	DO 20 N=1,NFRMS
C	WRITE(7,200)N,CURVE(N),CURVE(LFRAME),LFRAME
200	FORMAT(I6,2F20.6,I6)
	CALL READW(NMDWDS,IBUFF,N1,ICH2)
	IF (MOD(IP(12),2).EQ.0) GOTO 19
	TYPE *,'EXP DATA'
	DO 18 I = 4096,1,-1
18	IBUFF(I) = IBYTE(IBUFFB(I))
19	IF (N.LE.LFRAME) GOTO 22
	FACTOR = CURVE(LFRAME)/CURVE(N)
	SUM = 0.
	DO 21 I = 1,4096
21	IBUFF(I) = INT(FACTOR*FLOAT(IBUFF(I)))
22	CALL S9PT(IBUFF,64,MAXVAL)
	GOTO 20
C
C
C	IF (MOD(IP(12),2).EQ.0) GOTO 20
	TYPE *,'EXPANDING'
	DO 23 I = 1,4096
23	IBUFFB(I) = LBYTE(IBUFF(I))
D	SUM= 0.
D	DO 31 I = 1,4096
D31	SUM= SUM + IBUFF(I)
D	WRITE(7,300)SUM
20	CALL WRITW(4096,IBUFF,N2,ICH)
C
C	CHANGE TITLE PROCES.X00
	N2 = 0
	CALL READW(256,ADMN,N2,ICH)
	CALL HDCHG(ADMN,TITLE)
	IF (MOD(IP(12),2).EQ.0) GOTO 24
	TYPE *,'FLAG BYT/WRD'
C
C	FLAG WORD STATUS FOR NEW STUDY
C
	ADMN(98) = N1 + 16*NFRMS
	ADMNB(239) = ADMNB(239) + 1
24	N2 = 0
	CALL WRITW(256,ADMN,N2,ICH)
	CALL FIXSVH(ICH1,ICH,FILE,TITLE,IBUFF,ADMN,ADMNB,4096)
C
C	CLOSE ALL CHANNELS
C
	DO 25 J = 1,10
	I = J - 1
	CALL CLOSEC(I)
25	CALL IFREEC(I)
	CALL GAMCA(IBUFF,-1)
	END