PROGRAM PHASEM
C	PROGRAM TO THRESHOLD AMP IMAGE,MASK PHASE IMAGE &
C	DERIVE PHASE HISTOGRAM
C	PROCESSED IMAGES ARE STORED IN A MULTIPLE STATIC
C	FILE WITH PATIENT NAME.X10
	LOGICAL*1 LADMIN(512),ADMIN(512),NAME(14),BMAT,L1,L2
	LOGICAL*1 CMAT,HEAD(29),M1(14),M2(14),M3(14),LG(35)
	LOGICAL*1 TITLE(6),STITLE(12)
	INTEGER*2 SADMIN(256),P(75),MATA,MAT,IMN,IMX,NEWSTY(4)
	INTEGER*2 CU1(64),CMAX,CU9,SKR,SKL,OUTF(4),SA0(4)
	VIRTUAL BMAT(64,64),CMAT(64,64),MATA(64,64),MAT(64,64)
	REAL*4 B(3,42)
	LOGICAL*1 RADMIN(148)
	EQUIVALENCE(LADMIN,SADMIN)
	EQUIVALENCE(OUTF,SADMIN(250))
	DATA CA/'CA  '/
	DATA VIEW1/'AMPL'/
	DATA VIEW2/'PHSE'/
	DATA VIEW3/'HIST'/
	DATA SA0/3RSVA,3RSVA,3RR00,3RSYS/
	DATA HEAD/'P','H','A','S','E',' ','D','I','S','T','R','I','B',
	1'U','T','I','O','N',' ','P','A','R','A','M','E','T','E','R','S'/
	DATA M1/'F','W','H','M','=',' ',' ',' ',' ',' ',' ',' ',' ','%'/
	DATA M2/'R','I','G','H','T',' ','S','K','E','W','=',' ',' ','%'/
	DATA M3/'L','E','F','T',' ',' ','S','K','E','W','=',' ',' ','%'/
	DATA TITLE/'P','H','A','S','E','M'/
	DATA STITLE/'P','H','A','S','E',' ','S','T','A','T','I','C'/
c read SA0 for filename
	CALL CNTXSW
	CALL GAMSTP(LADMIN,TITLE)
	L1='1'
	L2='5'
	CALL READSA(L1,L2,LADMIN,MAT)
	CALL R50ASC(3,SADMIN(250),NAME(1))
	CALL R50ASC(3,SADMIN(251),NAME(5))
	CALL R50ASC(3,SADMIN(252),NAME(8))
	CALL R50ASC(3,SADMIN(253),NAME(12))
	NAME(4) = ':'
	NAME(11) = '.'
C	WRITE(7,299)(NAME(I),I=1,14)
C read SA12, amplitude image
	L1='1'
	L2='2'
	CALL READSA(L1,L2,LADMIN,MAT)
	LT=IBYTE(LADMIN(165))
C find max & min cell count
	IMX=0
	IMN=32000
	DO 31 I=1,64
	DO 31,J=1,64
	IF(MAT(I,J).GT.IMX)IMX=MAT(I,J)
	IF(MAT(I,J).LT.IMN.AND.MAT(I,J).GT.0)IMN=MAT(I,J)
31	CONTINUE
24	FORMAT(1X,I5)
	LTN=IMN+IFIX(FLOAT(IMX-IMN)*FLOAT(LT/100.))-1
C zero all pixels below LT
	DO 50 I=1,64
	DO 50 J=1,64
	IF(MAT(I,J).LE.LTN)MAT(I,J)=0
50	CONTINUE
	NAME(4)=':'
	NAME(11)='.'
