PetscErrorCode PetscViewerGetSubViewer_String(PetscViewer viewer,MPI_Comm comm,PetscViewer *sviewer) { PetscViewer_String *vstr = (PetscViewer_String*)viewer->data; PetscErrorCode ierr; PetscFunctionBegin; ierr = PetscViewerStringOpen(PETSC_COMM_SELF,vstr->head,vstr->maxlen-vstr->curlen,sviewer);CHKERRQ(ierr); PetscFunctionReturn(0); }
#include <petsc/private/fortranimpl.h> #include <petscviewer.h> #if defined(PETSC_HAVE_FORTRAN_CAPS) #define petscviewerstringopen_ PETSCVIEWERSTRINGOPEN #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE) #define petscviewerstringopen_ petscviewerstringopen #endif PETSC_EXTERN void PETSC_STDCALL petscviewerstringopen_(MPI_Comm *comm,CHAR name PETSC_MIXED_LEN(len1),PetscInt *len,PetscViewer *str, PetscErrorCode *ierr PETSC_END_LEN(len1)) { *ierr = PetscViewerStringOpen(MPI_Comm_f2c(*(MPI_Fint*)&*comm),name,*len,str); }
int main(int argc,char **argv) { PetscErrorCode ierr; PetscInt time_steps=100,iout,NOUT=1; PetscMPIInt size; Vec global; PetscReal dt,ftime,ftime_original; TS ts; PetscViewer viewfile; Mat J = 0; Vec x; Data data; PetscInt mn; PetscBool flg; MatColoring mc; ISColoring iscoloring; MatFDColoring matfdcoloring = 0; PetscBool fd_jacobian_coloring = PETSC_FALSE; SNES snes; KSP ksp; PC pc; PetscViewer viewer; char pcinfo[120],tsinfo[120]; TSType tstype; PetscBool sundials; ierr = PetscInitialize(&argc,&argv,(char*)0,help);CHKERRQ(ierr); ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);CHKERRQ(ierr); /* set data */ data.m = 9; data.n = 9; data.a = 1.0; data.epsilon = 0.1; data.dx = 1.0/(data.m+1.0); data.dy = 1.0/(data.n+1.0); mn = (data.m)*(data.n); ierr = PetscOptionsGetInt(NULL,"-time",&time_steps,NULL);CHKERRQ(ierr); /* set initial conditions */ ierr = VecCreate(PETSC_COMM_WORLD,&global);CHKERRQ(ierr); ierr = VecSetSizes(global,PETSC_DECIDE,mn);CHKERRQ(ierr); ierr = VecSetFromOptions(global);CHKERRQ(ierr); ierr = Initial(global,&data);CHKERRQ(ierr); ierr = VecDuplicate(global,&x);CHKERRQ(ierr); /* create timestep context */ ierr = TSCreate(PETSC_COMM_WORLD,&ts);CHKERRQ(ierr); ierr = TSMonitorSet(ts,Monitor,&data,NULL);CHKERRQ(ierr); #if defined(PETSC_HAVE_SUNDIALS) ierr = TSSetType(ts,TSSUNDIALS);CHKERRQ(ierr); #else ierr = TSSetType(ts,TSEULER);CHKERRQ(ierr); #endif dt = 0.1; ftime_original = data.tfinal = 1.0; ierr = TSSetInitialTimeStep(ts,0.0,dt);CHKERRQ(ierr); ierr = TSSetDuration(ts,time_steps,ftime_original);CHKERRQ(ierr); ierr = TSSetSolution(ts,global);CHKERRQ(ierr); /* set user provided RHSFunction and RHSJacobian */ ierr = TSSetRHSFunction(ts,NULL,RHSFunction,&data);CHKERRQ(ierr); ierr = MatCreate(PETSC_COMM_WORLD,&J);CHKERRQ(ierr); ierr = MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,mn,mn);CHKERRQ(ierr); ierr = MatSetFromOptions(J);CHKERRQ(ierr); ierr = MatSeqAIJSetPreallocation(J,5,NULL);CHKERRQ(ierr); ierr = MatMPIAIJSetPreallocation(J,5,NULL,5,NULL);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-ts_fd",&flg);CHKERRQ(ierr); if (!flg) { ierr = TSSetRHSJacobian(ts,J,J,RHSJacobian,&data);CHKERRQ(ierr); } else { ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-fd_color",&fd_jacobian_coloring);CHKERRQ(ierr); if (fd_jacobian_coloring) { /* Use finite differences with coloring */ /* Get data structure of J */ PetscBool pc_diagonal; ierr = PetscOptionsHasName(NULL,"-pc_diagonal",&pc_diagonal);CHKERRQ(ierr); if (pc_diagonal) { /* the preconditioner of J is a diagonal matrix */ PetscInt rstart,rend,i; PetscScalar zero=0.0; ierr = MatGetOwnershipRange(J,&rstart,&rend);CHKERRQ(ierr); for (i=rstart; i<rend; i++) { ierr = MatSetValues(J,1,&i,1,&i,&zero,INSERT_VALUES);CHKERRQ(ierr); } ierr = MatAssemblyBegin(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); ierr = MatAssemblyEnd(J,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); } else { /* Fill the structure using the expensive SNESComputeJacobianDefault. Temporarily set up the TS so we can call this function */ ierr = TSSetType(ts,TSBEULER);CHKERRQ(ierr); ierr = TSSetUp(ts);CHKERRQ(ierr); ierr = SNESComputeJacobianDefault(snes,x,J,J,ts);CHKERRQ(ierr); } /* create coloring context */ ierr = MatColoringCreate(J,&mc);CHKERRQ(ierr); ierr = MatColoringSetType(mc,MATCOLORINGSL);CHKERRQ(ierr); ierr = MatColoringSetFromOptions(mc);CHKERRQ(ierr); ierr = MatColoringApply(mc,&iscoloring);CHKERRQ(ierr); ierr = MatColoringDestroy(&mc);CHKERRQ(ierr); ierr = MatFDColoringCreate(J,iscoloring,&matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetFunction(matfdcoloring,(PetscErrorCode (*)(void))SNESTSFormFunction,ts);CHKERRQ(ierr); ierr = MatFDColoringSetFromOptions(matfdcoloring);CHKERRQ(ierr); ierr = MatFDColoringSetUp(J,iscoloring,matfdcoloring);CHKERRQ(ierr); ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefaultColor,matfdcoloring);CHKERRQ(ierr); ierr = ISColoringDestroy(&iscoloring);CHKERRQ(ierr); } else { /* Use finite differences (slow) */ ierr = SNESSetJacobian(snes,J,J,SNESComputeJacobianDefault,NULL);CHKERRQ(ierr); } } /* Pick up a Petsc preconditioner */ /* one can always set method or preconditioner during the run time */ ierr = TSGetSNES(ts,&snes);CHKERRQ(ierr); ierr = SNESGetKSP(snes,&ksp);CHKERRQ(ierr); ierr = KSPGetPC(ksp,&pc);CHKERRQ(ierr); ierr = PCSetType(pc,PCJACOBI);CHKERRQ(ierr); ierr = TSSetFromOptions(ts);CHKERRQ(ierr); ierr = TSSetUp(ts);CHKERRQ(ierr); /* Test TSSetPostStep() */ ierr = PetscOptionsHasName(NULL,"-test_PostStep",&flg);CHKERRQ(ierr); if (flg) { ierr = TSSetPostStep(ts,PostStep);CHKERRQ(ierr); } ierr = PetscOptionsGetInt(NULL,"-NOUT",&NOUT,NULL);CHKERRQ(ierr); for (iout=1; iout<=NOUT; iout++) { ierr = TSSetDuration(ts,time_steps,iout*ftime_original/NOUT);CHKERRQ(ierr); ierr = TSSolve(ts,global);CHKERRQ(ierr); ierr = TSGetSolveTime(ts,&ftime);CHKERRQ(ierr); ierr = TSSetInitialTimeStep(ts,ftime,dt);CHKERRQ(ierr); } /* Interpolate solution at tfinal */ ierr = TSGetSolution(ts,&global);CHKERRQ(ierr); ierr = TSInterpolate(ts,ftime_original,global);CHKERRQ(ierr); ierr = PetscOptionsHasName(NULL,"-matlab_view",&flg);CHKERRQ(ierr); if (flg) { /* print solution into a MATLAB file */ ierr = PetscViewerASCIIOpen(PETSC_COMM_WORLD,"out.m",&viewfile);CHKERRQ(ierr); ierr = PetscViewerSetFormat(viewfile,PETSC_VIEWER_ASCII_MATLAB);CHKERRQ(ierr); ierr = VecView(global,viewfile);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewfile);CHKERRQ(ierr); } /* display solver info for Sundials */ ierr = TSGetType(ts,&tstype);CHKERRQ(ierr); ierr = PetscObjectTypeCompare((PetscObject)ts,TSSUNDIALS,&sundials);CHKERRQ(ierr); if (sundials) { ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,tsinfo,120,&viewer);CHKERRQ(ierr); ierr = TSView(ts,viewer);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); ierr = PetscViewerStringOpen(PETSC_COMM_WORLD,pcinfo,120,&viewer);CHKERRQ(ierr); ierr = PCView(pc,viewer);CHKERRQ(ierr); ierr = PetscPrintf(PETSC_COMM_WORLD,"%d Procs,%s TSType, %s Preconditioner\n",size,tsinfo,pcinfo);CHKERRQ(ierr); ierr = PetscViewerDestroy(&viewer);CHKERRQ(ierr); } /* free the memories */ ierr = TSDestroy(&ts);CHKERRQ(ierr); ierr = VecDestroy(&global);CHKERRQ(ierr); ierr = VecDestroy(&x);CHKERRQ(ierr); ierr = MatDestroy(&J);CHKERRQ(ierr); if (fd_jacobian_coloring) {ierr = MatFDColoringDestroy(&matfdcoloring);CHKERRQ(ierr);} ierr = PetscFinalize(); return 0; }