#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  break.c break.h no_break.c no_break.h
# Wrapped by karin@borodin on Wed Jul 24 21:38:09 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'break.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'break.c'\"
else
echo shar: Extracting \"'break.c'\" \(27147 characters\)
sed "s/^X//" >'break.c' <<'END_OF_FILE'
X/*----------------------------------------------------------------------
X    break.c         procedures for break-down and break-up bifurcations     
X------------------------------------------------------------------------*/
X
X#include <strings.h>
X#include <stdio.h>
X#include <math.h>
X#include <malloc.h>
X
X#include "macros.h"
X#include "matalloc.h"
X#include "matutil.h"
X#include "mattrans.h"
X
X#include "group.h"
X#include "tree.h"
X#include "general.h"
X#include "continuation.h"
X#include "gauss_newton.h"
X
X#include "break.h"
X
X#define RHO             0.5
X#define RHO_DETECT      0.1
X#define ALPHA_MAX       0.9
X#define ALPHA_MIN       0.1
X#define INTERPOL_MAX    5
X
Xstatic Branch *b_bif, *b_up;
Xstatic Point *p_up;
Xstatic REAL *x, *t, *u, r, s;
X
Xstatic int i_break, mi, ni;
Xstatic BOOLEAN old;
X
Xstatic Group *sigma1, *sigma0;
Xstatic REAL *pt, *qt, *pu, *qu, *qy, *py, *y, *ty, *x_temp;
Xstatic REAL *y_temp, *test, *y_sym, *ty_sym, *u_temp;
X
Xstatic REAL **a_test;
X
Xvoid init_break()
X{
X    y               = dvector(1, n);
X    ty = test       = dvector(1, n);
X    py = pu         = dvector(1, n);
X    qy = qu         = dvector(1, n);
X    pt = y_sym      = dvector(1, n);
X    qt = ty_sym     = dvector(1, n);
X    x_temp = y_temp = dvector(1, n);
X    u_temp          = dvector(1, n);
X    
X    a_test          = dmatrix(1, n, 1, n);
X}
X
Xvoid quit_break()
X{
X    free_dvector(y, 1, n);
X    free_dvector(test, 1, n);
X    free_dvector(pu, 1, n);
X    free_dvector(qu, 1, n);
X    free_dvector(pt, 1, n);
X    free_dvector(qt, 1, n);
X    free_dvector(x_temp, 1, n);
X}
X
X/*----------------------------------------------------------------------
X    function used in numeric mode      
X------------------------------------------------------------------------*/
X
Xvoid aiut(u, b)
X    REAL *u, *b;
X{
X    sigma->transform(u,y);
X    update_jacobian(y);
X    sigma->iso_transform[i_break](u-mi, ty);	/* dirty trick !! */
X    mat_vec_mult(dfy, ty, y, m, m);
X    sigma->inv_iso_transform[i_break](y, b);    
X}
X
X/*----------------------------------------------------------------------
X    functions for augmented system for break down bifurcations      
X------------------------------------------------------------------------*/
X
Xstatic void h(x, b)
X    REAL *x, *b;
X{
X    REAL *u = x+mi, *t = x, *gu = b+mi+1;
X    
X    sigma->dg[i_break](u, a_help);
X    mat_vec_mult(a_help, t, b, mi, mi);
X    b[mi+1] = squared_norm(t, 1, mi) - 1;
X    g(u, gu);
X}
X        
Xstatic BOOLEAN h_jac(x)
X    REAL *x;
X{
X    REAL  *u = x+mi, *t = x,
X            **c   = dsubmatrix(a, 1, mi, mi+1, ni, 1, 1),
X            **ai  = dsubmatrix(a, 1, mi, 1, mi, 1, 1),
X            **dgu = dsubmatrix(a, mi+2, ni, mi+1, ni, 1, 1);
X    int i, j;
X    
X    for (j=1; j<=mi; j++) a[mi+1][j] = 2 * t[j];
X    for (j=mi+1; j<=ni; j++) a[mi+1][j] = 0;
X    for (i=mi+2; i<=ni; i++) {
X        for (j=1; j<=mi; j++) a[i][j] = 0;
X    }
X    sigma->dg[i_break](u, ai);
X    sigma->cg[i_break](u, t, c);
X    dg(u, dgu);
X    
X    free_dsubmatrix(c, 1, mi, 1, nu);
X    free_dsubmatrix(ai, 1, mi, 1, mi);
X    free_dsubmatrix(dgu, 1, mu, 1, nu);
X    
X    copy_dmatrix(a_test, a, 1, ni, 1, ni);
X    
X    return qr_jac(x, ni, ni);
X}   
X
Xstatic BOOLEAN h_solve(b, x)
X    REAL *x, *b;
X{
X    REAL temp;
X    BOOLEAN return_code;
X    return_code = qr_solve(b, x, ni, ni);
X    mat_vec_mult(a_test, x, test, ni, ni);
X    temp = distance(test, b, 1, ni);
X    
X    return return_code;
X}
X 
X/*----------------------------------------------------------------------
X    detection of break-down bifurcations of type i_break
X        (sets i_break if a break-down bifurcation was detected)     
X------------------------------------------------------------------------*/
X
X/*  extern Group *ID;       */
X
XBOOLEAN detect_break_down()
X{
X    Point *p = p_act, *q = p->next;
X    int i, found = FALSE;
X    
X    REAL cond;
X    int k;
X
X    if (p->sym_det != nil && q->sym_det != nil) {
X        for (i=2; i<=sigma->s; i++) {
X            if (p->sym_det[i] * q->sym_det[i] < 0) {
X                i_break = i;
X                if (found) {
X                    sprintf(str, "more than one break-down detected");
X                    warning(str);
X                    i_break = 0;
X/*
X                    sigma->transform(p->u, y_temp);
X                    ID->inv_transform(y_temp, u_temp);
X                    ID->dg[1](u_temp, a);
X                    k = m;
X                    cond = 10e2;
X                    householder(a, d, &cond, pivot, m, n, &k, &signum);
X                    sprintf(str, "numerical rank of complete jacobian = %d", k);
X                    message(str);
X*/
X                }
X                found = TRUE;
X            }
X        }
X    }
X/*
X    caution: the following 15 lines were just copied from detect_break_up
X*/
X    if (found && i_break != 0) {
X        sigma1 = sigma;
X        sigma0 = sigma->subgroup[i_break][1];
X        p_up = p_act;
X        b_up = b_act;
X        while (!sigma1->implemented || !sigma0->implemented) {
X            sigma1  = p_up->op->group(sigma1);
X            i_break = p_up->op->isotypic(i_break);
X            sigma0  = p_up->op->group(sigma0);
X            p_up = p_up->sym_next;
X            b_up = b_up->sym_next;
X        }
X        change_group(sigma1);
X        p_act=p_up;
X        b_act=b_up;
X    }
X    if (found) {
X        sprintf(str, "break down bifurcation detected, group = %s, i_break = %d",
X                    sigma->label, i_break);
X        message(str);
X    }
X    return found;
X}
X
Xstatic BOOLEAN detect_old_break_down(sigma, p, b_first, b_bif, u, i, sym)
X    Group *sigma;
X    Point *p;
X    Branch *b_first, **b_bif;
X    REAL *u;
X    int i;
X    BOOLEAN sym;
X{
X    Branch *b;
X    REAL beta_min = 0, beta, dist, dist_min = r;
X    int found = FALSE, nu;
X    
X    nu = sigma->m[1] + 1;
X    for (b = b_first; b != nil;) {
X        if (b->group == sigma && b->type == BREAK_DOWN &&
X                b->point->next == nil && b->i_break == i) {
X            dist = squared_distance(b->point->u, u, 1, nu);
X            if (dist < dist_min) {
X                beta = product(b->point->tu, p->tu, 1, nu);
X                if (beta < beta_min) {
X                    found = TRUE;
X                    beta_min = beta;
X                    dist_min = dist;
X                    *b_bif = b;
X                }
X            }
X            else if (found && dist == dist_min) {
X                beta = product(b->point->tu, p->tu, 1, nu);
X                if (beta < beta_min) {
X                    beta_min = beta;
X                    *b_bif = b;
X                }
X            }
X        }
X        b = (sym) ? b->sym_next : b->next;
X        if (b==b_first) break;
X    }
X    return found;
X}
X    
Xstatic void handle_old_break_down(p, b_bif, u, i)
X    Point *p;
X    Branch *b_bif;
X    REAL *u;
X    int i;
X{
X    Branch *b_sym, *b, *b_sym_list;
X    Point *q_sym, *p_sym;
X    Group *sigma_sym;
X    Op *op; 
X    int nu, i_sym;
X    
X    sigma_sym = b_bif->group;
X    
X    nu  = sigma_sym->m[1]  + 1;
X
X    p_sym = p;
X    q_sym = p->next;
X    b_sym = b_sym_list = b_bif;
X    i_sym = i;
X    
X    do {
X        free_point(p_sym->next);
X        q_sym = p_sym->next = q_sym->sym_next = b_sym->point;
X        turn_dvector(q_sym->tu, 1, nu);
X        q_sym->s = 0;
X        q_sym->op = p_sym->op;       
X        delete_branch(b_sym, &cont_list);
X        delete_sym_branch(b_sym, &b_sym_list);
X        
X        op = p_sym->op;     
X        p_sym = p_sym->sym_next;
X        if (p_sym!=p) {
X            sigma_sym->transform(u, y);
X            sigma_sym   = op->group(sigma_sym);
X            i_sym       = op->isotypic(i_sym);
X            op->proc(y, y_temp);
X            sigma_sym->inv_transform(y_temp, u);
X            if (!detect_old_break_down(sigma_sym, p_sym, b_sym_list, &b_sym,
X                        u, op->isotypic(i), YES)) {
X                fatal_error("detect_old_break_down failed in handle_old_break_down\n");
X                break;
X            }
X        }       
X    } while (p_sym != p);
X}
X
Xvoid new_sym_branches(q, b)
X    Point *q;
X    Branch *b;
X{
X    Branch *b_sym;
X    Point *q_sym;
X    Group *sigma, *sigma1;
X    Op *op;
X    REAL *sym_det, *sym_sc;
X    int nu, i;
X
X    sigma = b->group;
X    sigma1 = (b->type == BREAK_UP) ? b->supergroup : sigma;
X    nu = sigma->m[1] + 1;
X    q->op = sigma->op;
X    for (q_sym=q, b_sym=b, op=q->op; op->next!=nil; op=op->next) {
X        sigma->transform(q_sym->u, y_sym);
X        sigma->transform(q_sym->tu, ty_sym);
X        sigma   = op->group(sigma);
X        sigma1  = op->group(sigma1);
X                
X        sym_det = dvector(2, sigma->s);
X        sym_sc  = dvector(2, sigma->s);
X        for (i=2; i<=sigma->s; i++) {
X            sym_det[op->isotypic(i)] = q_sym->sym_det[i];
X            sym_sc[op->isotypic(i)]  = q_sym->sym_sc[i];
X        }
X        
X        q_sym = q_sym->sym_next = new_point();
X        q_sym->sym_next = q;        
X        q_sym->type     = q->type;
X        q_sym->para     = q->para;
X        q_sym->u        = dvector(1, nu);
X        q_sym->tu       = dvector(1, nu);
X        q_sym->sc       = q->sc;
X        q_sym->det      = q->det;
X        q_sym->sym_sc   = sym_sc;
X        q_sym->sym_det  = sym_det;
X        q_sym->s        = q->s;
X        q_sym->op       = op->next;     
X        
X        b_sym = b_sym->sym_next = new_branch();
X        b_sym->sym_next     = b;
X        b_sym->point        = q_sym;
X        b_sym->group        = sigma;
X        b_sym->supergroup   = sigma1;
X        b_sym->type         = b->type;
X        b_sym->i_break      = op->isotypic(b->i_break);
X        b_sym->op           = q_sym->op;
X
X        op->proc(y_sym, y_temp);
X        sigma->inv_transform(y_temp, q_sym->u);
X        op->proc(ty_sym, y_temp);
X        sigma->inv_transform(y_temp, q_sym->tu);
X
X        insert_branch(b_sym, &cont_list);   
X    }
X}
X
Xvoid old_sym_branches(sigma, p, q)
X    Group *sigma;
X    Point *p, *q;
X{
X    Point *p_sym, *q_sym;
X    Group *sigma_sym;
X    Op *op;
X    REAL *sym_det, *sym_sc;
X    int nu = sigma->m[1]+1, i;
X
X    for (p_sym=p, q_sym=q, sigma_sym=sigma; p_sym->sym_next != p;) {
X        sigma_sym->transform(q_sym->u, y_sym);
X        sigma_sym->transform(q_sym->tu, ty_sym);
X        op = p_sym->op;     
X        sigma_sym = op->group(sigma_sym);
X        
X        sym_det = dvector(2, sigma->s);
X        sym_sc  = dvector(2, sigma->s);
X        for (i=2; i<=sigma->s; i++) {
X            sym_det[op->isotypic(i)] = q_sym->sym_det[i];
X            sym_sc[op->isotypic(i)]  = q_sym->sym_sc[i];
X        }
X        
X        p_sym = p_sym->sym_next;
X        q_sym = q_sym->sym_next = new_point();
X        q_sym->sym_next = q;        
X        q_sym->type     = q->type;
X        q_sym->para     = q->para;
X        q_sym->u        = dvector(1, nu);
X        q_sym->tu       = dvector(1, nu);
X        q_sym->sc       = q->sc;
X        q_sym->det      = q->det;
X        q_sym->sym_sc   = sym_sc;
X        q_sym->sym_det  = sym_det;
X        q_sym->s        = q->s;
X        q_sym->op       = p_sym->op;
X                
X        op->proc(y_sym, y_temp);
X        sigma_sym->inv_transform(y_temp, q_sym->u);
X        op->proc(ty_sym, y_temp);
X        sigma_sym->inv_transform(y_temp, q_sym->tu);
X        p_sym->next = q_sym;
X    }
X}
X
Xstatic void create_symmetric_branches(p, break_up)
X    Point *p;
X    BOOLEAN break_up;
X{
X    Branch *b;
X    Point *q;
X    REAL *tu, *det, *sym_det, *sym_sc;
X    int i, para;
X    
X    tu      = dvector(1, nu);
X    det     = dvector(1, nu);
X
X    sym_det = dvector(2, sigma->s);
X    sym_sc  = dvector(2, sigma->s); 
X    
X    for (i=2; i<=sigma->s; i++) {
X        if (i!=i_break) {
X            sigma->dg[i](u, a);
X            det_sc(&sym_det[i] , &sym_sc[i], sigma->m[i]);
X        }
X    }
X    sym_det[i_break] = 0;
X    sym_sc[i_break]  = EPS_MACH;
X        
X    transform(u, y);
X    tangent(dg, u, tu, mu, nu, YES);
X    para = pivot[nu];
X    if (product(p->tu, tu, 1, nu) < 0)  turn_dvector(tu, 1, nu);
X    for (i=1; i<=nu; i++) det[i] = extended_det(a, d, pivot, mu, i, signum);
X    if (steplength_control) {
X        s = RHO * MAX(distance(p->u, u, 1, nu),
X                        distance(p->next->u, u, 1, nu));
X        s = MAX(s, steplength);
X    }
X    else s = steplength;
X        
X    q = new_point();
X    q->type     = BIFURCATION;
X    q->para     = para;
X    q->u        = u;
X    q->tu       = tu;
X    q->sc       = cond;
X    q->det      = det;
X    q->sym_det  = sym_det;
X    q->sym_sc   = sym_det;
X    q->op       = p->op;
X    
X    if (break_up) {
X        q->s = s;
X        b = new_branch();
X        b->point    = q;
X        b->group    = sigma;
X        b->type     = BREAK_DOWN;
X        b->i_break  = i_break;
X        b->op       = q->op;
X        insert_branch(b, &cont_list);   
X    }
X    else {
X        q->s = 0;
X        free_point(p->next);
X        p->next = q;
X    }
X    if (break_up)   new_sym_branches(q, b);
X    else    old_sym_branches(sigma, p, q);  
X    
X    q = new_point();        
X    q->type     = BIFURCATION;
X    q->para     = para;
X    q->u        = u;
X    q->tu       = dvector(1, nu);   copy_dvector(q->tu, tu, 1, nu);
X    q->s        = s;
X    q->sc       = cond;
X    q->det      = det;
X    q->sym_det  = sym_det;
X    q->sym_sc   = sym_det;
X    
X    b = new_branch();
X    b->point    = q;
X    b->group    = sigma;
X    b->type     = BREAK_DOWN;
X    b->i_break  = i_break;
X    insert_branch(b, &cont_list);   
X    new_sym_branches(q, b);
X    
X}   
X
Xstatic void create_break_branches(p)
X    Point *p;
X{
X    Branch *b;
X    Point *q;
X    Group *sigma0;
X    REAL *u0, *tu0, *sym_det, *sym_sc, temp;
X    int i, k, nu0, mu0;
X    
X    for (k=1; k<=sigma->nsub[i_break]; k++) {
X        sigma0 = sigma->subgroup[i_break][k];
X        mu0 = sigma0->m[1];
X        nu0 = mu0 + 1;
X        
X        tu0 = dvector(1, nu0);
X        u0  = dvector(1, nu0);
X        
X        sigma->tangent[i_break][k](t, tu0);
X        temp = norm(tu0, 1, nu0);
X        for (i=1; i<=nu0; i++) tu0[i] /= temp;
X        sigma0->inv_transform(y, u0);
X        
X        sym_det = dvector(2, sigma0->s);
X        sym_sc  = dvector(2, sigma0->s);    
X    
X        for (i=2; i<=sigma0->s; i++) {
X            sigma0->dg[i](u0, a);
X            det_sc(&sym_det[i] , &sym_sc[i], sigma0->m[i]);
X        }
X        
X        q = new_point();        
X        q->type     = BIFURCATION;
X        q->para     = p->para;
X        q->u        = u0;
X        q->tu       = tu0;
X        q->sym_sc   = sym_sc;
X        q->sym_det  = sym_det;
X        q->sc       = 0;
X        q->s        = s;
X        
X        b = new_branch();
X        b->point        = q;
X        b->group        = sigma0;
X        b->supergroup   = sigma;
X        b->type         = BREAK_UP;
X        insert_branch(b, &cont_list);   
X        new_sym_branches(q, b);
X    
X        if (!sigma->symmetric[i_break][k]) {
X            tu0 = dvector(1, nu0);
X            for (i=1; i<=nu0; i++)  tu0[i] = - q->tu[i];
X            sigma0->inv_transform(tu0, ty);
X        
X            q = new_point();        
X            q->type     = BIFURCATION;
X            q->para     = p->para;
X            q->u        = u0;
X            q->tu       = tu0;
X            q->sym_sc   = sym_sc;
X            q->sym_det  = sym_det;
X            q->sc       = 0;
X            q->s        = s;
X            
X            b = new_branch();
X            b->point        = q;
X            b->group        = sigma0;
X            b->supergroup   = sigma;
X            b->type         = BREAK_UP;
X            insert_branch(b, &cont_list);   
X            new_sym_branches(q, b);
X        }   
X    }
X}
X    
Xstatic void handle_new_break_down(p)
X    Point *p;
X{
X    create_symmetric_branches(p, NO); 
X    create_break_branches(p);   
X}
X
XBOOLEAN look_for_break_down(p)
X    Point *p;
X{   
X    Point *q = p->next;
X    REAL nc, snc, alpha;
X    REAL det_p, det_q, det_u, sc_p, sc_q, sc_u;
X    int i, k, errno, iter, found = FALSE;   
X    
X    if (i_break==0) return FALSE;       /* more than one break down detected */
X    
X    mi = sigma->m[i_break]; 
X    ni = mi + nu;   
X    
X    x = dvector(1, ni);
X    t = x;
X    u = x + mi;
X    
X    copy_dvector(pu, p->u, 1, nu);
X    copy_dvector(qu, q->u, 1, nu);
X    
X    det_p = p->sym_det[i_break];
X    det_q = q->sym_det[i_break];
X    sc_p = p->sym_sc[i_break];
X    sc_q = q->sym_sc[i_break];
X    
X    for (k=1; k<= INTERPOL_MAX && !found; k++) {
X        alpha = sc_q / (sc_p + sc_q);
X        alpha = MIN(alpha, ALPHA_MAX);
X        alpha = MAX(alpha, ALPHA_MIN);
X        for (i=1; i<=nu; i++) u[i] = alpha * qu[i] + (1 - alpha) * pu[i];
X        tangent(sigma->dg[i_break], u, t, mi-1, mi, YES);
X        copy_dvector(u_temp, u, 1, nu); 
X        if (!gn_first(h, h_jac, h_solve, x, nil, &nc, &snc, ni, ni, &errno)) {
X            message(gn_message[errno]);
X        }
X        else {
X            r = MAX(RHO_DETECT * MIN(1/nc, SQR(nc)/snc), nu * eps);
X            if (detect_old_break_down(sigma, p, cont_list, &b_bif, u_temp,
X                    i_break, NO)) {
X                message("old break down bifurcation found");
X                old = TRUE;
X                found = TRUE;
X            }
X            else if (!gn_second(h, h_jac, h_solve, x, nil, ni, ni, &errno, &iter)) {
X                message(gn_message[errno]);
X            }
X            else {
X                sprintf(str, "new break down bifurcation found after %d iterations", iter);
X                message(str);
X                found = TRUE;
X                r = 10 * nu * eps;
X                copy_dvector(u_temp, u, 1, nu); 
X                if (old = detect_old_break_down(sigma, p, cont_list, &b_bif,
X                        u_temp, i_break, NO)) {
X                    message(" ... but it was an old one");
X                }
X            }
X        }
X        if (!found) {
X            sigma->dg[i_break](u_temp, a);
X            det_sc(&det_u, &sc_u, mi);
X            if (det_u * det_p < 0) {
X                copy_dvector(qu, u_temp, 1, nu);
X                det_q = det_u;
X                sc_q = sc_u;
X            }
X            else {
X                copy_dvector(pu, u_temp, 1, nu);
X                det_p = det_u;
X                sc_p = sc_u;
X            }
X        }
X    }
X    if (!found) {
X        free_dvector(x, 1, ni);
X        sprintf(str, "no break down bifurcation found after %d trials", k);
X        message(str);
X    }
X    return found;
X}
X
Xvoid handle_break_down(p)
X    Point *p;
X{
X    if (old) handle_old_break_down(p, b_bif, u, i_break);
X    else     handle_new_break_down(p);
X}
X
X/*----------------------------------------------------------------------
X    detect break up bifurcation (sets sigma1 and alters pt, qt) 
X------------------------------------------------------------------------*/
X
XBOOLEAN detect_break_up()
X{
X    int i, j, k;
X    Point *p = p_act, *q = p->next;
X    BOOLEAN found = FALSE;
X    REAL rel, rel_max = 0.9;
X    
X    if (p->type != BIFURCATION) {
X        for (k=1; k<=sigma->r; k++) {
X            sigma->test[k](p->u, pt);
X            sigma->test[k](q->u, qt);
X            for (i=1, j=0; i<=sigma->ntest[k]; i++) {
X                if (pt[i] * qt[i] < SQRT_EPS_MACH) j++;
X            }
X            rel = (REAL) j / (REAL) sigma->ntest[k];
X            if (rel > rel_max) {
X                sigma1 = sigma->supergroup[k];
X                rel_max = rel;
X                found = TRUE;
X            }
X            else if (found && rel == rel_max) {
X                if (look_for_subgroup(sigma->supergroup[k], sigma1)) {
X                    sigma1 = sigma->supergroup[k];
X                }
X            }
X        }
X        if (found) {
X            sigma0 = sigma;
X            p_up = p_act;
X            b_up = b_act;
X            while (!sigma1->implemented || !sigma0->implemented) {
X                sigma1 = p_up->op->group(sigma1);
X                sigma0 = p_up->op->group(sigma0);
X                p_up = p_up->sym_next;
X                b_up = b_up->sym_next;
X            }
X        }
X    }
X    if (found) {
X        sprintf(str, "%s to %s break up bifurcation detected, rel_max = %.2lg",
X                    sigma->label, sigma1->label, rel_max);
X        message(str);
X    }
X    return found;
X}
X
Xstatic BOOLEAN subgroup(sigma, sigma0, i)
X    Group *sigma, *sigma0;
X    int i;
X{
X    int j;
X    for (j=1; j<=sigma->nsub[i]; j++) {
X        if (sigma->subgroup[i][j] == sigma0)    break;
X    }
X    return (j<=sigma->nsub[i]);
X}
X
Xstatic BOOLEAN detect_old_break_up(sigma1, sigma0, p, b_first, b_bif, u, sym)
X    Group *sigma1, *sigma0;
X    Point *p;
X    Branch *b_first, **b_bif;
X    REAL *u;
X    BOOLEAN sym;
X{
X    Branch *b;
X    REAL beta = 0, dist, dist_min = r, temp;
X    int nu1, nu0;
X    BOOLEAN found = FALSE;
X    
X    nu1 = sigma1->m[1] + 1;
X    nu0 = sigma0->m[1] + 1;
X    for (b = b_first; b != nil;) {
X        if (b->type == BREAK_UP && b->group == sigma0
X                && b->supergroup == sigma1 && b->point->next == nil) {
X            dist = squared_distance(b->point->u, u, 1, nu0);
X            if (dist < dist_min) {
X                found = TRUE;
X                dist_min = dist;
X                beta = product(b->point->tu, p->tu, 1, nu0);
X                *b_bif = b;
X            }
X            else if (found && dist == dist_min) {
X                temp = product(b->point->tu, p->tu, 1, nu0);
X                if (temp < beta) {
X                    beta = temp;
X                    *b_bif = b;
X                }
X            }
X        }
X        b = (sym) ? b->sym_next : b->next;
X        if (b==b_first) break;
X    }
X    return found;
X}
X
XBOOLEAN look_for_break_up()
X{
X    Point *p, *q;
X    REAL nc, snc, alpha, p_length, q_length, sc, sc_max = 0.0;
X    int i, j, k, errno, iter, ntest, jp, jq, nu0;
X    BOOLEAN found = FALSE;
X    
X    b_act = b_up;
X    p_act = p = p_up;
X    q = p->next;
X
X    nu0 = sigma0->m[1] + 1;
X    for (k=1; sigma0->supergroup[k]!=sigma1; k++);
X    ntest   = sigma->ntest[k];
X
X    change_group(sigma1);
X    
X    u = x = dvector(1, n);
X    sigma0->transform(p->u, py);
X    sigma0->transform(q->u, qy);
X        
X    sigma0->test[k](p->u, pt);
X    sigma0->test[k](q->u, qt);
X    p_length = norm(pt, 1, ntest);
X    q_length = norm(qt, 1, ntest);  
X/*
X *  initial guess for u by linear interpolation w.r.t norm of test-vector
X */
X    alpha = p_length / (q_length + p_length);
X    alpha = MIN(alpha, ALPHA_MAX);
X    alpha = MAX(alpha, ALPHA_MIN);
X    for (i=1; i<=n; i++) y[i] = alpha * qy[i] + (1 - alpha) * py[i];
X    inv_transform(y, u);
X/*
X *  check out what's the most probable isotypic compoment
X */
X    for (i=2; i<=sigma->s; i++) {
X        if (subgroup(sigma, sigma0, i)) {
X            sigma->dg[i](u, a);
X            j = mi = sigma->m[i];
X            sc = 1/EPS_MACH;
X            householder(a, d, &sc, pivot, mi, mi, &j, &signum);
X            if (sc > sc_max) {
X                i_break = i;
X                sc_max = sc;
X            }
X        }
X    }
X
X    mi = sigma->m[i_break]; 
X    ni = mi + nu;   
X    
X    t = x;
X    u = x + mi;
X
X    for (j=1; j<= INTERPOL_MAX && !found; j++) {
X        inv_transform(y, u);
X/*
X        if (!gauss_newton(g, g_jac, g_solve, u, nil, &nc, &snc,
X                    mu, nu, &errno, &iter)) {
X            warning("gauss_newton failed in look_for_break_up");
X            break;
X        }
X*/
X        tangent(sigma->dg[i_break], u, t, mi, mi, YES);
X        sigma0->inv_transform(y, u_temp);
X        if (!gn_first(h, h_jac, h_solve, x, nil, &nc, &snc, ni, ni, &errno)) {
X            message(gn_message[errno]);
X        }
X        else {
X            r = MAX(RHO_DETECT * MIN(1/nc, SQR(nc)/snc), nu * eps);
X            if (detect_old_break_up(sigma1, sigma0, p, cont_list, &b_bif,
X                    u_temp, NO)) {
X                message("old break-up bifurcation found");
X                old = TRUE;
X                found = TRUE;
X            }
X            else if (!gn_second(h, h_jac, h_solve, x, nil, ni, ni,
X                                                    &errno, &iter)) {
X                message(gn_message[errno]);
X            }
X            else {
X                sprintf(str, "new break-up bifurcation found after %d iterations", iter);
X                message(str);
X                found = TRUE;
X                r = nu0 * eps;
X                sigma0->inv_transform(y, u_temp);
X                if (old = detect_old_break_up(sigma1, sigma0, p, cont_list,
X                        &b_bif, u_temp, NO)) {
X                    message(" ... but it was an old one");
X                }
X            }
X        }   
X        if (!found) {
X            sigma0->test[k](u_temp, test);
X            for (i=1, jp=0; i<=ntest; i++) {
X                if (pt[i] * test[i] < 0)    jp++;
X            }
X            for (i=1, jq=0; i<=ntest; i++) {
X                if (qt[i] * test[i] < 0)    jq++;
X            }
X            if (jp > jq) {
X                copy_dvector(qy, y, 1, n);
X                copy_dvector(qt, test, 1, ntest);
X                q_length = norm(test, 1, ntest);
X            }
X            else {
X                copy_dvector(py, y, 1, n);
X                copy_dvector(pt, test, 1, ntest);
X                p_length = norm(test, 1, ntest);
X            }
X            alpha = p_length / (q_length + p_length);
X            alpha = MIN(alpha, ALPHA_MAX);
X            alpha = MAX(alpha, ALPHA_MIN);
X            for (i=1; i<=n; i++) y[i] = alpha * qy[i] + (1 - alpha) * py[i];
X        }
X    }
X    if (!found) {
X        free_dvector(x, 1, ni);
X        sprintf(str, "no break-up bifurcation found after %d trials", j);
X        message(str);
X    }
X    change_group(sigma0);   
X    return found;
X}
X
Xstatic void handle_old_break_up(p, b_bif, u)
X    Point *p;
X    Branch *b_bif;
X    REAL *u;
X{
X    Branch *b_sym, *b, *b_sym_list;
X    Point *q_sym, *p_sym;
X    Group *sigma1, *sigma0;
X    Op *op; 
X    int nu1, nu0;
X    
X    sigma1  = b_bif->supergroup;
X    sigma0  = b_bif->group;
X    
X    nu1 = sigma1->m[1] + 1;
X    nu0 = sigma0->m[1] + 1;
X
X    p_sym = p;
X    q_sym = p->next;
X    b_sym = b_sym_list = b_bif;
X    
X    do {
X        free_point(p_sym->next);
X        q_sym = p_sym->next = q_sym->sym_next = b_sym->point;
X        turn_dvector(q_sym->tu, 1, nu0);
X        q_sym->s = 0;
X        q_sym->op = p_sym->op;       
X        delete_branch(b_sym, &cont_list);
X        delete_sym_branch(b_sym, &b_sym_list);
X        
X        op = p_sym->op;     
X        p_sym = p_sym->sym_next;
X        if (p_sym!=p) {
X            sigma0->transform(u, y);
X            sigma1  = op->group(sigma1);
X            sigma0  = op->group(sigma0);
X            op->proc(y, y_temp);
X            sigma0->inv_transform(y_temp, u);
X            if (!detect_old_break_up(sigma1, sigma0, p_sym, b_sym_list, &b_sym,
X                u, YES)) {
X                fatal_error("detect_old_break_up failed in handle_old_break_up");
X                break;
X            }
X        }       
X    } while (p_sym != p);
X}
X
Xstatic void handle_new_break_up(p)
X    Point *p;
X{
X    change_group(sigma1);   
X    create_symmetric_branches(p, YES); 
X    create_break_branches(p);   
X    r = (sigma0->m[1]+1) * eps;
X    sigma0->inv_transform(y, u_temp);
X    if (!detect_old_break_up(sigma1, sigma0, p, cont_list,
X        &b_bif, u_temp, NO)) {
X        fatal_error("detect_old_break_up failed in handle_new_break_up");
X    }
X    else handle_old_break_up(p, b_bif, u_temp);
X    change_group(sigma0);
X}
X
Xvoid handle_break_up(p)
X    Point *p;
X{
X    if (old) handle_old_break_up(p, b_bif, u_temp);
X    else     handle_new_break_up(p);
X}
X        
X
END_OF_FILE
if test 27147 -ne `wc -c <'break.c'`; then
    echo shar: \"'break.c'\" unpacked with wrong size!