C read patient file associated with SA
	CALL ASSIGN(1,NAME,14,'OLD','NC')
	DEFINE FILE 1(1000,256,U,N1)
	N1=1
	READ(1'N1)ADMIN
C convert to Fortran format
	CALL FGADM1(ADMIN,P,B)
C change admin parms for new file
	B(1,10)=VIEW1
	P(14)=4
	P(20)=3
	P(1)=3
	P(2)=1
	P(3)=52
	P(4)=0
	P(5)=0
	P(6)=2
	P(7)=0
	P(8)=18
	P(9)=3
	P(13)=1
	P(21)=1
	CALL FGADM2(ADMIN,P,B)
	CALL CSTAT(2,1,ISTUDY,ICNEW,MDOFF,3,STITLE,NEWSTY)
C
C	CLOSE CHANNELS
C
	CALL CLOSEC(ISTUDY)
	CALL IFREEC(ISTUDY)
	CALL CLOSEC(ICNEW)
	CALL IFREEC(ICNEW)
	CALL R50ASC(3,NEWSTY(1),NAME(1))
	CALL R50ASC(3,NEWSTY(2),NAME(5))
	CALL R50ASC(3,NEWSTY(3),NAME(8))
	CALL R50ASC(3,NEWSTY(4),NAME(12))
	NAME(4) = ':'
	NAME(11) ='.'
C	WRITE(7,299)(NAME(I),I=1,14)
C	NAME(13)='1'
C
C	IF GAMMA DISK GE 3 THEN MAKE 1
C
	IF (NAME(3).GE.'3') NAME(3) = '1'
C open new patient file for static images
C
C	COMPILE WITH /D IF CHOICE OF DISK REQUIRED
C
D	WRITE(7,900)
D900	FORMAT(2X,'WHICH DISC UNIT FOR STATIC FILE (52 BLOCKS)?')
D	READ(5,901)NAME(3)
901	FORMAT(A1)
	CALL ASSIGN(2,NAME,14,'NEW','NC')
	DEFINE FILE 2(52,256,U,N2)
	CALL HDCHG(ADMIN,STITLE)
	N2=1
	WRITE(2'N2)ADMIN
	N2=N2+1
	DO 210 I=1,64,4
210	WRITE(2'N2)((MAT(K,J),J=1,64),K=I,I+3)
	CALL CLOSE(1)
C copy MAT to MATA
	DO 80 I=1,64
	DO 80 J=1,64
	MATA(I,J)=MAT(I,J)
80	CONTINUE
C read SA13 phase image
	L2='3'
	CALL READSA(L1,L2,ADMIN,MAT)
	DO 90 I=1,64
	DO 90 J=1,64
	IF(MATA(I,J).EQ.0)MAT(I,J)=0
90	CONTINUE
C change admin parms for frame 2
	B(1,10)=VIEW2
	P(2)=-17
	P(4)=-18
	P(6)=1
	P(7)=-18
	P(8)=17
	P(21)=2
	CALL FGADM2(ADMIN,P,B)
	CALL HDCHG(ADMIN,STITLE)
C write frame 2
	WRITE(2'N2)ADMIN
	DO 230 I=1,64,4
230	WRITE(2'N2)((MAT(K,J),J=1,64),K=I,I+3)
	N2 = 1
	READ(2'N2)ADMIN
	CALL FGADM1(ADMIN,P,B)
	B(1,10)=VIEW3
	P(1)= 3
	P(2)=-34
	P(3)=52
	P(4)=-35
	P(5)=0
	P(6)=1
	P(7)=-17
	P(8)=17
	P(9)=3
	P(13)=1
	P(21)=3
	CALL FGADM2(ADMIN,P,B)
	N2 = 36
	WRITE(2'N2)ADMIN
	DO 232 I=1,64,4
232	WRITE(2'N2)((MAT(K,J),J=1,64),K=I,I+3)
	CALL CLOSE(1)
	CALL CLOSE(2)
	NAME(1)='S'
	NAME(2)='Y'
	CALL IRAD50(3,NAME(1),OUTF(1))
	CALL IRAD50(3,NAME(5),OUTF(2))
	CALL IRAD50(3,NAME(8),OUTF(3))
	CALL IRAD50(3,NAME(12),OUTF(4))
C	WRITE(7,299)(NAME(I),I=1,14)
299	FORMAT(' NAME FROM PHASEM',14A1)
	I=IFETCH(OUTF)
	IF(I.GT.0)STOP'ERROR FETCHING HANDLER'
	CALL FIXFRM(SA0,OUTF)
	CALL GAMCA(LADMIN,-1)
	END
C
C
	SUBROUTINE READSA(N1,N2,ADMIN,MAT)
	LOGICAL*1 N1,N2,NAME(14)
	INTEGER*2 ADMIN(256),IMN,IMX
	VIRTUAL MAT(64,64)
	DATA NAME/'S','V','A',':','S','V','A','R','0','0','.','S','Y','S'/
	NAME(9)=N1
	NAME(10)=N2
	CALL ASSIGN(1,NAME,14,'OLD','NC')
	DEFINE FILE 1(33,256,U,N)
	N=1
	READ(1'N)ADMIN
	DO 20 I=1,64,4
20	READ(1'N)((MAT(K,J),J=1,64),K=I,I+3)
	CALL CLOSE(1)
	RETURN
	END