Compiled under Redhat Linux<Right

This commit is contained in:
cvs
2000-02-18 15:54:23 +00:00
parent b9529f1cfd
commit cbc7fdf334
48 changed files with 160 additions and 109 deletions

View File

@@ -48,4 +48,3 @@ C-----------------------------------------------------------------------
RETURN
10000 FORMAT (A)
END


View File

@@ -133,7 +133,7 @@ C-----------------------------------------------------------------------
ENDIF
ENDIF
CALL SHUTTR (1)
CALL CTIME (PRESET,CT1)
CALL CCTIME (PRESET,CT1)
CALL SHUTTR (-1)
WRITE (COUT,23000) IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI,CT1
CALL GWRITE (ITP,' ')
@@ -303,7 +303,7 @@ C-----------------------------------------------------------------------
ENDIF
ENDIF
CALL SHUTTR (1)
CALL CTIME (PRESET,CT1)
CALL CCTIME (PRESET,CT1)
CALL SHUTTR (-1)
WRITE (LPT,30000) IH,IK,IL,RTHETA,ROMEGA,RCHI,RPHI,CT1
IF (ITRUE .EQ. 1) THEN

View File

@@ -61,7 +61,7 @@ C-----------------------------------------------------------------------
KI = ' '
RETURN
10000 FORMAT (/10X,'Constrained Cell Dimension Least-Squares'/)
11000 FORMAT (/' Wavelength'F10.6,'; ',I6,' reflections.')
11000 FORMAT (/' Wavelength',F10.6,'; ',I6,' reflections.')
12000 FORMAT (' Less than 6 reflections. Quit')
END
C-----------------------------------------------------------------------
@@ -625,4 +625,4 @@ C-----------------------------------------------------------------------
220 CONTINUE
RETURN
END


View File

@@ -115,9 +115,9 @@ C-----------------------------------------------------------------------
$ SAS(1),SAS(2),SAS(3),SANS(1),SANS(2),SANS(3)
RETURN
10000 FORMAT (/,' Real Cell'/
$ 3X,'a', 11X,'b', 11X,'c', 9X,'alpha', 6X'beta', 5X,'gamma'/
$ 3X,'a', 11X,'b', 11X,'c', 9X,'alpha', 6X, 'beta', 5X,'gamma'/
$ 3(F9.5,3X),3(F7.3,3X)/3(F9.5,3X),3(F7.3,3X))
11000 FORMAT (/,' Reciprocal Cell'/
$ 3X,'a*',10X,'b*',10X,'c*',8X,'alpha*',5X'beta*',4X,'gamma*'/
$ 3(1X,F8.6,3X),3(F7.3,3X)/3(1X,F8.6,3X),3(F7.3,3X))
$ 3X,'a*',10X,'b*',10X,'c*',8X,'alpha*',5X, 'beta*',4X,'gamma*'/
$ ,3(1X,F8.6,3X),3(F7.3,3X)/3(1X,F8.6,3X),3(F7.3,3X))
END

View File

@@ -253,7 +253,7 @@ C-----------------------------------------------------------------------
WRITE (LPT,24000) IH,IK,IL,THETA,OMEGA,CHI,PHI
CALL WXW2T (DT,DO,DC,ISLIT)
CALL SHUTTR (1)
CALL CTIME (MPRESET,COUNT)
CALL CCTIME (MPRESET,COUNT)
CALL KORQ(INTERRUPT)
IF(INTERRUPT .NE. 1) THEN
WRITE(COUT,37000)
@@ -373,7 +373,7 @@ C14000 FORMAT (' Type the Crystal-to-Detector distance (',I3,'mm) ',$)
18000 FORMAT (' Type the max count cutoff fraction (0.5) ',$)
19000 FORMAT (' Type h,k,l for reflections to be used (End) ')
C22000 FORMAT (' The 1st reflection is set. Is everything OK (Y) ? ',$)
23000 FORMAT (' Setting',I2', Collision. Cannot complete',3I4)
23000 FORMAT (' Setting',I2,', Collision. Cannot complete',3I4)
24000 FORMAT (' Starting values ',3I4,4F10.3)
25000 FORMAT (' Setting',I2,' of',3I4,' failed on first attempt.')
25100 FORMAT (' Setting',I2,' of',3I4,' failed. Cannot complete')

View File

