/* mrs98.f -- translated by f2c (version 19980913). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static doublereal c_b29 = 10.; /* Subroutine */ int mrs98_(x, q, mode, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *q; integer *mode; doublereal *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal xmin = 1e-5; static doublereal xmax = 1.; static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; /* Format strings */ static char fmt_99[] = "(\002 WARNING: Q^2 VALUE IS OUT OF RANGE \ \002)"; /* static char fmt_98[] = "(\002 WARNING: X VALUE IS OUT OF RANGE \ \002)"; */ static char fmt_98[] = "(\002 \002)"; /* Builtin functions */ integer s_wsfe(), e_wsfe(); /* Local variables */ extern /* Subroutine */ int mrs981_(), mrs982_(), mrs983_(), mrs984_(), mrs985_(); static doublereal q2; /* Fortran I/O blocks */ static cilist io___6 = { 0, 6, 0, fmt_99, 0 }; static cilist io___7 = { 0, 6, 0, fmt_98, 0 }; /* ****************************************************************C */ /* C */ /* This is a package for the new MRS 1998 parton C */ /* distributions. The format is similar to the previous C */ /* (1996) MRS-R series. C */ /* C */ /* As before, x times the parton distribution is returned, C */ /* q is the scale in GeV, MSbar factorization is assumed, C */ /* and Lambda(MSbar,nf=4) is given below for each set. C */ /* C */ /* TEMPORARY NAMING SCHEME: C */ /* C */ /* mode set comment L(4)/MeV a_s(M_Z) grid#1 C */ /* ---- --- ------- -------- ------- ------ C */ /* C */ /* 1 FT08A central gluon, a_s 300 0.1175 0.00561 C */ /* 2 FT09A higher gluon 300 0.1175 0.00510 C */ /* 3 FT11A lower gluon 300 0.1175 0.00408 C */ /* 4 FT24A lower a_s 229 0.1125 0.00586 C */ /* 5 FT23A higher a_s 383 0.1225 0.00410 C */ /* C */ /* C */ /* The corresponding grid files are called ft08a.dat etc. C */ /* C */ /* The reference is: C */ /* A.D. Martin, R.G. Roberts, W.J. Stirling, R.S Thorne C */ /* Univ. Durham preprint DTP/98/??, hep-ph/??????? (1998) C */ /* C */ /* Comments to : W.J.Stirling@durham.ac.uk C */ /* C */ /* C */ /* ****************************************************************C */ q2 = *q * *q; if (q2 < qsqmin || q2 > qsqmax) { s_wsfe(&io___6); e_wsfe(); } if (*x < xmin || *x > xmax) { s_wsfe(&io___7); e_wsfe(); } if (*mode == 1) { mrs981_(x, &q2, upv, dnv, usea, dsea, str, chm, bot, glu); } else if (*mode == 2) { mrs982_(x, &q2, upv, dnv, usea, dsea, str, chm, bot, glu); } else if (*mode == 3) { mrs983_(x, &q2, upv, dnv, usea, dsea, str, chm, bot, glu); } else if (*mode == 4) { mrs984_(x, &q2, upv, dnv, usea, dsea, str, chm, bot, glu); } else if (*mode == 5) { mrs985_(x, &q2, upv, dnv, usea, dsea, str, chm, bot, glu); } return 0; } /* mrs98_ */ /* Subroutine */ int mrs981_(x, qsq, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *qsq, *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal xmin = 1e-5; static doublereal xmax = 1.; static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; static doublereal n0[8] = { 3.,4.,5.,9.,9.,9.,9.,9. }; static integer init = 0; static doublereal xx[49] = { 1e-5,2e-5,4e-5,6e-5,8e-5,1e-4,2e-4,4e-4,6e-4, 8e-4,.001,.002,.004,.006,.008,.01,.014,.02,.03,.04,.06,.08,.1, .125,.15,.175,.2,.225,.25,.275,.3,.325,.35,.375,.4,.425,.45,.475, .5,.525,.55,.575,.6,.65,.7,.75,.8,.9,1. }; static doublereal qq[37] = { 1.25,1.5,2.,2.5,3.2,4.,5.,6.4,8.,10.,12.,18., 26.,40.,64.,100.,160.,240.,400.,640.,1e3,1800.,3200.,5600.,1e4, 1.8e4,3.2e4,5.6e4,1e5,1.8e5,3.2e5,5.6e5,1e6,1.8e6,3.2e6,5.6e6,1e7 }; /* Format strings */ static char fmt_50[] = "(8f10.5)"; /* System generated locals */ doublereal d__1; olist o__1; /* Builtin functions */ integer f_open(), s_rsfe(), do_fio(), e_rsfe(); double pow_dd(), d_lg10(); /* Local variables */ static doublereal a, b, f[14896] /* was [8][49][38] */, g[8]; static integer i__, j, k, m, n; static doublereal xsave, q2save, fac, xxx; /* Fortran I/O blocks */ static cilist io___20 = { 0, 1, 0, fmt_50, 0 }; xsave = *x; q2save = *qsq; if (init != 0) { goto L10; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 9; o__1.ofnm = "ft08a.dat"; o__1.orl = 0; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); for (n = 1; n <= 48; ++n) { for (m = 1; m <= 37; ++m) { s_rsfe(&io___20); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 400], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 399], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 398], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 397], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 396], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 394], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 395], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 393], (ftnlen)sizeof( doublereal)); e_rsfe(); /* notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea */ for (i__ = 1; i__ <= 8; ++i__) { /* L25: */ d__1 = 1. - xx[n - 1]; f[i__ + (n + m * 49 << 3) - 401] /= pow_dd(&d__1, &n0[i__ - 1] ); } /* L20: */ } } for (j = 1; j <= 22; ++j) { d__1 = xx[j - 1] / xx[22]; xx[j - 1] = d_lg10(&d__1) + xx[22]; for (i__ = 1; i__ <= 8; ++i__) { if (i__ == 5 || i__ == 7) { goto L31; } for (k = 1; k <= 37; ++k) { /* L30: */ d__1 = f[i__ + (j + k * 49 << 3) - 401] / f[i__ + (k * 49 + 23 << 3) - 401]; f[i__ + (j + k * 49 << 3) - 401] = d_lg10(&d__1) + f[i__ + (k * 49 + 23 << 3) - 401]; } L31: ; } } for (i__ = 1; i__ <= 8; ++i__) { for (m = 1; m <= 37; ++m) { /* L40: */ f[i__ + (m * 49 + 49 << 3) - 401] = 0.; } } init = 1; L10: if (*x < xmin) { *x = xmin; } if (*x > xmax) { *x = xmax; } if (*qsq < qsqmin) { *qsq = qsqmin; } if (*qsq > qsqmax) { *qsq = qsqmax; } xxx = *x; if (*x < xx[22]) { d__1 = *x / xx[22]; xxx = d_lg10(&d__1) + xx[22]; } n = 0; L70: ++n; if (xxx > xx[n]) { goto L70; } a = (xxx - xx[n - 1]) / (xx[n] - xx[n - 1]); m = 0; L80: ++m; if (*qsq > qq[m]) { goto L80; } b = (*qsq - qq[m - 1]) / (qq[m] - qq[m - 1]); for (i__ = 1; i__ <= 8; ++i__) { g[i__ - 1] = (1. - a) * (1. - b) * f[i__ + (n + m * 49 << 3) - 401] + (1. - a) * b * f[i__ + (n + (m + 1) * 49 << 3) - 401] + a * ( 1. - b) * f[i__ + (n + 1 + m * 49 << 3) - 401] + a * b * f[ i__ + (n + 1 + (m + 1) * 49 << 3) - 401]; if (n >= 23) { goto L65; } if (i__ == 5 || i__ == 7) { goto L65; } fac = (1. - b) * f[i__ + (m * 49 + 23 << 3) - 401] + b * f[i__ + ((m + 1) * 49 + 23 << 3) - 401]; d__1 = g[i__ - 1] - fac; g[i__ - 1] = fac * pow_dd(&c_b29, &d__1); L65: d__1 = 1. - *x; g[i__ - 1] *= pow_dd(&d__1, &n0[i__ - 1]); /* L60: */ } *upv = g[0]; *dnv = g[1]; *usea = g[3]; *dsea = g[7]; *str = g[5]; *chm = g[4]; *glu = g[2]; *bot = g[6]; *x = xsave; *qsq = q2save; return 0; } /* mrs981_ */ /* Subroutine */ int mrs982_(x, qsq, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *qsq, *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal xx[49] = { 1e-5,2e-5,4e-5,6e-5,8e-5,1e-4,2e-4,4e-4,6e-4, 8e-4,.001,.002,.004,.006,.008,.01,.014,.02,.03,.04,.06,.08,.1, .125,.15,.175,.2,.225,.25,.275,.3,.325,.35,.375,.4,.425,.45,.475, .5,.525,.55,.575,.6,.65,.7,.75,.8,.9,1. }; static doublereal qq[37] = { 1.25,1.5,2.,2.5,3.2,4.,5.,6.4,8.,10.,12.,18., 26.,40.,64.,100.,160.,240.,400.,640.,1e3,1800.,3200.,5600.,1e4, 1.8e4,3.2e4,5.6e4,1e5,1.8e5,3.2e5,5.6e5,1e6,1.8e6,3.2e6,5.6e6,1e7 }; static doublereal xmin = 1e-5; static doublereal xmax = 1.; static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; static doublereal n0[8] = { 3.,4.,5.,9.,9.,9.,9.,9. }; static integer init = 0; /* Format strings */ static char fmt_50[] = "(8f10.5)"; /* System generated locals */ doublereal d__1; olist o__1; /* Builtin functions */ integer f_open(), s_rsfe(), do_fio(), e_rsfe(); double pow_dd(), d_lg10(); /* Local variables */ static doublereal a, b, f[14896] /* was [8][49][38] */, g[8]; static integer i__, j, k, m, n; static doublereal xsave, q2save, fac, xxx; /* Fortran I/O blocks */ static cilist io___42 = { 0, 1, 0, fmt_50, 0 }; xsave = *x; q2save = *qsq; if (init != 0) { goto L10; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 9; o__1.ofnm = "ft09a.dat"; o__1.orl = 0; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); for (n = 1; n <= 48; ++n) { for (m = 1; m <= 37; ++m) { s_rsfe(&io___42); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 400], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 399], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 398], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 397], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 396], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 394], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 395], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 393], (ftnlen)sizeof( doublereal)); e_rsfe(); /* notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea */ for (i__ = 1; i__ <= 8; ++i__) { /* L25: */ d__1 = 1. - xx[n - 1]; f[i__ + (n + m * 49 << 3) - 401] /= pow_dd(&d__1, &n0[i__ - 1] ); } /* L20: */ } } for (j = 1; j <= 22; ++j) { d__1 = xx[j - 1] / xx[22]; xx[j - 1] = d_lg10(&d__1) + xx[22]; for (i__ = 1; i__ <= 8; ++i__) { if (i__ == 5 || i__ == 7) { goto L31; } for (k = 1; k <= 37; ++k) { /* L30: */ d__1 = f[i__ + (j + k * 49 << 3) - 401] / f[i__ + (k * 49 + 23 << 3) - 401]; f[i__ + (j + k * 49 << 3) - 401] = d_lg10(&d__1) + f[i__ + (k * 49 + 23 << 3) - 401]; } L31: ; } } for (i__ = 1; i__ <= 8; ++i__) { for (m = 1; m <= 37; ++m) { /* L40: */ f[i__ + (m * 49 + 49 << 3) - 401] = 0.; } } init = 1; L10: if (*x < xmin) { *x = xmin; } if (*x > xmax) { *x = xmax; } if (*qsq < qsqmin) { *qsq = qsqmin; } if (*qsq > qsqmax) { *qsq = qsqmax; } xxx = *x; if (*x < xx[22]) { d__1 = *x / xx[22]; xxx = d_lg10(&d__1) + xx[22]; } n = 0; L70: ++n; if (xxx > xx[n]) { goto L70; } a = (xxx - xx[n - 1]) / (xx[n] - xx[n - 1]); m = 0; L80: ++m; if (*qsq > qq[m]) { goto L80; } b = (*qsq - qq[m - 1]) / (qq[m] - qq[m - 1]); for (i__ = 1; i__ <= 8; ++i__) { g[i__ - 1] = (1. - a) * (1. - b) * f[i__ + (n + m * 49 << 3) - 401] + (1. - a) * b * f[i__ + (n + (m + 1) * 49 << 3) - 401] + a * ( 1. - b) * f[i__ + (n + 1 + m * 49 << 3) - 401] + a * b * f[ i__ + (n + 1 + (m + 1) * 49 << 3) - 401]; if (n >= 23) { goto L65; } if (i__ == 5 || i__ == 7) { goto L65; } fac = (1. - b) * f[i__ + (m * 49 + 23 << 3) - 401] + b * f[i__ + ((m + 1) * 49 + 23 << 3) - 401]; d__1 = g[i__ - 1] - fac; g[i__ - 1] = fac * pow_dd(&c_b29, &d__1); L65: d__1 = 1. - *x; g[i__ - 1] *= pow_dd(&d__1, &n0[i__ - 1]); /* L60: */ } *upv = g[0]; *dnv = g[1]; *usea = g[3]; *dsea = g[7]; *str = g[5]; *chm = g[4]; *glu = g[2]; *bot = g[6]; *x = xsave; *qsq = q2save; return 0; } /* mrs982_ */ /* Subroutine */ int mrs983_(x, qsq, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *qsq, *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal xx[49] = { 1e-5,2e-5,4e-5,6e-5,8e-5,1e-4,2e-4,4e-4,6e-4, 8e-4,.001,.002,.004,.006,.008,.01,.014,.02,.03,.04,.06,.08,.1, .125,.15,.175,.2,.225,.25,.275,.3,.325,.35,.375,.4,.425,.45,.475, .5,.525,.55,.575,.6,.65,.7,.75,.8,.9,1. }; static doublereal qq[37] = { 1.25,1.5,2.,2.5,3.2,4.,5.,6.4,8.,10.,12.,18., 26.,40.,64.,100.,160.,240.,400.,640.,1e3,1800.,3200.,5600.,1e4, 1.8e4,3.2e4,5.6e4,1e5,1.8e5,3.2e5,5.6e5,1e6,1.8e6,3.2e6,5.6e6,1e7 }; static doublereal xmin = 1e-5; static doublereal xmax = 1.; static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; static doublereal n0[8] = { 3.,4.,5.,9.,9.,9.,9.,9. }; static integer init = 0; /* Format strings */ static char fmt_50[] = "(8f10.5)"; /* System generated locals */ doublereal d__1; olist o__1; /* Builtin functions */ integer f_open(), s_rsfe(), do_fio(), e_rsfe(); double pow_dd(), d_lg10(); /* Local variables */ static doublereal a, b, f[14896] /* was [8][49][38] */, g[8]; static integer i__, j, k, m, n; static doublereal xsave, q2save, fac, xxx; /* Fortran I/O blocks */ static cilist io___64 = { 0, 1, 0, fmt_50, 0 }; xsave = *x; q2save = *qsq; if (init != 0) { goto L10; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 9; o__1.ofnm = "ft11a.dat"; o__1.orl = 0; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); for (n = 1; n <= 48; ++n) { for (m = 1; m <= 37; ++m) { s_rsfe(&io___64); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 400], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 399], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 398], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 397], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 396], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 394], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 395], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 393], (ftnlen)sizeof( doublereal)); e_rsfe(); /* notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea */ for (i__ = 1; i__ <= 8; ++i__) { /* L25: */ d__1 = 1. - xx[n - 1]; f[i__ + (n + m * 49 << 3) - 401] /= pow_dd(&d__1, &n0[i__ - 1] ); } /* L20: */ } } for (j = 1; j <= 22; ++j) { d__1 = xx[j - 1] / xx[22]; xx[j - 1] = d_lg10(&d__1) + xx[22]; for (i__ = 1; i__ <= 8; ++i__) { if (i__ == 5 || i__ == 7) { goto L31; } for (k = 1; k <= 37; ++k) { /* L30: */ d__1 = f[i__ + (j + k * 49 << 3) - 401] / f[i__ + (k * 49 + 23 << 3) - 401]; f[i__ + (j + k * 49 << 3) - 401] = d_lg10(&d__1) + f[i__ + (k * 49 + 23 << 3) - 401]; } L31: ; } } for (i__ = 1; i__ <= 8; ++i__) { for (m = 1; m <= 37; ++m) { /* L40: */ f[i__ + (m * 49 + 49 << 3) - 401] = 0.; } } init = 1; L10: if (*x < xmin) { *x = xmin; } if (*x > xmax) { *x = xmax; } if (*qsq < qsqmin) { *qsq = qsqmin; } if (*qsq > qsqmax) { *qsq = qsqmax; } xxx = *x; if (*x < xx[22]) { d__1 = *x / xx[22]; xxx = d_lg10(&d__1) + xx[22]; } n = 0; L70: ++n; if (xxx > xx[n]) { goto L70; } a = (xxx - xx[n - 1]) / (xx[n] - xx[n - 1]); m = 0; L80: ++m; if (*qsq > qq[m]) { goto L80; } b = (*qsq - qq[m - 1]) / (qq[m] - qq[m - 1]); for (i__ = 1; i__ <= 8; ++i__) { g[i__ - 1] = (1. - a) * (1. - b) * f[i__ + (n + m * 49 << 3) - 401] + (1. - a) * b * f[i__ + (n + (m + 1) * 49 << 3) - 401] + a * ( 1. - b) * f[i__ + (n + 1 + m * 49 << 3) - 401] + a * b * f[ i__ + (n + 1 + (m + 1) * 49 << 3) - 401]; if (n >= 23) { goto L65; } if (i__ == 5 || i__ == 7) { goto L65; } fac = (1. - b) * f[i__ + (m * 49 + 23 << 3) - 401] + b * f[i__ + ((m + 1) * 49 + 23 << 3) - 401]; d__1 = g[i__ - 1] - fac; g[i__ - 1] = fac * pow_dd(&c_b29, &d__1); L65: d__1 = 1. - *x; g[i__ - 1] *= pow_dd(&d__1, &n0[i__ - 1]); /* L60: */ } *upv = g[0]; *dnv = g[1]; *usea = g[3]; *dsea = g[7]; *str = g[5]; *chm = g[4]; *glu = g[2]; *bot = g[6]; *x = xsave; *qsq = q2save; return 0; } /* mrs983_ */ /* Subroutine */ int mrs984_(x, qsq, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *qsq, *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal xx[49] = { 1e-5,2e-5,4e-5,6e-5,8e-5,1e-4,2e-4,4e-4,6e-4, 8e-4,.001,.002,.004,.006,.008,.01,.014,.02,.03,.04,.06,.08,.1, .125,.15,.175,.2,.225,.25,.275,.3,.325,.35,.375,.4,.425,.45,.475, .5,.525,.55,.575,.6,.65,.7,.75,.8,.9,1. }; static doublereal qq[37] = { 1.25,1.5,2.,2.5,3.2,4.,5.,6.4,8.,10.,12.,18., 26.,40.,64.,100.,160.,240.,400.,640.,1e3,1800.,3200.,5600.,1e4, 1.8e4,3.2e4,5.6e4,1e5,1.8e5,3.2e5,5.6e5,1e6,1.8e6,3.2e6,5.6e6,1e7 }; static doublereal xmin = 1e-5; static doublereal xmax = 1.; static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; static doublereal n0[8] = { 3.,4.,5.,9.,9.,9.,9.,9. }; static integer init = 0; /* Format strings */ static char fmt_50[] = "(8f10.5)"; /* System generated locals */ doublereal d__1; olist o__1; /* Builtin functions */ integer f_open(), s_rsfe(), do_fio(), e_rsfe(); double pow_dd(), d_lg10(); /* Local variables */ static doublereal a, b, f[14896] /* was [8][49][38] */, g[8]; static integer i__, j, k, m, n; static doublereal xsave, q2save, fac, xxx; /* Fortran I/O blocks */ static cilist io___86 = { 0, 1, 0, fmt_50, 0 }; xsave = *x; q2save = *qsq; if (init != 0) { goto L10; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 9; o__1.ofnm = "ft24a.dat"; o__1.orl = 0; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); for (n = 1; n <= 48; ++n) { for (m = 1; m <= 37; ++m) { s_rsfe(&io___86); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 400], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 399], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 398], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 397], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 396], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 394], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 395], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 393], (ftnlen)sizeof( doublereal)); e_rsfe(); /* notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea */ for (i__ = 1; i__ <= 8; ++i__) { /* L25: */ d__1 = 1. - xx[n - 1]; f[i__ + (n + m * 49 << 3) - 401] /= pow_dd(&d__1, &n0[i__ - 1] ); } /* L20: */ } } for (j = 1; j <= 22; ++j) { d__1 = xx[j - 1] / xx[22]; xx[j - 1] = d_lg10(&d__1) + xx[22]; for (i__ = 1; i__ <= 8; ++i__) { if (i__ == 5 || i__ == 7) { goto L31; } for (k = 1; k <= 37; ++k) { /* L30: */ d__1 = f[i__ + (j + k * 49 << 3) - 401] / f[i__ + (k * 49 + 23 << 3) - 401]; f[i__ + (j + k * 49 << 3) - 401] = d_lg10(&d__1) + f[i__ + (k * 49 + 23 << 3) - 401]; } L31: ; } } for (i__ = 1; i__ <= 8; ++i__) { for (m = 1; m <= 37; ++m) { /* L40: */ f[i__ + (m * 49 + 49 << 3) - 401] = 0.; } } init = 1; L10: if (*x < xmin) { *x = xmin; } if (*x > xmax) { *x = xmax; } if (*qsq < qsqmin) { *qsq = qsqmin; } if (*qsq > qsqmax) { *qsq = qsqmax; } xxx = *x; if (*x < xx[22]) { d__1 = *x / xx[22]; xxx = d_lg10(&d__1) + xx[22]; } n = 0; L70: ++n; if (xxx > xx[n]) { goto L70; } a = (xxx - xx[n - 1]) / (xx[n] - xx[n - 1]); m = 0; L80: ++m; if (*qsq > qq[m]) { goto L80; } b = (*qsq - qq[m - 1]) / (qq[m] - qq[m - 1]); for (i__ = 1; i__ <= 8; ++i__) { g[i__ - 1] = (1. - a) * (1. - b) * f[i__ + (n + m * 49 << 3) - 401] + (1. - a) * b * f[i__ + (n + (m + 1) * 49 << 3) - 401] + a * ( 1. - b) * f[i__ + (n + 1 + m * 49 << 3) - 401] + a * b * f[ i__ + (n + 1 + (m + 1) * 49 << 3) - 401]; if (n >= 23) { goto L65; } if (i__ == 5 || i__ == 7) { goto L65; } fac = (1. - b) * f[i__ + (m * 49 + 23 << 3) - 401] + b * f[i__ + ((m + 1) * 49 + 23 << 3) - 401]; d__1 = g[i__ - 1] - fac; g[i__ - 1] = fac * pow_dd(&c_b29, &d__1); L65: d__1 = 1. - *x; g[i__ - 1] *= pow_dd(&d__1, &n0[i__ - 1]); /* L60: */ } *upv = g[0]; *dnv = g[1]; *usea = g[3]; *dsea = g[7]; *str = g[5]; *chm = g[4]; *glu = g[2]; *bot = g[6]; *x = xsave; *qsq = q2save; return 0; } /* mrs984_ */ /* Subroutine */ int mrs985_(x, qsq, upv, dnv, usea, dsea, str, chm, bot, glu) doublereal *x, *qsq, *upv, *dnv, *usea, *dsea, *str, *chm, *bot, *glu; { /* Initialized data */ static doublereal qsqmin = 1.25; static doublereal qsqmax = 1e7; static doublereal n0[8] = { 3.,4.,5.,9.,9.,9.,9.,9. }; static integer init = 0; static doublereal xx[49] = { 1e-5,2e-5,4e-5,6e-5,8e-5,1e-4,2e-4,4e-4,6e-4, 8e-4,.001,.002,.004,.006,.008,.01,.014,.02,.03,.04,.06,.08,.1, .125,.15,.175,.2,.225,.25,.275,.3,.325,.35,.375,.4,.425,.45,.475, .5,.525,.55,.575,.6,.65,.7,.75,.8,.9,1. }; static doublereal qq[37] = { 1.25,1.5,2.,2.5,3.2,4.,5.,6.4,8.,10.,12.,18., 26.,40.,64.,100.,160.,240.,400.,640.,1e3,1800.,3200.,5600.,1e4, 1.8e4,3.2e4,5.6e4,1e5,1.8e5,3.2e5,5.6e5,1e6,1.8e6,3.2e6,5.6e6,1e7 }; static doublereal xmin = 1e-5; static doublereal xmax = 1.; /* Format strings */ static char fmt_50[] = "(8f10.5)"; /* System generated locals */ doublereal d__1; olist o__1; /* Builtin functions */ integer f_open(), s_rsfe(), do_fio(), e_rsfe(); double pow_dd(), d_lg10(); /* Local variables */ static doublereal a, b, f[14896] /* was [8][49][38] */, g[8]; static integer i__, j, k, m, n; static doublereal xsave, q2save, fac, xxx; /* Fortran I/O blocks */ static cilist io___108 = { 0, 1, 0, fmt_50, 0 }; xsave = *x; q2save = *qsq; if (init != 0) { goto L10; } o__1.oerr = 0; o__1.ounit = 1; o__1.ofnmlen = 9; o__1.ofnm = "ft23a.dat"; o__1.orl = 0; o__1.osta = "old"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); for (n = 1; n <= 48; ++n) { for (m = 1; m <= 37; ++m) { s_rsfe(&io___108); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 400], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 399], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 398], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 397], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 396], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 394], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 395], (ftnlen)sizeof( doublereal)); do_fio(&c__1, (char *)&f[(n + m * 49 << 3) - 393], (ftnlen)sizeof( doublereal)); e_rsfe(); /* notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea */ for (i__ = 1; i__ <= 8; ++i__) { /* L25: */ d__1 = 1. - xx[n - 1]; f[i__ + (n + m * 49 << 3) - 401] /= pow_dd(&d__1, &n0[i__ - 1] ); } /* L20: */ } } for (j = 1; j <= 22; ++j) { d__1 = xx[j - 1] / xx[22]; xx[j - 1] = d_lg10(&d__1) + xx[22]; for (i__ = 1; i__ <= 8; ++i__) { if (i__ == 5 || i__ == 7) { goto L31; } for (k = 1; k <= 37; ++k) { /* L30: */ d__1 = f[i__ + (j + k * 49 << 3) - 401] / f[i__ + (k * 49 + 23 << 3) - 401]; f[i__ + (j + k * 49 << 3) - 401] = d_lg10(&d__1) + f[i__ + (k * 49 + 23 << 3) - 401]; } L31: ; } } for (i__ = 1; i__ <= 8; ++i__) { for (m = 1; m <= 37; ++m) { /* L40: */ f[i__ + (m * 49 + 49 << 3) - 401] = 0.; } } init = 1; L10: if (*x < xmin) { *x = xmin; } if (*x > xmax) { *x = xmax; } if (*qsq < qsqmin) { *qsq = qsqmin; } if (*qsq > qsqmax) { *qsq = qsqmax; } xxx = *x; if (*x < xx[22]) { d__1 = *x / xx[22]; xxx = d_lg10(&d__1) + xx[22]; } n = 0; L70: ++n; if (xxx > xx[n]) { goto L70; } a = (xxx - xx[n - 1]) / (xx[n] - xx[n - 1]); m = 0; L80: ++m; if (*qsq > qq[m]) { goto L80; } b = (*qsq - qq[m - 1]) / (qq[m] - qq[m - 1]); for (i__ = 1; i__ <= 8; ++i__) { g[i__ - 1] = (1. - a) * (1. - b) * f[i__ + (n + m * 49 << 3) - 401] + (1. - a) * b * f[i__ + (n + (m + 1) * 49 << 3) - 401] + a * ( 1. - b) * f[i__ + (n + 1 + m * 49 << 3) - 401] + a * b * f[ i__ + (n + 1 + (m + 1) * 49 << 3) - 401]; if (n >= 23) { goto L65; } if (i__ == 5 || i__ == 7) { goto L65; } fac = (1. - b) * f[i__ + (m * 49 + 23 << 3) - 401] + b * f[i__ + ((m + 1) * 49 + 23 << 3) - 401]; d__1 = g[i__ - 1] - fac; g[i__ - 1] = fac * pow_dd(&c_b29, &d__1); L65: d__1 = 1. - *x; g[i__ - 1] *= pow_dd(&d__1, &n0[i__ - 1]); /* L60: */ } *upv = g[0]; *dnv = g[1]; *usea = g[3]; *dsea = g[7]; *str = g[5]; *chm = g[4]; *glu = g[2]; *bot = g[6]; *x = xsave; *qsq = q2save; return 0; } /* mrs985_ */