diff --git a/qpms/gaunt.c b/qpms/gaunt.c index 1d9fad1..1d9f360 100644 --- a/qpms/gaunt.c +++ b/qpms/gaunt.c @@ -169,11 +169,10 @@ double f_a2normr(int m, int n, int mu, int nu, double a1norm) { } // gaunt_xu from vec_trans.f90 -// btw, what is the difference from gaunt_xu2? // FIXME set some sensible return value -double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *error) { +double gaunt_xu(int m, int n, int mu, int nu, int qmax, double *v_aq, int *error) { - int v_zero[qmax] = {0}; + int v_zero[qmax] = {0}; // FIXME FAKT TO MÁ BÝT INITIALISOVÁNO NA 0???? KDYŽ SE TOMU NÍŽE PŘIŘAZUJÍ NULY??!!! *error = 0; if(abs(m)>n || abs(mu)=nu) { @@ -182,35 +181,65 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro return NAN; } - switch(qmax) { + switch(qmax) { //qmax_case case 0: v_aq[0] = f_a0(m,n,mu,nu); break; case 1: v_aq[0] = f_a0(m,n,mu,nu); v_aq[1] = v_aq[0] + f_a1norm(m,n,mu,nu); + // controllo gli zeri + if (fabs(v_aq[1]/v_aq[0]) < ZERO_THRESHOLD) { + v_aq[1] = 0.; + v_zero[1] = 0; + } break; case 2: v_aq[0] = f_a0(m,n,mu,nu); + v_aq[1] = v_aq[0] + f_a1norm(m,n,mu,nu); + // controllo gli zeri + if (fabs(v_aq[1]/v_aq[0]) < ZERO_THRESHOLD) { + v_aq[1] = 0.; + v_zero[1] = 0; + } + v_aq[2] = v_aq[0] * f_a2normr(m,n,mu,nu,v_aq[1]/v_aq[0]); + // controllo gli zeri + if (fabs(v_aq[2]/v_aq[0]) < ZERO_THRESHOLD) { + v_aq[2] = 0.; + v_zero[2] = 0; + } break; default: - if (m == 0 && mu == 0) { + if (m == 0 && mu == 0) { // big_if v_aq[0] = f_a0(m,n,mu,nu); // backward recursion - for (int q = 1; q <= qmax; ++q) { + for (int q = 1; q <= qmax; ++q) { // uno_b_do int p = n + nu - 2*q; double c0 = f_alpha(n,nu,p+1); double c1 = f_alpha(n,nu,p+2); v_aq[q] = (c1/c0) * v_aq[q-1]; - } + + // Vedo se il q-esimo valore e' zero + if (v_zero[q-1] == 1) {// v_zero_if_1 + if(fabs(v_aq[q]/v_aq[q-1]) < ZERO_THRESHOLD) { // zg_if_1 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } else if (v_zero[q-1]==0 && v_zero[q-2]) { + if(fabs(v_aq[q]/v_aq[q-2]) < ZERO_THRESHOLD) {// zg_if1_1 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } //v_zero_if_1 + } //uno_b_do } else if (mu == m && nu == n) { v_aq[0] = f_a0(m,n,mu,nu); // backward recursion - for (int q = 1; q <= qmax; ++q) { + for (int q = 1; q <= qmax; ++q) { // due_b_do // calculate pre-coefficients int p = n + nu - 2*q; int p1 = p - m - mu; @@ -222,13 +251,33 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro //recursion v_aq[q] = (c1/c0) * v_aq[q-1]; - } + + // Vedo se il q-esimo valore e' zero + if (v_zero[q-1] == 1) {// v_zero_if_2 + if(fabs(v_aq[q]/v_aq[q-1]) < ZERO_THRESHOLD) { // zg_if_2 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } else if (v_zero[q-1]==0 && v_zero[q-2]) { + if(fabs(v_aq[q]/v_aq[q-2]) < ZERO_THRESHOLD) {// zg_if1_2 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } //v_zero_if_2 + } // due_b_do } else if (mu == -m) { + // Primo valore per la backward recursion v_aq[0] = f_a0(m,n,mu,nu); v_aq[1] = f_a1norm(m,n,mu,nu)*v_aq[0]; + // Controllo gli zeri + if (fabs(v_aq[1]/v_aq[0]) < ZERO_THRESHOLD) { //zg_if_3_0 + v_aq[1] = 0.; + v_zero[1] = 0; + } //zg_if_3_0 + // backward recursion - for (int q = 2; q <= qmaq; ++q) { + for (int q = 2; q <= qmax; ++q) { // tre_b_do // calculate pre-coefficient int p = n + nu - 2*q; @@ -239,7 +288,20 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro // recursion v_aq[q] = (c1/c0)*v_aq[q-1] + (c2/c0)*v_aq[q-2]; - } + + // Vedo se il q-esimo valore e' zero + if (v_zero[q-1] == 1) {// v_zero_if_3 + if(fabs(v_aq[q]/v_aq[q-1]) < ZERO_THRESHOLD) { // zg_if_3 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } else if (v_zero[q-1]==0 && v_zero[q-2]) { + if(fabs(v_aq[q]/v_aq[q-2]) < ZERO_THRESHOLD) {// zg_if1_3 + v_aq[q] = 0.; + v_zero[q] = 0; + } + } //v_zero_if_3 + } // tre_b_do // forward recursion // Primo valore per la forward recursion,errore relativo e suo swap @@ -247,13 +309,13 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro double res=fabs(aq_fwd-v_aq[qmax])/fabs(aq_fwd); //Se non ho precisione, sostituisco i valori - if (res>BF_PREC) { + if (res>BF_PREC) { //tre_f_if v_aq[qmax]=aq_fwd; int qi=1; int zeroswitch = 0; // black magic (gevero's "switch") //Entro nel ciclo della sostituzione valori for( int q=qmax-1,q>=0,--q) { // tre_f_do - switch(qmax-q) {// FIXME switch -> if/else + switch(qmax-q) {// tre_q_case // FIXME switch -> if/else case 1: {// q==qmax-1 //Calcolo v_aq[qmax-1] int p=n+nu-2*(q+2); @@ -261,47 +323,46 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro double c2=-f_alpha(n,nu,p+4) double aq_fwd=-(c1/c2)*v_aq[qmax]; - //If a secondo che v_aq[qmax-1] sia zero o no - if (aq_fwd/v_aq[max] if/else + + switch(v_zero[q]){ // z_3_2_case//FIXME switch -> if/else + case 0: + v_aq[q] = 0.; + break; case 1: //Il valore precedente e' zero res=fabs(aq_fwd-v_aq[q])/fabs(aq_fwd); break; - case 0: //Il valore precedente e' diverso da zero - //If a secondo che v_aq[q] sia zero o no - if ((aq_fwd/v_aq[q+1])=0; --i) { //Apmin_do + qi=1; //FIXME nepoužitá proměnná + + for (q = qmax; q >= 2; --q) { //Apmin_do: DO q=qmax,2,-1 + //Calcolo pre-coefficienti - int p=n+nu-2*REALq+2; + int p=n+nu-2*(q); int p1=p-m-mu; int p2=p+m+mu; double alphap1=f_alpha(n,nu,p+1); @@ -402,135 +558,381 @@ double gaunt_xu2(int m, int n, int mu, int nu, int qmax, double *v_aq, int *erro //Calcolo coefficienti ricorsione double c0=(p+2)*(p+3)*(p1+1)*(p1+2)*Ap4*alphap1; - double c1=Ap2*Ap3*Ap4+(p+1)*(p+3)*(p1+2)*(p2+2)*Ap4*alphap2+ \ + double c1=Ap2*Ap3*Ap4+(p+1)*(p+3)*(p1+2)*(p2+2)*Ap4*alphap2+ (p+2)*(p+4)*(p1+3)*(p2+3)*Ap2*alphap3; double c2=-(p+2)*(p+3)*(p2+3)*(p2+4)*Ap2*alphap4; //Ricorsione e residuo - double aq_fwd=-(c1/c2)*v_aq(q+1)+(c0/c2)*v_aq(q+2); - res=fabs(aq_fwd-v_aq[q])/fabs(aq_fwd); - if (resBF_PREC) { //gen_f_if //Se non ho precisione, sostituisco i valori - if (res > BF_PREC) { // gen_f_if + v_aq[qmax]=aq_fwd; - - int zeroswitch = 0; // black magic + + qi=qmax-1; //Entro nel ciclo della sostituzione valori - for (int q = qmax-1; q >= 0; --q) { //gen_f_do - switch(qmax-q) { //gen_q_case - case 1: //q=qmax-1 - //Calcolo aq - int p=n+nu-2*(q+2); - int p1=p-m-mu; - int p2=p+m+mu; - double alphap1=f_alpha(n,nu,p+1); - double alphap2=f_alpha(n,nu,p+2); - double alphap3=f_alpha(n,nu,p+3); - double alphap4=f_alpha(n,nu,p+4); - int Ap2=f_Ap(m,n,mu,nu,p+2); - int Ap3=f_Ap(m,n,mu,nu,p+3); - int Ap4=f_Ap(m,n,mu,nu,p+4); - double c1=Ap2*Ap3*Ap4+(p+1)*(p+3)*(p1+2)*(p2+2)*Ap4*alphap2+ \ - (p+2)*(p+4)*(p1+3)*(p2+3)*Ap2*alphap3; - double c2=-(p+2)*(p+3)*(p2+3)*(p2+4)*Ap2*alphap4; - double aq_fwd=-(c1/c2)*v_aq[qmax] //E' qui che lo calcolo + while(1) { // gen_f_do: DO - //If a secondo che v_aq(qmax-1) sia zero o no - if (aq_fwd/v_aq[qmax] < ZERO_THRESHOLD) { // gen_zero1_if - v_aq[q]=aq_fwd; //Zero - zeroswitch=1; - continue; // gen_f_do - } else - res=fabs(aq_fwd-v_aq[q])/fabs(aq_fwd); //Diverso da zero - break; - default: // Per tutti gli altri q - //Calcolo aq - int p=n+nu-2*(q+2); - int p1=p-m-mu; - int p2=p+m+mu; - double alphap1=f_alpha(n,nu,p+1); - double alphap2=f_alpha(n,nu,p+2); - double alphap3=f_alpha(n,nu,p+3); - double alphap4=f_alpha(n,nu,p+4); - int Ap2=f_Ap(m,n,mu,nu,p+2); - int Ap3=f_Ap(m,n,mu,nu,p+3); - int Ap4=f_Ap(m,n,mu,nu,p+4); - double c0=(p+2)*(p+3)*(p1+1)*(p1+2)*Ap4*alphap1; - double c1=Ap2*Ap3*Ap4+(p+1)*(p+3)*(p1+2)*(p2+2)*Ap4*alphap2+ \ - (p+2)*(p+4)*(p1+3)*(p2+3)*Ap2*alphap3; - double c2=-(p+2)*(p+3)*(p2+3)*(p2+4)*Ap2*alphap4; - double aq_fwd=-(c1/c2)*v_aq(q+1)+(c0/c2)*v_aq(q+2); + switch(qmax-qi) {//gen_q_case:SELECT CASE (qmax-qi) - //Case a seconda che il valore appena precedente sia zero o meno - switch (zeroswitch) { //gen_switch_case - case 1: //Il valore precedente e' zero - res=fabs(aq_fwd-v_aq[q])/fabs(aq_fwd); - break; - case 0: //Il valore precedente e' diverso da zero - //If a secondo che v_aq[q] sia zero o no - if (aq_fwd/v_aq[q+1] < ZERO_THRESHOLD/10.) {// gen_zero2_if - - v_aq[q]=aq_fwd; //Zero - switch=1 + //$$$$$$$$$$$$$$$$ + case 1: { //q=qmax-1 + //$$$$$$$$$$$$$$$$ + //Calcolo Ap4 per qi+2 per vedere quale schema usare + int p=n+nu-2*(qi+2); + int Ap4=f_Ap(m,n,mu,nu,p+4); + + //Scelgo la ricorrenza a seconda del valore di Ap4 + if (Ap4==0) { // Ap4_q1_if + + //Calcolo aq secondo la ricorrenza a 4 termini: uso qi+3 perche' il termine piu' alto e' + //maggiore di 3 unita' rispetto a qi, pur essendo nullo e non comparendo nella ricorsione + int p=n+nu-2*(qi+3); + int p1=p-m-mu; + int p2=p+m+mu; + double alphap5=f_alpha(n,nu,p+5); + double alphap6=f_alpha(n,nu,p+6); + int Ap2=f_Ap(m,n,mu,nu,p+2); + int Ap5=f_Ap(m,n,mu,nu,p+5); + int Ap6=f_Ap(m,n,mu,nu,p+6); + double c2=(p+2)*(p2+3)*Ap2*(Ap5*Ap6 + (p+4)*(p+6)*(p1+5)*(p2+5)*alphap5); + double c3=-(p+2)*(p+4)*(p+5)*(p2+3)*(p2+5)*(p2+6)*Ap2*alphap6; + aq_fwd=-(c2/c3)*v_aq[qi+1]; + + //A seconda che il mio valore sia 0 o meno confronto i valori + switch(v_zero[qi]){ //zAp41_case:SELECT CASE (v_zero[qi]) + case 0: + v_aq[qi]=0; + break; + case 1: + res=fabs(aq_fwd-v_aq[qi])/fabs(aq_fwd); + if (res0) { // qi_if + + qi=qi-1; + + switch(v_zero[qi]) { //zczq_case:SELECT CASE (v_zero[qi]) + case 0: + v_aq[qi]=0; + qi=qi-1; + continue; // CYCLE gen_f_do + break; + case 1: + gaunt_cz(m,n,mu,nu,qmax,&(v_aq_cz[qi]),error); + aq_fwd=v_aq_cz[qi]; + res=fabs(aq_fwd-v_aq[qi])/fabs(aq_fwd); + break; + default: + assert(0); + } + + } // qi_if + + //----------------- + } else { //Qui Ap4/=0 + //----------------- + + //Calcolo aq + int p=n+nu-2*(qi+2); + int p1=p-m-mu; + int p2=p+m+mu; + double alphap2=f_alpha(n,nu,p+2); + double alphap3=f_alpha(n,nu,p+3); + double alphap4=f_alpha(n,nu,p+4); + int Ap2=f_Ap(m,n,mu,nu,p+2); + int Ap3=f_Ap(m,n,mu,nu,p+3); + int Ap4=f_Ap(m,n,mu,nu,p+4); + double c0=(p+2)*(p+3)*(p1+1)*(p1+2)*Ap4*alphap1; + double c1=Ap2*Ap3*Ap4+(p+1)*(p+3)*(p1+2)*(p2+2)*Ap4*alphap2+ + (p+2)*(p+4)*(p1+3)*(p2+3)*Ap2*alphap3; + double c2=-(p+2)*(p+3)*(p2+3)*(p2+4)*Ap2*alphap4; + aq_fwd=(c0/c2)*v_aq[qi+2]-(c1/c2)*v_aq[qi+1]; //E' qui che lo calcolo + + //A seconda che il mio valore sia 0 o meno confronto i valori + switch(v_zero[qi]) { //zAp4dq_case:SELECT CASE (v_zero[qi]) + case 0: + v_aq[qi]=0; + qi=qi-1; + continue; // gen_f_do + break; + case 1: + res=fabs(aq_fwd-v_aq[qi])/fabs(aq_fwd); + break; + default: + assert(0); + } + + } // Ap4_qq_if + } // default + } // END SELECT gen_q_case //Adesso se la precisione e' raggiunta esco dal ciclo, se no sostituisco e rimango - if ((res