@@ -66,7 +66,7 @@ C-----------------------------------------------------------------------
KI = 'FF'
RETURN
ENDIF
CALL CTIME (PRESET,COUNT)
CALL CCTIME (PRESET,COUNT)
CALL KORQ(IRUPT)
IF(IRUPT .NE. 1) THEN
WRITE (COUT,10000)
@@ -282,7 +282,7 @@ C-----------------------------------------------------------------------
C Set the attenuator if necessary
C-----------------------------------------------------------------------
TIME = 1.0
CALL CTIME (TIME,COUNT)
CALL CCTIME (TIME,COUNT)
IF (COUNT .GT. ICPSMX .AND. NATT .EQ. 0) THEN
NATT = 1
COUNT = COUNT/ATTEN(2)

View File

@@ -18,7 +18,7 @@ C-----------------------------------------------------------------------
ICOUNT = 0
MCOUNT = 0
DO 120 I = 1,NPTS
CALL CTIME (TIM,TCOUNT(I))
CALL CCTIME (TIM,TCOUNT(I))
IF (TCOUNT(I)/TIM .GT. ICPSMX .AND. NATT .LT. NATTEN) THEN
NATT = NATT + 1
GO TO 110

View File

@@ -44,7 +44,7 @@ C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C Sample count at point to find suitable counting time, then measure
C-----------------------------------------------------------------------
CALL CTIME (QTIME,ENQ)
CALL CCTIME (QTIME,ENQ)
COUNT = ENQ
ENQD = ENQ - 2.0*SQRT(ENQ)
IF (ENQD .LE. 0.0) ENQD = ENQ
@@ -53,7 +53,7 @@ C-----------------------------------------------------------------------
IF (PRESET .GT. QTIME) THEN
IF (PRESET .GT. PRESET) PRESET = TMAX
TIMED = PRESET - QTIME
CALL CTIME (TIMED,EN)
CALL CCTIME (TIMED,EN)
ELSE
PRESET = QTIME
EN = 0

View File

@@ -12,7 +12,7 @@ C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C Move 2Theta
C-----------------------------------------------------------------------
CALL CTIME (DELAY,COUNT)
CALL CCTIME (DELAY,COUNT)
CALL ANGET (THETA,OMEGA,CHI,PHI)
THETA = THETA + 20.0
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@@ -21,7 +21,7 @@ C Move Omega
C-----------------------------------------------------------------------
WRITE (COUT,11000)
CALL GWRITE (ITP,' ')
CALL CTIME (DELAY,COUNT)
CALL CCTIME (DELAY,COUNT)
OMEGA = OMEGA - 20.0
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
C-----------------------------------------------------------------------
@@ -29,7 +29,7 @@ C Move Chi
C-----------------------------------------------------------------------
WRITE (COUT,12000)
CALL GWRITE (ITP,' ')
CALL CTIME (DELAY,COUNT)
CALL CCTIME (DELAY,COUNT)
CHI = CHI + 20.0
IF (CHI .GE. 360.0) CHI = CHI - 360.0
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@@ -38,7 +38,7 @@ C Move Phi
C-----------------------------------------------------------------------
WRITE (COUT,13000)
CALL GWRITE (ITP,' ')
CALL CTIME (DELAY,COUNT)
CALL CCTIME (DELAY,COUNT)
PHI = PHI + 30.0
IF (PHI .GE. 360.0) PHI = PHI - 360.0
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@@ -47,7 +47,7 @@ C Move all circles
C-----------------------------------------------------------------------
WRITE (COUT,14000)
CALL GWRITE (ITP,' ')
CALL CTIME(DELAY,COUNT)
CALL CCTIME(DELAY,COUNT)
THETA = THETA - 20.0
OMEGA = OMEGA + 20.0
CHI = CHI - 20.0
@@ -82,7 +82,7 @@ C-----------------------------------------------------------------------
DO 130 J = 1,100
DJUNK = SQRT(1.0)
130 CONTINUE
CALL CTIME (DELAY,COUNT)
CALL CCTIME (DELAY,COUNT)
140 CONTINUE
CALL SHUTTR (-1)
C-----------------------------------------------------------------------

View File

@@ -260,4 +260,3 @@ C-----------------------------------------------------------------------
14000 FORMAT (' TYPO -- Too many digits in number. Try again please.')
15000 FORMAT (' Unexpected EOF on Unit',I3,'. Job Aborted.'/'%')
END


View File

