linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
cvs
2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

195
difrac/grid.f Normal file
View File

@@ -0,0 +1,195 @@
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 CTIME (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