C
C
C
	SUBROUTINE PBCRT(MAT,CMAT,BMAT,ADMIN,RADMIN,NAME,NFR,N1)
	VIRTUAL MAT(64,64),CMAT(64,64)
	LOGICAL*1 CMAT,BMAT(64,64),ADMIN(512),RADMIN(500),NAME(14),NUM
	NBLK = NFR*4 + 1
	NAME(3) = '1'
	NAME(9) = 'R'
	NAME(10) = 'T'
	NUM = '1'
C
C	COMPILE WITH /D IF YOU REQUIRE CHOICE
C	OF DISK TO STORE PBACK BUFFERS
C
D	WRITE(7,905)NBLK
D905	FORMAT(//'$WHICH DISC UNIT FOR PB BUFFER (',I4,' BLOCKS))?   ')
D	READ(5,906)NAME(3)
D906	FORMAT(A1)
D907	WRITE(7,910)
D910	FORMAT(//,'$ENTER STUDY TYPE-RT,HG OR CP 
D	1AND NO.(1 TO 4 TO CREATE P1 - P4 FOR MR JOIN)  ')
D	READ(5,911)NAME(9),NAME(10),NUM,NUM
D911	FORMAT(4A1)
D	IF (NUM.LE.'0'.OR.NUM.GT.'4') GOTO 907
	NAME(12)='G'
	NAME(13)='P'
	NAME(14)='B'
	WRITE(7,210)(NAME(I),I=5,10),NAME(3),NUM
210	FORMAT(//,' TO PLAYBACK PHASE IMAGE BUFFER TYPE - PB '
	1,6A1,',',A1,' OR P',A1,//)
	CALL ASSIGN(2,NAME,14,'NEW','NC')
	DEFINE FILE 2(NBLK,256,U,N2)
C
C	SET UP FOR P?.GPB
C
	NAME(3) = '0'
	NAME(5) = 'P'
	NAME(6) = NUM
	NAME(7) = ' '
	NAME(8) = ' '
	NAME(9) = ' '
	NAME(10) = ' '
	CALL ASSIGN(3,NAME,14,'NEW','NC')
	DEFINE FILE 3(NBLK,256,U,N3)
C	NFR=24	!EXTRACTED FROM SVAR06
	N=1
	N2=1
	N3 = 1
	L1="54
	L2="20
	K=124
	DO 77 I=1,24
	IF(ADMIN(I).EQ.0)GO TO 78
	RADMIN(K)=ADMIN(I)
	K=K+1
77	CONTINUE
78	RADMIN(K-1)="054
	RADMIN(K)="040
	J=K+1
	DO 79 I=54,62
	RADMIN(J)=ADMIN(I)
	J=J+1
79	CONTINUE
	RADMIN(J-1)="054
	RADMIN(J)="040
	WRITE(2'N2)NFR,N,RADMIN
	WRITE(3'N3)NFR,N,RADMIN
	WRITE(7,303)
303	FORMAT(//' PROCESSING-PLEASE WAIT  -  APPROX 2 MIN'/)
C	reread phase image data from SA
	N1=2
	DO 920 I=1,64,4
920	READ(1'N1)((MAT(K,J),J=1,64),K=I,I+3)
	CALL CLOSE(1)
C	set all pixels in phase image to same value
	ICT = 0
	DO 30 I=1,64
        DO 30 J=1,64
	IF(MAT(I,J).EQ.0)GO TO 29
	BMAT(I,J)=2
	ICT = ICT + 1
	GO TO 30
29	BMAT(I,J)=0
30	CONTINUE
	RNFR = NFR
	DO 300 LZ=1,NFR
	DO 100 I=1,64
	DO 100 J=1,64
	IF(MAT(I,J).EQ.0)GO TO 100 
	IPH=INT(1.+(RNFR*FLOAT(MAT(I,J)-1.)/6283.))
	IF(IPH.NE.LZ)GO TO 100
	BMAT(I,J)=7
100	CONTINUE
	K=65
	DO 95 I=1,64
	K=K-1
	DO 95 J=1,64
	CMAT(J,I)=BMAT(K,J)
95	CONTINUE
	DO 94 I = 1,64
	DO 94 J = 1,64
94	BMAT(I,J) = CMAT(I,J)
	N = 2048
	CALL PACK(BMAT,BMAT,N)
	DO 200 I = 1,32,8
	WRITE(2'N2)((BMAT(K,J),K=1,64),J=I,I+7)
200	WRITE(3'N3)((BMAT(K,J),K=1,64),J=I,I+7)
C
C reset pixels in amp image
C
	DO 250 I=1,64
	DO 250 J=1,64
	IF(MAT(I,J).EQ.0)GO TO 249
	BMAT(I,J)=2
	GO TO 250
249	BMAT(I,J)=0
250	CONTINUE
300	CONTINUE
	CALL CLOSE(2)
	CALL CLOSE(3)
	RETURN
	END
