      SUBROUTINE ASSIGN
      include 'param.inc'
      COMMON/REFLS/IREFS(IRS),REFS(IRS,8),MLT(IRS),IC(NUPH)
      COMMON/PARAMS/GLB(16),AGLB(16),LGLB(16),PAR(NUPH,20),
     *APAR(NUPH,20),LPAR(NUPH,20),XL(NATS,11),LP(NATS,11),A(NATS,11),
     *PTR(NATS),RELAX(4),RATIO(2)
      CHARACTER*4 ATEXT(NATS),NTYP(NATS)
      COMMON/PARAC/ATEXT,NTYP
      COMMON/G1/THMIN,STEP,THMAX,U,V,W,LAMDA(2),TMV,CTHM,RLIM,SB,WDT,
     *UU,VV,WW,SYNPOL
      COMMON/CNTRLS/JOBTYP,NPROF,NPHASE,IOT,IPL,IPC,MAT,NXT,LST1,LST2,
     *LST3,IPL1,IPL2,MCYCLE,EPS,MAXS,IFOUR,NFMT
      COMMON/JNK/ALOW(30),AHIGH(30),POS(30),BCK(30),
     *NATOM(NUPH),PREF(NUPH,3),NBCKGD,NEXCRG,NSCAT,IWT
      CHARACTER SYMB(NUPH,20)*1
      CHARACTER TITLE*80,PHSNM(NUPH)*80
      COMMON/CHAR/SYMB,TITLE,PHSNM
      COMMON/DATAX/Y(IDSZ),YC(IDSZ),KR(IDSZ),BK(IDSZ),NPTS,WT(IDSZ)
      DIMENSION KRR(2,IDSZ),ICN(NUPH)
C     CODE FOR REFLECTIONS BEYOND OBS PATTERN
      NNPTS=NPTS
      NPTS=(THMAX-THMIN)/STEP + 1.5
      NXPTS=NPTS-NNPTS
      DO 100 I=1,NXPTS
      Y(NNPTS+I)=1.0
      BK(NNPTS+I)=1.0
  100 CONTINUE
C     END CODE
      ICX=0
      DO 101 I=1,NPHASE
      ICX=ICX+IC(I)
      ICN(I)=IC(I)
  101 IC(I)=0
      IC(1)=ICX
      IF (NPHASE.GT.1) CALL SORT(1)
      DO 102 I=1,NPHASE
  102 IC(I)=ICN(I)
      DO 2 J=1,2
      DO 2 K=1,IDSZ
   2  KRR(J,K)=0
      IF(LST3.EQ.0)GOTO 7
      DO 8 I=1,ICX
      IRL=MOD(IREFS(I),256)-128
      IRK=MOD(IREFS(I)/256,256)-128
      IRH=MOD(IREFS(I)/256/256,256)-128
      IRC=MOD(IREFS(I)/256/256/256,4)
      IPHAS=IREFS(I)/256/256/256/4
      IF(MOD(I-1,50).EQ.0)WRITE(16,9)
    8 WRITE(16,10)I,IRC,IRH,IRK,IRL,IPHAS,(REFS(I,JX),JX=1,2)
    9 FORMAT(1H ,10X,23H MERGED REFLECTION LIST ,//,
     *45H NO.  CODE     H   K   L   PHASE  HW    POSN  /)
   10 FORMAT(1X,2I4,3X,3I4,I6,2F8.3)
    7 DO 479 I=1,ICX
      RMIN=REFS(I,2)-WDT*REFS(I,1)
      RMAX=REFS(I,2)+WDT*REFS(I,1)
      MIN=(RMIN-THMIN)/STEP+1.5
      MAX=(RMAX-THMIN)/STEP+1.5
      MIN=MAX0(MIN,1)
      MIN=MIN0(MIN,NPTS)
      MAX=MIN0(MAX,NPTS)
      DO 479 K=MIN,MAX
      KRR(2,K)=I
 479  IF(KRR(1,K).EQ.0)KRR(1,K)=I
      DO 482 J=1,NEXCRG
      IF(AHIGH(J).LE.THMIN) GOTO 482
      IN1=(ALOW(J)-THMIN)/STEP+1.5
      IN1=MAX0(IN1,1)
      IN2=(AHIGH(J)-THMIN)/STEP+1.5
      IN2=MIN0(IN2,NPTS)
      DO 483 I=IN1,IN2
      KRR(2,I)=1
 483  KRR(1,I)=0
      IF(IN2.EQ.NPTS) GOTO 484
 482  CONTINUE
  484 CONTINUE
      IF(JOBTYP.EQ.3.OR.JOBTYP.EQ.4) GO TO 301
      DO 300 J=1,NPTS
      IF(Y(J).EQ.0.0) Y(J)=BK(J)/2.0
      IF(WT(J).EQ.0.0) WT(J)=1.0
      IF(NBCKGD.EQ.1) GO TO 200
      WT(J)=WT(J)/Y(J)
      GO TO 201
  200 WT(J)=WT(J)/(Y(J)+BK(J))
  201 CONTINUE
  300 CONTINUE
  301 CONTINUE
      IF(LST2.EQ.0)GOTO 530
      WRITE(16,589)THMIN,THMAX,STEP
 589  FORMAT(13H PATTERN FROM,F8.4,1X,2HTO,F9.4,1X,11HIN STEPS OF,
     *F8.4,1X,7HDEGREES)
      WRITE(16,544)
 544  FORMAT(6H  POSN,6X,3HI+B,5X,1HB,7X,1HI,4X,5H100*W,3X,3HK11,2X,
     *3HK21)
      DO 520 J=1,NPTS
      PX=THMIN+FLOAT(J-1)*STEP
      YUN=Y(J)-BK(J)
      WRITE(16,559)PX,Y(J),BK(J),YUN,WT(J),(KRR(J2,J),J2=1,2)
 559  FORMAT(1X,F8.4,3F7.0,2PF9.4,2I5)
  520 CONTINUE
 530  CONTINUE
      DO 600 I=1,NPTS
      IF(KRR(2,I)-KRR(1,I).GT.NIPOI)THEN
       WRITE(16,601)
       WRITE(7,601)
  601 FORMAT(1X,'EXCESSIVE PEAK OVERLAP')
       STOP 'EXCESSIVE PEAK OVERLAP'
      ENDIF
  600 CONTINUE
      DO 531 I=1,NPTS
      KR(I)=KRR(1,I)+IRS*KRR(2,I)
 531  CONTINUE
      DO 602 I=1,NPTS
      IF(KR(I).NE.0.AND.KR(I).NE.IRS)GOTO 603
  602 CONTINUE
      STOP 'NO REFLECTIONS FOUND '
C THE FOLLOWING TEST IS REALLY ONLY VALID FOR THE SINGLE PHASE CASE
  603 IF(REFS(KRR(1,I),2).GE.RLIM.AND.LPAR(1,14).NE.0
     *     .AND.NPROF.LT.4) THEN
       WRITE(16,604)
       WRITE(7,604)
  604 FORMAT(1X,'ASYMMETRY PARAMETER USAGE INVALID')
       STOP 'ASYMMETRY PARAMETER USAGE INVALID'
      ENDIF
      DO 606 I=1,NPHASE
      IF(PAR(I,12).EQ.0..AND.PAR(I,13).EQ.0..AND.LPAR(I,13).NE.0)THEN
       WRITE(16,605)
       WRITE(7,605)
  605 FORMAT(1X,'PREFERRED ORIENTATION USAGE INVALID')
       STOP 'PREFERRED ORIENTATION USAGE INVALID'
      ENDIF
  606 CONTINUE
      RETURN
      END
