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 #ifdef HAVE_CONFIG_H
00028 # include <config.h>
00029 #endif
00030
00031
00044
00047
00048
00049
00050
00051 #include <xsh_baryvel.h>
00052
00053 #include <xsh_pfits.h>
00054 #include <xsh_utils.h>
00055 #include <xsh_error.h>
00056 #include <xsh_msg.h>
00057
00058 #include <cpl.h>
00059
00060 #include <math.h>
00061
00062
00063
00064
00065 static void deg2dms(double in_val,
00066 double *degs,
00067 double *minutes,
00068 double *seconds);
00069
00070 static void deg2hms(double in_val,
00071 double *hour,
00072 double *min,
00073 double *sec);
00074
00075 static void compxy(double inputr[19], char inputc[4],
00076 double outputr[4],
00077 double utr, double mod_juldat);
00078
00079 static void barvel(double DJE, double DEQ,
00080 double DVELH[4], double DVELB[4]);
00081
00082
00083
00090
00091 void
00092 xsh_baryvel(const cpl_propertylist *raw_header,
00093 double *bary_corr,
00094 double *helio_corr)
00095 {
00096
00097 double outputr[4];
00098
00099
00100 char inputc[] = "X+++";
00101
00102
00103 double rneg = 1.0;
00104
00105
00106 double inputr[19];
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118 double qc_ra;
00119 double qc_dec;
00120 double qc_geolat;
00121 double qc_geolon;
00122
00123 double utr;
00124 double mod_juldat;
00125
00126 double ra_hour, ra_min, ra_sec;
00127 double dec_deg, dec_min, dec_sec;
00128 double lat_deg, lat_min, lat_sec;
00129 double lon_deg, lon_min, lon_sec;
00130
00131 if(cpl_propertylist_has(raw_header,"RA")) {
00132 check_msg( qc_ra = xsh_pfits_get_ra(raw_header),
00133 "Error getting object right ascension");
00134 } else {
00135 xsh_msg_warning("RA FITS keyword not present in header, barycor not computed");
00136 return;
00137 }
00138
00139 if(cpl_propertylist_has(raw_header,"DEC")) {
00140 check_msg( qc_dec = xsh_pfits_get_dec(raw_header),
00141 "Error getting object declination");
00142 } else {
00143 xsh_msg_warning("DEC FITS keyword not present in header, barycor not computed");
00144 return;
00145 }
00146 check_msg( qc_geolat = xsh_pfits_get_geolat(raw_header),
00147 "Error getting telescope latitude");
00148 check_msg( qc_geolon = xsh_pfits_get_geolon(raw_header),
00149 "Error getting telescope longitude");
00150
00151
00152
00153 check_msg( utr = xsh_pfits_get_utc(raw_header),
00154 "Error reading UTC");
00155 check_msg( mod_juldat = xsh_pfits_get_mjdobs(raw_header),
00156 "Error julian date");
00157
00158 deg2hms(qc_ra, &ra_hour, &ra_min, &ra_sec);
00159 deg2dms(qc_dec, &dec_deg, &dec_min, &dec_sec);
00160 deg2dms(qc_geolat, &lat_deg, &lat_min, &lat_sec);
00161 deg2dms(qc_geolon, &lon_deg, &lon_min, &lon_sec);
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175 inputr[7] = lon_deg;
00176 inputr[8] = lon_min;
00177 inputr[9] = lon_sec;
00178
00179
00180 rneg = (inputr[7]*3600.)+(inputr[8]*60.)+inputr[9];
00181
00182 inputc[1] = (lon_deg >= 0) ? '+' : '-';
00183
00184 if (rneg < 0) inputc[1] = '-';
00185
00186
00187 inputr[10] = lat_deg;
00188 inputr[11] = lat_min;
00189 inputr[12] = lat_sec;
00190
00191
00192 rneg = (inputr[10]*3600.)+(inputr[11]*60.)+inputr[12];
00193
00194 inputc[2] = (lat_deg >= 0) ? '+' : '-';
00195
00196 if (rneg < 0) inputc[2] = '-';
00197
00198
00199 inputr[13] = ra_hour;
00200 inputr[14] = ra_min;
00201 inputr[15] = ra_sec;
00202
00203
00204 inputr[16] = dec_deg;
00205 inputr[17] = dec_min;
00206 inputr[18] = dec_sec;
00207
00208
00209 inputc[3] = (dec_deg >= 0) ? '+' : '-';
00210
00211 rneg = (inputr[16]*3600.)+(inputr[17]*60.)+inputr[18];
00212
00213 if (rneg < 0) inputc[3] = '-';
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226 compxy(inputr, inputc, outputr, utr, mod_juldat);
00227
00228
00229
00230
00231
00232 xsh_msg_debug(" Total barycentric RV correction: %f km/s", outputr[1]);
00233 xsh_msg_debug(" Total heliocentric RV correction: %f km/s", outputr[2]);
00234 xsh_msg_debug(" (incl. diurnal RV correction of %f km/s)", outputr[3]);
00235
00236
00237
00238 *bary_corr = outputr[1];
00239 *helio_corr = outputr[2];
00240
00241 cleanup:
00242 return;
00243 }
00244
00245
00246
00268
00269 static void
00270 compxy(double inputr[19], char inputc[4],
00271 double outputr[4],
00272 double utr, double mod_juldat)
00273 {
00274
00275
00276
00277
00278
00279 double STR;
00280
00281
00282 double t0, dl, theta0, pe, st0hg, stg;
00283
00284 double jd, jd0h;
00285
00286 double dvelb[4], dvelh[4];
00287
00288 double alp, del, beov, berv, EDV;
00289
00290 double HAR, phi, heov, herv;
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300 double *rbuf;
00301
00302
00303 char inpsgn[4];
00304
00305
00306
00307
00308
00309
00310
00311 double *olong, *olat, *alpha, *delta;
00312
00313
00314 char signs[] = "+++";
00315
00316
00317 rbuf = inputr;
00318
00319 inpsgn[1] = inputc[1];
00320 inpsgn[2] = inputc[2];
00321 inpsgn[3] = inputc[3];
00322
00323
00324
00325
00326 olong = rbuf + 7 - 1;
00327
00328 olat = rbuf + 10 - 1;
00329 alpha = rbuf + 13 - 1;
00330
00331 delta = rbuf + 16 - 1;
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349 utr /= 3600;
00350
00351
00352 jd = mod_juldat + 2400000.5;
00353
00354
00355
00356
00357
00358
00359
00360 if (olong[1] < 0 || olong[2] < 0 ||
00361 olong[3] < 0 || inpsgn[1] == '-') {
00362
00363 signs[1] = '-';
00364
00365
00366
00367 olong[1] = fabs(olong[1]);
00368 olong[2] = fabs(olong[2]);
00369 olong[3] = fabs(olong[3]);
00370
00371 }
00372
00373
00374 dl = olong[1]+olong[2]/60. +olong[3]/3600.;
00375
00376
00377 if (signs[1] == '-') dl = -dl;
00378
00379
00380 dl = -dl*24. /360.;
00381
00382
00383
00384 if (olat[1] < 0 || olat[2] < 0 ||
00385 olat[3] < 0 || inpsgn[2] == '-') {
00386
00387 signs[2] = '-';
00388
00389
00390
00391
00392 olat[1] = fabs(olat[1]);
00393 olat[2] = fabs(olat[2]);
00394 olat[3] = fabs(olat[3]);
00395
00396 }
00397
00398
00399 phi = olat[1]+olat[2]/60. +olat[3]/3600.;
00400
00401
00402 if (signs[2] == '-') phi = -phi;
00403
00404
00405 phi = phi*M_PI/180. ;
00406
00407
00408
00409
00410 alp = (alpha[1]*3600. +alpha[2]*60. +alpha[3])*M_PI/(12. *3600. );
00411
00412
00413
00414 if (delta[1] < 0 || delta[2] < 0 ||
00415 delta[3] < 0 || inpsgn[3] == '-') {
00416
00417 signs[3] = '-';
00418
00419
00420
00421 delta[1] = fabs(delta[1]);
00422 delta[2] = fabs(delta[2]);
00423 delta[3] = fabs(delta[3]);
00424
00425 }
00426
00427
00428
00429 del = (delta[1]*3600.0 + delta[2]*60. + delta[3])
00430 * M_PI/(3600. *180. );
00431
00432
00433
00434 if (signs[3] == '-') del = - del;
00435
00436
00437
00438
00439
00440
00441
00442 barvel(jd, 0.0, dvelh, dvelb);
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452 beov =
00453 dvelb[1]*cos(alp)*cos(del)+
00454 dvelb[2]*sin(alp)*cos(del)+
00455 dvelb[3]*sin(del);
00456
00457
00458
00459
00460 heov =
00461 dvelh[1]*cos(alp)*cos(del)+
00462 dvelh[2]*sin(alp)*cos(del)+
00463 dvelh[3]*sin(del);
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475 jd0h = jd - (utr/24.0);
00476
00477
00478 t0 = (jd0h-2415020. )/36525. ;
00479
00480
00481 theta0 = 0.276919398 +100.0021359 *t0+0.000001075 *t0*t0 ;
00482
00483
00484 pe = (int) theta0;
00485
00486
00487 theta0 = theta0 - pe;
00488
00489
00490 st0hg = theta0*24. ;
00491
00492
00493
00494
00495
00496
00497
00498
00499 stg = st0hg+utr*1.00273790931 ;
00500
00501
00502 if (stg < dl) stg = stg +24. ;
00503
00504
00505 STR = stg-dl;
00506
00507
00508 if (STR >= 24. ) STR = STR-24. ;
00509
00510
00511 STR = STR*M_PI/12. ;
00512
00513
00514 HAR = STR-alp;
00515
00516
00517 EDV = -0.4654 * sin(HAR)* cos(del)* cos(phi);
00518
00519
00520
00521
00522 herv=heov+EDV;
00523
00524 berv=beov+EDV;
00525
00526
00527
00528 #if 0
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550 #endif
00551
00552
00553
00554
00555
00556
00557 rbuf[1] = berv;
00558 rbuf[2] = herv;
00559 rbuf[3] = EDV;
00560
00561
00562 outputr[1] = rbuf[1];
00563 outputr[2] = rbuf[2];
00564 outputr[3] = rbuf[3];
00565
00566 return;
00567 }
00568
00569
00570 #define DCFEL(x,y) dcfel[y][x]
00571 #define DCFEPS(x,y) dcfeps[y][x]
00572 #define CCSEL(x,y) ccsel[y][x]
00573 #define DCARGS(x,y) dcargs[y][x]
00574 #define CCAMPS(x,y) ccamps[y][x]
00575 #define CCSEC(x,y) ccsec[y][x]
00576 #define DCARGM(x,y) dcargm[y][x]
00577 #define CCAMPM(x,y) ccampm[y][x]
00578 #define DCEPS(x) dceps[x]
00579 #define FORBEL(x) forbel[x]
00580 #define SORBEL(x) sorbel[x]
00581 #define SN(x) sn[x]
00582 #define SINLP(x) sinlp[x]
00583 #define COSLP(x) coslp[x]
00584 #define CCPAMV(x) ccpamv[x]
00585
00586
00599
00600
00601
00602
00603 static
00604 void barvel(double DJE, double DEQ,
00605 double DVELH[4], double DVELB[4])
00606 {
00607
00608 double sn[5];
00609
00610 double DT,DTL,DTSQ,DLOCAL;
00611
00612 double DRD,DRLD;
00613
00614 double DXBD,DYBD,DZBD,DZHD,DXHD,DYHD;
00615
00616 double DYAHD,DZAHD,DYABD,DZABD;
00617
00618 double DML,DEPS,PHI,PHID,PSID,DPARAM,PARAM;
00619
00620 double PLON,POMG,PECC;
00621
00622 double PERTL,PERTLD,PERTRD,PERTP,PERTR,PERTPD;
00623
00624 double SINA,TL;
00625
00626 double COSA,ESQ;
00627
00628
00629
00630
00631 double A,B,F,SINF,COSF,T,TSQ,TWOE,TWOG;
00632
00633
00634 double DPSI,D1PDRO,DSINLS;
00635
00636 double DCOSLS,DSINEP,DCOSEP;
00637
00638 double forbel[8], sorbel[18], sinlp[5], coslp[5];
00639
00640 double SINLM,COSLM,SIGMA;
00641
00642
00643 int IDEQ,K,N;
00644
00645
00646
00647
00648
00649
00650 double *E = sorbel + 1 - 1;
00651 double *G = forbel + 1 - 1;
00652
00653
00654 double DC2PI = 6.2831853071796E0;
00655 double CC2PI = 6.283185;
00656
00657
00658 double DC1 = 1.0;
00659 double DCT0 = 2415020.0E0;
00660 double DCJUL = 36525.0E0;
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671 double dcfel[][4] = { {0, 0, 0, 0},
00672 {0, 1.7400353E+00, 6.2833195099091E+02, 5.2796E-06},
00673 {0, 6.2565836E+00, 6.2830194572674E+02,-2.6180E-06},
00674 {0, 4.7199666E+00, 8.3997091449254E+03,-1.9780E-05},
00675 {0, 1.9636505E-01, 8.4334662911720E+03,-5.6044E-05},
00676 {0, 4.1547339E+00, 5.2993466764997E+01, 5.8845E-06},
00677 {0, 4.6524223E+00, 2.1354275911213E+01, 5.6797E-06},
00678 {0, 4.2620486E+00, 7.5025342197656E+00, 5.5317E-06},
00679 {0, 1.4740694E+00, 3.8377331909193E+00, 5.6093E-06} };
00680
00681
00682
00683 double dceps[4] = {0, 4.093198E-01,-2.271110E-04,-2.860401E-08};
00684
00685
00686
00687
00688
00689
00690
00691
00692
00693
00694
00695
00696
00697
00698
00699
00700
00701
00702
00703
00704 double ccsel[][4] = { {0, 0, 0, 0},
00705 {0, 1.675104E-02, -4.179579E-05, -1.260516E-07},
00706 {0, 2.220221E-01, 2.809917E-02, 1.852532E-05},
00707 {0, 1.589963E+00, 3.418075E-02, 1.430200E-05},
00708 {0, 2.994089E+00, 2.590824E-02, 4.155840E-06},
00709 {0, 8.155457E-01, 2.486352E-02, 6.836840E-06},
00710 {0, 1.735614E+00, 1.763719E-02, 6.370440E-06},
00711 {0, 1.968564E+00, 1.524020E-02, -2.517152E-06},
00712 {0, 1.282417E+00, 8.703393E-03, 2.289292E-05},
00713 {0, 2.280820E+00, 1.918010E-02, 4.484520E-06},
00714 {0, 4.833473E-02, 1.641773E-04, -4.654200E-07},
00715 {0, 5.589232E-02, -3.455092E-04, -7.388560E-07},
00716 {0, 4.634443E-02, -2.658234E-05, 7.757000E-08},
00717 {0, 8.997041E-03, 6.329728E-06, -1.939256E-09},
00718 {0, 2.284178E-02, -9.941590E-05, 6.787400E-08},
00719 {0, 4.350267E-02, -6.839749E-05, -2.714956E-07},
00720 {0, 1.348204E-02, 1.091504E-05, 6.903760E-07},
00721 {0, 3.106570E-02, -1.665665E-04, -1.590188E-07} };
00722
00723
00724
00725
00726
00727
00728
00729
00730
00731
00732
00733
00734
00735
00736
00737
00738
00739
00740
00741 double dcargs[][3] = { {0, 0, 0},
00742 {0, 5.0974222E+00, -7.8604195454652E+02},
00743 {0, 3.9584962E+00, -5.7533848094674E+02},
00744 {0, 1.6338070E+00, -1.1506769618935E+03},
00745 {0, 2.5487111E+00, -3.9302097727326E+02},
00746 {0, 4.9255514E+00, -5.8849265665348E+02},
00747 {0, 1.3363463E+00, -5.5076098609303E+02},
00748 {0, 1.6072053E+00, -5.2237501616674E+02},
00749 {0, 1.3629480E+00, -1.1790629318198E+03},
00750 {0, 5.5657014E+00, -1.0977134971135E+03},
00751 {0, 5.0708205E+00, -1.5774000881978E+02},
00752 {0, 3.9318944E+00, 5.2963464780000E+01},
00753 {0, 4.8989497E+00, 3.9809289073258E+01},
00754 {0, 1.3097446E+00, 7.7540959633708E+01},
00755 {0, 3.5147141E+00, 7.9618578146517E+01},
00756 {0, 3.5413158E+00, -5.4868336758022E+02} };
00757
00758
00759
00760
00761
00762
00763
00764
00765
00766
00767
00768
00769
00770
00771
00772
00773
00774
00775 double ccamps[][6] =
00776 {{0, 0, 0, 0, 0, 0},
00777 {0, -2.279594E-5, 1.407414E-5, 8.273188E-6, 1.340565E-5, -2.490817E-7},
00778 {0, -3.494537E-5, 2.860401E-7, 1.289448E-7, 1.627237E-5, -1.823138E-7},
00779 {0, 6.593466E-7, 1.322572E-5, 9.258695E-6, -4.674248E-7, -3.646275E-7},
00780 {0, 1.140767E-5, -2.049792E-5, -4.747930E-6, -2.638763E-6, -1.245408E-7},
00781 {0, 9.516893E-6, -2.748894E-6, -1.319381E-6, -4.549908E-6, -1.864821E-7},
00782 {0, 7.310990E-6, -1.924710E-6, -8.772849E-7, -3.334143E-6, -1.745256E-7},
00783 {0, -2.603449E-6, 7.359472E-6, 3.168357E-6, 1.119056E-6, -1.655307E-7},
00784 {0, -3.228859E-6, 1.308997E-7, 1.013137E-7, 2.403899E-6, -3.736225E-7},
00785 {0, 3.442177E-7, 2.671323E-6, 1.832858E-6, -2.394688E-7, -3.478444E-7},
00786 {0, 8.702406E-6, -8.421214E-6, -1.372341E-6, -1.455234E-6, -4.998479E-8},
00787 {0, -1.488378E-6, -1.251789E-5, 5.226868E-7, -2.049301E-7, 0.0E0},
00788 {0, -8.043059E-6, -2.991300E-6, 1.473654E-7, -3.154542E-7, 0.0E0},
00789 {0, 3.699128E-6, -3.316126E-6, 2.901257E-7, 3.407826E-7, 0.0E0},
00790 {0, 2.550120E-6, -1.241123E-6, 9.901116E-8, 2.210482E-7, 0.0E0},
00791 {0, -6.351059E-7, 2.341650E-6, 1.061492E-6, 2.878231E-7, 0.0E0}};
00792
00793
00794
00795 double CCSEC3 = -7.757020E-08;
00796
00797
00798
00799
00800
00801
00802 double ccsec[][4] = { {0, 0, 0, 0},
00803 {0, 1.289600E-06, 5.550147E-01, 2.076942E+00},
00804 {0, 3.102810E-05, 4.035027E+00, 3.525565E-01},
00805 {0, 9.124190E-06, 9.990265E-01, 2.622706E+00},
00806 {0, 9.793240E-07, 5.508259E+00, 1.559103E+01}};
00807
00808
00809
00810 double DCSLD = 1.990987E-07, CCSGD = 1.990969E-07;
00811
00812
00813 double CCKM = 3.122140E-05, CCMLD = 2.661699E-06, CCFDI = 2.399485E-07;
00814
00815
00816
00817
00818
00819 double dcargm[][3] = {{0, 0, 0},
00820 {0, 5.1679830E+00, 8.3286911095275E+03},
00821 {0, 5.4913150E+00, -7.2140632838100E+03},
00822 {0, 5.9598530E+00, 1.5542754389685E+04}};
00823
00824
00825
00826
00827
00828
00829 double ccampm[][5] = {{0, 0, 0, 0, 0},
00830 {0, 1.097594E-01, 2.896773E-07, 5.450474E-02, 1.438491E-07},
00831 {0, -2.223581E-02, 5.083103E-08, 1.002548E-02, -2.291823E-08},
00832 {0, 1.148966E-02, 5.658888E-08, 8.249439E-03, 4.063015E-08} };
00833
00834
00835
00836 double ccpamv[] = {0, 8.326827E-11, 1.843484E-11, 1.988712E-12, 1.881276E-12};
00837
00838 double DC1MME = 0.99999696E0;
00839
00840
00841
00842 IDEQ=DEQ;
00843
00844
00845 DT=(DJE-DCT0)/DCJUL;
00846
00847
00848 T=DT;
00849
00850
00851 DTSQ=DT*DT;
00852
00853
00854 TSQ=DTSQ;
00855
00856 DML = 0;
00857
00858 for (K = 1; K <= 8; K++) {
00859
00860
00861 DLOCAL=fmod(DCFEL(1,K)+DT*DCFEL(2,K)+DTSQ*DCFEL(3,K),DC2PI);
00862
00863
00864 if (K == 1) DML=DLOCAL;
00865
00866
00867 if (K != 1) FORBEL(K-1)=DLOCAL;
00868
00869 }
00870
00871
00872 DEPS=fmod(DCEPS(1)+DT*DCEPS(2)+DTSQ*DCEPS(3), DC2PI);
00873
00874
00875 for (K = 1; K <= 17; K++) {
00876
00877
00878 SORBEL(K)=fmod(CCSEL(1,K)+T*CCSEL(2,K)+TSQ*CCSEL(3,K),CC2PI);
00879
00880
00881 }
00882
00883
00884 for (K = 1; K <= 4; K++) {
00885
00886
00887 A=fmod(CCSEC(2,K)+T*CCSEC(3,K),CC2PI);
00888
00889
00890 SN(K)=sin(A);
00891
00892 }
00893
00894
00895
00896
00897 PERTL = CCSEC(1,1) *SN(1) +CCSEC(1,2)*SN(2)
00898 +(CCSEC(1,3)+T*CCSEC3)*SN(3) +CCSEC(1,4)*SN(4);
00899
00900
00901
00902
00903 PERTLD=0.0;
00904 PERTR =0.0;
00905 PERTRD=0.0;
00906
00907
00908 for (K = 1; K <= 15; K++) {
00909
00910 A=fmod(DCARGS(1,K)+DT*DCARGS(2,K), DC2PI);
00911
00912
00913 COSA=cos(A);
00914
00915
00916 SINA=sin(A);
00917
00918
00919 PERTL =PERTL+CCAMPS(1,K)*COSA+CCAMPS(2,K)*SINA;
00920
00921
00922 PERTR =PERTR+CCAMPS(3,K)*COSA+CCAMPS(4,K)*SINA;
00923
00924
00925 if (K >= 11) break;
00926
00927
00928 PERTLD=PERTLD+(CCAMPS(2,K)*COSA-CCAMPS(1,K)*SINA)*CCAMPS(5,K);
00929
00930
00931 PERTRD=PERTRD+(CCAMPS(4,K)*COSA-CCAMPS(3,K)*SINA)*CCAMPS(5,K);
00932
00933
00934 }
00935
00936
00937 ESQ=E[1]*E[1];
00938
00939
00940 DPARAM=DC1-ESQ;
00941
00942
00943 PARAM=DPARAM;
00944
00945
00946 TWOE=E[1]+E[1];
00947
00948
00949 TWOG=G[1]+G[1];
00950
00951
00952
00953
00954 PHI=TWOE*((1.0-ESQ*0.125 )*sin(G[1])+E[1]*0.625 *sin(TWOG)
00955 +ESQ*0.5416667 *sin(G[1]+TWOG) ) ;
00956
00957
00958 F=G[1]+PHI;
00959
00960
00961 SINF=sin(F);
00962
00963
00964 COSF=cos(F);
00965
00966
00967 DPSI=DPARAM/(DC1+E[1]*COSF);
00968
00969
00970 PHID=TWOE*CCSGD*((1.0+ESQ*1.5 )*COSF+E[1]*(1.25 -SINF*SINF*0.5 ));
00971
00972
00973 PSID=CCSGD*E[1]*SINF/sqrt(PARAM);
00974
00975
00976 D1PDRO=(DC1+PERTR);
00977
00978
00979 DRD=D1PDRO*(PSID+DPSI*PERTRD);
00980
00981
00982 DRLD=D1PDRO*DPSI*(DCSLD+PHID+PERTLD);
00983
00984
00985 DTL=fmod(DML+PHI+PERTL, DC2PI);
00986
00987
00988 DSINLS=sin(DTL);
00989
00990
00991 DCOSLS=cos(DTL);
00992
00993
00994 DXHD = DRD*DCOSLS-DRLD*DSINLS;
00995
00996
00997 DYHD = DRD*DSINLS+DRLD*DCOSLS;
00998
00999
01000 PERTL =0.0;
01001
01002 PERTLD=0.0;
01003
01004 PERTP =0.0;
01005
01006 PERTPD=0.0;
01007
01008
01009 for (K = 1; K <= 3; K++) {
01010
01011 A=fmod(DCARGM(1,K)+DT*DCARGM(2,K), DC2PI);
01012
01013
01014 SINA =sin(A);
01015
01016
01017 COSA =cos(A);
01018
01019
01020 PERTL =PERTL +CCAMPM(1,K)*SINA;
01021
01022
01023 PERTLD=PERTLD+CCAMPM(2,K)*COSA;
01024
01025
01026 PERTP =PERTP +CCAMPM(3,K)*COSA;
01027
01028
01029 PERTPD=PERTPD-CCAMPM(4,K)*SINA;
01030
01031
01032 }
01033
01034
01035 TL=FORBEL(2)+PERTL;
01036
01037
01038 SINLM=sin(TL);
01039
01040
01041 COSLM=cos(TL);
01042
01043
01044 SIGMA=CCKM/(1.0+PERTP);
01045
01046
01047 A=SIGMA*(CCMLD+PERTLD);
01048
01049
01050 B=SIGMA*PERTPD;
01051
01052
01053 DXHD=DXHD+A*SINLM+B*COSLM;
01054
01055
01056 DYHD=DYHD-A*COSLM+B*SINLM;
01057
01058
01059 DZHD= -SIGMA*CCFDI* cos(FORBEL(3));
01060
01061
01062 DXBD=DXHD*DC1MME;
01063
01064
01065 DYBD=DYHD*DC1MME;
01066
01067 DZBD=DZHD*DC1MME;
01068
01069
01070 for (K = 1; K <= 4; K++) {
01071
01072
01073 PLON=FORBEL(K+3);
01074
01075
01076 POMG=SORBEL(K+1);
01077
01078
01079 PECC=SORBEL(K+9);
01080
01081
01082 TL=fmod(PLON+2.0*PECC* sin(PLON-POMG), CC2PI);
01083
01084
01085 SINLP(K)= sin(TL);
01086
01087
01088 COSLP(K)= cos(TL);
01089
01090
01091 DXBD=DXBD+CCPAMV(K)*(SINLP(K)+PECC*sin(POMG));
01092
01093
01094 DYBD=DYBD-CCPAMV(K)*(COSLP(K)+PECC*cos(POMG));
01095
01096
01097 DZBD=DZBD-CCPAMV(K)*SORBEL(K+13)*cos(PLON-SORBEL(K+5));
01098
01099
01100 }
01101
01102
01103 DCOSEP=cos(DEPS);
01104
01105 DSINEP=sin(DEPS);
01106
01107 DYAHD=DCOSEP*DYHD-DSINEP*DZHD;
01108
01109 DZAHD=DSINEP*DYHD+DCOSEP*DZHD;
01110
01111 DYABD=DCOSEP*DYBD-DSINEP*DZBD;
01112
01113 DZABD=DSINEP*DYBD+DCOSEP*DZBD;
01114
01115
01116 DVELH[1]=DXHD;
01117
01118 DVELH[2]=DYAHD;
01119
01120 DVELH[3]=DZAHD;
01121
01122
01123 DVELB[1]=DXBD;
01124
01125 DVELB[2]=DYABD;
01126
01127 DVELB[3]=DZABD;
01128
01129 for (N = 1; N <= 3; N++) {
01130
01131 DVELH[N]=DVELH[N]*1.4959787E8;
01132
01133 DVELB[N]=DVELB[N]*1.4959787E8;
01134
01135 }
01136
01137 return;
01138 }
01139
01140
01148
01149
01150 static void
01151 deg2dms(double in_val,
01152 double *degs,
01153 double *minutes,
01154 double *seconds)
01155 {
01156 deg2hms(in_val*15, degs, minutes, seconds);
01157 }
01158
01162 #define MIDAS_BUG 0
01163
01171
01172
01173 static void
01174 deg2hms(double in_val,
01175 double *hours,
01176 double *minutes,
01177 double *seconds)
01178 {
01179
01180
01181
01182
01183
01184
01185
01186
01187 double tmp;
01188
01189
01190
01191 char sign;
01192
01193
01194
01195
01196
01197
01198
01199
01200 if (in_val < 0) {
01201 in_val = fabs(in_val);
01202 sign = '-';
01203 }
01204 else {
01205 sign = '+';
01206 }
01207
01208
01210
01211 tmp = in_val / 15;
01212
01213
01214 #if MIDAS_BUG
01215 *hours= xsh_round_double(tmp);
01216 #else
01217 *hours= (int) tmp;
01218 #endif
01219
01220
01221 tmp = tmp - *hours;
01222
01223 tmp = tmp * 60;
01224
01225
01226 #if MIDAS_BUG
01227 *minutes= xsh_round_double(tmp);
01228 #else
01229 *minutes= (int) tmp;
01230 #endif
01231
01232
01233 tmp = tmp - *minutes;
01234
01235
01236 *seconds= tmp * 60;
01237
01238
01239
01240
01241 if (sign == '-') *hours = -(*hours);
01242
01243 return;
01244 }
01245
01248 #if 0
01249
01250
01251
01252
01253
01254
01255
01256
01257
01258
01259
01260
01261
01262
01263
01264
01265
01266
01267
01268
01269
01270
01271
01272
01273
01274
01275
01276
01277
01278
01279
01280 static void
01281 juldat(double *INDATE,
01282 double UTR,
01283 double *JD)
01284 {
01285
01286 double UT;
01287
01288
01289
01290
01291 int DATE[4];
01292
01293
01294
01295
01296
01297 UT=UTR / 24.0;
01298
01299
01300
01301
01302
01303
01304
01305
01306
01307
01308
01309
01310
01311
01312
01313
01314
01315
01316
01317
01318
01319
01320
01321
01322 DATE[1]=xsh_round_double(INDATE[1]);
01323
01324
01325 FRAC = 0;
01326
01327
01328 DATE[2]=xsh_round_double(INDATE[2]);
01329
01330 DATE[3]=xsh_round_double(INDATE[3]);
01331
01332
01333 if ((DATE[2] == 0) && (DATE[3] == 0)) {
01334
01335 DATE[2]=1;
01336
01337 DATE[3]=1;
01338
01339 }
01340
01341
01342
01343
01344
01345
01346
01347
01348
01349
01350
01351 if (DATE[2] > 2) {
01352
01353 YP=DATE[1];
01354
01355 P=DATE[2];
01356
01357 } else {
01358
01359 YP=DATE[1]-1;
01360
01361 P=DATE(2)+12.0;
01362
01363 }
01364
01365
01366 C = DATE[1] + DATE[2]*1.E-2 + DATE[3]*1.E-4 + UT*1.E-6;
01367
01368
01369 if (C > 1582.1015E0) {
01370
01371 IA=(int) (YP/100.D0);
01372
01373 A=IA;
01374
01375 IB=2-IA+((int)(A/4.D0));
01376
01377 } else {
01378
01379 IB=0;
01380
01381 }
01382
01383
01384
01385 *JD = ((int) (365.25E0*YP)) + ((int)(30.6001D0*(P+1.D0))) + DATE[3] + UT
01386 + IB + 1720994.5E0;
01387
01388
01389
01390
01391
01392 if (FRAC > 1.0E-6) {
01393
01394 ND=365;
01395
01396
01397 IF (C >= 1582.1015E0) {
01398
01399 IC = DATE[1] % 4;
01400
01401 if (IC == 0) {
01402
01403 ND=366;
01404
01405 IC = DATE[1] % 100;
01406
01407 if (IC == 0) {
01408
01409 IC = DATE[1] % 400;
01410
01411 if (IC != 0) ND=365;
01412
01413 }
01414
01415 }
01416
01417 }
01418
01419
01420 if (fabs(FRAC*ND-xsh_round_double(FRAC*ND)) > 0.3) {
01421
01422
01423
01424 xsh_msg_warning("Fraction of year MAY not correspond to "
01425 "integer number of days");
01426
01427 }
01428
01429
01430 *JD = *JD+xsh_round_double(FRAC*ND);
01431
01432 }
01433
01434
01435 return;
01436 }
01437 #endif