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

- Fixed a bug which caused the SICServer to die when a socket was broken.

Browse Source 
- Fixed many things in DIFRAC subsystem:
  * Recoded tcentr.f etc so that the course centering will work and will not
    go into an endless loop.
  * fixed boundary overwrites which occurred when yesno or alfnum where
    uset to get a single character and several were given.
  * Addeded documentation for DIFRAC
- Added tcl-files which  support the WWW status system
This commit is contained in:
cvs
2000-03-31 13:16:50 +00:00
parent d02a81400f
commit 714b8ae84d
35 changed files with 3069 additions and 203 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
commandlog.c
View File

@ -58,6 +58,14 @@
{ {
return; return;
} }
/* suppress TRANSACTIONFINISHED as well in order to make the WWW
commandlog work
*/
if(strstr(pText,"TRANSACTIONFINISHED") != NULL)
{
return;
}
/* create tail buffer as needed */ /* create tail buffer as needed */
if(!pTail) if(!pTail)

65
conman.c
View File

@ -367,6 +367,21 @@ extern pServer pServ;
return; return;
} }
if(pVictim->inUse > 0)
{
SCnoSock(pVictim);
if(pVictim->pSock)
{
NETClosePort(pVictim->pSock);
free(pVictim->pSock);
pVictim->pSock = NULL;
}
WriteToCommandLog("SYS> ",
"ERROR: Erraneous deletion of used Connection stopped");
return;
}
/* remove the connection from the server log if it has captured /* remove the connection from the server log if it has captured
something something
*/ */
@ -471,6 +486,7 @@ extern pServer pServ;
{ {
char *pStart = NULL, *pPtr; char *pStart = NULL, *pPtr;
int iCount, iState; int iCount, iState;
int iRet = 1;
pStart = pBuffer; pStart = pBuffer;
pPtr = pStart; pPtr = pStart;
@ -484,8 +500,8 @@ extern pServer pServ;
if( (*pPtr == '\r') || (*pPtr == '\n') ) if( (*pPtr == '\r') || (*pPtr == '\n') )
{ {
iState = LF; iState = LF;
NETWrite(pSock,pStart,iCount); iRet = NETWrite(pSock,pStart,iCount);
NETWrite(pSock,"\r\n",2); iRet = NETWrite(pSock,"\r\n",2);
iCount = 0; iCount = 0;
} }
else else
@ -510,10 +526,10 @@ extern pServer pServ;
} }
if(iCount > 0) if(iCount > 0)
{ {
NETWrite(pSock,pStart,iCount); iRet = NETWrite(pSock,pStart,iCount);
NETWrite(pSock,"\r\n",2); iRet = NETWrite(pSock,"\r\n",2);
} }
return 1; return iRet;
} }
/*-------------------------------------------------------------------------*/ /*-------------------------------------------------------------------------*/
int SCWrite(SConnection *self, char *pBuffer, int iOut) int SCWrite(SConnection *self, char *pBuffer, int iOut)
@ -566,7 +582,7 @@ extern pServer pServ;
{ {
if(self->iTelnet) if(self->iTelnet)
{ {
TelnetWrite(self->pSock,buffer); iRet = TelnetWrite(self->pSock,buffer);
} }
else else
{ {
@ -576,6 +592,11 @@ extern pServer pServ;
iRet = NETWrite(self->pSock,"\n",sizeof("\n")); iRet = NETWrite(self->pSock,"\n",sizeof("\n"));
} }
} }
if(!iRet)
{
SCnoSock(self);
WriteToCommandLog("SYS> ","Connection broken on send");
}
} }
else else
{ {
@ -594,7 +615,7 @@ extern pServer pServ;
{ {
if(self->iTelnet) if(self->iTelnet)
{ {
TelnetWrite(self->pSock,buffer); iRet = TelnetWrite(self->pSock,buffer);
} }
else else
{ {
@ -605,7 +626,10 @@ extern pServer pServ;
} }
} }
if(!iRet) if(!iRet)
return 0; {
SCnoSock(self);
WriteToCommandLog("SYS> ","Send broken to connection");
}
} }
else else
{ {
@ -863,6 +887,7 @@ extern pServer pServ;
int iRet, i; int iRet, i;
char *pPtr = NULL; char *pPtr = NULL;
char pFrom[50];
Status eOld; Status eOld;
if(!VerifyConnection(pCon)) if(!VerifyConnection(pCon))
@ -890,6 +915,8 @@ extern pServer pServ;
SetStatus(eOld); SetStatus(eOld);
CostaLock(pCon->pStack); CostaLock(pCon->pStack);
strncpy(pResult,pPtr,iLen); strncpy(pResult,pPtr,iLen);
sprintf(pFrom,"Prompted from sock %2.2d: ", pCon->pSock->sockid);
WriteToCommandLog(pFrom,pPtr);
return 1; return 1;
} }
} }
@ -1360,9 +1387,16 @@ extern pServer pServ;
return 0; return 0;
} }
if(self->iEnd) if(self->iEnd)
{ {
return 0; if(self->inUse != 0)
{
return 1;
}
else
{
return 0;
}
} }
@ -1379,9 +1413,16 @@ extern pServer pServ;
free(pPtr); free(pPtr);
} }
} }
if(self->iEnd) if(self->iEnd)
{ {
return 0; if(self->inUse != 0)
{
return 1;
}
else
{
return 0;
}
} }
return 1; return 1;

2
danu.dat
View File

@ -1,3 +1,3 @@
5378 5424
NEVER, EVER modify or delete this file NEVER, EVER modify or delete this file
You'll risk eternal damnation and a reincarnation as a cockroach!|n You'll risk eternal damnation and a reincarnation as a cockroach!|n

10
devexec.c
View File

