Initial revision

2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
--- a/difrac/oscil.f
+++ b/difrac/oscil.f
@@ -0,0 +1,93 @@
+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 CTIME (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