00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028 #ifdef HAVE_CONFIG_H
00029 # include <config.h>
00030 #endif
00031
00032
00033 #include <math.h>
00034 #include <string.h>
00035
00036 #include <cxtypes.h>
00037
00038 #include <cpl_matrix.h>
00039
00040 #include "girvcorrection.h"
00041
00042
00043
00052
00053
00054
00055
00056 static const cxdouble dct0 = 2415020.0;
00057 static const cxdouble dcjul = 36525.0;
00058 static const cxdouble dc1900 = 1900.0;
00059 static const cxdouble dctrop = 365.24219572;
00060 static const cxdouble dcbes = 0.313;
00061
00062 static const cxdouble RV_DPI =
00063 3.1415926535897932384626433832795028841971693993751;
00064
00065 static const cxdouble RV_D2PI =
00066 6.2831853071795864769252867665590057683943387987502;
00067
00068 static const cxdouble RV_D4PI =
00069 12.566370614359172953850573533118011536788677597500;
00070
00071 static const cxdouble RV_DPIBY2 =
00072 1.5707963267948966192313216916397514420985846996876;
00073
00074 static const cxdouble RV_DD2R =
00075 0.017453292519943295769236907684886127134428718885417;
00076
00077 static const cxdouble RV_DAS2R =
00078 4.8481368110953599358991410235794797595635330237270e-6;
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131 inline static void
00132 slaDeuler(const cxchar* order, cxdouble phi, cxdouble theta, cxdouble psi,
00133 cpl_matrix* rmat)
00134 {
00135 register cxint j, i, l, n, k;
00136 cxdouble result[3][3], rotn[3][3], angle, s, c , w, wm[3][3];
00137 cxchar axis;
00138
00139
00140 for ( j = 0; j < 3; j++ ) {
00141 for ( i = 0; i < 3; i++ ) {
00142 result[i][j] = ( i == j ) ? 1.0 : 0.0;
00143 }
00144 }
00145
00146
00147 l = strlen ( order );
00148
00149
00150 for ( n = 0; n < 3; n++ ) {
00151 if ( n <= l ) {
00152
00153
00154 for ( j = 0; j < 3; j++ ) {
00155 for ( i = 0; i < 3; i++ ) {
00156 rotn[i][j] = ( i == j ) ? 1.0 : 0.0;
00157 }
00158 }
00159
00160
00161 switch ( n ) {
00162 case 0 :
00163 angle = phi;
00164 break;
00165 case 1 :
00166 angle = theta;
00167 break;
00168 default:
00169 angle = psi;
00170 break;
00171 }
00172 s = sin ( angle );
00173 c = cos ( angle );
00174
00175
00176 axis = order[n];
00177 if ( ( axis == 'X' ) || ( axis == 'x' ) || ( axis == '1' ) ) {
00178
00179
00180 rotn[1][1] = c;
00181 rotn[1][2] = s;
00182 rotn[2][1] = -s;
00183 rotn[2][2] = c;
00184 }
00185 else if ( ( axis == 'Y' ) || ( axis == 'y' ) || ( axis == '2' ) ) {
00186
00187
00188 rotn[0][0] = c;
00189 rotn[0][2] = -s;
00190 rotn[2][0] = s;
00191 rotn[2][2] = c;
00192 }
00193 else if ( ( axis == 'Z' ) || ( axis == 'z' ) || ( axis == '3' ) ) {
00194
00195
00196 rotn[0][0] = c;
00197 rotn[0][1] = s;
00198 rotn[1][0] = -s;
00199 rotn[1][1] = c;
00200 }
00201 else {
00202
00203
00204 l = 0;
00205 }
00206
00207
00208 for ( i = 0; i < 3; i++ ) {
00209 for ( j = 0; j < 3; j++ ) {
00210 w = 0.0;
00211 for ( k = 0; k < 3; k++ ) {
00212 w += rotn[i][k] * result[k][j];
00213 }
00214 wm[i][j] = w;
00215 }
00216 }
00217 for ( j = 0; j < 3; j++ ) {
00218 for ( i= 0; i < 3; i++ ) {
00219 result[i][j] = wm[i][j];
00220 }
00221 }
00222 }
00223 }
00224
00225
00226 for ( j = 0; j < 3; j++ ) {
00227 for ( i = 0; i < 3; i++ ) {
00228 cpl_matrix_set(rmat, i, j, result[i][j]);
00229 }
00230 }
00231
00232 return;
00233
00234 }
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268 inline static cpl_matrix*
00269 slaPrecession (cxdouble ep0, cxdouble ep1)
00270 {
00271
00272 cxdouble t = 0.;
00273 cxdouble w = 0.;
00274 cxdouble z = 0.;
00275 cxdouble t0 = 0.;
00276 cxdouble zeta = 0.;
00277 cxdouble theta = 0.;
00278 cxdouble tas2r = 0.;
00279
00280 cpl_matrix* mprec = NULL;
00281
00282
00283
00284
00285
00286
00287 t0 = ( ep0 - 2000.0 ) / 1000.0;
00288
00289
00290
00291
00292
00293
00294 t = ( ep1 - ep0 ) / 1000.0;
00295
00296
00297
00298
00299
00300
00301 tas2r = t * RV_DAS2R;
00302 w = 23060.9097 +
00303 (139.7459 +
00304 (-0.0038 +
00305 (-0.5918 +
00306 (-0.0037 +
00307 0.0007 * t0) * t0) * t0) * t0) * t0;
00308
00309 zeta = (w +
00310 (30.2226 +
00311 (-0.2523 +
00312 (-0.3840 +
00313 (-0.0014 +
00314 0.0007 * t0) * t0) * t0) * t0 +
00315 (18.0183 +
00316 (-0.1326 +
00317 (0.0006 +
00318 0.0005 * t0) * t0) * t0 +
00319 (-0.0583 +
00320 (-0.0001 +
00321 0.0007 * t0) * t0 +
00322 (-0.0285 +
00323 -0.0002 * t) * t) * t) * t) * t) * tas2r;
00324
00325 z = (w +
00326 (109.5270 +
00327 (0.2446 +
00328 (-1.3913 +
00329 (-0.0134 +
00330 0.0026 * t0) * t0) * t0) * t0 +
00331 (18.2667 +
00332 (-1.1400 +
00333 (-0.0173 +
00334 0.0044 * t0) * t0) * t0 +
00335 (-0.2821 +
00336 (-0.0093 +
00337 0.0032 * t0) * t0 +
00338 (-0.0301 +
00339 0.0006 * t0 +
00340 -0.0001 * t) * t) * t) * t) * t) * tas2r;
00341
00342 theta = (20042.0207 +
00343 (-85.3131 +
00344 (-0.2111 +
00345 (0.3642 +
00346 (0.0008 +
00347 -0.0005 * t0) * t0) * t0) * t0) * t0 +
00348 (-42.6566 +
00349 (-0.2111 +
00350 (0.5463 +
00351 (0.0017 +
00352 -0.0012 * t0) * t0) * t0) * t0 +
00353 (-41.8238 +
00354 (0.0359 +
00355 (0.0027 +
00356 -0.0001 * t0) * t0) * t0 +
00357 (-0.0731 +
00358 (0.0019 +
00359 0.0009 * t0) * t0 +
00360 (-0.0127 +
00361 0.0011 * t0 + 0.0004 * t) * t) * t) * t) * t) * tas2r;
00362
00363
00364
00365
00366
00367
00368 mprec = cpl_matrix_new(3, 3);
00369 slaDeuler("ZYZ", -zeta, theta, -z, mprec);
00370
00371 return mprec;
00372
00373 }
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392 inline static cxdouble
00393 sideral_time(cxdouble djd, cxdouble dlong)
00394 {
00395
00396
00397
00398
00399
00400
00401 const cxdouble d1 = 1.739935934667999;
00402 const cxdouble d2 = 6.283319509909095e02;
00403 const cxdouble d3 = 6.755878646261384e-06;
00404
00405 const cxdouble df = 1.00273790934;
00406
00407 cxdouble dut = 0.;
00408 cxdouble dt = 0.;
00409 cxdouble dst0 = 0.;
00410 cxdouble dst = 0.;
00411 cxdouble djd0 = floor(djd) + 0.5;
00412
00413 if (djd0 > djd) {
00414 djd0 -= 1.;
00415 }
00416
00417 dut = (djd - djd0) * RV_D2PI;
00418
00419 dt = (djd0 - dct0) / dcjul;
00420 dst0 = d1 + d2 * dt + d3 * dt * dt;
00421 dst0 = fmod(dst0, RV_D2PI);
00422 dst = df * dut + dst0 - dlong;
00423 dst = fmod(dst + RV_D4PI, RV_D2PI);
00424
00425 return dst;
00426
00427 }
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460 inline static cxdouble
00461 geo_correction(cxdouble dlat, cxdouble dalt, cxdouble dec, cxdouble dha)
00462 {
00463
00464
00465
00466
00467
00468 const cxdouble da = 6378.137;
00469
00470
00471
00472
00473
00474 const cxdouble df = 1./298.257222;
00475
00476
00477
00478
00479
00480 const cxdouble dw = RV_D2PI/86164.;
00481
00482
00483 const cxdouble de2 = df * (2.0 - df);
00484 const cxdouble dsdlats = sin (dlat) * sin (dlat);
00485
00486 cxdouble d1 = 0.;
00487 cxdouble d2 = 0.;
00488 cxdouble dr0 = 0.;
00489 cxdouble dlatg = 0.;
00490 cxdouble drh = 0.;
00491 cxdouble dvelg = 0.;
00492
00493
00494
00495
00496
00497
00498 d1 = 1.0 - de2 * (2.0 - de2) * dsdlats;
00499 d2 = 1.0 - de2 * dsdlats;
00500 dr0 = da * sqrt(d1 / d2);
00501
00502
00503
00504
00505
00506
00507 d1 = de2 * sin(2.0 * dlat);
00508 d2 = 2.0 * d2;
00509 dlatg = dlat - atan(d1 / d2);
00510
00511
00512
00513
00514
00515
00516 drh = dr0 * cos(dlatg) + (dalt / 1000.) * cos(dlat);
00517
00518
00519
00520
00521
00522
00523
00524 dvelg = dw * drh * cos(dec) * sin(dha);
00525
00526 return dvelg;
00527
00528 }
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550
00551
00552
00553
00554
00555
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565 inline static void
00566 earth_velocity(cxdouble dje, cxdouble deq, cxdouble* hvel, cxdouble* bvel)
00567 {
00568
00569
00570
00571
00572
00573
00574
00575
00576 const cxdouble dcfel[][3] = {
00577 {1.7400353e+00, 6.2833195099091e+02, 5.2796e-06},
00578 {6.2565836e+00, 6.2830194572674e+02, -2.6180e-06},
00579 {4.7199666e+00, 8.3997091449254e+03, -1.9780e-05},
00580 {1.9636505e-01, 8.4334662911720e+03, -5.6044e-05},
00581 {4.1547339e+00, 5.2993466764997e+01, 5.8845e-06},
00582 {4.6524223e+00, 2.1354275911213e+01, 5.6797e-06},
00583 {4.2620486e+00, 7.5025342197656e+00, 5.5317e-06},
00584 {1.4740694e+00, 3.8377331909193e+00, 5.6093e-06}
00585 };
00586
00587
00588
00589
00590
00591
00592
00593
00594 const cxdouble dceps[3] = {
00595 4.093198e-01,
00596 -2.271110e-04,
00597 -2.860401e-08
00598 };
00599
00600 const cxdouble ccsel[][3] = {
00601 {1.675104e-02, -4.179579e-05, -1.260516e-07},
00602 {2.220221e-01, 2.809917e-02, 1.852532e-05},
00603 {1.589963e+00, 3.418075e-02, 1.430200e-05},
00604 {2.994089e+00, 2.590824e-02, 4.155840e-06},
00605 {8.155457e-01, 2.486352e-02, 6.836840e-06},
00606 {1.735614e+00, 1.763719e-02, 6.370440e-06},
00607 {1.968564e+00, 1.524020e-02, -2.517152e-06},
00608 {1.282417e+00, 8.703393e-03, 2.289292e-05},
00609 {2.280820e+00, 1.918010e-02, 4.484520e-06},
00610 {4.833473e-02, 1.641773e-04, -4.654200e-07},
00611 {5.589232e-02, -3.455092e-04, -7.388560e-07},
00612 {4.634443e-02, -2.658234e-05, 7.757000e-08},
00613 {8.997041e-03, 6.329728e-06, -1.939256e-09},
00614 {2.284178e-02, -9.941590e-05, 6.787400e-08},
00615 {4.350267e-02, -6.839749e-05, -2.714956e-07},
00616 {1.348204e-02, 1.091504e-05, 6.903760e-07},
00617 {3.106570e-02, -1.665665e-04, -1.590188e-07}
00618 };
00619
00620
00621
00622
00623
00624
00625
00626
00627
00628 const cxdouble dcargs[][2] = {
00629 {5.0974222e+00, -7.8604195454652e+02},
00630 {3.9584962e+00, -5.7533848094674e+02},
00631 {1.6338070e+00, -1.1506769618935e+03},
00632 {2.5487111e+00, -3.9302097727326e+02},
00633 {4.9255514e+00, -5.8849265665348e+02},
00634 {1.3363463e+00, -5.5076098609303e+02},
00635 {1.6072053e+00, -5.2237501616674e+02},
00636 {1.3629480e+00, -1.1790629318198e+03},
00637 {5.5657014e+00, -1.0977134971135e+03},
00638 {5.0708205e+00, -1.5774000881978e+02},
00639 {3.9318944e+00, 5.2963464780000e+01},
00640 {4.8989497e+00, 3.9809289073258e+01},
00641 {1.3097446e+00, 7.7540959633708e+01},
00642 {3.5147141e+00, 7.9618578146517e+01},
00643 {3.5413158e+00, -5.4868336758022e+02}
00644 };
00645
00646
00647
00648
00649
00650
00651
00652
00653 const cxdouble ccamps[][5] = {
00654 {-2.279594e-5, 1.407414e-5, 8.273188e-6, 1.340565e-5, -2.490817e-7},
00655 {-3.494537e-5, 2.860401e-7, 1.289448e-7, 1.627237e-5, -1.823138e-7},
00656 { 6.593466e-7, 1.322572e-5, 9.258695e-6, -4.674248e-7, -3.646275e-7},
00657 { 1.140767e-5, -2.049792e-5, -4.747930e-6, -2.638763e-6, -1.245408e-7},
00658 { 9.516893e-6, -2.748894e-6, -1.319381e-6, -4.549908e-6, -1.864821e-7},
00659 { 7.310990e-6, -1.924710e-6, -8.772849e-7, -3.334143e-6, -1.745256e-7},
00660 {-2.603449e-6, 7.359472e-6, 3.168357e-6, 1.119056e-6, -1.655307e-7},
00661 {-3.228859e-6, 1.308997e-7, 1.013137e-7, 2.403899e-6, -3.736225e-7},
00662 { 3.442177e-7, 2.671323e-6, 1.832858e-6, -2.394688e-7, -3.478444e-7},
00663 { 8.702406e-6, -8.421214e-6, -1.372341e-6, -1.455234e-6, -4.998479e-8},
00664 {-1.488378e-6, -1.251789e-5, 5.226868e-7, -2.049301e-7, 0.0e0},
00665 {-8.043059e-6, -2.991300e-6, 1.473654e-7, -3.154542e-7, 0.0e0},
00666 { 3.699128e-6, -3.316126e-6, 2.901257e-7, 3.407826e-7, 0.0e0},
00667 { 2.550120e-6, -1.241123e-6, 9.901116e-8, 2.210482e-7, 0.0e0},
00668 {-6.351059e-7, 2.341650e-6, 1.061492e-6, 2.878231e-7, 0.0e0}
00669 };
00670
00671
00672
00673
00674
00675
00676
00677
00678 const cxdouble ccsec3 = -7.757020e-08;
00679
00680 const cxdouble ccsec[][3] = {
00681 {1.289600e-06, 5.550147e-01, 2.076942e+00},
00682 {3.102810e-05, 4.035027e+00, 3.525565e-01},
00683 {9.124190e-06, 9.990265e-01, 2.622706e+00},
00684 {9.793240e-07, 5.508259e+00, 1.559103e+01}
00685 };
00686
00687
00688
00689
00690
00691
00692 const cxdouble dcsld = 1.990987e-07;
00693 const cxdouble ccsgd = 1.990969e-07;
00694
00695
00696
00697
00698
00699
00700
00701 const cxdouble cckm = 3.122140e-05;
00702 const cxdouble ccmld = 2.661699e-06;
00703 const cxdouble ccfdi = 2.399485e-07;
00704
00705
00706
00707
00708
00709
00710
00711
00712
00713 const cxdouble dcargm[][2] = {
00714 {5.1679830e+00, 8.3286911095275e+03},
00715 {5.4913150e+00, -7.2140632838100e+03},
00716 {5.9598530e+00, 1.5542754389685e+04}
00717 };
00718
00719
00720
00721
00722
00723
00724
00725 const cxdouble ccampm[][4] = {
00726 { 1.097594e-01, 2.896773e-07, 5.450474e-02, 1.438491e-07},
00727 {-2.223581e-02, 5.083103e-08, 1.002548e-02, -2.291823e-08},
00728 { 1.148966e-02, 5.658888e-08, 8.249439e-03, 4.063015e-08}
00729 };
00730
00731
00732
00733
00734
00735
00736 const cxdouble ccpamv[4] = {
00737 8.326827e-11,
00738 1.843484e-11,
00739 1.988712e-12,
00740 1.881276e-12
00741 };
00742
00743
00744
00745
00746
00747
00748 const cxdouble dc1mme = 0.99999696;
00749
00750
00751 register cxint k = 0;
00752 register cxint n = 0;
00753
00754 cxint ideq = 0;
00755
00756 cxdouble a = 0.;
00757 cxdouble b = 0.;
00758 cxdouble f = 0.;
00759 cxdouble dt = 0.;
00760 cxdouble t = 0.;
00761 cxdouble tl = 0.;
00762 cxdouble dtsq = 0.;
00763 cxdouble tsq = 0.;
00764 cxdouble dml = 0.;
00765 cxdouble dlocal = 0.;
00766 cxdouble deps = 0.;
00767 cxdouble pertl = 0.;
00768 cxdouble pertld = 0.;
00769 cxdouble pertr = 0.;
00770 cxdouble pertrd = 0.;
00771 cxdouble pertp = 0.;
00772 cxdouble pertpd = 0.;
00773 cxdouble sina = 0.;
00774 cxdouble cosa = 0.;
00775 cxdouble twoe = 0.;
00776 cxdouble twog = 0.;
00777 cxdouble param = 0.;
00778 cxdouble dparam = 0.;
00779 cxdouble dpsi = 0.;
00780 cxdouble phi = 0.;
00781 cxdouble phid = 0.;
00782 cxdouble psid = 0.;
00783 cxdouble sin_f = 0.;
00784 cxdouble cos_f = 0.;
00785 cxdouble esq = 0.;
00786 cxdouble d1pdro = 0.;
00787 cxdouble drd = 0.;
00788 cxdouble drld = 0.;
00789 cxdouble dsinls = 0.;
00790 cxdouble dcosls = 0.;
00791 cxdouble dtl = 0.;
00792 cxdouble dxhd = 0.;
00793 cxdouble dyhd = 0.;
00794 cxdouble dzhd = 0.;
00795 cxdouble sinlm = 0.;
00796 cxdouble coslm = 0.;
00797 cxdouble sigma = 0.;
00798 cxdouble plon = 0.;
00799 cxdouble pomg = 0.;
00800 cxdouble dxbd = 0.;
00801 cxdouble dybd = 0.;
00802 cxdouble dzbd = 0.;
00803 cxdouble pecc = 0.;
00804 cxdouble dcosep = 0.;
00805 cxdouble dsinep = 0.;
00806 cxdouble dyahd = 0.;
00807 cxdouble dzahd = 0.;
00808 cxdouble dyabd = 0.;
00809 cxdouble dzabd = 0.;
00810 cxdouble sn[4] = {0., 0., 0., 0.};
00811 cxdouble sinlp[4] = {0., 0., 0., 0.};
00812 cxdouble coslp[4] = {0., 0., 0., 0.};
00813 cxdouble forbel[7] = {0., 0., 0., 0., 0., 0., 0.};
00814 cxdouble sorbel[17];
00815
00816
00817 memset(sorbel, 0, sizeof sorbel * sizeof(cxdouble));
00818
00819
00820
00821
00822
00823
00824 ideq = (cxint)deq;
00825 dt = (dje - dct0) / dcjul;
00826 t = dt;
00827 dtsq = dt * dt;
00828 tsq = dtsq;
00829
00830
00831
00832
00833
00834
00835 for (k = 0; k < 8; k++) {
00836
00837 dlocal = fmod(dcfel[k][0] + dt * dcfel[k][1] + dtsq * dcfel[k][2],
00838 RV_D2PI);
00839
00840 if (k == 0) {
00841 dml = dlocal;
00842 }
00843
00844 if (k != 0) {
00845 forbel[k - 1] = dlocal;
00846 }
00847
00848 }
00849
00850 deps = fmod(dceps[0] + dt * dceps[1] + dtsq * dceps[2], RV_D2PI);
00851
00852 for (k = 0; k < 17; k++) {
00853
00854 sorbel[k] = fmod(ccsel[k][0] + t * ccsel[k][1] + tsq * ccsel[k][2],
00855 RV_D2PI);
00856
00857 }
00858
00859
00860
00861
00862
00863
00864 for (k = 0; k < 4; k++) {
00865
00866 a = fmod(ccsec[k][1] + t * ccsec[k][2], RV_D2PI);
00867 sn[k] = sin(a);
00868
00869 }
00870
00871
00872
00873
00874
00875
00876 pertl = ccsec[0][0] * sn[0] + ccsec[1][0] * sn[1] +
00877 (ccsec[2][0] + t * ccsec3) * sn[2] + ccsec[3][0] * sn[3];
00878
00879 pertld = 0.;
00880 pertr = 0.;
00881 pertrd = 0.;
00882
00883 for (k = 0; k < 15; k++) {
00884
00885 a = fmod(dcargs[k][0] + dt * dcargs[k][1], RV_D2PI);
00886 cosa = cos (a);
00887 sina = sin (a);
00888 pertl += (ccamps[k][0] * cosa + ccamps[k][1] * sina);
00889 pertr += (ccamps[k][2] * cosa + ccamps[k][3] * sina);
00890
00891 if (k >= 10) {
00892 continue;
00893 }
00894
00895 pertld += ((ccamps[k][1] * cosa - ccamps[k][0] * sina) * ccamps[k][4]);
00896 pertrd += ((ccamps[k][3] * cosa - ccamps[k][2] * sina) * ccamps[k][4]);
00897
00898 }
00899
00900
00901
00902
00903
00904
00905 esq = sorbel[0] * sorbel[0];
00906 dparam = 1. - esq;
00907 param = dparam;
00908 twoe = sorbel[0] + sorbel[0];
00909 twog = forbel[0] + forbel[0];
00910 phi = twoe * ((1.0 - esq * (1.0 / 8.0)) * sin (forbel[0]) +
00911 sorbel[0] * (5.0 / 8.0) * sin (twog) +
00912 esq * 0.5416667 * sin (forbel[0] + twog));
00913 f = forbel[0] + phi;
00914 sin_f = sin(f);
00915 cos_f = cos(f);
00916 dpsi = dparam / (1. + sorbel[0] * cos_f);
00917 phid = twoe * ccsgd * ((1.0 + esq * 1.50) * cos_f +
00918 sorbel[0] * (1.250 - sin_f * sin_f * 0.50));
00919 psid = ccsgd * sorbel[0] * sin_f / sqrt(param);
00920
00921
00922
00923
00924
00925
00926 d1pdro = 1. + pertr;
00927 drd = d1pdro * (psid + dpsi * pertrd);
00928 drld = d1pdro * dpsi * (dcsld + phid + pertld);
00929 dtl = fmod(dml + phi + pertl, RV_D2PI);
00930 dsinls = sin(dtl);
00931 dcosls = cos(dtl);
00932 dxhd = drd * dcosls - drld * dsinls;
00933 dyhd = drd * dsinls + drld * dcosls;
00934
00935
00936
00937
00938
00939
00940
00941 pertl = 0.;
00942 pertld = 0.;
00943 pertp = 0.;
00944 pertpd = 0.;
00945
00946 for (k = 0; k < 3; k++) {
00947
00948 a = fmod(dcargm[k][0] + dt * dcargm[k][1], RV_D2PI);
00949 sina = sin(a);
00950 cosa = cos(a);
00951 pertl += ccampm[k][0] * sina;
00952 pertld += ccampm[k][1] * cosa;
00953 pertp += ccampm[k][2] * cosa;
00954 pertpd -= ccampm[k][3] * sina;
00955
00956 }
00957
00958
00959
00960
00961
00962
00963 tl = forbel[1] + pertl;
00964 sinlm = sin(tl);
00965 coslm = cos(tl);
00966 sigma = cckm / (1. + pertp);
00967 a = sigma * (ccmld + pertld);
00968 b = sigma * pertpd;
00969 dxhd = dxhd + a * sinlm + b * coslm;
00970 dyhd = dyhd - a * coslm + b * sinlm;
00971 dzhd = -sigma * ccfdi * cos(forbel[2]);
00972
00973
00974
00975
00976
00977
00978 dxbd = dxhd * dc1mme;
00979 dybd = dyhd * dc1mme;
00980 dzbd = dzhd * dc1mme;
00981
00982 for (k = 0; k < 4; k++) {
00983
00984 plon = forbel[k + 3];
00985 pomg = sorbel[k + 1];
00986 pecc = sorbel[k + 9];
00987 tl = fmod(plon + 2.0 * pecc * sin (plon - pomg), RV_D2PI);
00988 sinlp[k] = sin(tl);
00989 coslp[k] = cos(tl);
00990 dxbd = dxbd + ccpamv[k] * (sinlp[k] + pecc * sin(pomg));
00991 dybd = dybd - ccpamv[k] * (coslp[k] + pecc * cos(pomg));
00992 dzbd = dzbd - ccpamv[k] * sorbel[k + 13] * cos(plon - sorbel[k + 5]);
00993
00994 }
00995
00996
00997
00998
00999
01000
01001 dcosep = cos(deps);
01002 dsinep = sin(deps);
01003 dyahd = dcosep * dyhd - dsinep * dzhd;
01004 dzahd = dsinep * dyhd + dcosep * dzhd;
01005 dyabd = dcosep * dybd - dsinep * dzbd;
01006 dzabd = dsinep * dybd + dcosep * dzbd;
01007
01008 if (ideq == 0) {
01009
01010 hvel[0] = dxhd;
01011 hvel[1] = dyahd;
01012 hvel[2] = dzahd;
01013
01014 bvel[0] = dxbd;
01015 bvel[1] = dyabd;
01016 bvel[2] = dzabd;
01017
01018 }
01019 else {
01020
01021
01022
01023
01024
01025 cxdouble deqdat = (dje - dct0 - dcbes) / dctrop + dc1900;
01026
01027 cpl_matrix* prec = slaPrecession(deqdat, deq);
01028
01029
01030 for (n = 0; n < 3; n++) {
01031
01032 hvel[n] =
01033 dxhd * cpl_matrix_get(prec, 0, n) +
01034 dyahd * cpl_matrix_get(prec, 1, n) +
01035 dzahd * cpl_matrix_get(prec, 2, n);
01036
01037 bvel[n] =
01038 dxbd * cpl_matrix_get(prec, 0, n) +
01039 dyabd * cpl_matrix_get(prec, 1, n) +
01040 dzabd * cpl_matrix_get(prec, 2, n);
01041 }
01042
01043 cpl_matrix_delete(prec);
01044
01045 }
01046
01047 return;
01048
01049 }
01050
01051
01052
01053
01054
01055
01088 void
01089 giraffe_rvcorrection_compute(GiRvCorrection* rv,
01090 cxdouble jdate, cxdouble longitude,
01091 cxdouble latitude, cxdouble altitude,
01092 cxdouble ra, cxdouble dec,
01093 cxdouble equinox)
01094 {
01095
01096 cxint i = 0;
01097
01098 const cxdouble aukm = 1.4959787e08;
01099
01100 cxdouble eqt = 0.;
01101 cxdouble ha = 0.;
01102 cxdouble ra2 = 0.;
01103 cxdouble dec2 = 0.;
01104 cxdouble dc[3] = {0., 0., 0.};
01105 cxdouble dcc[3] = {0., 0., 0.};
01106 cxdouble hv[3] = {0., 0., 0.};
01107 cxdouble bv[3] = {0., 0., 0.};
01108 cxdouble _long = longitude * RV_DD2R;
01109 cxdouble _lat = latitude * RV_DD2R;
01110 cxdouble _ra = ra * 15.0 * RV_DD2R;
01111 cxdouble _dec = dec * RV_DD2R;
01112 cxdouble st = sideral_time(jdate, _long);
01113
01114 cpl_matrix* precession = NULL;
01115
01116
01117
01118
01119
01120
01121 eqt = (jdate - dct0 - dcbes) / dctrop + dc1900;
01122
01123 dc[0] = cos(_ra) * cos(_dec);
01124 dc[1] = sin(_ra) * cos(_dec);
01125 dc[2] = sin(_dec);
01126
01127 precession = slaPrecession(equinox, eqt);
01128
01129 for (i = 0; i < 3; ++i) {
01130
01131 dcc[i] =
01132 dc[0] * cpl_matrix_get(precession, i, 0) +
01133 dc[1] * cpl_matrix_get(precession, i, 1) +
01134 dc[2] * cpl_matrix_get(precession, i, 2);
01135
01136 }
01137
01138 cpl_matrix_delete(precession);
01139 precession = NULL;
01140
01141
01142 if (dcc[0] != 0.) {
01143
01144 cxdouble darg = dcc[1] / dcc[0];
01145
01146
01147 ra2 = atan(darg);
01148
01149 if (dcc[0] < 0.) {
01150 ra2 += RV_DPI;
01151 }
01152 else {
01153 if (dcc[1] < 0.) {
01154 ra2 += RV_D2PI;
01155 }
01156 }
01157
01158 }
01159 else {
01160
01161 if (dcc[1] > 0.) {
01162 ra2 = RV_DPIBY2;
01163 }
01164 else {
01165 ra2 = 1.5 * RV_DPI;
01166 }
01167
01168 }
01169
01170 dec2 = asin(dcc[2]);
01171
01172
01173
01174
01175
01176
01177 ha = st - ra2;
01178
01179
01180
01181
01182
01183
01184
01185 rv->gc = geo_correction(_lat, altitude, dec2, -ha);
01186
01187
01188
01189
01190
01191
01192
01193 earth_velocity (jdate, eqt, hv, bv);
01194
01195
01196
01197
01198
01199
01200
01201 rv->bc = 0.;
01202 rv->hc = 0.;
01203
01204 for (i = 0; i < 3; ++i) {
01205 rv->bc += bv[i] * dcc[i] * aukm;
01206 rv->hc += hv[i] * dcc[i] * aukm;
01207 }
01208
01209 return;
01210
01211 }