@ -386,6 +386,11 @@
DeleteDevEntry(pDev); DeleteDevEntry(pDev);
LLDnodeDelete(self->iList); LLDnodeDelete(self->iList);
iRet = LLDnodePtr2Prev(self->iList); iRet = LLDnodePtr2Prev(self->iList);
if(SCGetInterrupt(self->pOwner) != eContinue)
{
self->iStatus = DEVINT;
return -1;
}
self->iStatus = DEVDONE; self->iStatus = DEVDONE;
break; break;
case HWFault: /* real HW error: burning, no net etc.. */ case HWFault: /* real HW error: burning, no net etc.. */
@ -400,7 +405,6 @@
if(SCGetInterrupt(self->pOwner) != eContinue) if(SCGetInterrupt(self->pOwner) != eContinue)
{ {
self->iStatus = DEVINT; self->iStatus = DEVINT;
StopExe(self,"all");
return -1; return -1;
} }
break; break;
@ -443,7 +447,6 @@
if(SCGetInterrupt(self->pOwner) != eContinue) if(SCGetInterrupt(self->pOwner) != eContinue)
{ {
self->iStatus = DEVINT; self->iStatus = DEVINT;
StopExe(self,"all");
return -1; return -1;
} }
break; break;
@ -907,7 +910,8 @@
{ {
if(self->pOwner) if(self->pOwner)
{ {
SCWrite(self->pOwner,"ERROR: Interrupting Current Hardware Operation", SCWrite(self->pOwner,
"ERROR: Interrupting Current Hardware Operation",
eError); eError);
SCSetInterrupt(self->pOwner,*iInt); SCSetInterrupt(self->pOwner,*iInt);
} }

2
difrac/Makefile
View File

@ -3,7 +3,7 @@
# #
# Mark Koennecke, November 1999 # Mark Koennecke, November 1999
#---------------------------------------------------------------------------- #----------------------------------------------------------------------------
CFLAGS = -g -c CFLAGS = -C -g -c
FL = f77 $(CFLAGS) FL = f77 $(CFLAGS)
ROOT = .. ROOT = ..
LIBS = $(ROOT)\libs LIBS = $(ROOT)\libs

11
difrac/align.f
View File

@ -474,7 +474,7 @@ C-----------------------------------------------------------------------
SUBROUTINE ALEDIT (NTOT) SUBROUTINE ALEDIT (NTOT)
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
DIMENSION NDEL(100) DIMENSION NDEL(100)
CHARACTER IOPT*1 CHARACTER IOPT*1,LINE*80
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Read in the existing list of h,k,l values and write it to terminal C Read in the existing list of h,k,l values and write it to terminal
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
@ -504,7 +504,8 @@ C-----------------------------------------------------------------------
C Get the edit option IOPT C Get the edit option IOPT
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
WRITE (COUT,13000) WRITE (COUT,13000)
CALL ALFNUM (IOPT) CALL ALFNUM (LINE)
IOPT = LINE(1:1)
IF (IOPT .EQ. ' ') IOPT = 'U' IF (IOPT .EQ. ' ') IOPT = 'U'
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Option E. Exit from AL with 0 reflns C Option E. Exit from AL with 0 reflns
@ -519,7 +520,8 @@ C-----------------------------------------------------------------------
IF (IOPT .EQ. 'U') THEN IF (IOPT .EQ. 'U') THEN
ITRUE = 0 ITRUE = 0
WRITE (COUT,14100) WRITE (COUT,14100)
CALL YESNO ('N',ANS) CALL YESNO ('N',LINE)
ANS = LINE(1:1)
IF (ANS .EQ. 'Y') ITRUE = 1 IF (ANS .EQ. 'Y') ITRUE = 1
RETURN RETURN
ENDIF ENDIF
@ -530,7 +532,8 @@ C-----------------------------------------------------------------------
IF (IOPT .EQ. 'N') NTOT = 0 IF (IOPT .EQ. 'N') NTOT = 0
ISYMOR = 0 ISYMOR = 0
WRITE (COUT,14000) WRITE (COUT,14000)
CALL YESNO ('Y',ANS) CALL YESNO ('Y',LINE)
ANS = LINE(1:1)
IF (ANS .EQ. 'Y') THEN IF (ANS .EQ. 'Y') THEN
ISYMOR = 1 ISYMOR = 1
IOUT = -1 IOUT = -1

5
difrac/blind.f
View File

@ -576,7 +576,7 @@ C EDLIST Edit the reflection list
C-------------------------------------------------------------------- C--------------------------------------------------------------------
SUBROUTINE EDLIST SUBROUTINE EDLIST
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
CHARACTER FLAG*1,REFNAM*40 CHARACTER FLAG*1,REFNAM*40,LINE*80
DIMENSION THETAS(NSIZE), DIMENSION THETAS(NSIZE),
$ OMEGAS(NSIZE),CHIS(NSIZE),PHIS(NSIZE),ICNTS(NSIZE) $ OMEGAS(NSIZE),CHIS(NSIZE),PHIS(NSIZE),ICNTS(NSIZE)
EQUIVALENCE (ACOUNT( 1),THETAS(1)), EQUIVALENCE (ACOUNT( 1),THETAS(1)),
@ -596,7 +596,8 @@ C--------------------------------------------------------------------
90 WRITE (COUT,11000) 90 WRITE (COUT,11000)
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
100 WRITE (COUT,12000) 100 WRITE (COUT,12000)
CALL ALFNUM (ANS) CALL ALFNUM (LINE)
ANS = LINE(1:1)
IF (ANS .NE. 'L' .AND. ANS .NE. 'D' .AND. ANS .NE. 'R' .AND. IF (ANS .NE. 'L' .AND. ANS .NE. 'D' .AND. ANS .NE. 'R' .AND.
$ ANS .NE. 'A' .AND. ANS .NE. 'F' .AND. ANS .NE. 'E') $ ANS .NE. 'A' .AND. ANS .NE. 'F' .AND. ANS .NE. 'E')
$ GO TO 90 $ GO TO 90

43
difrac/cfind.f
View File

@ -1,24 +1,31 @@
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Subroutine to find the coarse centre for Chi C Subroutine to find the coarse centre for Chi
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
SUBROUTINE CFIND (TIM) SUBROUTINE CFIND (TIM,MAXCOUNT)
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
REAL MAXCOUNT, MCOUNT
DIMENSION TCOUNT(NSIZE) DIMENSION TCOUNT(NSIZE)
EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1)) EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
ICPSMX = 25000 ICPSMX = 25000
STEPM = 0.02 STEPM = 0.02
SENSE = -1.0 SENSE = -1.0
CSTEP = 0.25 CSTEP = 1.5
NPTS = 10 NPTS = 10
CHI = CHI + NPTS*CSTEP/2 NRUN = 0
100 IF (CHI .LT. 0) CHI = CHI + 360 100 IF (CHI .LT. 0) CHI = CHI + 360
IF (CHI .GE. 360) CHI = CHI - 360 IF (CHI .GE. 360) CHI = CHI - 360
CHI = CHI + NPTS*CSTEP/2
CHISV = CHI CHISV = CHI
110 CALL ANGSET (THETA,OMEGA,CHISV,PHI,NATT,ICOL) 110 CALL ANGSET (THETA,OMEGA,CHISV,PHI,NATT,ICOL)
ICOUNT = 0 ICOUNT = 0
MCOUNT = 0 MCOUNT = 0
DO 120 I = 1,NPTS DO 120 I = 1,NPTS
CALL CCTIME (TIM,TCOUNT(I)) CALL CCTIME (TIM,TCOUNT(I))
CALL KORQ (IFLAG1)
IF (IFLAG1 .NE. 1) THEN
KI = 'O4'
RETURN
ENDIF
IF (TCOUNT(I)/TIM .GT. ICPSMX .AND. NATT .LT. NATTEN) THEN IF (TCOUNT(I)/TIM .GT. ICPSMX .AND. NATT .LT. NATTEN) THEN
NATT = NATT + 1 NATT = NATT + 1
GO TO 110 GO TO 110
@ -32,25 +39,25 @@ C-----------------------------------------------------------------------
IF (CHI .GE. 360) CHI = CHI - 360 IF (CHI .GE. 360) CHI = CHI - 360
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
120 CONTINUE 120 CONTINUE
MAXCOUNT = REAL(MCOUNT)
IF (ICOUNT .EQ. 1) THEN IF (ICOUNT .EQ. 1) THEN
C
C try the other direction, but only once otherwise we get into an
C endless loop
C
IF(NRUN .GT. 0) THEN
MAXCOUNT = 0.
RETURN
ENDIF
SENSE = -SENSE SENSE = -SENSE
CHI = CHI + 9*SENSE*CSTEP CHI = CHISV + 9*SENSE*CSTEP
NRUN = NRUN + 1
GO TO 100 GO TO 100
ELSE IF (ICOUNT .EQ. 10) THEN ELSE IF (ICOUNT .EQ. 20) THEN
CHI = CHI - 3*SENSE*CSTEP CHI = CHISV - 3*SENSE*CSTEP
GO TO 100 GO TO 100
ENDIF ENDIF
CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP C CHI = CHI + (ICOUNT - 12.25)*SENSE*CSTEP
IF(TCOUNT(ICOUNT) .GT. 0)THEN CHI = CHISV + ICOUNT*SENSE*CSTEP
TIM = 500.*TIM/TCOUNT(ICOUNT)
ELSE
TIM = 500 * TIM
ENDIF
IF (TIM .LT. 10000.0) THEN
IF (TIM .LT. 1000.) TIM =1000.
CSTEP = CSTEP/4
IF (CSTEP .GT. STEPM) GO TO 100
ENDIF
CHI = CHI + 5*SENSE*CSTEP
RETURN RETURN
END END

5
difrac/cinput.f
View File

