static int getresid(Tcl_Interp *interp, CONST84 char *id, Pg_ConnectionId ** connid_p) { Tcl_Channel conn_chan; char *mark; int resid; Pg_ConnectionId *connid; if (!(mark = strchr(id, '.'))) return -1; *mark = '\0'; conn_chan = Tcl_GetChannel(interp, id, 0); *mark = '.'; if (conn_chan == NULL || Tcl_GetChannelType(conn_chan) != &Pg_ConnType) { Tcl_SetResult(interp, "Invalid connection handle", TCL_STATIC); return -1; } if (Tcl_GetInt(interp, mark + 1, &resid) == TCL_ERROR) { Tcl_SetResult(interp, "Poorly formated result handle", TCL_STATIC); return -1; } connid = (Pg_ConnectionId *) Tcl_GetChannelInstanceData(conn_chan); if (resid < 0 || resid >= connid->res_max || connid->results[resid] == NULL) { Tcl_SetResult(interp, "Invalid result handle", TCL_STATIC); return -1; } *connid_p = connid; return resid; }
/* ** Usage: fake_big_file N FILENAME ** ** Write a few bytes at the N megabyte point of FILENAME. This will ** create a large file. If the file was a valid SQLite database, then ** the next time the database is opened, SQLite will begin allocating ** new pages after N. If N is 2096 or bigger, this will test the ** ability of SQLite to write to large files. */ static int fake_big_file( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ int rc; int n; i64 offset; OsFile *fd = 0; int readOnly = 0; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " N-MEGABYTES FILE\"", 0); return TCL_ERROR; } if( Tcl_GetInt(interp, argv[1], &n) ) return TCL_ERROR; rc = sqlite3OsOpenReadWrite(argv[2], &fd, &readOnly); if( rc ){ Tcl_AppendResult(interp, "open failed: ", errorName(rc), 0); return TCL_ERROR; } offset = n; offset *= 1024*1024; rc = sqlite3OsSeek(fd, offset); if( rc ){ Tcl_AppendResult(interp, "seek failed: ", errorName(rc), 0); return TCL_ERROR; } rc = sqlite3OsWrite(fd, "Hello, World!", 14); sqlite3OsClose(&fd); if( rc ){ Tcl_AppendResult(interp, "write failed: ", errorName(rc), 0); return TCL_ERROR; } return TCL_OK; }
/* Parse an n-tuple of ints specified as a tcl-list. */ int get_tcl_int_tuple( Tcl_Interp *ip, const char *inList, int *p, int n ) { CONST84 char **indices; int tmp; int num_ints; int rtn; char s[100]; int i; rtn = Tcl_SplitList(ip, inList, &num_ints, &indices); if ((TCL_OK != rtn) || (n != num_ints)) { sprintf(s,"%d",n); Tcl_AppendResult(ip, "Expected a tuple of ", s, " integers.\n", (char *) 0 ); Tcl_Free((char *)indices); return TCL_ERROR; } for (i = 0; i < n; i++) { if (TCL_OK != Tcl_GetInt(ip, indices[i], &tmp)) { Tcl_Free((char *)indices); sprintf(s,"%d",n); Tcl_AppendResult(ip, "Expected a tuple of ", s, " integers.\n", (char *) 0 ); return TCL_ERROR; } p[i] = tmp; } Tcl_Free((char *)indices); return TCL_OK; }
int TclNullPlasticMaterialCommand(ClientData clienData, Tcl_Interp *interp, int argc, TCL_Char **argv, TclModelBuilder *theTclBuilder) { PlasticHardeningMaterial *theMaterial = 0; int tag; if (Tcl_GetInt(interp, argv[2], &tag) != TCL_OK) { opserr << "WARNING invalid PlaticHardening quadrReducing tag" << endln; return TCL_ERROR; } theMaterial = new NullPlasticMaterial(tag); if (theTclBuilder->addPlasticMaterial(*theMaterial) < 0) { opserr << "WARNING could not add uniaxialMaterial to the domain\n"; opserr << *theMaterial << endln; delete theMaterial; // invoke the material objects destructor, otherwise mem leak return TCL_ERROR; } return TCL_OK; }
static int page_lookup( void *NotUsed, Tcl_Interp *interp, int argc, const char **argv ){ Pager *pPager; char zBuf[100]; DbPage *pPage; int pgno; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ID PGNO\"", 0); return TCL_ERROR; } pPager = sqlite3TestTextToPtr(argv[1]); if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR; pPage = sqlite3PagerLookup(pPager, pgno); if( pPage ){ sqlite3_snprintf(sizeof(zBuf),zBuf,"%p",pPage); Tcl_AppendResult(interp, zBuf, 0); } return TCL_OK; }
/******************************************************************************* * dhsSysCloseTcl ( ... ) * Use: set dhsStat [dhs::SysClose <sID>] *******************************************************************************/ static int dhsSysCloseTcl ( ClientData clientData, Tcl_Interp *interp, int argc, char *argv[] ) { /* declare local scope variable and initialize them */ dhsHandle sID=(dhsHandle)0; int ival=0; long lstat=0; /* initialize static variables */ (void) memset(response,'\0',MAXMSG); (void) memset(result,'\0',DHS_RESULT_LEN); /* check handle */ if ( Tcl_GetInt(interp,argv[1],&ival) != TCL_OK ) { (void) sprintf(result,"%s","dhsSysCloseTcl-E-bad handle\n"); (void) Tcl_SetResult(interp,result,TCL_STATIC); return TCL_ERROR; } sID = (dhsHandle)ival; #ifdef DEBUGTCL (void) fprintf(stderr,"dhs::SysClose>> sID=%d\n",(int)sID); (void) fflush(stderr); #endif /* execute the dhs function */ dhsSysClose(&lstat,response,sID); if ( STATUS_BAD(lstat) ) { (void) Tcl_SetResult(interp,response,TCL_STATIC); return TCL_ERROR; } #ifdef DEBUGTCL (void) fprintf(stderr,"dhs::SysClose>> lstat=%ld\n",lstat); (void) fflush(stderr); #endif /* return result */ (void) sprintf(result,"%ld",lstat); #ifdef DEBUGTCL (void) fprintf(stderr,"dhs::SysClose>> response=\"%s\"\n",response); (void) fflush(stderr); (void) fprintf(stderr,"dhs::SysClose>> result=\"%s\"\n",result); (void) fflush(stderr); #endif (void) Tcl_SetResult(interp,result,TCL_STATIC); return TCL_OK; }
/** Reads a Tcl vector and returns a C vector. \param interp The Tcl interpreter \param data_in String containing a Tcl vector of integers \param nrep Pointer to the C vector \param len Pointer to an int to store the length of the vector \return \em TCL_OK if everything went fine \em TCL_ERROR otherwise and interp->result is set to an error message. If \em TCL_OK is returned you have to make sure to free the memory pointed to by nrep. */ int uwerr_read_int_vector(Tcl_Interp *interp, char * data_in , int ** nrep, int * len) { char ** col; int i; *len = -1; *nrep = 0; if (Tcl_SplitList(interp, data_in, len, &col) == TCL_ERROR) return TCL_ERROR; if (*len < 1) { Tcl_AppendResult(interp, "Argument is not a vector.", (char *)NULL); return TCL_ERROR; } if (!(*nrep = (int*)malloc((*len)*sizeof(int)))) { Tcl_AppendResult(interp, "Out of Memory.", (char *)NULL); Tcl_Free((char *)col); return TCL_ERROR; } for (i = 0; i < *len; ++i) { if (Tcl_GetInt(interp, col[i], &((*nrep)[i])) == TCL_ERROR) { Tcl_Free((char *)col); free(*nrep); return TCL_ERROR; } } Tcl_Free((char *)col); return TCL_OK; }
/* ** Usage: fake_big_file N FILENAME ** ** Write a few bytes at the N megabyte point of FILENAME. This will ** create a large file. If the file was a valid SQLite database, then ** the next time the database is opened, SQLite will begin allocating ** new pages after N. If N is 2096 or bigger, this will test the ** ability of SQLite to write to large files. */ static int fake_big_file( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ sqlite3_vfs *pVfs; sqlite3_file *fd = 0; int rc; int n; i64 offset; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " N-MEGABYTES FILE\"", 0); return TCL_ERROR; } if( Tcl_GetInt(interp, argv[1], &n) ) return TCL_ERROR; pVfs = sqlite3_vfs_find(0); rc = sqlite3OsOpenMalloc(pVfs, argv[2], &fd, (SQLITE_OPEN_CREATE|SQLITE_OPEN_READWRITE|SQLITE_OPEN_MAIN_DB), 0 ); if( rc ){ Tcl_AppendResult(interp, "open failed: ", errorName(rc), 0); return TCL_ERROR; } offset = n; offset *= 1024*1024; rc = sqlite3OsWrite(fd, "Hello, World!", 14, offset); sqlite3OsCloseFree(fd); if( rc ){ Tcl_AppendResult(interp, "write failed: ", errorName(rc), 0); return TCL_ERROR; } return TCL_OK; }
int GraphCmdMask(GRAPH_ARGS) { int mask; if ((argc != 2) && (argc != 3)) { Tcl_AppendResult(interp, "wrong # args", (char *) NULL); return TCL_ERROR; } if (argc == 3) { if ((Tcl_GetInt(interp, argv[2], &mask) != TCL_OK) || (mask < 0) || (mask > 63)) { Tcl_AppendResult(interp, " bogus args", (char *) NULL); return TCL_ERROR; } graph->mask = mask; NewGraph = 1; } sprintf(interp->result, "%d", graph->mask); return TCL_OK; }
/* ** Usage: page_lookup ID PGNO ** ** Return a pointer to a page if the page is already in cache. ** If not in cache, return an empty string. */ static int page_lookup( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ Pager *pPager; char zBuf[100]; DbPage *pPage; int pgno; if( argc!=3 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ID PGNO\"", 0); return TCL_ERROR; } pPager = sqlite3TestTextToPtr(argv[1]); if( Tcl_GetInt(interp, argv[2], &pgno) ) return TCL_ERROR; pPage = sqlite3PagerLookup(pPager, pgno); if( pPage ){ sqlite3_snprintf(sizeof(zBuf),zBuf,"%p",pPage); Tcl_AppendResult(interp, zBuf, 0); } return TCL_OK; }
/* ** usage: btree_set_cache_size ID NCACHE ** ** Set the size of the cache used by btree $ID. */ static int btree_set_cache_size( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ int nCache; Btree *pBt; if( argc!=3 ){ Tcl_AppendResult( interp, "wrong # args: should be \"", argv[0], " BT NCACHE\"", 0); return TCL_ERROR; } pBt = sqlite3TestTextToPtr(argv[1]); if( Tcl_GetInt(interp, argv[2], &nCache) ) return TCL_ERROR; sqlite3_mutex_enter(pBt->db->mutex); sqlite3BtreeEnter(pBt); sqlite3BtreeSetCacheSize(pBt, nCache); sqlite3BtreeLeave(pBt); sqlite3_mutex_leave(pBt->db->mutex); return TCL_OK; }
int GraphCmdRange(GRAPH_ARGS) { int range; if ((argc != 2) && (argc != 3)) { Tcl_AppendResult(interp, "wrong # args", (char *) NULL); return TCL_ERROR; } if (argc == 3) { if ((Tcl_GetInt(interp, argv[2], &range) != TCL_OK) || ((range != 10) && (range != 120))) { Tcl_AppendResult(interp, " bogus args", (char *) NULL); return TCL_ERROR; } graph->range = range; NewGraph = 1; } sprintf(interp->result, "%d", graph->range); return TCL_OK; }
/* ARGSUSED */ static int ImageCmd( ClientData clientData, /* Main window for application. */ Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ const char **argv) /* Argument strings. */ { TImageMaster *timPtr = clientData; int x, y, width, height; if (argc < 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], "option ?arg ...?", NULL); return TCL_ERROR; } if (strcmp(argv[1], "changed") == 0) { if (argc != 8) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " changed x y width height imageWidth imageHeight", NULL); return TCL_ERROR; } if ((Tcl_GetInt(interp, argv[2], &x) != TCL_OK) || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) || (Tcl_GetInt(interp, argv[4], &width) != TCL_OK) || (Tcl_GetInt(interp, argv[5], &height) != TCL_OK) || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK) || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) { return TCL_ERROR; } Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width, timPtr->height); } else { Tcl_AppendResult(interp, "bad option \"", argv[1], "\": must be changed", NULL); return TCL_ERROR; } return TCL_OK; }
int NurbsSurface (Tcl_Interp *interp, int argc, char* argv []) { int result = TCL_OK; GLint uOrder = 4; GLint vOrder = 4; GLenum type = GL_MAP2_VERTEX_3; int nCoords = 3; FloatArray uKnot = NewFloatArray (); FloatArray vKnot = NewFloatArray (); FloatArray cPoint = NewFloatArray (); GLfloat samplingTolerance = 50.0; GLfloat displayMode = GLU_FILL; GLfloat culling = GL_FALSE; int iarg; int dlist = 0; for (iarg = 2; iarg < argc; iarg++) { int len = (int)strlen (argv [iarg]); if (strncmp (argv [iarg], "-uorder", len) == 0) { int val; iarg++; if (iarg >= argc) ERRMSG ("No value given for -uorder"); if (Tcl_GetInt (interp, argv [iarg], &val) != TCL_OK || val < 2 || val > 8) ERRMSG2 ("\nInvalid value for -uorder:", argv [iarg]); uOrder = val; } else if (strncmp (argv [iarg], "-vorder", len) == 0) { int val; iarg++; if (iarg >= argc) ERRMSG ("No value given for -vorder"); if (Tcl_GetInt (interp, argv [iarg], &val) != TCL_OK || val < 2 || val > 8) ERRMSG2 ("\nInvalid value for -vorder:", argv [iarg]); vOrder = val; } else if (strncmp (argv [iarg], "-uknots", len) == 0) { if (uKnot->count != 0) ERRMSG ("uknot values already given"); iarg++; while (iarg < argc && !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) { double val; if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK) ERRMSG ("\nError parsing uknot value"); if (uKnot->count > 0 && uKnot->value [uKnot->count-1] > val) ERRMSG ("uknot values not in non-descending order"); AddFloat (uKnot, (GLfloat)val); iarg++; } iarg--; } else if (strncmp (argv [iarg], "-vknots", len) == 0) { if (vKnot->count != 0) ERRMSG ("vknot values already given"); iarg++; while (iarg < argc && !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) { double val; if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK) ERRMSG ("\nError parsing uknot value"); if (vKnot->count > 0 && vKnot->value [vKnot->count-1] > val) ERRMSG ("vknot values not in non-descending order"); AddFloat (vKnot, (GLfloat)val); iarg++; } iarg--; } else if (strncmp (argv [iarg], "-controlpoints", len) == 0) { if (cPoint->count != 0) ERRMSG ("controlpoint values already given"); iarg++; while (iarg < argc && !(argv [iarg][0] == '-' && isalpha(argv [iarg][1]))) { double val; if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK) ERRMSG ("\nError parsing uknot value"); AddFloat (cPoint, (GLfloat)val); iarg++; } iarg--; } else if (strncmp (argv [iarg], "-type", len) == 0) { iarg++; if (iarg >= argc) ERRMSG ("No -type value given"); if (strcmp (argv [iarg], "map2vertex3") ==0) { type = GL_MAP2_VERTEX_3; nCoords = 3; } else if (strcmp (argv [iarg], "map2vertex4") == 0) { type = GL_MAP2_VERTEX_4; nCoords = 4; } else if (strcmp (argv [iarg], "map2color4") == 0) { type = GL_MAP2_COLOR_4; nCoords = 4; } else if (strcmp (argv [iarg], "map2normal") == 0) { type = GL_MAP2_NORMAL; nCoords = 3; } else if (strcmp (argv [iarg], "map2texturecoord1") == 0) { type = GL_MAP2_TEXTURE_COORD_1; nCoords = 1; } else if (strcmp (argv [iarg], "map2texturecoord2") == 0) { type = GL_MAP2_TEXTURE_COORD_2; nCoords = 2; } else if (strcmp (argv [iarg], "map2texturecoord3") == 0) { type = GL_MAP2_TEXTURE_COORD_3; nCoords = 3; } else if (strcmp (argv [iarg], "map2texturecoord4") == 0) { type = GL_MAP2_TEXTURE_COORD_4; nCoords = 4; } else ERRMSG2 ("not a valid type:", argv [iarg]); } else if (strncmp (argv [iarg], "-samplingtolerance", len) == 0) { double val; iarg++; if (iarg >= argc) ERRMSG ("No -samplingtolerance value given"); if (Tcl_GetDouble (interp, argv [iarg], &val) != TCL_OK) ERRMSG ("\nError parsing sampling tolerance"); samplingTolerance = (GLfloat)val; } else if (strncmp (argv [iarg], "-displaymode", len) == 0) { iarg++; if (iarg >= argc) ERRMSG ("No -displaymode value given"); if (strcmp (argv [iarg], "fill") == 0) { displayMode = GLU_FILL; } else if (strcmp (argv [iarg], "outlinepolygon") == 0) { displayMode = GLU_OUTLINE_POLYGON; } else if (strcmp (argv [iarg], "outlinepatch") == 0) { displayMode = GLU_OUTLINE_PATCH; } else { ERRMSG2 ("not a valid display mode:", argv [iarg]); } } else if (strncmp (argv [iarg], "-culling", len) == 0) { int val; iarg++; if (iarg >= argc) ERRMSG ("No -culling value given"); if (Tcl_GetBoolean (interp, argv [iarg], &val) != TCL_OK) ERRMSG ("\nError parsing culling value"); culling = (GLfloat)val; } else { ERRMSG2 ("invalid option:", argv [iarg]); } } if (vKnot->count == 0 || uKnot->count == 0 || cPoint->count == 0) ERRMSG ("All of -uknot, -vknot and -cpoint options must be specified"); /* Now try to guess the remaining arguments and call gluNurbsSurface */ { GLint uKnotCount = uKnot->count; GLint vKnotCount = vKnot->count; GLint vStride = nCoords; GLint uStride = nCoords * (vKnotCount - vOrder); static GLUnurbsObj* obj = NULL; if (uStride * (uKnotCount - uOrder) != cPoint->count) { char buf [80]; sprintf (buf, "%d", uStride * (uKnotCount - uOrder)); ERRMSG2 ("Incorrect number of controlpoint coordinates. Expected ", buf); } /* Theoretically, a nurbs object could be allocated for each invocation of NurbsSurface and then freed after the creation of the display list. However, this produces a segmentation violation on AIX OpenGL 1.0. Thus, only one nurbs object is ever allocated and never freed. */ if (obj == NULL) obj = gluNewNurbsRenderer(); dlist = glGenLists (1); gluNurbsProperty (obj, GLU_SAMPLING_TOLERANCE, samplingTolerance); gluNurbsProperty (obj, GLU_DISPLAY_MODE, displayMode); gluNurbsProperty (obj, GLU_CULLING, culling); glNewList (dlist, GL_COMPILE); gluBeginSurface (obj); gluNurbsSurface (obj, uKnotCount, uKnot->value, vKnotCount, vKnot->value, uStride, vStride, cPoint->value, uOrder, vOrder, type); gluEndSurface (obj); /* This is never used because of a bug in AIX OpenGL 1.0. gluDeleteNurbsObj (obj); */ glEndList(); glFlush(); } done: DestroyFloatArray (uKnot); DestroyFloatArray (vKnot); DestroyFloatArray (cPoint); if (result == TCL_OK) { char tmp[128]; sprintf (tmp, "%d", dlist); Tcl_SetResult(interp, tmp, TCL_VOLATILE); } return result; }
int TclModelBuilder_addElastomericBearingPlasticity(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theTclDomain, TclModelBuilder *theTclBuilder, int eleArgStart) { // ensure the destructor has not been called if (theTclBuilder == 0) { opserr << "WARNING builder has been destroyed - elastomericBearing\n"; return TCL_ERROR; } Element *theElement = 0; int ndm = theTclBuilder->getNDM(); int ndf = theTclBuilder->getNDF(); int tag; if (ndm == 2) { // check plane frame problem has 3 dof per node if (ndf != 3) { opserr << "WARNING invalid ndf: " << ndf; opserr << ", for plane problem need 3 - elastomericBearing\n"; return TCL_ERROR; } // check the number of arguments is correct if ((argc-eleArgStart) < 13) { opserr << "WARNING insufficient arguments\n"; printCommand(argc, argv); opserr << "Want: elastomericBearing eleTag iNode jNode kInit fy alpha1 alpha2 mu -P matTag -Mz matTag <-orient x1 x2 x3 y1 y2 y3> <-shearDist sDratio> <-doRayleigh> <-mass m>\n"; return TCL_ERROR; } // get the id and end nodes int iNode, jNode, matTag, argi, j; int recvMat = 0; double kInit, fy, alpha1; double alpha2 = 0.0; double mu = 2.0; double shearDistI = 0.5; int doRayleigh = 0; double mass = 0.0; if (Tcl_GetInt(interp, argv[1+eleArgStart], &tag) != TCL_OK) { opserr << "WARNING invalid elastomericBearing eleTag\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2+eleArgStart], &iNode) != TCL_OK) { opserr << "WARNING invalid iNode\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3+eleArgStart], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[4+eleArgStart], &kInit) != TCL_OK) { opserr << "WARNING invalid kInit\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[5+eleArgStart], &fy) != TCL_OK) { opserr << "WARNING invalid fy\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[6+eleArgStart], &alpha1) != TCL_OK) { opserr << "WARNING invalid alpha1\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[7+eleArgStart], &alpha2) != TCL_OK) { opserr << "WARNING invalid alpha2\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[8+eleArgStart], &mu) != TCL_OK) { opserr << "WARNING invalid mu\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } UniaxialMaterial *theMaterials[2]; for (int i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-P") == 0) { theMaterials[0] = 0; if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[0] = OPS_getUniaxialMaterial(matTag); if (theMaterials[0] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } for (int i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-Mz") == 0) { if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[1] = OPS_getUniaxialMaterial(matTag); if (theMaterials[1] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } if (recvMat != 2) { opserr << "WARNING wrong number of materials\n"; opserr << "got " << recvMat << " materials, but want 2 materials\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } // check for optional arguments Vector x = 0; Vector y = 0; for (int i = 9+eleArgStart; i < argc; i++) { if (strcmp(argv[i],"-orient") == 0) { j = i+1; int numOrient = 0; while (j < argc && strcmp(argv[j],"-shearDist") != 0 && strcmp(argv[j],"-doRayleigh") != 0 && strcmp(argv[j],"-mass") != 0) { numOrient++; j++; } if (numOrient == 6) { argi = i+1; x.resize(3); y.resize(3); double value; // read the x values for (j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } else { argi++; x(j) = value; } } // read the y values for (j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } else { argi++; y(j) = value; } } } else { opserr << "WARNING insufficient arguments after -orient flag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } for (int i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-shearDist") == 0) { if (Tcl_GetDouble(interp, argv[i+1], &shearDistI) != TCL_OK) { opserr << "WARNING invalid -shearDist value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } for (int i = 9+eleArgStart; i < argc; i++) { if (strcmp(argv[i], "-doRayleigh") == 0) doRayleigh = 1; } for (int i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-mass") == 0) { if (Tcl_GetDouble(interp, argv[i+1], &mass) != TCL_OK) { opserr << "WARNING invalid -mass value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } // now create the elastomericBearing theElement = new ElastomericBearingPlasticity2d(tag, iNode, jNode, kInit, fy, alpha1, theMaterials, y, x, alpha2, mu, shearDistI, doRayleigh, mass); if (theElement == 0) { opserr << "WARNING ran out of memory creating element\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } // then add the elastomericBearing to the domain if (theTclDomain->addElement(theElement) == false) { opserr << "WARNING could not add element to the domain\n"; opserr << "elastomericBearing element: " << tag << endln; delete theElement; return TCL_ERROR; } } else if (ndm == 3) { // check space frame problem has 6 dof per node if (ndf != 6) { opserr << "WARNING invalid ndf: " << ndf; opserr << ", for space problem need 6 - elastomericBearing \n"; return TCL_ERROR; } // check the number of arguments is correct if ((argc-eleArgStart) < 17) { opserr << "WARNING insufficient arguments\n"; printCommand(argc, argv); opserr << "Want: elastomericBearing eleTag iNode jNode kInit fy alpha1 alpha2 mu -P matTag -T matTag -My matTag -Mz matTag <-orient <x1 x2 x3> y1 y2 y3> <-shearDist sDratio> <-mass m>\n"; return TCL_ERROR; } // get the id and end nodes int iNode, jNode, matTag, argi, i, j; int recvMat = 0; double kInit, fy, alpha1; double alpha2 = 0.0; double mu = 2.0; double shearDistI = 0.5; int doRayleigh = 0; double mass = 0.0; if (Tcl_GetInt(interp, argv[1+eleArgStart], &tag) != TCL_OK) { opserr << "WARNING invalid elastomericBearing eleTag\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[2+eleArgStart], &iNode) != TCL_OK) { opserr << "WARNING invalid iNode\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[3+eleArgStart], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[4+eleArgStart], &kInit) != TCL_OK) { opserr << "WARNING invalid kInit\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[5+eleArgStart], &fy) != TCL_OK) { opserr << "WARNING invalid fy\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[6+eleArgStart], &alpha1) != TCL_OK) { opserr << "WARNING invalid alpha1\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[7+eleArgStart], &alpha2) != TCL_OK) { opserr << "WARNING invalid alpha2\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[8+eleArgStart], &mu) != TCL_OK) { opserr << "WARNING invalid mu\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } UniaxialMaterial *theMaterials[4]; for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-P") == 0) { if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid axial matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[0] = OPS_getUniaxialMaterial(matTag); if (theMaterials[0] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-T") == 0) { if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid torsional matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[1] = OPS_getUniaxialMaterial(matTag); if (theMaterials[1] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-My") == 0) { if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid moment y matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[2] = OPS_getUniaxialMaterial(matTag); if (theMaterials[2] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-Mz") == 0) { if (Tcl_GetInt(interp, argv[i+1], &matTag) != TCL_OK) { opserr << "WARNING invalid moment z matTag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } theMaterials[3] = OPS_getUniaxialMaterial(matTag); if (theMaterials[3] == 0) { opserr << "WARNING material model not found\n"; opserr << "uniaxialMaterial: " << matTag << endln; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } recvMat++; } } if (recvMat != 4) { opserr << "WARNING wrong number of materials\n"; opserr << "got " << recvMat << " materials, but want 4 materials\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } // check for optional arguments Vector x(0); Vector y(3); y(0) = 0.0; y(1) = 1.0; y(2) = 0.0; for (i = 9+eleArgStart; i < argc; i++) { if (strcmp(argv[i],"-orient") == 0) { j = i+1; int numOrient = 0; while (j < argc && strcmp(argv[j],"-shearDist") != 0 && strcmp(argv[j],"-doRayleigh") != 0 && strcmp(argv[j],"-mass") != 0) { numOrient++; j++; } if (numOrient == 3) { argi = i+1; double value; // read the y values for (j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } else { argi++; y(j) = value; } } } else if (numOrient == 6) { argi = i+1; x.resize(3); double value; // read the x values for (j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } else { argi++; x(j) = value; } } // read the y values for (j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } else { argi++; y(j) = value; } } } else { opserr << "WARNING insufficient arguments after -orient flag\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-shearDist") == 0) { if (Tcl_GetDouble(interp, argv[i+1], &shearDistI) != TCL_OK) { opserr << "WARNING invalid -shearDist value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-doRayleigh") == 0) doRayleigh = 1; } for (i = 9+eleArgStart; i < argc; i++) { if (i+1 < argc && strcmp(argv[i], "-mass") == 0) { if (Tcl_GetDouble(interp, argv[i+1], &mass) != TCL_OK) { opserr << "WARNING invalid -mass value\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } } } // now create the elastomericBearing theElement = new ElastomericBearingPlasticity3d(tag, iNode, jNode, kInit, fy, alpha1, theMaterials, y, x, alpha2, mu, shearDistI, doRayleigh, mass); if (theElement == 0) { opserr << "WARNING ran out of memory creating element\n"; opserr << "elastomericBearing element: " << tag << endln; return TCL_ERROR; } // then add the elastomericBearing to the domain if (theTclDomain->addElement(theElement) == false) { opserr << "WARNING could not add element to the domain\n"; opserr << "elastomericBearing element: " << tag << endln; delete theElement; return TCL_ERROR; } } else { opserr << "WARNING elastomericBearing command only works when ndm is 2 or 3, ndm: "; opserr << ndm << endln; return TCL_ERROR; } // if get here we have sucessfully created the elastomericBearing and added it to the domain return TCL_OK; }
/* ** usage: varint_test START MULTIPLIER COUNT INCREMENT ** ** This command tests the putVarint() and getVarint() ** routines, both for accuracy and for speed. ** ** An integer is written using putVarint() and read back with ** getVarint() and varified to be unchanged. This repeats COUNT ** times. The first integer is START*MULTIPLIER. Each iteration ** increases the integer by INCREMENT. ** ** This command returns nothing if it works. It returns an error message ** if something goes wrong. */ static int btree_varint_test( void *NotUsed, Tcl_Interp *interp, /* The TCL interpreter that invoked this command */ int argc, /* Number of arguments */ const char **argv /* Text of each argument */ ){ u32 start, mult, count, incr; u64 in, out; int n1, n2, i, j; unsigned char zBuf[100]; if( argc!=5 ){ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " START MULTIPLIER COUNT INCREMENT\"", 0); return TCL_ERROR; } if( Tcl_GetInt(interp, argv[1], (int*)&start) ) return TCL_ERROR; if( Tcl_GetInt(interp, argv[2], (int*)&mult) ) return TCL_ERROR; if( Tcl_GetInt(interp, argv[3], (int*)&count) ) return TCL_ERROR; if( Tcl_GetInt(interp, argv[4], (int*)&incr) ) return TCL_ERROR; in = start; in *= mult; for(i=0; i<count; i++){ char zErr[200]; n1 = putVarint(zBuf, in); if( n1>9 || n1<1 ){ sprintf(zErr, "putVarint returned %d - should be between 1 and 9", n1); Tcl_AppendResult(interp, zErr, 0); return TCL_ERROR; } n2 = getVarint(zBuf, &out); if( n1!=n2 ){ sprintf(zErr, "putVarint returned %d and getVarint returned %d", n1, n2); Tcl_AppendResult(interp, zErr, 0); return TCL_ERROR; } if( in!=out ){ sprintf(zErr, "Wrote 0x%016llx and got back 0x%016llx", in, out); Tcl_AppendResult(interp, zErr, 0); return TCL_ERROR; } if( (in & 0xffffffff)==in ){ u32 out32; n2 = getVarint32(zBuf, out32); out = out32; if( n1!=n2 ){ sprintf(zErr, "putVarint returned %d and GetVarint32 returned %d", n1, n2); Tcl_AppendResult(interp, zErr, 0); return TCL_ERROR; } if( in!=out ){ sprintf(zErr, "Wrote 0x%016llx and got back 0x%016llx from GetVarint32", in, out); Tcl_AppendResult(interp, zErr, 0); return TCL_ERROR; } } /* In order to get realistic timings, run getVarint 19 more times. ** This is because getVarint is called about 20 times more often ** than putVarint. */ for(j=0; j<19; j++){ getVarint(zBuf, &out); } in += incr; } return TCL_OK; }
int TkpUseWindow( Tcl_Interp *interp, /* If not NULL, used for error reporting * if string is bogus. */ Tk_Window tkwin, /* Tk window that does not yet have an * associated X window. */ CONST char *string) /* String identifying an X window to use * for tkwin; must be an integer value. */ { TkWindow *winPtr = (TkWindow *) tkwin; TkWindow *usePtr; MacDrawable *parent, *macWin; Container *containerPtr; XEvent event; int result; if (winPtr->window != None) { panic("TkpUseWindow: X window already assigned"); } /* * Decode the container pointer, and look for it among the *list of available containers. * * N.B. For now, we are limiting the containers to be in the same Tk * application as tkwin, since otherwise they would not be in our list * of containers. * */ if (Tcl_GetInt(interp, string, &result) != TCL_OK) { return TCL_ERROR; } usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, (Window) result); if (usePtr == NULL) { Tcl_AppendResult(interp, "Tk window does not correspond to id \"", string, "\"", (char *) NULL); return TCL_ERROR; } else { if (!(usePtr->flags & TK_CONTAINER)) { Tcl_AppendResult(interp, "window \"", usePtr->pathName, "\" doesn't have -container option set", (char *) NULL); return TCL_ERROR; } } parent = (MacDrawable *) result; /* * Save information about the container and the embedded window * in a Container structure. Currently, there must already be an existing * Container structure, since we only allow the case where both container * and embedded app. are in the same process. */ for (containerPtr = firstContainerPtr; containerPtr != NULL; containerPtr = containerPtr->nextPtr) { if (containerPtr->parent == (Window) parent) { winPtr->flags |= TK_BOTH_HALVES; containerPtr->parentPtr->flags |= TK_BOTH_HALVES; break; } } /* * Make the embedded window. */ macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable)); if (macWin == NULL) { winPtr->privatePtr = NULL; return TCL_ERROR; } macWin->winPtr = winPtr; winPtr->privatePtr = macWin; /* * The portPtr will be NULL for a Tk in Tk embedded window. * It is none of our business what it is for a Tk not in Tk embedded window, * but we will initialize it to NULL, and let the registerWinProc * set it. In any case, you must always use TkMacGetDrawablePort * to get the portPtr. It will correctly find the container's port. */ macWin->portPtr = (GWorldPtr) NULL; macWin->clipRgn = NewRgn(); macWin->aboveClipRgn = NewRgn(); macWin->referenceCount = 0; macWin->flags = TK_CLIP_INVALID; macWin->toplevel = macWin; macWin->toplevel->referenceCount++; winPtr->flags |= TK_EMBEDDED; /* * Make a copy of the TK_EMBEDDED flag, since sometimes * we need this to get the port after the TkWindow structure * has been freed. */ macWin->flags |= TK_EMBEDDED; /* * Now check whether it is embedded in another Tk widget. If not (the first * case below) we see if there is an in-process embedding handler registered, * and if so, let that fill in the rest of the macWin. */ if (containerPtr == NULL) { /* * If someone has registered an in process embedding handler, then * see if it can handle this window... */ if (gMacEmbedHandler == NULL || gMacEmbedHandler->registerWinProc(result, (Tk_Window) winPtr) != TCL_OK) { Tcl_AppendResult(interp, "The window ID ", string, " does not correspond to a valid Tk Window.", (char *) NULL); return TCL_ERROR; } else { containerPtr = (Container *) ckalloc(sizeof(Container)); containerPtr->parentPtr = NULL; containerPtr->embedded = (Window) macWin; containerPtr->embeddedPtr = macWin->winPtr; containerPtr->nextPtr = firstContainerPtr; firstContainerPtr = containerPtr; } } else { /* * The window is embedded in another Tk window. */ macWin->xOff = parent->winPtr->privatePtr->xOff + parent->winPtr->changes.border_width + winPtr->changes.x; macWin->yOff = parent->winPtr->privatePtr->yOff + parent->winPtr->changes.border_width + winPtr->changes.y; /* * Finish filling up the container structure with the embedded window's * information. */ containerPtr->embedded = (Window) macWin; containerPtr->embeddedPtr = macWin->winPtr; /* * Create an event handler to clean up the Container structure when * tkwin is eventually deleted. */ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc, (ClientData) winPtr); } /* * TODO: need general solution for visibility events. */ event.xany.serial = Tk_Display(winPtr)->request; event.xany.send_event = False; event.xany.display = Tk_Display(winPtr); event.xvisibility.type = VisibilityNotify; event.xvisibility.window = (Window) macWin;; event.xvisibility.state = VisibilityUnobscured; Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); /* * TODO: need general solution for visibility events. */ event.xany.serial = Tk_Display(winPtr)->request; event.xany.send_event = False; event.xany.display = Tk_Display(winPtr); event.xvisibility.type = VisibilityNotify; event.xvisibility.window = (Window) macWin;; event.xvisibility.state = VisibilityUnobscured; Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL); return TCL_OK; }
int TclModelBuilder_addZeroLengthRocking(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, iNode, jNode, and the orientation // of ele xPrime and yPrime not along the global x and y axis // int eleTag, iNode, jNode; // a quick check on number of args if (argc < 9) { opserr << "WARNING too few arguments " << "want - element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "WARNING invalied eleTag " << argv[2] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "WARNING invalied iNode " << argv[3] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode " << argv[4] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // look for rocking required inputs double kr = 0; double R = 0; double theta = 0; double kap = 1.0e12; // rotational stiffness if (Tcl_GetDouble(interp, argv[5], &kr) != TCL_OK) { opserr << "WARNING invalid kr " << argv[5] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // rocking radius if (Tcl_GetDouble(interp, argv[6], &R) != TCL_OK) { opserr << "WARNING invalid radius " << argv[6] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // theta0 if (Tcl_GetDouble(interp, argv[7], &theta) != TCL_OK) { opserr << "WARNING invalid theta0 " << argv[7] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // kappa if (Tcl_GetDouble(interp, argv[8], &kap) != TCL_OK) { opserr << "WARNING invalid kappa " << argv[8] << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // create the vectors for the element orientation Vector x(3); x(0) = 1.0; x(1) = 0.0; x(2) = 0.0; Vector y(3); y(0) = 0.0; y(1) = 1.0; y(2) = 0.0; double xi = 1.0e-8; double dTol = 1.0e-7; double vTol = 1.0e-7; int argi = 9; while (argi < argc) { if (strcmp(argv[argi],"-orient") == 0) { if (argc < (argi+7)) { opserr << "WARNING not enough parameters after -orient flag for ele " << eleTag << "- element ZeroLengthRocking eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; double value; // read the x values for (int i=0; i<3; i++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[i] << "- element ZeroLength eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; x(i) = value; } } // read the y values for (int j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "kr? radius? theta0? kappa? <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; y(j) = value; } } } } else if (strcmp(argv[argi],"-xi") == 0) { if (argc < (argi+2)) { opserr << "WARNING not enough parameters after -xi flag for ele " << eleTag << endln; return TCL_ERROR; } else { argi++; if (Tcl_GetDouble(interp, argv[argi], &xi) != TCL_OK) { opserr << "WARNING invalid -xi value for ele " << eleTag << endln; return TCL_ERROR; } else argi++; } } else if (strcmp(argv[argi],"-dTol") == 0) { if (argc < (argi+2)) { opserr << "WARNING not enough parameters after -dTol flag for ele " << eleTag << endln; return TCL_ERROR; } else { argi++; if (Tcl_GetDouble(interp, argv[argi], &dTol) != TCL_OK) { opserr << "WARNING invalid -dTol value for ele " << eleTag << endln; return TCL_ERROR; } else argi++; } } else if (strcmp(argv[argi],"-vTol") == 0) { if (argc < (argi+2)) { opserr << "WARNING not enough parameters after -vTol flag for ele " << eleTag << endln; return TCL_ERROR; } else { argi++; if (Tcl_GetDouble(interp, argv[argi], &vTol) != TCL_OK) { opserr << "WARNING invalid -vTol value for ele " << eleTag << endln; return TCL_ERROR; } else argi++; } } else argi++; } // // now we create the element and add it to the domain // Element *theEle; theEle = new ZeroLengthRocking(eleTag, ndm, iNode, jNode, x, y, kr, R, theta, kap, xi, dTol, vTol); if (theEle == 0) return TCL_ERROR; if (theDomain->addElement(theEle) == false) return TCL_ERROR; return TCL_OK; }
int TclModelBuilder_addZeroLengthContact3D(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, SlaveNode, MasterNode, int eleTag, iNode, jNode; //opserr << argc; // a quick check on number of args if (argc < 10) { opserr << "ZeroLengthContact3D::WARNING too few arguments " << "want - element ZeroLengthContact3D eleTag? iNode? jNode? Kn? Kt? fs? c? dir?" ; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalied eleTag " << argv[2] << "\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalied iNode " << argv[3] << "\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid jNode " << argv[4] << "\n" ; return TCL_ERROR; } double Kn, Kt, fs, c; // read the material properties if (Tcl_GetDouble(interp, argv[5], &Kn) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid Kn " << argv[5] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[6], &Kt) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid Kt " << argv[6] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[7], &fs) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid fs " << argv[7] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[8], &c) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid c " << argv[8] << "\n" ; return TCL_ERROR; } int dir; if (Tcl_GetInt(interp, argv[9], &dir) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid direction " << argv[9] << "\n" ; return TCL_ERROR; } // // now we create the element and add it to the domain // Element *theEle; double originX, originY; originX=0; originY=0; if (dir==0) { if (argc == 12) { if (Tcl_GetDouble(interp, argv[10], &originX) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid originX " << argv[9] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[11], &originY) != TCL_OK) { opserr << "ZeroLengthContact3D::WARNING invalid originY " << argv[10] << "\n" ; return TCL_ERROR; } } } theEle = new ZeroLengthContact3D(eleTag, iNode, jNode, dir, Kn, Kt, fs, c, originX, originY); if (theEle == 0) { return TCL_ERROR; } if (theDomain->addElement(theEle) == false) { return TCL_ERROR; } // return the memory we stole and return OK return TCL_OK; }
int TclModelBuilder_addZeroLength(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, iNode, jNode, material ID's // and their directions, and the orientation of ele xPrime and yPrime not // along the global x and y axis // int eleTag, iNode, jNode; // a quick check on number of args if (argc < 9) { opserr << "WARNING too few arguments " << "want - element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "WARNING invalied eleTag " << argv[2] << "- element ZeroLength eleTag? iNode? jNode? -mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "WARNING invalied iNode " << argv[3] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode " << argv[4] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // create an array of material pointers, to do this first count // the materials to create the array then get matID's and from ModelBuilder // obtain pointers to the material objects // read the number of materials int numMat = 0; if (strcmp(argv[5],"-mat") != 0) { opserr << "WARNING expecting -mat flag %s %s %s %s\n" << argv[5] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } int argi = 6; while ((argi < argc) && (strcmp(argv[argi],"-dir") != 0)) { numMat++; argi++; } if (argi == argc) { // check we encountered the -dirn flag opserr << "WARNING no -dirn flag encountered " << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } if (numMat == 0) { opserr << "WARNING no materials specified " << "- element ZeroLength eleTag? iNode? jNode? " << "-mat <matID1? ... -dir irMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // create the array UniaxialMaterial **theMats = new UniaxialMaterial *[numMat]; UniaxialMaterial **theDampMats = new UniaxialMaterial *[numMat]; if (theMats == 0) { opserr << "WARNING out of memory " << "creating material array of size " << numMat << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // fill in the material array argi=6; for (int i=0; i<numMat; i++) { theDampMats[i] = 0; int matID; // read the material tag if (Tcl_GetInt(interp, argv[argi], &matID) != TCL_OK) { opserr << "WARNING invalid matID " << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { // get a pointer to the material from the modelbuilder argi++; UniaxialMaterial *theMat = OPS_getUniaxialMaterial(matID); if (theMat == 0) { opserr << "WARNING no material " << matID << "exitsts - element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n" ; delete [] theMats; return TCL_ERROR; } else { // add the material to the array theMats[i] = theMat; } } } // now read the dirn ID's for the materials added argi = 6 + numMat; if (strcmp(argv[argi],"-dir") != 0) { opserr << "WARNING expecting -dirn flag " << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } if ((argi + numMat) > argc) { opserr << "WARNING not enough directions provided for ele " << eleTag << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } // create an ID to hold the directions ID theDirns(numMat); argi++; int dirnID; // read the dirn identifiers for (int j=0; j<numMat; j++) { if (Tcl_GetInt(interp, argv[argi], &dirnID) != TCL_OK) { opserr << "WARNING invalid directiion " << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { theDirns[j] = dirnID -1; // the minus g3 to C++ argi++; } } // create the vectors for the element orientation Vector x(3); x(0) = 1.0; x(1) = 0.0; x(2) = 0.0; Vector y(3); y(0) = 0.0; y(1) = 1.0; y(2) = 0.0; // finally check the command line to see if user specified orientation int doRayleighDamping = 0; while (argi < argc) { if (strcmp(argv[argi],"-orient") == 0) { if (argc < (argi+7)) { opserr << "WARNING not enough parameters after -orient flag for ele " << eleTag << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { argi++; double value; // read the x values for (int i=0; i<3; i++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[i] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { argi++; x(i) = value; } } // read the y values for (int j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { argi++; y(j) = value; } } } argi++; } else if (strcmp(argv[argi],"-doRayleigh") == 0) { doRayleighDamping = 1; argi++; if (argi < argc) if ((Tcl_GetInt(interp, argv[argi], &doRayleighDamping) == TCL_OK)) argi++; } else if (strcmp(argv[argi],"-dampMats") == 0) { doRayleighDamping = 2; argi++; for (int i=0; i<numMat; i++) { int matID; // read the material tag if (Tcl_GetInt(interp, argv[argi], &matID) != TCL_OK) { opserr << "WARNING invalid matID " << argv[argi] << "- element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; delete [] theMats; return TCL_ERROR; } else { UniaxialMaterial *theMat = OPS_getUniaxialMaterial(matID); if (theMat == 0) { opserr << "WARNING no material " << matID << "exitsts - element ZeroLength eleTag? iNode? jNode? " << "-mat matID1? ... -dir dirMat1? .. " << "<-orient x1? x2? x3? y1? y2? y3?>\n" ; delete [] theMats; return TCL_ERROR; } else { theDampMats[i] = theMat; } } argi++; } } else argi++; } // // now we create the element and add it to the domain // Element *theEle; if (doRayleighDamping != 2) theEle = new ZeroLength(eleTag, ndm, iNode, jNode, x, y, numMat, theMats, theDirns, doRayleighDamping); else theEle = new ZeroLength(eleTag, ndm, iNode, jNode, x, y, numMat, theMats, theDampMats, theDirns, doRayleighDamping); if (theEle == 0) { delete [] theMats; return TCL_ERROR; } if (theDomain->addElement(theEle) == false) { delete [] theMats; return TCL_ERROR; } // return the memory we stole and return OK delete [] theMats; delete [] theDampMats; return TCL_OK; }
int NsTclConfigCmd(ClientData dummy, Tcl_Interp *interp, int argc, char **argv) { char *value; int i; int fHasDefault = NS_FALSE; int defaultIndex = 0; if (argc < 3 || argc > 5) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?-exact | -bool | -int? section key ?default?\"", NULL); return TCL_ERROR; } if (argv[1][0] == '-') { if (argc == 5) { fHasDefault = NS_TRUE; defaultIndex = 4; } } else if (argc == 4) { fHasDefault = NS_TRUE; defaultIndex = 3; } if (STREQ(argv[1], "-exact")) { value = Ns_ConfigGetValueExact(argv[2], argv[3]); if (value == NULL && fHasDefault) { value = argv[defaultIndex]; } } else if (STREQ(argv[1], "-int")) { if (Ns_ConfigGetInt(argv[2], argv[3], &i)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); return TCL_OK; } else if (fHasDefault) { if (Tcl_GetInt(interp, argv[defaultIndex], &i) != TCL_OK) { return TCL_ERROR; } Tcl_SetObjResult(interp, Tcl_NewIntObj(i)); return TCL_OK; } value = NULL; } else if (STREQ(argv[1], "-bool")) { int iValue; if (Ns_ConfigGetBool(argv[2], argv[3], &iValue) == NS_FALSE) { if (fHasDefault) { if ( Tcl_GetBoolean(interp, argv[defaultIndex], &iValue) != TCL_OK) { return TCL_ERROR; } value = (iValue) ? "1" : "0"; } else { value = NULL; } } else { value = (iValue) ? "1" : "0"; } } else if (argc == 3 || argc == 4) { value = Ns_ConfigGetValue(argv[1], argv[2]); if (value == NULL && fHasDefault) { value = argv[defaultIndex]; } } else { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], " ?-exact | -bool | -int? section key ?default?\"", NULL); return TCL_ERROR; } if (value != NULL) { Tcl_SetResult(interp, value, TCL_STATIC); } return TCL_OK; }
BOOL CSemanticStrView::Create(LPCTSTR lpszClassName, LPCTSTR lpszWindowName, DWORD dwStyle, const RECT& rect, CWnd* pParentWnd, UINT nID, CCreateContext* pContext) { // TODO: Add your specialized code here and/or call the base class m_Menu.LoadMenu(IDR_ROSSDETYPE); pParentWnd->SetMenu( &m_Menu ); char s[2000]; CRect R = rect; //R.right = rect.right + 100; pParentWnd->SetWindowPos(0, 120, 120, 840, 500,0); BOOL ok = CWnd::Create(lpszClassName, lpszWindowName, dwStyle, R, pParentWnd, nID, pContext); if (ok) { int retcode; CString winhnd, cmd; m_tkname.Format(".tk%d",++TclWindowCounter); // name this window .tk1 .tk2 etc winhnd.Format("0x%08X",m_hWnd); cmd.Format("toplevel %s -use %s",m_tkname,winhnd); strcpy (s, cmd); retcode = Tcl_Eval(theInterp,s); if (retcode!=TCL_OK) { Tcl_SetResult(theInterp,"Cannot create TK child window",TCL_VOLATILE); return ok; } Tk_Window tkmain = Tk_MainWindow(theInterp); if (tkmain) { //get the tk window token strcpy (s, m_tkname); m_tkwin = Tk_NameToWindow(theInterp, s, tkmain); Tcl_DoOneEvent(TCL_ALL_EVENTS|TCL_DONT_WAIT); //force window creation // get the HWND cmd.Format("winfo id %s",m_tkname); strcpy (s, cmd); retcode = Tcl_Eval(theInterp,s); if (retcode==TCL_OK) { int i; retcode = Tcl_GetInt(theInterp,theInterp->result,&i); if (retcode==TCL_OK) { m_tkhwnd = (HWND)i; } } SwitchGraph(m_tkname); CString cmd; cmd.Format("source $env(GRAPHLET_DIR)/lib/graphscript/ross/semstruct.tcl"); strcpy (s, cmd); retcode = Tcl_Eval(theInterp,s); if (retcode!=TCL_OK) { AfxMessageBox (theInterp->result); return FALSE; }; cmd.Format("initialize_graphic $main"); strcpy (s, cmd); retcode = Tcl_Eval(theInterp,s); if (retcode!=TCL_OK) { AfxMessageBox (theInterp->result); return FALSE; }; } } return ok; }
int TclModelBuilder_addZeroLengthSection(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, iNode, jNode, material ID's // and their directions, and the orientation of ele xPrime and yPrime not // along the global x and y axis // int eleTag, iNode, jNode; // a quick check on number of args if (argc < 6) { opserr << "WARNING too few arguments " << "want - element zeroLengthSection eleTag? iNode? jNode? " << "secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "WARNING invalied eleTag " << argv[2] << "- element zeroLengthSection eleTag? iNode? jNode? " << "secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "WARNING invalied iNode " << argv[3] << "- element zeroLengthSection eleTag? iNode? jNode? " << "secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode " << argv[4] << "- element zeroLengthSection eleTag? iNode? jNode? " << "secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } int secTag; if (Tcl_GetInt(interp, argv[5], &secTag) != TCL_OK) { opserr << "WARNING invalid secTag " << argv[5] << "- element zeroLengthSection eleTag? iNode? jNode? " << "secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // create the vectors for the element orientation Vector x(3); x(0) = 1.0; x(1) = 0.0; x(2) = 0.0; Vector y(3); y(0) = 0.0; y(1) = 1.0; y(2) = 0.0; int argi = 6; int doRayleighDamping = 1; // finally check the command line to see if user specified orientation while (argi < argc) { if (strcmp(argv[argi],"-orient") == 0) { if (argc < (argi+7)) { opserr << "WARNING not enough parameters after -orient flag for ele " << eleTag << "- element zeroLengthSection eleTag? iNode? jNode? secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; double value; // read the x values for (int i=0; i<3; i++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[argi] << "- element zeroLengthSection eleTag? iNode? jNode secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; x(i) = value; } } // read the y values for (int j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[argi] << "- element zeroLengthSection eleTag? iNode? jNode? secTag? " << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; y(j) = value; } } } } else if (strcmp(argv[argi],"-doRayleigh") == 0) { doRayleighDamping = 1; argi++; if (argi < argc) if ((Tcl_GetInt(interp, argv[argi], &doRayleighDamping) == TCL_OK)) argi++; } else argi++; } // // now we create the element and add it to the domain // SectionForceDeformation *theSection = theBuilder->getSection(secTag); if (theSection == 0) { opserr << "zeroLengthSection -- no section with tag " << secTag << " exists in Domain\n"; return TCL_ERROR; } Element *theEle = new ZeroLengthSection(eleTag, ndm, iNode, jNode, x, y, *theSection, doRayleighDamping); if (theEle == 0) return TCL_ERROR; if (theDomain->addElement(theEle) == false) return TCL_ERROR; return TCL_OK; }
extern "C" void *vmd_mpi_parallel_for_scheduler(void *voidparms) { parallel_for_parms *parfor = (parallel_for_parms *) voidparms; // Run the for loop management code on node zero. // Do the work on all the other nodes... #if defined(VMDTHREADS) int i; wkf_tasktile_t curtile; while (wkf_shared_iterator_next_tile(&parfor->iter, 1, &curtile) != WKF_SCHED_DONE) { i = curtile.start; #else int i; for (i=parfor->loop.start; i<parfor->loop.end; i++) { #endif int reqnode; MPI_Status rcvstat; MPI_Recv(&reqnode, 1, MPI_INT, MPI_ANY_SOURCE, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD, &rcvstat); MPI_Send(&i, 1, MPI_INT, reqnode, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD); } // tell all nodes we're done with all of the work int node; for (node=1; node<parfor->numnodes; node++) { int reqnode; MPI_Status rcvstat; MPI_Recv(&reqnode, 1, MPI_INT, MPI_ANY_SOURCE, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD, &rcvstat); i=-1; // indicate that the for loop is completed MPI_Send(&i, 1, MPI_INT, reqnode, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD); } return NULL; } #endif int text_cmd_parallel(ClientData cd, Tcl_Interp *interp, int argc, const char *argv[]) { VMDApp *app = (VMDApp *)cd; if(argc<2) { Tcl_SetResult(interp, (char *) "Parallel job query commands:\n" " parallel nodename\n" " parallel noderank\n" " parallel nodecount\n" "Parallel collective operations (all nodes MUST participate):\n" " parallel allgather <object>\n" " parallel allreduce <tcl reduction proc> <object>\n" " parallel barrier\n" " parallel for <startcount> <endcount> <tcl callback proc> <user data>", TCL_STATIC); return TCL_ERROR; } // XXX hack to make Swift/T cooperate with VMD when using VMD's MPI // communicator if (!strcmp(argv[1], "swift_clone_communicator")) { swift_mpi_init(interp); return TCL_OK; } // return the MPI node name if (!strcmp(argv[1], "nodename")) { Tcl_Obj *tcl_result = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(app->par_name(), strlen(app->par_name()))); Tcl_SetObjResult(interp, tcl_result); return TCL_OK; } // return the MPI node rank if (!strcmp(argv[1], "noderank")) { Tcl_Obj *tcl_result = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewIntObj(app->par_rank())); Tcl_SetObjResult(interp, tcl_result); return TCL_OK; } // return the MPI node count if (!strcmp(argv[1], "nodecount")) { Tcl_Obj *tcl_result = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewIntObj(app->par_size())); Tcl_SetObjResult(interp, tcl_result); return TCL_OK; } // execute an MPI barrier if(!strupncmp(argv[1], "barrier", CMDLEN) && argc==2) { app->par_barrier(); return TCL_OK; } // Execute a parallel for loop across all nodes // // parallel for <startcount> <endcount> <callback proc> <user data>", // if(!strupncmp(argv[1], "for", CMDLEN)) { int isok = (argc == 6); int N = app->par_size(); int start, end; if (Tcl_GetInt(interp, argv[2], &start) != TCL_OK || Tcl_GetInt(interp, argv[3], &end) != TCL_OK) { isok = 0; } // // If there's only one node, short-circuit the parallel for // if (N == 1) { if (!isok) { Tcl_SetResult(interp, (char *) "invalid parallel for, missing parameter", TCL_STATIC); return TCL_ERROR; } // run for loop on one node... int i; for (i=start; i<=end; i++) { char istr[128]; sprintf(istr, "%d", i); if (Tcl_VarEval(interp, argv[4], " ", istr, " {", argv[5], "} ", NULL) != TCL_OK) { Tcl_SetResult(interp, (char *) "error occured during parallel for", TCL_STATIC); } } return TCL_OK; } #if defined(VMDMPI) int allok = 0; // Check all node result codes before we continue with the reduction MPI_Allreduce(&isok, &allok, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); // XXX we may want to verify that all nodes are going to call the same // reduction proc here before continuing further. if (!allok) { Tcl_SetResult(interp, (char *) "invalid parallel for, missing parameter on one or more nodes", TCL_STATIC); return TCL_ERROR; } // Run the for loop management code on node zero. // Do the work on all the other nodes... int i; if (app->par_rank() == 0) { // use multithreaded code path parallel_for_parms parfor; memset(&parfor, 0, sizeof(parfor)); parfor.numnodes = N; parfor.loop.start=start; parfor.loop.end=end+1; wkf_shared_iterator_init(&parfor.iter); wkf_shared_iterator_set(&parfor.iter, &parfor.loop); #if defined(VMDTHREADS) // run the MPI scheduler in a new child thread wkf_thread_t pft; wkf_thread_create(&pft, vmd_mpi_parallel_for_scheduler, &parfor); // run the Tcl in the main thread wkf_tasktile_t curtile; while (wkf_shared_iterator_next_tile(&parfor.iter, 1, &curtile) != WKF_SCHED_DONE) { i = curtile.start; char istr[128]; sprintf(istr, "%d", i); if (Tcl_VarEval(interp, argv[4], " ", istr, " {", argv[5], "} ", NULL) != TCL_OK) { Tcl_SetResult(interp, (char *) "error occured during parallel for", TCL_STATIC); } } // join up with the MPI scheduler thread wkf_thread_join(pft, NULL); #else // if no threads, node zero only runs the scheduler and doesn't do work vmd_mpi_parallel_for_scheduler(&parfor); #endif wkf_shared_iterator_destroy(&parfor.iter); } else { char istr[128]; int done=0; int mynode=app->par_rank(); while (!done) { MPI_Send(&mynode, 1, MPI_INT, 0, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD); MPI_Status rcvstat; MPI_Recv(&i, 1, MPI_INT, MPI_ANY_SOURCE, VMD_MPI_TAG_FOR_REQUEST, MPI_COMM_WORLD, &rcvstat); if (i == -1) { done = 1; } else { sprintf(istr, "%d", i); if (Tcl_VarEval(interp, argv[4], " ", istr, " {", argv[5], "} ", NULL) != TCL_OK) { Tcl_SetResult(interp, (char *) "error occured during parallel for", TCL_STATIC); } } } } #endif return TCL_OK; } // Execute an allgather producing a Tcl list of the per-node contributions // // parallel allgather <object> // if(!strupncmp(argv[1], "allgather", CMDLEN)) { int isok = (argc == 3); #if defined(VMDMPI) int allok = 0; int i; // Check all node result codes before we continue with the gather MPI_Allreduce(&isok, &allok, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); if (!allok) { Tcl_SetResult(interp, (char *) "invalid parallel gather, missing parameter on one or more nodes", TCL_STATIC); return TCL_ERROR; } // Collect parameter size data so we can allocate result buffers // before executing the gather int *szlist = new int[app->par_size()]; szlist[app->par_rank()] = strlen(argv[2])+1; #if defined(USE_MPI_IN_PLACE) // MPI >= 2.x implementations (e.g. NCSA/Cray Blue Waters) MPI_Allgather(MPI_IN_PLACE, 1, MPI_INT, &szlist[0], 1, MPI_INT, MPI_COMM_WORLD); #else // MPI 1.x MPI_Allgather(&szlist[app->par_rank()], 1, MPI_INT, &szlist[0], 1, MPI_INT, MPI_COMM_WORLD); #endif int totalsz = 0; int *displist = new int[app->par_size()]; for (i=0; i<app->par_size(); i++) { displist[i]=totalsz; totalsz+=szlist[i]; } char *recvbuf = new char[totalsz]; memset(recvbuf, 0, totalsz); // Copy this node's data into the correct array position strcpy(&recvbuf[displist[app->par_rank()]], argv[2]); // Perform the parallel gather #if defined(USE_MPI_IN_PLACE) // MPI >= 2.x implementations (e.g. NCSA/Cray Blue Waters) MPI_Allgatherv(MPI_IN_PLACE, szlist[app->par_rank()], MPI_BYTE, &recvbuf[0], szlist, displist, MPI_BYTE, MPI_COMM_WORLD); #else // MPI 1.x MPI_Allgatherv(&recvbuf[displist[app->par_rank()]], szlist[app->par_rank()], MPI_BYTE, &recvbuf[0], szlist, displist, MPI_BYTE, MPI_COMM_WORLD); #endif // Build Tcl result from the array of results Tcl_Obj *tcl_result = Tcl_NewListObj(0, NULL); for (i=0; i<app->par_size(); i++) { Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(&recvbuf[displist[i]], szlist[i]-1)); } Tcl_SetObjResult(interp, tcl_result); delete [] recvbuf; delete [] displist; delete [] szlist; return TCL_OK; #else if (!isok) { Tcl_SetResult(interp, (char *) "invalid parallel gather, missing parameter on one or more nodes", TCL_STATIC); return TCL_ERROR; } Tcl_Obj *tcl_result = Tcl_NewListObj(0, NULL); Tcl_ListObjAppendElement(interp, tcl_result, Tcl_NewStringObj(argv[2], strlen(argv[2]))); Tcl_SetObjResult(interp, tcl_result); return TCL_OK; #endif } // // Execute an All-Reduce across all of the nodes. // The user must provide a Tcl proc that performs the appropriate reduction // operation for a pair of data items, resulting in a single item. // Since the user may pass floating point data or perform reductions // that give very slightly different answers depending on the order of // operations, the architecture or the host, or whether reductions on // a given host are occuring on the CPU or on a heterogeneous accelerator // or GPU of some kind, we must ensure that all nodes get a bit-identical // result. When heterogeneous accelerators are involved, we can really // only guarantee this by implementing the All-Reduce with a // Reduce-then-Broadcast approach, where the reduction collapses the // result down to node zero, which then does a broadcast to all peers. // // parallel allreduce <tcl reduction proc> <object> // if(!strupncmp(argv[1], "allreduce", CMDLEN)) { int isok = (argc == 4); int N = app->par_size(); // // If there's only one node, short-circuit the full parallel reduction // if (N == 1) { if (!isok) { Tcl_SetResult(interp, (char *) "invalid parallel reduction, missing parameter", TCL_STATIC); return TCL_ERROR; } // return our result, no other reduction is necessary Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], strlen(argv[3]))); return TCL_OK; } #if 1 && defined(VMDMPI) // // All-Reduce implementation based on a ring reduction followed by a // broadcast from node zero. This implementation gaurantees strict // ordering and will properly handle the case where one or more nodes // perform their reduction with slightly differing floating point // rounding than others (e.g. using GPUs, heterogeneous nodes, etc), // and it works with any number of nodes. While NOT latency-optimal, // this implementation is close to bandwidth-optimal which is helpful // for workstation clusters on non-switched networks or networks with // switches that cannot operate in a fully non-blocking manner. // int allok = 0; // Check all node result codes before we continue with the reduction MPI_Allreduce(&isok, &allok, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); // XXX we may want to verify that all nodes are going to call the same // reduction proc here before continuing further. if (!allok) { Tcl_SetResult(interp, (char *) "invalid parallel reduction, missing parameter on one or more nodes", TCL_STATIC); return TCL_ERROR; } // copy incoming data into initial "result" object Tcl_Obj *resultobj = Tcl_NewStringObj((const char *) argv[3], strlen(argv[3])+1); // A ring-based all-reduce implementation which should be // close to bandwidth-optimal, at the cost of additional latency. int src=app->par_rank(); // src node is this node int Ldest = (N + src + 1) % N; // compute left peer int Rdest = (N + src - 1) % N; // compute right peer MPI_Status status; if (src != 0) { int recvsz = 0; // Post blocking receive for data size MPI_Recv(&recvsz, 1, MPI_INT, Ldest, VMD_MPI_TAG_ALLREDUCE_ARGLENGTH, MPI_COMM_WORLD, &status); // Allocate or resize receive buffer char * recvbuf = (char *) malloc(recvsz); // Post non-blocking receive for data MPI_Recv(recvbuf, recvsz, MPI_BYTE, Ldest, VMD_MPI_TAG_ALLREDUCE_PAYLOAD, MPI_COMM_WORLD, &status); // Perform reduction // Perform the reduction operation on our existing and incoming data. // We build a Tcl command string with the user-defined proc, this // node's previous resultand, and the incoming data, and evaluate it. if (Tcl_VarEval(interp, argv[2], " ", Tcl_GetString(resultobj), " ", recvbuf, NULL) != TCL_OK) { printf("Error occured during reduction!\n"); } // Prep for next reduction step. Set result object to result of // the latest communication/reduction phase. resultobj = Tcl_GetObjResult(interp); // Free the receive buffer free(recvbuf); } // // All nodes // char *sendbuf = Tcl_GetString(resultobj); int sendsz = strlen(sendbuf)+1; // Post blocking send for data size MPI_Send(&sendsz, 1, MPI_INT, Rdest, VMD_MPI_TAG_ALLREDUCE_ARGLENGTH, MPI_COMM_WORLD); // Post blocking send for data MPI_Send(sendbuf, sendsz, MPI_BYTE, Rdest, VMD_MPI_TAG_ALLREDUCE_PAYLOAD, MPI_COMM_WORLD); if (src == 0) { int recvsz = 0; // Post blocking receive for data size MPI_Recv(&recvsz, 1, MPI_INT, Ldest, VMD_MPI_TAG_ALLREDUCE_ARGLENGTH, MPI_COMM_WORLD, &status); // Allocate or resize receive buffer char * recvbuf = (char *) malloc(recvsz); // Post non-blocking receive for data MPI_Recv(recvbuf, recvsz, MPI_BYTE, Ldest, VMD_MPI_TAG_ALLREDUCE_PAYLOAD, MPI_COMM_WORLD, &status); // Perform reduction // Perform the reduction operation on our existing and incoming data. // We build a Tcl command string with the user-defined proc, this // node's previous result and the incoming data, and evaluate it. if (Tcl_VarEval(interp, argv[2], " ", Tcl_GetString(resultobj), " ", recvbuf, NULL) != TCL_OK) { printf("Error occured during reduction!\n"); } // Prep for next reduction step. Set result object to result of // the latest communication/reduction phase. resultobj = Tcl_GetObjResult(interp); // Free the receive buffer free(recvbuf); } // // Broadcast final result from root to peers // if (src == 0) { // update send buffer for root node before broadcast sendbuf = Tcl_GetString(resultobj); sendsz = strlen(sendbuf)+1; MPI_Bcast(&sendsz, 1, MPI_INT, 0, MPI_COMM_WORLD); MPI_Bcast(sendbuf, sendsz, MPI_BYTE, 0, MPI_COMM_WORLD); } else { int recvsz = 0; MPI_Bcast(&recvsz, 1, MPI_INT, 0, MPI_COMM_WORLD); // Allocate or resize receive buffer char * recvbuf = (char *) malloc(recvsz); MPI_Bcast(recvbuf, recvsz, MPI_BYTE, 0, MPI_COMM_WORLD); // Set the final Tcl result if necessary Tcl_SetObjResult(interp, Tcl_NewStringObj(recvbuf, recvsz-1)); // Free the receive buffer free(recvbuf); } return TCL_OK; #elif defined(VMDMPI) // // Power-of-two-only hypercube/butterfly/recursive doubling // All-Reduce implementation. This implementation can't be used // in the case that we have either a non-power-of-two node count or // in the case where we have heterogeneous processing units that may // yield different floating point rounding. For now we leave this // implementation in the code for performance comparisons until we work // out the changes necessary to make it closer to bandwidth-optimal, // heterogeneous-safe, and non-power-of-two capable. // int allok = 0; int i; // Check all node result codes before we continue with the reduction MPI_Allreduce(&isok, &allok, 1, MPI_INT, MPI_LAND, MPI_COMM_WORLD); // XXX we may want to verify that all nodes are going to call the same // reduction proc here before continuing further. if (!allok) { Tcl_SetResult(interp, (char *) "invalid parallel reduction, missing parameter on one or more nodes", TCL_STATIC); return TCL_ERROR; } // Calculate number of reduction phases required int log2N; for (log2N=0; N>1; N>>=1) { log2N++; // XXX bail out of we don't have a power-of-two node count, // at least until we implement 3-2 reduction phases if ((N & 1) && (N > 1)) { Tcl_SetResult(interp, (char *) "parallel allreduce only allowed for even power-of-two node count", TCL_STATIC); return TCL_ERROR; } } N = app->par_size(); // copy incoming data into initial "result" object Tcl_Obj *resultobj = Tcl_NewStringObj((const char *) argv[3], strlen(argv[3])+1); // An all-reduce tree with hypercube connectivity with // log2(N) communication/reduction phases. At each phase, we compute // the peer/destination node we will communicate with using an XOR of // our node ID with the current hypercube dimension. If we have an // incomplete hypercube topology (e.g. non-power-of-two node count), // we have to do special 3-2 communication rounds (not implemented yet). // The current implementation requires that all existing nodes // participate, and that they contribute a valid data item. // If we wish to support reductions where a node may not contribute, // we would need to handle that similarly to a peer node that doesn't // exist, but we would likely determine this during the parameter length // exchange step. int src=app->par_rank(); // src node is this node for (i=0; i<log2N; i++) { int mask = 1 << i; // generate bitmask to use in the XOR int dest = src ^ mask; // XOR src node with bitmask to find dest node Tcl_Obj *oldresultobj = resultobj; // track old result // Check to make sure dest node exists for non-power-of-two // node counts (an incomplete hypercube). If not, skip to the next // communication/reduction phase. if (dest < N) { char *sendbuf = Tcl_GetString(oldresultobj); int sendsz = strlen(sendbuf)+1; int recvsz = 0; MPI_Request handle; MPI_Status status; // // Exchange required receive buffer size for data exchange with peer // // Post non-blocking receive for data size MPI_Irecv(&recvsz, 1, MPI_INT, dest, VMD_MPI_TAG_ALLREDUCE_ARGLENGTH, MPI_COMM_WORLD, &handle); // Post blocking send for data size MPI_Send(&sendsz, 1, MPI_INT, dest, VMD_MPI_TAG_ALLREDUCE_ARGLENGTH, MPI_COMM_WORLD); // Wait for non-blocking receive of data size to complete MPI_Wait(&handle, &status); // printf("src[%d], dest[%d], value '%s', recvsz: %d\n", src, dest, sendbuf, recvsz); // Allocate or resize receive buffer char * recvbuf = (char *) malloc(recvsz); // // Exchange the data payload // // Post non-blocking receive for data MPI_Irecv(recvbuf, recvsz, MPI_BYTE, dest, VMD_MPI_TAG_ALLREDUCE_PAYLOAD, MPI_COMM_WORLD, &handle); // Post blocking send for data MPI_Send(sendbuf, sendsz, MPI_BYTE, dest, VMD_MPI_TAG_ALLREDUCE_PAYLOAD, MPI_COMM_WORLD); // Wait for receive of data MPI_Wait(&handle, &status); // Perform the reduction operation on our existing and incoming data. // We build a Tcl command string with the user-defined proc, this // node's previous result and the incoming data, and evaluate it. if (Tcl_VarEval(interp, argv[2], " ", sendbuf, " ", recvbuf, NULL) != TCL_OK) { printf("Error occured during reduction!\n"); } // Free the receive buffer free(recvbuf); // Prep for next reduction step. Set result object to result of // the latest communication/reduction phase. resultobj = Tcl_GetObjResult(interp); } } // Set the final Tcl result if necessary Tcl_SetObjResult(interp, resultobj); return TCL_OK; #endif }
int TclModelBuilder_addZeroLengthContact2D(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { // need to write here. int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, SlaveNode, MasterNode, int eleTag, iNode, jNode; //opserr << argc; // a quick check on number of args if (argc < 11) { opserr << "ZeroLengthContact2D::WARNING too few arguments " << "want - element ZeroLengthContact2D eleTag? iNode? jNode? Kn? Kt? fs? -normal Nx? Ny?" ; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalied eleTag " << argv[2] << "\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalied iNode " << argv[3] << "\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalid jNode " << argv[4] << "\n" ; return TCL_ERROR; } double Kn, Kt, fs; // read the material properties if (Tcl_GetDouble(interp, argv[5], &Kn) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalid Kn " << argv[5] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[6], &Kt) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalid Kt " << argv[6] << "\n" ; return TCL_ERROR; } if (Tcl_GetDouble(interp, argv[7], &fs) != TCL_OK) { opserr << "ZeroLengthContact2D::WARNING invalid fs " << argv[7] << "\n" ; return TCL_ERROR; } ///// changed to specify any contact normal direction if (strcmp(argv[8],"-normal") != 0) { opserr << "ZeroLengthContact2D:: expecting "<< "- element ZeroLengthContact2D eleTag? iNode? jNode? Kn? Kt? fs? -normal Nx? Ny? \n" ; return TCL_ERROR; } Vector NormalDir(2); int argi=9; double value; // read the NormalDir values for (int i=0; i<2; i++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "ZeroLengthContact2D:: invalid -normal value for ele " << eleTag << "- element ZeroLengthContact2D eleTag? iNode? jNode? Kn? Kt? fs? -normal Nx? Ny? \n" ; return TCL_ERROR; } else { argi++; NormalDir(i) = value; } } // // now we create the element and add it to the domain // Element *theEle; theEle = new ZeroLengthContact2D(eleTag, iNode, jNode, Kn, Kt, fs, NormalDir); if (theEle == 0) { return TCL_ERROR; } if (theDomain->addElement(theEle) == false) { return TCL_ERROR; } // return the memory we stole and return OK return TCL_OK; }
int cross_services(ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ char **argv) /* Argument strings. */ { Tcl_CmdInfo infoPtr; ClientData wcdata; Tcl_CmdProc* wcmd; char *wname; char *command, *contents; int pargc, i, size; char *pline, *q; int result, ret = TCL_OK; wname = argv[1]; if (wname[0]) { if (!Tcl_GetCommandInfo(interp, wname, &infoPtr)) { Tcl_AppendResult(interp, "wrong # \"", wname, "\" does not exist", (char *) NULL); return TCL_ERROR; } wcdata = infoPtr.clientData; wcmd = (Tcl_CmdProc *)infoPtr.proc; } Tcl_ResetResult (interp); pargc = 2; command = argv[pargc++]; contents = argv[pargc++]; if (argc == 12 && *command == 'f' && strcmp (command, "filter") == 0) { char *refartStr, *testline, *shown_scopes, *ref_access; char *file = NULL; enum RefTypes refart; char **tfields, **lfields=NULL, **oldfields=NULL; char *tmpline; int tmpline_size = 512; int uniq, have, accept_static, accept_param, fsize, tsize; int AddRefArt=0; int length; char *line[line_arg_count], AddRefartStr[16] = {0}; Tcl_DString res, erg; refartStr = argv[pargc++]; testline = argv[pargc++]; uniq = atoi (argv[pargc++]); have = atoi (argv[pargc++]); accept_param = atoi (argv[pargc++]); accept_static= atoi (argv[pargc++]); shown_scopes = argv[pargc++]; ref_access = argv[pargc++]; if (accept_static) { /* Information to the actual scope */ if (Tcl_SplitList (interp, testline, &tsize, &tfields) != TCL_OK) { return TCL_ERROR; } file = tfields[file1_pos]; } if (strcmp (refartStr, "to") == 0) { refart = REF_TO; } else { refart = REF_BY; } /* init some variables */ for (i=0; i<line_arg_count; i++) { line[i] = ""; } Tcl_DStringInit(&res); Tcl_DStringInit(&erg); tmpline = (char*)ckalloc (tmpline_size); tmpline[0] = 0; for (length=strlen(contents), q = contents; 1;) { char *prevlist = q; result = TclFindElement(interp, q, length, &pline, &q, &size, NULL); if (result != TCL_OK || size == 0) { break; } length -= q - prevlist; if (size > tmpline_size) { tmpline_size += size; tmpline = ckrealloc (tmpline, tmpline_size); } memcpy (tmpline, pline, size); tmpline[size] = 0; if (Tcl_SplitList (interp, tmpline, &fsize, &lfields) != TCL_OK) { continue; } if (fsize != DB_COUNT) { ckfree ((char*)lfields); continue; } if (*shown_scopes && strstr (shown_scopes, lfields[DB_SCP2]) == NULL) { continue; } if (*ref_access && strstr (ref_access, lfields[DB_REFA]) == NULL) { continue; } if (uniq && oldfields) { if (strcmp (oldfields[DB_CLS2], lfields[DB_CLS2]) == 0 && strcmp (oldfields[DB_SYM2], lfields[DB_SYM2]) == 0 && strcmp (oldfields[DB_SCP2], lfields[DB_SCP2]) == 0 && (! accept_param || (accept_param && strcmp (oldfields[DB_PRM2], lfields[DB_PRM2]) == 0))) { if (!AddRefartStr[0] || (lfields[DB_REFA][0] && strchr (AddRefartStr, lfields[DB_REFA][0]) == NULL)) { strcat (AddRefartStr, lfields[DB_REFA]); } ckfree ((char *) lfields); continue; } } /* Static functions and variables */ if (accept_static && refart == REF_TO && lfields[DB_REFA][0] != 0 && ! cross_is_type_with_classes(lfields[DB_SCP2])) { int attr; if (Tcl_GetInt(interp, lfields[DB_REFA], &attr) == TCL_OK && (! (attr&PAF_STATIC) || strcmp (lfields[DB_FILE], file) != 0)) { ckfree ((char*)lfields); continue; } } if (have) { ckfree ((char *) lfields); Tcl_DStringAppendElement (&erg, "yes"); break; } if (AddRefArt) { Tcl_DStringAppendElement(&res, AddRefartStr); Tcl_DStringAppendElement(&erg, Tcl_DStringValue(&res)); } else { AddRefArt = 1; } strcpy (AddRefartStr, lfields[DB_REFA]); line[class1_pos] = lfields[DB_CLS2]; line[item1_pos] = lfields[DB_SYM2]; line[what1_pos] = lfields[DB_SCP2]; line[param1_pos] = lfields[DB_PRM2]; line[file_pos] = lfields[DB_FILE]; line[file_line_pos] = lfields[DB_LINE]; Tcl_DStringFree (&res); for (i=0; i<refart_pos; i++) { Tcl_DStringAppendElement (&res, line[i]); } /* Store last line */ if (oldfields) { ckfree ((char*)oldfields); } oldfields = lfields; } if (AddRefArt) { Tcl_DStringAppendElement(&res, AddRefartStr); Tcl_DStringAppendElement(&erg, Tcl_DStringValue(&res)); AddRefartStr[0] = 0; } Tcl_DStringFree (&res); if (accept_static) { ckfree ((char*)tfields); } if (oldfields) { ckfree ((char*)oldfields); } ckfree (tmpline); Tcl_DStringResult(interp, &erg); Tcl_DStringFree (&erg); } else if (argc == 7 && *command == 'i' && strcmp (command, "insert") == 0) { } else { char tmp[32]; sprintf (tmp, "%i", argc); Tcl_AppendResult(interp, "wrong # args(", tmp, "): should be \"", argv[0], " filter \"\" contents RefArt line unique have accept_param accept_static shown_scopes ref_access |\n" "insert widget contents RefArt id line\n", "\"", (char *) NULL); ret = TCL_ERROR; } return ret; }
int TclModelBuilder_addZeroLengthND(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain *theDomain, TclModelBuilder *theBuilder) { int ndm = theBuilder->getNDM(); // the spatial dimension of the problem // // first scan the command line to obtain eleID, iNode, jNode, material ID's // and their directions, and the orientation of ele xPrime and yPrime not // along the global x and y axis // int eleTag, iNode, jNode; // a quick check on number of args if (argc < 6) { opserr << "WARNING too few arguments %s %s %s\n" << "want - element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?>" << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the ele tag if (Tcl_GetInt(interp, argv[2], &eleTag) != TCL_OK) { opserr << "WARNING invalied eleTag " << argv[2] << " - element zeroLengthND eleTag? iNode? jNode? NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } // get the two end nodes if (Tcl_GetInt(interp, argv[3], &iNode) != TCL_OK) { opserr << "WARNING invalied iNode " << argv[3] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?>" << "<-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } if (Tcl_GetInt(interp, argv[4], &jNode) != TCL_OK) { opserr << "WARNING invalid jNode " << argv[4] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } int NDTag; if (Tcl_GetInt(interp, argv[5], &NDTag) != TCL_OK) { opserr << "WARNING invalid NDTag %s %s %s %s\n" << argv[5] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } UniaxialMaterial *the1DMat = 0; int argi = 6; if (argc > 6 && strcmp(argv[6],"-orient") != 0) { int uniTag; if (Tcl_GetInt(interp, argv[6], &uniTag) != TCL_OK) { opserr << "WARNING invalid NDTag " << argv[5] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } the1DMat = OPS_getUniaxialMaterial(uniTag); if (the1DMat == 0) opserr << "WARNING UniaxialMaterial " << uniTag << " not found in model, proceeding without\n"; argi = 7; } // create the vectors for the element orientation Vector x(3); x(0) = 1.0; x(1) = 0.0; x(2) = 0.0; Vector y(3); y(0) = 0.0; y(1) = 1.0; y(2) = 0.0; // finally check the command line to see if user specified orientation if (argi < argc) { if (strcmp(argv[argi],"-orient") == 0) { if (argc < (argi+7)) { opserr << "WARNING not enough parameters after -orient flag for ele " << eleTag << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; double value; // read the x values for (int i=0; i<3; i++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << argv[argi] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; x(i) = value; } } // read the y values for (int j=0; j<3; j++) { if (Tcl_GetDouble(interp, argv[argi], &value) != TCL_OK) { opserr << "WARNING invalid -orient value for ele " << eleTag << " " << argv[argi] << "- element zeroLengthND eleTag? iNode? jNode? " << "NDTag? <1DTag?> <-orient x1? x2? x3? y1? y2? y3?>\n"; return TCL_ERROR; } else { argi++; y(j) = value; } } } } } // // now we create the element and add it to the domain // NDMaterial *theNDMat = OPS_getNDMaterial(NDTag); if (theNDMat == 0) { opserr << "zeroLengthND -- no NDMaterial with tag " << NDTag << " exists in Domain\n"; return TCL_ERROR; } Element *theEle = 0; if (the1DMat == 0) theEle = new ZeroLengthND(eleTag, ndm, iNode, jNode, x, y, *theNDMat); else theEle = new ZeroLengthND(eleTag, ndm, iNode, jNode, x, y, *theNDMat, *the1DMat); if (theEle == 0) return TCL_ERROR; if (theDomain->addElement(theEle) == false) return TCL_ERROR; return TCL_OK; }
int class_browser_insert(ClientData clientData, Tcl_Interp *interp, /* Current interpreter. */ int argc, /* Number of arguments. */ Tcl_Obj *objv[]) /* Argument strings. */ { Tcl_CmdInfo infoPtr; char *textwid; register void*textPtr = NULL; char image [64]; char *protected_font, *public_font, *private_font, font[512]; int del; Tcl_CmdProc *text_wdgcmd; char *linebuf; int linebuf_pos, linebuf_size = 1024; char *data; int data_pos, data_size = 1024; int len; char *tag_name; char *imageptr; unsigned int attr; Tcl_Obj *objlist, *next; int objlistc, oi; int wargc; char *wargv[12]; int fld_cou; int j, fnd1, fnd2; char **flds; char *p, * base_classes_of, * sub_classes_of, * viewed_classes; char *browsed_class; int overridden; unsigned int filter, filter1; int flags_and; char **prev_flds=NULL, **actu_flds=NULL, **next_flds=NULL; if (argc < 13 || argc > 14) { Tcl_AppendResult(interp, "wrong # args: should be ", Tcl_GetString(objv[0]), " ?-delete? textwidget list base_class_tree" " sub_class_tree viewed_classes" " overridden filter " " protected_font private_font, public_font" " browsed_class, and/or" , NULL); return TCL_ERROR; } if (Tcl_GetString(objv[1])[0] == '-') { del = TRUE; argc--; objv++; } else del = FALSE; textwid = Tcl_GetString(objv[1]); /* tree pathname */ objlist = objv[2]; /* list of entries */ base_classes_of = Tcl_GetString(objv[3]); /* base classes filter */ sub_classes_of = Tcl_GetString(objv[4]); /* sub classes filter */ viewed_classes = Tcl_GetString(objv[5]); /* list of viewed classes */ overridden = atoi (Tcl_GetString(objv[6])); /* overridden flag */ filter = atoi (Tcl_GetString(objv[7])); /* member filter */ filter1 = filter&(~(PAF_OVERRIDE|PAF_OVERLOADED)); /* flags without group flags */ public_font = Tcl_GetString(objv[8]); /* font for public members */ protected_font = Tcl_GetString(objv[9]); /* font for protected members */ private_font = Tcl_GetString(objv[10]); /* font for private members */ browsed_class = Tcl_GetString(objv[11]); /* browsed class in the browser */ flags_and = atoi(Tcl_GetString(objv[12])); /* Flag if all flags must be seted */ if (!Tcl_GetCommandInfo(interp, textwid, &infoPtr)) { Tcl_AppendResult(interp, "unknown widget \"", textwid,"\"",NULL); return TCL_ERROR; } textPtr = (void*)infoPtr.clientData; text_wdgcmd = (Tcl_CmdProc *)infoPtr.proc; /* set widget state as normal */ wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "configure"; wargv[wargc++] = "-state"; wargv[wargc++] = "normal"; (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); /* delete old items */ if (del) { wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "delete"; wargv[wargc++] = "0"; wargv[wargc++] = "end"; (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); } if (Tcl_ListObjLength(interp, objlist, &objlistc) != TCL_OK) { return TCL_ERROR; } if (objlistc == 0) { return TCL_OK; } /* using of dynamic buffers */ linebuf = ckalloc (linebuf_size); data = ckalloc (data_size); /* options for inserting items */ wargc = 0; wargv[wargc++] = textwid; wargv[wargc++] = "insert"; wargv[wargc++] = "end"; wargv[wargc++] = "-image"; wargv[wargc++] = image; wargv[wargc++] = "-font"; wargv[wargc++] = font; wargv[wargc++] = "-data"; wargv[wargc ] = data; data_pos = wargc++; wargv[wargc++] = "-text"; wargv[wargc ] = linebuf; linebuf_pos = wargc++; for (j=0, oi=0; oi<=objlistc; j++, oi++) { /* line scanning is complicated, because at least two lines are * to be stored to compare for overloaded and overridden flags */ if (oi == objlistc) { if (j > 1) { if (prev_flds) { ckfree ((char *) prev_flds); } prev_flds = actu_flds; actu_flds = next_flds; next_flds = NULL; } if (actu_flds == NULL) { break; } } else { if (Tcl_ListObjIndex (interp, objlist, oi, &next) != TCL_OK) { continue; } if (Tcl_SplitList(interp, Tcl_GetString(next), &fld_cou, &flds) != TCL_OK) { continue; } if (fld_cou < LIST_CNT) { ckfree((char *)flds); continue; } if (actu_flds == NULL) { actu_flds = flds; continue; } if (next_flds == NULL) { next_flds = flds; } else { if (prev_flds) { ckfree ((char *) prev_flds); } prev_flds = actu_flds; actu_flds = next_flds; next_flds = flds; } } if (Tcl_GetInt(interp, actu_flds[ATTR_POS],(int *)&attr) != TCL_OK) { continue; } /* verify if the class is selected */ p = Tcl_GetVar2 (interp, viewed_classes, CLASS(actu_flds[CLASS_POS]), TCL_LIST_ELEMENT); if (p != NULL && atoi (p) == 0) /* class not selected */ { continue; } /* if filter enabled, view only selected member types */ if (filter1) { if (flags_and) { if ((filter1&attr)!=filter1) { continue; } } else { int cnt = 0; if ((filter1&PAF_STATIC )!=0 && (attr&PAF_STATIC )!=0) cnt++; if ((filter1&PAF_STRUCT_DEF)!=0 && (attr&PAF_STRUCT_DEF)!=0) cnt++; if ((filter1&PAF_INLINE )!=0 && (attr&PAF_INLINE )!=0) cnt++; if ((filter1&PAF_VIRTUAL )!=0 && (attr&PAF_VIRTUAL )!=0) cnt++; if ((filter1&PAF_PUREVIRTUAL)==PAF_PUREVIRTUAL && (attr&PAF_PUREVIRTUAL)==PAF_PUREVIRTUAL) cnt ++; if (cnt == 0) { continue; } } } /* verif if overloaded flag is enabled */ if (filter & PAF_OVERLOADED) { if ((prev_flds && strcmp (actu_flds[MEMBER_POS], prev_flds[MEMBER_POS]) == 0) || (next_flds && strcmp (actu_flds[MEMBER_POS], next_flds[MEMBER_POS]) == 0)) { } else { continue; } } /* we need this to build correct image name */ strcpy (image, "cls_br_"); imageptr = image+7; if (attr & PAF_PROTECTED) { *imageptr++ = 'p'; } if (attr & PAF_STATIC) { *imageptr++ = 's'; } if (attr & PAF_VIRTUAL) { *imageptr++ = 'v'; } /* verify if the member overides a member on the base method * or is being overridden by a sub class */ fnd1 = fnd2 = 0; /* override flag */ if (next_flds && strcmp (next_flds[MEMBER_POS], actu_flds[MEMBER_POS]) == 0 && strcmp (CLASS(next_flds[CLASS_POS]), CLASS(actu_flds[CLASS_POS])) != 0 && /* different classes */ strcmp (next_flds[PARAM_POS ], actu_flds[PARAM_POS ]) == 0) { *imageptr++ = OVERRIDE; fnd1 = 0; } /* overridden flag */ if (prev_flds && strcmp (prev_flds[MEMBER_POS], actu_flds[MEMBER_POS]) == 0 && strcmp (CLASS(prev_flds[CLASS_POS]), CLASS(actu_flds[CLASS_POS])) != 0 && /* different classes */ strcmp (prev_flds[PARAM_POS ], actu_flds[PARAM_POS ]) == 0) { *imageptr++ = OVERRIDDEN; fnd2 = 1; } /* if we don't view the overridden members * or when we view only override/overridden members */ if ((fnd2 && overridden == 0) || ((filter & PAF_OVERRIDE) && fnd1 == 0 && fnd2 == 0)) { continue; } /* A private member uses a special empty image */ if (attr & PAF_PRIVATE) { char * pstr = "private"; strcpy (imageptr, pstr); imageptr += strlen(pstr); } /* finish image name */ strcpy (imageptr, "_image"); /* make text */ tag_name= strchr(actu_flds[MEMBER_POS],'('); /* function */ if (tag_name && (strncmp(tag_name + 1,"md",2) == 0 || strncmp(tag_name + 1,"fr",2) == 0)) { if (tag_name[1] == 'f') /* Friend use the private tag. */ { attr &= ~(PAF_PUBLIC|PAF_PROTECTED); } /* using dynamic buffers */ len = strlen (actu_flds[MEMBER_POS]) + strlen (actu_flds[CLASS_POS]) + strlen (actu_flds[TYPE_POS]) + strlen (actu_flds[PARAM_POS]) + 6; if (len > linebuf_size) { linebuf_size += len; linebuf = ckrealloc (linebuf, linebuf_size); wargv[linebuf_pos] = linebuf; } sprintf(linebuf,"%s\t%s\t%s\t(%s)", actu_flds[MEMBER_POS], actu_flds[CLASS_POS], actu_flds[TYPE_POS], actu_flds[PARAM_POS]); } /* variable */ else { /* using dynamic buffers */ len = strlen (actu_flds[MEMBER_POS]) + strlen (actu_flds[CLASS_POS]) + strlen (actu_flds[TYPE_POS]) + 3; if (len > linebuf_size) { linebuf_size += len; linebuf = ckrealloc (linebuf, linebuf_size); wargv[linebuf_pos] = linebuf; } sprintf(linebuf,"%s\t%s\t%s", actu_flds[MEMBER_POS], actu_flds[CLASS_POS], actu_flds[TYPE_POS]); } /* using dynamic buffers */ len = strlen (actu_flds[FILENAME_POS]) + strlen (actu_flds[FILEPOS_POS]) + 2; if (len > data_size) { data_size += len; data = ckrealloc (data, data_size); wargv[data_pos] = data; } /* Add file name and position in the data section */ sprintf (data, "%s\t%s", actu_flds[FILENAME_POS], actu_flds[FILEPOS_POS]); if (attr & PAF_PUBLIC) strcpy (font, public_font); else if (attr & PAF_PROTECTED) strcpy (font, protected_font); else if (attr & PAF_PRIVATE) strcpy (font, private_font); /* * Add line to browser list */ (*text_wdgcmd)((ClientData)textPtr,interp,wargc,wargv); /* Insert ! */ } /* free dynamic buffers */ ckfree ((void*)linebuf); ckfree ((void*)data); if (prev_flds) ckfree ((void*)prev_flds); if (actu_flds) ckfree ((void*)actu_flds); if (next_flds) ckfree ((void*)next_flds); return TCL_OK; }
int tclcommand_setmd(ClientData data, Tcl_Interp *interp, int argc, char **argv) { union { int intbuf[MAX_DIMENSION]; double doublebuf[MAX_DIMENSION]; } databuf; char buffer[TCL_DOUBLE_SPACE + 5]; int i, j; int all = (argc == 1), writing = (argc >= 3); /* loop over all global variables. Has two purposes: either we write al variables or search for the one to write */ for (i = 0; fields[i].data != NULL; i++) { if (all || !strncmp(argv[1], fields[i].name, strlen(argv[1]))) { if (!all) { if ((int)strlen(argv[1]) < fields[i].min_length) { Tcl_AppendResult(interp, "Argument \"",argv[1],"\" not long ", (char *) NULL); Tcl_AppendResult(interp, "enough to identify a setmd variable!", (char *) NULL); return (TCL_ERROR); } if (writing) { /* set */ /* parse in data */ if (argc != 2 + fields[i].dimension) { sprintf(buffer, "%d", fields[i].dimension); Tcl_AppendResult(interp, "\"", argv[1], "\" has dimension ", buffer, (char *) NULL); sprintf(buffer, " not %d", argc - 2); Tcl_AppendResult(interp, buffer, (char *) NULL); return (TCL_ERROR); } /* get new value */ for (j = 0; j < fields[i].dimension; j++) { switch (fields[i].type) { case TYPE_INT: if (Tcl_GetInt(interp, argv[2 + j], databuf.intbuf + j) == TCL_ERROR) return (TCL_ERROR); break; case TYPE_BOOL: { int dta; if (Tcl_GetInt(interp, argv[2 + j], &dta)) return (TCL_ERROR); if (dta) { databuf.intbuf[0] |= (1L << j); } else { databuf.intbuf[0] &= ~(1L << j); } break; } case TYPE_DOUBLE: if (Tcl_GetDouble(interp, argv[2 + j], databuf.doublebuf + j)) return (TCL_ERROR); break; default: ; } } if (find_callback(i)(interp, databuf.intbuf) != TCL_OK) return gather_runtime_errors(interp, TCL_ERROR); /* fall through to write out the set value immediately again */ } } /* get */ if (all) { if (i != 0) Tcl_AppendResult(interp, " ", (char *)NULL); Tcl_AppendResult(interp, "{", fields[i].name, " ", (char *)NULL); } for (j = 0; j < fields[i].dimension; j++) { switch (fields[i].type) { case TYPE_INT: sprintf(buffer, "%d", ((int *)fields[i].data)[j]); break; case TYPE_BOOL: { if ((*(int *)fields[i].data) & (1L << j)) strcpy(buffer, "1"); else strcpy(buffer, "0"); break; } case TYPE_DOUBLE: Tcl_PrintDouble(interp, ((double *)fields[i].data)[j], buffer); break; default: ; } Tcl_AppendResult(interp, buffer, (char *) NULL); if (j < fields[i].dimension - 1) Tcl_AppendResult(interp, " ", (char *) NULL); } if (all) Tcl_AppendResult(interp, "}", (char *)NULL); /* wrote out one value, so skip rest */ if (!all) { if (writing) return gather_runtime_errors(interp, TCL_OK); else return (TCL_OK); } } } if (all) return TCL_OK; Tcl_AppendResult(interp, "unknown md variable \"", argv[1], "\"", (char *) NULL); return (TCL_ERROR); }
int TclModelBuilder_addGenericClient(ClientData clientData, Tcl_Interp *interp, int argc, TCL_Char **argv, Domain*theTclDomain, TclModelBuilder *theTclBuilder, int eleArgStart) { // ensure the destructor has not been called if (theTclBuilder == 0) { opserr << "WARNING builder has been destroyed - genericClient\n"; return TCL_ERROR; } // check the number of arguments is correct if ((argc-eleArgStart) < 8) { opserr << "WARNING insufficient arguments\n"; printCommand(argc, argv); opserr << "Want: element genericClient eleTag -node Ndi Ndj ... -dof dofNdi -dof dofNdj ... -server ipPort <ipAddr> <-ssl> <-udp> <-dataSize size> <-noRayleigh>\n"; return TCL_ERROR; } Element *theElement = 0; int ndm = theTclBuilder->getNDM(); // get the id and end nodes int tag, node, dof, ipPort, argi, i, j; int numNodes = 0, numDOFj = 0, numDOF = 0; char *ipAddr = 0; int ssl = 0, udp = 0; int dataSize = 256; int doRayleigh = 1; if (Tcl_GetInt(interp, argv[1+eleArgStart], &tag) != TCL_OK) { opserr << "WARNING invalid genericClient eleTag\n"; return TCL_ERROR; } // read the number of nodes if (strcmp(argv[2+eleArgStart], "-node") != 0) { opserr << "WARNING expecting -node flag\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } argi = 3+eleArgStart; i = argi; while (strcmp(argv[i], "-dof") != 0 && i < argc) { numNodes++; i++; } if (numNodes == 0) { opserr << "WARNING no nodes specified\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } // create the ID arrays to hold the nodes and dofs ID nodes(numNodes); ID *dofs = new ID [numNodes]; if (dofs == 0) { opserr << "WARNING out of memory\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } // fill in the nodes ID for (i=0; i<numNodes; i++) { if (Tcl_GetInt(interp, argv[argi], &node) != TCL_OK) { opserr << "WARNING invalid node\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } nodes(i) = node; argi++; } for (j=0; j<numNodes; j++) { // read the number of dofs per node j numDOFj = 0; if (strcmp(argv[argi], "-dof") != 0) { opserr << "WARNING expect -dof\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } argi++; i = argi; while (strcmp(argv[i], "-dof") != 0 && strcmp(argv[i], "-server") != 0 && strcmp(argv[i], "-doRayleigh") != 0 && strcmp(argv[i], "-noRayleigh") != 0 && i < argc) { numDOFj++; numDOF++; i++; } // fill in the dofs ID array ID dofsj(numDOFj); for (i=0; i<numDOFj; i++) { if (Tcl_GetInt(interp, argv[argi], &dof) != TCL_OK) { opserr << "WARNING invalid dof\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } dofsj(i) = dof-1; argi++; } dofs[j] = dofsj; } if (strcmp(argv[argi], "-server") == 0) { argi++; if (Tcl_GetInt(interp, argv[argi], &ipPort) != TCL_OK) { opserr << "WARNING invalid ipPort\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } argi++; if (argi < argc && strcmp(argv[argi], "-doRayleigh") != 0 && strcmp(argv[argi], "-noRayleigh") != 0 && strcmp(argv[argi], "-dataSize") != 0 && strcmp(argv[argi], "-ssl") != 0 && strcmp(argv[argi], "-udp") != 0) { ipAddr = new char [strlen(argv[argi])+1]; strcpy(ipAddr,argv[argi]); argi++; } else { ipAddr = new char [9+1]; strcpy(ipAddr,"127.0.0.1"); } for (i = argi; i < argc; i++) { if (strcmp(argv[i], "-ssl") == 0) { ssl = 1; udp = 0; } else if (strcmp(argv[i], "-udp") == 0) { udp = 1; ssl = 0; } else if (strcmp(argv[i], "-dataSize") == 0) { if (Tcl_GetInt(interp, argv[i+1], &dataSize) != TCL_OK) { opserr << "WARNING invalid dataSize\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } } } } else { opserr << "WARNING expecting -server string but got "; opserr << argv[argi] << endln; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } for (i = argi; i < argc; i++) { if (strcmp(argv[i], "-doRayleigh") == 0) { doRayleigh = 1; } else if (strcmp(argv[i], "-noRayleigh") == 0) { doRayleigh = 0; } } // now create the GenericClient theElement = new GenericClient(tag, nodes, dofs, ipPort, ipAddr, ssl, udp, dataSize, doRayleigh); // cleanup dynamic memory if (dofs != 0) delete [] dofs; if (theElement == 0) { opserr << "WARNING ran out of memory creating element\n"; opserr << "genericClient element: " << tag << endln; return TCL_ERROR; } // then add the GenericClient to the domain if (theTclDomain->addElement(theElement) == false) { opserr << "WARNING could not add element to the domain\n"; opserr << "genericClient element: " << tag << endln; delete theElement; return TCL_ERROR; } // if get here we have sucessfully created the genericClient and added it to the domain return TCL_OK; }