@@ -425,9 +425,9 @@ C------- modified: MK --> IO to SICS instead of LPT
RETURN
ENDIF
10000 FORMAT (3I4,' Scan Collision in GOLOOP')
11000 FORMAT (10X,A1'-stop. Restart at'/
11000 FORMAT (10X,A1,'-stop. Restart at'/
$ 3I4,', number',I5,' in set',I3,' segment',I2,
$ ' at Idata Record',I4)
12000 FORMAT (10X'End of Segment. Start next data at Record',I4)
13000 FORMAT (10X'End of Data Collection ---- HURRAY !!')
12000 FORMAT (10X,'End of Segment. Start next data at Record',I4)
13000 FORMAT (10X,'End of Data Collection ---- HURRAY !!')
END

View File

@@ -145,7 +145,7 @@ C-----------------------------------------------------------------------
KI = ' '
RETURN
ENDIF
CALL CTIME (TIMSTP,COUNT)
CALL CCTIME (TIMSTP,COUNT)
ICOUNT(N1) = COUNT
ANG(IFIRST) = ANG(IFIRST) + ANSTEP(IFIRST)
CALL MOD360 (ANG(IFIRST))

View File

@@ -424,7 +424,7 @@ C-----------------------------------------------------------------------
ENDIF
RETURN
10000 FORMAT (' Scan Collision')
11000 FORMAT (/,3X' h k l 2-Theta Time',
11000 FORMAT (/,3X, ' h k l 2-Theta Time',
$ ' Att Bkg Peak Bkg Psi Inet ')
12000 FORMAT (3I4,F7.2,F7.3,1X,I1,I5,I7,I5,F7.2,I7,I4)
13000 FORMAT (3I4,5F8.2,I8)

View File

@@ -35,4 +35,3 @@ C-----------------------------------------------------------------------
RETURN
10000 FORMAT (A1)
END


View File

@@ -72,7 +72,7 @@ C Loop to count and step through the reflection
C-----------------------------------------------------------------------
CALL SHUTTR (99)
DO 240 J = 1,NPTS
CALL CTIME (TSTEP,COUNT)
CALL CCTIME (TSTEP,COUNT)
ACOUNT(J) = COUNT
IF (ITYP .EQ. 0) ANG1 = ANG1 + CSTEP
IF (ITYP .NE. 0) ANG2 = ANG2 + CSTEP
@@ -135,7 +135,7 @@ C-----------------------------------------------------------------------
11000 FORMAT (' There is something WRONG. Please try again.')
13000 FORMAT (' Scan type: Theta/2Theta or Omega, 0 or 1 ',$)
15000 FORMAT (' Type the no. of pts before & after the peak,'
$ '(',I2,',',I2,') ',$)
$ ,'(',I2,',',I2,') ',$)
15100 FORMAT (' Type the step size in degs and the preset/step',
$ ' (',F4.2,',',F4.2,') ',$)
17000 FORMAT (' Which attenuator do you wish to use (0) ? ',$)

View File

@@ -202,8 +202,8 @@ C-----------------------------------------------------------------------
IF (ISYSF .EQ. 6) ISYSF = 5
WRITE (COUT,15000) FSTRIN,STRING
15000 FORMAT (' Space-group choices are as follows :--'/
$ ' 1. The safest space-group based on cell-reduction 'A/
$ ' 2. The safest space-group based on cell lengths 'A/
$ ' 1. The safest space-group based on cell-reduction ', A/
$ ' 2. The safest space-group based on cell lengths ', A/
$ ' 3. Any other space-group.'/
$ ' Which do you want (1) ',$)
16000 FORMAT (' Type the space-group symbol ',$)

View File

@@ -351,7 +351,7 @@ C-----------------------------------------------------------------------
23000 FORMAT (' Do you wish to insert reflections (N) ? ',$)
24100 FORMAT (' Do you want to include these zero values (Y) ? ',$)
24200 FORMAT (' The new zeroes for Omega and Chi are',2F7.3)
24000 FORMAT (' First non-written record: 'I4)
24000 FORMAT (' First non-written record: ',I4)
25000 FORMAT (/,22X,'Observed',22X,'Calculated',10X,'Angular'/
$ ' h k l 2Theta Omega Chi Phi ',
$ ' 2Theta Omega Chi Phi ',

View File

@@ -231,4 +231,4 @@ C-----------------------------------------------------------------------
520 RETURN
10000 FORMAT(' Matrix operation ',A6,' is not programmed')
END


View File

@@ -38,7 +38,7 @@ C-----------------------------------------------------------------------
PRESET = SPRESET
RETURN
ENDIF
120 CALL CTIME (TTIME,COUNT)
120 CALL CCTIME (TTIME,COUNT)
IF (COUNT/TTIME .GE. ICPSMX) THEN
NATT = NATT + 1
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@@ -72,7 +72,7 @@ C-----------------------------------------------------------------------
C Measure the low angle background for BGDTIM
C-----------------------------------------------------------------------
BGDTIM = FRAC*PRESET
CALL CTIME (BGDTIM,BGRD1)
CALL CCTIME (BGDTIM,BGRD1)
C-----------------------------------------------------------------------
C Do the scan:
C ITYPE Type of scan 0 -- theta/2-theta b-p-b
@@ -202,7 +202,7 @@ C-----------------------------------------------------------------------
I = BGRD1*PRESET*FRAC/BGDTIM + 0.5
BGRD1 = I
BGDTIM = PRESET*FRAC
CALL CTIME (BGDTIM,BGRD2)
CALL CCTIME (BGDTIM,BGRD2)
IF (BGRD1 + BGRD2 .GT. 4.0*COUNT) THEN
WRITE (COUT,11000) IH,IK,IL
CALL GWRITE(ITP,' ')
@@ -251,7 +251,7 @@ C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C Count at peak for time TIME
C-----------------------------------------------------------------------
420 CALL CTIME (PRESET,COUNT)
420 CALL CCTIME (PRESET,COUNT)
C C = COUNT/PRESET
IF (C .GE. ICPSMX .AND. NATTEN .GT. 0 .AND. NATT .LT. NATTEN) THEN
NATT = NATT + 1
@@ -271,9 +271,9 @@ C Measure the backgrounds
C-----------------------------------------------------------------------
IF (ITYPE .EQ. 5 .OR. ITYPE .EQ. 6) THEN
BGDTIM = FRAC*PRESET
CALL CTIME (BGDTIM,BGRD2)
CALL CCTIME (BGDTIM,BGRD2)
CALL ANGSET (ANG1,ANG2,CHI,PHI,NATT,ICOL)
CALL CTIME (BGDTIM,BGRD1)
CALL CCTIME (BGDTIM,BGRD1)
IF (BGRD1 + BGRD2 .GT. 4.0*COUNT) THEN
WRITE (COUT,11000) IH,IK,IL
CALL GWRITE(LPT,' ')
@@ -287,7 +287,7 @@ C-----------------------------------------------------------------------
C Sample background on high side
C-----------------------------------------------------------------------
PRESET = STIME*0.5
CALL CTIME (PRESET,BGRD2)
CALL CCTIME (PRESET,BGRD2)
C-----------------------------------------------------------------------
C Evaluate rough Peak/Background ratio and Time required to
C accumulate a preset number FRAC of counts on the peak.
@@ -308,7 +308,7 @@ C Finish measurement of high background
C-----------------------------------------------------------------------
BCT = (IBCT - (STIME/2.0))
IF (BCT .GT. 0.) THEN
CALL CTIME (BCT,BKG2)
CALL CCTIME (BCT,BKG2)
BGRD2 = BGRD2 + BKG2
BCT = IBCT
ICC = 0
@@ -327,7 +327,7 @@ C-----------------------------------------------------------------------
ENDIF
PPCT = PCT
PCT = IPCT
CALL CTIME (PPCT,PC)
CALL CCTIME (PPCT,PC)
COUNT = COUNT + PC
ELSE
PCT = STIME
@@ -341,7 +341,7 @@ C-----------------------------------------------------------------------
RETURN
ENDIF
PRESET = BCT
CALL CTIME (PRESET,BGRD1)
CALL CCTIME (PRESET,BGRD1)
PRESET = PCT + BCT
CALL FILLN2 (IFILN,NFLG)
IF (NFLG .EQ. 1) GO TO 100
@@ -373,7 +373,7 @@ C-----------------------------------------------------------------------
WRITE (COUT,10000)
CALL GWRITE (ITP,' ')
100 TIM1 = 1500
CALL CTIME (TIM1,CONT)
CALL CCTIME (TIM1,CONT)
DUM1 = 1.0/16.0
DUM2 = 0.5
CALL ONEBEP (DUM1,DUM2)
@@ -385,7 +385,7 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ')
TMIN = DELAY*6000
IF (TMIN .LE. 1) TMIN = 1
CALL CTIME (TMIN,DUM2)
CALL CCTIME (TMIN,DUM2)
IFILN = 1
NFLG = 1
ENDIF

View File

@@ -241,7 +241,7 @@ C-----------------------------------------------------------------------
$ ' reflections')
24000 FORMAT (/' Orientation Matrix from M2')
25000 FORMAT (3F12.8)
26000 FORMAT (' Reflection,'I2,' > ',$)
26000 FORMAT (' Reflection,',I2,' > ',$)
END
C-----------------------------------------------------------------------
C Subroutine to calculate the S matrices for ORCEL2

View File

@@ -69,7 +69,7 @@ C-----------------------------------------------------------------------
KI = ' '
RETURN
ENDIF
CALL CTIME (TISTEP,COUNT)
CALL CCTIME (TISTEP,COUNT)
CALL KORQ (KQFLAG)
IF (KQFLAG .NE. 1) THEN
WRITE (COUT,15000)

View File

@@ -49,7 +49,7 @@ C-----------------------------------------------------------------------
C Single count only
C-----------------------------------------------------------------------
IF (ANS .EQ. 'N') THEN
CALL CTIME (MPRESET,COUNT)
CALL CCTIME (MPRESET,COUNT)
IF (NATTEN .NE. 0) THEN
WRITE (COUT,15000) MPRESET,NATT,COUNT
CALL GWRITE (ITP,' ')
@@ -69,7 +69,7 @@ C-----------------------------------------------------------------------
110 CONTINUE
BIGTIM = MPRESET * 5.
WRITE (LPT,17000) BIGTIM
CALL CTIME (BIGTIM,COUNT)
CALL CCTIME (BIGTIM,COUNT)
COUNT = COUNT*MPRESET/BIGTIM
SIGM = SQRT(COUNT)
AVC = COUNT + 0.5
@@ -81,7 +81,7 @@ C-----------------------------------------------------------------------
WRITE (LPT,20000)
DO 150 N = 1,50
DO 120 I = 1,10
CALL CTIME (MPRESET,COUNT)
CALL CCTIME (MPRESET,COUNT)
C(I) = COUNT
120 CONTINUE
DO 130 I = 1,10
@@ -119,7 +119,7 @@ C-----------------------------------------------------------------------
CALL SHUTTR (-99)
KI = ' '
RETURN
10000 FORMAT (' Timed Count at a Point (Y) ? '$)
10000 FORMAT (' Timed Count at a Point (Y) ? ',$)
11000 FORMAT (' Type the Count Preset and the attenuator',
$ ' number (1000.0,0) ',$)
12000 FORMAT (' Type the Count Preset (1000.0) ',$)

View File

@@ -29,7 +29,7 @@ C-----------------------------------------------------------------------
ICOUNT = 0
MCOUNT = 0
DO 110 I = 1,NPTS
CALL CTIME (TIM,PCOUNT(I))
CALL CCTIME (TIM,PCOUNT(I))
IF (PCOUNT(I) .GT. MCOUNT) THEN
MCOUNT = PCOUNT(I)
ICOUNT = I

View File

@@ -259,7 +259,7 @@ C-----------------------------------------------------------------------
22000 FORMAT (' There are NO Explicit Absence Conditions')
23000 FORMAT (' The Explicit Absence Conditions are :--')
24000 FORMAT (' Type',I3,' -- ',
$ I4,'*h +',I2,'*k +',I2,'*l = ',I2'*n +',I2)
$ I4,'*h +',I2,'*k +',I2,'*l = ',I2,'*n +',I2)
30000 FORMAT (' Peak Top Counting - 2Theta range')
31000 FORMAT (' Peak Top Counting - Omega range')
32000 FORMAT (' Economized Peak Top - 2Theta range')
@@ -271,8 +271,8 @@ C-----------------------------------------------------------------------
29000 FORMAT (' Omega Scan with Precision Control. ',A,
$ 'rofile analysis.')
25000 FORMAT (' Compton or TDS Measurements')
35000 FORMAT (' Bisecting Geometry. Scan speed 'F8.3'deg/min')
34000 FORMAT (' Parallel Geometry. Scan speed 'F8.3'deg/min')
35000 FORMAT (' Bisecting Geometry. Scan speed ',F8.3,'deg/min')
34000 FORMAT (' Parallel Geometry. Scan speed ',F8.3,'deg/min')
36000 FORMAT (' Scan Parameters: ',
$ F6.3,' + ',F6.3,'*tan(theta) + ',F6.3)
37000 FORMAT (' Time/Precision Params: ',
@@ -285,5 +285,5 @@ C-----------------------------------------------------------------------
43000 FORMAT (' Next reflection: ',3I4,', #',I5,', set',I3,
$ ', segment',I2,', at record ',I4)
44000 FORMAT (' This is a low-temperature experiment.'/
$ ' The waiting time after a refill is'F6.2' minutes.')
$ ' The waiting time after a refill is',F6.2,' minutes.')
END

