int DA::createActiveMatrix(Mat &M, MatType mtype, unsigned int dof) { // first determine the size ... unsigned int sz = 0; if(m_bIamActive) { sz = dof*(m_uiNodeSize + m_uiBoundaryNodeSize); // now create the PETSc Mat PetscBool isAij, isAijSeq, isAijPrl, isSuperLU, isSuperLU_Dist; PetscStrcmp(mtype,MATAIJ,&isAij); PetscStrcmp(mtype,MATSEQAIJ,&isAijSeq); PetscStrcmp(mtype,MATMPIAIJ,&isAijPrl); isSuperLU = PETSC_FALSE; //PetscStrcmp(mtype,MATSUPERLU,&isSuperLU); isSuperLU_Dist = PETSC_FALSE; //PetscStrcmp(mtype,MATSUPERLU_DIST,&isSuperLU_Dist); MatCreate(m_mpiCommActive, &M); MatSetSizes(M, sz,sz, PETSC_DECIDE, PETSC_DECIDE); MatSetType(M,mtype); if(isAij || isAijSeq || isAijPrl || isSuperLU || isSuperLU_Dist) { if(m_iNpesActive > 1) { MatMPIAIJSetPreallocation(M, 53*dof , PETSC_NULL, 53*dof , PETSC_NULL); }else { MatSeqAIJSetPreallocation(M, 53*dof , PETSC_NULL); } } }//end if active return 0; }//end function
PetscErrorCode PetscRMTree(const char dir[]) { PetscErrorCode ierr; struct dirent *data; char loc[PETSC_MAX_PATH_LEN]; PetscBool flg1, flg2; DIR *dirp; struct stat statbuf; PetscFunctionBegin; dirp = opendir(dir); if(!dirp) { PetscBool flg; ierr = PetscTestDirectory(dir,'r',&flg);CHKERRQ(ierr); if (flg) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Cannot access directory to delete: %s",dir); ierr = PetscTestFile(dir,'r',&flg);CHKERRQ(ierr); if (flg) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Specified path is a file - not a dir: %s",dir); PetscFunctionReturn(0); /* perhaps the dir was not yet created */ } while((data = readdir(dirp))) { ierr = PetscStrcmp(data->d_name, ".",&flg1);CHKERRQ(ierr); ierr = PetscStrcmp(data->d_name, "..",&flg2);CHKERRQ(ierr); if (flg1 || flg2) continue; ierr = PetscPathJoin(dir,data->d_name,PETSC_MAX_PATH_LEN,loc);CHKERRQ(ierr); if (lstat(loc,&statbuf) <0) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"cannot run lstat() on: %s",loc); if (S_ISDIR(statbuf.st_mode)) { ierr = PetscRMTree(loc);CHKERRQ(ierr); } else { if (unlink(loc)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Could not delete file: %s",loc); } } closedir(dirp); if (rmdir(dir)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Could not delete dir: %s",dir); PetscFunctionReturn(0); }
PETSC_EXTERN PetscErrorCode TaoLMVMGetH0(Tao tao, Mat *H0) { TAO_LMVM *lmP; TAO_BLMVM *blmP; const TaoType type; PetscBool is_lmvm, is_blmvm; Mat M; PetscErrorCode ierr; ierr = TaoGetType(tao, &type);CHKERRQ(ierr); ierr = PetscStrcmp(type, TAOLMVM, &is_lmvm);CHKERRQ(ierr); ierr = PetscStrcmp(type, TAOBLMVM, &is_blmvm);CHKERRQ(ierr); if (is_lmvm) { lmP = (TAO_LMVM *)tao->data; M = lmP->M; } else if (is_blmvm) { blmP = (TAO_BLMVM *)tao->data; M = blmP->M; } else SETERRQ(PetscObjectComm((PetscObject)tao), PETSC_ERR_ARG_WRONGSTATE, "This routine applies to TAO_LMVM and TAO_BLMVM."); ierr = MatLMVMGetH0(M, H0);CHKERRQ(ierr); PetscFunctionReturn(0); }
/***************** Array Access ********************/ int DA::createMatrix(Mat &M, MatType mtype, unsigned int dof) { // first determine the size ... unsigned int sz = 0; if(m_bIamActive) { sz = dof*(m_uiNodeSize + m_uiBoundaryNodeSize); }//end if active // now create the PETSc Mat // The "parallel direct solver" matrix types like MATAIJSPOOLES are ALL gone in petsc-3.0.0 // Thus, I (Ilya Lashuk) "delete" all such checks for matrix type. Hope it is reasonable thing to do. PetscBool isAij, isAijSeq, isAijPrl, isSuperLU, isSuperLU_Dist; PetscStrcmp(mtype,MATAIJ,&isAij); PetscStrcmp(mtype,MATSEQAIJ,&isAijSeq); PetscStrcmp(mtype,MATMPIAIJ,&isAijPrl); isSuperLU = PETSC_FALSE; // PetscStrcmp(mtype,MATSUPERLU,&isSuperLU); isSuperLU_Dist = PETSC_FALSE; // PetscStrcmp(mtype,MATSUPERLU_DIST,&isSuperLU_Dist); MatCreate(m_mpiCommAll, &M); MatSetSizes(M, sz,sz, PETSC_DECIDE, PETSC_DECIDE); MatSetType(M,mtype); if(isAij || isAijSeq || isAijPrl || isSuperLU || isSuperLU_Dist) { if(m_iNpesAll > 1) { MatMPIAIJSetPreallocation(M, 53*dof , PETSC_NULL, 53*dof , PETSC_NULL); }else { MatSeqAIJSetPreallocation(M, 53*dof , PETSC_NULL); } } return 0; }//end function
int TaoLinearSolverPetsc::GetObjFcn(double *o_fcn) { const KSPType ktype; int info; PetscTruth flg; PetscFunctionBegin; info = KSPGetType(ksp, &ktype); CHKERRQ(info); info = PetscStrcmp((char *)ktype, KSPNASH, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPNASHGetObjFcn(ksp, o_fcn); CHKERRQ(info); } info = PetscStrcmp((char *)ktype, KSPSTCG, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPSTCGGetObjFcn(ksp, o_fcn); CHKERRQ(info); } info = PetscStrcmp((char *)ktype, KSPGLTR, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPGLTRGetObjFcn(ksp, o_fcn); CHKERRQ(info); } PetscFunctionReturn(0); }
static PetscErrorCode PetscImageListAdd(const char filename[],const char ext[],PetscInt count) { PetscErrorCode ierr; PetscImageList image,oimage = SAWs_images; PetscBool flg; PetscFunctionBegin; if (oimage) { ierr = PetscStrcmp(filename,oimage->filename,&flg);CHKERRQ(ierr); if (flg) { oimage->count = count; PetscFunctionReturn(0); } while (oimage->next) { oimage = oimage->next; ierr = PetscStrcmp(filename,oimage->filename,&flg);CHKERRQ(ierr); if (flg) { oimage->count = count; PetscFunctionReturn(0); } } ierr = PetscNew(&image);CHKERRQ(ierr); oimage->next = image; } else { ierr = PetscRegisterFinalize(PetscImageListDestroy);CHKERRQ(ierr); ierr = PetscNew(&image);CHKERRQ(ierr); SAWs_images = image; } ierr = PetscStrallocpy(filename,&image->filename);CHKERRQ(ierr); ierr = PetscStrallocpy(ext,&image->ext);CHKERRQ(ierr); image->count = count; PetscFunctionReturn(0); }
int TaoLinearSolverPetsc::SetTrustRadius(double rad) { const KSPType ktype; int info; PetscTruth flg; PetscFunctionBegin; info = KSPGetType(ksp, &ktype); CHKERRQ(info); info = PetscStrcmp((char *)ktype, KSPNASH, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPNASHSetRadius(ksp, rad); CHKERRQ(info); } info = PetscStrcmp((char *)ktype, KSPSTCG, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPSTCGSetRadius(ksp, rad); CHKERRQ(info); } info = PetscStrcmp((char *)ktype, KSPGLTR, &flg); CHKERRQ(info); if (flg == PETSC_TRUE) { info = KSPGLTRSetRadius(ksp, rad); CHKERRQ(info); } PetscFunctionReturn(0); }
/*@C PetscMallocDump - Dumps the allocated memory blocks to a file. The information printed is: size of space (in bytes), address of space, id of space, file in which space was allocated, and line number at which it was allocated. Collective on PETSC_COMM_WORLD Input Parameter: . fp - file pointer. If fp is NULL, stdout is assumed. Options Database Key: . -malloc_dump - Dumps unfreed memory during call to PetscFinalize() Level: intermediate Fortran Note: The calling sequence in Fortran is PetscMallocDump(integer ierr) The fp defaults to stdout. Notes: uses MPI_COMM_WORLD, because this may be called in PetscFinalize() after PETSC_COMM_WORLD has been freed. Concepts: memory usage Concepts: memory bleeding Concepts: bleeding memory .seealso: PetscMallocGetCurrentUsage(), PetscMallocDumpLog() @*/ PetscErrorCode PetscMallocDump(FILE *fp) { TRSPACE *head; PetscInt libAlloc = 0; PetscErrorCode ierr; PetscMPIInt rank; PetscFunctionBegin; ierr = MPI_Comm_rank(MPI_COMM_WORLD,&rank);CHKERRQ(ierr); if (!fp) fp = PETSC_STDOUT; head = TRhead; while (head) { PetscBool isLib; ierr = PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);CHKERRQ(ierr); libAlloc += head->size; head = head->next; } if (TRallocated - libAlloc > 0) fprintf(fp,"[%d]Total space allocated %.0f bytes\n",rank,(PetscLogDouble)TRallocated); head = TRhead; while (head) { PetscBool isLib; ierr = PetscStrcmp(head->functionname, "PetscDLLibraryOpen", &isLib);CHKERRQ(ierr); if (!isLib) { fprintf(fp,"[%2d]%.0f bytes %s() line %d in %s\n",rank,(PetscLogDouble)head->size,head->functionname,head->lineno,head->filename); #if defined(PETSC_USE_DEBUG) ierr = PetscStackPrint(&head->stack,fp);CHKERRQ(ierr); #endif } head = head->next; } PetscFunctionReturn(0); }
/*@C PetscFOpen - Has the first process in the communicator open a file; all others do nothing. Logically Collective on MPI_Comm Input Parameters: + comm - the communicator . name - the filename - mode - the mode for fopen(), usually "w" Output Parameter: . fp - the file pointer Level: developer Notes: NULL (0), "stderr" or "stdout" may be passed in as the filename Fortran Note: This routine is not supported in Fortran. Concepts: opening ASCII file Concepts: files^opening ASCII .seealso: PetscFClose(), PetscSynchronizedFGets(), PetscSynchronizedPrintf(), PetscSynchronizedFlush(), PetscFPrintf() @*/ PetscErrorCode PetscFOpen(MPI_Comm comm,const char name[],const char mode[],FILE **fp) { PetscErrorCode ierr; PetscMPIInt rank; FILE *fd; char fname[PETSC_MAX_PATH_LEN],tname[PETSC_MAX_PATH_LEN]; PetscFunctionBegin; ierr = MPI_Comm_rank(comm,&rank);CHKERRQ(ierr); if (!rank) { PetscBool isstdout,isstderr; ierr = PetscStrcmp(name,"stdout",&isstdout);CHKERRQ(ierr); ierr = PetscStrcmp(name,"stderr",&isstderr);CHKERRQ(ierr); if (isstdout || !name) fd = PETSC_STDOUT; else if (isstderr) fd = PETSC_STDERR; else { PetscBool devnull; ierr = PetscStrreplace(PETSC_COMM_SELF,name,tname,PETSC_MAX_PATH_LEN);CHKERRQ(ierr); ierr = PetscFixFilename(tname,fname);CHKERRQ(ierr); ierr = PetscStrbeginswith(fname,"/dev/null",&devnull);CHKERRQ(ierr); if (devnull) { ierr = PetscStrcpy(fname,"/dev/null");CHKERRQ(ierr); } ierr = PetscInfo1(0,"Opening file %s\n",fname);CHKERRQ(ierr); fd = fopen(fname,mode); if (!fd) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_OPEN,"Unable to open file %s\n",fname); } } else fd = 0; *fp = fd; PetscFunctionReturn(0); }
EXTERN_C_BEGIN #undef __FUNCT__ #define __FUNCT__ "SNESMSSetType_MS" PetscErrorCode SNESMSSetType_MS(SNES snes,SNESMSType mstype) { PetscErrorCode ierr; SNES_MS *ms = (SNES_MS*)snes->data; SNESMSTableauLink link; PetscBool match; PetscFunctionBegin; if (ms->tableau) { ierr = PetscStrcmp(ms->tableau->name,mstype,&match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); } for (link = SNESMSTableauList; link; link=link->next) { ierr = PetscStrcmp(link->tab.name,mstype,&match);CHKERRQ(ierr); if (match) { ierr = SNESReset_MS(snes);CHKERRQ(ierr); ms->tableau = &link->tab; PetscFunctionReturn(0); } } SETERRQ1(((PetscObject)snes)->comm,PETSC_ERR_ARG_UNKNOWN_TYPE,"Could not find '%s'",mstype); PetscFunctionReturn(0); }
/*@C DMPlexRemoveLabel - Remove the label from this mesh Not Collective Input Parameters: + dm - The DMPlex object - name - The label name Output Parameter: . label - The DMLabel, or NULL if the label is absent Level: developer .keywords: mesh .seealso: DMPlexCreateLabel(), DMPlexHasLabel(), DMPlexGetLabelValue(), DMPlexSetLabelValue(), DMPlexGetStratumIS() @*/ PetscErrorCode DMPlexRemoveLabel(DM dm, const char name[], DMLabel *label) { DM_Plex *mesh = (DM_Plex*) dm->data; PlexLabel next = mesh->labels; PlexLabel last = NULL; PetscBool hasLabel; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); ierr = DMPlexHasLabel(dm, name, &hasLabel);CHKERRQ(ierr); *label = NULL; if (!hasLabel) PetscFunctionReturn(0); while (next) { ierr = PetscStrcmp(name, next->label->name, &hasLabel);CHKERRQ(ierr); if (hasLabel) { if (last) last->next = next->next; else mesh->labels = next->next; next->next = NULL; *label = next->label; ierr = PetscFree(next);CHKERRQ(ierr); break; } last = next; next = next->next; } PetscFunctionReturn(0); }
/*@ MatAXPY - Computes Y = a*X + Y. Logically Collective on Mat Input Parameters: + a - the scalar multiplier . X - the first matrix . Y - the second matrix - str - either SAME_NONZERO_PATTERN, DIFFERENT_NONZERO_PATTERN or SUBSET_NONZERO_PATTERN (nonzeros of X is a subset of Y's) Level: intermediate .keywords: matrix, add .seealso: MatAYPX() @*/ PetscErrorCode MatAXPY(Mat Y,PetscScalar a,Mat X,MatStructure str) { PetscErrorCode ierr; PetscInt m1,m2,n1,n2; PetscBool sametype; PetscFunctionBegin; PetscValidHeaderSpecific(X,MAT_CLASSID,3); PetscValidHeaderSpecific(Y,MAT_CLASSID,1); PetscValidLogicalCollectiveScalar(Y,a,2); ierr = MatGetSize(X,&m1,&n1);CHKERRQ(ierr); ierr = MatGetSize(Y,&m2,&n2);CHKERRQ(ierr); if (m1 != m2 || n1 != n2) SETERRQ4(PETSC_COMM_SELF,PETSC_ERR_ARG_SIZ,"Non conforming matrix add: %D %D %D %D",m1,m2,n1,n2); ierr = PetscStrcmp(((PetscObject)X)->type_name,((PetscObject)Y)->type_name,&sametype);CHKERRQ(ierr); ierr = PetscLogEventBegin(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr); if (Y->ops->axpy && sametype) { ierr = (*Y->ops->axpy)(Y,a,X,str);CHKERRQ(ierr); } else { ierr = MatAXPY_Basic(Y,a,X,str);CHKERRQ(ierr); } ierr = PetscLogEventEnd(MAT_AXPY,Y,0,0,0);CHKERRQ(ierr); #if defined(PETSC_HAVE_VIENNACL) || defined(PETSC_HAVE_CUDA) if (Y->valid_GPU_matrix != PETSC_OFFLOAD_UNALLOCATED) { Y->valid_GPU_matrix = PETSC_OFFLOAD_CPU; } #endif PetscFunctionReturn(0); }
EXTERN_C_END #undef __FUNCT__ #define __FUNCT__ "PetscViewerSocketSetConnection" /*@C PetscViewerSocketSetConnection - Sets the machine and port that a PETSc socket viewer is to use Collective on PetscViewer Input Parameters: + v - viewer to connect . machine - host to connect to, use PETSC_NULL for the local machine,use "server" to passively wait for a connection from elsewhere - port - the port on the machine one is connecting to, use PETSC_DEFAULT for default Level: advanced .seealso: PetscViewerSocketOpen() @*/ PetscErrorCode PETSC_DLLEXPORT PetscViewerSocketSetConnection(PetscViewer v,const char machine[],PetscInt port) { PetscErrorCode ierr; PetscMPIInt rank; char mach[256]; PetscTruth tflg; PetscViewer_Socket *vmatlab = (PetscViewer_Socket *)v->data; PetscFunctionBegin; if (port <= 0) { char portn[16]; ierr = PetscOptionsGetenv(((PetscObject)v)->comm,"PETSC_VIEWER_SOCKET_PORT",portn,16,&tflg);CHKERRQ(ierr); if (tflg) { ierr = PetscOptionsAtoi(portn,&port);CHKERRQ(ierr); } else { port = PETSCSOCKETDEFAULTPORT; } } if (!machine) { ierr = PetscOptionsGetenv(((PetscObject)v)->comm,"PETSC_VIEWER_SOCKET_MACHINE",mach,256,&tflg);CHKERRQ(ierr); if (!tflg) { ierr = PetscGetHostName(mach,256);CHKERRQ(ierr); } } else { ierr = PetscStrncpy(mach,machine,256);CHKERRQ(ierr); } ierr = MPI_Comm_rank(((PetscObject)v)->comm,&rank);CHKERRQ(ierr); if (!rank) { ierr = PetscStrcmp(mach,"server",&tflg);CHKERRQ(ierr); if (tflg) { ierr = PetscInfo1(v,"Waiting for connection from socket process on port %D\n",port);CHKERRQ(ierr); ierr = SOCKAnswer_Private((int)port,&vmatlab->port);CHKERRQ(ierr); } else { ierr = PetscInfo2(v,"Connecting to socket process on port %D machine %s\n",port,mach);CHKERRQ(ierr); ierr = PetscOpenSocket(mach,(int)port,&vmatlab->port);CHKERRQ(ierr); } } PetscFunctionReturn(0); }
/*@C DMPlexCreateLabel - Create a label of the given name if it does not already exist Not Collective Input Parameters: + dm - The DMPlex object - name - The label name Level: intermediate .keywords: mesh .seealso: DMLabelCreate(), DMPlexHasLabel(), DMPlexGetLabelValue(), DMPlexSetLabelValue(), DMPlexGetStratumIS() @*/ PetscErrorCode DMPlexCreateLabel(DM dm, const char name[]) { DM_Plex *mesh = (DM_Plex*) dm->data; PlexLabel next = mesh->labels; PetscBool flg = PETSC_FALSE; PetscErrorCode ierr; PetscFunctionBegin; PetscValidHeaderSpecific(dm, DM_CLASSID, 1); PetscValidCharPointer(name, 2); while (next) { ierr = PetscStrcmp(name, next->label->name, &flg);CHKERRQ(ierr); if (flg) break; next = next->next; } if (!flg) { PlexLabel tmpLabel; ierr = PetscCalloc1(1, &tmpLabel);CHKERRQ(ierr); ierr = DMLabelCreate(name, &tmpLabel->label);CHKERRQ(ierr); tmpLabel->output = PETSC_TRUE; tmpLabel->next = mesh->labels; mesh->labels = tmpLabel; } PetscFunctionReturn(0); }
/*@C DMGetNamedLocalVector - get access to a named, persistent local vector Not Collective Input Arguments: + dm - DM to hold named vectors - name - unique name for Vec Output Arguments: . X - named Vec Level: developer Note: If a Vec with the given name does not exist, it is created. .seealso: DMGetNamedGlobalVector(),DMRestoreNamedLocalVector() @*/ PetscErrorCode DMGetNamedLocalVector(DM dm,const char *name,Vec *X) { PetscErrorCode ierr; DMNamedVecLink link; PetscFunctionBegin; PetscValidHeaderSpecific(dm,DM_CLASSID,1); PetscValidCharPointer(name,2); PetscValidPointer(X,3); for (link=dm->namedlocal; link; link=link->next) { PetscBool match; ierr = PetscStrcmp(name,link->name,&match);CHKERRQ(ierr); if (match) { if (link->status != DMVEC_STATUS_IN) SETERRQ1(PetscObjectComm((PetscObject)dm),PETSC_ERR_ARG_WRONGSTATE,"Vec name '%s' already checked out",name); goto found; } } /* Create the Vec */ ierr = PetscNew(&link);CHKERRQ(ierr); ierr = PetscStrallocpy(name,&link->name);CHKERRQ(ierr); ierr = DMCreateLocalVector(dm,&link->X);CHKERRQ(ierr); link->next = dm->namedlocal; dm->namedlocal = link; found: *X = link->X; link->status = DMVEC_STATUS_OUT; PetscFunctionReturn(0); }
PetscErrorCode PetscViewerHDF5OpenGroup(PetscViewer viewer, hid_t *fileId, hid_t *groupId) { hid_t file_id, group; const char *groupName = NULL; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscViewerHDF5GetFileId(viewer, &file_id);CHKERRQ(ierr); ierr = PetscViewerHDF5GetGroup(viewer, &groupName);CHKERRQ(ierr); /* Open group */ if (groupName) { PetscBool root; ierr = PetscStrcmp(groupName, "/", &root);CHKERRQ(ierr); if (!root && !H5Lexists(file_id, groupName, H5P_DEFAULT)) { #if (H5_VERS_MAJOR * 10000 + H5_VERS_MINOR * 100 + H5_VERS_RELEASE >= 10800) group = H5Gcreate2(file_id, groupName, 0, H5P_DEFAULT, H5P_DEFAULT); #else /* deprecated HDF5 1.6 API */ group = H5Gcreate(file_id, groupName, 0); #endif if (group < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Could not create group %s", groupName); ierr = H5Gclose(group);CHKERRQ(ierr); } #if (H5_VERS_MAJOR * 10000 + H5_VERS_MINOR * 100 + H5_VERS_RELEASE >= 10800) group = H5Gopen2(file_id, groupName, H5P_DEFAULT); #else group = H5Gopen(file_id, groupName); #endif if (group < 0) SETERRQ1(PETSC_COMM_SELF, PETSC_ERR_LIB, "Could not open group %s", groupName); } else group = file_id; *fileId = file_id; *groupId = group; PetscFunctionReturn(0); }
static PetscErrorCode DMCreateMatrix_Shell(DM dm,Mat *J) { PetscErrorCode ierr; DM_Shell *shell = (DM_Shell*)dm->data; Mat A; PetscFunctionBegin; PetscValidHeaderSpecific(dm,DM_CLASSID,1); PetscValidPointer(J,3); if (!shell->A) { if (shell->Xglobal) { PetscInt m,M; ierr = PetscInfo(dm,"Naively creating matrix using global vector distribution without preallocation\n"); CHKERRQ(ierr); ierr = VecGetSize(shell->Xglobal,&M); CHKERRQ(ierr); ierr = VecGetLocalSize(shell->Xglobal,&m); CHKERRQ(ierr); ierr = MatCreate(PetscObjectComm((PetscObject)dm),&shell->A); CHKERRQ(ierr); ierr = MatSetSizes(shell->A,m,m,M,M); CHKERRQ(ierr); ierr = MatSetType(shell->A,dm->mattype); CHKERRQ(ierr); ierr = MatSetUp(shell->A); CHKERRQ(ierr); } else SETERRQ(PetscObjectComm((PetscObject)dm),PETSC_ERR_USER,"Must call DMShellSetMatrix(), DMShellSetCreateMatrix(), or provide a vector"); } A = shell->A; /* the check below is tacky and incomplete */ if (dm->mattype) { PetscBool flg,aij,seqaij,mpiaij; ierr = PetscObjectTypeCompare((PetscObject)A,dm->mattype,&flg); CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATSEQAIJ,&seqaij); CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)A,MATMPIAIJ,&mpiaij); CHKERRQ(ierr); ierr = PetscStrcmp(dm->mattype,MATAIJ,&aij); CHKERRQ(ierr); if (!flg) { if (!(aij && (seqaij || mpiaij))) SETERRQ2(PetscObjectComm((PetscObject)dm),PETSC_ERR_ARG_NOTSAMETYPE,"Requested matrix of type %s, but only %s available",dm->mattype,((PetscObject)A)->type_name); } } if (((PetscObject)A)->refct < 2) { /* We have an exclusive reference so we can give it out */ ierr = PetscObjectReference((PetscObject)A); CHKERRQ(ierr); ierr = MatZeroEntries(A); CHKERRQ(ierr); *J = A; } else { /* Need to create a copy, could use MAT_SHARE_NONZERO_PATTERN in most cases */ ierr = MatDuplicate(A,MAT_DO_NOT_COPY_VALUES,J); CHKERRQ(ierr); ierr = MatZeroEntries(*J); CHKERRQ(ierr); } PetscFunctionReturn(0); }
/*@C PetscDrawSetType - Builds graphics object for a particular implementation Collective on PetscDraw Input Parameter: + draw - the graphics context - type - for example, PETSC_DRAW_X Options Database Command: . -draw_type <type> - Sets the type; use -help for a list of available methods (for instance, x) Level: intermediate Notes: See "petsc/include/petscdraw.h" for available methods (for instance, PETSC_DRAW_X) Concepts: drawing^X windows Concepts: X windows^graphics Concepts: drawing^Microsoft Windows .seealso: PetscDrawSetFromOptions(), PetscDrawCreate(), PetscDrawDestroy() @*/ PetscErrorCode PetscDrawSetType(PetscDraw draw,PetscDrawType type) { PetscErrorCode ierr,(*r)(PetscDraw); PetscBool match; PetscBool flg=PETSC_FALSE; PetscFunctionBegin; PetscValidHeaderSpecific(draw,PETSC_DRAW_CLASSID,1); PetscValidCharPointer(type,2); ierr = PetscObjectTypeCompare((PetscObject)draw,type,&match); CHKERRQ(ierr); if (match) PetscFunctionReturn(0); /* User requests no graphics */ ierr = PetscOptionsHasName(NULL,"-nox",&flg); CHKERRQ(ierr); /* This is not ideal, but it allows codes to continue to run if X graphics was requested but is not installed on this machine. Mostly this is for testing. */ #if !defined(PETSC_HAVE_X) if (!flg) { ierr = PetscStrcmp(type,PETSC_DRAW_X,&match); CHKERRQ(ierr); if (match) { PetscBool dontwarn = PETSC_TRUE; flg = PETSC_TRUE; ierr = PetscOptionsHasName(NULL,"-nox_warning",&dontwarn); CHKERRQ(ierr); if (!dontwarn) (*PetscErrorPrintf)("PETSc installed without X windows on this machine\nproceeding without graphics\n"); } } #endif if (flg) type = PETSC_DRAW_NULL; if (draw->data) { /* destroy the old private PetscDraw context */ ierr = (*draw->ops->destroy)(draw); CHKERRQ(ierr); draw->ops->destroy = NULL; draw->data = 0; } ierr = PetscFunctionListFind(PetscDrawList,type,&r); CHKERRQ(ierr); if (!r) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_UNKNOWN_TYPE,"Unknown PetscDraw type given: %s",type); ierr = PetscObjectChangeTypeName((PetscObject)draw,type); CHKERRQ(ierr); draw->data = 0; ierr = (*r)(draw); CHKERRQ(ierr); PetscFunctionReturn(0); }
/*@C PetscPushJSONValue - Puts a "key" : "value" pair onto a string Input Parameters: + buffer - the char array where the value will be put . key - the key value to be set . value - the value associated with the key - bufflen - the size of the buffer (currently ignored) Level: advanced Notes: Ignores lengths so can cause buffer overflow @*/ PetscErrorCode PetscPushJSONValue(char buff[],const char key[],const char value[],size_t bufflen) { PetscErrorCode ierr; size_t len; PetscBool special; PetscFunctionBegin; ierr = PetscStrcmp(value,"null",&special);CHKERRQ(ierr); if (!special) { ierr = PetscStrcmp(value,"true",&special);CHKERRQ(ierr); } if (!special) { ierr = PetscStrcmp(value,"false",&special);CHKERRQ(ierr); } if (!special) { PetscInt i; ierr = PetscStrlen(value,&len);CHKERRQ(ierr); special = PETSC_TRUE; for (i=0; i<(int)len; i++) { if (!isdigit(value[i])) { special = PETSC_FALSE; break; } } } ierr = PetscStrcat(buff,"\"");CHKERRQ(ierr); ierr = PetscStrcat(buff,key);CHKERRQ(ierr); ierr = PetscStrcat(buff,"\":");CHKERRQ(ierr); if (!special) { ierr = PetscStrcat(buff,"\"");CHKERRQ(ierr); } ierr = PetscStrcat(buff,value);CHKERRQ(ierr); if (!special) { ierr = PetscStrcat(buff,"\"");CHKERRQ(ierr); } PetscFunctionReturn(0); }
dErr dUnitsFindUnit(dUnits un,const char *name,dUnit *unit) { dErr err; dFunctionBegin; *unit = NULL; for (dInt i=0; i<un->nalloc; i++) { dBool flg; dUnit t = un->list[i]; err = PetscStrcmp(t->longname,name,&flg);dCHK(err); if (flg) {*unit = t; break;} } dFunctionReturn(0); }
PetscErrorCode PetscRMTree(const char dir[]) { PetscErrorCode ierr; struct _finddata_t data; char loc[PETSC_MAX_PATH_LEN]; PetscBool flg1, flg2; #if defined (PETSC_HAVE_STDINT_H) intptr_t handle; #else long handle; #endif PetscFunctionBegin; ierr = PetscPathJoin(dir,"*",PETSC_MAX_PATH_LEN,loc);CHKERRQ(ierr); handle = _findfirst(loc, &data); if(handle == -1) { PetscBool flg; ierr = PetscTestDirectory(loc,'r',&flg);CHKERRQ(ierr); if (flg) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Cannot access directory to delete: %s",dir); ierr = PetscTestFile(loc,'r',&flg);CHKERRQ(ierr); if (flg) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Specified path is a file - not a dir: %s",dir); PetscFunctionReturn(0); /* perhaps the dir was not yet created */ } while(_findnext(handle, &data) != -1) { ierr = PetscStrcmp(data.name, ".",&flg1);CHKERRQ(ierr); ierr = PetscStrcmp(data.name, "..",&flg2);CHKERRQ(ierr); if (flg1 || flg2) continue; ierr = PetscPathJoin(dir,data.name,PETSC_MAX_PATH_LEN,loc);CHKERRQ(ierr); if(data.attrib & _A_SUBDIR) { ierr = PetscRMTree(loc);CHKERRQ(ierr); } else{ if (remove(loc)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Could not delete file: %s",loc); } } _findclose(handle); if (_rmdir(dir)) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_FILE_UNEXPECTED,"Could not delete dir: %s",dir); PetscFunctionReturn(0); }
PetscErrorCode TSRKSetType_RK(TS ts,TSRKType rktype) { TS_RK *rk = (TS_RK*)ts->data; PetscErrorCode ierr; PetscBool match; RKTableauLink link; PetscFunctionBegin; if (rk->tableau) { ierr = PetscStrcmp(rk->tableau->name,rktype,&match);CHKERRQ(ierr); if (match) PetscFunctionReturn(0); } for (link = RKTableauList; link; link=link->next) { ierr = PetscStrcmp(link->tab.name,rktype,&match);CHKERRQ(ierr); if (match) { ierr = TSReset_RK(ts);CHKERRQ(ierr); rk->tableau = &link->tab; PetscFunctionReturn(0); } } SETERRQ1(PetscObjectComm((PetscObject)ts),PETSC_ERR_ARG_UNKNOWN_TYPE,"Could not find '%s'",rktype); PetscFunctionReturn(0); }
/*@C PetscFortranCallbackRegister - register a type+subtype callback Not Collective Input Arguments: + classid - ID of class on which to register callback - subtype - subtype string, or NULL for class ids Output Arguments: . id - callback id Level: developer .seealso: PetscFortranCallbackGetSizes() @*/ PetscErrorCode PetscFortranCallbackRegister(PetscClassId classid,const char *subtype,PetscFortranCallbackId *id) { PetscErrorCode ierr; FortranCallbackBase *base; FortranCallbackLink link; PetscFunctionBegin; *id = 0; if (classid < PETSC_SMALLEST_CLASSID || PETSC_LARGEST_CLASSID <= classid) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_CORRUPT,"ClassId %D corrupt",classid); if (classid >= _maxclassid) { PetscClassId newmax = PETSC_SMALLEST_CLASSID + 2*(PETSC_LARGEST_CLASSID-PETSC_SMALLEST_CLASSID); FortranCallbackBase *newbase; if (!_classbase) { ierr = PetscRegisterFinalize(PetscFortranCallbackFinalize);CHKERRQ(ierr); } ierr = PetscMalloc((newmax-PETSC_SMALLEST_CLASSID)*sizeof(_classbase[0]),&newbase);CHKERRQ(ierr); ierr = PetscMemzero(newbase,(newmax-PETSC_SMALLEST_CLASSID)*sizeof(_classbase[0]));CHKERRQ(ierr); ierr = PetscMemcpy(newbase,_classbase,(_maxclassid-PETSC_SMALLEST_CLASSID)*sizeof(_classbase[0]));CHKERRQ(ierr); ierr = PetscFree(_classbase);CHKERRQ(ierr); _classbase = newbase; _maxclassid = newmax; } base = &_classbase[classid-PETSC_SMALLEST_CLASSID]; if (!subtype) *id = PETSC_SMALLEST_FORTRAN_CALLBACK + base->basecount++; else { for (link=base->subtypes; link; link=link->next) { /* look for either both NULL or matching values (implies both non-NULL) */ PetscBool match; ierr = PetscStrcmp(subtype,link->type_name,&match);CHKERRQ(ierr); if (match) { /* base type or matching subtype */ goto found; } } /* Not found. Create node and prepend to class' subtype list */ ierr = PetscMalloc(sizeof(*link),&link);CHKERRQ(ierr); ierr = PetscStrallocpy(subtype,&link->type_name);CHKERRQ(ierr); link->max = PETSC_SMALLEST_FORTRAN_CALLBACK; link->next = base->subtypes; base->subtypes = link; found: *id = link->max++; base->maxsubtypecount = PetscMax(base->maxsubtypecount,link->max-PETSC_SMALLEST_FORTRAN_CALLBACK); } PetscFunctionReturn(0); }
/*MC PetscFunctionListAdd - Given a routine and a string id, saves that routine in the specified registry. Synopsis: #include <petscsys.h> PetscErrorCode PetscFunctionListAdd(PetscFunctionList *flist,const char name[],void (*fptr)(void)) Not Collective Input Parameters: + flist - pointer to function list object . name - string to identify routine - fptr - function pointer Notes: To remove a registered routine, pass in a NULL fptr. Users who wish to register new classes for use by a particular PETSc component (e.g., SNES) should generally call the registration routine for that particular component (e.g., SNESRegister()) instead of calling PetscFunctionListAdd() directly. Level: developer .seealso: PetscFunctionListDestroy(), SNESRegister(), KSPRegister(), PCRegister(), TSRegister(), PetscFunctionList, PetscObjectComposeFunction() M*/ PETSC_EXTERN PetscErrorCode PetscFunctionListAdd_Private(PetscFunctionList *fl,const char name[],void (*fnc)(void)) { PetscFunctionList entry,ne; PetscErrorCode ierr; PetscFunctionBegin; if (!*fl) { ierr = PetscNew(&entry);CHKERRQ(ierr); ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); entry->routine = fnc; entry->next = 0; *fl = entry; #if defined(PETSC_USE_DEBUG) /* add this new list to list of all lists */ if (!dlallhead) { dlallhead = *fl; (*fl)->next_list = 0; } else { ne = dlallhead; dlallhead = *fl; (*fl)->next_list = ne; } #endif } else { /* search list to see if it is already there */ ne = *fl; while (ne) { PetscBool founddup; ierr = PetscStrcmp(ne->name,name,&founddup);CHKERRQ(ierr); if (founddup) { /* found duplicate */ ne->routine = fnc; PetscFunctionReturn(0); } if (ne->next) ne = ne->next; else break; } /* create new entry and add to end of list */ ierr = PetscNew(&entry);CHKERRQ(ierr); ierr = PetscStrallocpy(name,&entry->name);CHKERRQ(ierr); entry->routine = fnc; entry->next = 0; ne->next = entry; } PetscFunctionReturn(0); }
/*@C PetscObjectTypeCompare - Determines whether a PETSc object is of a particular type. Not Collective Input Parameters: + obj - any PETSc object, for example a Vec, Mat or KSP. This must be cast with a (PetscObject), for example, PetscObjectTypeCompare((PetscObject)mat); - type_name - string containing a type name Output Parameter: . same - PETSC_TRUE if they are the same, else PETSC_FALSE Level: intermediate .seealso: VecGetType(), KSPGetType(), PCGetType(), SNESGetType() Concepts: comparing^object types Concepts: types^comparing Concepts: object type^comparpeing @*/ PetscErrorCode PetscObjectTypeCompare(PetscObject obj,const char type_name[],PetscBool *same) { PetscErrorCode ierr; PetscFunctionBegin; if (!obj) *same = PETSC_FALSE; else if (!type_name && !obj->type_name) *same = PETSC_TRUE; else if (!type_name || !obj->type_name) *same = PETSC_FALSE; else { PetscValidHeader(obj,1); PetscValidCharPointer(type_name,2); PetscValidPointer(same,3); ierr = PetscStrcmp((char*)(obj->type_name),type_name,same);CHKERRQ(ierr); } PetscFunctionReturn(0); }
/*@ MatSchurComplementGetAinvType - get the type of approximation for the inverse of the (0,0) block used in forming Sp in MatSchurComplementGetPmat() Not collective. Input Parameter: . S - matrix obtained with MatCreateSchurComplement() (or equivalent) and implementing the action of A11 - A10 ksp(A00,Ap00) A01 Output Parameter: . ainvtype - type of approximation used to form A00inv from A00 when assembling Sp = A11 - A10 A00inv A01: MAT_SCHUR_COMPLEMENT_AINV_DIAG or MAT_SCHUR_COMPLEMENT_AINV_LUMP Note: Since the real Schur complement is usually dense, providing a good approximation to newpmat usually requires application-specific information. The default for assembled matrices is to use the inverse of the diagonal of the (0,0) block A00 in place of A00^{-1}. This rarely produce a scalable algorithm. Optionally, A00 can be lumped before forming inv(diag(A00)). Level: advanced Concepts: matrices^submatrices .seealso: MatSchurComplementAinvType, MatCreateSchurComplement(), MatGetSchurComplement(), MatSchurComplementGetPmat(), MatSchurComplementSetAinvType() @*/ PetscErrorCode MatSchurComplementGetAinvType(Mat S,MatSchurComplementAinvType *ainvtype) { PetscErrorCode ierr; const char* t; PetscBool isschur; Mat_SchurComplement *schur; PetscFunctionBegin; PetscValidHeaderSpecific(S,MAT_CLASSID,1); ierr = PetscObjectGetType((PetscObject)S,&t);CHKERRQ(ierr); ierr = PetscStrcmp(t,MATSCHURCOMPLEMENT,&isschur);CHKERRQ(ierr); if (!isschur) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_WRONG,"Expected Mat of type MATSCHURCOMPLEMENT, got %s instead",t); schur = (Mat_SchurComplement*)S->data; if (ainvtype) *ainvtype = schur->ainvtype; PetscFunctionReturn(0); }
PetscErrorCode PCFactorSetMatOrderingType_Factor(PC pc,MatOrderingType ordering) { PC_Factor *dir = (PC_Factor*)pc->data; PetscErrorCode ierr; PetscBool flg; PetscFunctionBegin; if (!pc->setupcalled) { ierr = PetscFree(dir->ordering);CHKERRQ(ierr); ierr = PetscStrallocpy(ordering,(char**)&dir->ordering);CHKERRQ(ierr); } else { ierr = PetscStrcmp(dir->ordering,ordering,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Cannot change ordering after use"); } PetscFunctionReturn(0); }
PetscErrorCode DMSwarmDataFieldStringFindInList(const char name[],const PetscInt N,const DMSwarmDataField gfield[],PetscInt *index) { PetscInt i; PetscErrorCode ierr; PetscFunctionBegin; *index = -1; for (i = 0; i < N; ++i) { PetscBool flg; ierr = PetscStrcmp(name, gfield[i]->name, &flg);CHKERRQ(ierr); if (flg) { *index = i; PetscFunctionReturn(0); } } PetscFunctionReturn(0); }
/* string helpers */ PetscErrorCode DMSwarmDataFieldStringInList(const char name[],const PetscInt N,const DMSwarmDataField gfield[],PetscBool *val) { PetscInt i; PetscErrorCode ierr; PetscFunctionBegin; *val = PETSC_FALSE; for (i = 0; i < N; ++i) { PetscBool flg; ierr = PetscStrcmp(name, gfield[i]->name, &flg);CHKERRQ(ierr); if (flg) { *val = PETSC_TRUE; PetscFunctionReturn(0); } } PetscFunctionReturn(0); }
PetscErrorCode PCFactorSetMatSolverPackage_Factor(PC pc,const MatSolverPackage stype) { PetscErrorCode ierr; PC_Factor *lu = (PC_Factor*)pc->data; PetscFunctionBegin; if (lu->fact) { const MatSolverPackage ltype; PetscBool flg; ierr = MatFactorGetSolverPackage(lu->fact,<ype);CHKERRQ(ierr); ierr = PetscStrcmp(stype,ltype,&flg);CHKERRQ(ierr); if (!flg) SETERRQ(PetscObjectComm((PetscObject)pc),PETSC_ERR_ARG_WRONGSTATE,"Cannot change solver matrix package after PC has been setup or used"); } else { ierr = PetscFree(lu->solvertype);CHKERRQ(ierr); ierr = PetscStrallocpy(stype,&lu->solvertype);CHKERRQ(ierr); } PetscFunctionReturn(0); }