@ -5,7 +5,7 @@ C-----------------------------------------------------------------------
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
DIMENSION A(3),ALP(3),SYS(7),TRANS(3,3,7),AA(3,3),PRIM(3), DIMENSION A(3),ALP(3),SYS(7),TRANS(3,3,7),AA(3,3),PRIM(3),
$ ANPRIM(3),TRANSF(3,3),H(3,3) $ ANPRIM(3),TRANSF(3,3),H(3,3)
CHARACTER CATMOD*1,SYS*1 CHARACTER CATMOD*1,SYS*1,LINE*80
DATA SYS/'P','A','B','C','I','F','R'/ DATA SYS/'P','A','B','C','I','F','R'/
DATA TRANS/ 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0,.5,.5, DATA TRANS/ 1, 0, 0, 0, 1, 0, 0, 0, 1, 1, 0, 0, 0,.5,.5,
$ 0, 0, 1, .5, 0,.5, 0, 1, 0, 0, 0, 1, .5,.5, 0, $ 0, 0, 1, .5, 0,.5, 0, 1, 0, 0, 0, 1, .5,.5, 0,
@ -20,7 +20,8 @@ C-----------------------------------------------------------------------
ALP(I) = RADEG*ATAN2(SANG(I),CANG(I)) ALP(I) = RADEG*ATAN2(SANG(I),CANG(I))
100 CONTINUE 100 CONTINUE
110 WRITE (COUT,10000) 110 WRITE (COUT,10000)
CALL ALFNUM (CATMOD) CALL ALFNUM (LINE)
CATMOD = LINE(1:1)
IF (CATMOD .EQ. ' ') CATMOD = 'P' IF (CATMOD .EQ. ' ') CATMOD = 'P'
READ (CATMOD,11000) ATMOD READ (CATMOD,11000) ATMOD
WRITE (COUT,12000) A,ALP,CATMOD WRITE (COUT,12000) A,ALP,CATMOD

22
difrac/difint.f
View File

@ -12,6 +12,7 @@ C-----------------------------------------------------------------------
SUBROUTINE DIFINT(COMMAND, LEN) SUBROUTINE DIFINT(COMMAND, LEN)
INTEGER COMMAND(256), LEN INTEGER COMMAND(256), LEN
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
CHARACTER STRING*80
KI(1:1) = CHAR(COMMAND(1)) KI(1:1) = CHAR(COMMAND(1))
KI(2:2) = CHAR(COMMAND(2)) KI(2:2) = CHAR(COMMAND(2))
@ -83,7 +84,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 2) THEN IF (I .EQ. 0 .OR. I .EQ. 2) THEN
@ -91,7 +93,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 3) THEN IF (I .EQ. 0 .OR. I .EQ. 3) THEN
@ -99,7 +102,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 4) THEN IF (I .EQ. 0 .OR. I .EQ. 4) THEN
@ -107,7 +111,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 5) THEN IF (I .EQ. 0 .OR. I .EQ. 5) THEN
@ -115,7 +120,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 6) THEN IF (I .EQ. 0 .OR. I .EQ. 6) THEN
@ -125,7 +131,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN
@ -133,7 +140,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
ENDIF ENDIF

5
difrac/mesint.f
View File

@ -26,7 +26,10 @@ C-----------------------------------------------------------------------
IWARN = 0 IWARN = 0
ISIGN = 1 ISIGN = 1
IF (THETA .LT. 0.0 .OR. THETA .GT. 180.0) ISIGN = -1 IF (THETA .LT. 0.0 .OR. THETA .GT. 180.0) ISIGN = -1
D12 = BS*ABS(TAN(0.5*THETA/DEG)) C---- Modified MK: there is no alpha1 alpha2 separation with neutrons
C D12 = BS*ABS(TAN(0.5*THETA/DEG))
D12 = 0.
C---- end of modification
TTIME = 0.20*PRESET TTIME = 0.20*PRESET
110 CALL SHUTTR (1) 110 CALL SHUTTR (1)
IF (NATTEN .GT. 0) THEN IF (NATTEN .GT. 0) THEN

17
difrac/pfind.f
View File

@ -1,8 +1,9 @@
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Get the coarse value of Phi for PCENTR C Get the coarse value of Phi for PCENTR
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
SUBROUTINE PFIND (TIM) SUBROUTINE PFIND (TIM,MAXCOUNT)
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
REAL MAXCOUNT, MCOUNT
DIMENSION PCOUNT(NSIZE) DIMENSION PCOUNT(NSIZE)
EQUIVALENCE (ACOUNT(9*NSIZE + 1), PCOUNT(1)) EQUIVALENCE (ACOUNT(9*NSIZE + 1), PCOUNT(1))
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
@ -30,6 +31,11 @@ C-----------------------------------------------------------------------
MCOUNT = 0 MCOUNT = 0
DO 110 I = 1,NPTS DO 110 I = 1,NPTS
CALL CCTIME (TIM,PCOUNT(I)) CALL CCTIME (TIM,PCOUNT(I))
CALL KORQ (IFLAG1)
IF (IFLAG1 .NE. 1) THEN
KI = 'O4'
RETURN
ENDIF
IF (PCOUNT(I) .GT. MCOUNT) THEN IF (PCOUNT(I) .GT. MCOUNT) THEN
MCOUNT = PCOUNT(I) MCOUNT = PCOUNT(I)
ICOUNT = I ICOUNT = I
@ -39,16 +45,11 @@ C-----------------------------------------------------------------------
IF (PHI .GE. 360.0) PHI = PHI - 360.0 IF (PHI .GE. 360.0) PHI = PHI - 360.0
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
110 CONTINUE 110 CONTINUE
MAXCOUNT = REAL(MCOUNT)
IF (ICOUNT .EQ. 1 .OR. ICOUNT .EQ. NPTS) THEN IF (ICOUNT .EQ. 1 .OR. ICOUNT .EQ. NPTS) THEN
TIM = 5.0 TIM = -5.0
RETURN RETURN
ENDIF ENDIF
PHI = PHIOFF + (ICOUNT - 1)*PSTEP PHI = PHIOFF + (ICOUNT - 1)*PSTEP
TIM = 500.0*TIM/PCOUNT(ICOUNT)
IF (TIM .LT. 10000.0) THEN
IF (TIM .LT. 1000.) TIM = 1000.
PSTEP = PSTEP/4
IF (PSTEP .GT. STEPM) GO TO 100
ENDIF
RETURN RETURN
END END

6
difrac/prnbas.f
View File