View File

@@ -240,7 +240,7 @@ C-----------------------------------------------------------------------
13000 FORMAT (' Type 2thetamin ',$)
14000 FORMAT (/' Reflns can be selected on 2theta and Inet/Sig(Inet)'/
$ ' Type 2thetamin, 2thetamax and min(I/sigI)',
$ ' (All Reflns) '$)
$ ' (All Reflns) ',$)
15000 FORMAT (' Intensity data is in records 20 to',I5/
$ ' Type the range of records to be examined ',$)
16000 FORMAT (/' Records',I4,' to',I4,' will be used.')

View File

@@ -38,4 +38,3 @@ C-----------------------------------------------------------------------
10000 FORMAT (' Error no.',I3,' in processing space group symbol ',
$ 10A1/1X,A52)
END


View File

@@ -654,4 +654,3 @@ C-----------------------------------------------------------------------
IF (IER .EQ. 0) IER = 5
RETURN
END


View File

@@ -9,4 +9,3 @@ C-----------------------------------------------------------------------
L(2) = 3
RETURN
END


View File

@@ -21,4 +21,3 @@ C-----------------------------------------------------------------------
CONTINUE
RETURN
END


View File

@@ -123,4 +123,3 @@ C-----------------------------------------------------------------------
14000 FORMAT (' Friedel Reflections are the -,-,- of these.'/'%')
15000 FORMAT (5X,3(A20,3X))
END


