Ejemplo n.º 1
0
/*@
  MatSchurComplementComputeExplicitOperator - Compute the Schur complement matrix explicitly

  Collective on Mat

  Input Parameter:
. M - the matrix obtained with MatCreateSchurComplement()

  Output Parameter:
. S - the Schur complement matrix

  Note: This can be expensive, so it is mainly for testing

  Level: advanced

.seealso: MatCreateSchurComplement(), MatSchurComplementUpdate()
@*/
PetscErrorCode MatSchurComplementComputeExplicitOperator(Mat M, Mat *S)
{
  Mat            B, C, D;
  KSP            ksp;
  PC             pc;
  PetscBool      isLU, isILU;
  PetscReal      fill = 2.0;
  PetscErrorCode ierr;

  PetscFunctionBegin;
  ierr = MatSchurComplementGetSubMatrices(M, NULL, NULL, &B, &C, &D);CHKERRQ(ierr);
  ierr = MatSchurComplementGetKSP(M, &ksp);CHKERRQ(ierr);
  ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject) pc, PCLU, &isLU);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject) pc, PCILU, &isILU);CHKERRQ(ierr);
  if (isLU || isILU) {
    Mat       fact, Bd, AinvB, AinvBd;
    PetscReal eps = 1.0e-10;

    /* This can be sped up for banded LU */
    ierr = KSPSetUp(ksp);CHKERRQ(ierr);
    ierr = PCFactorGetMatrix(pc, &fact);CHKERRQ(ierr);
    ierr = MatConvert(B, MATDENSE, MAT_INITIAL_MATRIX, &Bd);CHKERRQ(ierr);
    ierr = MatDuplicate(Bd, MAT_DO_NOT_COPY_VALUES, &AinvBd);CHKERRQ(ierr);
    ierr = MatMatSolve(fact, Bd, AinvBd);CHKERRQ(ierr);
    ierr = MatDestroy(&Bd);CHKERRQ(ierr);
    ierr = MatChop(AinvBd, eps);CHKERRQ(ierr);
    ierr = MatConvert(AinvBd, MATAIJ, MAT_INITIAL_MATRIX, &AinvB);CHKERRQ(ierr);
    ierr = MatDestroy(&AinvBd);CHKERRQ(ierr);
    ierr = MatMatMult(C, AinvB, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
    ierr = MatDestroy(&AinvB);CHKERRQ(ierr);
  } else {
    Mat Ainvd, Ainv;

    ierr = PCComputeExplicitOperator(pc, &Ainvd);CHKERRQ(ierr);
    ierr = MatConvert(Ainvd, MATAIJ, MAT_INITIAL_MATRIX, &Ainv);CHKERRQ(ierr);
    ierr = MatDestroy(&Ainvd);CHKERRQ(ierr);
#if 0
    /* Symmetric version */
    ierr = MatPtAP(Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
#else
    /* Nonsymmetric version */
    ierr = MatMatMatMult(C, Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
#endif
    ierr = MatDestroy(&Ainv);CHKERRQ(ierr);
  }

  ierr = PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD, PETSC_VIEWER_ASCII_INFO);CHKERRQ(ierr);
  ierr = MatView(*S, PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);
  ierr = PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD);CHKERRQ(ierr);

  if (D) {
    MatInfo info;

    ierr = MatGetInfo(D, MAT_GLOBAL_SUM, &info);CHKERRQ(ierr);
    if (info.nz_used) SETERRQ(PetscObjectComm((PetscObject) M), PETSC_ERR_SUP, "Not yet implemented");
  }
  PetscFunctionReturn(0);
}
Ejemplo n.º 2
0
/*@
  MatSchurComplementComputeExplicitOperator - Compute the Schur complement matrix explicitly

  Collective on Mat

  Input Parameter:
. M - the matrix obtained with MatCreateSchurComplement()

  Output Parameter:
. S - the Schur complement matrix

  Note: This can be expensive, so it is mainly for testing

  Level: advanced

.seealso: MatCreateSchurComplement(), MatSchurComplementUpdate()
@*/
PetscErrorCode MatSchurComplementComputeExplicitOperator(Mat M, Mat *S)
{
  Mat            B, C, D;
  KSP            ksp;
  PC             pc;
  PetscBool      isLU, isILU;
  PetscReal      fill = 2.0;
  PetscErrorCode ierr;

  PetscFunctionBegin;
  ierr = MatSchurComplementGetSubMatrices(M, NULL, NULL, &B, &C, &D);CHKERRQ(ierr);
  ierr = MatSchurComplementGetKSP(M, &ksp);CHKERRQ(ierr);
  ierr = KSPGetPC(ksp, &pc);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject) pc, PCLU, &isLU);CHKERRQ(ierr);
  ierr = PetscObjectTypeCompare((PetscObject) pc, PCILU, &isILU);CHKERRQ(ierr);
  if (isLU || isILU) {
    Mat       fact, Bd, AinvB, AinvBd;
    PetscReal eps = 1.0e-10;

    /* This can be sped up for banded LU */
    ierr = KSPSetUp(ksp);CHKERRQ(ierr);
    ierr = PCFactorGetMatrix(pc, &fact);CHKERRQ(ierr);
    ierr = MatConvert(B, MATDENSE, MAT_INITIAL_MATRIX, &Bd);CHKERRQ(ierr);
    ierr = MatDuplicate(Bd, MAT_DO_NOT_COPY_VALUES, &AinvBd);CHKERRQ(ierr);
    ierr = MatMatSolve(fact, Bd, AinvBd);CHKERRQ(ierr);
    ierr = MatDestroy(&Bd);CHKERRQ(ierr);
    ierr = MatChop(AinvBd, eps);CHKERRQ(ierr);
    ierr = MatConvert(AinvBd, MATAIJ, MAT_INITIAL_MATRIX, &AinvB);CHKERRQ(ierr);
    ierr = MatDestroy(&AinvBd);CHKERRQ(ierr);
    ierr = MatMatMult(C, AinvB, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
    ierr = MatDestroy(&AinvB);CHKERRQ(ierr);
  } else {
    Mat Ainvd, Ainv;

    ierr = PCComputeExplicitOperator(pc, &Ainvd);CHKERRQ(ierr);
    ierr = MatConvert(Ainvd, MATAIJ, MAT_INITIAL_MATRIX, &Ainv);CHKERRQ(ierr);
    ierr = MatDestroy(&Ainvd);CHKERRQ(ierr);
#if 0
    /* Symmetric version */
    ierr = MatPtAP(Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
#else
    /* Nonsymmetric version */
    ierr = MatMatMatMult(C, Ainv, B, MAT_INITIAL_MATRIX, fill, S);CHKERRQ(ierr);
#endif
    ierr = MatDestroy(&Ainv);CHKERRQ(ierr);
  }
  if (D) {
    ierr = MatAXPY(*S, -1.0, D, DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
   }
  ierr = MatScale(*S,-1.0);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}
PetscErrorCode BSSCR_DRIVER_flex( KSP ksp, Mat stokes_A, Vec stokes_x, Vec stokes_b, Mat approxS, KSP ksp_K,
                                  MatStokesBlockScaling BA, PetscTruth sym, KSP_BSSCR * bsscrp_self )
{
    char name[PETSC_MAX_PATH_LEN];
    char ubefore[100];
    char uafter[100];
    char pbefore[100];
    char pafter[100];
    PetscTruth flg, flg2, truth, useAcceleratingSmoothingMG, useFancySmoothingMG;
    PetscTruth usePreviousGuess, useNormInfStoppingConditions, useNormInfMonitor, found, extractMats;
    Mat K,G,D,C;
    Vec u,p,f,h;
    Mat S;
    Vec h_hat,t,t2,q,v;

    KSP ksp_inner;
    KSP ksp_S;
    KSP ksp_cleaner;
    KSPType ksp_inner_type;
        
    PetscTruth has_cnst_nullspace;
    PC pc_S, pc_MG, pcInner;
    PetscInt monitor_index,max_it,min_it;
    Vec nsp_vec = PETSC_NULL; 
        
    PetscReal scr_rtol;
    PetscReal inner_rtol;
    PetscReal vSolver_rtol;
        
    PetscScalar uNormInf, pNormInf;
    PetscScalar uNorm, pNorm, rNorm, fNorm;
    PetscInt  uSize, pSize;
    PetscInt    lmin,lmax;
    PetscInt  iterations;
    PetscReal   min,max;
    PetscReal p_sum;

    MGContext mgCtx;
    PC shellPC;

    double t0, t1;
    double mgSetupTime, scrSolveTime, a11SingleSolveTime, solutionAnalysisTime;
    Index nx,ny,nz;
    PetscInt j,start,end;

    static int been_here = 0;  /* Ha Ha Ha !! */

    /* get sub matrix / vector objects */
    MatNestGetSubMat( stokes_A, 0,0, &K );
    MatNestGetSubMat( stokes_A, 0,1, &G );
    MatNestGetSubMat( stokes_A, 1,0, &D );
    MatNestGetSubMat( stokes_A, 1,1, &C );
        
    VecNestGetSubVec( stokes_x, 0, &u );
    VecNestGetSubVec( stokes_x, 1, &p );
        
    VecNestGetSubVec( stokes_b, 0, &f );
    VecNestGetSubVec( stokes_b, 1, &h );

    /* PetscPrintf( PETSC_COMM_WORLD,  "\t Adress of stokes_x is %p\n", stokes_x); */
    /* VecNorm( u, NORM_2, &uNorm ); */
    /* PetscPrintf( PETSC_COMM_WORLD,  "\t u Norm is %.6e in %s: address is %p\n",uNorm,__func__,u); */
    /* VecNorm( p, NORM_2, &pNorm ); */
    /* PetscPrintf( PETSC_COMM_WORLD,  "\t p Norm is %.6e in %s: addres is %p\n",pNorm,__func__,p); */
    /* Create Schur complement matrix */
        
    //MatCreateSchurFromBlock( stokes_A, 0.0, "MatSchur_A11", &S );
    MatCreateSchurComplement(K,K,G,D,C, &S);
    /* configure inner solver */
    if (ksp_K!=PETSC_NULL) {
        MatSchurComplementSetKSP( S, ksp_K );
        MatSchurComplementGetKSP( S, &ksp_inner );
    }
    else {
        abort();
        MatSchurComplementGetKSP( S, &ksp_inner );
        KSPSetType( ksp_inner, "cg" );
    }
    KSPGetPC( ksp_inner, &pcInner );

    /* If we're using multigrid, replace the preconditioner here
       so we get the same options prefix. */

    if(bsscrp_self->mg) {
        mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx );
    }

    /* SETFROMOPTIONS MIGHT F**K MG UP */
    KSPSetOptionsPrefix( ksp_inner, "A11_" );
    KSPSetFromOptions( ksp_inner );

    useNormInfStoppingConditions = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL ,"-A11_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
    if(useNormInfStoppingConditions) 
        BSSCR_KSPSetNormInfConvergenceTest( ksp_inner ); 

    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor) 
        KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfMonitor, PETSC_NULL, PETSC_NULL );
        
    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_to_norm_2_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor) 
        KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );

    /* create right hand side */
    /* h_hat = G'*inv(K)*f - h */
    MatGetVecs(K,PETSC_NULL,&t);
    MatGetVecs( S, PETSC_NULL, &h_hat );

    KSPSetOptionsPrefix( ksp_inner, "A11_" );
    KSPSetFromOptions( ksp_inner );

    KSPSolve(ksp_inner,f,t);/* t=f/K */
    //bsscr_writeVec( t, "ts", "Writing t vector");
    MatMult(D,t,h_hat);/* G'*t */
    VecAXPY(h_hat, -1.0, h);/* h_hat = h_hat - h */
    Stg_VecDestroy(&t);
    //bsscr_writeVec( h_hat, "h_hat", "Writing h_hat Vector in Solver");
    //MatSchurApplyReductionToVecFromBlock( S, stokes_b, h_hat );
        
    /* create solver for S p = h_hat */

    KSPCreate( PETSC_COMM_WORLD, &ksp_S );
    KSPSetOptionsPrefix( ksp_S, "scr_");
    Stg_KSPSetOperators( ksp_S, S,S, SAME_NONZERO_PATTERN );
    KSPSetType( ksp_S, "cg" );
        
    /* Build preconditioner for S */
    KSPGetPC( ksp_S, &pc_S );
    BSSCR_BSSCR_StokesCreatePCSchur2( K,G,D,C,approxS,pc_S,sym, bsscrp_self );

    KSPSetFromOptions(ksp_S);

    /* Set specific monitor test */
    KSPGetTolerances( ksp_S, PETSC_NULL, PETSC_NULL, PETSC_NULL, &max_it );
    //BSSCR_KSPLogSetMonitor( ksp_S, max_it, &monitor_index );
        
    /* Pressure / Velocity Solve */   
    scrSolveTime = MPI_Wtime();
    PetscPrintf( PETSC_COMM_WORLD, "\t* Pressure / Velocity Solve \n");

    usePreviousGuess = PETSC_FALSE; 
    if(been_here)
        PetscOptionsGetTruth( PETSC_NULL, "-scr_use_previous_guess", &usePreviousGuess, &found );
    
    if(usePreviousGuess) {   /* Note this should actually look at checkpoint information */
        KSPSetInitialGuessNonzero( ksp_S, PETSC_TRUE );
    }
    else {
        KSPSetInitialGuessNonzero( ksp_S, PETSC_FALSE );
    }
    
    //KSPSetRelativeRhsConvergenceTest( ksp_S );

    useNormInfStoppingConditions = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL ,"-scr_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
    if(useNormInfStoppingConditions) 
        BSSCR_KSPSetNormInfConvergenceTest(ksp_S); 

    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor) 
        KSPMonitorSet( ksp_S, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );


    PetscPrintf( PETSC_COMM_WORLD, "\t* KSPSolve( ksp_S, h_hat, p )\n");
    /* if h_hat needs to be fixed up ..take out any nullspace vectors here */
    /* we want to check that there is no "noise" in the null-space in the h vector */
    /* this causes problems when we are trying to solve a Jacobian system when the Residual is almost converged */
    if(bsscrp_self->check_pressureNS){
        bsscrp_self->buildPNS(ksp);/* build and set nullspace vectors on bsscr - which is on ksp (function pointer is set in KSPSetUp_BSSCR */
    }

    PetscScalar norm, a, a1, a2, hnorm, pnorm, gnorm;
    MatNorm(G,NORM_INFINITY,&gnorm);
    VecNorm(h_hat, NORM_2, &hnorm);
    hnorm=hnorm/gnorm;

    if((hnorm < 1e-6) && (hnorm > 1e-20)){
        VecScale(h_hat,1.0/hnorm);
    }
    /* test to see if v or t are in nullspace of G and orthogonalize wrt h_hat if needed */
    KSPRemovePressureNullspace_BSSCR(ksp, h_hat);
    /***************************************/
    /* set convergence test to use min_it */
    found = PETSC_FALSE;
    min_it = 0;
    PetscOptionsGetInt( PETSC_NULL,"-scr_ksp_set_min_it_converge", &min_it, &found);
    if(found && min_it > 0){
        BSSCR_KSPSetConvergenceMinIts(ksp_S, min_it, bsscrp_self);
    }
    KSPSolve( ksp_S, h_hat, p );
    sprintf(pafter,"psafter_%d",been_here);
    bsscr_writeVec( p, pafter, "Writing p Vector in Solver");
    /***************************************/
    if((hnorm < 1e-6) && (hnorm > 1e-20)){
        VecScale(h_hat,hnorm);
        VecScale(p,hnorm);
    }
    KSPRemovePressureNullspace_BSSCR(ksp, p);


    scrSolveTime =  MPI_Wtime() - scrSolveTime;
    PetscPrintf( PETSC_COMM_WORLD, "\n\t* KSPSolve( ksp_S, h_hat, p )  Solve  Finished in time: %lf seconds\n\n", scrSolveTime);
    /* Resolve with this pressure to obtain solution for u */
        
    /* obtain solution for u */       
    VecDuplicate( u, &t );
    MatMult( G, p, t);
    VecAYPX( t, -1.0, f ); /* t <- -t + f */
    MatSchurComplementGetKSP( S, &ksp_inner );
        
 
    a11SingleSolveTime = MPI_Wtime();         /* ----------------------------------  Final V Solve */
        
    if(usePreviousGuess)      
        KSPSetInitialGuessNonzero( ksp_inner, PETSC_TRUE ); 

    KSPSetOptionsPrefix( ksp_inner, "backsolveA11_" );
    KSPSetFromOptions( ksp_inner );
    KSPSolve( ksp_inner, t, u );       /* Solve, then restore default tolerance and initial guess */          


    a11SingleSolveTime = MPI_Wtime() - a11SingleSolveTime;            /* ------------------ Final V Solve */

        
    PetscPrintf( PETSC_COMM_WORLD,  "\n\nSCR Solver Summary:\n\n");
  
    if(bsscrp_self->mg)
        PetscPrintf( PETSC_COMM_WORLD, "  Multigrid setup:        = %.4g secs \n", mgSetupTime);

    KSPGetIterationNumber( ksp_S, &iterations);
    PetscPrintf( PETSC_COMM_WORLD,     "  Pressure Solve:         = %.4g secs / %d its\n", scrSolveTime, iterations);
    KSPGetIterationNumber( ksp_inner, &iterations);
    PetscPrintf( PETSC_COMM_WORLD,     "  Final V Solve:          = %.4g secs / %d its\n\n", a11SingleSolveTime, iterations);
    
    /* Analysis of solution:
       This can be somewhat time consuming as it requires allocation / de-allocation, 
       computing vector norms etc. So we make it optional..
       This should be put into a proper KSP  monitor now?
    */        
    flg = PETSC_TRUE;
    PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_solution_summary", &flg, &found );
        
    if(flg) {
        
        solutionAnalysisTime = MPI_Wtime();
        
        VecGetSize( u, &uSize ); 
        VecGetSize( p, &pSize );
        
        VecDuplicate( u, &t2 );
        MatMult( K, u, t2);
        VecAYPX( t2, -1.0, t ); /* t2 <- -t2 + t  ... should be the formal residual vector */
        
        VecNorm( t2, NORM_2, &rNorm );      
        VecNorm( f,  NORM_2, &fNorm );      
        
        PetscPrintf( PETSC_COMM_WORLD,  "  |f - K u - G p|/|f|     = %.6e\n", rNorm/fNorm );
                
        VecDuplicate( p, &q );
        MatMult( D, u, q );
        VecNorm( u, NORM_2, &uNorm );       
        VecNorm( q, NORM_2, &rNorm );       
        
        PetscPrintf( PETSC_COMM_WORLD,  "  |G^T u|_2/|u|_2         = %.6e\n", sqrt( (double) uSize / (double) pSize ) * rNorm / uNorm);
        
        VecNorm( q, NORM_INFINITY, &rNorm );
        
        PetscPrintf( PETSC_COMM_WORLD,  "  |G^T u|_infty/|u|_2     = %.6e\n", sqrt( (double) uSize ) * rNorm / uNorm);

        VecNorm( u, NORM_INFINITY, &uNormInf );
        VecNorm( u, NORM_2,        &uNorm );
        VecGetSize( u, &uSize );
        
        VecNorm( p, NORM_INFINITY, &pNormInf );
        VecNorm( p, NORM_2,        &pNorm );
        
        PetscPrintf( PETSC_COMM_WORLD,  "  |u|_{\\infty}  = %.6e , u_rms = %.6e\n", 
                     uNormInf, uNorm / sqrt( (double) uSize ) );
                
        PetscPrintf( PETSC_COMM_WORLD,  "  |p|_{\\infty}  = %.6e , p_rms = %.6e\n",
                     pNormInf, pNorm / sqrt( (double) pSize ) );

        VecMax( u, &lmax, &max );
        VecMin( u, &lmin, &min );
        PetscPrintf( PETSC_COMM_WORLD,  "  min/max(u)    = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);

        VecMax( p, &lmax, &max );
        VecMin( p, &lmin, &min );
        PetscPrintf( PETSC_COMM_WORLD,  "  min/max(p)    = %.6e [%d] / %.6e [%d]\n",min,lmin,max,lmax);
       
        VecSum( p, &p_sum );
        PetscPrintf( PETSC_COMM_WORLD,  "  \\sum_i p_i    = %.6e \n", p_sum );
        
        solutionAnalysisTime = MPI_Wtime() - solutionAnalysisTime;
        
        PetscPrintf( PETSC_COMM_WORLD,  "\n  Time for this analysis  = %.4g secs\n\n",solutionAnalysisTime);
        
        Stg_VecDestroy(&t2 );
        Stg_VecDestroy(&q );
            
    }
                
    if(bsscrp_self->mg) {
        //MG_inner_solver_pcmg_shutdown( pcInner );
    }

    Stg_VecDestroy(&t );

        
//      KSPLogDestroyMonitor( ksp_S );
        
    Stg_KSPDestroy(&ksp_S );
    //Stg_KSPDestroy(&ksp_inner );
    Stg_VecDestroy(&h_hat );
    Stg_MatDestroy(&S );

    /* Destroy nullspace vector if it exists. */
    if(nsp_vec)
        Stg_VecDestroy(&nsp_vec);
       
    //been_here = 1;
    been_here++;
    PetscFunctionReturn(0);
}
PetscErrorCode BSSCR_DRIVER_auglag( KSP ksp, Mat stokes_A, Vec stokes_x, Vec stokes_b, Mat approxS,
                                          MatStokesBlockScaling BA, PetscTruth sym, KSP_BSSCR * bsscrp_self )
{
    AugLagStokes_SLE *    stokesSLE = (AugLagStokes_SLE*)bsscrp_self->solver->st_sle;
    PetscTruth uzawastyle, KisJustK=PETSC_TRUE, restorek, change_A11rhspresolve;
    PetscTruth usePreviousGuess, useNormInfStoppingConditions, useNormInfMonitor, found, forcecorrection;
    PetscTruth change_backsolve, mg_active;
    PetscErrorCode ierr;
    //PetscInt monitor_index;
    PetscInt max_it,min_it;
    KSP ksp_inner, ksp_S, ksp_new_inner;
    PC pc_S, pcInner;
    Mat K,G,D,C, S, K2;// Korig;
    Vec u,p,f,f2=0,f3=0,h, h_hat,t;
    MGContext mgCtx;
    double mgSetupTime, scrSolveTime, a11SingleSolveTime, penaltyNumber;// hFactor;
    static int been_here = 0;  /* Ha Ha Ha !! */

    char name[PETSC_MAX_PATH_LEN];
    char matname[PETSC_MAX_PATH_LEN];
    char suffix[PETSC_MAX_PATH_LEN];
    char str[PETSC_MAX_PATH_LEN];
    PetscTruth flg, extractMats;
    PetscLogDouble flopsA,flopsB;

    /***************************************************************************************************************/
    /***************************************************************************************************************/
    //if( bsscrp_self->solver->st_sle->context->loadFromCheckPoint ){
    //    been_here=1;
    //}
    /* get sub matrix / vector objects */
    /* note that here, the matrix D should always exist. It is set up in  _StokesBlockKSPInterface_Solve in StokesBlockKSPInterface.c */
    /* now extract K,G etc from a MatNest object */
    MatNestGetSubMat( stokes_A, 0,0, &K );
    MatNestGetSubMat( stokes_A, 0,1, &G );
    MatNestGetSubMat( stokes_A, 1,0, &D );if(!D){ PetscPrintf( PETSC_COMM_WORLD, "D does not exist but should!!\n"); exit(1); }
    MatNestGetSubMat( stokes_A, 1,1, &C );  
    VecNestGetSubVec( stokes_x, 0, &u );
    VecNestGetSubVec( stokes_x, 1, &p );
    VecNestGetSubVec( stokes_b, 0, &f );
    VecNestGetSubVec( stokes_b, 1, &h );
    
    PetscPrintf( PETSC_COMM_WORLD,  "\n\n----------  AUGMENTED LAGRANGIAN K2 METHOD ---------\n\n" );
    PetscPrintf( PETSC_COMM_WORLD,      "----------- Penalty = %f\n\n", bsscrp_self->solver->penaltyNumber );
    sprintf(suffix,"%s","x");

    PetscOptionsGetString( PETSC_NULL, "-matsuffix", suffix, PETSC_MAX_PATH_LEN-1, &extractMats );

    flg=0;
    PetscOptionsGetString( PETSC_NULL, "-matdumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
    if(flg){
        sprintf(str,"%s/",name); sprintf(matname,"K%s",suffix);
        bsscr_dirwriteMat( K, matname,str, "Writing K matrix in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"G%s",suffix);
        bsscr_dirwriteMat( G, matname,str, "Writing G matrix in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"D%s",suffix);
        bsscr_dirwriteMat( D, matname,str, "Writing D matrix in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"f%s",suffix);
        bsscr_dirwriteVec( f, matname,str, "Writing f vector in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"h%s",suffix);
        bsscr_dirwriteVec( h, matname,str, "Writing h vector in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"Shat%s",suffix);
        bsscr_dirwriteMat( approxS, matname,str, "Writing Shat matrix in al Solver");
        if(C){
          sprintf(str,"%s/",name); sprintf(matname,"C%s",suffix);
          bsscr_dirwriteMat( C, matname,str, "Writing C matrix in al Solver");
        }
    }

    mg_active=PETSC_TRUE;
    PetscOptionsGetTruth( PETSC_NULL ,"-A11_mg_active", &mg_active, &found );
    bsscrp_self->solver->mg_active=mg_active;

    penaltyNumber = bsscrp_self->solver->penaltyNumber;
    //hFactor = stokesSLE->hFactor;
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /******  GET K2   ****************************************************************************************/
    if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
        flg=0;
        PetscOptionsGetString( PETSC_NULL, "-matdumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
        if(flg){
            sprintf(str,"%s/",name);   sprintf(matname,"K2%s",suffix);
            bsscr_dirwriteMat( bsscrp_self->K2, matname,str, "Writing K2 matrix in al Solver");
        }
        K2=bsscrp_self->K2;
        scrSolveTime = MPI_Wtime();
        ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
        scrSolveTime =  MPI_Wtime() - scrSolveTime;
        PetscPrintf( PETSC_COMM_WORLD, "\n\t* K+p*K2 in time: %lf seconds\n\n", scrSolveTime);
        KisJustK=PETSC_FALSE;
        forcecorrection=PETSC_TRUE;
        PetscOptionsGetTruth( PETSC_NULL ,"-force_correction", &forcecorrection, &found );
        if(forcecorrection){
            if(bsscrp_self->f2 && forcecorrection){ 
                f2=bsscrp_self->f2;
                ierr=VecAXPY(f,penaltyNumber,f2);/*  f <- f +a*f2 */
            }else{
                switch (bsscrp_self->k2type) {
                case (K2_GG):
                {
                    VecDuplicate( u, &f3 );
                    MatMult( G, h, f3);   ierr=VecAXPY(f,penaltyNumber,f3);/*  f <- f +a*f2 */
                }
                break;
                case (K2_GMG):
                {
                    Mat M;
                    Vec Mdiag;
                    VecDuplicate( u, &f3 );
                    M = bsscrp_self->solver->mStiffMat->matrix;
                    MatGetVecs( M, &Mdiag, PETSC_NULL );
                    MatGetDiagonal( M, Mdiag );
                    VecReciprocal(Mdiag);
                    VecPointwiseMult(Mdiag,Mdiag,h);
                    MatMult( G, Mdiag, f3);   ierr=VecAXPY(f,penaltyNumber,f3);/*  f <- f +a*f2 */
                    Stg_VecDestroy(&Mdiag);
                }
                break;
                case (K2_DGMGD):
                {
                    Mat M;
                    Vec Mdiag;
                    VecDuplicate( u, &f3 );
                    M = bsscrp_self->solver->mStiffMat->matrix;
                    MatGetVecs( M, &Mdiag, PETSC_NULL );
                    MatGetDiagonal( M, Mdiag );
                    VecReciprocal(Mdiag);
                    VecPointwiseMult(Mdiag,Mdiag,h);
                    MatMult( G, Mdiag, f3);   ierr=VecAXPY(f,penaltyNumber,f3);/*  f <- f +a*f2 */
                    Stg_VecDestroy(&Mdiag);
                }
                break;
                case (K2_NULL):
                {
                    ;
                }
                break;
                case (K2_SLE):
                {
                    ;
                }
                break;
                }
            }
        }
    }

    /* Create Schur complement matrix */
    MatCreateSchurComplement(K,K,G,D,C, &S);
    MatSchurComplementGetKSP( S, &ksp_inner);
    KSPGetPC( ksp_inner, &pcInner );
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /*********    SET PREFIX FOR INNER/VELOCITY KSP    *************************************************************/
    KSPSetOptionsPrefix( ksp_inner, "A11_" );
    KSPSetFromOptions( ksp_inner );
    Stg_KSPSetOperators(ksp_inner, K, K, DIFFERENT_NONZERO_PATTERN);

    useNormInfStoppingConditions = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL ,"-A11_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
    if(useNormInfStoppingConditions) 
        BSSCR_KSPSetNormInfConvergenceTest( ksp_inner ); 

    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor)  KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfMonitor, PETSC_NULL, PETSC_NULL );

    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-A11_ksp_norm_inf_to_norm_2_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor)  KSPMonitorSet( ksp_inner, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /* If multigrid is enabled, set it now. */
    change_A11rhspresolve = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-change_A11rhspresolve", &change_A11rhspresolve, &found );

    if(bsscrp_self->solver->mg_active && !change_A11rhspresolve) { mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx ); }
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /* create right hand side */
    if(change_A11rhspresolve){
      //Stg_KSPDestroy(&ksp_inner );
      KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
      Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
      KSPSetOptionsPrefix(ksp_new_inner, "rhsA11_");
      MatSchurComplementSetKSP( S, ksp_new_inner );/* this call destroys the ksp_inner that is already set on S */
      ksp_inner=ksp_new_inner;
      KSPGetPC( ksp_inner, &pcInner );
      KSPSetFromOptions(ksp_inner); /* make sure we are setting up our solver how we want it */
    }
    MatGetVecs( S, PETSC_NULL, &h_hat );
    Vec f_tmp;
    /* It may be the case that the current velocity solution might not be bad guess for f_tmp? <-- maybe not */
    MatGetVecs( K, PETSC_NULL, &f_tmp );
    scrSolveTime = MPI_Wtime();
    KSPSolve(ksp_inner, f, f_tmp);
    scrSolveTime =  MPI_Wtime() - scrSolveTime;
    PetscPrintf( PETSC_COMM_WORLD, "\n\t*  KSPSolve for RHS setup Finished in time: %lf seconds\n\n", scrSolveTime);
    MatMult(D, f_tmp, h_hat);
    VecAYPX(h_hat, -1.0, h); /* Computes y = x + alpha y.  h_hat -> h - Gt*K^(-1)*f*/
    Stg_VecDestroy(&f_tmp);

    if(bsscrp_self->solver->mg_active && change_A11rhspresolve) {
      //Stg_KSPDestroy(&ksp_inner );
      KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
      Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
      KSPSetOptionsPrefix( ksp_new_inner, "A11_" );
      MatSchurComplementSetKSP( S, ksp_new_inner );
      ksp_inner=ksp_new_inner;
      //MatSchurSetKSP( S, ksp_inner );
      KSPGetPC( ksp_inner, &pcInner );
      KSPSetFromOptions( ksp_inner );
      mgSetupTime=setupMG( bsscrp_self, ksp_inner, pcInner, K, &mgCtx ); 
    }
    /* create solver for S p = h_hat */
    KSPCreate( PETSC_COMM_WORLD, &ksp_S );
    KSPSetOptionsPrefix( ksp_S, "scr_");
    /* By default use the UW approxS Schur preconditioner -- same as the one used by the Uzawa solver */
    /* Note that if scaling is activated then the approxS matrix has been scaled already */
    /* so no need to rebuild in the case of scaling as we have been doing */
    if(!approxS){ PetscPrintf( PETSC_COMM_WORLD,  "WARNING approxS is NULL\n"); }
    Stg_KSPSetOperators( ksp_S, S, S, SAME_NONZERO_PATTERN );
    KSPSetType( ksp_S, "cg" );
    KSPGetPC( ksp_S, &pc_S );
    BSSCR_BSSCR_StokesCreatePCSchur2( K,G,D,C,approxS, pc_S, sym, bsscrp_self );

    flg=0;
    PetscOptionsGetString( PETSC_NULL, "-NN", name, PETSC_MAX_PATH_LEN-1, &flg );
    if(flg){
      Mat Smat, Pmat;                                                                                                 
      //MatStructure mstruct;  
      Stg_PCGetOperators( pc_S, &Smat, &Pmat, NULL );
      sprintf(str,"%s/",name); sprintf(matname,"Pmat%s",suffix);
      bsscr_dirwriteMat( Pmat, matname,str, "Writing Pmat matrix in al Solver");
    }
   
    uzawastyle=PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL, "-uzawa_style", &uzawastyle, &found );
    if(uzawastyle){
        /* now want to set up the ksp_S->pc to be of type ksp (gmres) by default to match Uzawa */
        KSP pc_ksp;
        KSPGetPC( ksp_S, &pc_S );
        PCSetType(pc_S,PCKSP);
        PCKSPGetKSP( pc_S, &pc_ksp);
        KSPSetType(pc_ksp, "gmres" );
        KSPSetOptionsPrefix( pc_ksp, "scrPCKSP_");
        KSPSetFromOptions( pc_ksp );
    }
    KSPSetFromOptions( ksp_S );
    /* Set specific monitor test */
    KSPGetTolerances( ksp_S, PETSC_NULL, PETSC_NULL, PETSC_NULL, &max_it );
    // Weirdness with petsc 3.2 here...look at it later
    //BSSCR_KSPLogSetMonitor( ksp_S, max_it, &monitor_index );

    /***************************************************************************************************************/
    /* Pressure / Velocity Solve */     
    /***************************************************************************************************************/
    PetscPrintf( PETSC_COMM_WORLD, "\t* Pressure / Velocity Solve \n");
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    usePreviousGuess = PETSC_FALSE; 
    if(been_here)
        PetscOptionsGetTruth( PETSC_NULL, "-scr_use_previous_guess", &usePreviousGuess, &found );
    if(usePreviousGuess) {   /* Note this should actually look at checkpoint information */
        KSPSetInitialGuessNonzero( ksp_S, PETSC_TRUE ); }
    else {
        KSPSetInitialGuessNonzero( ksp_S, PETSC_FALSE ); }
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /*******     SET CONVERGENCE TESTS     *************************************************************************/
    useNormInfStoppingConditions = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL ,"-scr_use_norm_inf_stopping_condition", &useNormInfStoppingConditions, &found );
    if(useNormInfStoppingConditions) 
        BSSCR_KSPSetNormInfConvergenceTest(ksp_S); 

    useNormInfMonitor = PETSC_FALSE; 
    PetscOptionsGetTruth( PETSC_NULL, "-scr_ksp_norm_inf_monitor", &useNormInfMonitor, &found );
    if(useNormInfMonitor) 
        KSPMonitorSet( ksp_S, BSSCR_KSPNormInfToNorm2Monitor, PETSC_NULL, PETSC_NULL );
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /*******   PRESSURE SOLVE   ************************************************************************************/
    PetscPrintf( PETSC_COMM_WORLD, "\t* KSPSolve( ksp_S, h_hat, p )\n");
    /* if h_hat needs to be fixed up ..take out any nullspace vectors here */
    /* we want to check that there is no "noise" in the null-space in the h vector */
    /* this causes problems when we are trying to solve a Jacobian system when the Residual is almost converged */
    if(bsscrp_self->check_pressureNS){
        bsscrp_self->buildPNS(ksp);/* build and set nullspace vectors on bsscr - which is on ksp (function pointer is set in KSPSetUp_BSSCR) */
    }

    PetscScalar hnorm, gnorm;
    MatNorm(G,NORM_INFINITY,&gnorm);
    VecNorm(h_hat, NORM_2, &hnorm);
    hnorm=hnorm/gnorm;

    if((hnorm < 1e-6) && (hnorm > 1e-20)){
        VecScale(h_hat,1.0/hnorm);
    }
    /* test to see if v or t are in nullspace of G and orthogonalize wrt h_hat if needed */
    KSPRemovePressureNullspace_BSSCR(ksp, h_hat);
    /* set convergence test to use min_it */
    found = PETSC_FALSE;
    min_it = 0;
    PetscOptionsGetInt( PETSC_NULL,"-scr_ksp_set_min_it_converge", &min_it, &found);
    if(found && min_it > 0){
        BSSCR_KSPSetConvergenceMinIts(ksp_S, min_it, bsscrp_self);
    }

    /** Pressure Solve **/
    PetscGetFlops(&flopsA);
    scrSolveTime = MPI_Wtime();
    KSPSolve( ksp_S, h_hat, p );
    scrSolveTime =  MPI_Wtime() - scrSolveTime;
    PetscGetFlops(&flopsB);
    PetscPrintf( PETSC_COMM_WORLD, "\n\t* KSPSolve( ksp_S, h_hat, p )  Solve Finished in time: %lf seconds\n\n", scrSolveTime);
    bsscrp_self->solver->stats.pressure_time=scrSolveTime;
    bsscrp_self->solver->stats.pressure_flops=(double)(flopsB-flopsA);

    /***************************************/
    if((hnorm < 1e-6) && (hnorm > 1e-20)){
        VecScale(h_hat,hnorm);
        VecScale(p,hnorm);
    }
    KSPRemovePressureNullspace_BSSCR(ksp, p);

    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /* restore K and f for the Velocity back solve */
    found = PETSC_FALSE;
    restorek = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL, "-restore_K", &restorek, &found);
    //PetscOptionsGetString( PETSC_NULL, "-restore_K", name, PETSC_MAX_PATH_LEN-1, &flg );
    if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
        if(restorek){
            penaltyNumber = -penaltyNumber;
            if(f2) { ierr=VecAXPY(f,penaltyNumber,f2); }/*  f <- f +a*f2 */
            if(f3) { ierr=VecAXPY(f,penaltyNumber,f3); }/*  f <- f +a*f3 */
            ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
            //K=Korig;
            Stg_KSPSetOperators(ksp_inner, K, K, DIFFERENT_NONZERO_PATTERN);
            KisJustK=PETSC_TRUE;          
        }      
    }
    if(f3){ Stg_VecDestroy(&f3 ); } /* always destroy this local vector if was created */

    /* obtain solution for u */
    VecDuplicate( u, &t );   MatMult( G, p, t);  VecAYPX( t, -1.0, f ); /*** t <- -t + f   = f - G*p  ***/
    MatSchurComplementGetKSP( S, &ksp_inner );
    a11SingleSolveTime = MPI_Wtime();           /* ----------------------------------  Final V Solve */
    if(usePreviousGuess) KSPSetInitialGuessNonzero( ksp_inner, PETSC_TRUE );

    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /*******   VELOCITY SOLVE   ************************************************************************************/
    /** Easier to just create a new KSP here if we want to do backsolve diffferently. (getting petsc errors now when switching from fgmres) */
    change_backsolve=PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL, "-change_backsolve", &change_backsolve, &found );
    if(change_backsolve){
      //Stg_KSPDestroy(&ksp_inner );
      KSPCreate(PETSC_COMM_WORLD, &ksp_new_inner);
      Stg_KSPSetOperators(ksp_new_inner, K, K, DIFFERENT_NONZERO_PATTERN);
      KSPSetOptionsPrefix(ksp_new_inner, "backsolveA11_");
      KSPSetFromOptions(ksp_new_inner); /* make sure we are setting up our solver how we want it */
      MatSchurComplementSetKSP( S, ksp_new_inner );/* need to give the Schur it's inner ksp back for when we destroy it at end */
      ksp_inner=ksp_new_inner;
    }

    PetscGetFlops(&flopsA);
    KSPSolve(ksp_inner, t, u);         /* Solve, then restore default tolerance and initial guess */
    PetscGetFlops(&flopsB);
    bsscrp_self->solver->stats.velocity_backsolve_flops=(double)(flopsB-flopsA);
    a11SingleSolveTime = MPI_Wtime() - a11SingleSolveTime;              /* ------------------ Final V Solve */
    bsscrp_self->solver->stats.velocity_backsolve_time=a11SingleSolveTime;

    flg=0;
    PetscOptionsGetString( PETSC_NULL, "-solutiondumpdir", name, PETSC_MAX_PATH_LEN-1, &flg );
    if(flg){
        sprintf(str,"%s/",name); sprintf(matname,"p%s",suffix);
        bsscr_dirwriteVec( p, matname,str, "Writing p vector in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"u%s",suffix);
        bsscr_dirwriteVec( u, matname,str, "Writing u vector in al Solver");
        sprintf(str,"%s/",name); sprintf(matname,"h_hat%s",suffix);
        bsscr_dirwriteVec( h_hat, matname,str, "Writing h_hat vector in al Solver");

    }

    found = PETSC_FALSE;
    restorek = PETSC_FALSE;
    PetscOptionsGetTruth( PETSC_NULL, "-restore_K_after_solve", &restorek, &found);
    if(penaltyNumber > 1e-10 && bsscrp_self->k2type){
        if(restorek){
            penaltyNumber = -penaltyNumber;
            ierr=MatAXPY(K,penaltyNumber,K2,DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);/* Computes K = penaltyNumber*K2 + K */
            KisJustK=PETSC_TRUE;          
        }      
    }
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    /******     SOLUTION SUMMARY      ******************************************************************************/
    bsscr_summary(bsscrp_self,ksp_S,ksp_inner,K,K2,D,G,C,u,p,f,h,t,penaltyNumber,KisJustK, mgSetupTime, scrSolveTime, a11SingleSolveTime);
    //bsscr_summary(bsscrp_self,ksp_S,ksp_inner,K,Korig,K2,D,G,C,u,p,f,h,t,penaltyNumber,KisJustK, mgSetupTime, scrSolveTime, a11SingleSolveTime);
    /***************************************************************************************************************/
    /***************************************************************************************************************/
    Stg_VecDestroy(&t );
    Stg_KSPDestroy(&ksp_S );
    Stg_VecDestroy(&h_hat );
    Stg_MatDestroy(&S );//This will destroy ksp_inner: also.. pcInner == pc_MG and is destroyed when ksp_inner is 
    been_here = 1;
    PetscFunctionReturn(0);
}
Ejemplo n.º 5
0
PetscErrorCode SNESSetUp_Multiblock(SNES snes)
{
  SNES_Multiblock *mb = (SNES_Multiblock *) snes->data;
  BlockDesc        blocks;
  PetscInt         i, numBlocks;
  PetscErrorCode   ierr;

  PetscFunctionBegin;
  /* ierr = SNESDefaultGetWork(snes, 1);CHKERRQ(ierr); */
  ierr = SNESMultiblockSetDefaults(snes);CHKERRQ(ierr);
  numBlocks = mb->numBlocks;
  blocks    = mb->blocks;

  /* Create ISs */
  if (!mb->issetup) {
    PetscInt  ccsize, rstart, rend, nslots, bs;
    PetscBool sorted;

    mb->issetup = PETSC_TRUE;
    bs     = mb->bs;
    ierr   = MatGetOwnershipRange(snes->jacobian_pre, &rstart, &rend);CHKERRQ(ierr);
    ierr   = MatGetLocalSize(snes->jacobian_pre, PETSC_NULL, &ccsize);CHKERRQ(ierr);
    nslots = (rend - rstart)/bs;
    for (i = 0; i < numBlocks; ++i) {
      if (mb->defaultblocks) {
        ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+i, numBlocks, &blocks->is);CHKERRQ(ierr);
      } else if (!blocks->is) {
        if (blocks->nfields > 1) {
          PetscInt *ii, j, k, nfields = blocks->nfields, *fields = blocks->fields;

          ierr = PetscMalloc(nfields*nslots*sizeof(PetscInt), &ii);CHKERRQ(ierr);
          for (j = 0; j < nslots; ++j) {
            for (k = 0; k < nfields; ++k) {
              ii[nfields*j + k] = rstart + bs*j + fields[k];
            }
          }
          ierr = ISCreateGeneral(((PetscObject) snes)->comm, nslots*nfields, ii, PETSC_OWN_POINTER, &blocks->is);CHKERRQ(ierr);
        } else {
          ierr = ISCreateStride(((PetscObject) snes)->comm, nslots, rstart+blocks->fields[0], bs, &blocks->is);CHKERRQ(ierr);
        }
      }
      ierr = ISSorted(blocks->is, &sorted);CHKERRQ(ierr);
      if (!sorted) SETERRQ(PETSC_COMM_SELF, PETSC_ERR_USER, "Fields must be sorted when creating split");
      blocks = blocks->next;
    }
  }