@ -6,7 +6,8 @@ C-----------------------------------------------------------------------
DIMENSION RW(3,3),ANG(3) DIMENSION RW(3,3),ANG(3)
CHARACTER CPROF*4,STRING*10 CHARACTER CPROF*4,STRING*10
WRITE (COUT,10000) WRITE (COUT,10000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
KZ = -1 KZ = -1
IF (ANS .EQ. ' ' .OR. ANS .EQ. '0') KZ = 0 IF (ANS .EQ. ' ' .OR. ANS .EQ. '0') KZ = 0
IF (ANS .EQ. '1') KZ = 1 IF (ANS .EQ. '1') KZ = 1
@ -115,7 +116,8 @@ C-----------------------------------------------------------------------
C Pause to allow users to read the screen C Pause to allow users to read the screen
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
WRITE (COUT,20000) WRITE (COUT,20000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Theta min/max and h,k,l max data C Theta min/max and h,k,l max data
C----------------------------------------------------------------------- C-----------------------------------------------------------------------

14
difrac/profil.f
View File

@ -183,8 +183,10 @@ C The profile is suitable for analysis to find the limits
C J1 is the beginning of the low angle search C J1 is the beginning of the low angle search
C J2 is the beginning of the high angle search C J2 is the beginning of the high angle search
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
J1 = MAXI - STEPOF*CON*AS - A2*ID12 C J1 = MAXI - STEPOF*CON*AS - A2*ID12
J2 = MAXI + STEPOF*CON*CS + A1*ID12 C J2 = MAXI + STEPOF*CON*CS + A1*ID12
J1 = MAXI - ((STEPOF*AS)/STEP) - A2*ID12
J2 = MAXI + ((STEPOF*CS)/STEP) + A1*ID12
IF (J1 .LE. NWIND .OR. J2 .GE. NP-NWIND) THEN IF (J1 .LE. NWIND .OR. J2 .GE. NP-NWIND) THEN
ILOW = 1 ILOW = 1
IHIGH = NP IHIGH = NP
@ -255,6 +257,9 @@ C-----------------------------------------------------------------------
DO 220 I = 1,ILOW-1 DO 220 I = 1,ILOW-1
B1 = B1 + ACOUNT(I) B1 = B1 + ACOUNT(I)
220 CONTINUE 220 CONTINUE
C---mk
B1 = B1/ILOW
C---
ENDIF ENDIF
FRAC1 = (FRAC*NP + ILOW - 1)/NPK FRAC1 = (FRAC*NP + ILOW - 1)/NPK
PEAK = 0.0 PEAK = 0.0
@ -266,9 +271,12 @@ C-----------------------------------------------------------------------
DO 230 I = IHIGH+1,NP DO 230 I = IHIGH+1,NP
B2 = B2 + ACOUNT(I) B2 = B2 + ACOUNT(I)
230 CONTINUE 230 CONTINUE
IDIV = NP - IHIGH
IF(IDIV .LE. 0)IDIV =1
B2 = B2/IDIV
ENDIF ENDIF
FRAC2 = (FRAC*NP + NP - IHIGH)/NPK FRAC2 = (FRAC*NP + NP - IHIGH)/NPK
BTOT = 0.5*(B1/FRAC1 + B2/FRAC2) BTOT = 0.5*(B1/FRAC1 + B2/FRAC2)*NP
TOP1 = PEAK - BTOT TOP1 = PEAK - BTOT
BOT1 = SQRT(PEAK + 0.25*(B1/(FRAC1*FRAC1) + B2/(FRAC2*FRAC2))) BOT1 = SQRT(PEAK + 0.25*(B1/(FRAC1*FRAC1) + B2/(FRAC2*FRAC2)))
FRAC1 = 0.5*(FRAC1 + FRAC2) FRAC1 = 0.5*(FRAC1 + FRAC2)

7
difrac/rcpcor.f
View File

@ -8,6 +8,7 @@ C-----------------------------------------------------------------------
SUBROUTINE RCPCOR SUBROUTINE RCPCOR
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
DIMENSION RM1(3,3),XA(3),HA(3) DIMENSION RM1(3,3),XA(3),HA(3)
CHARACTER STRING*80
IF (KI .EQ. 'AH') THEN IF (KI .EQ. 'AH') THEN
WRITE (COUT,10000) WRITE (COUT,10000)
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
@ -58,7 +59,8 @@ C Index faces for ABSORP when they are set so that the face normal is
C in the equator plane and normal to the microscope viewing direction C in the equator plane and normal to the microscope viewing direction
C at the Kappa angles -45, 78, kappa (-60 start), phi (0 start) C at the Kappa angles -45, 78, kappa (-60 start), phi (0 start)
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
SUBROUTINE FACEIN SUBROUTINE FACEIN
CHARACTER STRING*80
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
DATA ISENSE/-1/ DATA ISENSE/-1/
NATT = 0 NATT = 0
@ -79,7 +81,8 @@ C-----------------------------------------------------------------------
C Get the adjusted angles and transform them C Get the adjusted angles and transform them
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
100 WRITE (COUT,11000) 100 WRITE (COUT,11000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
C write (cout,99990) C write (cout,99990)
C99990 format (' Type omk, kap, phk for face ',$) C99990 format (' Type omk, kap, phk for face ',$)
C call freefm (itr) C call freefm (itr)

25
difrac/setop.f
View File

@ -11,8 +11,10 @@ C
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
SUBROUTINE SETOP SUBROUTINE SETOP
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
CHARACTER STRING*80
100 WRITE (COUT,10000) 100 WRITE (COUT,10000)
CALL ALFNUM (KI) CALL ALFNUM (STRING)
KI = STRING(1:2)
IF (KI .EQ. 'Q') THEN IF (KI .EQ. 'Q') THEN
CALL WNEND CALL WNEND
STOP STOP
@ -74,7 +76,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 2) THEN IF (I .EQ. 0 .OR. I .EQ. 2) THEN
@ -82,7 +85,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 3) THEN IF (I .EQ. 0 .OR. I .EQ. 3) THEN
@ -90,7 +94,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 4) THEN IF (I .EQ. 0 .OR. I .EQ. 4) THEN
@ -98,7 +103,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 5) THEN IF (I .EQ. 0 .OR. I .EQ. 5) THEN
@ -106,7 +112,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (I .EQ. 0 .OR. I .EQ. 6) THEN IF (I .EQ. 0 .OR. I .EQ. 6) THEN
@ -116,7 +123,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN IF (DFMODL .EQ. 'CAD4' .AND. (I .EQ. 0 .OR. I .EQ. 7)) THEN
@ -124,7 +132,8 @@ C-----------------------------------------------------------------------
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
IF (I .EQ. 0) THEN IF (I .EQ. 0) THEN
WRITE (COUT,14000) WRITE (COUT,14000)
CALL ALFNUM (ANS) CALL ALFNUM (STRING)
ANS = STRING(1:1)
ENDIF ENDIF
ENDIF ENDIF
ENDIF ENDIF

123
difrac/tcentr.f
View File

