C----------------------------------------------------------------------- C This subroutine either :-- C 1. for RS, finds the direct cell by reindexing 3 reflections; C 2. for CH, chooses reflections from the PK list to use with M2 or M3. C----------------------------------------------------------------------- SUBROUTINE REINDX INCLUDE 'COMDIF' DIMENSION IOLD(3,3),INEW(3,3),INDICS(3) DIMENSION THETAS(NSIZE),OMEGAS(NSIZE),CHIS(NSIZE),PHIS(NSIZE) EQUIVALENCE (ACOUNT( 1),THETAS(1)), $ (ACOUNT( NSIZE*1),OMEGAS(1)), $ (ACOUNT(2*NSIZE+1),CHIS(1)), $ (ACOUNT(3*NSIZE+1),PHIS(1)) IF (KI .EQ. 'RS') THEN WRITE (COUT,10000) CALL YESNO ('Y',ANS) IF (ANS .EQ. 'Y') THEN DO 110 I = 1,3 100 WRITE (COUT,11000) I CALL FREEFM (ITR) IOLD(I,1) = IFREE(1) IOLD(I,2) = IFREE(2) IOLD(I,3) = IFREE(3) INEW(I,1) = IFREE(4) INEW(I,2) = IFREE(5) INEW(I,3) = IFREE(6) NN = -1 ISTAN = 0 IH = IOLD(I,1) IK = IOLD(I,2) IL = IOLD(I,3) IF ((IH .EQ. 0 .AND. IK .EQ. 0 .AND. IL .EQ. 0) .OR. $ (INEW(I,1) .EQ. 0 .AND. INEW(I,2) .EQ. 0 .AND. $ INEW(I,3) .EQ. 0)) THEN WRITE (COUT,11100) CALL GWRITE (ITP,' ') GO TO 100 ENDIF IPRVAL = 1 CALL ANGCAL IF (IVALID .NE. 0) THEN WRITE (COUT,12000) CALL YESNO ('Y',ANS) IF (ANS .EQ. 'N') GO TO 100 ENDIF WRITE (COUT,13000) $ (IOLD(I,KK),KK = 1,3),THETA,OMEGA,CHI,PHI, $ (INEW(I,KK),KK = 1,3) CALL GWRITE (ITP,' ') IHK(I) = INEW(I,1) NREFB(I) = INEW(I,2) ILA(I) = INEW(I,3) BCOUNT(I) = THETA BBGR1(I) = OMEGA BBGR2(I) = CHI BTIME(I) = PHI 110 CONTINUE CALL ORMAT3 ENDIF C----------------------------------------------------------------------- C Choose PK reflections for M2 or M3 C----------------------------------------------------------------------- ELSE IF (KI .EQ. 'CH') THEN WRITE (COUT,14000) CALL YESNO ('Y',ANS) IF (ANS .EQ. 'Y') THEN WRITE (COUT,15000) CALL GWRITE (ITP,' ') C----------------------------------------------------------------------- C Bring in the peaks from PK C----------------------------------------------------------------------- READ (ISD, REC=140) NGOOD CALL ANGRW (0,4,NGOOD,140,0) DO 120 I = 1,3 WRITE (COUT,16000) I CALL FREEFM (ITR) IOC = IFREE(1) INDICS(1) = IFREE(2) INDICS(2) = IFREE(3) INDICS(3) = IFREE(4) IF (IOC .EQ. 0) THEN KI = ' ' RETURN ENDIF IHK(I) = INDICS(1) NREFB(I) = INDICS(2) ILA(I) = INDICS(3) BCOUNT(I) = THETAS(IOC) BBGR1(I) = OMEGAS(IOC) BBGR2(I) = CHIS(IOC) BTIME(I) = PHIS(IOC) 120 CONTINUE ENDIF ENDIF KI = ' ' RETURN 10000 FORMAT (' Reindex 3 Reflections (Y) ? ',$) 11000 FORMAT (' Reflection',I3,'. Type OLD indices then NEW indices ',$) 11100 FORMAT (' 0,0,0 indices not allowed. Try again.') 12000 FORMAT (' The OLD indices are Invalid. Use them anyway (Y) ? ',$) 13000 FORMAT (2X,3I3,4F8.2,' New indices ',3I3) 14000 FORMAT (' Choose reflections from OC for M2 or M3 (Y) ? ',$) 15000 FORMAT (' Sequence number in OC and indices') 16000 FORMAT (' Reflection ',I1,' ',$) END