#if 0
  /* Create matrices */
  ilink  = jac->head;
  if (!jac->pmat) {
    ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->pmat);CHKERRQ(ierr);
    for (i=0; i<nsplit; i++) {
      ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
      ilink = ilink->next;
    }
  } else {
    for (i=0; i<nsplit; i++) {
      ierr = MatGetSubMatrix(pc->pmat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->pmat[i]);CHKERRQ(ierr);
      ilink = ilink->next;
    }
  }
  if (jac->realdiagonal) {
    ilink = jac->head;
    if (!jac->mat) {
      ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->mat);CHKERRQ(ierr);
      for (i=0; i<nsplit; i++) {
        ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_INITIAL_MATRIX,&jac->mat[i]);CHKERRQ(ierr);
        ilink = ilink->next;
      }
    } else {
      for (i=0; i<nsplit; i++) {
        if (jac->mat[i]) {ierr = MatGetSubMatrix(pc->mat,ilink->is,ilink->is,MAT_REUSE_MATRIX,&jac->mat[i]);CHKERRQ(ierr);}
        ilink = ilink->next;
      }
    }
  } else {
    jac->mat = jac->pmat;
  }
#endif

#if 0
  if (jac->type != PC_COMPOSITE_ADDITIVE  && jac->type != PC_COMPOSITE_SCHUR) {
    /* extract the rows of the matrix associated with each field: used for efficient computation of residual inside algorithm */
    ilink  = jac->head;
    if (!jac->Afield) {
      ierr = PetscMalloc(nsplit*sizeof(Mat),&jac->Afield);CHKERRQ(ierr);
      for (i=0; i<nsplit; i++) {
        ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_INITIAL_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
        ilink = ilink->next;
      }
    } else {
      for (i=0; i<nsplit; i++) {
        ierr = MatGetSubMatrix(pc->mat,ilink->is,PETSC_NULL,MAT_REUSE_MATRIX,&jac->Afield[i]);CHKERRQ(ierr);
        ilink = ilink->next;
      }
    }
  }