@ -16,6 +16,7 @@ C-----------------------------------------------------------------------
$ (ACOUNT(6*NSIZE+1),OMEGP(1)), $ (ACOUNT(6*NSIZE+1),OMEGP(1)),
$ (ACOUNT(7*NSIZE+1),CHIP(1)), $ (ACOUNT(7*NSIZE+1),CHIP(1)),
$ (ACOUNT(8*NSIZE+1),PHIP(1)) $ (ACOUNT(8*NSIZE+1),PHIP(1))
REAL CURCTS,MAXCTS
WIDTH = 1.25 WIDTH = 1.25
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Read the peaks from disk C Read the peaks from disk
@ -60,85 +61,57 @@ C Set the angles at the approximate position of the peak and adjust
C Phi, Chi and 2Theta to get maximum intensity in the detector. C Phi, Chi and 2Theta to get maximum intensity in the detector.
C Sietronics interface works via MAXPOINT; CAD4 via CADCEN C Sietronics interface works via MAXPOINT; CAD4 via CADCEN
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C CAD-4 and Sietronics deleted for clarity: Mark Koennecke
CALL SHUTTR (99) CALL SHUTTR (99)
ITIMS(J) = 0
IF (DFMODL .EQ. 'CAD4') THEN
KI = 'SP'
CALL CADCEN (0)
IF (KI .EQ. 'FF') THEN
WHICH = 'Phi'
WRITE (COUT,13000) WHICH
CALL GWRITE (ITP,' ')
WRITE (LPT,13000) WHICH
GO TO 200
ENDIF
110 CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
KI = 'ST'
IGOOD = 0
CALL CADCEN (IGOOD)
C write (lpt,99993) ki,igood
C99993 format (' KI,igood ',a,i4)
IF (KI .EQ. 'FF' .OR. KI .EQ. 'TO' .OR. KI .EQ. 'BO') THEN
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,IERR)
KI = 'SC'
RTIM = PRESET
CALL CFIND (RTIM)
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
IF (RTIM .GT. 3.0) THEN
WHICH = 'Chi'
WRITE (COUT,13000) WHICH
CALL GWRITE (ITP,' ')
WRITE (LPT,13000) WHICH
GO TO 200
ENDIF
KI = 'SO'
IGOOD = 0
CALL CADCEN (IGOOD)
IF (KI .EQ. 'FF') THEN
WHICH = 'Omega'
WRITE (COUT,13000) WHICH
CALL GWRITE (ITP,' ')
WRITE (LPT,13000) WHICH
GO TO 200
ENDIF
GO TO 110
ENDIF
IF (IGOOD .NE. 0) GO TO 110
C-----------------------------------------------------------------------
C Sietronics 145D centring
C-----------------------------------------------------------------------
ELSE IF (DFMODL .EQ. '145D') THEN
PWIDTH = 2*WIDTH
CALL MAXPOINT (3,PWIDTH,0.1,RMAXPT)
PHI = RMAXPT
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
CWIDTH = 4*WIDTH
CALL MAXPOINT (2,CWIDTH,0.1,RMAXPT)
CHI = RMAXPT
OMEGA = OMEGA - 0.5*TWIDTH
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
TWIDTH = WIDTH
CALL MAXPOINT (4,TWIDTH,0.1,RMAXPT)
THETA = RMAXPT
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C All other machines for the moment C All other machines for the moment
C Modified: Mark Koennecke for TRICS
C Do initial search. But use the results of the searches
C only if they improved the countrate.
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
ELSE CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
RTIM = 1000. CALL CCTIME (PRESET,CURCTS)
CALL PFIND (RTIM) C----- first two theta
THETA = RTHETA RTIM = PRESET
OMEGA = ROMEGA CALL TFIND(RTIM,MAXCTS)
IF (RTIM .GT. 10000.0) GO TO 200 IF(MAXCTS .LT. CURCTS) THEN
C IF (RTIM .GT. 1.0) RTIM = 1.0 THETA = RTHETA
CHI = RCHI + 1.25 OMEGA = ROMEGA
CALL CFIND (RTIM) ELSE
THETA = RTHETA + 1.25 CURCTS = MAXCTS
OMEGA = OMEGA - 0.625 ENDIF
IF (RTIM .GT. 10000.0) GO TO 200 CALL KORQ (IFLAG1)
C IF (RTIM .GT. 1.0) RTIM = 1.0 IF (IFLAG1 .NE. 1) THEN
CALL TFIND (RTIM) KI = 'O4'
IF (RTIM .GT. 10000.0) GO TO 200 RETURN
ENDIF ENDIF
C----- now phi
RTIM = PRESET
CALL PFIND(RTIM,MAXCTS)
IF(MAXCTS .LT. CURCTS) THEN
PHI = RPHI
ELSE
CURCTS = MAXCTS
ENDIF
CALL KORQ (IFLAG1)
IF (IFLAG1 .NE. 1) THEN
KI = 'O4'
RETURN
ENDIF
C------ finally phi
RTIM = PRESET
CALL CFIND(RTIM,MAXCTS)
IF(MAXCTS .LT. CURCTS) THEN
CHI = RCHI
ELSE
CURCTS = MAXCTS
ENDIF
CALL KORQ (IFLAG1)
IF (IFLAG1 .NE. 1) THEN
KI = 'O4'
RETURN
ENDIF
C------- end of pre centering
WRITE (COUT,11000) THETA,OMEGA,CHI,PHI WRITE (COUT,11000) THETA,OMEGA,CHI,PHI
CALL GWRITE (ITP,' ') CALL GWRITE (ITP,' ')
WRITE (LPT,11000) THETA,OMEGA,CHI,PHI WRITE (LPT,11000) THETA,OMEGA,CHI,PHI

27
difrac/tfind.f
View File

@ -1,8 +1,9 @@
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C Find the Coarse setting for 2-Theta C Find the Coarse setting for 2-Theta
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
SUBROUTINE TFIND (TIM) SUBROUTINE TFIND (TIM, MAXCOUNT)
INCLUDE 'COMDIF' INCLUDE 'COMDIF'
REAL MAXCOUNT, MCOUNT
DIMENSION TCOUNT(NSIZE) DIMENSION TCOUNT(NSIZE)
EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1)) EQUIVALENCE (ACOUNT(9*NSIZE+1),TCOUNT(1))
STEPM = 0.01 STEPM = 0.01
@ -10,6 +11,7 @@ C-----------------------------------------------------------------------
TSTEP = 0.25 TSTEP = 0.25
NATT = 0 NATT = 0
NPTS = 10 NPTS = 10
NRUN = 0
100 THEOFF = THETA 100 THEOFF = THETA
OMEOFF = OMEGA OMEOFF = OMEGA
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
@ -17,6 +19,11 @@ C-----------------------------------------------------------------------
MCOUNT = 0 MCOUNT = 0
DO 110 I = 1,NPTS DO 110 I = 1,NPTS
CALL CCTIME (TIM,TCOUNT(I)) CALL CCTIME (TIM,TCOUNT(I))
CALL KORQ (IFLAG1)
IF (IFLAG1 .NE. 1) THEN
KI = 'O4'
RETURN
ENDIF
IF (TCOUNT(I) .GT. MCOUNT) THEN IF (TCOUNT(I) .GT. MCOUNT) THEN
MCOUNT = TCOUNT(I) MCOUNT = TCOUNT(I)
ICOUNT = I ICOUNT = I
@ -25,10 +32,20 @@ C-----------------------------------------------------------------------
OMEGA = OMEGA - SENSE*TSTEP*0.5 OMEGA = OMEGA - SENSE*TSTEP*0.5
CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL) CALL ANGSET (THETA,OMEGA,CHI,PHI,NATT,ICOL)
110 CONTINUE 110 CONTINUE
MAXCOUNT = MCOUNT
IF (ICOUNT .EQ. 1) THEN IF (ICOUNT .EQ. 1) THEN
C
C try, the other direction. But only once as checked by NRUN
C otherwise we end in an endless loop.
C
IF (NRUN .GT. 0) THEN
MAXCOUNT = 0.
RETURN
ENDIF
SENSE = -SENSE SENSE = -SENSE
THETA = THEOFF + 9.0*SENSE*TSTEP THETA = THEOFF + 9.0*SENSE*TSTEP
OMEGA = OMEOFF - 9.0*SENSE*TSTEP/2 OMEGA = OMEOFF - 9.0*SENSE*TSTEP/2
NRUN = NRUN + 1
GO TO 100 GO TO 100
ENDIF ENDIF
IF (ICOUNT .EQ. 10) THEN IF (ICOUNT .EQ. 10) THEN
@ -36,14 +53,6 @@ C-----------------------------------------------------------------------
OMEGA = OMEOFF + 3.0*SENSE*TSTEP/2 OMEGA = OMEOFF + 3.0*SENSE*TSTEP/2
GO TO 100 GO TO 100
ENDIF ENDIF
THETA = THEOFF + (ICOUNT - 2.25)*SENSE*TSTEP
OMEGA = OMEOFF - 0.5*(ICOUNT - 2.25)*SENSE*TSTEP
TIM = 500.0*TIM/TCOUNT(ICOUNT)
IF (TIM .LT. 10000.0) THEN
IF (TIM .LT. 1000.) TIM = 1000.
TSTEP = TSTEP/4.0
IF (TSTEP .GT. STEPM) GO TO 100
ENDIF
THETA = THEOFF + ICOUNT*SENSE*TSTEP THETA = THEOFF + ICOUNT*SENSE*TSTEP
OMEGA = OMEOFF - ICOUNT*SENSE*TSTEP/2 OMEGA = OMEOFF - ICOUNT*SENSE*TSTEP/2
RETURN RETURN

5
difrac/yesno.f
View File

@ -18,14 +18,15 @@ C-----------------------------------------------------------------------
COMMON /IOUASS/ IOUNIT(12) COMMON /IOUASS/ IOUNIT(12)
CHARACTER*132 COUT(20) CHARACTER*132 COUT(20)
COMMON /IOUASC/ COUT COMMON /IOUASC/ COUT
CHARACTER DEFOLT*1,ANS*1 CHARACTER DEFOLT*1,ANS*1,LINE*80
ITR = IOUNIT(5) ITR = IOUNIT(5)
ITP = IOUNIT(6) ITP = IOUNIT(6)
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
C This code gets round IBM VM/CMS limitations C This code gets round IBM VM/CMS limitations
C----------------------------------------------------------------------- C-----------------------------------------------------------------------
100 CALL GWRITE (ITP,'$') 100 CALL GWRITE (ITP,'$')
CALL GETLIN (ANS) CALL GETLIN (LINE)
ANS=LINE(1:1)
IF (ANS .EQ. '?') STOP IF (ANS .EQ. '?') STOP
IF (ANS .EQ. 'y') ANS = 'Y' IF (ANS .EQ. 'y') ANS = 'Y'
IF (ANS .EQ. 'n') ANS = 'N' IF (ANS .EQ. 'n') ANS = 'N'