View File

@@ -28,4 +28,3 @@ C-----------------------------------------------------------------------
RT(5,4) = 20.
RETURN
END


View File

@@ -559,4 +559,3 @@ C-----------------------------------------------------------------------
RETURN
10000 FORMAT (10A1)
END


View File

@@ -66,4 +66,3 @@ C-----------------------------------------------------------------------
11000 FORMAT (' Operator',I2,' generates matrix',I3,' which has a',
$ ' translation conflict',2I3)
END


View File

@@ -182,7 +182,7 @@ C Position on the peak and count for standard preset
C-----------------------------------------------------------------------
CALL ANGSET (RTHETA,ROMEGA,RCHI,RPHI,NATT,ICOL)
CALL SHUTTR (99)
CALL CTIME (PRESET,COUNT)
CALL CCTIME (PRESET,COUNT)
ICOUNT = COUNT
C-----------------------------------------------------------------------
C Do not save a weak count

View File

@@ -16,7 +16,7 @@ C-----------------------------------------------------------------------
ICOUNT = 0
MCOUNT = 0
DO 110 I = 1,NPTS
CALL CTIME (TIM,TCOUNT(I))
CALL CCTIME (TIM,TCOUNT(I))
IF (TCOUNT(I) .GT. MCOUNT) THEN
MCOUNT = TCOUNT(I)
ICOUNT = I