#endif

  if (mb->type == PC_COMPOSITE_SCHUR) {
#if 0
    IS       ccis;
    PetscInt rstart,rend;
    if (nsplit != 2) SETERRQ(((PetscObject)pc)->comm,PETSC_ERR_ARG_INCOMP,"To use Schur complement preconditioner you must have exactly 2 fields");

    /* When extracting off-diagonal submatrices, we take complements from this range */
    ierr  = MatGetOwnershipRangeColumn(pc->mat,&rstart,&rend);CHKERRQ(ierr);

    /* need to handle case when one is resetting up the preconditioner */
    if (jac->schur) {
      ilink = jac->head;
      ierr  = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
      ierr  = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->B);CHKERRQ(ierr);
      ierr  = ISDestroy(&ccis);CHKERRQ(ierr);
      ilink = ilink->next;
      ierr  = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
      ierr  = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_REUSE_MATRIX,&jac->C);CHKERRQ(ierr);
      ierr  = ISDestroy(&ccis);CHKERRQ(ierr);
      ierr  = MatSchurComplementUpdate(jac->schur,jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->pmat[1],pc->flag);CHKERRQ(ierr);
      ierr  = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),pc->flag);CHKERRQ(ierr);

     } else {
      KSP ksp;
      char schurprefix[256];

      /* extract the A01 and A10 matrices */
      ilink = jac->head;
      ierr  = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
      ierr  = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->B);CHKERRQ(ierr);
      ierr  = ISDestroy(&ccis);CHKERRQ(ierr);
      ilink = ilink->next;
      ierr  = ISComplement(ilink->is,rstart,rend,&ccis);CHKERRQ(ierr);
      ierr  = MatGetSubMatrix(pc->mat,ilink->is,ccis,MAT_INITIAL_MATRIX,&jac->C);CHKERRQ(ierr);
      ierr  = ISDestroy(&ccis);CHKERRQ(ierr);
      /* Use mat[0] (diagonal block of the real matrix) preconditioned by pmat[0] */
      ierr  = MatCreateSchurComplement(jac->mat[0],jac->pmat[0],jac->B,jac->C,jac->mat[1],&jac->schur);CHKERRQ(ierr);
      /* set tabbing and options prefix of KSP inside the MatSchur */
      ierr  = MatSchurComplementGetKSP(jac->schur,&ksp);CHKERRQ(ierr);
      ierr  = PetscObjectIncrementTabLevel((PetscObject)ksp,(PetscObject)pc,2);CHKERRQ(ierr);
      ierr  = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",jac->head->splitname);CHKERRQ(ierr);
      ierr  = KSPSetOptionsPrefix(ksp,schurprefix);CHKERRQ(ierr);
      ierr  = MatSetFromOptions(jac->schur);CHKERRQ(ierr);

      ierr  = KSPCreate(((PetscObject)pc)->comm,&jac->kspschur);CHKERRQ(ierr);
      ierr  = PetscLogObjectParent((PetscObject)pc,(PetscObject)jac->kspschur);CHKERRQ(ierr);
      ierr  = PetscObjectIncrementTabLevel((PetscObject)jac->kspschur,(PetscObject)pc,1);CHKERRQ(ierr);
      ierr  = KSPSetOperators(jac->kspschur,jac->schur,FieldSplitSchurPre(jac),DIFFERENT_NONZERO_PATTERN);CHKERRQ(ierr);
      if (jac->schurpre == PC_FIELDSPLIT_SCHUR_PRE_SELF) {
        PC pc;
        ierr = KSPGetPC(jac->kspschur,&pc);CHKERRQ(ierr);
        ierr = PCSetType(pc,PCNONE);CHKERRQ(ierr);
        /* Note: This is bad if there exist preconditioners for MATSCHURCOMPLEMENT */
      }
      ierr = PetscSNPrintf(schurprefix,sizeof(schurprefix),"%sfieldsplit_%s_",((PetscObject)pc)->prefix?((PetscObject)pc)->prefix:"",ilink->splitname);CHKERRQ(ierr);
      ierr  = KSPSetOptionsPrefix(jac->kspschur,schurprefix);CHKERRQ(ierr);
      /* really want setfromoptions called in PCSetFromOptions_FieldSplit(), but it is not ready yet */
      ierr = KSPSetFromOptions(jac->kspschur);CHKERRQ(ierr);

      ierr = PetscMalloc2(2,Vec,&jac->x,2,Vec,&jac->y);CHKERRQ(ierr);
      ierr = MatGetVecs(jac->pmat[0],&jac->x[0],&jac->y[0]);CHKERRQ(ierr);
      ierr = MatGetVecs(jac->pmat[1],&jac->x[1],&jac->y[1]);CHKERRQ(ierr);
      ilink = jac->head;
      ilink->x = jac->x[0]; ilink->y = jac->y[0];
      ilink = ilink->next;
      ilink->x = jac->x[1]; ilink->y = jac->y[1];
    }
