94 lines
2.7 KiB
Fortran
94 lines
2.7 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C This subroutine performs a wide omega scan for photographic purposes
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE OSCIL
|
|
INCLUDE 'COMDIF'
|
|
CON = IFRDEF
|
|
WRITE (COUT,10000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') THEN
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
WRITE (COUT,11000)
|
|
CALL FREEFM (ITR)
|
|
OLIM1 = RFREE(1)
|
|
OLIM2 = RFREE(2)
|
|
WRITE (COUT,12000)
|
|
CALL FREEFM (ITR)
|
|
OSTIM = RFREE(1)
|
|
WRITE ( COUT,13000)
|
|
CALL FREEFM (ITR)
|
|
NOSTIM = IFREE(1)
|
|
IF (NOSTIM .EQ. 0) NOSTIM = 1
|
|
NO = NOSTIM
|
|
C-----------------------------------------------------------------------
|
|
C Get the scan range assuming that 180 is the maximum
|
|
C-----------------------------------------------------------------------
|
|
OLI1 = AMOD(OLIM1,360.)
|
|
OLI2 = AMOD(OLIM2,360.)
|
|
IF (OLI2 .LE. OLI1) THEN
|
|
SAVE = OLI1
|
|
OLI1 = OLI2
|
|
OLI2 = SAVE
|
|
ENDIF
|
|
OLI3 = OLI1 + 360.0
|
|
IF ((OLI2 - OLI1) .GE. 180.0) THEN
|
|
OLI1 = OLI2
|
|
OLI2 = OLI3
|
|
ENDIF
|
|
RANGE = AMOD((OLI2-OLI1),360.0)
|
|
IRANGE = RANGE + 1
|
|
MSTEP = (RANGE - IRANGE)*CON
|
|
TOSTEP = CON*RANGE
|
|
TOTIME = OSTIM
|
|
TISTEP = OSTIM
|
|
IF (TISTEP .LT. 0.01) TISTEP = 0.01
|
|
DO 150 NT = 1,NO
|
|
CALL ANGET (THETA,OMEGA,CHI,PHI)
|
|
OLIC = OLI1
|
|
CALL ANGSET (THETA,OLI1,CHI,PHI,NATT,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,14000)
|
|
CALL GWRITE (ITP,' ')
|
|
CALL SHUTTR (-1)
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
DO 140 I = 1,IRANGE
|
|
NSTEP = MSTEP
|
|
IF ((IRANGE-I) .GT. 0) NSTEP = CON
|
|
DO 130 J = 1,NSTEP
|
|
OLIC = OLIC + 1.0/CON
|
|
CALL MOD360 (OLIC)
|
|
CALL ANGSET (THETA,OLIC,CHI,PHI,NATT,ICOL)
|
|
IF (ICOL .NE. 0) THEN
|
|
WRITE (COUT,14000)
|
|
CALL GWRITE (ITP,' ')
|
|
CALL SHUTTR (-1)
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
CALL CCTIME (TISTEP,COUNT)
|
|
CALL KORQ (KQFLAG)
|
|
IF (KQFLAG .NE. 1) THEN
|
|
WRITE (COUT,15000)
|
|
CALL GWRITE (ITP,' ')
|
|
CALL SHUTTR (-1)
|
|
KI = ' '
|
|
RETURN
|
|
ENDIF
|
|
130 CONTINUE
|
|
140 CONTINUE
|
|
150 CONTINUE
|
|
CALL SHUTTR (-1)
|
|
KI = ' '
|
|
RETURN
|
|
10000 FORMAT (' Oscillation Picture (Y) ? ',$)
|
|
11000 FORMAT (' Type the omega scan limits ',$)
|
|
12000 FORMAT (' Type the count preset',$)
|
|
13000 FORMAT (' Type the number of repeats (1) ',$)
|
|
14000 FORMAT (' Collision Stop')
|
|
15000 FORMAT (' K-stop')
|
|
END
|