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 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