/***************************** Main Program ******************************/ int main(int argc, char *argv[]) { realtype abstol, reltol, t, tout; N_Vector u; UserData data; void *arkode_mem; int iout, flag; MPI_Comm comm; HYPRE_Int local_N, npes, my_pe; HYPRE_ParVector Upar; /* Declare HYPRE parallel vector */ HYPRE_IJVector Uij; /* Declare "IJ" interface to HYPRE vector */ u = NULL; data = NULL; arkode_mem = NULL; /* Set problem size neq */ /* neq = NVARS*MX*MY; */ /* Get processor number and total number of pe's */ MPI_Init(&argc, &argv); comm = MPI_COMM_WORLD; MPI_Comm_size(comm, &npes); MPI_Comm_rank(comm, &my_pe); if (npes != NPEX*NPEY) { if (my_pe == 0) fprintf(stderr, "\nMPI_ERROR(0): npes = %d is not equal to NPEX*NPEY = %d\n\n", npes,NPEX*NPEY); MPI_Finalize(); return(1); } /* Set local length */ local_N = NVARS*MXSUB*MYSUB; /* Allocate hypre vector */ HYPRE_IJVectorCreate(comm, my_pe*local_N, (my_pe + 1)*local_N - 1, &Uij); HYPRE_IJVectorSetObjectType(Uij, HYPRE_PARCSR); HYPRE_IJVectorInitialize(Uij); /* Allocate and load user data block; allocate preconditioner block */ data = (UserData) malloc(sizeof *data); if (check_flag((void *)data, "malloc", 2, my_pe)) MPI_Abort(comm, 1); InitUserData(my_pe, comm, data); /* Set initial values and allocate u */ SetInitialProfiles(Uij, data, local_N, my_pe*local_N); HYPRE_IJVectorAssemble(Uij); HYPRE_IJVectorGetObject(Uij, (void**) &Upar); u = N_VMake_ParHyp(Upar); /* Create wrapper u around hypre vector */ if (check_flag((void *)u, "N_VNew", 0, my_pe)) MPI_Abort(comm, 1); /* Set tolerances */ abstol = ATOL; reltol = RTOL; /* Call ARKodeCreate to create the solver memory */ arkode_mem = ARKodeCreate(); if (check_flag((void *)arkode_mem, "ARKodeCreate", 0, my_pe)) MPI_Abort(comm, 1); /* Set the pointer to user-defined data */ flag = ARKodeSetUserData(arkode_mem, data); if (check_flag(&flag, "ARKodeSetUserData", 1, my_pe)) MPI_Abort(comm, 1); /* Call ARKodeInit to initialize the integrator memory and specify the user's right hand side functions in u'=fe(t,u)+fi(t,u) [here fe is NULL], the inital time T0, and the initial dependent variable vector u. */ flag = ARKodeInit(arkode_mem, NULL, f, T0, u); if(check_flag(&flag, "ARKodeInit", 1, my_pe)) return(1); /* Call ARKodeSetMaxNumSteps to increase default */ flag = ARKodeSetMaxNumSteps(arkode_mem, 1000000); if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1, my_pe)) return(1); /* Call ARKodeSStolerances to specify the scalar relative tolerance and scalar absolute tolerances */ flag = ARKodeSStolerances(arkode_mem, reltol, abstol); if (check_flag(&flag, "ARKodeSStolerances", 1, my_pe)) return(1); /* Call ARKSpgmr to specify the linear solver ARKSPGMR with left preconditioning and the default Krylov dimension maxl */ flag = ARKSpgmr(arkode_mem, PREC_LEFT, 0); if (check_flag(&flag, "ARKSpgmr", 1, my_pe)) MPI_Abort(comm, 1); /* Set preconditioner setup and solve routines Precond and PSolve, and the pointer to the user-defined block data */ flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve); if (check_flag(&flag, "ARKSpilsSetPreconditioner", 1, my_pe)) MPI_Abort(comm, 1); if (my_pe == 0) printf("\n2-species diurnal advection-diffusion problem\n\n"); /* In loop over output points, call ARKode, print results, test for error */ for (iout=1, tout=TWOHR; iout<=NOUT; iout++, tout+=TWOHR) { flag = ARKode(arkode_mem, tout, u, &t, ARK_NORMAL); if (check_flag(&flag, "ARKode", 1, my_pe)) break; PrintOutput(arkode_mem, my_pe, comm, u, t); } /* Print final statistics */ if (my_pe == 0) PrintFinalStats(arkode_mem); /* Free memory */ N_VDestroy(u); /* Free hypre vector wrapper */ HYPRE_IJVectorDestroy(Uij); /* Free the underlying hypre vector */ FreeUserData(data); ARKodeFree(&arkode_mem); MPI_Finalize(); return(0); }
/*--------------------------------------------------------------- Initialization, Free, and Get Functions NOTE: The band linear solver assumes a serial implementation of the NVECTOR package. Therefore, ARKBandPrecInit will first test for a compatible N_Vector internal representation by checking that the function N_VGetArrayPointer exists. ---------------------------------------------------------------*/ int ARKBandPrecInit(void *arkode_mem, long int N, long int mu, long int ml) { ARKodeMem ark_mem; ARKSpilsMem arkspils_mem; ARKBandPrecData pdata; long int mup, mlp, storagemu; int flag; if (arkode_mem == NULL) { arkProcessError(NULL, ARKSPILS_MEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_NULL); return(ARKSPILS_MEM_NULL); } ark_mem = (ARKodeMem) arkode_mem; /* Test if one of the SPILS linear solvers has been attached */ if (ark_mem->ark_lmem == NULL) { arkProcessError(ark_mem, ARKSPILS_LMEM_NULL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_LMEM_NULL); return(ARKSPILS_LMEM_NULL); } arkspils_mem = (ARKSpilsMem) ark_mem->ark_lmem; /* Test if the NVECTOR package is compatible with the BAND preconditioner */ if(ark_mem->ark_tempv->ops->nvgetarraypointer == NULL) { arkProcessError(ark_mem, ARKSPILS_ILL_INPUT, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_BAD_NVECTOR); return(ARKSPILS_ILL_INPUT); } pdata = NULL; pdata = (ARKBandPrecData) malloc(sizeof *pdata); /* Allocate data memory */ if (pdata == NULL) { arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL); return(ARKSPILS_MEM_FAIL); } /* Load pointers and bandwidths into pdata block. */ pdata->arkode_mem = arkode_mem; pdata->N = N; pdata->mu = mup = SUNMIN(N-1, SUNMAX(0,mu)); pdata->ml = mlp = SUNMIN(N-1, SUNMAX(0,ml)); /* Initialize nfeBP counter */ pdata->nfeBP = 0; /* Allocate memory for saved banded Jacobian approximation. */ pdata->savedJ = NULL; pdata->savedJ = NewBandMat(N, mup, mlp, mup); if (pdata->savedJ == NULL) { free(pdata); pdata = NULL; arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL); return(ARKSPILS_MEM_FAIL); } /* Allocate memory for banded preconditioner. */ storagemu = SUNMIN(N-1, mup+mlp); pdata->savedP = NULL; pdata->savedP = NewBandMat(N, mup, mlp, storagemu); if (pdata->savedP == NULL) { DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL); return(ARKSPILS_MEM_FAIL); } /* Allocate memory for pivot array. */ pdata->lpivots = NULL; pdata->lpivots = NewLintArray(N); if (pdata->lpivots == NULL) { DestroyMat(pdata->savedP); DestroyMat(pdata->savedJ); free(pdata); pdata = NULL; arkProcessError(ark_mem, ARKSPILS_MEM_FAIL, "ARKBANDPRE", "ARKBandPrecInit", MSGBP_MEM_FAIL); return(ARKSPILS_MEM_FAIL); } /* make sure s_P_data is free from any previous allocations */ if (arkspils_mem->s_pfree != NULL) { arkspils_mem->s_pfree(ark_mem); } /* Point to the new P_data field in the SPILS memory */ arkspils_mem->s_P_data = pdata; /* Attach the pfree function */ arkspils_mem->s_pfree = ARKBandPrecFree; /* Attach preconditioner solve and setup functions */ flag = ARKSpilsSetPreconditioner(arkode_mem, ARKBandPrecSetup, ARKBandPrecSolve); return(flag); }
int main() { realtype abstol=ATOL, reltol=RTOL, t, tout; N_Vector c; WebData wdata; void *arkode_mem; booleantype firstrun; int jpre, gstype, flag; int ns, mxns, iout; c = NULL; wdata = NULL; arkode_mem = NULL; /* Initializations */ c = N_VNew_Serial(NEQ); if(check_flag((void *)c, "N_VNew_Serial", 0)) return(1); wdata = AllocUserData(); if(check_flag((void *)wdata, "AllocUserData", 2)) return(1); InitUserData(wdata); ns = wdata->ns; mxns = wdata->mxns; /* Print problem description */ PrintIntro(); /* Loop over jpre and gstype (four cases) */ for (jpre = PREC_LEFT; jpre <= PREC_RIGHT; jpre++) { for (gstype = MODIFIED_GS; gstype <= CLASSICAL_GS; gstype++) { /* Initialize c and print heading */ CInit(c, wdata); PrintHeader(jpre, gstype); /* Call ARKodeInit or ARKodeReInit, then ARKSpgmr to set up problem */ firstrun = (jpre == PREC_LEFT) && (gstype == MODIFIED_GS); if (firstrun) { arkode_mem = ARKodeCreate(); if(check_flag((void *)arkode_mem, "ARKodeCreate", 0)) return(1); wdata->arkode_mem = arkode_mem; flag = ARKodeSetUserData(arkode_mem, wdata); if(check_flag(&flag, "ARKodeSetUserData", 1)) return(1); flag = ARKodeInit(arkode_mem, NULL, f, T0, c); if(check_flag(&flag, "ARKodeInit", 1)) return(1); flag = ARKodeSStolerances(arkode_mem, reltol, abstol); if (check_flag(&flag, "ARKodeSStolerances", 1)) return(1); flag = ARKodeSetMaxNumSteps(arkode_mem, 1000); if (check_flag(&flag, "ARKodeSetMaxNumSteps", 1)) return(1); flag = ARKodeSetNonlinConvCoef(arkode_mem, 1.e-3); if (check_flag(&flag, "ARKodeSetNonlinConvCoef", 1)) return(1); flag = ARKSpgmr(arkode_mem, jpre, MAXL); if(check_flag(&flag, "ARKSpgmr", 1)) return(1); flag = ARKSpilsSetGSType(arkode_mem, gstype); if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1); flag = ARKSpilsSetEpsLin(arkode_mem, DELT); if(check_flag(&flag, "ARKSpilsSetEpsLin", 1)) return(1); flag = ARKSpilsSetPreconditioner(arkode_mem, Precond, PSolve); if(check_flag(&flag, "ARKSpilsSetPreconditioner", 1)) return(1); } else { flag = ARKodeReInit(arkode_mem, NULL, f, T0, c); if(check_flag(&flag, "ARKodeReInit", 1)) return(1); flag = ARKSpilsSetPrecType(arkode_mem, jpre); check_flag(&flag, "ARKSpilsSetPrecType", 1); flag = ARKSpilsSetGSType(arkode_mem, gstype); if(check_flag(&flag, "ARKSpilsSetGSType", 1)) return(1); } /* Print initial values */ if (firstrun) PrintAllSpecies(c, ns, mxns, T0); /* Loop over output points, call ARKode, print sample solution values. */ tout = T1; for (iout = 1; iout <= NOUT; iout++) { flag = ARKode(arkode_mem, tout, c, &t, ARK_NORMAL); PrintOutput(arkode_mem, t); if (firstrun && (iout % 3 == 0)) PrintAllSpecies(c, ns, mxns, t); if(check_flag(&flag, "ARKode", 1)) break; if (tout > RCONST(0.9)) tout += DTOUT; else tout *= TOUT_MULT; } /* Print final statistics, and loop for next case */ PrintFinalStats(arkode_mem); } } /* Free all memory */ ARKodeFree(&arkode_mem); N_VDestroy_Serial(c); FreeUserData(wdata); return(0); }