diff --git a/tecs/coc_client.c b/tecs/coc_client.c index 2d393bb4..b2963465 100644 --- a/tecs/coc_client.c +++ b/tecs/coc_client.c @@ -10,7 +10,7 @@ /*-------------------------------------------------------------------------*/ -int CocConnect(CocConn *conn, int allowConnRefused) { +int CocConnect(CocConn *conn) { int i; struct sockaddr_in sadr; @@ -20,7 +20,7 @@ int CocConnect(CocConn *conn, int allowConnRefused) { ERR_SI(setsockopt(conn->fd,SOL_SOCKET,SO_REUSEADDR,&i,sizeof(int))); /* allow quick port reuse */ i=connect(conn->fd, (struct sockaddr *)&sadr, sizeof(sadr)); if (i<0) { - if (allowConnRefused && errno==ECONNREFUSED) return(1); + if (errno==ECONNREFUSED) return(1); ERR_COD(errno); } return(0); @@ -31,24 +31,25 @@ int CocOpen(CocConn *conn) { int i, try, tmo; - ERR_I(i=CocConnect(conn, conn->startcmd[0]!='\0')); + ERR_I(i=CocConnect(conn)); if (i==0) return(0); + if (conn->startcmd[0]=='\0') ERR_MSG("TECS is down, can not restart from here"); - printf("Starting TecsServer...\n\n%s\n", conn->startcmd); + printf("Starting TecsServer ...\n\n%s\n", conn->startcmd); ERR_I(system(conn->startcmd)); try=15; - tmo=100; /* wait total ca. 10 sec. for 15 tries */ + tmo=100; /* wait total ca. 10 sec. for max. 15 tries */ while (try>0) { try--; CocDelay(tmo); tmo=tmo*5/4; - ERR_I(i=CocConnect(conn, try>0)); + ERR_I(i=CocConnect(conn)); if (i==0) { printf("\n... connected to TecsServer\n"); return(0); } } - ERR_MSG("error in CocConnect"); + ERR_MSG("can not start TECS, too many retries"); OnError: return(-1); } @@ -121,7 +122,7 @@ int CocCmdWithRetry(CocConn *conn) { close(conn->fd); conn->fd=-1; if (ErrCode!=ECONNRESET && ErrCode!=EPIPE) goto OnError; - ErrWrite("try again, error was"); + ErrShow("try again, error was"); } ERR_P(err=str_get_str(conn->resbuf, NULL)); if (*err!='\0') { ErrMsg(err); ErrTxt(": (response from server)",0 ); goto OnError; } diff --git a/tecs/coc_client.h b/tecs/coc_client.h index 525e3246..aa4bdd73 100644 --- a/tecs/coc_client.h +++ b/tecs/coc_client.h @@ -4,6 +4,7 @@ #include "coc_util.h" typedef struct { + /* private */ int fd, port; CocVar *varList; Str_Buf *cmdbuf; /* for sending command */ @@ -14,11 +15,35 @@ typedef struct { } CocConn; int CocInitClient(CocConn *conn, char *host, int port, char *magic, int bufsize, char *startcmd); +/* initialize a connection to the server process +*/ + int CocSendMagic(CocConn *conn, char *magic); +/* send magic word to the server for changing access rights +*/ + int CocCmd(CocConn *conn, const char *rwList); +/* rwList consists of a list of variables to be read or written. + Variables must be separated with commas, variables to be written + must be enclosed in square brackets. + + Example (read p1 and p4, write p2 and p3): + CocCmd(&conn, "p1,[p2,p3],p4") + + see COC_UTIL.H for the definiton of variables +*/ + int CocSet(CocConn *conn, const char *name, const char *value); +/* + set one variable +*/ int CocGetN(CocConn *conn, const char *name, char *value, int reslen); #define CocGet(C,N,V) CocGetN(C,N,V,sizeof(V)) +/* + read one variable. Use the macro if value is a fixed length array +*/ void CocCloseClient(CocConn *conn); - +/* + close the connection to the server +*/ #endif /* _COC_CLIENT_H_ */ diff --git a/tecs/coc_logfile.c b/tecs/coc_logfile.c index 802fcfd4..503e6b8f 100644 --- a/tecs/coc_logfile.c +++ b/tecs/coc_logfile.c @@ -43,7 +43,7 @@ void logfileOpen(int first) { if (logfileStd) { fil=stdout; - return; + str_copy(filnam, ""); } assert(fil==NULL); if (first) { @@ -83,13 +83,14 @@ void logfileStatusBuffer(char *buffer, int bufsize) { statusSize=bufsize-1; } -void logfileInit(char *path, int nodate, int use_stdout, int write_all) { +char *logfileInit(char *path, int nodate, int use_stdout, int write_all) { str_copy(lnam, path); - lastStamp=-1; + lastStamp=-2; logfileStd=use_stdout; writeAll=write_all; notDated=nodate; logfileOpen(1); + return(filnam); } void logfileOut(int mask, const char *fmt, ...) @@ -144,7 +145,7 @@ void logfileMask(int mask) { logMask=logMask | mask; } -void logfileStamp(void) { +void logfileStamp(char *text) { struct tm *tim; struct timeb btim; int stamp; @@ -152,16 +153,17 @@ void logfileStamp(void) { ftime(&btim); tim=localtime(&btim.time); stamp=tim->tm_hour*60+tim->tm_min; - if (stamp!=lastStamp) { - if (stamp new day -> new logfile */ - if (fil!=NULL) { fclose(fil); fil=NULL; } - logfileOpen(1); - } + if (stamp new day -> new logfile */ + if (fil!=NULL) { fclose(fil); fil=NULL; } + logfileOpen(1); + lastStamp=-2; + } + if (stamp>lastStamp+1) { #ifdef __VMS - else if (fil==NULL) logfileOpen(0); + if (fil==NULL) logfileOpen(0); #endif lastStamp=stamp; - fprintf(fil, "--- %02d:%02d:%02d ---\n", tim->tm_hour, tim->tm_min, tim->tm_sec); + fprintf(fil, "%02d:%02d:%02d --- %s", tim->tm_hour, tim->tm_min, tim->tm_sec, text); dirty=0; } } @@ -170,18 +172,23 @@ void logfileWrite0(int mask) { char *s, *next; logMask=logMask | mask; - if (dirty) logfileStamp(); /* there was something written since last time */ + if (dirty) logfileStamp("\n"); /* there was something written since last time */ s=ebuf; if (writeAll || *s!='\0' && wrtMask & logMask) { - logfileStamp(); /* write stamp before write something */ next=strchr(s, '\1'); while (next!=NULL) { *next='\0'; next++; if (*next & logMask) { - fprintf(fil, "%s", s); - dirty=1; + if (*s=='@') { /* write out time */ + lastStamp=-2; + logfileStamp(s+1); + } else { + logfileStamp("\n"); /* write stamp before write something */ + fprintf(fil, "%s", s); + dirty=1; + } } s=next+1; next=strchr(s, '\1'); @@ -213,7 +220,7 @@ void logfileShowErr(char *text) if (fil==NULL) logfileOpen(0); #endif logfileWrite0(LOG_ALL); /* write all */ - ErrWrite(text); + ErrShow(text); #ifdef __VMS if (!logfileStd) { fclose(fil); fil=NULL; } #else @@ -227,8 +234,8 @@ void logfileClose() if (fil==NULL) logfileOpen(0); #endif logfileWrite0(LOG_MAIN+LOG_INFO); - lastStamp-=1; - logfileStamp(); + lastStamp=-2; + logfileStamp("\n"); if (fil!=NULL) { fclose(fil); fil=NULL; } filnam[0]='\0'; } diff --git a/tecs/coc_logfile.h b/tecs/coc_logfile.h index a1c92ea1..ae441cce 100644 --- a/tecs/coc_logfile.h +++ b/tecs/coc_logfile.h @@ -11,7 +11,7 @@ #define logfileStatusBuf(B) logfileStatusBuffer(B,sizeof(B)) void logfileStatusBuffer(char *buffer, int bufsize); -void logfileInit(char *path, int nodate, int use_stdout, int write_all); +char *logfileInit(char *path, int nodate, int use_stdout, int write_all); void logfileOut(int mask, const char *fmt, ...); void logfileOutBuf(int mask, Str_Buf *buf); void logfileShowErr(char *text); diff --git a/tecs/coc_server.c b/tecs/coc_server.c index c697ce7a..0de7ba74 100644 --- a/tecs/coc_server.c +++ b/tecs/coc_server.c @@ -14,7 +14,6 @@ #include #include #include -#include #include "sys_util.h" #include "err_handling.h" #include "coc_logfile.h" diff --git a/tecs/coc_util.h b/tecs/coc_util.h index 2c39f2b2..727d45e9 100644 --- a/tecs/coc_util.h +++ b/tecs/coc_util.h @@ -8,28 +8,70 @@ int CocCreateSockAdr( struct sockaddr_in *sockaddrPtr, /* Socket address */ const char *host, /* Host. NULL implies INADDR_ANY */ int port); /* Port number */ +/* + compose internet address +*/ + int CocRecv(int fd, Str_Buf *buf); +/* + receive data +*/ -typedef struct { void *next; char name[32]; void *var; int *flag; int type; void *strucType; } CocVar; +typedef struct { + /* private */ + void *next; + char name[32]; + void *var; + int *flag; + int type; + void *strucType; +} CocVar; -extern int CocRD; -extern int CocWR; -CocVar *serverVarList; +extern int CocRD; /* readonly variable (used as argument for CocDefXXX) */ +extern int CocWR; /* read/write variable (used as argument for CocDefXXX) */ +CocVar *serverVarList; /* variable list for the server process */ CocVar *CocDefVar(const char *name, void *var, int type, int *flag); void CocDefVarS(const char *name, const char *tname, void *var, int type); -void CocVarList(CocVar **varlist); -void CocFreeVarList(CocVar **varList); -CocVar *CocFindVar(CocVar *varList, const char *name, void **adr); -int CocPutVar(CocVar *varList, Str_Buf *buf, const char *name, int secure); -int CocGetVar(CocVar *varList, Str_Buf *buf, const char *name, int secure); +/* + Define variables. Call this routines not directly, but through + one of the macros below. +*/ +void CocVarList(CocVar **varlist); +/* + print a variable list (for debugging purposes) +*/ +void CocFreeVarList(CocVar **varList); +/* + free a variable list +*/ +CocVar *CocFindVar(CocVar *varList, const char *name, void **adr); +/* + find a variable. returns NULL if not found. +*/ +int CocPutVar(CocVar *varList, Str_Buf *buf, const char *name, int secure); +/* + put a variable named of variable list to the buffer + if , access rights are checked +*/ +int CocGetVar(CocVar *varList, Str_Buf *buf, const char *name, int secure); +/* + get a variable named of variable list from the buffer + if , access rights are checked +*/ +void CocDelay(int msec); +/* + system independent delay function with msec resolution +*/ #define COC_INT -1 #define COC_FLT -2 #define COC_PTR -3 #define COC_STRUCT -4 #define COC_TYPE -5 #define COC_ALIAS -6 + +/* macros to define variables */ #define CocDefInt(V,F) CocDefVar(#V,&V,COC_INT,&F) #define CocDefFlt(V,F) CocDefVar(#V,&V,COC_FLT,&F) #define CocDefStr(V,F) CocDefVar(#V,V,sizeof(V),&F) @@ -42,6 +84,4 @@ int CocGetVar(CocVar *varList, Str_Buf *buf, const char *name, int secure); #define CocDefStrPtr(V,S,F) CocDefVar(#V,V,S,&F) #define CocAlias(A,V) CocDefVar(#A, #V, COC_ALIAS, &CocRD); -void CocDelay(int msec); - #endif /* _COC_UTIL_H_ */ diff --git a/tecs/err_handling.c b/tecs/err_handling.c index 2fec2aac..1e8e0f80 100644 --- a/tecs/err_handling.c +++ b/tecs/err_handling.c @@ -41,7 +41,7 @@ void ErrOutFil(void *arg, char *text) { fprintf((FILE *)arg, "%s\n", text); } -void ErrWrite(char *text) +void ErrShow(char *text) { int i, l; char buf[256]; @@ -80,7 +80,7 @@ void ErrSetOutFile(FILE *arg) { } void ERR_EXIT(char *text) { - ErrWrite(text); exit(1); + ErrShow(text); exit(1); } /* FORTRAN wrappers */ @@ -88,13 +88,14 @@ void ERR_EXIT(char *text) { #ifdef __VMS #define err_show_ err_show #define err_txt_ err_txt +#define err_msg_ err_msg #endif void err_show_(F_CHAR(text), int text_len) { char buf[256]; STR_TO_C(buf, text); - ErrWrite(buf); + ErrShow(buf); } void err_txt_(F_CHAR(text), int text_len) { @@ -104,6 +105,13 @@ void err_txt_(F_CHAR(text), int text_len) { ErrTxt(buf,0); } +void err_msg_(F_CHAR(text), int text_len) { + char buf[256]; + + STR_TO_C(buf, text); + ErrMsg(buf); +} + void errsetoutrtn_(void (*rtn)(), void *arg) { ErrSetOutRtn(rtn, arg); } diff --git a/tecs/err_handling.h b/tecs/err_handling.h index f977c6fb..671a84cd 100644 --- a/tecs/err_handling.h +++ b/tecs/err_handling.h @@ -3,7 +3,6 @@ #include #include -#include /* ErrHDL Error handling utilities ------------------------------- @@ -47,7 +46,6 @@ Macros and routines: Signals an error condition as code from errno.h ErrShow("program_name") - ErrWrite(fil, "program_name") Show actual error message with traceback information to stdout or a file fil @@ -75,7 +73,7 @@ Global Variables (read only) void ErrTxt(char *text, int systemError); void ErrMsg(char *msg); void ErrCod(int code); -void ErrWrite(char *text); +void ErrShow(char *text); void ERR_EXIT(char *text); void ErrLog(char *text); void ErrSetOutRtn(void (*rtn)(), void *arg); diff --git a/tecs/str_util.c b/tecs/str_util.c index 9f09a3a1..7897bd1d 100644 --- a/tecs/str_util.c +++ b/tecs/str_util.c @@ -51,7 +51,7 @@ int str_ntrim(char *dest, const char *src, int ldest, int lsrc) { if (dest!=src) strncpy(dest, src, lsrc); dest[lsrc]='\0'; i=strlen(dest)-1; - while (i>0 && dest[i]==' ') i--; /* trim sequence */ + while (i>=0 && dest[i]==' ') i--; /* trim sequence */ i++; dest[i]='\0'; return(i); diff --git a/tecs/sys_util.c b/tecs/sys_util.c index e943546a..79841c88 100644 --- a/tecs/sys_util.c +++ b/tecs/sys_util.c @@ -1,4 +1,6 @@ #include +#include "str_util.h" +#include "sys_util.h" void *my_malloc(size_t size, const char *text) { void *ptr; @@ -11,3 +13,38 @@ void my_free(void *ptr) { /* printf("my_free %X\n", ptr); */ free(ptr); } + +#if __VMS + +#include + +int sys_remove_file(F_CHAR(file), int file_len) { + char buf[128]; + STR_TO_C(buf, file); + return(delete(buf)); +} + +int sys_gmt_off() { + return(0); +} + +#else + +#include +#include + +int sys_remove_file_(F_CHAR(file), int file_len) { + char buf[128]; + STR_TO_C(buf, file); + return(unlink(buf)); +} + +int sys_gmt_off_() { + struct tm *timp; + time_t tim; + time(&tim); + timp=localtime(&tim); + return(timp->tm_gmtoff); +} + +#endif diff --git a/tecs/tecs.c b/tecs/tecs.c index 94756901..94383b9a 100644 --- a/tecs/tecs.c +++ b/tecs/tecs.c @@ -26,6 +26,7 @@ static char *logDir=NULL; typedef struct { float temp, t1, t2; /* calc, high, low temperature */ + float tMin, tMax, min1, max1, min2, max2; /* minimum and maximum temperatures since ... */ int dirty; /* input config to be reloaded */ int try; /* trial count */ int manual; /* manual device */ @@ -52,6 +53,8 @@ static float tLimit, power, /* heater parameters */ tLow=0, tHigh=0, /* lower limit of high-T sensor, upper limit of low-T sensor */ tShift=0, /* setpoint shift */ + prop, integ, deriv, /* pid */ + maxShift=2, /* maximal shift in when controlMode=2 */ tInt=0; /* integral time (sec.) for setpoint shift */ static int @@ -59,8 +62,10 @@ static int period=5000, /* default read interval (msec.) */ logTime, /* next logging time */ setFlag, /* temperature to be set */ + powerFlag, /* power to be set */ + pidFlag, /* pid's to be set */ saveTime, /* time for a CRVSAV command */ - noResp=1, /* no response */ + noResp=2, /* no response */ quit, /* quit server */ controlMode=2, /* 0: control on heater, 1: control on sample, 3: 2nd loop for difference heater-sample */ remoteMode, /* 1: local, 2: remote */ @@ -72,14 +77,17 @@ static int key, /* key status */ serialNo, configuring=1, + stable, /* stable since 2 min. */ resist, /* heater resistance */ readTemp, /* client requested readTemp */ cod1, cod2, out1, out2, /* codes read from digital input/output */ iRange, iAmp, /* max. range and max. current code */ + htrst, htrst0, /* heater status */ per; /* effective period */ static time_t tim, /* actual time */ + mmInt, mmTime, /* interval and time for next min-max logging */ tableTime; /* last time when table was read */ static int decod[8]={21,20,17,16,5,4,1,0}; /* for code conversion */ @@ -95,7 +103,19 @@ static char static char *table=NULL, /* environment devices table */ - *cache=NULL; /* curve list cache */ + *cache=NULL, /* curve list cache */ + *logfile=""; + +static char + *heaterStatus[7]={ + "heater o.k.\n", + "heater supply over V\n", + "heater supply under V\n", + "heater output DAC error\n", + "heater Ilimit DAC error\n", + "open heater load\n", + "heater load < 10 Ohm\n", + }; struct timeb tim0; int logMask; @@ -147,7 +167,7 @@ int putPermanentData(FILE *fil) { OnError: return(-1); } -int instCurve(char *nam, char *channel) { +int instCurve(char *nam, char *channel, int dispFld) { /* install sensor nam on channel */ @@ -163,6 +183,7 @@ int instCurve(char *nam, char *channel) { fil=NULL; crv=NULL; + e=NULL; str_copy(chan, channel); logfileOut(LOG_MAIN, "install curve %s\n", nam); @@ -180,6 +201,11 @@ int instCurve(char *nam, char *channel) { points=str_split(intype, t, '\n'); } if (points==NULL) ERR_MSG("illegal curve file"); + if (cache==NULL) { ERR_SP(cache=my_malloc(1,"one")); *cache='\0'; } /* create empty cache if undefined */ + + start=strchr(cache, '\n'); /* skip permanent data */ + if (start==NULL) { start=cache; } else { start++; } + if (points[0]=='$') { /* standard curve */ points++; num=atoi(points); @@ -195,9 +221,6 @@ int instCurve(char *nam, char *channel) { str_append(buf, " "); str_upcase(buf, buf); - if (cache==NULL) { ERR_SP(cache=my_malloc(1,"one")); *cache='\0'; } /* create empty cache if undefined */ - start=strchr(cache, '\n'); /* skip device names */ - if (start==NULL) { start=cache; } else { start++; } entry=strstr(start, buf); if (entry==NULL) { /* sensor not found in cache */ entry=start; @@ -235,14 +258,14 @@ int instCurve(char *nam, char *channel) { if (e!=NULL) { *e='\0'; e++; } } } - fld=chan[0]-'A'+1; + fld=dispFld; if (fld>maxfld) maxfld=fld; if (head[0]!='\0' && LscEqPar(head, chead)) { /* header matches: select sensor type and curve */ retstat=-1; /* an error could be fixed */ ERR_P(LscCmd(ser, "RANGE:0;INTYPE [chan]:[intype];INCRV [chan]:[num]")); - ERR_P(LscCmd(ser, "DISPFLD [fld],[chan],1;DISPLAY:[maxfld]")); + ERR_P(LscCmd(ser, "MNMX [chan]:1,1;DISPFLD [fld],[chan],1;DISPLAY [maxfld]")); logfileOut(LOG_MAIN, "curve %d on channel %s selected\n", num, chan); Progress(100); @@ -254,8 +277,7 @@ int instCurve(char *nam, char *channel) { if (busy) ERR_MSG("busy"); logfileOut(LOG_MAIN, "download curve %d\n", num); /* select sensor type first to display sensor units */ - ERR_P(LscCmd(ser, "RANGE:0;INTYPE [chan]:[intype]")); - ERR_P(LscCmd(ser, "DISPFLD [fld],[chan],3;DISPLAY:[maxfld]")); + ERR_P(LscCmd(ser, "RANGE:0;INTYPE [chan]:[intype];DISPLAY:[maxfld]")); Progress(1); n=3; @@ -283,7 +305,8 @@ int instCurve(char *nam, char *channel) { /* write header, select curve */ str_upcase(head, chead); - ERR_P(LscCmd(ser, "CRVHDR [num]:[head];INCRV [chan]:[num];DISPFLD [fld],[chan],1")); + ERR_P(LscCmd(ser, "CRVHDR [num]:[head];INCRV [chan]:[num]")); + ERR_P(LscCmd(ser, "MNMX [chan]:1,1;DISPFLD [fld],[chan],1;DISPLAY [maxfld]")); Progress(1); logfileOut(LOG_MAIN, "curve selected on channel %s\n", chan); saveTime=tim+30; @@ -300,8 +323,10 @@ int instCurve(char *nam, char *channel) { fil=fopen(nbuf, "r+"); if (fil==NULL) ERR_SP(fil=fopen(nbuf, "w")); ERR_I(putPermanentData(fil)); - sprintf(buf, "%d:%s", num, head); - ERR_SI(fputs(buf, fil)); /* write actual entry */ + if (num>20) { /* write actual entry */ + sprintf(buf, "%d:%s", num, head); + ERR_SI(fputs(buf, fil)); + } if (start!=s) { /* write content before replaced entry */ ERR_SI(fputs("\n", fil)); ERR_SI(fputs(start, fil)); @@ -327,7 +352,7 @@ int instCurve(char *nam, char *channel) { int configInput(void) { char *t; char buf[80], nam[16], nbuf[256]; - int i, n, nn; + int i, n, nn, dispFld; int retstat; char *ext; @@ -358,6 +383,7 @@ int configInput(void) { i=sscanf(t, "%12s%d%d", nam, &nn, &n); if (i<1) ERR_MSG("missing sensor name"); ext=".s"; + dispFld=2; } else { cryo.nSens=0; tLow=0; tHigh=0; @@ -365,6 +391,7 @@ int configInput(void) { i=sscanf(t, "%12s%d%d%d%f%d%f%f%f", nam, &n, &nn, &controlMode, &tLimit, &resist, &power, &tLow, &tHigh); if (i<7) ERR_MSG("missing some sensor parameters"); ext=".x"; + dispFld=1; } if (n<0 || n>2) ERR_MSG("illegal value for nsensor"); if (n==0) return(0); @@ -375,10 +402,10 @@ int configInput(void) { } str_append(nam, ext); - ERR_I(retstat=instCurve(nam, tpoint->ch1)); + ERR_I(retstat=instCurve(nam, tpoint->ch1, dispFld)); if (n==2) { str_append(nam, "l"); - ERR_I(retstat=instCurve(nam, tpoint->ch2)); + ERR_I(retstat=instCurve(nam, tpoint->ch2, dispFld+2)); } tpoint->nSens=n; return(0); @@ -445,10 +472,75 @@ float WeightedAverage(int n, float tH, float tL) { } } +int LogMinMax(int new) { + char buf[256]; + int i, j, logIt; + float tol, tmin[2], tmax[2]; + + buf[0]='\0'; + + if (cryo.nSens>0) { + str_append(buf, "MDAT?[cryo.ch1]>cryo.min1,cryo.max1;"); + if (cryo.nSens>1) { + str_append(buf, "MDAT?[cryo.ch2]>cryo.min2,cryo.max2;"); + } else { + cryo.t2=0; + } + } else { + cryo.t1=0; + cryo.t2=0; + } + + if (samp.nSens>0) { + str_append(buf, "MDAT?[samp.ch1]>samp.min1,samp.max1;"); + if (samp.nSens>1) { + str_append(buf, "MDAT?[samp.ch2]>samp.min2,samp.max2;"); + } else { + samp.t2=0; + } + } else { + samp.t1=0; + samp.t2=0; + } + + i=strlen(buf); + if (i>0) { + str_append(buf, "MNMXRST"); + ERR_P(LscCmd(ser, buf)); + } + + logIt=0; + for (i=0; i<2; i++) { + tpoint=tpoints[i]; + if (tpoint->nSens>0) { + tpoint->tMin = WeightedAverage(tpoint->nSens, tpoint->min1, tpoint->min2) * tpoint->scale; + tpoint->tMax = WeightedAverage(tpoint->nSens, tpoint->max1, tpoint->max2) * tpoint->scale; + } + } + sprintf(buf, "@%.3f < T < %.3f K", cryo.tMin, cryo.tMax); + if (samp.nSens>0) { + sprintf(buf1, "(reg), %.3f < T < %.3f K (samp)", samp.tMin, samp.tMax); + str_append(buf, buf1); + } + logfileOut(LOG_MAIN, "%s\n", buf); + if (new) { + mmInt=60; + } else if (mmInt<600) { + mmInt=mmInt+60; + } + mmTime=tim+mmInt; + return(0); + OnError: return(-1); +} + int SetTemp(int switchOn) { char *ch; float scale; + if (switchOn) { + ERR_I(LogMinMax(1)); + logfileOut(LOG_MAIN, "set %.3f\n", tempC); + } scale=cryo.scale; ch=cryo.ch1; if (cryo.nSens>1 && tempC<(tLow+tHigh)/2) ch=cryo.ch2; @@ -468,6 +560,11 @@ int SetTemp(int switchOn) { if (scale!=1.0) { /* show set point on display (for rdrn) */ ERR_P(LscCmd(ser, "LINEAR C,1,0,1,1,[tempC]")); } + if (tShift>maxShift) { + tShift=maxShift; + } else if (tShift<-maxShift) { + tShift=-maxShift; + } tempH=(tempC+tShift)/scale; if (tempC==0) { ERR_P(LscCmd(ser, "CSET 1:[chan],1,1,0;RANGE:0;SETP 1:0")); @@ -540,13 +637,24 @@ int PeriodicTask(void) { time_t putTim; float t3[3], p, d, w; - ERR_P(LscCmd(ser, "DIOST?>cod1,out1;DOUT 3,29;HTR?>htr;BUSY?>busy")); + ERR_P(LscCmd(ser, "DIOST?>cod1,out1;DOUT 3,29;HTR?>htr;HTRST?>htrst;BUSY?>busy")); if (cryo.codDefined && samp.codDefined) { per=period; /* no timeout on above command and codes are defined: normal period */ if (per>logPeriod*1000) per=logPeriod*1000; } + if (htrst!=htrst0) { + if (htrst<0 || htrst>6) { + sprintf(buf, "heater status %d\n", htrst); + logfileOut(LOG_MAIN, buf); + } else { + logfileOut(LOG_MAIN, heaterStatus[htrst]); + } + htrst0=htrst; + } if (noResp) { /* there was no response on an earlier command, or we are initializing */ + if (!configuring) remoteMode=2; + LscCmd(ser, "MODE:[remoteMode]"); k=serialNo; /* check serial number */ ERR_P(LscCmd(ser, "*IDN?>buf1,buf2,serialNo,")); if (0!=strcmp(buf1, "LSCI") || 0!=strcmp(buf2, "MODEL340") || serialNo==0) return(0); @@ -605,27 +713,35 @@ int PeriodicTask(void) { ERR_I(ReadTemp()); - if (cryo.dirty==0 && samp.dirty==0 && noResp==0 && tim>logTime) { + if (tim>=logTime) { + i=0; if (cryo.nSens>0) { t3[0]=cryo.temp; + i=1; } else { t3[0]=undef; } if (samp.nSens>0) { t3[1]=samp.temp; + i=2; } else { - t3[1]=undef; + if (cryo.nSens>1) { + t3[1]=cryo.t2; + i=2; + } else { + t3[1]=undef; + } } if (tempC!=0 || htr!=0) { t3[2]=htr*htr*power*1e-4; + i=3; } else { t3[2]=undef; } time(&putTim); - i=3; - dlog_put_(&putTim, &i, t3); - + if (i>0) ERR_I(dlog_put_(&putTim, &i, t3)); logTime=(putTim/logPeriod+1)*logPeriod; + if (tim>mmTime) ERR_I(LogMinMax(0)); } if (samp.nSens>0 && cryo.nSens>0 && controlMode==2 && tempC!=0) { d=(tempH-cryo.temp)/cryo.temp-1.0; /* relative difference */ @@ -693,6 +809,7 @@ int PeriodicTask(void) { remoteMode=1; ERR_P(LscCmd(ser, "MODE?>remoteMode")); if (remoteMode==2) { /* user switched to remote mode */ + ERR_P(LscCmd(ser, "PID?1>prop,integ,deriv")); if (controlMode==2) { ERR_P(LscCmd(ser, "RANGE?>iRange")); if (iRange==0) tempC=0; @@ -741,8 +858,6 @@ int inputSettings(Testpoint *this) { } else { logfileShowErr("try again"); } - } else { - ERR_P(LscCmd(ser, "ALARM [tpoint.ch1]:[tpoint.nSens],1,[tLimit],0,0,1;ALARM [tpoint.ch2]:0;RELAY 1:1;BEEP:0")); } } } @@ -750,59 +865,112 @@ int inputSettings(Testpoint *this) { OnError: return(-1); } -int Settings(void) { - int i, j, k; +int SetPower(void) { + int i, j; float pa, pr, pw, dif; + + iAmp=1; iRange=0; + if (power>0) { + pa=resist*4; /* max. power */ + pw=0; dif=1.0e6; + for (i=4; i>0; i--) { + pr=pa; + for (j=5; j>0; j--) { + if (pr>power) { + if (pr/powernSens>0) { + k=1+j; + flds[k]=tpoint->ch1[0]; fmt[k]='1'; if (k>maxfld) maxfld=k; + if (tpoint->nSens>1) { + k=3+j; + flds[k]=tpoint->ch2[0]; fmt[k]='1'; if (k>maxfld) maxfld=k; + } + } + } + for (j=0; j<2; j++) { /* fill raw display fields */ + tpoint=tpoints[j]; + if (tpoint->nSens>0) { + k=2-j; /* try first right (or left) of the kelvin field */ + if (flds[k]!=' ') k=3+j; /* then the field below */ + if (flds[k]!=' ') k=4-j; /* then below right */ + if (flds[k]==' ') { + if (k>maxfld) maxfld=k; + flds[k]=tpoint->ch1[0]; fmt[k]='3'; + } + if (tpoint->nSens>1) { + k=4-j; /* try right (or left) of the kelvin field */ + if (flds[k]==' ') { + if (k>maxfld) maxfld=k; + flds[k]=tpoint->ch2[0]; fmt[k]='3'; + } + } + } + } + /* fields 5-8 standard raw data */ + ERR_P(LscCmd(ser, "DISPFLD 5,A,3;DISPFLD 6,C,3;DISPFLD 7,B,3;DISPFLD 8,D,3")); + if (maxfld==0) { /* show raw data */ + ERR_P(LscCmd(ser, "DISPFLD 1,A,3;DISPFLD 2,C,3;DISPFLD 3,B,3;DISPFLD 4,D,3;DISPLAY:4")); + } else { + buf[0]='\0'; + for (i=1; i<=maxfld; i++) { + if (flds[i]!=' ') { + sprintf(disp, "DISPFLD %d,%c,%c;", i, flds[i], fmt[i]); + } + str_append(buf, disp); + } + str_append(buf, "DISPLAY:[maxfld]"); + ERR_P(LscCmd(ser, buf)); + } + return(0); + OnError: return(-1); +} + +int Settings(void) { char nbuf[256], buf[256], *cfg, *p; cfg=NULL; if (cryo.dirty && cryo.codDefined || samp.dirty && samp.codDefined) { - for (i=0; i<2; i++) { - tpoint=tpoints[i]; - if (tpoint->dirty) { - ERR_P(LscCmd(ser, "DISPFLD 2,[tpoint.ch1],1;DISPFLD 4,[tpoint.ch2],1")); - } - } - inputSettings(&cryo); - inputSettings(&samp); + ERR_I(inputSettings(&cryo)); + ERR_I(inputSettings(&samp)); if (cryo.nSens>0) { - /* control settings */ - ERR_P(LscCmd(ser, "CDISP 1:1,[resist],1;MOUT 1:0;CMODE 1:1")); - iAmp=1; iRange=0; - if (power>0) { - pa=resist*4; /* max. power */ - pw=0; dif=1.0e6; - for (i=4; i>0; i--) { - pr=pa; - for (j=5; j>0; j--) { - if (pr>power) { - if (pr/power0) { + ERR_P(LscCmd(ser, "ALARM [samp.ch1]:1,1,[tLimit],0,0,1;ALARM [samp.ch2]:0")); + } else { + ERR_P(LscCmd(ser, "ALARM [samp.ch1]:0;ALARM [samp.ch2]:0")); } - power=pw; - logfileOut(LOG_INFO, "power %f\n", power, iAmp, iRange); - ERR_P(LscCmd(ser, "CLIMIT 1:[tLimit],0,0,[iAmp],[iRange]")); - ERR_I(SetTemp(1)); - } - if (samp.nSens>=cryo.nSens) { - maxfld=2*samp.nSens; } else { - maxfld=2*cryo.nSens-1; - } - if (maxfld>0) { - ERR_P(LscCmd(ser, "DISPLAY:[maxfld]")); - } else { - maxfld=1; - ERR_P(LscCmd(ser, "DISPLAY:1;DISPFLD 1,A,3")); + ERR_P(LscCmd(ser, "ALARM [cryo.ch1]:0;ALARM [cryo.ch2]:0;ALARM [samp.ch1]:0;ALARM [samp.ch2]:0")); } + ERR_I(Display()); str_copy(nbuf, binDir); str_append(nbuf, cryo.device); @@ -830,15 +998,24 @@ int Settings(void) { int ExecuteRequest(void) { char *t, *res; struct CocClient *client; + float p; - if (readTemp) ReadTemp(); + if (readTemp) ERR_I(ReadTemp()); if (remoteMode==2) ERR_I(Settings()); + if (powerFlag) { + powerFlag=0; + ERR_I(SetPower()); + } + if (pidFlag) { + pidFlag=0; + ERR_P(LscCmd(ser,"PID 1:[prop],[integ],[deriv]")); + } if (setFlag) { + setFlag=0; if (cryo.nSens>0) { tInt=0; /* reset integral time */ ERR_I(SetTemp(1)); } - setFlag=0; } client=CocGetNextCmd(); if (client!=NULL) { @@ -854,7 +1031,7 @@ int ExecuteRequest(void) { if (deviceFlag) { tempC=0; remoteMode=2; /* set to remote mode */ - LscCmd(ser, "MODE:[remoteMode]"); + ERR_P(LscCmd(ser, "MODE:[remoteMode]")); if (!configuring) { str_copy(status, "configuring"); configuring=1; @@ -895,8 +1072,6 @@ int mainBody(void) int i, iret, tdif; struct timeb tim1; - ERR_I(PeriodicTask()); - if (remoteMode==2) ERR_I(Settings()); logfileWrite(logMask); while (!quit) { @@ -914,17 +1089,27 @@ int mainBody(void) i=period*tdif+tim0.millitm; tim0.time+=i / 1000; tim0.millitm=i % 1000; - if (tdif>1) { - logfileOut(LOG_INFO ,"%d cycles lost\n", tdif-1); + if (tdif>4) { + logfileOut(LOG_MAIN ,"%d cycles lost\n", tdif-1); } + + ERR_I(PeriodicTask()); + if (remoteMode==2) ERR_I(Settings()); + return(0); OnError: if (0==strcmp(ErrMessage, "timeout")) { - if (!noResp) logfileOut(LOG_MAIN ,"no response\n"); - per=period+10000; /* long period if no response */ - noResp=1; - cryo.temp=0; - samp.temp=0; + if (noResp==1) { /* this is the second time we have no response */ + per=period+15000; /* long period if no response */ + cryo.temp=0; + samp.temp=0; + remoteMode=1; + configuring=0; + } else { + logfileOut(LOG_ALL ,"no response\n"); + noResp=1; + per=100; /* try again soon */ + } return(0); } return(-1); @@ -948,14 +1133,14 @@ int main(int argc, char *argv[]) samp.codChanged=1; samp.scale=1.0; - logMask=LOG_MAIN+LOG_INFO; + logMask=LOG_MAIN; binDir="bin/"; logDir="log/"; serverId="tecs"; host="lnsp26:4000/0"; port=0; msecTmo=0; - logfileOut(LOG_INFO ,"%s ", argv[0]); + logfileOut(LOG_MAIN ,"%s ", argv[0]); for (i=1;i1000) { /* round time */ + tim0.time=tim0.time-(tim0.time % (period/1000)); + tim0.millitm=0; + } str_copy(dlogfile, logDir); str_append(dlogfile, serverId); str_append(dlogfile, ".dlog"); - logfileOut(LOG_INFO, "open data log file: %s\n", dlogfile); - dlog_open_write_(dlogfile); + logfileOut(LOG_MAIN, "open data log file: %s\n", dlogfile); + ERR_I(iret=dlog_open_write_(dlogfile)); + if (iret==1) logfileOut(LOG_MAIN, "created new data log file\n"); logfileWrite(logMask); + remoteMode=2; LscCmd(ser, "MODE?>remoteMode"); + prop=50; + integ=20; + deriv=0; + LscCmd(ser, "PID?1>prop,integ,deriv"); if (remoteMode!=2) configuring=0; per=1; /* advance fast when initializing */ cntError=0; @@ -1094,6 +1301,7 @@ int main(int argc, char *argv[]) if (cntError>0) cntError--; } } + LogMinMax(0); logfileWrite(logMask); ERR_MSG("got quit command"); OnError: diff --git a/tecs/tecs_cli.c b/tecs/tecs_cli.c index 7e4b0eee..fa816863 100644 --- a/tecs/tecs_cli.c +++ b/tecs/tecs_cli.c @@ -38,6 +38,7 @@ int TeccGet3(pTecsClient conn, float *tC, float *tX, float *tP) { } int TeccGet(pTecsClient conn, float *temp) { + readTemp=1; ERR_I(CocCmd(conn, "tempP,[readTemp],configuring")); *temp=tempP; return(configuring); diff --git a/tecs/tecs_cli.h b/tecs/tecs_cli.h index f8fe14bf..7029d802 100644 --- a/tecs/tecs_cli.h +++ b/tecs/tecs_cli.h @@ -6,38 +6,57 @@ tecc.h: tecs client interface routines M. Zolliker March 2000 -------------------------------------------------------------------------*/ +*/ typedef CocConn *pTecsClient; pTecsClient TeccInit(char *server, int port); -/* init tecs client (connect to server) -------------------------------------------------------------------------*/ +/* init tecs client (connect to server) */ int TeccGet(pTecsClient conn, float *temp); -/* set temperature -------------------------------------------------------------------------*/ +/* get temperature */ int TeccSet(pTecsClient conn, float temp); -/* get temperature -------------------------------------------------------------------------*/ +/* set temperature */ int TeccWait(pTecsClient conn); -/* wait until the controller is configured -------------------------------------------------------------------------*/ +/* wait until the controller is configured */ int TeccSend(pTecsClient conn, char *cmd, char *reply, int replyLen); /* send a command transparently to the controller - replyLen is the maximal length of reply -------------------------------------------------------------------------*/ + replyLen is the maximal length of reply */ void TeccClose(pTecsClient conn); -/* close connection and free ressources -------------------------------------------------------------------------*/ +/* close connection and free ressources */ int TeccQuitServer(pTecsClient conn); -/* quit the server process -------------------------------------------------------------------------*/ +/* quit the server process */ + +/* Fortran interface: + + integer function TECS_INIT(STARTCMD, PORT) - open server connection + logical function TECS_IS_OPEN () - check if tecs is open + integer function TECS_GET3(SET_T, REG_T, SAM_T) - read 3 temperatures + integer function TECS_WAIT() - wait for end of configuration + integer function TECS_SET (TEMP) - set temperature target + integer function TECS_GET (TEMP) - get sample temperature + integer function TECS_QUIT_SERVER () - force server to quit + integer function TECS_GET_PAR (NAME, PAR) - get parameter + integer function TECS_SET_PAR (NAME, PAR) - set parameter + integer function TECS_SEND (CMND, REPLY) - send command to LakeShore + subroutine TECS_CLOSE - close connection to tecs + + character*(*) STARTCMD - command to start server (no restart if empty) + integer PORT - port number + real SET_T,REG_T,SAM_T - set-temperature, regulation temperature, sample temperature + real TEMP - temperature + character*(*) NAME - parameter name + character*(*) PAR - parameter value + character*(*) CMND - raw command + character*(*) REPLY - reply to command + + integer return values are error codes (negative means error, like in most C system routines) +*/ #endif /* _TECS_CLI_H_ */ diff --git a/tecs/tecs_dlog.f b/tecs/tecs_dlog.f index 13c22f0f..65784ea8 100644 --- a/tecs/tecs_dlog.f +++ b/tecs/tecs_dlog.f @@ -1,5 +1,9 @@ - subroutine DLOG_OPEN_W(FILE) !! -!! ============================ + subroutine tecs_dlog + stop 'TECS_DLOG: do not call module header' + end + + integer function DLOG_OPEN_W(FILE) !! +!! ================================== !! !! open dlog file for write !! @@ -12,7 +16,8 @@ data lunw/0/ if (lunw .ne. 0) then - print *,'DLOG_OPEN_W: file already open for write' + call err_msg('file already open for write') + dlog_open_w=-1 ! failure return endif lunw=38 @@ -22,17 +27,16 @@ open(lunw, name=file, status='old', access='direct', shared 1 , recl=recl, iostat=iostat) if (iostat .eq. 0) then - read(lunw, rec=1) vers, stim, etim, wrec, rrec, wdir - if (vers .ne. version) then + read(lunw, rec=1, iostat=iostat) vers, stim, etim, wrec, rrec, wdir + if (vers .ne. version .or. iostat .ne. 0) then close(lunw, status='delete') endif else ! delete file - open(lunw, name=file, status='old', iostat=iostat, shared) - if (iostat .eq. 0) close(lunw, status='delete') + call sys_remove_file(file) vers=0 endif if (vers .ne. version) then - print *,'DLOG_OPEN_W: create new file' + dlog_open_w=1 ! new file created vers=version do i=0,dirlen-1 wdir(i)=0 @@ -44,22 +48,26 @@ open(lunw, name=file, status='new', access='direct', shared 1 , recl=recl, err=93) else + dlog_open_w=1 ! reopened read(lunw, rec=wrec+2, iostat=iostat) wdat endif - call dlog_write_block(1) - + call dlog_write_block(1, done) + if (.not. done) then + call err_txt('dlog_write_block(1,done)') + goto 99 + endif return -93 print *,'DLOG_OPEN_W: can not open file for write' - print *,file +93 call err_msg('can not open file for write') +99 dlog_open_w=-1 ! failure close(lunw) lunw=0 end - subroutine DLOG_PUT(TIME, N, DAT) !! -!! ================================= + integer function DLOG_PUT(TIME, N, DAT) !! +!! ======================================= !! !! put data for N channels to logfile. !! by default the file is updated in every call (see also DLOG_UPDATE) @@ -71,11 +79,18 @@ integer p,r,i,j,btim data update/.true./ + logical done + integer dlog_put_ entry dlog_put_(time, n, dat) ! C interface for VMS + dlog_put=0 ! assume success + if (lunw .le. 0) then - if (lunw .eq. 0) print *,'DLOG_PUT: file not open' + if (lunw .eq. 0) then ! return error message only once + call err_msg('file not open') + dlog_put=-1 + endif lunw=-1 return endif @@ -94,8 +109,16 @@ endif if (time .lt. btim .or. time .ge. btim+recs*step) then if (.not. update .and. wrec .ge. 0) then - call dlog_write_block(wrec+2) - call dlog_write_block(1) + call dlog_write_block(wrec+2, done) + if (.not. done) then + call err_txt('dlog_write_block(wrec+2,done)') + goto 99 + endif + call dlog_write_block(1, done) + if (.not. done) then + call err_txt('dlog_write_block(1,done)') + goto 99 + endif endif wrec=mod(wrec+1,dirlen) btim=time-step/2 @@ -118,23 +141,48 @@ etim=time if (update) then - call dlog_write_block(wrec+2) - call dlog_write_block(1) + call dlog_write_block(wrec+2, done) + if (.not. done) then + call err_txt('dlog_write_block(wrec+2,done)') + goto 99 + endif + call dlog_write_block(1, done) + if (.not. done) then + call err_txt('dlog_write_block(1,done)') + goto 99 + endif endif + return + +99 dlog_put=-1 end - subroutine DLOG_UPDATE(ALWAYS) !! -!! ============================== + integer function DLOG_UPDATE(ALWAYS) !! +!! ==================================== !! !! update file. ALWAYS: switch on/off automatic update after DLOG_PUT !! include 'tecs_dlog.inc' - logical always + logical always, done - if (wrec .ge. 0) call dlog_write_block(wrec+2) - call dlog_write_block(1) + if (wrec .ge. 0) then + call dlog_write_block(wrec+2, done) + if (.not. done) then + call err_txt('dlog_write_block(wrec+2,done)') + goto 99 + endif + endif + call dlog_write_block(1, done) + if (.not. done) then + call err_txt('dlog_write_block(1,done)') + goto 99 + endif update=always + dlog_update=0 + return + +99 dlog_update=-1 end @@ -144,20 +192,21 @@ !! close data file for write !! include 'tecs_dlog.inc' + logical done entry dlog_close_w_ if (.not. update) then - call dlog_write_block(wrec+2) - call dlog_write_block(1) + call dlog_write_block(wrec+2, done) + call dlog_write_block(1, done) endif if (lunw .gt. 0) close(lunw) lunw=0 end - subroutine DLOG_OPEN_R(FILE, FIRST, LAST, OFFSET) !! -!! ================================================= + integer function DLOG_OPEN_R(FILE, FIRST, LAST, OFFSET) !! +!! ======================================================= !! !! open dlog file for read !! @@ -173,8 +222,11 @@ integer iostat data lunr/0/ + integer sys_gmt_off + if (lunr .ne. 0) then - print *,'DLOG_OPEN_R: file already open for read' + dlog_open_r=1 + call err_msg('file already open for read') return endif @@ -190,50 +242,71 @@ first=stim last=etim - offset=first-mod(first+3*24*3600,7*24*3600) + offset=first-mod(first+3*24*3600,7*24*3600)-sys_gmt_off() + dlog_open_r=0 return -99 print *,'DLOG_OPEN_R: can not open' +99 call err_msg('can not open') + dlog_open_r=-1 lunr=0 end - subroutine DLOG_GET(NDIM,NDAT,OFFSET,XMIN,XMAX,UNDEF_VALUE,X,Y,NRES) !! -!! ==================================================================== + integer function DLOG_GET(NDIM,NDAT,OFFSET,XMIN,XMAX,UNDEF_VALUE,X,Y) !! +!! ===================================================================== !! !! Get data from logfile in the range XMIN..XMAX !! not available data is represented by 0 !! for precision reasons, and because time is internally stored !! as integer seconds since UNIX (1 Jan 1970), a time offset is used. !! X(i)+OFFSET, XMIN+OFFSET, XMAX+OFFSET is in seconds since UNIX +!! return value is the number of values returned or a negative value +!! if an error occured !! integer NDIM, NDAT !! (in) dimensions integer OFFSET !! (in) time zero point (use value from DLOG_OPEN) - real XMIN, XMAX !! (in) start and end time + real XMIN !! (in) start time (XMIN=0: first used time, XMIN<0 seconds before XMAX) + real XMAX !! (in) end time (XMAX=0: last used time) real UNDEF_VALUE !! (in) value to be returned for undefined data real X(NDIM), Y(NDIM, NDAT) !! (out) data - integer NRES !! (out) returned size include 'tecs_dlog.inc' integer r,rtim,ftim,ltim,btim,ntim,xtim - integer irec + integer irec, nres integer i,j,i1,i2,iostat,n,d logical done real ys(mdat),yj integer ns(mdat) - if (lunr .eq. 0) return ! file not open + if (lunr .eq. 0) then + call err_msg('file not open') + dlog_get=-1 + return + endif -! print *,xmin,xmax n=min(mdat,ndat) nres=0 call dlog_read_block(1, done) - if (.not. done) return ! record locked + if (.not. done) then + call err_txt('dlog_read_block(1,done)') + dlog_get=-1 + return ! record locked + endif - ftim=max(stim,offset+nint(max(-2147480000.-offset,xmin))) - ltim=min(etim,offset+nint(min( 2147480000.-offset,xmax))) + if (xmax .eq. 0) then + ltim=etim + else + ltim=min(etim,offset+nint(min( 2147480000.-offset,xmax))) + endif + if (xmin .eq. 0) then + ftim=stim + elseif (xmin .lt. 0) then + ftim=ltim+nint(xmin) + else + ftim=max(stim,offset+nint(max(-2147480000.-offset,xmin))) + endif do j=1,mdat ys(j)=0 @@ -252,7 +325,11 @@ i1=(rtim-btim+step/2)/step if (i1 .lt. recs) then call dlog_read_block(r+2, done) - if (.not. done) return ! record locked + if (.not. done) then + call err_txt('dlog_read_block(r+2,done)') + dlog_get=-1 + return ! record locked + endif i2=min((ltim-btim+step/2)/step,recs-1) do i=i1,i2 @@ -264,14 +341,13 @@ if (nres .lt. ndim) then nres=nres+1 ! we calculate over how long time we have to average in order not to exceed NDIM - d=max(step,(ltim-rtim)/(ndim-nres+1)+1) + d=max(step,(ltim-rtim)/max(ndim-nres-1,1)+1) x(nres)=xtim+d/2-offset do j=1,n if (ns(j) .eq. 0) then y(nres,j)=undef_value else y(nres,j)=ys(j)/ns(j) -! if (j .eq. 1) print *,'get',x(nres),y(nres,j) endif enddo do j=n+1,ndat @@ -290,7 +366,6 @@ do j=1,ndat y(nres,j)=undef_value enddo -! print *,'get undef',x(nres) endif ntim=0 endif @@ -320,13 +395,13 @@ y(nres,j)=undef_value else y(nres,j)=ys(j)/ns(j) -! if (j .eq. 1) print *,'get last',x(nres),y(nres,j) endif enddo do j=n+1,ndat y(nres,j)=undef_value enddo endif + dlog_get=nres end @@ -343,9 +418,10 @@ - subroutine dlog_write_block(recno) + subroutine dlog_write_block(recno, done) integer recno + logical done include 'tecs_dlog.inc' @@ -357,18 +433,21 @@ write(lunw, rec=1, iostat=iostat) vers, stim, etim, wrec, rrec, wdir else write(lunw, rec=recno, iostat=iostat) wdat -! print *,'write',recno-2,wdat(1,0),wdat(1,recs-1) endif if (iostat .eq. 52) then ! record locked if (s .eq. 0) then s=secnds(0.0) elseif (secnds(s) .gt. 2.0) then - print *,'DLOG_PUT: record locked' + done=.false. + call err_msg('record locked') return endif goto 1 endif - if (s .ne. 0) print *,'DLOG_PUT: locked for ',secnds(s),' seconds' + done=.true. +! if (s .ne. 0) then +! print *,'DLOG_PUT: locked for ',secnds(s),' seconds' +! endif end @@ -381,6 +460,8 @@ integer iostat, i real s + character*24 msg + save msg s=0 1 if (recno .eq. 1) then @@ -392,17 +473,20 @@ if (s .eq. 0) then s=secnds(0.0) elseif (secnds(s) .gt. 2.0) then - print *,'DLOG_PUT: record locked' + call err_msg('record locked') done=.false. return endif read(lunr, rec=mod(recno-2,dirlen)+1, iostat=iostat) i ! dummy read to wait goto 1 elseif (iostat .ne. 0) then - print *,'DLOG_GET: can not read record' + write(msg, '(a,i5)') 'read error ',iostat + call err_msg(msg) done=.false. else - if (s .ne. 0) print *,'DLOG_GET: locked for ',secnds(s),' seconds' +! if (s .ne. 0) then +! print *,'DLOG_GET: locked for ',secnds(s),' seconds' +! endif done=.true. endif end @@ -411,21 +495,25 @@ ! ! C interface ! - subroutine dlog_open_write(cfile) + integer function dlog_open_write(cfile) byte cfile(*) ! C char* integer m, i, j character file*128 + integer dlog_open_w + + integer dlog_open_write_ entry dlog_open_write_(cfile) ! C interface for VMS do i=2,128 if (cfile(i) .eq. 0) then write(file, '(128a1)') (cfile(j), j=1,i-1) - call dlog_open_w(file(1:i-1)) + dlog_open_write_=dlog_open_w(file(1:i-1)) return endif enddo - print *,'DLOG_OPEN_WRITE: filename too long' + dlog_open_write_=0 + call err_msg('filename too long') end