コード例 #1
0
ファイル: newtond.c プロジェクト: ASCM/apbs-pdb2pqr
VPUBLIC void Vnewton(int *nx, int *ny, int *nz,
        double *x, int *iz,
        double *w0, double *w1, double *w2, double *w3,
        int *istop, int *itmax, int *iters, int *ierror,
        int *nlev, int *ilev, int *nlev_real,
        int *mgsolv, int *iok, int *iinfo,
        double *epsiln, double *errtol, double *omega,
        int *nu1, int *nu2, int *mgsmoo,
        double *cprime,  double *rhs, double *xtmp,
        int *ipc, double *rpc,
        double *pc, double *ac, double *cc, double *fc, double *tru) {

    int level, lev;
    int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
    double errtol_s, ord, bigc;
    double rsden, rsnrm, orsnrm;

    double xnorm_old, xnorm_new, damp, xnorm_med, xnorm_den;
    double rho_max, rho_min, rho_max_mod, rho_min_mod, errtol_p;
    int iter_d, itmax_d, mode, idamp, ipkey;
    int itmax_p, iters_p, iok_p, iinfo_p;

    // Utility and temproary parameters
    double alpha;

    MAT2(iz, 50, 1);

    // Recover level information
    level = 1;
    lev   = (*ilev - 1) + level;

    // Do some i/o if requested
    if (*iinfo > 1) {
        VMESSAGE3("Starting: (%d, %d, %d)", *nx, *ny, *nz);
    }

    if (*iok != 0) {
        Vprtstp(*iok, -1, 0.0, 0.0, 0.0);
    }

    /**************************************************************
     *** note: if (iok!=0) then:  use a stopping test.          ***
     ***       else:  use just the itmax to stop iteration.     ***
     **************************************************************
     *** istop=0 most efficient (whatever it is)                ***
     *** istop=1 relative residual                              ***
     *** istop=2 rms difference of successive iterates          ***
     *** istop=3 relative true error (provided for testing)     ***
     **************************************************************/

    // Compute denominator for stopping criterion
    if (*istop == 0) {
         rsden = 1.0;
    } else if (*istop == 1) {

        // Compute initial residual with zero initial guess
        // this is analogous to the linear case where one can
        // simply take norm of rhs for a zero initial guess

        Vazeros(nx, ny, nz, w1);

        Vnmresid(nx, ny, nz,
                RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                RAT( fc, VAT2(iz, 1, lev)),
                w1, w2, w3);
        rsden = Vxnrm1(nx, ny, nz, w2);
    } else if (*istop == 2) {
        rsden = VSQRT( *nx * *ny * *nz);
    } else if (*istop == 3) {
        rsden = Vxnrm2(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)));
    } else if (*istop == 4) {
        rsden = Vxnrm2(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)));
    } else if (*istop == 5) {
        Vnmatvec(nx, ny, nz,
                RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                RAT(tru, VAT2(iz, 1, lev)),
                w1, w2);
        rsden = VSQRT(Vxdot(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1));
    } else {
        VABORT_MSG1("Bad istop value: %d\n", *istop);
    }

    if (rsden == 0.0) {
        rsden = 1.0;
        VWARN_MSG0(rsden != 0, "rhs is zero");
    }
    rsnrm = rsden;
    orsnrm = rsnrm;

    if (*iok != 0) {
        Vprtstp(*iok, 0, rsnrm, rsden, orsnrm);
    }

    /*********************************************************************
     *** begin newton iteration
     *********************************************************************/

    // Now compute residual with the initial guess

    Vnmresid(nx, ny, nz,
            RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
            RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
            RAT( fc, VAT2(iz, 1, lev)), RAT(  x, VAT2(iz, 1, lev)),
            w0, w2);
    xnorm_old = Vxnrm1(nx, ny, nz, w0);
    if (*iok != 0) {
        xnorm_den = rsden;
    } else {
        xnorm_den = xnorm_old;
    }



    /*********************************************************************
     *** begin the loop
     *********************************************************************/

    // Setup for the looping
    VMESSAGE0("Damping enabled");
    idamp  = 1;
    *iters  = 0;

    //30
    while(1) {

        (*iters)++;

        // Save iterate if stop test will use it on next iter
        if (*istop == 2) {
            Vxcopy(nx, ny, nz,
                    RAT(x, VAT2(iz, 1, lev)), RAT(tru, VAT2(iz, 1, lev)));
        }

        // Compute the current jacobian system and rhs
        ipkey = VAT(ipc, 10);
        Vgetjac(nx, ny, nz, nlev_real, iz, ilev, &ipkey,
                x, w0, cprime, rhs, cc, pc);

        // Determine number of correct digits in current residual
        // Algorithm 5.3 in the thesis, test version (1')
        // Global-superlinear convergence
        bigc = 1.0;
        ord  = 2.0;

        /* NAB 06-18-01:  If complex problems are not converging, set this to
         * machine epsilon.  This makes it use the exact jacobian rather than
         * the appropriate form (as here)
         */
         errtol_s  = VMIN2((0.9 * xnorm_old), (bigc * VPOW(xnorm_old, ord)));
         VMESSAGE1("Using errtol_s: %f", errtol_s);

        // Do a linear multigrid solve of the newton equations
        Vazeros(nx, ny, nz, RAT(xtmp, VAT2(iz, 1, lev)));

        itmax_s   = 1000;
        istop_s   = 0;
        iters_s   = 0;
        ierror_s  = 0;

        // NAB 06-18-01 -- What this used to be:
        iok_s     = 0;
        iinfo_s   = 0;
        if ((*iinfo >= 2) && (*ilev == 1))
            iok_s = 2;

        // What it's changed to:
        if (*iinfo >= 2)
            iinfo_s = *iinfo;
        iok_s = 2;

        // End of NAB hack.

        Vmvcs(nx, ny, nz,
                xtmp, iz,
                w0, w1, w2, w3,
                &istop_s, &itmax_s, &iters_s, &ierror_s,
                nlev, ilev, nlev_real, mgsolv,
                &iok_s, &iinfo_s,
                epsiln, &errtol_s, omega,
                nu1, nu2, mgsmoo,
                ipc, rpc, pc, ac, cprime, rhs, tru);

        /**************************************************************
         *** note: rhs and cprime are now available as temp vectors ***
         **************************************************************/

        // If damping is still enabled -- doit
        if (idamp == 1) {

            // Try the correction
            Vxcopy(nx, ny, nz,
                    RAT(x, VAT2(iz, 1, lev)), w1);
            damp = 1.0;
            Vxaxpy(nx, ny, nz, &damp, RAT(xtmp, VAT2(iz, 1, lev)), w1);

            Vnmresid(nx, ny, nz,
                    RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                    RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                    RAT( fc, VAT2(iz, 1, lev)),
                    w1, w0,
                    RAT(rhs, VAT2(iz, 1, lev)));
            xnorm_new = Vxnrm1(nx, ny, nz, w0);

            // Damping is still enabled -- doit
            damp    = 1.0;
            iter_d  = 0;
            itmax_d = 10;
            mode    = 0;

            VMESSAGE1("Attempting damping, relres = %f", xnorm_new / xnorm_den);

            while(iter_d < itmax_d) {
                if (mode == 0) {
                    if (xnorm_new < xnorm_old) {
                        mode = 1;
                    }
                } else if (xnorm_new > xnorm_med) {
                        break;
                }

                // Keep old soln and residual around, and its norm
                Vxcopy(nx, ny, nz, w1, w2);
                Vxcopy(nx, ny, nz, w0, w3);
                xnorm_med = xnorm_new;

                // New damped correction, residual, and its norm
                Vxcopy(nx, ny, nz,
                        RAT(x, VAT2(iz, 1, lev)), w1);
                damp = damp / 2.0;
                Vxaxpy(nx, ny, nz, &damp, RAT(xtmp, VAT2(iz, 1, lev)), w1);

                Vnmresid(nx, ny, nz,
                        RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                        RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                        RAT( fc, VAT2(iz, 1, lev)),
                        w1, w0,
                        RAT(rhs, VAT2(iz, 1, lev)));
                xnorm_new = Vxnrm1(nx, ny, nz, w0);

               // Next iter...
               iter_d = iter_d + 1;
               VMESSAGE1("Attempting damping, relres = %f",
                   xnorm_new / xnorm_den);

            }

            Vxcopy(nx, ny, nz, w2, RAT(x, VAT2(iz, 1, lev)));
            Vxcopy(nx, ny, nz, w3, w0);
            xnorm_new = xnorm_med;
            xnorm_old = xnorm_new;

            VMESSAGE1("Damping accepted, relres = %f", xnorm_new / xnorm_den);

            // Determine whether or not to disable damping
            if ((iter_d - 1) == 0) {
                VMESSAGE0("Damping disabled");
               idamp = 0;
            }
         } else {

            // Damping is disabled -- accept the newton step
            damp = 1.0;

            Vxaxpy(nx, ny, nz, &damp,
                    RAT(xtmp, VAT2(iz, 1, lev)), RAT(x, VAT2(iz, 1, lev)));

            Vnmresid(nx, ny, nz,
                    RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                    RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                    RAT( fc, VAT2(iz, 1, lev)), RAT(  x, VAT2(iz, 1, lev)),
                    w0,
                    RAT(rhs, VAT2(iz, 1, lev)));

            xnorm_new = Vxnrm1(nx, ny, nz, w0);
            xnorm_old = xnorm_new;
         }

         // Compute/check the current stopping test ***
         if (iok != 0) {

             orsnrm = rsnrm;

             if (*istop == 0) {
                rsnrm = xnorm_new;
             } else if (*istop == 1) {
                rsnrm = xnorm_new;
            } else if (*istop == 2) {
               Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
               alpha = -1.0;
               Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
               rsnrm = Vxnrm1(nx, ny, nz, w1);
            } else if (*istop == 3) {
               Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
               alpha = -1.0;
               Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
               rsnrm = Vxnrm2(nx, ny, nz, w1);
            } else if (*istop == 4) {
               Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
               alpha = -1.0;
               Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
               rsnrm = Vxnrm2(nx, ny, nz, w1);
            } else if (*istop == 5) {
               Vxcopy(nx, ny, nz, RAT(tru, VAT2(iz, 1, lev)), w1);
               alpha = -1.0;
               Vxaxpy(nx, ny, nz, &alpha, RAT(x, VAT2(iz, 1, lev)), w1);
               Vnmatvec(nx, ny, nz,
                       RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                       RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)),
                       w1, w2, w3);
               rsnrm = VSQRT(Vxdot(nx, ny, nz, w1, w2));
            } else {
                VABORT_MSG1("Bad istop value: %d", *istop);
            }

             Vprtstp(*iok, *iters, rsnrm, rsden, orsnrm);

            if ((rsnrm/rsden) <= *errtol)
                break;
        }

        // Check iteration count ***
        if (*iters >= *itmax)
            break;
    }

    // Condition estimate of final jacobian
    if (*iinfo > 2) {

        Vnm_print(2, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
        Vnm_print(2, "% Vnewton: JACOBIAN ANALYSIS ==> (%d, %d, %d)\n",
                *nx, *ny, *nz );

        // Largest eigenvalue of the jacobian matrix
        Vnm_print(2, "% Vnewton: Power calculating rho(JAC)\n");
        itmax_p   = 1000;
        errtol_p  = 1.0e-4;
        iters_p   = 0;
        iinfo_p   = *iinfo;

        Vpower(nx, ny, nz,
                iz, ilev,
                ipc, rpc, ac, cprime,
                w0, w1, w2, w3,
                &rho_max, &rho_max_mod,
                &errtol_p, &itmax_p, &iters_p, &iinfo_p);

        Vnm_print(2, "% Vnewton: power iters   = %d\n", iters_p);
        Vnm_print(2, "% Vnewton: power eigmax  = %d\n", rho_max);
        Vnm_print(2, "% Vnewton: power (MODEL) = %d\n", rho_max_mod);

        // Smallest eigenvalue of the system matrix A ***
        Vnm_print(2, "% Vnewton: ipower calculating lambda_min(JAC)...\n");
        itmax_p   = 1000;
        errtol_p  = 1.0e-4;
        iters_p   = 0;
        iinfo_p   = *iinfo;

        Vazeros(nx, ny, nz, xtmp);

        Vipower(nx, ny, nz,
                xtmp, iz,
                w0, w1, w2, w3,
                rhs, &rho_min, &rho_min_mod,
                &errtol_p, &itmax_p, &iters_p,
                nlev, ilev, nlev_real, mgsolv,
                &iok_p, &iinfo_p,
                epsiln, errtol, omega,
                nu1, nu2, mgsmoo,
                ipc, rpc,
                pc, ac, cprime, tru);

        Vnm_print(2, "% Vnewton: ipower iters   = %d\n", iters_p);
        Vnm_print(2, "% Vnewton: ipower eigmin  = %d\n", rho_min);
        Vnm_print(2, "% Vnewton: ipower (MODEL) = %d\n", rho_min_mod);

        // Condition number estimate
        Vnm_print(2, "% Vnewton: condition number  = %f\n",
                (double)rho_max / rho_min);
        Vnm_print(2, "% Vnewton: condition (MODEL) = %f\n",
                (double)rho_max_mod / rho_min_mod);
        Vnm_print(2, "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n");
    }
}
コード例 #2
0
ファイル: powerd.c プロジェクト: Chauamtran/apbs-pdb2pqr
VPUBLIC void Vpower(int *nx, int *ny, int *nz,
        int *iz, int *ilev,
        int *ipc, double *rpc, double *ac, double *cc,
        double *w1, double *w2, double *w3, double *w4,
        double *eigmax, double *eigmax_model, double *tol,
        int *itmax, int *iters, int *iinfo) {

    int lev, level;
    double denom, fac, rho, oldrho, error, relerr;

    /// @todo  Just use a constant definition of PI here
    double pi = 4.0 * atan( 1.0 );

    // Utility variables
    int skipIters = 0;
    double alpha;

    MAT2(iz, 50, 1);

    WARN_UNTESTED;

    // Recover level information
    level = 1;
    lev   = (*ilev - 1) + level;

    // Seed vector: random to contain all components

    Vaxrand(nx, ny, nz, w1);

    Vazeros(nx, ny, nz, w2);
    Vazeros(nx, ny, nz, w3);
    Vazeros(nx, ny, nz, w4);

    // Compute raleigh quotient with the seed vector
    denom = Vxnrm2(nx, ny, nz, w1);
    fac = 1.0 / denom;
    Vxscal(nx, ny, nz, &fac, w1);
    Vmatvec(nx, ny, nz,
            RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6,lev)),
             RAT(ac, VAT2(iz, 7, lev)),  RAT(cc, VAT2(iz, 1,lev)), w1, w2);
    oldrho = Vxdot(nx, ny, nz, w1, w2);

    // I/O
    if (oldrho == 0.0) {
        if (*iinfo > 3)  {
            Vnm_print(2, "POWER: iter: estimate = %d %g\n", *iters, oldrho);
        }
        rho = oldrho;
    } else {

        // Main iteration
        *iters = 0;
        while(1) {
            (*iters)++;

            // Apply the matrix A
            Vmatvec(nx, ny, nz,
                    RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                     RAT(ac, VAT2(iz, 7, lev)),  RAT(cc, VAT2(iz, 1, lev)), w1, w2);

            Vxcopy(nx, ny, nz, w2, w1);

            // Normalize the new vector
            denom = Vxnrm2(nx, ny, nz, w1);
            fac = 1.0 / denom;
            Vxscal(nx, ny, nz, &fac, w1);

            // Compute the new raleigh quotient
            Vmatvec(nx, ny, nz,
                    RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                    RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)), w1, w2);
            rho = Vxdot(nx, ny, nz, w1, w2);

            // Stopping test ***
            // w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x)

            Vxcopy(nx, ny, nz, w1, w3);
            Vxcopy(nx, ny, nz, w2, w4);
            Vxscal(nx, ny, nz, &rho, w3);
            alpha = -1.0;
            Vxaxpy(nx, ny, nz, &alpha, w3, w4);
            error = Vxnrm2(nx, ny, nz, w4);
            relerr = VABS(rho - oldrho ) / VABS( rho );

            // I/O
            if (*iinfo > 3) {

                Vnm_print(2, "POWER:  iters  =%d\n", *iters);
                Vnm_print(2, "        error  =%g\n", error);
                Vnm_print(2, "        relerr =%g\n", relerr);
                Vnm_print(2, "        rho    =%g\n", rho);
            }

            if( relerr < *tol || *iters == *itmax)
                break;

            oldrho = rho;
        }
    }

    // Return some stuff ***
    *eigmax = rho;
    fac = VPOW(2.0, *ilev - 1);
    *eigmax_model = fac * (6.0 - 2.0 * VCOS((*nx - 2) * pi / (*nx - 1))
                                     - 2.0 * VCOS((*ny - 2) * pi / (*ny - 1)));
}
コード例 #3
0
ファイル: powerd.c プロジェクト: Chauamtran/apbs-pdb2pqr
VPUBLIC void Vipower(int *nx,int *ny,int *nz,
        double *u, int *iz,
        double *w0, double *w1, double *w2, double *w3, double *w4,
        double *eigmin, double *eigmin_model, double *tol,
        int *itmax, int *iters,
        int *nlev, int *ilev, int *nlev_real, int *mgsolv,
        int *iok, int *iinfo, double *epsiln, double *errtol, double *omega,
        int *nu1, int *nu2, int *mgsmoo,
        int *ipc, double *rpc,
        double *pc, double *ac, double *cc, double *tru) {

    int level, lev;
    double denom, fac, rho, oldrho;
    double error, relerr, errtol_s;
    int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
    int nu1_s, nu2_s, mgsmoo_s;

    /// @todo  Just use a constant definition of PI here
    double pi = 4.0 * atan( 1.0 );

    // Utility variables
    double alpha;

    MAT2(iz, 50, 1);

    WARN_UNTESTED;

    // Recover level information
    level = 1;
    lev   = (*ilev - 1) + level;

    // Seed vector: random to contain all components
    Vaxrand(nx, ny, nz, w1);
    Vazeros(nx, ny, nz, w2);
    Vazeros(nx, ny, nz, w3);
    Vazeros(nx, ny, nz, w4);
    Vazeros(nx, ny, nz, RAT(w0, VAT2(iz, 1, lev)));
    Vazeros(nx, ny, nz, RAT( u, VAT2(iz, 1, lev)));

    // Compute raleigh quotient with the seed vector ***
    denom = Vxnrm2(nx, ny, nz, w1);
    fac = 1.0 / denom;
    Vxscal(nx, ny, nz, &fac, w1);
    Vmatvec(nx, ny, nz,
            RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
            RAT( ac, VAT2(iz, 7, lev)), RAT( cc, VAT2(iz, 1, lev)), w1, w2);
    oldrho = Vxdot(nx, ny, nz, w1, w2);

    // I/O
    if (oldrho == 0.0) {
           if (*iinfo > 3) {
               Vnm_print(2, "Vipower: iters=%d\n",    *iters);
               Vnm_print(2, "         estimate=%f\n", oldrho);
        }
       rho = oldrho;
    } else {

        //main iteration
        *iters = 0;
        while (1) {
               (*iters)++;

            // Apply the matrix A^{-1} (using MG solver)
               itmax_s = 100;
               iters_s = 0;
               ierror_s = 0;
               iok_s = 0;
               iinfo_s = 0;
               istop_s = 0;
            mgsmoo_s = 1;
            nu1_s = 1;
            nu2_s = 1;
            errtol_s = *epsiln;

            Vxcopy(nx, ny, nz, w1, RAT(w0, VAT2(iz, 1,lev)));
            Vmvcs(nx, ny, nz, u, iz,
                    w1, w2, w3, w4,
                    &istop_s, &itmax_s, &iters_s, &ierror_s,
                    nlev, ilev, nlev_real, mgsolv,
                    &iok_s, &iinfo_s, epsiln,
                    &errtol_s, omega, &nu1_s, &nu2_s, &mgsmoo_s,
                    ipc, rpc, pc, ac, cc, w0, tru);
            Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w1);

            // Normalize the new vector
            denom = Vxnrm2(nx, ny, nz, w1);
            fac = 1.0 / denom;
            Vxscal(nx, ny, nz, &fac, w1);

            // Compute the new raleigh quotient
            Vmatvec(nx, ny, nz,
                    RAT(ipc, VAT2(iz, 5, lev)), RAT(rpc, VAT2(iz, 6, lev)),
                     RAT(ac, VAT2(iz, 7,lev)),   RAT(cc, VAT2(iz, 1, lev)), w1, w2);
            rho = Vxdot(nx, ny, nz, w1, w2);

            // Stopping test
            // w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x) ***
            Vxcopy(nx, ny, nz, w1, w3);
            Vxcopy(nx, ny, nz, w2, w4);
            Vxscal(nx, ny, nz, &rho, w3);
            alpha = -1.0;
            Vxaxpy(nx, ny, nz, &alpha, w3, w4);
            error = Vxnrm2(nx, ny, nz, w4);
            relerr = VABS(rho - oldrho ) / VABS( rho );

            // I/O
            if (*iinfo > 3) {

                Vnm_print(2, "POWER:  iters  =%d\n", *iters);
                Vnm_print(2, "        error  =%g\n", error);
                Vnm_print(2, "        relerr =%g\n", relerr);
                Vnm_print(2, "        rho    =%g\n", rho);
            }

            if (relerr < *tol || *iters == *itmax)
                break;

            oldrho = rho;
        }
    }

    // Return some stuff
    *eigmin = rho;
    fac = VPOW(2.0, *ilev - 1);
    *eigmin_model = fac * (6.0 - 2.0 * VCOS(pi / (*nx - 1))
                               - 2.0 * VCOS(pi / (*ny - 1))
                               - 2.0 * VCOS(pi / (*nz - 1)));
}
コード例 #4
0
ファイル: powerd.c プロジェクト: Chauamtran/apbs-pdb2pqr
VEXTERNC void Vmpower(int *nx, int *ny, int *nz,
        double *u, int *iz,
        double *w0, double *w1, double *w2, double *w3, double *w4,
        double *eigmax, double *tol,
        int *itmax, int *iters, int *nlev, int *ilev, int *nlev_real,
        int *mgsolv, int *iok, int *iinfo,
        double *epsiln, double *errtol, double *omega,
        int *nu1, int *nu2, int *mgsmoo, int *ipc, double *rpc,
        double *pc, double *ac, double *cc, double *fc, double *tru) {

    // Local variables
    int lev, level;
    double denom, fac, rho, oldrho, error;
    double relerr;
    int itmax_s, iters_s, ierror_s, iok_s, iinfo_s, istop_s;
    double alpha;

    MAT2(iz, 50, 1);

    // Recover level information
    level = 1;
    lev   = (*ilev - 1) + level;

    // Seed vector: random to contain all components
    Vaxrand(nx, ny, nz, w1);
    Vazeros(nx, ny, nz, w2);
    Vazeros(nx, ny, nz, w3);
    Vazeros(nx, ny, nz, w4);
    Vazeros(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)));

    // NOTE: we destroy "fc" on this level due to lack of vectors... ***
    Vazeros(nx,ny,nz,RAT(fc, VAT2(iz, 1, lev)));

    // Normalize the seed vector
    denom = Vxnrm2(nx, ny, nz, w1);
    fac = 1.0 / denom;
    Vxscal(nx, ny, nz, &fac, w1);

    // Compute raleigh quotient with the seed vector
    Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
    itmax_s = 1;
    iters_s = 0;
    ierror_s = 0;
    iok_s = 0;
    iinfo_s = 0;
    istop_s = 1;
    Vmvcs(nx, ny, nz,
            u, iz, w0, w2, w3, w4,
            &istop_s, &itmax_s, &iters_s, &ierror_s,
            nlev, ilev, nlev_real, mgsolv,
            &iok_s, &iinfo_s,
            epsiln, errtol, omega, nu1, nu2, mgsmoo,
            ipc, rpc,
            pc, ac, cc, fc, tru);
    oldrho = Vxdot(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));

    // I/O
    if (oldrho == 0.0) {
       if (*iinfo > 3) {
           Vnm_print(2, "Vmp0ower: iter=%d, estimate=%f", *iters, oldrho);
       }
       rho = oldrho;

    } else {

        // Main iteration
        *iters = 0;
        while (1) {
            (*iters)++;

            // Apply the matrix M
           Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
           itmax_s = 1;
           iters_s = 0;
           ierror_s = 0;
           iok_s = 0;
           iinfo_s = 0;
           istop_s = 1;
           Vmvcs(nx, ny, nz,
                   u, iz, w1, w2, w3, w4,
                   &istop_s, &itmax_s, &iters_s, &ierror_s,
                   nlev, ilev, nlev_real, mgsolv,
                   &iok_s, &iinfo_s,
                   epsiln, errtol, omega, nu1, nu2, mgsmoo,
                   ipc, rpc,
                   pc, ac, cc, fc, tru);
           Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w1);

           // Normalize the new vector
           denom = Vxnrm2(nx, ny, nz, w1);
           fac = 1.0 / denom;
           Vxscal(nx, ny, nz, &fac, w1);

           // Compute the new raleigh quotient
           Vxcopy(nx, ny, nz, w1, RAT(u, VAT2(iz, 1, lev)));
           itmax_s = 1;
           iters_s = 0;
           ierror_s = 0;
           iok_s = 0;
           iinfo_s = 0;
           istop_s = 1;
           Vmvcs(nx, ny, nz,
                   u, iz, w0, w2, w3, w4,
                   &istop_s, &itmax_s, &iters_s, &ierror_s,
                   nlev, ilev, nlev_real, mgsolv,
                   &iok_s, &iinfo_s,
                   epsiln, errtol, omega, nu1, nu2, mgsmoo,
                   ipc, rpc,
                   pc, ac, cc, fc, tru);
           Vxcopy(nx, ny, nz, RAT(u, VAT2(iz, 1, lev)), w2);
           rho = Vxdot(nx, ny, nz, w1, w2);

           // Stopping test
           // w2=A*x, w1=x, stop = 2-norm(A*x-lamda*x)
           alpha = -1.0;
           Vxcopy(nx, ny, nz, w1, w3);
           Vxcopy(nx, ny, nz, w2, w4);
           Vxscal(nx, ny, nz, &rho, w3);
           Vxaxpy(nx, ny, nz, &alpha, w3, w4);
           error = Vxnrm2(nx, ny, nz, w4);
           relerr = VABS( rho - oldrho ) / VABS( rho );

           // I/O
           if (*iinfo > 3) {
               Vnm_print(2, "Vmpower: iter=%d; error=%f; relerr=%f; estimate=%f",
                       *iters, error, relerr, rho);
           }

           if ((relerr < *tol) || (*iters == *itmax)) {
               break;
           }

           oldrho = rho;
        }
    }

    *eigmax = rho;
}
コード例 #5
0
ファイル: cgd.c プロジェクト: Chauamtran/apbs-pdb2pqr
VPUBLIC void Vcghs(int *nx, int *ny, int *nz,
        int *ipc, double *rpc,
        double *ac, double *cc, double *fc,
        double *x, double *p, double *ap, double *r,
        int *itmax, int *iters,
        double *errtol, double *omega,
        int *iresid, int *iadjoint) {

    double rsnrm, pAp, denom;
    double rhok1, rhok2, alpha, beta;

    // Setup for the looping
    *iters = 0;

    if (*iters >= *itmax && *iresid == 0)
        return;

    Vmresid(nx, ny, nz, ipc, rpc, ac, cc, fc, x, r);
    denom = Vxnrm2(nx, ny, nz, r);

    if (denom == 0.0)
        return;

    if (*iters >= *itmax)
        return;

    while(1) {

        // Compute/check the current stopping test
       rhok2 = Vxdot(nx, ny, nz, r, r);
       rsnrm = VSQRT(rhok2);

       if (rsnrm / denom <= *errtol)
           break;

       if (*iters >= *itmax)
           break;

       // Form new direction vector from old one and residual
       if (*iters == 0) {
          Vxcopy(nx, ny, nz, r, p);
       } else {
          beta = rhok2 / rhok1;
          alpha = 1.0 / beta;
          Vxaxpy(nx, ny, nz, &alpha, r, p);
          Vxscal(nx, ny, nz, &beta, p);
       }

       // Linear case: alpha which minimizes energy norm of error
       Vmatvec(nx, ny, nz, ipc, rpc, ac, cc, p, ap);
       pAp = Vxdot(nx, ny, nz, p, ap);
       alpha = rhok2 / pAp;

       // Save rhok2 for next iteration
       rhok1 = rhok2;

       // Update solution in direction p of length alpha
       Vxaxpy(nx, ny, nz, &alpha, p, x);

       // Update residual
       alpha = -alpha;
       Vxaxpy(nx, ny, nz, &alpha, ap, r);

       // some bookkeeping
       (*iters)++;
    }
}