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