fi
# end of 'break.c'
fi
if test -f 'break.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'break.h'\"
else
echo shar: Extracting \"'break.h'\" \(552 characters\)
sed "s/^X//" >'break.h' <<'END_OF_FILE'
X/*----------------------------------------------------------------------
X	break_down.h	procedures for break down bifurcations		
X------------------------------------------------------------------------*/
X
Xextern void init_break();
Xextern void quit_break();
X
Xextern BOOLEAN detect_break_down();
Xextern BOOLEAN look_for_break_down();
Xextern void handle_break_down();
X
Xextern BOOLEAN detect_break_up();
Xextern BOOLEAN look_for_break_up();
Xextern void handle_break_up();
X
Xextern void old_sym_branches();
Xextern void new_sym_branches();
X
Xextern void aiut();
END_OF_FILE
if test 552 -ne `wc -c <'break.h'`; then
    echo shar: \"'break.h'\" unpacked with wrong size!
fi
# end of 'break.h'
fi
if test -f 'no_break.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'no_break.c'\"
else
echo shar: Extracting \"'no_break.c'\" \(15712 characters\)
sed "s/^X//" >'no_break.c' <<'END_OF_FILE'
X/*------------------------------------------------------------------------
X	no_break.c		procedures for no-break bifurcations		
X--------------------------------------------------------------------------*/
X
X#include <strings.h>
X#include <stdio.h>
X#include <math.h>
X#include <malloc.h>
X
X#include "macros.h"
X#include "matalloc.h"
X#include "matutil.h"
X#include "mattrans.h"
X
X#include "group.h"
X#include "tree.h"
X#include "general.h"
X#include "continuation.h"
X#include "gauss_newton.h"
X#include "break.h"
X
X#include "no_break.h"
X
X#define RHO				0.5
X#define RHO_DETECT		0.25
X#define ALPHA_MAX		0.9
X#define ALPHA_MIN		0.1
X#define INTERPOL_MAX	2
X#define TANGENT_MIN		0.1
X#define DETECT_FACTOR	0.5		/*	0.7		*/
X
Xstatic double **c, **c_help, **c11, **c12, **c22, **b;
Xstatic double *w, *h, *g1, *g2, *du, *dv, *dw;
Xstatic double *t_temp, *e;
X
Xstatic int n2, no_breaks = 0;
X
Xstatic Branch *b_bif;
Xstatic BOOLEAN old;
Xstatic double *x, *u, *z, *y, *tu[4];
Xstatic double *pu, *qu;
Xstatic double *y_sym, *ty_sym, *y_temp, r;
X
X/*--------------------------------------------------------------------------
X	allocation and deallocation		
X---------------------------------------------------------------------------*/
X
Xvoid init_no_break()
X{
X	int p = m-1;
X	
X	c11 = c = upper_dmatrix(1, n, 1, n);
X	c_help 	= upper_dmatrix(1, n, 1, n);
X	b 		= dmatrix(1, n-p, 1, p);
X	
X	w 		= dvector(1, m);
X	g1 		= dvector(1, n);
X	h 		= dvector(1, m);
X	du 		= dvector(1, n);
X	dw 		= dvector(1, m);
X
X	y_sym 	= pu = dvector(1, n);
X	ty_sym 	= qu = dvector(1, n);
X
X	t_temp  = y_temp = g1;
X}
X
Xvoid quit_no_break()
X{
X	int p = m - 1;
X
X	free_upper_dmatrix(c, 1, n, 1, n);
X	free_upper_dmatrix(c_help, 1, n, 1, n);
X	free_dmatrix(b, 1, n-p, 1, p);
X	
X	free_dvector(w, 1, m);
X	free_dvector(g1, 1, n);
X	free_dvector(h, 1, m);
X	free_dvector(du, 1, n);
X	free_dvector(dw, 1, m);
X	
X	free_dvector(pu, 1, n);
X	free_dvector(qu, 1, n);
X}
X
Xvoid begin_no_break(m, n)
X	int m, n;
X{
X	int p = m - 1;
X	
X	c12		= dsubmatrix(c, 1, p, p+1, n, 1, 1);
X	c22		= dsubmatrix(c, p+1, n, p+1, n, 1, 1);
X
X	g2 		= g1 + p;
X	dv		= du + p;
X	e 		= g1 + p;
X}
X
Xvoid end_no_break(m, n)
X	int m, n;
X{
X	int p = m - 1;
X
X	free_dsubmatrix(c12, 1, p, 1, 2);
X	free_dsubmatrix(c22, 1, 2, 1, 2);
X}
X	
X/*----------------------------------------------------------------------
X    function used in numeric mode (autt = A(u)^T*t)     
X------------------------------------------------------------------------*/
X
Xvoid autt(u, b)
X    REAL *u, *b;
X{
X    transform(u,y_temp);
X    update_jacobian(y_temp);
X    sigma->iso_transform[1](u+nu, ty_sym);			/* dirty trick !! */
X    mat_trans_vec_mult(dfy, ty_sym, y_temp, m, n);
X    sigma->inv_transform(y_temp, b);    
X}
X
X/*-------------------------------------------------------------------------
X	function for Moore's extended system for simple bifurcations		
X--------------------------------------------------------------------------*/
X
Xstatic void f_moore(x, fx)
X	double *x, *fx;
X{
X	double *y = x, *z = x+nu, alpha = x[n2];
X	double *fy = fx, *fz = fx+nu;
X	int i;
X	
X	dg(y, a_help);
X	mat_trans_vec_mult(a_help, z, fy, mu, nu);
X	g(y, fz);
X	for (i=1; i<=mu; i++) fz[i] += alpha * z[i];
X	fx[n2] = (squared_norm(z, 1, mu) - 1)/2;
X}
X
X/*-------------------------------------------------------------------------
X	Jacobian for Moore's extended system
X	
X	This procedure computes everything needed for a solution of a
X	linear system with the Jacobian matrix at x of Moore's system		
X--------------------------------------------------------------------------*/
X
Xstatic BOOLEAN jac_moore(x)
X	double *x;
X{
X	double *y = x, *z = x+nu, cond = 1/EPS_MACH, temp;
X	int p = mu-1, i, j, k, ip, jp;
X	BOOLEAN return_code = TRUE;
X	
X	dg(y, a);
X	if (mu==1) {
X		cg(y, z, c);
X	}
X	else {
X		householder(a, d, &cond, pivot, mu, nu, &p, &signum);
X		if (p<mu-1) return_code = FALSE;
X		else {
X			prepare_solution(a, v, l, d, mu, nu, p);
X/*
X *	C = PI^T * (f'(y) * z)' * PI
X */
X			cg(y, z, c_help);
X			for (i=1; i<=nu; i++) {
X				for (j=i; j<=nu; j++) {
X					ip = pivot[i];
X					jp = pivot[j];
X					c[i][j] = (ip <= jp) ? c_help[ip][jp] : c_help[jp][ip];
X				}
X			}
X/*
X *	B = C_12^T - V^T * C_11
X */
X			for (i=1; i<=2; i++) {
X				for (j=1; j<=p; j++) {
X					temp = c12[j][i];
X					for (k=1; k<=p; k++) {
X						temp -= v[k][i] * ((k<=j) ? c11[k][j] : c11[j][k]);
X					}
X					b[i][j] = temp;
X				}
X			}
X/*
X *	C_22 = C_22 - B * V - V^T * C_12
X */
X			for (i=1; i<=2; i++) {
X				for (j=i; j<=2; j++) {
X					temp = c22[i][j];
X					for (k=1; k<=p; k++) {
X						temp = temp - b[i][k] * v[k][j] - v[k][i] * c12[k][j];
X					}
X					c22[i][j] = temp;
X				}
X			}
X/*
X *	w = Q * z
X */	
X			q_vec_mult(a, d, z, w, mu, nu, p);
X		}
X	}
X	return return_code;
X}
X
X/*----------------------------------------------------------------------------
X 	solve linear system : f_moore(x)' * dx = r
X-----------------------------------------------------------------------------*/	
X
Xstatic BOOLEAN solve_moore(r, dx)
X	double *r, *dx;
X{
X	double *dy = dx, *dz = dx+nu, *ry = r, *rz = r+nu;
X	double d_alpha, r_alpha = r[n2], temp;
X	int i, j, k, p = mu-1;
X	BOOLEAN return_code = TRUE;		
X	
X	if (mu==1) {
X/*
X *	solve trivial system
X */
X		dz[1] = 0;
X		d_alpha = rz[1];
X		temp = c[1][1] * c[2][2] - SQR(c[1][2]);
X		if (temp != 0) {
X			dy[1] = (c[2][2] * a[1][1] - c[1][2] * a[1][2]) / temp;
X			dy[2] = (c[1][1] * a[1][2] - c[1][2] * a[1][1]) / temp;
X		}
X		else return_code = FALSE;
X	}
X	else {
X/*
X *	g1 = PI^T * ry,  h = Q * rz
X */
X		for (i=1; i<=nu; i++) g1[i] = ry[pivot[i]]; 
X		q_vec_mult(a, d, rz, h, mu, nu, p);
X		d_alpha = h[mu] / w[mu];
X/*
X *	h_1 = R^(-1) * (- h_1 + w_1 * d_alpha)
X */
X		for (i=1; i<=p; i++) 	h[i] = - h[i] + w[i] * d_alpha;
X		r_inv_vec_mult(a, d, h, h, p);
X/*
X *	g_2 = g_2 + B * h_1 - V^T * g_1
X */
X		for (i=1; i<=2; i++) {
X			temp = g2[i];
X			for (j=1; j<=p; j++) {
X				temp += b[i][j] * h[j] - v[j][i] * g1[j];
X			}
X			g2[i] = temp;
X		}
X/*
X *	dv = C_22^(-1) * g_2
X */		
X		temp = c22[1][1] * c22[2][2] - SQR(c22[1][2]);
X		if (fabs(temp) < EPS_MACH) {
X			return_code = FALSE;
X		}
X		else {			
X			dv[1] = (c22[2][2] * g2[1] - c22[1][2] * g2[2]) / temp;
X			dv[2] = (- c22[1][2] * g2[1] + c22[1][1] * g2[2]) / temp;
X/*
X *	du = - h_1 - V * dv
X */	
X			for (i=1; i<=p; i++) {
X				du[i] = - h[i] - v[i][1] * dv[1] - v[i][2] * dv[2];
X			}
X/*
X *	dw_1 = R^(-T) * (g_1 - C_11 * du - C_12 * dv)
X */	
X			for (i=1; i<=p; i++) {
X				temp = g1[i];
X				for (j=1; j<=p; j++) {
X					temp -= ((i<=j) ? c11[i][j] : c11[j][i]) * du[j];
X				}
X				dw[i] = temp - c12[i][1] * dv[1] - c12[i][2] * dv[2];
X			}
X			r_trans_inv_vec_mult(a, d, dw, dw, p);
X/*
X *	dw[mu] = (r_alpha - <w_1, dw_1>) / w[mu],  dy = PI * du,  dz = Q^T * dw
X */	
X			dw[mu] = (r_alpha - product(w, dw, 1, p)) / w[mu];
X			for (i=1; i<=nu; i++) 	dy[pivot[i]] = du[i];
X			q_trans_vec_mult(a, d, dw, dz, mu, nu, p);
X		}
X	}
X	dx[n2] = d_alpha;
X	return return_code;
X}
X
X/*----------------------------------------------------------------------------
X 	detection of simple bifurcations
X-----------------------------------------------------------------------------*/	
X
XBOOLEAN detect_no_break(p)
X	Point *p;
X{
X	Point *q = p->next;
X	double temp;
X	int i, changes = 0, relevant = 0, found = FALSE;
X	
X	if (p->det != nil && q->det != nil) {
X		for (i=1; i<=nu; i++) {
X			temp = p->det[i] * q->det[i];
X			if (fabs(temp) >  SQRT_EPS_MACH) {
X				relevant++;
X				if (temp < 0) 	changes++;
X			}
X		}
X		if (p->det[p->para] * q->det[p->para] < 0) {
X/*			found = p->det[q->para] * q->det[q->para] < 0 || changes > nu / 2; */
X			found = p->det[q->para] * q->det[q->para] < 0 &&
X						(double) changes / (double) relevant > DETECT_FACTOR;
X		}
X		else if (p->det[q->para] * q->det[q->para] < 0) {
X/*			found = p->det[p->para] * q->det[p->para] < 0 || changes > nu / 2; */
X			found = p->det[p->para] * q->det[p->para] < 0 &&
X						(double) changes / (double) relevant > DETECT_FACTOR;
X		}
X	}
X	if (found) {
X		sprintf(str, "symmetry preserving bifurcation detected, group = %s",
X					sigma->label);
X		message(str);
X	}
X	return found;
X}
X
X/*----------------------------------------------------------------------------
X
X-----------------------------------------------------------------------------*/
X
Xstatic BOOLEAN detect_old_no_break(sigma, p, b_first, b_bif, u, r, sym)
X	Group *sigma;
X	Point *p;
X	Branch *b_first, **b_bif;
X	double *u, r;
X	BOOLEAN sym;
X{
X	Branch *b;
X	double beta_min = - TANGENT_MIN, beta, dist, dist_min = r, temp;
X	int i, found = FALSE;
X	
X	for (b = b_first; b != nil; ) {
X		if (b->group == sigma && b->type == NO_BREAK &&
X				b->point->next == nil) {
X			dist = squared_distance(b->point->u, u, 1, nu);
X			if (dist < dist_min) {
X				beta = product(b->point->tu, p->tu, 1, nu);
X				if (beta < beta_min) {
X					found = TRUE;
X					beta_min = beta;
X					dist_min = dist;
X					*b_bif = b;
X				}
X			}
X			else if (found && dist == dist_min) {
X				beta = product(b->point->tu, p->tu, 1, nu);
X				if (beta < beta_min) {
X					beta_min = beta;
X					*b_bif = b;
X				}
X			}
X		}
X		b = (sym) ? b->sym_next : b->next;
X		if (b==b_first) break;
X	}
X	return found;
X}
X
X/*----------------------------------------------------------------------------
X 	compute tangents tu[0..3][1..nu] at x = (u, z, alpha)
X-----------------------------------------------------------------------------*/
X	
Xstatic BOOLEAN compute_tangents(point)
X	Point *point;
X{
X	double temp, help, a, a_11, a_22, *theta, *t_help;
X	int i, j, k, p = mu-1;
X	BOOLEAN return_code = TRUE;
X	
X	theta = dvector(1, 2);
X	
X	if (!jac_moore(x)) return_code = FALSE;
X	else {	
X		a 		= 2 * c22[1][2];
X		a_11 	= c22[1][1];
X		a_22 	= c22[2][2];			
X		temp = SQR(a) / 4 - a_11 * a_22;	
X		if (temp < EPS_MACH) return_code = FALSE;
X		else {
X			if (SQR(a_22) + SQR(a_11) < EPS_MACH) {
X				theta[1] = 0;
X				theta[2] = PI_HALF;
X			}
X			else if (fabs(a_22) > fabs(a_11)) {			
X				temp = sqrt(temp / SQR(a_22));
X				help = - a / (2 * a_22);
X				theta[1] = atan(help + temp);
X				theta[2] = atan(help - temp);
X			}		
X			else {	
X				temp = sqrt(temp / SQR(a_11));
X				help = - a / (2 * a_11);
X				theta[1] = atan(1 / (help + temp));
X				theta[2] = atan(1 / (help - temp));
X			}		
X			for (k=1; k<=2; k++) {	
X				tu[k] = dvector(1,nu);		
X				e[1] = cos(theta[k]);
X				e[2] = sin(theta[k]);	
X				if (mu!=1) {
X					mat_vec_mult(v, e, t_temp, p, 2);
X					for (i=1; i<=p; i++) t_temp[i] = - t_temp[i];
X					temp = norm(t_temp, 1, nu);
X					for (i=1; i<=nu; i++) tu[k][pivot[i]] = t_temp[i] / temp;
X				}
X				else {
X					for (i=1; i<=nu; i++) tu[k][i] = t_temp[i];		
X				}		
X				theta[k] = product(point->tu, tu[k], 1, nu);
X			}	
X			if (fabs(theta[2]) > fabs(theta[1])) {
X				SWAP(tu[1], tu[2], t_help);
X				theta[1] = theta[2];
X			}	
X			if (theta[1] < 0) {
X				for (i=1; i<=nu; i++) tu[1][i] = - tu[1][i];
X			}	
X			tu[0] = dvector(1,nu);
X			tu[3] = dvector(1,nu);
X			copy_dvector(tu[0], tu[1], 1, nu);
X			for (i=1; i<=nu; i++) tu[3][i] = - tu[2][i];
X		}
X	}
X	free_dvector(theta, 1, 2);	
X	return return_code;
X}
X
X/*----------------------------------------------------------------------------
X 	compute simple bifurcation by Moore's augmented system
X-----------------------------------------------------------------------------*/	
X
XBOOLEAN look_for_no_break(p)
X	Point *p;
X{	
X	Point *q = p->next;
X	double *x_temp, nc, snc, alpha;
X	double det_p, det_q, det_u, sc_p, sc_q, sc_u;
X	int i, k, pp = mu-1, errno, iter, found = FALSE, para = p->para;	
X	
X	n2 = nu+nu;
X	
X	x = dvector(1, n2);
X	x_temp = dvector(1, n2);
X	u = x;
X	z = x+nu;
X
X	copy_dvector(pu, p->u, 1, nu);
X	copy_dvector(qu, q->u, 1, nu);
X	
X/*
X * 	compute initial value x = (u, z, alpha) for Moore's iteration
X * 	u = convex linear interpolation w.r.t. det[para] of p->u and q->u
X */	
X	det_p = p->det[para];
X	det_q = q->det[para];
X	sc_p = p->sc;
X	sc_q = q->sc;
X	
X	for (k=1; k<= INTERPOL_MAX && !found; k++) {
X		alpha = sc_q / (sc_p + sc_q);
X		alpha = MIN(alpha, ALPHA_MAX);
X		alpha = MAX(alpha, ALPHA_MIN);
X		for (i=1; i<=nu; i++) u[i] = alpha * qu[i] + (1 - alpha) * pu[i];
X/*
X *	h = Q * g(u),  z = Q^T *(0,...,0,1)^T,  x[n2] = alpha = h[mu]
X */
X		g(u, h);
X		dg(u, a);
X		cond = 1/EPS_MACH;
X		pp = mu-1;
X		householder(a, d, &cond, pivot, mu, nu, &pp, &signum);
X		q_vec_mult(a, d, h, h, mu, nu, pp);
X		for (i=1; i<mu; i++) z[i] = 0;
X		z[mu] = 1;
X		q_trans_vec_mult(a, d, z, z, mu, nu, pp);
X		x[n2] = alpha = h[mu];
X		copy_dvector(x_temp, x, 1, n2);
X
X		if (!gn_first(f_moore, jac_moore, solve_moore, x, nil, &nc, &snc, n2, n2,
X				&errno)) {
X			message(gn_message[errno]);
X		}
X		else {
X			r = MAX(RHO_DETECT * MIN(1/nc, SQR(nc)/snc), nu * eps);
X			if (detect_old_no_break(sigma, p, cont_list, &b_bif, x, r, NO)) {
X				message("old no-break bifurcation found");
X				old = TRUE;
X				found = TRUE;
X			}
X			else 
X			if (!gn_second(f_moore, jac_moore, solve_moore, x, nil, n2, n2,
X					&errno, &iter)) {
X				message(gn_message[errno]);
X			}
X			else {
X				sprintf(str, "new no-break found after %d iterations", iter);
X				message(str);
X				if (fabs(x[n2]) > eps) {
X					sprintf(str, "perturbation alpha = %.3lg", x[n2]);
X					warning(str);
X				}
X				r = nu * eps;
X				if (old = detect_old_no_break(sigma, p, cont_list, &b_bif,
X												x, r, NO)) {
X					message(" ... but it was an old one");
X					found = TRUE;
X				}
X				else if (!(found = compute_tangents(p))) {
X					fatal_error("compute_tangents failed in look_for_no_break");
X				}
X			}
X		}
X		if (!found) {		
X			dg(x_temp, a);
X			sc_u = 1/EPS_MACH;
X			pp = mu;
X			householder(a, d, &sc_u, pivot, mu, nu, &pp, &signum);
X			det_u = extended_det(a, d, pivot, mu, para, signum);
X			if (det_u * det_p < 0) {
X				copy_dvector(qu, x_temp, 1, nu);
X				det_q = det_u;
X				sc_q = sc_u;
X			}
X			else {
X				copy_dvector(pu, x_temp, 1, nu);
X				det_p = det_u;
X				sc_p = sc_u;
X			}
X		}		
X	}	
X	free_dvector(x_temp, 1, n2);
X	if (!found) {
X		free_dvector(x, 1, n2);
X		sprintf(str, "no no-break found after %d trials", k);
X		message(str);
X	}
X	return found;
X}
X
Xstatic void handle_new_no_break(p)
X	Point *p;
X{
X	Branch *branch;
X	Point *q[4];
X	double s, *sym_det, *sym_sc;
X	int i;
X
X	sym_det = dvector(2, sigma->s);
X	sym_sc  = dvector(2, sigma->s);
X	
X	if (steplength_control) {
X		s = RHO * MAX(distance(p->u, u, 1, nu), distance(p->next->u, u, 1, nu));
X	}
X	else s = steplength;
X		
X	for (i=2; i<=sigma->s; i++) {
X		sigma->dg[i](u, a);
X		det_sc(&sym_det[i] , &sym_sc[i], sigma->m[i]);
X	}
X		
X	for (i=0; i<=3; i++) {
X		q[i] = new_point();		
X		q[i]->type 		= BIFURCATION;
X		q[i]->u 		= u;
X		q[i]->tu 		= tu[i];
X		q[i]->sym_det	= sym_det;
X		q[i]->sym_sc	= sym_det;
X	}
X	
X	free_point(p->next);
X	p->next = q[0];	
X	old_sym_branches(sigma, p, q[0]);	
X	
X	for (i=1; i<=3; i++) {
X		q[i]->s = s;
X		branch = new_branch();
X		branch->point = q[i];
X		branch->group 		= sigma;
X		branch->type		= NO_BREAK;
X		insert_branch(branch, &cont_list);	
X		new_sym_branches(q[i], branch);
X	}
X	no_breaks++;
X}
X
Xstatic void handle_old_no_break(p, b_bif, x)
X	Point *p;
X	Branch *b_bif;
X	double *x;
X{
X	Branch *b_sym, *b, *b_sym_list;
X	Point *q_sym, *p_sym;
X	Group *sigma;
X	Op *op;	
X	int nu;
X	
X	sigma 	= b_bif->group;
X	
X	nu 	= sigma->m[1]  + 1;
X
X	p_sym = p;
X	q_sym = p->next;
X	b_sym = b_sym_list = b_bif;
X	
X	do {
X		free_point(p_sym->next);
X		q_sym = p_sym->next = q_sym->sym_next = b_sym->point;
X		turn_dvector(q_sym->tu, 1, nu);
X		q_sym->s = 0;
X		q_sym->op = p_sym->op;		 
X		delete_branch(b_sym, &cont_list);
X		delete_sym_branch(b_sym, &b_sym_list);
X		
X		op = p_sym->op;		
X		p_sym = p_sym->sym_next;
X		if (p_sym!=p) {
X			sigma->transform(x, y_sym);
X			sigma = op->group(sigma);
X			op->proc(y_sym, y_temp);
X			sigma->inv_transform(y_temp, x);
X			if (!detect_old_no_break(sigma, p_sym, b_sym_list, &b_sym,
X										x, r, YES)) {
X				fatal_error("detect_old_no_break failed in handle_old_no_break");
X				break;
X			}
X		}		
X	} while (p_sym != p);
X}
X
Xvoid handle_no_break(p)
X	Point *p;
X{
X	if (old) handle_old_no_break(p, b_bif, x);
X	else handle_new_no_break(p);	
X}
X
X
X
X
END_OF_FILE
if test 15712 -ne `wc -c <'no_break.c'`; then
    echo shar: \"'no_break.c'\" unpacked with wrong size!
fi
# end of 'no_break.c'
fi
if test -f 'no_break.h' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'no_break.h'\"
else
echo shar: Extracting \"'no_break.h'\" \(445 characters\)
sed "s/^X//" >'no_break.h' <<'END_OF_FILE'
X/*----------------------------------------------------------------------
X	break_down.h	procedures for break down bifurcations		
X------------------------------------------------------------------------*/
X
Xextern BOOLEAN detect_no_break();
Xextern BOOLEAN look_for_no_break();
Xextern void handle_no_break();
X
Xextern void init_no_break();
Xextern void quit_no_break();
Xextern void begin_no_break();
Xextern void end_no_break();
X
Xextern void autt();
X
X
END_OF_FILE
if test 445 -ne `wc -c <'no_break.h'`; then
    echo shar: \"'no_break.h'\" unpacked with wrong size!
fi
# end of 'no_break.h'
fi
echo shar: End of shell archive.
exit 0