#endif
  } else {
    /* Set up the individual SNESs */
    blocks = mb->blocks;
    i      = 0;
    while (blocks) {
      /*TODO: Set these correctly */
      /*ierr = SNESSetFunction(blocks->snes, blocks->x, func);CHKERRQ(ierr);*/
      /*ierr = SNESSetJacobian(blocks->snes, blocks->x, jac);CHKERRQ(ierr);*/
      ierr = VecDuplicate(blocks->snes->vec_sol, &blocks->x);CHKERRQ(ierr);
      /* really want setfromoptions called in SNESSetFromOptions_Multiblock(), but it is not ready yet */
      ierr = SNESSetFromOptions(blocks->snes);CHKERRQ(ierr);
      ierr = SNESSetUp(blocks->snes);CHKERRQ(ierr);
      blocks = blocks->next;
      i++;
    }
  }

  /* Compute scatter contexts needed by multiplicative versions and non-default splits */
  if (!mb->blocks->sctx) {
    Vec xtmp;

    blocks = mb->blocks;
    ierr = MatGetVecs(snes->jacobian_pre, &xtmp, PETSC_NULL);CHKERRQ(ierr);
    while(blocks) {
      ierr = VecScatterCreate(xtmp, blocks->is, blocks->x, PETSC_NULL, &blocks->sctx);CHKERRQ(ierr);
      blocks = blocks->next;
    }
    ierr = VecDestroy(&xtmp);CHKERRQ(ierr);
  }
  PetscFunctionReturn(0);
}
Ejemplo n.º 6
0
PetscErrorCode PCBDDCSubSchursSetUp(PCBDDCSubSchurs sub_schurs, Mat S, IS is_A_I, IS is_A_B, PetscInt ncc, IS is_cc[], PetscInt xadj[], PetscInt adjncy[], PetscInt nlayers)
{
  Mat                    A_II,A_IB,A_BI,A_BB;
  ISLocalToGlobalMapping BtoNmap,ItoNmap;
  PetscBT                touched;
  PetscInt               i,n_I,n_B,n_local,*local_numbering;
  PetscBool              is_sorted;
  PetscErrorCode         ierr;

  PetscFunctionBegin;
  ierr = ISSorted(is_A_I,&is_sorted);CHKERRQ(ierr);
  if (!is_sorted) {
    SETERRQ(PetscObjectComm((PetscObject)is_A_I),PETSC_ERR_PLIB,"IS for I dofs should be shorted");
  }
  ierr = ISSorted(is_A_B,&is_sorted);CHKERRQ(ierr);
  if (!is_sorted) {
    SETERRQ(PetscObjectComm((PetscObject)is_A_B),PETSC_ERR_PLIB,"IS for B dofs should be shorted");
  }

  /* get sizes */
  ierr = ISGetLocalSize(is_A_I,&n_I);CHKERRQ(ierr);
  ierr = ISGetLocalSize(is_A_B,&n_B);CHKERRQ(ierr);
  n_local = n_I+n_B;

  /* maps */
  ierr = ISLocalToGlobalMappingCreateIS(is_A_B,&BtoNmap);CHKERRQ(ierr);
  if (nlayers >= 0 && xadj != NULL && adjncy != NULL) { /* I problems have a different size of the original ones */
    ierr = ISLocalToGlobalMappingCreateIS(is_A_I,&ItoNmap);CHKERRQ(ierr);
    /* allocate some auxiliary space */
    ierr = PetscMalloc1(n_local,&local_numbering);CHKERRQ(ierr);
    ierr = PetscBTCreate(n_local,&touched);CHKERRQ(ierr);
  } else {
    ItoNmap = 0;
    local_numbering = 0;
    touched = 0;
  }

  /* get Schur complement matrices */
  ierr = MatSchurComplementGetSubMatrices(S,&A_II,NULL,&A_IB,&A_BI,&A_BB);CHKERRQ(ierr);

  /* allocate space for schur complements */
  ierr = PetscMalloc5(ncc,&sub_schurs->is_AEj_I,ncc,&sub_schurs->is_AEj_B,ncc,&sub_schurs->S_Ej,ncc,&sub_schurs->work1,ncc,&sub_schurs->work2);CHKERRQ(ierr);
  sub_schurs->n_subs = ncc;

  /* cycle on subsets and extract schur complements */
  for (i=0;i<sub_schurs->n_subs;i++) {
    Mat      AE_II,AE_IE,AE_EI,AE_EE;
    IS       is_I,is_subset_B;

    /* get IS for subsets in B numbering */
    ierr = ISDuplicate(is_cc[i],&sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
    ierr = ISSort(sub_schurs->is_AEj_B[i]);CHKERRQ(ierr);
    ierr = ISGlobalToLocalMappingApplyIS(BtoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_B[i],&is_subset_B);CHKERRQ(ierr);

    /* BB block on subset */
    ierr = MatGetSubMatrix(A_BB,is_subset_B,is_subset_B,MAT_INITIAL_MATRIX,&AE_EE);CHKERRQ(ierr);

    if (ItoNmap) { /* is ItoNmap has been computed, extracts only a part of I dofs */
      const PetscInt* idx_B;
      PetscInt        n_local_dofs,n_prev_added,j,layer,subset_size;

      /* all boundary dofs must be skipped when adding layers */
      ierr = PetscBTMemzero(n_local,touched);CHKERRQ(ierr);
      ierr = ISGetIndices(is_A_B,&idx_B);CHKERRQ(ierr);
      for (j=0;j<n_B;j++) {
        ierr = PetscBTSet(touched,idx_B[j]);CHKERRQ(ierr);
      }
      ierr = ISRestoreIndices(is_A_B,&idx_B);CHKERRQ(ierr);

      /* add next layers of dofs */
      ierr = ISGetLocalSize(is_cc[i],&subset_size);CHKERRQ(ierr);
      ierr = ISGetIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
      ierr = PetscMemcpy(local_numbering,idx_B,subset_size*sizeof(PetscInt));CHKERRQ(ierr);
      ierr = ISRestoreIndices(is_cc[i],&idx_B);CHKERRQ(ierr);
      n_local_dofs = subset_size;
      n_prev_added = subset_size;
      for (layer=0;layer<nlayers;layer++) {
        PetscInt n_added;
        if (n_local_dofs == n_I+subset_size) break;
        if (n_local_dofs > n_I+subset_size) {
          SETERRQ3(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Error querying layer %d. Out of bound access (%d > %d)",layer,n_local_dofs,n_I+subset_size);
        }
        ierr = PCBDDCAdjGetNextLayer_Private(local_numbering+n_local_dofs,n_prev_added,touched,xadj,adjncy,&n_added);CHKERRQ(ierr);
        n_prev_added = n_added;
        n_local_dofs += n_added;
        if (!n_added) break;
      }

      /* IS for I dofs in original numbering and in I numbering */
      ierr = ISCreateGeneral(PetscObjectComm((PetscObject)ItoNmap),n_local_dofs-subset_size,local_numbering+subset_size,PETSC_COPY_VALUES,&sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
      ierr = ISSort(sub_schurs->is_AEj_I[i]);CHKERRQ(ierr);
      ierr = ISGlobalToLocalMappingApplyIS(ItoNmap,IS_GTOLM_DROP,sub_schurs->is_AEj_I[i],&is_I);CHKERRQ(ierr);

      /* II block */
      ierr = MatGetSubMatrix(A_II,is_I,is_I,MAT_INITIAL_MATRIX,&AE_II);CHKERRQ(ierr);
    } else { /* in this case we can take references of already existing IS and matrices for I dofs */
      /* IS for I dofs in original numbering */
      ierr = PetscObjectReference((PetscObject)is_A_I);CHKERRQ(ierr);
      sub_schurs->is_AEj_I[i] = is_A_I;

      /* IS for I dofs in I numbering TODO: "first" argument of ISCreateStride is not general */
      ierr = ISCreateStride(PetscObjectComm((PetscObject)is_A_I),n_I,0,1,&is_I);CHKERRQ(ierr);

      /* II block is the same */
      ierr = PetscObjectReference((PetscObject)A_II);CHKERRQ(ierr);
      AE_II = A_II;
    }

    /* IE block */
    ierr = MatGetSubMatrix(A_IB,is_I,is_subset_B,MAT_INITIAL_MATRIX,&AE_IE);CHKERRQ(ierr);

    /* EI block */
    ierr = MatGetSubMatrix(A_BI,is_subset_B,is_I,MAT_INITIAL_MATRIX,&AE_EI);CHKERRQ(ierr);

    /* setup Schur complements on subset */
    ierr = MatCreateSchurComplement(AE_II,AE_II,AE_IE,AE_EI,AE_EE,&sub_schurs->S_Ej[i]);CHKERRQ(ierr);
    ierr = MatGetVecs(sub_schurs->S_Ej[i],&sub_schurs->work1[i],&sub_schurs->work2[i]);CHKERRQ(ierr);
    if (AE_II == A_II) { /* we can reuse the same ksp */
      KSP ksp;
      ierr = MatSchurComplementGetKSP(S,&ksp);CHKERRQ(ierr);
      ierr = MatSchurComplementSetKSP(sub_schurs->S_Ej[i],ksp);CHKERRQ(ierr);
    } else { /* build new ksp object which inherits ksp and pc types from the original one */
      KSP      origksp,schurksp;
      PC       origpc,schurpc;
      KSPType  ksp_type;
      PCType   pc_type;
      PetscInt n_internal;

      ierr = MatSchurComplementGetKSP(S,&origksp);CHKERRQ(ierr);
      ierr = MatSchurComplementGetKSP(sub_schurs->S_Ej[i],&schurksp);CHKERRQ(ierr);
      ierr = KSPGetType(origksp,&ksp_type);CHKERRQ(ierr);
      ierr = KSPSetType(schurksp,ksp_type);CHKERRQ(ierr);
      ierr = KSPGetPC(schurksp,&schurpc);CHKERRQ(ierr);
      ierr = KSPGetPC(origksp,&origpc);CHKERRQ(ierr);
      ierr = PCGetType(origpc,&pc_type);CHKERRQ(ierr);
      ierr = PCSetType(schurpc,pc_type);CHKERRQ(ierr);
      ierr = ISGetSize(is_I,&n_internal);CHKERRQ(ierr);
      if (n_internal) { /* UMFPACK gives error with 0 sized problems */
        MatSolverPackage solver=NULL;
        ierr = PCFactorGetMatSolverPackage(origpc,(const MatSolverPackage*)&solver);CHKERRQ(ierr);
        if (solver) {
          ierr = PCFactorSetMatSolverPackage(schurpc,solver);CHKERRQ(ierr);
        }
      }
      ierr = KSPSetUp(schurksp);CHKERRQ(ierr);
    }
    /* free */
    ierr = MatDestroy(&AE_II);CHKERRQ(ierr);
    ierr = MatDestroy(&AE_EE);CHKERRQ(ierr);
    ierr = MatDestroy(&AE_IE);CHKERRQ(ierr);
    ierr = MatDestroy(&AE_EI);CHKERRQ(ierr);
    ierr = ISDestroy(&is_I);CHKERRQ(ierr);
    ierr = ISDestroy(&is_subset_B);CHKERRQ(ierr);
  }
  /* free */
  ierr = ISLocalToGlobalMappingDestroy(&ItoNmap);CHKERRQ(ierr);
  ierr = ISLocalToGlobalMappingDestroy(&BtoNmap);CHKERRQ(ierr);
  ierr = PetscFree(local_numbering);CHKERRQ(ierr);
  ierr = PetscBTDestroy(&touched);CHKERRQ(ierr);
  PetscFunctionReturn(0);
}