2606
doc/user/diftrics.htm Normal file
View File

File diff suppressed because it is too large Load Diff

10
doc/user/tricsingle.htm
View File

@ -14,14 +14,20 @@ to be solved are:
<li>Measure a couple of reflections. <li>Measure a couple of reflections.
<li>Furthermore there are some specialities. <li>Furthermore there are some specialities.
</ul> </ul>
There are two ways to achieve all this: The older way uses some built in SICS functionality plus some external prograsm inherited from the ILL. This is called the ILL operation. Then a complete four circle packaage called DIFRAC from P. White and Eric Gabe was integrated into SICS. Thsi is The Difrac way of operation. There are two ways to achieve all this:
The older way uses some built in SICS functionality plus some external
programs inherited from the ILL. This is called the ILL operation.
Then a complete
four circle package called DIFRAC from P. White and Eric Gabe was
integrated into SICS.
This is The Difrac way of operation.
</p> </p>
<h2>DIFRAC</h2> <h2>DIFRAC</h2>
<p> <p>
The DIFRAC commands are accessed by prepending the difrac commands The DIFRAC commands are accessed by prepending the difrac commands
with <b>dif</b>. For example: "dif td" calls the difrac td with <b>dif</b>. For example: "dif td" calls the difrac td
command. For more information on DIFRAC commands see the separate command. For more information on DIFRAC commands see the separate
DIFRAC manual. <a href="diftrics.htm">DIFRAC manual</a>.
</p> </p>
<h2>ILL operation</h2> <h2>ILL operation</h2>

32
drive.c
View File

@ -51,7 +51,7 @@
#include "splitter.h" #include "splitter.h"
#include "status.h" #include "status.h"
#include "devexec.h" #include "devexec.h"
#include "motor.h"
/*---------------------------------------------------------------------------*/ /*---------------------------------------------------------------------------*/
int Drive(SConnection *pCon, SicsInterp *pInter, char *name, float fNew) int Drive(SConnection *pCon, SicsInterp *pInter, char *name, float fNew)
@ -128,7 +128,7 @@
/* wait for finish */ /* wait for finish */
iRet = Wait4Success(GetExecutor()); iRet = Wait4Success(GetExecutor());
fPos = pInt->GetValue(pDum,pCon); fPos = pInt->GetValue(pDum,pCon);
if(iRet == DEVINT) if(iRet == DEVINT)
{ {
if(SCGetInterrupt(pCon) == eAbortOperation) if(SCGetInterrupt(pCon) == eAbortOperation)
@ -250,6 +250,27 @@
pObjectDescriptor pDes = NULL; pObjectDescriptor pDes = NULL;
pIDrivable pInt = NULL; pIDrivable pInt = NULL;
Dummy *pDum = NULL; Dummy *pDum = NULL;
pMotor pMot = NULL;
float fPos;
int iRet;
/*
treat motors separatetly in order to correct for zero points
Sighh.........
*/
pMot = FindMotor(pSics,name);
if(pMot != NULL)
{
iRet = MotorGetSoftPosition(pMot,pCon,&fPos);
if(iRet)
{
return fPos;
}
else
{
return -999.;
}
}
pObject = FindCommand(pSics,name); pObject = FindCommand(pSics,name);
if(pObject) if(pObject)
@ -341,11 +362,12 @@
SCWrite(pCon,pBueffel,eError); SCWrite(pCon,pBueffel,eError);
ClearExecutor(GetExecutor()); ClearExecutor(GetExecutor());
SetStatus(eOld); SetStatus(eOld);
return 1; return 0;
} }
else if(iRet == DEVINT) else if(iRet == DEVINT)
{ {
SCWrite(pCon,"Driving Interrupted",eError); sprintf(pBueffel,"Driving Interrupted!",argv[0]);
SCWrite(pCon,pBueffel,eError);
ClearExecutor(GetExecutor()); ClearExecutor(GetExecutor());
SetStatus(eOld); SetStatus(eOld);
return 0; return 0;

8
fowrite.c
View File

@ -429,6 +429,13 @@
sprintf(pBueffel,"%d",iInt); sprintf(pBueffel,"%d",iInt);
NXDupdate(pDict,"timebin",pBueffel); NXDupdate(pDict,"timebin",pBueffel);
lData = GetHistogramPointer(self->pHist,pCon); lData = GetHistogramPointer(self->pHist,pCon);
if(!lData)
{
SCWrite(pCon,"ERROR: failed to find Histogram Memory Data",eError);
NXclose(&pFile);
NXDclose(pDict,NULL);
return;
}
setFMDataPointer(lData,iTime); setFMDataPointer(lData,iTime);
if(self->iUpper) if(self->iUpper)
{ {
@ -615,7 +622,6 @@
/* close everything */ /* close everything */
free(lData);
NXclose(&pFile); NXclose(&pFile);
NXDclose(pDict,NULL); NXDclose(pDict,NULL);

7
histmem.c
View File

@ -62,7 +62,6 @@
/* /*
#define LOADDEBUG 1 #define LOADDEBUG 1
*/ */
/*------------------------------------------------------------------------*/ /*------------------------------------------------------------------------*/
static int HistHalt(void *pData) static int HistHalt(void *pData)
@ -997,6 +996,12 @@
return NULL; return NULL;
} }
if(self->iLocalData == NULL)
{
self->iLocalUpdate = 1;
self->tLocal = 0;
}
/* get the full histogram if an update is needed */ /* get the full histogram if an update is needed */
if( (self->iLocalUpdate) && (time(NULL) > self->tLocal) ) if( (self->iLocalUpdate) && (time(NULL) > self->tLocal) )
{ {

3
nread.c
View File

@ -367,7 +367,8 @@ extern VerifyChannel(mkChannel *self); /* defined in network.c */
pTel = CreateTelnet(pRes); pTel = CreateTelnet(pRes);
if(!pTel) if(!pTel)
{ {
SICSLogWrite("Failure to allocate new Telnet Task Object",eInternal); SICSLogWrite("Failure to allocate new Telnet Task Object",
eInternal);
SCDeleteConnection(pRes); SCDeleteConnection(pRes);
return 0; return 0;
} }

3
nxsans.c
View File

@ -284,6 +284,9 @@
lVal = GetHistMonitor(self,0,pCon); lVal = GetHistMonitor(self,0,pCon);
iVal = (int32)lVal; iVal = (int32)lVal;
NXDputalias(Nfil,pDict,"m1counts",&iVal); NXDputalias(Nfil,pDict,"m1counts",&iVal);
lVal = GetHistMonitor(self,4,pCon);
iVal = (int32)lVal;
NXDputalias(Nfil,pDict,"pbcounts",&iVal);
/* the collimator */ /* the collimator */
pCom = FindCommand(pSics,"sps2"); pCom = FindCommand(pSics,"sps2");

24
scan.c
View File

@ -134,6 +134,8 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
pIDrivable pDriv = NULL; pIDrivable pDriv = NULL;
float fVal; float fVal;
pMotor pMot = NULL; pMotor pMot = NULL;
pVarEntry pScanVar = NULL;
void *pVoid = NULL;
assert(self->pSics); assert(self->pSics);
assert(self->pCon); assert(self->pCon);
@ -286,9 +288,31 @@ extern void SNXFormatTime(char *pBuffer, int iLen);
fprintf(self->fd,"%s %s\n",pBuffer,self->pFile); fprintf(self->fd,"%s %s\n",pBuffer,self->pFile);
continue; continue;
} }
/*------------ scanzero */
pPtr = strstr(pBuffer,"!!SCANZERO!!");
if(pPtr)
{
*pPtr = '\0';
/* write zero point of first scan variable if motor */
DynarGet(self->pScanVar,0,&pVoid);
pScanVar = (pVarEntry)pVoid;
if(pScanVar)
{
pMot = NULL;
pMot = FindMotor(self->pSics,pScanVar->Name);
if(pMot != NULL)
{
MotorGetPar(pMot,"softzero",&fVal);
fprintf(self->fd,"%s zero = %8.3f\n",pScanVar->Name, fVal);
}
}
}
/* --------- plain text */ /* --------- plain text */
fprintf(self->fd,"%s",pBuffer); fprintf(self->fd,"%s",pBuffer);
} /* end while */ } /* end while */
/* remember position for seeking to it for writing data */
self->lPos = ftell(self->fd); self->lPos = ftell(self->fd);
fclose(fd); fclose(fd);