View File

@@ -35,7 +35,7 @@ C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C CTIME Count for a fixed time
C-----------------------------------------------------------------------
SUBROUTINE CTIME (XTIME, XCOUNT)
SUBROUTINE CCTIME (XTIME, XCOUNT)
REAL XTIME, XCOUNT
INCLUDE 'COMDIF'
call setslt (icadsl,icol)
@@ -234,7 +234,7 @@ C----- position
RETURN
ENDIF
C----- count
CALL CTIME(PRESET,COUNT)
CALL CCTIME(PRESET,COUNT)
CALL KORQ(IT)
IF(IT .NE. 1)THEN
IERR = 2
@@ -295,7 +295,7 @@ C----- position
RETURN
ENDIF
C----- count
CALL CTIME(SPRESET,COUNT)
CALL CCTIME(SPRESET,COUNT)
CALL KORQ(IT)
IF(IT .NE. 1)THEN
IERR = 2
@@ -341,7 +341,7 @@ C-----------------------------------------------------------------------
C Set the microscope viewing position (CAD-4 version)
C-----------------------------------------------------------------------
SUBROUTINE VUPOS (VTH,VOM,VCH,VPH)
CALL ANGSET(VTH,VOM,VCH,VPH)
CALL ANGSET(VTH,VOM,VCH,VPH,1,1)
RETURN
END