196 lines
6.7 KiB
Fortran
196 lines
6.7 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C dimensional grid of points.
|
|
C The grid is specified by from 1 to 3 start & end angles,
|
|
C 2Theta, Omega & Chi and the step size in each.
|
|
C If the step size for any angle is zero that angle is not varied.
|
|
C The counting-time/step is also needed.
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE GRID
|
|
INCLUDE 'COMDIF'
|
|
CHARACTER ANGLES(3)*8
|
|
DIMENSION ANG(3),ANSTRT(3),ANSTOP(3),ANSTEP(3),NNN(3),ICOUNT(500)
|
|
EQUIVALENCE (ACOUNT(1),ICOUNT(1))
|
|
DATA ANGLES/'2THETA ',' OMEGA ',' CHI '/
|
|
NATT = 0
|
|
C-----------------------------------------------------------------------
|
|
C Verify command GD and then read grid specifications
|
|
C-----------------------------------------------------------------------
|
|
WRITE (COUT,10000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') THEN
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
WRITE (COUT,12000)
|
|
CALL GWRITE (ITP,' ')
|
|
DO 100 I = 1,3
|
|
WRITE (COUT,13000) ANGLES(I)
|
|
CALL FREEFM (ITR)
|
|
ANSTRT(I) = RFREE(1)
|
|
ANSTOP(I) = RFREE(2)
|
|
CALL MOD360 (ANSTRT(I))
|
|
CALL MOD360 (ANSTOP(I))
|
|
ANSTEP(I) = RFREE(3)
|
|
ANSTEP(I) = ANSTEP(I)
|
|
100 CONTINUE
|
|
WRITE (COUT,15000)
|
|
CALL FREEFM (ITR)
|
|
TIMSTP = RFREE(1)
|
|
IF (TIMSTP .EQ. 0) TIMSTP = 100.0
|
|
C-----------------------------------------------------------------------
|
|
C Work out the heading
|
|
C-----------------------------------------------------------------------
|
|
CALL ANGET (THETA,OMEGA,CHI,PHI)
|
|
ANG(1) = THETA
|
|
ANG(2) = OMEGA
|
|
ANG(3) = CHI
|
|
OMOFF = 0.0
|
|
DO 110 I = 1,3
|
|
IF (ANSTEP(I) .EQ. 0) THEN
|
|
ANSTRT(I) = ANG(I)
|
|
ANSTOP(I) = ANG(I)
|
|
NNN(I) = 0
|
|
ELSE
|
|
DEL1 = ANSTOP(I) - ANSTRT(I)
|
|
IF (DEL1 .GT. 0.0) THEN
|
|
DEL2 = DEL1 - 360.0
|
|
ELSE
|
|
DEL2 = DEL1 + 360.0
|
|
ENDIF
|
|
IF (ABS(DEL2) .LT. ABS(DEL1)) DEL1 = DEL2
|
|
IF (DEL1 .LT. 0.0) ANSTEP(I) = -ABS(ANSTEP(I))
|
|
NNN(I) = DEL1/ANSTEP(I) + 1.5
|
|
ENDIF
|
|
ANG(I) = ANSTRT(I)
|
|
IF (I .EQ. 1) OMOFF = 0.5*(ANG(1) - THETA)
|
|
IF (I .EQ. 2) ANG(2) = ANG(2) - OMOFF
|
|
110 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Work out the grid loop control and grid header print.
|
|
C The grid is such that if :--
|
|
C theta is stepped it is always fastest, then omega, then chi.
|
|
C IFIRST, ISECND or ITHIRD 1 means theta, 2 omega, 3 chi.
|
|
C NFIRST, NSECND or NTHIRD are the number of steps on that axis.
|
|
C-----------------------------------------------------------------------
|
|
IFIRST = 0
|
|
ISECND = 0
|
|
ITHIRD = 0
|
|
NFIRST = 1
|
|
NSECND = 1
|
|
NTHIRD = 1
|
|
C-----------------------------------------------------------------------
|
|
C Theta variation
|
|
C-----------------------------------------------------------------------
|
|
IF (ANSTEP(1) .NE. 0.0) THEN
|
|
IFIRST = 1
|
|
NFIRST = NNN(1)
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Omega variation
|
|
C-----------------------------------------------------------------------
|
|
IF (ANSTEP(2) .NE. 0.0) THEN
|
|
IF (NFIRST .EQ. 1) THEN
|
|
NFIRST = NNN(2)
|
|
IFIRST = 2
|
|
ELSE
|
|
NSECND = NNN(2)
|
|
ISECND = 2
|
|
ENDIF
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Chi variation
|
|
C-----------------------------------------------------------------------
|
|
IF (ANSTEP(3) .NE. 0.0) THEN
|
|
IF (NSECND .EQ. 1) THEN
|
|
IF (NFIRST .EQ. 1) THEN
|
|
NFIRST = NNN(3)
|
|
IFIRST = 3
|
|
ELSE
|
|
NSECND = NNN(3)
|
|
ISECND = 3
|
|
ENDIF
|
|
ELSE
|
|
NTHIRD = NNN(3)
|
|
ITHIRD = 3
|
|
ENDIF
|
|
ENDIF
|
|
WRITE (COUT,16000)
|
|
$ ANGLES(IFIRST),ANSTRT(IFIRST),NFIRST,ANSTOP(IFIRST)
|
|
CALL GWRITE (ITP,' ')
|
|
IF (ISECND .NE. 0) THEN
|
|
WRITE (COUT,16100) ANGLES(ISECND),ANSTRT(ISECND),NSECND,
|
|
$ ANSTOP(ISECND)
|
|
CALL GWRITE (ITP,' ')
|
|
ENDIF
|
|
IF (ITHIRD .NE. 0) THEN
|
|
WRITE (COUT,16200) ANGLES(ITHIRD),ANSTRT(ITHIRD),NTHIRD,
|
|
$ ANSTOP(ITHIRD)
|
|
CALL GWRITE (ITP,' ')
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Now scan the grid in the correct order
|
|
C-----------------------------------------------------------------------
|
|
IF (NSECND .EQ. 0) NSECND = 1
|
|
IF (NTHIRD .EQ. 0) NTHIRD = 1
|
|
CALL SHUTTR (99)
|
|
DO 140 N3 = 1,NTHIRD
|
|
ANG2SV = ANG(2)
|
|
DO 130 N2 = 1,NSECND
|
|
DO 120 N1 = 1,NFIRST
|
|
CALL ANGSET (ANG(1),ANG(2),ANG(3),PHI,0,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,18000)
|
|
CALL GWRITE (ITP,' ')
|
|
CALL ANGSET (THETA,OMEGA,CHI,PHI,0,ICOL)
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
CALL CCTIME (TIMSTP,COUNT)
|
|
ICOUNT(N1) = COUNT
|
|
ANG(IFIRST) = ANG(IFIRST) + ANSTEP(IFIRST)
|
|
CALL MOD360 (ANG(IFIRST))
|
|
IF (IFIRST .EQ. 1) THEN
|
|
ANG(2) = ANG(2) - 0.5*ANSTEP(1)
|
|
CALL MOD360 (ANG(2))
|
|
ENDIF
|
|
120 CONTINUE
|
|
WRITE (COUT,19000) (ICOUNT(I),I = 1,NFIRST)
|
|
CALL GWRITE (ITP,' ')
|
|
ANG(IFIRST) = ANSTRT(IFIRST)
|
|
IF (ISECND .NE. 0) THEN
|
|
ANG2SV = ANG2SV + ANSTEP(ISECND)
|
|
ANG(ISECND) = ANG2SV
|
|
CALL MOD360 (ANG(ISECND))
|
|
ENDIF
|
|
130 CONTINUE
|
|
IF (ISECND .NE. 0) ANG(ISECND) = ANSTRT(ISECND)
|
|
IF (ITHIRD .NE. 0) THEN
|
|
ANG(ITHIRD) = ANG(ITHIRD) + ANSTEP(ITHIRD)
|
|
CALL MOD360 (ANG(ITHIRD))
|
|
ENDIF
|
|
IF (ITHIRD .EQ. 3 .AND. N3 .LT. NTHIRD) THEN
|
|
WRITE (COUT,17000) ANG(ITHIRD)
|
|
CALL GWRITE (ITP,' ')
|
|
ENDIF
|
|
140 CONTINUE
|
|
CALL SHUTTR (-99)
|
|
CALL ANGSET (THETA,OMEGA,CHI,PHI,0,ICOL)
|
|
KI = ' '
|
|
RETURN
|
|
10000 FORMAT (' Sample an Angular Grid (Y) ? ',$)
|
|
12000 FORMAT (' Type the grid specs.'/
|
|
$ ' A response of <CR> is interpreted as no variation of',
|
|
$ ' of that axis.'/)
|
|
13000 FORMAT (' Type start, end & step for ',A,' ',$)
|
|
15000 FORMAT (' Counting preset per step (1000) ',$)
|
|
16000 FORMAT (1X,A,' ACROSS page, from',F8.3,' in',I3,
|
|
$ ' steps, to ',F8.3)
|
|
16100 FORMAT (1X,A,' DOWN page, from',F8.3,' in',I3,
|
|
$ ' steps, to ',F8.3)
|
|
16200 FORMAT (1X,A,' SECTIONS, from',F8.3,' in',I3,
|
|
$ ' steps, to ',F8.3)
|
|
17000 FORMAT (' Chi Incremented to ',F8.3)
|
|
18000 FORMAT (' Collision')
|
|
19000 FORMAT (10I7)
|
|
END
|