28
sicsstatus.tcl
View File

@ -6,7 +6,7 @@ flightpath setAccess 1
delay 2500.000000 delay 2500.000000
delay setAccess 1 delay setAccess 1
hm CountMode timer hm CountMode timer
hm preset 100.000000 hm preset 2.000000
hm genbin 120.000000 35.000000 512 hm genbin 120.000000 35.000000 512
hm init hm init
datafile focus-1001848.hdf datafile focus-1001848.hdf
@ -117,10 +117,10 @@ twotheta AccessCode 2.000000
lastscancommand sscan ch 180 190 10 2 lastscancommand sscan ch 180 190 10 2
lastscancommand setAccess 2 lastscancommand setAccess 2
banana CountMode timer banana CountMode timer
banana preset 100.000000 banana preset 2.000000
sample_mur 0.000000 sample_mur 0.000000
sample_mur setAccess 2 sample_mur setAccess 2
email UNKNOWN email Uwe.Nurps@nurps.nurpstown.de
email setAccess 2 email setAccess 2
fax UNKNOWN fax UNKNOWN
fax setAccess 2 fax setAccess 2
@ -129,7 +129,7 @@ phone setAccess 2
adress UNKNOWN adress UNKNOWN
adress setAccess 2 adress setAccess 2
# Counter counter # Counter counter
counter SetPreset 1.000000 counter SetPreset 120.000000
counter SetMode Timer counter SetMode Timer
# Motor som # Motor som
som SoftZero 0.000000 som SoftZero 0.000000
@ -244,9 +244,9 @@ d1r sign 1.000000
d1r InterruptMode 0.000000 d1r InterruptMode 0.000000
d1r AccessCode 2.000000 d1r AccessCode 2.000000
# Motor tasse # Motor tasse
tasse SoftZero 0.000000 tasse SoftZero 10.000000
tasse SoftLowerLim -130.000000 tasse SoftLowerLim -140.000000
tasse SoftUpperLim 130.000000 tasse SoftUpperLim 120.000000
tasse Fixed -1.000000 tasse Fixed -1.000000
tasse sign 1.000000 tasse sign 1.000000
tasse InterruptMode 0.000000 tasse InterruptMode 0.000000
@ -332,9 +332,9 @@ a5 sign 1.000000
a5 InterruptMode 0.000000 a5 InterruptMode 0.000000
a5 AccessCode 2.000000 a5 AccessCode 2.000000
# Motor a4 # Motor a4
a4 SoftZero 0.000000 a4 SoftZero 10.000000
a4 SoftLowerLim -130.000000 a4 SoftLowerLim -140.000000
a4 SoftUpperLim 130.000000 a4 SoftUpperLim 120.000000
a4 Fixed -1.000000 a4 Fixed -1.000000
a4 sign 1.000000 a4 sign 1.000000
a4 InterruptMode 0.000000 a4 InterruptMode 0.000000
@ -363,11 +363,11 @@ a1 Fixed -1.000000
a1 sign 1.000000 a1 sign 1.000000
a1 InterruptMode 0.000000 a1 InterruptMode 0.000000
a1 AccessCode 2.000000 a1 AccessCode 2.000000
user Daniel_the_Clementine user Joseph Stalin
user setAccess 2 user setAccess 2
sample DanielOxid sample Fischdosen
sample setAccess 2 sample setAccess 2
title TopsiTupsiTapsi title Nasse Fische in Dosen
title setAccess 2 title setAccess 2
starttime UNKNOWN starttime 2000-03-31 11:40:31
starttime setAccess 2 starttime setAccess 2

14
tcl/count.tcl
View File

@ -10,6 +10,7 @@ proc SplitReply { text } {
} }
#-------------------------------------------------------------------------- #--------------------------------------------------------------------------
proc count { {mode NULL } { preset NULL } } { proc count { {mode NULL } { preset NULL } } {
starttime [sicstime]
#----- deal with mode #----- deal with mode
set mode2 [string toupper $mode] set mode2 [string toupper $mode]
set mode3 [string trim $mode2] set mode3 [string trim $mode2]
@ -32,14 +33,21 @@ proc count { {mode NULL } { preset NULL } } {
$bb $aa] $bb $aa]
#------- count #------- count
banana InitVal 0 banana InitVal 0
wait 1
banana count banana count
Success set ret [catch {Success} msg]
#------- StoreData #------- StoreData
# ClientPut [StoreData] # StoreData
if { $ret != 0 } {
error [format "Counting ended with error"]
}
} }
#---------------- Repeat ----------------------------------------------- #---------------- Repeat -----------------------------------------------
proc repeat { num {mode NULL} {preset NULL} } { proc repeat { num {mode NULL} {preset NULL} } {
for { set i 0 } { $i < $num } { incr i } { for { set i 0 } { $i < $num } { incr i } {
count $mode $preset set ret [catch {count $mode $preset} msg]
if {$ret != 0} {
error "Counting ended with error"
}
} }
} }

45
tcl/scancom.tcl
View File

@ -318,6 +318,7 @@ if {$ret != 0} {
Publish sscan User Publish sscan User
Publish sftime Spy Publish sftime Spy
Publish scaninfo Spy Publish scaninfo Spy
Publish wwwsics Spy
} }
#************************************************************************* #*************************************************************************
@ -359,10 +360,50 @@ proc scaninfo {} {
append result "," [lindex $l1 1] append result "," [lindex $l1 1]
return [format "scaninfo = %s" $result] return [format "scaninfo = %s" $result]
} }
#----------------------------------------------------------------------
# wwwsics is a procedure which formats the most important status
# information for the WWW-status.
proc wwwsics {} {
#----- get all the data we need
set user [GetNum [user]]
set sample [GetNum [sample]]
set tit [GetNum [title]]
set ret [catch {lambda} msg]
if {$ret != 0 } {
set lam Undetermined
} else {
set lam [GetNum $msg]
}
set lscan [GetNum [lastscancommand]]
set svar [GetNum [scan getvars]]
set ind [string last -END- $svar]
if { $ind > 2 } {
set svar [string range $svar 0 $ind]
} else {
set svar " "
}
set res [scan info]
set l [split $res ,]
set fil [lindex $l 5]
set run [GetNum [sicsdatanumber]]
set stat [GetNum [status]]
#------- html format the reply
append result "<table BORDER=2>"
append result <tr> <th>Run Number</th> <td> $run </td> </tr>
append result <tr> <th>Title</th> <td> $tit </td> </tr>
append result <tr> <th>User</th> <td> $user </td> </tr>
append result <tr> <th>Sample </th> <td> $sample </td> </tr>
append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
append result <tr> <th>Status</th> <td> $stat</td> </tr>
append result <tr> <th>Scan Variables</th> <td> $svar</td> </tr>
append result <tr> <th>File </th> <td> $fil</td> </tr>
append result <tr> <th>Last Scan Command</th> <td> $lscan</td> </tr>
append result </table>
return $result
}
#===================== Syntactical sugar around scan =================== #===================== Syntactical sugar around scan ===================
# center scan. A convenience scan for the one and only Daniel Clemens # center scan. A convenience scan for the one and only Daniel Clemens
# at TOPSI. Scans around a given ceter point. Requires the scan command # at TOPSI. Scans around a given center point. Requires the scan command
# for TOPSI to work. # for TOPSI to work.
# #
# another convenience scan: # another convenience scan:

43
tcl/wwwpulver.tcl Normal file
View File

@ -0,0 +1,43 @@
#------------------------------------------------------------------------
# This implements the wwwsics command which generates a listing of
# important experiment parameters in html format for the SICS WWW Status
# application. This version is for the powder diffractometers DMC and
# HRPT.
#
# Mark Koennecke, March 2000
#------------------------------------------------------------------------
proc wwwsics {} {
#----- get all the data we need
set user [GetNum [user]]
set sample [GetNum [sample]]
set tit [GetNum [title]]
set ret [catch {lambda} msg]
if {$ret != 0 } {
set lam Undetermined
} else {
set lam [GetNum $msg]
}
set ret [catch {temperature} msg]
if {$ret != 0 } {
set tem Undetermined
} else {
set tem [GetNum $msg]
}
set run [GetNum [sicsdatanumber]]
catch {incr run} msg
set stat [GetNum [status]]
#------- html format the reply
append result "<table BORDER=2>"
append result <tr> <th>Run Number</th> <td> $run </td> </tr>
append result <tr> <th>Title</th> <td> $tit </td> </tr>
append result <tr> <th>User</th> <td> $user </td> </tr>
append result <tr> <th>Sample </th> <td> $sample </td> </tr>
append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
append result <tr> <th>Sample Temperature</th> <td> $tem</td> </tr>
append result <tr> <th>Status</th> <td> $stat</td> </tr>
append result </table>
return $result
}
#------------ install command
catch {Publish wwwsics Spy} msg

29
telnet.c
View File

@ -105,7 +105,14 @@
if(self->pCon->iEnd) if(self->pCon->iEnd)
{ {
return 0; if(self->pCon->inUse > 0)
{
return 1;
}
else
{
return 0;
}
} }
/* pop and execute */ /* pop and execute */
@ -136,11 +143,13 @@
pLogin = strstr(pPtr,self->pLoginWord); pLogin = strstr(pPtr,self->pLoginWord);
if(!pLogin) if(!pLogin)
{ {
SCWrite(self->pCon,"------------------- Get Lost -------------------", SCWrite(self->pCon,
eError); "------------------- Get Lost -------------------",
eError);
if(time(&shit) > self->tStart + LOGINWAIT) if(time(&shit) > self->tStart + LOGINWAIT)
{ {
SCWrite(self->pCon,"I cannot stand your login attempts anymore!", SCWrite(self->pCon,
"I cannot stand your login attempts anymore!",
eError); eError);
NetReadRemove(pServ->pReader,self->pCon->pSock); NetReadRemove(pServ->pReader,self->pCon->pSock);
self->pCon->iEnd = 1; self->pCon->iEnd = 1;
@ -161,7 +170,8 @@
sprintf(pBuffer,"SYSTEM ATTACK by %s / %s",pUser, sprintf(pBuffer,"SYSTEM ATTACK by %s / %s",pUser,
pPasswd); pPasswd);
SICSLogWrite(pBuffer,eInternal); SICSLogWrite(pBuffer,eInternal);
SCWrite(self->pCon,"I do not know you, I do not let you in",eError); SCWrite(self->pCon,
"I do not know you, I do not let you in",eError);
SendGA(self->pCon); SendGA(self->pCon);
free(pPtr); free(pPtr);
return 1; return 1;
@ -191,7 +201,14 @@
/* check for end */ /* check for end */
if(self->pCon->iEnd) if(self->pCon->iEnd)
{ {
return 0; if(self->pCon->inUse > 0)
{
return 1;
}
else
{
return 0;
}
} }
return 1; return 1;

15
test.tcl
View File

@ -204,8 +204,8 @@ VarMake email Text User
VarMake sample_mur Float User VarMake sample_mur Float User
MakeDataNumber SicsDataNumber "$shome/sics/danu.dat" MakeDataNumber SicsDataNumber "$shome/sics/danu.dat"
InitSANS $shome/sics/sansdict.dic #InitSANS $shome/sics/sansdict.dic
#InitDMC InitDMC
MakeScanCommand xxxscan counter topsi.hdd recover.bin MakeScanCommand xxxscan counter topsi.hdd recover.bin
MakePeakCenter xxxscan MakePeakCenter xxxscan
@ -228,7 +228,8 @@ banana CountMode Timer
banana init banana init
ClientPut "HM initialized" ClientPut "HM initialized"
source $shome/sics/tcl/scancom.tcl source $shome/sics/tcl/scancom.tcl
source $shome/sics/countf.tcl #source $shome/sics/countf.tcl
source $shome/sics/tcl/count.tcl
Publish count User Publish count User
Publish repeat user Publish repeat user
source $shome/sics/tcl/fit.tcl source $shome/sics/tcl/fit.tcl
@ -340,14 +341,14 @@ MakeFocusAverager average hm
FocusInstall hm focus.dic $shome/sics/focusmerge.dat FocusInstall hm focus.dic $shome/sics/focusmerge.dat
#MakeChopper choco docho lnsp20 4000 8 #MakeChopper choco docho lnsp20 4000 8
MakeChopper choco sim #MakeChopper choco sim
#ChopperAdapter fermispeed choco chopper1.nspee 0 20000 #ChopperAdapter fermispeed choco chopper1.nspee 0 20000
#ChopperAdapter diskspeed choco chopper2.nspee 0 20000 #ChopperAdapter diskspeed choco chopper2.nspee 0 20000
#ChopperAdapter phase choco chopper2.nphas 0 90. #ChopperAdapter phase choco chopper2.nphas 0 90.
#ChopperAdapter ratio choco chopper2.ratio 0 6. #ChopperAdapter ratio choco chopper2.ratio 0 6.
ChopperAdapter diskspeed choco speed 0 20000 #ChopperAdapter diskspeed choco speed 0 20000
ChopperAdapter phase choco phase 0 90. #ChopperAdapter phase choco phase 0 90.
ChopperAdapter ratio choco ratio 0 6. #ChopperAdapter ratio choco ratio 0 6.
source chosta.tcl source chosta.tcl
Publish chosta Spy Publish chosta Spy

1
topsi.hdd
View File

@ -15,4 +15,5 @@ Zero STL = !!ZERO(STL)!!
Zero STU = !!ZERO(STU)!! Zero STU = !!ZERO(STU)!!
Zero SGL = !!ZERO(SGL)!! Zero SGL = !!ZERO(SGL)!!
Zero SGU = !!ZERO(SGU)!! Zero SGU = !!ZERO(SGU)!!
!!SCANZERO!!
**************************** DATA ****************************************** **************************** DATA ******************************************

2
ufortify.h
View File

@ -21,9 +21,9 @@
#define FILL_ON_FREE /* free'd memory is cleared */ #define FILL_ON_FREE /* free'd memory is cleared */
#define FILL_ON_FREE_VALUE 0xA9 /* Value to de-initialize with */ #define FILL_ON_FREE_VALUE 0xA9 /* Value to de-initialize with */
/*
#define CHECK_ALL_MEMORY_ON_MALLOC #define CHECK_ALL_MEMORY_ON_MALLOC
#define CHECK_ALL_MEMORY_ON_FREE #define CHECK_ALL_MEMORY_ON_FREE
/*
#define PARANOID_FREE #define PARANOID_FREE
*/ */