- Fix to AMOR s2t, wrong reading corrected
- Some problems at TASP with polarisation resolved
This commit is contained in:
cvs
95
t_update.c
95
t_update.c
@@ -5,30 +5,31 @@
|
||||
|
||||
#include "f2c.h"
|
||||
|
||||
/* Subroutine */ int t_update__(real *p_a__, real *p_ih__, real *c_ih__,
|
||||
logical *lpa, real *dm, real *da, integer *isa, real *helm, real *f1h,
|
||||
real *f1v, real *f2h, real *f2v, real *f, real *ei, real *aki, real *
|
||||
ef, real *akf, real *qhkl, real *en, real *hx, real *hy, real *hz,
|
||||
integer *if1, integer *if2, real *qm, integer *ier)
|
||||
/* Subroutine */ int t_update__(p_a__, p_ih__, c_ih__, lpa, dm, da, isa, helm,
|
||||
f1h, f1v, f2h, f2v, f, ei, aki, ef, akf, qhkl, en, hx, hy, hz, if1,
|
||||
if2, qm, ier)
|
||||
real *p_a__, *p_ih__, *c_ih__;
|
||||
logical *lpa;
|
||||
real *dm, *da;
|
||||
integer *isa;
|
||||
real *helm, *f1h, *f1v, *f2h, *f2v, *f, *ei, *aki, *ef, *akf, *qhkl, *en, *hx,
|
||||
*hy, *hz;
|
||||
integer *if1, *if2;
|
||||
real *qm;
|
||||
integer *ier;
|
||||
{
|
||||
static doublereal dakf, daki, dphi;
|
||||
static integer ieri, imod, ieru;
|
||||
extern /* Subroutine */ int ex_up__(doublereal *, doublereal *,
|
||||
doublereal *, doublereal *, doublereal *, integer *);
|
||||
extern /* Subroutine */ int ex_up__();
|
||||
static doublereal df;
|
||||
static integer id;
|
||||
static real qs;
|
||||
static doublereal dbqhkl[3];
|
||||
extern /* Subroutine */ int sam_up__(doublereal *, doublereal *,
|
||||
doublereal *, doublereal *, doublereal *, doublereal *,
|
||||
doublereal *, doublereal *, integer *);
|
||||
extern /* Subroutine */ int sam_up__();
|
||||
static doublereal da2, da3, da4, da6;
|
||||
extern /* Subroutine */ int erreso_(integer *, integer *);
|
||||
extern /* Subroutine */ int erreso_();
|
||||
static doublereal dda, def, dei, ddm, dqm, dhx, dhy, dhz, dqs;
|
||||
extern /* Subroutine */ int helm_up__(doublereal *, real *, real *, real *
|
||||
, doublereal *, doublereal *, doublereal *, integer *), flip_up__(
|
||||
integer *, integer *, real *, real *, real *, real *, real *,
|
||||
real *, real *, integer *);
|
||||
extern /* Subroutine */ int helm_up__(), flip_up__();
|
||||
|
||||
/* =================== */
|
||||
|
||||
@@ -193,14 +194,15 @@
|
||||
} /* t_update__ */
|
||||
|
||||
|
||||
/* Subroutine */ int ex_up__(doublereal *dx, doublereal *ex, doublereal *akx,
|
||||
doublereal *ax2, doublereal *f, integer *ier)
|
||||
/* Subroutine */ int ex_up__(dx, ex, akx, ax2, f, ier)
|
||||
doublereal *dx, *ex, *akx, *ax2, *f;
|
||||
integer *ier;
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal d__1;
|
||||
|
||||
/* Builtin functions */
|
||||
double sin(doublereal);
|
||||
double sin();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal arg;
|
||||
@@ -227,10 +229,7 @@
|
||||
/* !!!!!!!!!! This has to be fixed manually after conversion by f2c. */
|
||||
/* !!!!!!!!!! The reason is a different definition of the abs function. */
|
||||
/* !!!!!!!!!! MK, May 2001 */
|
||||
arg = *dx * sin(*ax2 / 114.59155902616465);
|
||||
if(arg < .0)
|
||||
arg = -arg;
|
||||
|
||||
arg = (d__1 = *dx * sin(*ax2 / 114.59155902616465), abs(d__1));
|
||||
if (arg <= 1e-4) {
|
||||
*ier = 1;
|
||||
} else {
|
||||
@@ -245,17 +244,16 @@
|
||||
} /* ex_up__ */
|
||||
|
||||
|
||||
/* Subroutine */ int sam_up__(doublereal *qhkl, doublereal *qm, doublereal *
|
||||
qs, doublereal *phi, doublereal *aki, doublereal *akf, doublereal *a3,
|
||||
doublereal *a4, integer *ier)
|
||||
/* Subroutine */ int sam_up__(qhkl, qm, qs, phi, aki, akf, a3, a4, ier)
|
||||
doublereal *qhkl, *qm, *qs, *phi, *aki, *akf, *a3, *a4;
|
||||
integer *ier;
|
||||
{
|
||||
/* Builtin functions */
|
||||
double cos(doublereal), sin(doublereal), atan2(doublereal, doublereal);
|
||||
double cos(), sin(), atan2();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal qpar, qperp;
|
||||
extern /* Subroutine */ int sp2rlv_(doublereal *, doublereal *,
|
||||
doublereal *, doublereal *, integer *);
|
||||
extern /* Subroutine */ int sp2rlv_();
|
||||
static doublereal qt[3];
|
||||
|
||||
/* ================= */
|
||||
@@ -302,7 +300,7 @@
|
||||
if (abs(qperp) > .001 && abs(qpar) > .001) {
|
||||
*phi = atan2(qperp, qpar);
|
||||
} else if (abs(qpar) < .001) {
|
||||
if (*a4 > 0.f) {
|
||||
if (*a4 > (float)0.) {
|
||||
*phi = -1.5707963267948966;
|
||||
} else {
|
||||
*phi = 1.5707963267948966;
|
||||
@@ -313,17 +311,18 @@
|
||||
} /* sam_up__ */
|
||||
|
||||
|
||||
/* Subroutine */ int helm_up__(doublereal *phi, real *helm, real *p_ih__,
|
||||
real *c_ih__, doublereal *dhx, doublereal *dhy, doublereal *dhz,
|
||||
integer *ier)
|
||||
/* Subroutine */ int helm_up__(phi, helm, p_ih__, c_ih__, dhx, dhy, dhz, ier)
|
||||
doublereal *phi;
|
||||
real *helm, *p_ih__, *c_ih__;
|
||||
doublereal *dhx, *dhy, *dhz;
|
||||
integer *ier;
|
||||
{
|
||||
/* System generated locals */
|
||||
real r__1;
|
||||
doublereal d__1, d__2;
|
||||
|
||||
/* Builtin functions */
|
||||
double sqrt(doublereal), atan2(doublereal, doublereal), cos(doublereal),
|
||||
sin(doublereal);
|
||||
double sqrt(), atan2(), cos(), sin();
|
||||
|
||||
/* Local variables */
|
||||
static doublereal hdir, hmod, hpar, hdir2, h__[4], hperp;
|
||||
@@ -421,21 +420,21 @@
|
||||
hdir2 += -3.1415926535897932384626433832795;
|
||||
}
|
||||
} else if (abs(hpar) > .001) {
|
||||
if (hpar >= 0.f) {
|
||||
hdir2 = 0.f;
|
||||
if (hpar >= (float)0.) {
|
||||
hdir2 = (float)0.;
|
||||
}
|
||||
if (hpar < 0.f) {
|
||||
if (hpar < (float)0.) {
|
||||
hdir2 = 3.1415926535897932384626433832795;
|
||||
}
|
||||
} else if (abs(hperp) > .001) {
|
||||
if (hperp >= 0.f) {
|
||||
if (hperp >= (float)0.) {
|
||||
hdir2 = 1.5707963267948966;
|
||||
}
|
||||
if (hperp < 0.f) {
|
||||
if (hperp < (float)0.) {
|
||||
hdir2 = -1.5707963267948966;
|
||||
}
|
||||
} else {
|
||||
hdir2 = 0.f;
|
||||
hdir2 = (float)0.;
|
||||
}
|
||||
hdir = hdir2 + *helm / 57.29577951308232087679815481410517 - *phi;
|
||||
*dhx = hmod * cos(hdir);
|
||||
@@ -445,9 +444,11 @@
|
||||
} /* helm_up__ */
|
||||
|
||||
|
||||
/* Subroutine */ int flip_up__(integer *if1, integer *if2, real *p_ih__, real
|
||||
*f1v, real *f1h, real *f2v, real *f2h, real *aki, real *akf, integer *
|
||||
ier)
|
||||
/* Subroutine */ int flip_up__(if1, if2, p_ih__, f1v, f1h, f2v, f2h, aki, akf,
|
||||
ier)
|
||||
integer *if1, *if2;
|
||||
real *p_ih__, *f1v, *f1h, *f2v, *f2h, *aki, *akf;
|
||||
integer *ier;
|
||||
{
|
||||
/* System generated locals */
|
||||
real r__1, r__2;
|
||||
@@ -480,12 +481,12 @@
|
||||
*ier = 0;
|
||||
*if1 = 0;
|
||||
*if2 = 0;
|
||||
if ((r__1 = p_ih__[1] - *f1v, dabs(r__1)) < .05f && (r__2 = p_ih__[2] - *
|
||||
aki * *f1h, dabs(r__2)) < .05f) {
|
||||
if ((r__1 = p_ih__[1] - *f1v, dabs(r__1)) < (float).05 && (r__2 = p_ih__[
|
||||
2] - *aki * *f1h, dabs(r__2)) < (float).05) {
|
||||
*if1 = 1;
|
||||
}
|
||||
if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < .05f && (r__2 = p_ih__[4] - *
|
||||
akf * *f2h, dabs(r__2)) < .05f) {
|
||||
if ((r__1 = p_ih__[3] - *f2v, dabs(r__1)) < (float).05 && (r__2 = p_ih__[
|
||||
4] - *akf * *f2h, dabs(r__2)) < (float).05) {
|
||||
*if2 = 1;
|
||||
}
|
||||
/* ----------------------------------------------------------------------- */
|
||||
|
||||
Reference in New Issue
Block a user