106 lines
3.7 KiB
Fortran
106 lines
3.7 KiB
Fortran
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
|