ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JSOC/proj/globalhs/apps/jv2ts.c
Revision: 1.25
Committed: Wed May 20 19:15:47 2015 UTC (8 years, 4 months ago) by tplarson
Content type: text/plain
Branch: MAIN
CVS Tags: globalhs_version_9, Ver_8-10, globalhs_version_12, globalhs_version_13, globalhs_version_10, globalhs_version_11, Ver_8-11, Ver_8-12
Changes since 1.24: +4 -4 lines
Log Message:
fix potential infinite loop

File Contents

# User Rev Content
1 tplarson 1.25
2 tplarson 1.4 /* this JSOC module is a combination of 3 SOI modules: v2helio, helio2mlat, qdotprod
3 tplarson 1.1 * ported by Tim Larson
4     * removes check on mapbmin, mapbmax, and maprows, these keywords are no longer carried
5     */
6    
7     /*
8 tplarson 1.9 * v2helio.c ~soi/(version)/src/modules/v2helio.c
9     *
10     * This module interpolates CCD velocity data to estimate values that
11     * would be obtained at specified equal increments of heliographic
12     * longitude and sine of latitude. Apodization and corrections for
13     * solar rotation and limbshift are included.
14     *
15     * Responsible: Kay Leibrand KLeibrand@solar.Stanford.EDU
16     *
17     * Bugs:
18     * This module is under development. Look for ??? in comments.
19     *
20     * Planned updates:
21     * Decide when and where and if default values should be used.
22     *
23     */
24    
25     /*
26     * helio2mlat.c ~soi/(version)/src/modules/helio2mlat.c
27     *
28     * Description:
29     * Adapted by Kay Leibrand from pipeLNU shtfft
30     * fft by map_rows. Use FORTRAN library Cmlib for float version.
31     * extends data to 360 degrees prior to transform but only saves
32     * cols up to lmax. Performs transpose needed prior to dotprod.
33     *
34     * Responsible: Kay Leibrand KLeibrand@solar.Stanford.EDU
35     *
36     * Bugs:
37     * This module is under development. Look for ??? in comments.
38     *
39     * Planned updates:
40     * Restructure to use functions?
41     * Refine parameter definitions and names to be consistent with
42     * new keywords and ancillary data flow.
43     * Fix phase
44     *
45     */
46    
47     /*
48 tplarson 1.1 * qdotprod.c ~soi/(version)/src/modules/qdotprod.c
49     *
50     * Description:
51     * Conversion of Jesper Schou's FORTRAN q(uick)dotprod to C
52     * from file ~schou/testdot/testdot4c.f
53     * uses FORTRAN functions from blas library
54     * contains optimizations, calculates masks, allows "chunking" in l
55     *
56     * Responsible: Kay Leibrand KLeibrand@solar.Stanford.EDU
57     *
58     * Bugs:
59     * Inadequate checks for consistency between data specifications,
60     * i.e. dataset names, and LMIN, LMAX, LCHUNK parameters.
61     * This module is under development. Look for ??? and TBD in comments.
62     * Normalization in plm's is different from PHS pipeLNU
63     *
64     * Planned updates:
65     * Fix known bugs.
66     * Use a consistent pointer style, i.e. pointer arith vs []
67     * Restructure to use functions.
68     * Refine parameter definitions and names to be consistent with
69     * new keywords and ancillary data flow.
70     *
71     * Revision history is at end of file.
72     */
73    
74     /* Normalization of the resulting time-series when norm != 0:
75    
76     Let the observed surface behaviour of an oscillation be given by
77     Re(exp(-i\omega t) Y_l^m (\theta,\phi)) with (Y_l^m)^2 normalized
78     to have an average of 1 over the unit sphere (this is 4\pi times
79     the usual definition where the integral is 1). Assume that the
80     whole (4\pi) Sun is observed with no velocity projection factor.
81     Then the resulting time series is given by exp(-i\omega t).
82    
83     This is equivalent to preserving the rms value of the real parts
84     of the oscillations.
85    
86     And maybe I got the implementation straight.
87    
88     */
89    
90     #include <stdio.h>
91     #include <math.h>
92     #include <stdlib.h>
93     #include <time.h>
94     #include <sys/time.h>
95     #include <sys/resource.h>
96     #include <fftw3.h>
97     #include "jsoc_main.h"
98 tplarson 1.9 #include "fstats.h"
99 tplarson 1.1 #include "drms_dsdsapi.h"
100     #include "errlog.h"
101 tplarson 1.21 #include "projection.h"
102 tplarson 1.23 #include "atoinc.h"
103 tplarson 1.1
104     #define ARRLENGTH(ARR) (sizeof(ARR)/sizeof(ARR[0]))
105     #define PI (M_PI)
106    
107     #define absval(x) (((x) < 0) ? (-(x)) : (x))
108     #define minval(x,y) (((x) < (y)) ? (x) : (y))
109     #define maxval(x,y) (((x) < (y)) ? (y) : (x))
110     #define very_small (1.0e-30)
111     #define is_very_small(x) (absval(x) < very_small)
112     #define is_even(x) (!((x)%2))
113     #define is_odd(x) ((x)%2)
114    
115     #define RADSINDEG (PI/180)
116     #define ARCSECSINRAD (3600*180/PI)
117     #define DAYSINYEAR (365.2425)
118     #define SECSINDAY (86400)
119     #define TAU_A (499.004783806) // light travel time in seconds, = 1 AU/c
120     //#define TAU_A (499.004782) // this value used in old v2helio
121     #define TCARR (25.38) // days
122     #define RTRUE (6.96000000e8) // meters
123     #define AU (149597870691) // meters/au
124     //#define AU (1.49597870e11) // this value used in old v2helio
125    
126 tplarson 1.20 #define QUAL_NODATA (0x80000000)
127     #define QUAL_MIXEDCALVER (0x00000001)
128 tplarson 1.1 #define kNOTSPECIFIED "not specified"
129    
130     char *module_name = "jv2ts";
131 tplarson 1.25 char *cvsinfo_jv2ts = "cvsinfo: $Header: /home/cvsuser/cvsroot/JSOC/proj/globalhs/apps/jv2ts.c,v 1.24 2014/01/15 19:08:00 tplarson Exp $";
132 tplarson 1.1
133     ModuleArgs_t module_args[] =
134     {
135     // these inputs are common to all modules
136     {ARG_STRING, "in", NULL, "input data records"},
137 tplarson 1.9 {ARG_STRING, "tsout", kNOTSPECIFIED, "output data series"},
138 tplarson 1.1 {ARG_STRING, "segin", kNOTSPECIFIED, "input data segment"},
139     {ARG_STRING, "segout", kNOTSPECIFIED, "output data segment"},
140 tplarson 1.21 {ARG_STRING, "histlink", "HISTORY", "name of link to ancillary dataseries for processing metadata. specify \"none\" to suppress warning messages."},
141 tplarson 1.1 {ARG_STRING, "srclink", "SRCDATA", "name of link to source data"}, // used only for jv2helio and jhelio2mlat output
142     {ARG_STRING, "v2hout", kNOTSPECIFIED, "output data series for jv2helio"},
143     {ARG_STRING, "h2mout", kNOTSPECIFIED, "output data series for jhelio2mlat"},
144     {ARG_INT, "PERM", "1", "set to 0 for transient records, nonzero for permanent records"},
145 tplarson 1.8 {ARG_INT, "VERB", "1", "option for level of verbosity: 0 gives only error and warning messages; >0 prints messages outside of loop; >1 prints messages inside loop; >2 for debugging output"},
146     {ARG_INT, "FORCEOUTPUT", "0", "option to specify behavior on missing inputs; 0 gives an error on missing or duplicate inputs, >0 makes outputs regardless"},
147     {ARG_STRING, "TAG", "none", "this parameter sets a keyword of the same name to the same value, usually used as an additional primekey"},
148 tplarson 1.23 {ARG_STRING, "VERSION", kNOTSPECIFIED, "this parameter sets a keyword of the same name to the same value, useful for selecting obsolete records"},
149 tplarson 1.20 {ARG_INT, "CALVERKEY", "2", "short integer bit mask determining which 4-bit fields of CALVER64 are permitted to change on input. set the bit to disallow change of the corresponding nybble."},
150 tplarson 1.1 // these are from jqdotprod
151     {ARG_INT, "LMIN", "0", "minimum l in output"},
152     // {ARG_INT, "LMAX", "0", "maximum l in output, take from input if 0"}, /* if 0, default is LMAX of in_sds */
153     {ARG_INT, "LCHUNK", "0", "increment in l on output, default is lmax+1"}, /* if 0, is LMAX+1 */
154     {ARG_INT, "NORM", "1", "set to nonzero to use cnorm=sinbdelta*sqrt(2) in sgemm call, otherwise use cnorm=1"}, /* Uses old norm if =0, see below */
155 tplarson 1.8 {ARG_TIME, "TSTART", NULL, "start time of first output record"},
156     {ARG_STRING, "TTOTAL", NULL, "total length of time in output"},
157 tplarson 1.1 {ARG_STRING, "TCHUNK", kNOTSPECIFIED, "length of output timeseries"},
158     // these are from jhelio2mlat
159     {ARG_INT, "LMAX", "300", "maximum l (maximum m) in the output, cannot be greater than MAPMMAX", NULL},
160     {ARG_INT, "SUBMEAN", "0", "nonzero subtracts mean of input image", NULL},
161     {ARG_INT, "NORMLIZE", "0", "nonzero multiplies by sqrt((fraction nonmissing)/2) for each row", NULL},
162     {ARG_INT, "CENTLONG", "1", "nonzero centers the longitude Fourier transform on the center of the remapped image", NULL},
163 tplarson 1.10 {ARG_INT, "ZEROMISS", "0", "zero sets any row containing a NaN to DRMS_MISSING", NULL},
164 tplarson 1.1 {ARG_INT, "LGAPOD", "0", "nonzero apodizes in longitude", NULL},
165     {ARG_DOUBLE, "LGAPMIN", "60.0", "start of longitude apodization, degrees", NULL},
166     {ARG_DOUBLE, "LGAPWIDT", "10.0", "width of longitude apodization, degrees", NULL},
167     // these are from jv2helio
168     {ARG_INT, "MAPMMAX", "1536", "determines mapcols", ""}, /* determines mapcols, default value is 3*512 */
169     {ARG_INT, "SINBDIVS", "512", "number of increments in sin latitude from 0 to 1", ""}, /* # of = increments in sinB from sin(0) to sin(PI/2) */
170     {ARG_FLOAT, "MAPRMAX", "0.95", "maximum image radius", ""},
171 tplarson 1.24 {ARG_INT, "NAN_BEYOND_RMAX", "0", "set to nonzero to set output to DRMS_MISSING outside MAPRMAX, otherwise uses 0.0 outside MAPRMAX"}, /* Non 0 sets data outside RMAX MISSING */
172 tplarson 1.1 {ARG_FLOAT, "MAPLGMAX", "72.0", "longitude maximum, degrees", ""}, /* degrees */
173     {ARG_FLOAT, "MAPLGMIN", "-72.0", "longitude minimum, degrees", ""},
174     {ARG_FLOAT, "MAPBMAX", "72.0", "latitude maximum, degrees, also used for minimum", ""},
175     {ARG_INT, "LGSHIFT", "0", "option for longitude shift: 0=none; 1=fixed rate; 2=nearest degree; 3=nearest tenth of a degree", ""}, /* 0=none; 1=fixed rate; 2=nearest Degree */
176     {ARG_TIME, "REF_T0", "1987.01.03_17:31:12_TAI", "reference time for computing fixed rate longitude shift", ""},
177     {ARG_FLOAT, "REF_L0", "0.0", "reference longitude for computing fixed rate longitude shift ", ""},
178     {ARG_FLOAT, "SOLAR_P", "999.0", "P-angle; if unset, taken from keywords", ""}, /* can't use D_MISSING here */
179     {ARG_FLOAT, "PSIGN", "1.0", "sign of SOLAR_P", ""}, /* Sign of P. For MWO data. */
180     {ARG_FLOAT, "PERR", "0.0", "fixed P-angle error, likely -0.22", ""}, /* Fixed P-angle error. Maybe -0.22. */
181     {ARG_FLOAT, "IERR", "0.0", "error in Carrington inclination, likely -0.10", ""}, /* Error in Carrington inclination. Maybe -0.10. */
182     {ARG_TIME, "REF_TB0", "2001.06.06_06:57:22_TAI", "reference time for computing correction to P and B angles, roughly when B0=0", ""},
183     {ARG_INT, "INTERPO", "1", "option for interpolation: 0=bilinear; 1=cubic convolution", ""}, /* 2 methods - see soi_fun.h */
184     {ARG_INT, "APODIZE", "0", "option for apodization: 0=none; 1=use true solar coordinates; 2=use ideal solar coordinates (b0=0)", ""}, /* see soi_fun.h or apodize.c */
185     {ARG_FLOAT, "APINNER", "0.90", "start of apodization in fractional image radius", ""}, /* start of apodization */
186     {ARG_FLOAT, "APWIDTH", "0.05", "width of apodization in fractional image radius", ""}, /* width of apodization */
187     {ARG_INT, "APEL", "0", "set to nonzero for elliptical apodization described by APX and APY", ""}, /* do elliptical apodization described by apx and apy */
188     {ARG_FLOAT, "APX", "1.00", "divide the x position by this before applying apodization", ""}, /* divide the x position by this before applying apodization */
189     {ARG_FLOAT, "APY", "1.00", "divide the y position by this before applying apodization", ""}, /* divide the y position by this before applying apodization */
190     {ARG_INT, "VCORLEV", "2", "option for velocity correction: 0=none; 1=subtract a model of differential rotation; 2=also divide by line of sight projection factor for purely radial velocities", ""}, /* 3 levels - see soi_fun.h*/
191 tplarson 1.24 {ARG_INT, "MCORLEV", "0", "option for magnetic correction: 0=none; 1=line of sight; 2=radial", ""}, /* 2 levels - see soi_fun.h*/
192 tplarson 1.1 {ARG_INT, "MOFFSETFLAG", "0", "set to nonzero to get BFITZERO from input record and subtract from data before interpolating", ""}, /* 1=apply BFITZERO correction*/
193     {ARG_FLOAT, "OUTSCALE", "1.0", "bscale to use for output", ""}, /* scale for output */
194     {ARG_FLOAT, "OUTBIAS", "0.0", "bzero to use for output", ""}, /* bias for scaled output */
195     {ARG_INT, "DISTORT", "0", "option for distortion correction: 0=none; 1=full disk(fd) data; 2=vector-weighted(vw) data", ""}, /* 0 for none, 1 for FD, 2 for vw */
196     {ARG_FLOAT, "CUBIC", "7.06E-9", "cubic distortion in fd units", ""}, /* Cubic distortion in FD units */
197     {ARG_FLOAT, "TILTALPHA", "2.59", "tilt of CCD, degrees", ""}, /* TILT of CCD in degrees */
198     {ARG_FLOAT, "TILTBETA", "56.0", "direction of CCD tilt, degrees", ""}, /* Direction of TILT in degrees */
199     {ARG_FLOAT, "TILTFEFF", "12972.629", "effective focal length", ""}, /* Effective focal length */
200     {ARG_INT, "OFLAG", "0", "set to nonzero to force reading orientation from keyword, otherwise \"SESW\" is assumed)", ""}, /* Non 0 skips checko (SESW assumed) */
201     {ARG_INT, "DATASIGN", "0", "value to multiply data; set to 0 to take DATASIGN from keyword, or 1.0 if not found", ""}, /* Non 0 forces datasign to value*/
202     {ARG_INT, "MAXMISSVALS", "0", "if >0, this becomes threshold on MISSVALS from keyword", ""}, /* max. allowed MISSING pixels */
203     {ARG_INT, "CARRSTRETCH", "0", "set to nonzero to correct for differential rotation according to DIFROT_[ABC]", ""}, /* 0 - don't correct for diff rot, 1 - correct */
204     {ARG_FLOAT, "DIFROT_A", "13.562", "A coefficient in differential rotation adjustment (offset)", ""}, /* A coefficient in diff rot adj (offset) */
205     {ARG_FLOAT, "DIFROT_B", "-2.04", "B coefficient (to sin(lat) ^ 2)", ""}, /* B coefficient (to sin(lat) ^ 2) */
206     {ARG_FLOAT, "DIFROT_C", "-1.4875", "C coefficient (to sin(lat) ^ 4)", ""}, /* C coefficient (to sin(lat) ^ 4) */
207    
208     {ARG_END}
209     };
210    
211     #include "saveparm.c"
212     #include "timing.c"
213 tplarson 1.8 #include "set_history.c"
214 tplarson 1.18 #include "calversfunctions.c"
215 tplarson 1.1
216 tplarson 1.21 int SetDistort(int dist, double cubic, double alpha, double beta, double feff, LIBPROJECTION_Dist_t *dOut);
217 tplarson 1.19
218 tplarson 1.21 int obs2helio(float *V, float *U, int xpixels, int ypixels, double x0, double y0, double BZero, double P,
219 tplarson 1.19 double S, double rsun, double Rmax, int interpolation, int cols, int rows, double Lmin,
220     double Ldelta, double Ladjust, double sinBdelta, double smajor, double sminor, double sangle,
221     double xscale, double yscale, const char *orientation, int mag_correction, int velocity_correction,
222     double obs_vr, double obs_vw, double obs_vn, double vsign, int NaN_beyond_rmax, int carrStretch,
223 tplarson 1.21 const LIBPROJECTION_Dist_t *distpars, float diffrotA, float diffrotB, float diffrotC,
224     LIBPROJECTION_RotRate_t *rRates, int size);
225 tplarson 1.19
226     int apodize(float *data, double b0, int cols, int rows, double Lmin, double Ldelta, double sinBdelta,
227     int apodlevel, double apinner, double apwidth, int apel, double apx, double apy);
228    
229     void setplm2(int lmin,int lmax,int m,long nx,int *indx,double *x,long nplm,double *plm,double *dplm);
230    
231 tplarson 1.21 //char *getshtversion(void);
232 tplarson 1.19
233 arta 1.3 /* forward decls for fortran functions */
234     void scopy_(int *, float *, int *, float *, int *);
235     void setplm_(int *, int *, int *, int *, int *, double *, int *, double *);
236     void sgemm_(); /* give up */
237    
238 tplarson 1.1 typedef enum
239     {
240     V2HStatus_Success,
241     V2HStatus_MissingParameter,
242     V2HStatus_IllegalTimeFormat,
243     V2HStatus_TimeConvFailed,
244     V2HStatus_Unimplemented,
245     V2HStatus_IllegalOrientation
246     } V2HStatus_t;
247    
248     static void CheckO(const char *orientation, V2HStatus_t *stat)
249     {
250     /* check for legal orientation string */
251     static char o[16];
252     char *c = o;
253    
254     if(!orientation)
255     {
256     *stat = V2HStatus_MissingParameter;
257     }
258     else if (4 != sscanf(orientation, "%[NS]%[EW]%[NS]%[EW]", c++, c++, c++, c++))
259     {
260     *stat = V2HStatus_IllegalOrientation;
261     }
262     else if ((o[0] == o[2]) && (o[1] == o[3]))
263     {
264     *stat = V2HStatus_IllegalOrientation;
265     }
266     else if ((o[0] !=o [2]) && (o[1] != o[3]))
267     {
268     *stat = V2HStatus_IllegalOrientation;
269     }
270     else
271     {
272     *stat = V2HStatus_Success;
273     }
274     }
275    
276     static inline void ParameterDef(int status,
277     char *pname,
278     double defaultp,
279     double *p,
280 tplarson 1.8 long long recnum,
281 tplarson 1.1 int verbflag)
282     {
283     /* logs warning and sets parameter to default value */
284     if (status != 0)
285     {
286     *p = defaultp;
287     if (verbflag)
288 tplarson 1.8 fprintf(stderr, "WARNING: default value %g used for %s, status = %d, recnum = %lld\n", defaultp, pname, status, recnum);
289 tplarson 1.1 }
290     }
291    
292     #define PARAMETER_ERROR(PNAME) \
293     if (status != DRMS_SUCCESS) \
294     { \
295 tplarson 1.8 fprintf(stderr, "ERROR: problem with required keyword %s, status = %d, T_REC = %s, recnum = %lld, histrecnum = %lld\n", PNAME, status, trecstr, inrec->recnum, histrecnum); \
296 tplarson 1.1 drms_free_array(inarr); \
297 tplarson 1.8 return 0; \
298 tplarson 1.1 }
299    
300    
301     int DoIt(void)
302     {
303     int newstat=0;
304     DRMS_RecChunking_t chunkstat = kRecChunking_None;
305     int fetchstat = DRMS_SUCCESS;
306     int status = DRMS_SUCCESS;
307 tplarson 1.8 char *inrecquery = NULL;
308 tplarson 1.1 char *outseries = NULL;
309     char *segnamein = NULL;
310     char *segnameout = NULL;
311 tplarson 1.8 DRMS_RecordSet_t *inrecset = NULL;
312 tplarson 1.1 DRMS_Record_t *inrec = NULL;
313     DRMS_Record_t *outrec = NULL;
314     DRMS_Segment_t *segin = NULL;
315     DRMS_Segment_t *segout = NULL;
316     DRMS_Array_t *inarr = NULL;
317     DRMS_Array_t *outarr = NULL;
318     DRMS_Type_t usetype = DRMS_TYPE_FLOAT;
319     DRMS_RecLifetime_t lifetime;
320     long long histrecnum=-1;
321     int length[2];
322    
323     double wt0, wt1, wt2, wt3, wt;
324     double ut0, ut1, ut2, ut3, ut;
325     double st0, st1, st2, st3, st;
326     double ct0, ct1, ct2, ct3, ct;
327    
328     TIME trec, tnow, UNIX_epoch = -220924792.000; /* 1970.01.01_00:00:00_UTC */
329     char trecstr[100], tstartstr[100];
330    
331 tplarson 1.6 int quality;
332 tplarson 1.1
333     float *v2hptr, *h2mptr;
334    
335     // from jqdotprod, norm changed to normflag
336     float *oddpart, *evenpart, *inptr, *workptr, *mptr, *outptr;
337     float *folded, *masks, *real4evenl, *real4oddl, *imag4evenl, *imag4oddl, *outx;
338    
339     /* used for setting up plm's */
340     double *plm, *saveplm, *latgrid;
341     int *indx;
342    
343     double sinBdelta;
344     double *plmptr;
345     float *maskptr;
346    
347     int nsn, fournsn, snx, maxnsn;
348     int lchunksize, lchunkfirst, lchunklast, lchunk, l;
349     int lmin, lmax;
350     int msize, mx, foldedsize;
351     int maprows, nlat, imagesize, latx, poslatx, neglatx, moffset, nlatx;
352     int i, m, modd, meven;
353     int lfirst, llast, ifirst, ilast, lstart, ldone;
354     int lfirsteven, llasteven, nevenl, lfirstodd, llastodd, noddl;
355     int fromoffset, tooffset, imageoffset;
356    
357     int increment1 = 1; /* for scopy call */
358     int increment2 = 2; /* for scopy call */
359    
360     /* arguments for sgemm call */
361     char transpose[] = "t";
362     char normal[] = "n";
363     float one = 1.0;
364     float zero = 0.0;
365     int normflag;
366     float cnorm; /* Constant to get proper normalization. */
367    
368 tplarson 1.9 double tstart, tepoch, tstep, tround, cadence, nseconds, chunksecs, cadence0;
369 tplarson 1.1 char *ttotal, *tchunk;
370     int nrecs, irec, trecind, bc, iset, ntimechunks;
371     int *bad;
372 tplarson 1.6 int ndt;
373 tplarson 1.1
374     // from jhelio2mlat, i, lmax duplicated.
375     double mean, norm=1.0, normx;
376     int subtract_mean, normalize, cent_long, zero_miss, lgapod;
377     double lgapmin, lgapwidt, lgapmax, lon;
378    
379     int row, col;
380     int lfft, mapped_lmax;
381     int mapcols2;
382     int nfft, nmean, nok, nout;
383    
384     float *buf, *bp, *ip, *inp, *op, *outp, *weight, *wp;
385     float *wbuf;
386     fftwf_plan fftwp;
387    
388     // from jv2helio, row, mapped_lmax, maprows, sinBdelta duplicated
389     V2HStatus_t vstat = V2HStatus_Success;
390     const char *orientationdef = "SESW ";
391     char *orientation = NULL;
392     int paramsign;
393     int longitude_shift, velocity_correction, interpolation, apodization;
394     int mag_correction;
395     int mag_offset;
396     int sinb_divisions, mapcols, nmax, nmin;
397     int carrStretch = 0;
398     float diffrotA = 0.0;
399     float diffrotB = 0.0;
400     float diffrotC = 0.0;
401     double tobs, tmearth, tref, trefb0;
402     double smajor, sminor, sangle;
403     double xscale, yscale, imagescale;
404     int xpixels, ypixels, pixels;
405     double obs_vr, obs_vw, obs_vn;
406     double b0, bmax, bmin;
407     double longmax, longmin, longmax_adjusted, longmin_adjusted, longinterval;
408     double p0, p, rmax;
409     double ierr, perr, psign;
410     double x0, y0;
411     double obsdist, longshift, obsl0, refl0, mapl0, longrate, rtrue, rsun, S;
412 tplarson 1.21 double rsunDef, rsunobs;
413 tplarson 1.1 int obsCR;
414     int apel;
415     double apinner, apwidth, apx, apy;
416     double scale, bias;
417     double colsperdeg;
418    
419     double satrot, instrot;
420     double dsignout, vsign;
421     int distsave;
422     double cubsave, tiltasave, tiltbsave, tiltfsave;
423 tplarson 1.21 LIBPROJECTION_Dist_t distP;
424 tplarson 1.1
425 tplarson 1.2 int errbufstat=setvbuf(stderr, NULL, _IONBF, BUFSIZ);
426     int outbufstat=setvbuf(stdout, NULL, _IONBF, BUFSIZ);
427    
428 tplarson 1.1 wt0=getwalltime();
429     ct0=getcputime(&ut0, &st0);
430    
431 tplarson 1.8 inrecquery = (char *)cmdparams_save_str(&cmdparams, "in", &newstat);
432 tplarson 1.9 outseries = (char *)cmdparams_save_str(&cmdparams, "tsout", &newstat);
433     int tsflag = strcmp(kNOTSPECIFIED, outseries);
434 tplarson 1.8 segnamein = (char *)cmdparams_save_str(&cmdparams, "segin", &newstat);
435     segnameout = (char *)cmdparams_save_str(&cmdparams, "segout", &newstat);
436 tplarson 1.1 int seginflag = strcmp(kNOTSPECIFIED, segnamein);
437     int segoutflag = strcmp(kNOTSPECIFIED, segnameout);
438     int verbflag = cmdparams_save_int(&cmdparams, "VERB", &newstat);
439     int permflag = cmdparams_save_int(&cmdparams, "PERM", &newstat);
440     if (permflag)
441     lifetime = DRMS_PERMANENT;
442     else
443     lifetime = DRMS_TRANSIENT;
444 tplarson 1.8 int forceoutput = cmdparams_save_int(&cmdparams, "FORCEOUTPUT", &newstat);
445     char *tag = (char *)cmdparams_save_str(&cmdparams, "TAG", &newstat);
446 tplarson 1.23 char *version = (char *)cmdparams_save_str(&cmdparams, "VERSION", &newstat);
447     int verflag = strcmp(kNOTSPECIFIED, version);
448 tplarson 1.20 unsigned short calverkey = (unsigned short)cmdparams_save_int(&cmdparams, "CALVERKEY", &newstat);
449 tplarson 1.1
450 tplarson 1.8 char *histlinkname = (char *)cmdparams_save_str(&cmdparams, "histlink", &newstat);
451     char *srclinkname = (char *)cmdparams_save_str(&cmdparams, "srclink", &newstat);
452 tplarson 1.1
453 tplarson 1.8 char *v2hout = (char *)cmdparams_save_str(&cmdparams, "v2hout", &newstat);
454     char *h2mout = (char *)cmdparams_save_str(&cmdparams, "h2mout", &newstat);
455 tplarson 1.1 int v2hflag = strcmp(kNOTSPECIFIED, v2hout);
456     int h2mflag = strcmp(kNOTSPECIFIED, h2mout);
457 tplarson 1.14 int histflag = strncasecmp("none", histlinkname, 4);
458 tplarson 1.1
459 tplarson 1.9 if (!v2hflag && !h2mflag && !tsflag)
460     {
461     fprintf(stderr, "ERROR: no outputs specified.\n");
462     return 1;
463     }
464    
465 tplarson 1.1 lmin=cmdparams_save_int(&cmdparams, "LMIN", &newstat);
466     lmax=cmdparams_save_int(&cmdparams, "LMAX", &newstat);
467     lchunksize=cmdparams_save_int(&cmdparams, "LCHUNK", &newstat);
468     normflag=cmdparams_save_int(&cmdparams, "NORM", &newstat);
469    
470     tstart=cmdparams_save_time(&cmdparams, "TSTART", &newstat);
471 tplarson 1.14 sprint_time(tstartstr, tstart, "TAI", 0);
472 tplarson 1.8 ttotal=(char *)cmdparams_save_str(&cmdparams, "TTOTAL", &newstat);
473 tplarson 1.23 nseconds=atoinc(ttotal);
474    
475     /*
476     if (strcmp(kNOTSPECIFIED, ttotal))
477     {
478     nseconds=atoinc(ttotal);
479     }
480     else
481     nseconds=0.0;
482     */
483     /*
484 arta 1.7 status=drms_names_parseduration(&ttotal, &nseconds, 1);
485 tplarson 1.16 if (status != DRMS_SUCCESS)
486 tplarson 1.8 {
487     fprintf(stderr, "ERROR: problem parsing TTOTAL, = %s\n", ttotal);
488     return 1;
489     }
490 tplarson 1.23 */
491 tplarson 1.8 tchunk=(char *)cmdparams_save_str(&cmdparams, "TCHUNK", &newstat);
492 tplarson 1.1 if (strcmp(kNOTSPECIFIED, tchunk))
493     {
494 tplarson 1.23 chunksecs=atoinc(tchunk);
495     /*
496 tplarson 1.8 status=drms_names_parseduration(&tchunk, &chunksecs, 1);
497 tplarson 1.16 if (status != DRMS_SUCCESS)
498 tplarson 1.1 newstat = newstat | CPSAVE_UNKNOWN_ERROR;
499 tplarson 1.23 */
500 tplarson 1.1 }
501 tplarson 1.9 else if (!tsflag)
502     {
503     fprintf(stderr, "ERROR: TCHUNK must be specified if no tsout is given.\n");
504     return 1;
505     }
506 tplarson 1.1 else
507 tplarson 1.23 chunksecs=0.0;
508 tplarson 1.1
509    
510     subtract_mean = cmdparams_save_int(&cmdparams, "SUBMEAN", &newstat);
511     normalize = cmdparams_save_int(&cmdparams, "NORMLIZE", &newstat);
512     /* CENTLONG=1 centers the longitude Fourier transform on the center
513     of the remapped image */
514     cent_long = cmdparams_save_int(&cmdparams, "CENTLONG", &newstat);
515     /* ZEROMISS=1 sets missing data to 0,
516     ZEROMISS=0 fills the output row with missing */
517     zero_miss = cmdparams_save_int(&cmdparams, "ZEROMISS", &newstat);
518     lgapod = cmdparams_save_int(&cmdparams, "LGAPOD", &newstat);
519     lgapmin = cmdparams_save_double(&cmdparams, "LGAPMIN", &newstat);
520     lgapwidt = cmdparams_save_double(&cmdparams, "LGAPWIDT", &newstat);
521     lgapmax = lgapmin+lgapwidt;
522    
523     int checko = cmdparams_save_int(&cmdparams, "OFLAG", &newstat);
524 tplarson 1.10 int NaN_beyond_rmax = cmdparams_save_int(&cmdparams, "NAN_BEYOND_RMAX", &newstat);
525 tplarson 1.1 int maxmissvals = cmdparams_save_int(&cmdparams, "MAXMISSVALS", &newstat);
526 tplarson 1.10 // float beyondrmax = cmdparams_save_float(&cmdparams, "BEYONDRMAX", &newstat);
527 tplarson 1.1
528     carrStretch = cmdparams_save_int(&cmdparams, "CARRSTRETCH", &newstat);
529     diffrotA = cmdparams_save_float(&cmdparams, "DIFROT_A", &newstat);
530     diffrotB = cmdparams_save_float(&cmdparams, "DIFROT_B", &newstat);
531     diffrotC = cmdparams_save_float(&cmdparams, "DIFROT_C", &newstat);
532    
533     longrate = 360.0 / TCARR - 360.0 / DAYSINYEAR; // degrees per day
534     longrate /= SECSINDAY; // degrees per sec
535    
536     apodization = cmdparams_save_int(&cmdparams, "APODIZE", &newstat);
537     apinner = cmdparams_save_double(&cmdparams, "APINNER", &newstat);
538     apwidth = cmdparams_save_double(&cmdparams, "APWIDTH", &newstat);
539     apel = cmdparams_save_int(&cmdparams, "APEL", &newstat);
540     apx = cmdparams_save_double(&cmdparams, "APX", &newstat);
541     apy = cmdparams_save_double(&cmdparams, "APY", &newstat);
542     longitude_shift = cmdparams_save_int(&cmdparams, "LGSHIFT", &newstat);
543     mag_correction = cmdparams_save_int(&cmdparams, "MCORLEV", &newstat);
544     mag_offset = cmdparams_save_int(&cmdparams, "MOFFSETFLAG", &newstat);
545     velocity_correction = cmdparams_save_int(&cmdparams, "VCORLEV", &newstat);
546     interpolation = cmdparams_save_int(&cmdparams, "INTERPO", &newstat);
547     paramsign = cmdparams_save_int(&cmdparams, "DATASIGN", &newstat);
548     rmax = cmdparams_save_double(&cmdparams, "MAPRMAX", &newstat);
549     refl0 = cmdparams_save_double(&cmdparams, "REF_L0", &newstat);
550    
551     distsave = cmdparams_save_int(&cmdparams, "DISTORT", &newstat);
552     cubsave = cmdparams_save_double(&cmdparams, "CUBIC", &newstat);
553     tiltasave = cmdparams_save_double(&cmdparams, "TILTALPHA", &newstat);
554     tiltbsave = cmdparams_save_double(&cmdparams, "TILTBETA", &newstat);
555     tiltfsave = cmdparams_save_double(&cmdparams, "TILTFEFF", &newstat);
556    
557     scale = cmdparams_save_double(&cmdparams, "OUTSCALE", &newstat);
558     bias = cmdparams_save_double(&cmdparams, "OUTBIAS", &newstat);
559     p0 = cmdparams_save_double(&cmdparams, "SOLAR_P", &newstat);
560     psign = cmdparams_save_double(&cmdparams, "PSIGN", &newstat);
561     perr = cmdparams_save_double(&cmdparams, "PERR", &newstat);
562     ierr = cmdparams_save_double(&cmdparams, "IERR", &newstat);
563     trefb0 = cmdparams_save_time(&cmdparams, "REF_TB0", &newstat);
564    
565     SetDistort(distsave, cubsave, tiltasave, tiltbsave, tiltfsave, &distP);
566    
567     tref = cmdparams_save_time(&cmdparams, "REF_T0", &newstat);
568    
569     // determine mapcols and adjust longmin and longmax */
570     mapped_lmax = cmdparams_save_int(&cmdparams, "MAPMMAX", &newstat);
571     longmax = cmdparams_save_double(&cmdparams, "MAPLGMAX", &newstat); /* degrees */
572     longmin = cmdparams_save_double(&cmdparams, "MAPLGMIN", &newstat); /* degrees */
573     longinterval = (180.0) / mapped_lmax; /* degrees */
574    
575     // This does not always handle the case where 1/longinterval is an integer correctly.
576    
577     // the next two statement do nothing, right?
578     // why do nmin and max keep getting set with different RHSs?
579     nmin = (int)(longmin / longinterval); // round towards 0
580     nmax = (int)(longmax / longinterval); // round towards 0
581     colsperdeg = mapped_lmax / 180.0;
582     nmin = (int)(longmin * colsperdeg); // round towards 0
583     nmax = (int)(longmax * colsperdeg); // round towards 0
584     mapcols = nmax - nmin + 1;
585     longmin_adjusted = nmin * longinterval;
586     longmax_adjusted = nmax * longinterval;
587    
588     // determine maprows, bmax, bmin, and sinBdelta
589     sinb_divisions = cmdparams_save_int(&cmdparams, "SINBDIVS", &newstat);
590     sinBdelta = 1.0/sinb_divisions;
591     bmax = cmdparams_save_double(&cmdparams, "MAPBMAX", &newstat); // degrees
592     bmin = -bmax;
593     nmax = (int)(sin(RADSINDEG*bmax)*sinb_divisions); // round towards 0
594     maprows = 2*nmax;
595    
596 tplarson 1.8 if (normflag == 0)
597     cnorm=1.0;
598     else
599     cnorm = sqrt(2.)*sinBdelta;
600    
601 tplarson 1.1 if (lmax > mapped_lmax || lmin > lmax)
602     {
603     fprintf(stderr, "ERROR: must have MAPMMAX >= LMAX >= LMIN, MAPMMAX = %d, LMAX= %d, LMIN = %d\n", mapped_lmax, lmax, lmin);
604     return 1;
605     }
606    
607 tplarson 1.8 if (newstat)
608     {
609     fprintf(stderr, "ERROR: problem with input arguments, status = %d, diagnosis follows\n", newstat);
610     cpsave_decode_error(newstat);
611     return 1;
612     }
613     else if (savestrlen != strlen(savestr))
614     {
615     fprintf(stderr, "ERROR: problem with savestr, savestrlen = %d, strlen(savestr) = %d\n", savestrlen, (int)strlen(savestr));
616     return 1;
617     }
618    
619 tplarson 1.9 DRMS_Record_t *tempoutrec;
620     DRMS_Link_t *histlink;
621     int itest;
622 tplarson 1.21 /*
623     // cvsinfo used to be passed in the call to set_history. now this information is encoded in CVSTAG, which is defined by a compiler flag in the make.
624 tplarson 1.17 char *cvsinfo;
625     cvsinfo = (char *)malloc(1024);
626 tplarson 1.25 strcpy(cvsinfo,"$Header: /home/cvsuser/cvsroot/JSOC/proj/globalhs/apps/jv2ts.c,v 1.24 2014/01/15 19:08:00 tplarson Exp $");
627 tplarson 1.17 strcat(cvsinfo,"\n");
628     strcat(cvsinfo,getshtversion());
629 tplarson 1.21 */
630 tplarson 1.9 // assume all output dataseries link to the same dataseries for HISTORY
631     if (tsflag)
632     {
633     tempoutrec = drms_create_record(drms_env, outseries, DRMS_TRANSIENT, &status);
634     if (status != DRMS_SUCCESS)
635     {
636     fprintf(stderr,"ERROR: couldn't open a record in output dataseries %s, status = %d\n", outseries, status);
637     return 1;
638     }
639 tplarson 1.1
640 tplarson 1.14 DRMS_Keyword_t *outkeytest = hcon_lookup_lower(&tempoutrec->keywords, "MAPMMAX");
641     if (outkeytest != NULL && outkeytest->info->recscope == 1)
642     {
643     int mapmmaxout=drms_getkey_int(tempoutrec, "MAPMMAX", &status);
644     if (mapmmaxout != mapped_lmax)
645     {
646     fprintf(stderr,"ERROR: output MAPMMAX=%d does not match input parameter MAPMMAX=%d, status = %d\n", mapmmaxout, mapped_lmax, status);
647     return 1;
648     }
649     }
650    
651     outkeytest = hcon_lookup_lower(&tempoutrec->keywords, "SINBDIVS");
652     if (outkeytest != NULL && outkeytest->info->recscope == 1)
653 tplarson 1.9 {
654 tplarson 1.14 int sinbdivsout=drms_getkey_int(tempoutrec, "SINBDIVS", &status);
655     if (sinbdivsout != sinb_divisions)
656 tplarson 1.9 {
657 tplarson 1.14 fprintf(stderr,"ERROR: output SINBDIVS=%d does not match input parameter SINBDIVS=%d, status = %d\n", sinbdivsout, sinb_divisions, status);
658     return 1;
659 tplarson 1.9 }
660     }
661 tplarson 1.14
662     // set up ancillary dataseries for processing metadata
663     if (histflag)
664 tplarson 1.9 {
665 tplarson 1.14 histlink = hcon_lookup_lower(&tempoutrec->links, histlinkname);
666     if (histlink != NULL)
667     {
668 tplarson 1.21 histrecnum=set_history(histlink);
669 tplarson 1.14 if (histrecnum < 0)
670     {
671     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
672     return 1;
673     }
674     }
675     else
676     {
677     fprintf(stderr,"WARNING: could not find history link in output dataseries\n");
678     }
679 tplarson 1.9 }
680 tplarson 1.1
681 tplarson 1.9 // these must be present in the output dataseries and variable, not links or constants
682 tplarson 1.14 char *outchecklist[] = {"T_START", "QUALITY", "LMIN", "LMAX", "NDT"};
683 tplarson 1.9 for (itest=0; itest < ARRLENGTH(outchecklist); itest++)
684     {
685     DRMS_Keyword_t *outkeytest = hcon_lookup_lower(&tempoutrec->keywords, outchecklist[itest]);
686     if (outkeytest == NULL || outkeytest->info->islink || outkeytest->info->recscope == 1)
687     {
688     fprintf(stderr, "ERROR: output keyword %s is either missing, constant, or a link\n", outchecklist[itest]);
689     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
690     return 1;
691     }
692     }
693 tplarson 1.1
694 tplarson 1.9 cadence0=drms_getkey_float(tempoutrec, "T_STEP", &status);
695     tepoch=drms_getkey_time(tempoutrec, "T_START_epoch", &status);
696     tstep=drms_getkey_float(tempoutrec, "T_START_step", &status);
697     tround=drms_getkey_float(tempoutrec, "T_START_round", &status);
698     if (fmod(tstart-tepoch,tstep) > tround/2)
699     {
700 tplarson 1.14 sprint_time(trecstr, tepoch, "TAI", 0);
701     fprintf(stderr, "ERROR: output dataseries seems incompatible with input parameters (tstep must divide tstart-tepoch): TSTART = %s, T_START_epoch = %s, tstep = %f\n",
702     tstartstr, trecstr, tstep);
703 tplarson 1.9 drms_close_record(tempoutrec, DRMS_FREE_RECORD);
704     return 1;
705     }
706     if (chunksecs == 0.0)
707     chunksecs = tstep;
708     else if (fmod(chunksecs,tstep))
709 tplarson 1.1 {
710 tplarson 1.9 fprintf(stderr, "ERROR: output dataseries seems incompatible with input parameters (tstep must divide chunksecs): chunksecs = %f, tstep = %f\n", chunksecs, tstep);
711 tplarson 1.4 drms_close_record(tempoutrec, DRMS_FREE_RECORD);
712 tplarson 1.1 return 1;
713     }
714 tplarson 1.9
715 tplarson 1.14 drms_close_record(tempoutrec, DRMS_FREE_RECORD);
716 tplarson 1.1 }
717 tplarson 1.14
718     if (v2hflag)
719 tplarson 1.1 {
720 tplarson 1.9 tempoutrec = drms_create_record(drms_env, v2hout, DRMS_TRANSIENT, &status);
721     if (status != DRMS_SUCCESS)
722     {
723     fprintf(stderr,"ERROR: couldn't open a record in output dataseries %s, status = %d\n", v2hout, status);
724     return 1;
725     }
726    
727     // set up ancillary dataseries for processing metadata
728 tplarson 1.14 if (histflag && histrecnum < 0)
729 tplarson 1.9 {
730 tplarson 1.14 histlink = hcon_lookup_lower(&tempoutrec->links, histlinkname);
731     if (histlink != NULL)
732 tplarson 1.9 {
733 tplarson 1.21 histrecnum=set_history(histlink);
734 tplarson 1.14 if (histrecnum < 0)
735     {
736     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
737     return 1;
738     }
739     }
740     else
741     {
742     fprintf(stderr,"WARNING: could not find history link in output dataseries\n");
743 tplarson 1.9 }
744     }
745 tplarson 1.1
746     // these must be present in the output dataseries and variable, not links or constants
747 tplarson 1.9 char *outchecklist[] = {"T_REC", "QUALITY", "CRPIX1", "CRVAL1", "CDELT1", "CRPIX2", "CROTA2", "CDELT2" };
748     for (itest=0; itest < ARRLENGTH(outchecklist); itest++)
749 tplarson 1.1 {
750 tplarson 1.9 DRMS_Keyword_t *outkeytest = hcon_lookup_lower(&tempoutrec->keywords, outchecklist[itest]);
751     if (outkeytest == NULL || outkeytest->info->islink || outkeytest->info->recscope == 1)
752     {
753     fprintf(stderr, "ERROR: output keyword %s is either missing, constant, or a link\n", outchecklist[itest]);
754     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
755     return 1;
756     }
757 tplarson 1.1 }
758    
759 tplarson 1.14 drms_close_record(tempoutrec, DRMS_FREE_RECORD);
760 tplarson 1.4 }
761 tplarson 1.14
762     if (h2mflag)
763 tplarson 1.4 {
764 tplarson 1.9 tempoutrec = drms_create_record(drms_env, h2mout, DRMS_TRANSIENT, &status);
765     if (status != DRMS_SUCCESS)
766     {
767     fprintf(stderr,"ERROR: couldn't open a record in output dataseries %s, status = %d\n", h2mout, status);
768     return 1;
769     }
770    
771     // set up ancillary dataseries for processing metadata
772 tplarson 1.14 if (histflag && histrecnum < 0)
773 tplarson 1.9 {
774 tplarson 1.14 histlink = hcon_lookup_lower(&tempoutrec->links, histlinkname);
775     if (histlink != NULL)
776 tplarson 1.9 {
777 tplarson 1.21 histrecnum=set_history(histlink);
778 tplarson 1.14 if (histrecnum < 0)
779     {
780     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
781     return 1;
782     }
783     }
784     else
785     {
786     fprintf(stderr,"WARNING: could not find history link in output dataseries\n");
787 tplarson 1.9 }
788     }
789    
790     // these must be present in the output dataseries and variable, not links or constants
791     char *outchecklist[] = {"T_REC", "QUALITY", "CRPIX1", "CDELT1", "CRPIX2", "CDELT2" };
792     for (itest=0; itest < ARRLENGTH(outchecklist); itest++)
793     {
794     DRMS_Keyword_t *outkeytest = hcon_lookup_lower(&tempoutrec->keywords, outchecklist[itest]);
795     if (outkeytest == NULL || outkeytest->info->islink || outkeytest->info->recscope == 1)
796     {
797     fprintf(stderr, "ERROR: output keyword %s is either missing, constant, or a link\n", outchecklist[itest]);
798     drms_close_record(tempoutrec, DRMS_FREE_RECORD);
799     return 1;
800     }
801     }
802    
803 tplarson 1.14 drms_close_record(tempoutrec, DRMS_FREE_RECORD);
804 tplarson 1.4 }
805 tplarson 1.14
806 tplarson 1.9
807 tplarson 1.4 if (fmod(nseconds,chunksecs) != 0.0)
808     {
809 tplarson 1.14 fprintf(stderr, "ERROR: input parameters seem incompatible (chunksecs must divide totalsecs): totalsecs = %f, chunksecs = %f\n", nseconds, chunksecs);
810 tplarson 1.8 return 1;
811 tplarson 1.4 }
812     ntimechunks=nseconds/chunksecs;
813    
814 tplarson 1.8 inrecset = drms_open_recordset(drms_env, inrecquery, &status);
815     if (status != DRMS_SUCCESS || inrecset == NULL)
816     {
817     fprintf(stderr, "ERROR: problem opening input recordset: status = %d\n", status);
818     return 1;
819     }
820 tplarson 1.1
821 tplarson 1.20 int nrecsin = drms_count_records(drms_env, inrecquery, &status);
822     if (status != DRMS_SUCCESS)
823     {
824     fprintf(stderr, "ERROR: problem counting input records: status = %d, nrecs = %d\n", status, nrecsin);
825     drms_close_records(inrecset, DRMS_FREE_RECORD);
826     return 1;
827     }
828     if (nrecsin == 0)
829     {
830     fprintf(stderr, "ERROR: input recordset contains no records. if such was intended use jretile instead.\n");
831     drms_close_records(inrecset, DRMS_FREE_RECORD);
832     return 1;
833     }
834    
835     //the above replaces the following. drms_open_recordset() no longer fills in the number of records.
836     /*
837 tplarson 1.8 if (inrecset->n == 0)
838 tplarson 1.1 {
839 tplarson 1.8 fprintf(stderr, "ERROR: input recordset contains no records. if such was intended use jretile instead.\n");
840     drms_close_records(inrecset, DRMS_FREE_RECORD);
841     return 1;
842 tplarson 1.1 }
843 tplarson 1.20 */
844 tplarson 1.1
845     if (verbflag)
846 tplarson 1.20 printf("input recordset opened, nrecs = %d\n", nrecsin);
847 tplarson 1.1
848 tplarson 1.8 inrec = drms_recordset_fetchnext(drms_env, inrecset, &fetchstat, &chunkstat, NULL);
849 tplarson 1.1
850 tplarson 1.8 // these must be present in the input dataseries
851 tplarson 1.12 char *inchecklist[] = {"T_REC", "QUALITY", "T_OBS", "CRLT_OBS", "CRLN_OBS", "CADENCE",
852 tplarson 1.14 // "SAT_ROT", "INST_ROT", "IM_SCALE",
853 tplarson 1.6 "CDELT1", "CDELT2"};
854 tplarson 1.1
855 tplarson 1.21 DRMS_Keyword_t *inkeytest;
856 tplarson 1.1 for (itest=0; itest < ARRLENGTH(inchecklist); itest++)
857     {
858 tplarson 1.21 inkeytest = hcon_lookup_lower(&inrec->keywords, inchecklist[itest]);
859 tplarson 1.8 if (inkeytest == NULL)
860 tplarson 1.1 {
861     fprintf(stderr, "ERROR: required input keyword %s is missing\n", inchecklist[itest]);
862 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
863     return 1;
864 tplarson 1.1 }
865     }
866    
867 tplarson 1.21 int readrsunref=0;
868     double rsunref;
869     inkeytest = hcon_lookup_lower(&inrec->keywords, "RSUN_REF");
870     if (inkeytest == NULL)
871     rtrue = RTRUE/AU;
872     else if (inkeytest->info->recscope == 1)
873     {
874     rsunref = drms_getkey_double(inrec, "RSUN_REF", &status);
875     ParameterDef(status, "RSUN_REF", RTRUE, &rsunref, inrec->recnum, 1);
876     rtrue=rsunref/AU;
877     }
878     else
879     readrsunref=1;
880 tplarson 1.1
881     trec = drms_getkey_time(inrec, "T_REC", &status);
882 tplarson 1.8 if (status != DRMS_SUCCESS)
883 tplarson 1.1 {
884     fprintf(stderr, "ERROR: problem with required parameter T_REC: status = %d, recnum = %lld\n", status, inrec->recnum);
885 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
886     return 1;
887 tplarson 1.1 }
888     sprint_time(trecstr, trec, "TAI", 0);
889    
890     cadence=drms_getkey_float(inrec, "CADENCE", &status);
891 tplarson 1.8 if (status != DRMS_SUCCESS)
892 tplarson 1.1 {
893 tplarson 1.14 fprintf(stderr, "ERROR: problem with required parameter CADENCE: status = %d, T_REC = %s, recnum = %lld\n", status, trecstr, inrec->recnum);
894 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
895     return 1;
896 tplarson 1.1 }
897 tplarson 1.11
898 tplarson 1.9 if (!forceoutput)
899     {
900 tplarson 1.20 if (nrecsin != nseconds/cadence)
901 tplarson 1.9 {
902     fprintf(stderr, "ERROR: input recordset does not contain a record for every slot.\n");
903     drms_close_records(inrecset, DRMS_FREE_RECORD);
904     return 1;
905     }
906     }
907 tplarson 1.6
908 tplarson 1.9 if (tsflag && cadence != cadence0)
909 tplarson 1.8 {
910 tplarson 1.14 fprintf(stderr, "ERROR: input CADENCE does not match output T_STEP: status = %d, T_REC = %s, recnum = %lld\n", status, trecstr, inrec->recnum);
911 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
912     return 1;
913     }
914 tplarson 1.1
915     nrecs=chunksecs/cadence;
916     maxnsn=nsn=nrecs;
917     fournsn=4*nsn;
918    
919     if (verbflag)
920     printf("ntimechunks = %d, recs per timechunk = %d\n", ntimechunks, nrecs);
921    
922    
923     if (trec >= tstart + nseconds)
924     {
925 tplarson 1.4 fprintf(stderr, "ERROR: no records processed: first input record is after last output record: T_REC = %s\n", trecstr);
926 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
927     return 1;
928 tplarson 1.1 }
929    
930     while (trec < tstart && chunkstat != kRecChunking_NoMoreRecs)
931     {
932 tplarson 1.14 fprintf(stderr, "WARNING: input record will not be included in output: T_REC = %s, TSTART = %s \n", trecstr, tstartstr);
933 tplarson 1.8 inrec = drms_recordset_fetchnext(drms_env, inrecset, &fetchstat, &chunkstat, NULL);
934     if (inrec != NULL)
935 tplarson 1.1 {
936     trec = drms_getkey_time(inrec, "T_REC", &status);
937     sprint_time(trecstr, trec, "TAI", 0);
938     }
939     }
940     if (chunkstat == kRecChunking_NoMoreRecs)
941     {
942 tplarson 1.4 fprintf(stderr,"ERROR: no records processed: last input record is before first output record: T_REC = %s\n", trecstr);
943 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
944     return 1;
945 tplarson 1.1 }
946    
947     msize = lmax+1;
948     if (lchunksize == 0) lchunksize = msize;
949    
950     nlat = maprows/2;
951     imagesize = maprows*2*msize; /* out image could be smaller than in */
952    
953     nout = 2 * (lmax + 1);
954    
955     lfft = 2 * mapped_lmax;
956     nfft = lfft + 2;
957     mapcols2 = mapcols/2;
958    
959     /* Let's try this since SGI's like odd leading dimensions of the first
960     array in sgemm */
961 tplarson 1.14 // nlatx=2*(nlat/2)+1;
962 tplarson 1.1
963     /* make nlatx divisible by 4 on linux systems */
964 tplarson 1.14 //#ifdef __linux__
965 tplarson 1.1 if (nlat % 4)
966     nlatx=4*(nlat/4+1);
967     else
968     nlatx=nlat;
969 tplarson 1.14 //#endif
970 tplarson 1.1
971 tplarson 1.14 DRMS_RecordSet_t *outrecset, *v2hrecset, *h2mrecset;
972 tplarson 1.9 if (tsflag)
973     {
974     real4evenl = (float *)(malloc (nlatx*maxnsn*sizeof(float)));
975     real4oddl = (float *)(malloc (nlatx*maxnsn*sizeof(float)));
976     imag4evenl = (float *)(malloc (nlatx*maxnsn*sizeof(float)));
977     imag4oddl = (float *)(malloc (nlatx*maxnsn*sizeof(float)));
978     outx = (float *)(malloc (maxnsn*2*lchunksize*sizeof(float)));
979    
980     plm = (double *)(malloc ((lmax+1)*nlat*sizeof(double)));
981     saveplm = (double *)(malloc ((lmax+1)*nlat*2*sizeof(double)));
982     latgrid = (double *)(malloc (nlat*sizeof(double)));
983     for (i=0; i<nlat; i++) latgrid[i] = (i+0.5)*sinBdelta;
984    
985     indx = (int *)(malloc ((lmax+1)*sizeof(int)));
986     for (l=0; l<=lmax; l++) indx[l]=l;
987    
988     masks = (float *)(malloc (nlat*lchunksize*sizeof(float)));
989     foldedsize = 4*nlat*(lmax+1)*maxnsn;
990     folded = (float *)(malloc (foldedsize*sizeof(float)));
991     oddpart = (float *)(malloc (nlat*sizeof(float)));
992     evenpart = (float *)(malloc (nlat*sizeof(float)));
993 tplarson 1.14
994     lchunkfirst = lmin/lchunksize;
995     lchunklast = lmax/lchunksize;
996     int nlchunks = (lchunklast - lchunkfirst) + 1;
997     int nrecsout = nlchunks*ntimechunks;
998     outrecset = drms_create_records(drms_env, nrecsout, outseries, lifetime, &status);
999     if (status != DRMS_SUCCESS || outrecset == NULL)
1000     {
1001     fprintf(stderr,"ERROR: unable to create records in output dataseries %s, status = %d\n", outseries, status);
1002     drms_close_records(inrecset, DRMS_FREE_RECORD);
1003     return 1;
1004     }
1005    
1006     }
1007    
1008     if (v2hflag)
1009     {
1010 tplarson 1.20 v2hrecset = drms_create_records(drms_env, nrecsin, v2hout, lifetime, &status);
1011 tplarson 1.14 if (status != DRMS_SUCCESS || v2hrecset == NULL)
1012     {
1013     fprintf(stderr,"ERROR: unable to create records in output dataseries %s, status = %d\n", v2hout, status);
1014     drms_close_records(inrecset, DRMS_FREE_RECORD);
1015     return 1;
1016     }
1017     }
1018    
1019     if (h2mflag)
1020     {
1021 tplarson 1.20 h2mrecset = drms_create_records(drms_env, nrecsin, h2mout, lifetime, &status);
1022 tplarson 1.14 if (status != DRMS_SUCCESS || h2mrecset == NULL)
1023     {
1024     fprintf(stderr,"ERROR: unable to create records in output dataseries %s, status = %d\n", h2mout, status);
1025     drms_close_records(inrecset, DRMS_FREE_RECORD);
1026     return 1;
1027     }
1028 tplarson 1.9 }
1029 tplarson 1.1
1030 tplarson 1.14
1031 tplarson 1.1 bad = (int *)(malloc (nrecs*sizeof(int)));
1032     v2hptr = (float *)(malloc(maprows*mapcols*sizeof(float)));
1033     h2mptr = (float *)(malloc(maprows*nout*sizeof(float)));
1034    
1035     /* get working buffer */
1036     buf = (float *)malloc(nfft * sizeof(float));
1037    
1038     wbuf = (float *)malloc(nfft * sizeof(float));
1039     fftwp = fftwf_plan_r2r_1d(lfft, buf, wbuf, FFTW_R2HC, FFTW_ESTIMATE);
1040    
1041     /* get weight array for apodizing */
1042     weight = (float *)malloc(nfft * sizeof(float));
1043    
1044     wp = weight;
1045     for (col=0; col<mapcols; col++)
1046     {
1047     if (lgapod)
1048     {
1049     lon=abs(col-mapcols2)*360.0/(2*mapped_lmax);
1050     if (lon < lgapmin)
1051     *wp++=1.0;
1052     else if (lon < lgapmax)
1053     *wp++=0.5+0.5*cos(PI*(lon-lgapmin)/lgapwidt);
1054     else
1055     *wp++=0.0;
1056     }
1057     else
1058     *wp++ = 1.0;
1059     }
1060    
1061 tplarson 1.8 status=drms_stage_records(inrecset, 1, 0);
1062     if (status != DRMS_SUCCESS)
1063     {
1064     fprintf(stderr, "ERROR: drms_stage_records returned status = %d\n", status);
1065     return 1;
1066     }
1067 tplarson 1.1
1068 tplarson 1.20 unsigned long long calversout, calvers;
1069 tplarson 1.15 int calversunset=1;
1070 tplarson 1.20 unsigned int nybblearrout[16] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
1071     int fixflagarr[16] = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
1072     for (i=0;i<16;i++)
1073     {
1074     if (getbits(calverkey,i,1))
1075     fixflagarr[i]=1;
1076     }
1077    
1078     int mixflag=0;
1079 tplarson 1.15
1080 tplarson 1.4 int nrecords=0;
1081     int nsegments=0;
1082     int error=0;
1083     int nodata=0;
1084 tplarson 1.14 int irecout=0;
1085     int iv2hrec=0;
1086     int ih2mrec=0;
1087 tplarson 1.1 for (iset=0; iset < ntimechunks && chunkstat != kRecChunking_NoMoreRecs; iset++)
1088     {
1089     sprint_time(tstartstr, tstart, "TAI", 0);
1090     if (verbflag)
1091     {
1092     wt1=getwalltime();
1093     ct1=getcputime(&ut1, &st1);
1094     printf("processing timechunk %d, tstart = %s\n", iset, tstartstr);
1095     }
1096    
1097     if (trec >= tstart+chunksecs)
1098     {
1099 tplarson 1.8 if (forceoutput)
1100     {
1101     nodata=1;
1102     goto skip_norecs;
1103     }
1104     else
1105     {
1106     fprintf(stderr, "ERROR: no data for timechunk beginning at %s\n", tstartstr);
1107     error++;
1108     tstart+=chunksecs;
1109     continue;
1110     }
1111 tplarson 1.1 }
1112    
1113 tplarson 1.4 while (trec < tstart && chunkstat != kRecChunking_NoMoreRecs)
1114     {
1115 tplarson 1.8 inrec = drms_recordset_fetchnext(drms_env, inrecset, &fetchstat, &chunkstat, NULL);
1116 tplarson 1.6 if (inrec != NULL)
1117 tplarson 1.4 {
1118     trec = drms_getkey_time(inrec, "T_REC", &status);
1119     sprint_time(trecstr, trec, "TAI", 0);
1120     }
1121     }
1122    
1123 tplarson 1.1 bc=0;
1124 tplarson 1.4 nodata=0;
1125 tplarson 1.20 mixflag=0;
1126     calversunset=1;
1127 tplarson 1.8 trecind=(trec-tstart+cadence/2)/cadence;
1128 tplarson 1.1
1129 tplarson 1.8 for (irec=0; irec < nrecs && chunkstat != kRecChunking_NoMoreRecs; irec++)
1130 tplarson 1.1 {
1131 tplarson 1.8
1132     if (trecind > irec)
1133     //some inputs were missing
1134 tplarson 1.1 {
1135 tplarson 1.8 if (forceoutput)
1136     {
1137     bad[bc++]=irec;
1138     continue;
1139     }
1140     else
1141     {
1142     fprintf(stderr, "ERROR: some input records missing, T_START = %s, T_REC = %s, irec = %d\n", tstartstr, trecstr, irec);
1143     error++;
1144     goto continue_outer_loop;
1145     }
1146     }
1147    
1148 tplarson 1.25 while (trecind < irec && chunkstat != kRecChunking_NoMoreRecs)
1149 tplarson 1.8 //T_REC is duplicated in input
1150     {
1151     if (forceoutput)
1152     {
1153     inrec = drms_recordset_fetchnext(drms_env, inrecset, &fetchstat, &chunkstat, NULL);
1154     if (inrec != NULL)
1155     {
1156     trec = drms_getkey_time(inrec, "T_REC", &status);
1157     sprint_time(trecstr, trec, "TAI", 0);
1158     trecind=(trec-tstart+cadence/2)/cadence;
1159     }
1160     }
1161     else
1162     {
1163     fprintf(stderr, "ERROR: some input records have duplicate T_REC, T_START = %s, T_REC = %s, irec = %d\n", tstartstr, trecstr, irec);
1164     error++;
1165     goto continue_outer_loop;
1166     }
1167 tplarson 1.1 }
1168    
1169     if (verbflag > 1)
1170     {
1171     wt2=getwalltime();
1172     ct2=getcputime(&ut2, &st2);
1173     printf(" processing record %d\n", irec);
1174     }
1175    
1176     quality=drms_getkey_int(inrec, "QUALITY", &status);
1177     if (status != DRMS_SUCCESS || (quality & QUAL_NODATA)) //may want stricter test on quality here
1178     {
1179     bad[bc++]=irec;
1180 tplarson 1.18 if (verbflag > 2)
1181 tplarson 1.8 fprintf(stderr, "SKIP: image rejected based on quality: T_REC = %s, quality = %08x\n", trecstr, quality);
1182 tplarson 1.1 goto skip;
1183     }
1184    
1185 tplarson 1.20 if (tsflag)
1186 tplarson 1.15 {
1187 tplarson 1.20 if (calversunset)
1188     {
1189     calversout=drms_getkey_longlong(inrec, "CALVER64", &status);
1190     if (status != DRMS_SUCCESS)
1191     calversout = 0;
1192     else
1193     calversout = fixcalver64(calversout);
1194     calversunset=0;
1195    
1196     for (i=0;i<16;i++)
1197     nybblearrout[i]=getbits(calversout,4*i+3,4);
1198    
1199     }
1200    
1201     calvers=drms_getkey_longlong(inrec, "CALVER64", &status);
1202 tplarson 1.15 if (status != DRMS_SUCCESS)
1203 tplarson 1.20 calvers = 0;
1204 tplarson 1.18 else
1205 tplarson 1.20 calvers = fixcalver64(calvers);
1206 tplarson 1.15
1207 tplarson 1.20 for (i=0;i<16;i++)
1208     {
1209     int nybble=getbits(calvers,4*i+3,4);
1210     if (fixflagarr[i])
1211     {
1212     if (nybble != nybblearrout[i])
1213     {
1214     fprintf(stderr, "ERROR: input data has mixed values for field %d of CALVER64: %d and %d, recnum = %lld, histrecnum = %lld\n", i, nybblearrout[i], nybble, inrec->recnum, histrecnum);
1215     error++;
1216     goto continue_outer_loop;
1217     }
1218     }
1219     else
1220     {
1221     if (nybble < nybblearrout[i])
1222     nybblearrout[i]=nybble;
1223     }
1224     }
1225 tplarson 1.15
1226 tplarson 1.20 if (!mixflag && calvers != calversout)
1227     mixflag=1;
1228 tplarson 1.15 }
1229    
1230 tplarson 1.20
1231 tplarson 1.1 if (seginflag)
1232     segin = drms_segment_lookup(inrec, segnamein);
1233     else
1234     segin = drms_segment_lookupnum(inrec, 0);
1235 tplarson 1.16 if (segin != NULL)
1236 tplarson 1.1 inarr = drms_segment_read(segin, usetype, &status);
1237    
1238 tplarson 1.8 if (segin == NULL || inarr == NULL || status != DRMS_SUCCESS)
1239 tplarson 1.1 {
1240 tplarson 1.8 fprintf(stderr, "ERROR: problem with input segment or array: status = %d, T_REC = %s, recnum = %lld, histrecnum = %lld\n", status, trecstr, inrec->recnum, histrecnum);
1241     return 0;
1242 tplarson 1.1 }
1243    
1244     if (maxmissvals > 0)
1245     {
1246     int missvals = drms_getkey_int(inrec, "MISSVALS", &status);
1247     PARAMETER_ERROR("MISSVALS")
1248     if (missvals > maxmissvals)
1249     {
1250     bad[bc++]=irec;
1251 tplarson 1.8 if (verbflag > 1)
1252     fprintf(stderr, "SKIP: %d pixels MISSING, max allowed is %d: T_REC = %s, recnum = %lld\n", missvals, maxmissvals, trecstr, inrec->recnum);
1253 tplarson 1.1 drms_free_array(inarr);
1254     goto skip;
1255     }
1256     }
1257    
1258     tobs = drms_getkey_time(inrec, "T_OBS", &status);
1259     PARAMETER_ERROR("T_OBS")
1260    
1261     // MDI keyword was OBS_B0
1262     b0 = drms_getkey_double(inrec, "CRLT_OBS", &status);
1263     PARAMETER_ERROR("CRLT_OBS")
1264    
1265     // MDI keyword was OBS_L0
1266     obsl0 = drms_getkey_double(inrec, "CRLN_OBS", &status);
1267     PARAMETER_ERROR("CRLN_OBS")
1268    
1269     if (p0 == 999.0)
1270     {
1271     // MDI keyword was SOLAR_P = -(SAT_ROT + INST_ROT)
1272 tplarson 1.6 /*
1273 tplarson 1.1 satrot = drms_getkey_double(inrec, "SAT_ROT", &status);
1274     PARAMETER_ERROR("SAT_ROT")
1275     instrot = drms_getkey_double(inrec, "INST_ROT", &status);
1276     PARAMETER_ERROR("INST_ROT")
1277     p=-(satrot+instrot);
1278 tplarson 1.6 */
1279     double crota = drms_getkey_double(inrec, "CROTA2", &status);
1280     PARAMETER_ERROR("CROTA2")
1281     p=-crota;
1282 tplarson 1.1 }
1283     else
1284     {
1285     p = p0;
1286     }
1287    
1288     p = psign * p ;
1289     b0 = b0 + ierr * sin((tobs - trefb0) / 31557600. * 2 * PI);
1290     p = p + perr - ierr * cos((tobs - trefb0) / 31557600. * 2 * PI);
1291    
1292     // S_MAJOR, S_MINOR, S_ANGLE, X_SCALE, Y_SCALE were MDI keywords, not used for HMI, but still necessary for GONG data
1293     smajor = drms_getkey_double(inrec, "S_MAJOR", &status);
1294 tplarson 1.8 ParameterDef(status, "S_MAJOR", 1.0, &smajor, inrec->recnum, 0);
1295 tplarson 1.1
1296     sminor = drms_getkey_double(inrec, "S_MINOR", &status);
1297 tplarson 1.8 ParameterDef(status, "S_MINOR", 1.0, &sminor, inrec->recnum, 0);
1298 tplarson 1.1
1299     sangle = drms_getkey_double(inrec, "S_ANGLE", &status);
1300 tplarson 1.8 ParameterDef(status, "S_ANGLE", 0.0, &sangle, inrec->recnum, 0);
1301 tplarson 1.1
1302 tplarson 1.21 /*
1303     our calculation of CDELTi does not follow WCS conventions. it should be the plate scale
1304     at the reference pixel (disk center), but instead we use the average between center and limb.
1305     this is taken into account in the calculation of rsun below.
1306     */
1307 tplarson 1.1 xscale = drms_getkey_double(inrec, "CDELT1", &status);
1308     PARAMETER_ERROR("CDELT1")
1309     yscale = drms_getkey_double(inrec, "CDELT2", &status);
1310     PARAMETER_ERROR("CDELT2")
1311    
1312     // use xscale and yscale for the following check, then set to 1.0 for the call to obs2helio
1313     if (xscale != yscale)
1314     {
1315 tplarson 1.8 fprintf(stderr, "ERROR: CDELT1 != CDELT2 not supported, CDELT1 = %f, CDELT2 = %f: T_REC = %s, recnum = %lld \n", xscale, yscale, trecstr, inrec->recnum);
1316 tplarson 1.1 drms_free_array(inarr);
1317 tplarson 1.4 error++;
1318 tplarson 1.8 goto continue_outer_loop;
1319 tplarson 1.1 }
1320 tplarson 1.13 imagescale=xscale;
1321 tplarson 1.1 xscale=1.0;
1322     yscale=1.0;
1323    
1324 tplarson 1.6 /*
1325 tplarson 1.1 imagescale = drms_getkey_double(inrec, "IM_SCALE", &status);
1326     PARAMETER_ERROR("IM_SCALE")
1327 tplarson 1.6 */
1328 tplarson 1.13
1329 tplarson 1.1 if (paramsign != 0)
1330     {
1331     vsign = paramsign;
1332     }
1333     else
1334     {
1335     vsign = drms_getkey_double(inrec, "DATASIGN", &status);
1336 tplarson 1.8 ParameterDef(status, "DATASIGN", 1.0, &vsign, inrec->recnum, 1);
1337 tplarson 1.1 }
1338    
1339     if (velocity_correction)
1340     {
1341     obs_vr = drms_getkey_double(inrec, "OBS_VR", &status);
1342 tplarson 1.8 ParameterDef(status, "OBS_VR", 0.0, &obs_vr, inrec->recnum, 1);
1343 tplarson 1.1
1344     obs_vw = drms_getkey_double(inrec, "OBS_VW", &status);
1345 tplarson 1.8 ParameterDef(status, "OBS_VW", 0.0, &obs_vw, inrec->recnum, 1);
1346 tplarson 1.1
1347     obs_vn = drms_getkey_double(inrec, "OBS_VN", &status);
1348 tplarson 1.8 ParameterDef(status, "OBS_VN", 0.0, &obs_vn, inrec->recnum, 1);
1349 tplarson 1.1 }
1350    
1351     // MDI keyword was OBS_DIST, in AU
1352 tplarson 1.21 obsdist = drms_getkey_double(inrec, "DSUN_OBS", &status) / AU;
1353     // note that an incorrect value of 1.49597892e11 has sometimes been used to convert between OBS_DIST and DSUN_OBS when porting data from DSDS to DRMS
1354     ParameterDef(status, "OBS_DIST", 1.0, &obsdist, inrec->recnum, 1);
1355     if (readrsunref)
1356     {
1357     rsunref = drms_getkey_double(inrec, "RSUN_REF", &status);
1358     ParameterDef(status, "RSUN_REF", RTRUE, &rsunref, inrec->recnum, 1);
1359     rtrue=rsunref/AU;
1360     }
1361     S = rtrue / obsdist; // radians - approx. arcsin(rtrue/obsdist), but don't undo this approximation, because it is assumed in obs2helio
1362 tplarson 1.1
1363 tplarson 1.21 rsunobs = drms_getkey_double(inrec, "RSUN_OBS", &status);
1364 tplarson 1.9 if (status == DRMS_SUCCESS)
1365 tplarson 1.21 rsun = rsunobs/imagescale; //this calculation of rsun assumes approximation of imagescale mentioned in comment above
1366 tplarson 1.9 else
1367     {
1368     rsun = drms_getkey_double(inrec, "R_SUN", &status);
1369     if (status != DRMS_SUCCESS)
1370     rsun = ARCSECSINRAD * S / sqrt(1.0 - S * S) / imagescale;
1371     }
1372    
1373 tplarson 1.1 if (longitude_shift == 1)
1374     {
1375     tmearth = tobs+TAU_A*(1.0-obsdist);
1376     longshift = (obsl0-refl0)+longrate*(tmearth-tref); // degrees
1377     while (longshift > 180.0) longshift-=360.0;
1378     while (longshift < -180.0) longshift+=360.0;
1379     }
1380     else if (longitude_shift == 2) // Shift center to nearest Carrington Degree
1381     {
1382     longshift = obsl0 - (int)(obsl0);
1383     if (longshift > 0.5) longshift -= 1.0;
1384     }
1385     else if (longitude_shift == 3) // Shift center to nearest tenth of a degree
1386     {
1387     longshift = (obsl0 * 10 - (int)(obsl0 * 10)) / 10;
1388     if (longshift > 0.5) longshift -= 1.0;
1389     }
1390     else
1391     {
1392     longshift = 0.0;
1393     }
1394    
1395     mapl0 = obsl0 - longshift;
1396    
1397     xpixels = inarr->axis[0];
1398     ypixels = inarr->axis[1];
1399     pixels = xpixels * ypixels;
1400    
1401     // MDI keyword was X0
1402     x0 = drms_getkey_double(inrec, "CRPIX1", &status);
1403 tplarson 1.8 ParameterDef(status, "CRPIX1", xpixels / 2, &x0, inrec->recnum, 1);
1404 tplarson 1.1 x0 -= 1.0;
1405    
1406     // MDI keyword was Y0
1407     y0 = drms_getkey_double(inrec, "CRPIX2", &status);
1408 tplarson 1.8 ParameterDef(status, "CRPIX2", ypixels / 2, &y0, inrec->recnum, 1);
1409 tplarson 1.1 y0 -= 1.0;
1410    
1411     if (mag_offset)
1412     {
1413     float *dat = (float *)inarr->data;
1414     double bfitzero = drms_getkey_double(inrec, "BFITZERO", &status);
1415     PARAMETER_ERROR("BFITZERO")
1416     int i;
1417    
1418     if (!isnan(bfitzero))
1419     {
1420     for (i = 0; i < pixels; ++i)
1421     {
1422     dat[i] -= (float)bfitzero;
1423     }
1424    
1425     }
1426     }
1427    
1428     if (checko)
1429     {
1430     orientation = drms_getkey_string(inrec, "ORIENT", &status);
1431     PARAMETER_ERROR("ORIENT")
1432     CheckO(orientation, &vstat);
1433     if (vstat != V2HStatus_Success)
1434     {
1435 tplarson 1.8 fprintf(stderr,"ERROR: illegal ORIENT: T_REC = %s, recnum = %lld\n", trecstr, inrec->recnum);
1436 tplarson 1.1 drms_free_array(inarr);
1437     free(orientation);
1438 tplarson 1.4 error++;
1439 tplarson 1.8 goto continue_outer_loop;
1440 tplarson 1.1 }
1441     }
1442     else
1443     {
1444     orientation = strdup(orientationdef);
1445     }
1446    
1447 tplarson 1.21 if (status = obs2helio((float *)inarr->data,
1448 tplarson 1.1 v2hptr,
1449     xpixels,
1450     ypixels,
1451     x0,
1452     y0,
1453     b0 * RADSINDEG,
1454     p * RADSINDEG,
1455     S,
1456     rsun,
1457     rmax,
1458     interpolation,
1459     mapcols,
1460     maprows,
1461     longmin_adjusted * RADSINDEG,
1462     longinterval * RADSINDEG,
1463     longshift * RADSINDEG,
1464     sinBdelta,
1465     smajor,
1466     sminor,
1467     sangle * RADSINDEG,
1468     xscale,
1469     yscale,
1470     orientation,
1471     mag_correction,
1472     velocity_correction,
1473     obs_vr,
1474     obs_vw,
1475     obs_vn,
1476     vsign,
1477     NaN_beyond_rmax,
1478     carrStretch,
1479     &distP,
1480     diffrotA,
1481     diffrotB,
1482     diffrotC,
1483     NULL,
1484     0))
1485     {
1486 tplarson 1.14 fprintf(stderr, "ERROR: failure in obs2helio: status = %d, T_REC = %s, recnum = %lld\n", status, trecstr, inrec->recnum);
1487 tplarson 1.1 drms_free_array(inarr);
1488     free(orientation);
1489 tplarson 1.4 error++;
1490 tplarson 1.8 goto continue_outer_loop;
1491 tplarson 1.1 }
1492     drms_free_array(inarr);
1493     free(orientation);
1494    
1495     if (status = apodize(v2hptr,
1496     b0 * RADSINDEG,
1497     mapcols,
1498     maprows,
1499     longmin_adjusted * RADSINDEG,
1500     longinterval * RADSINDEG,
1501     sinBdelta,
1502     apodization,
1503     apinner,
1504     apwidth,
1505     apel,
1506     apx,
1507     apy))
1508     {
1509 tplarson 1.14 fprintf(stderr, "ERROR: failure in apodize: status = %d, T_REC = %s, recnum = %lld\n", status, trecstr, inrec->recnum);
1510 tplarson 1.4 error++;
1511 tplarson 1.8 goto continue_outer_loop;
1512 tplarson 1.1 }
1513    
1514     if (v2hflag)
1515     {
1516 tplarson 1.14 // outrec = drms_create_record(drms_env, v2hout, lifetime, &status);
1517     outrec=v2hrecset->records[iv2hrec++];
1518 tplarson 1.20 drms_copykeys(outrec, inrec, 0, kDRMS_KeyClass_Explicit);
1519 tplarson 1.1 DRMS_Link_t *histlink = hcon_lookup_lower(&outrec->links, histlinkname);
1520     DRMS_Link_t *srclink = hcon_lookup_lower(&outrec->links, srclinkname);
1521 tplarson 1.14 if (histlink != NULL)
1522 tplarson 1.1 drms_setlink_static(outrec, histlinkname, histrecnum);
1523 tplarson 1.14 if (srclink != NULL)
1524 tplarson 1.1 drms_setlink_static(outrec, srclinkname, inrec->recnum);
1525     if (segoutflag)
1526     segout = drms_segment_lookup(outrec, segnameout);
1527     else
1528     segout = drms_segment_lookupnum(outrec, 0);
1529     length[0]=mapcols;
1530     length[1]=maprows;
1531 tplarson 1.8 outarr = drms_array_create(usetype, 2, length, v2hptr, &status);
1532 tplarson 1.22 drms_setkey_int(outrec, "TOTVALS", maprows*mapcols);
1533 tplarson 1.9 set_statistics(segout, outarr, 1);
1534 tplarson 1.16 outarr->bzero=segout->bzero;
1535     outarr->bscale=segout->bscale;
1536 tplarson 1.8 status=drms_segment_write(segout, outarr, 0);
1537     free(outarr);
1538    
1539     if (status != DRMS_SUCCESS)
1540     {
1541     fprintf(stderr, "ERROR: problem writing output segment: status = %d, T_REC = %s, input recnum = %lld, histrecnum = %lld\n", status, trecstr, inrec->recnum, histrecnum);
1542     return 0;
1543     }
1544    
1545 tplarson 1.15 // drms_copykey(outrec, inrec, "T_REC");
1546 tplarson 1.1 drms_setkey_int(outrec, "QUALITY", quality);
1547     drms_setkey_int(outrec, "MAPMMAX", mapped_lmax);
1548     drms_setkey_int(outrec, "SINBDIVS", sinb_divisions);
1549     drms_setkey_float(outrec, "CRPIX1", mapcols/2.0 + 0.5);
1550     drms_setkey_float(outrec, "CRVAL1", mapl0);
1551     drms_setkey_float(outrec, "CROTA1", 0.0);
1552     drms_setkey_float(outrec, "CDELT1", longinterval);
1553     drms_setkey_float(outrec, "CRPIX2", maprows/2.0 + 0.5);
1554     drms_setkey_float(outrec, "CRVAL2", 0.0);
1555     drms_setkey_float(outrec, "CROTA2", 0.0);
1556     drms_setkey_float(outrec, "CDELT2", sinBdelta);
1557     drms_setkey_string(outrec, "CTYPE1", "CRLN_CEA");
1558     drms_setkey_string(outrec, "CTYPE2", "CRLT_CEA");
1559     drms_setkey_string(outrec, "CUNIT1", "deg");
1560     drms_setkey_string(outrec, "CUNIT2", "sinlat");
1561 tplarson 1.17
1562 tplarson 1.22 // set keywords for magnetic pipeline
1563     drms_setkey_float(outrec, "MAPRMAX", rmax);
1564     drms_setkey_float(outrec, "MAPBMAX", bmax);
1565     drms_setkey_float(outrec, "MAPLGMAX", longmax_adjusted);
1566     drms_setkey_float(outrec, "MAPLGMIN", longmin_adjusted);
1567     drms_setkey_int(outrec, "INTERPO", interpolation);
1568     drms_setkey_int(outrec, "LGSHIFT", longitude_shift);
1569     drms_setkey_int(outrec, "MCORLEV", mag_correction);
1570     drms_setkey_int(outrec, "MOFFSET", mag_offset);
1571     drms_setkey_int(outrec, "CARSTRCH", carrStretch);
1572     drms_setkey_float(outrec, "DIFROT_A", diffrotA);
1573     drms_setkey_float(outrec, "DIFROT_B", diffrotB);
1574     drms_setkey_float(outrec, "DIFROT_C", diffrotC);
1575    
1576 tplarson 1.1 dsignout=vsign*drms_getkey_double(inrec, "DATASIGN", &status);
1577     if (status != DRMS_SUCCESS)
1578     dsignout=vsign;
1579     dsignout/=fabs(dsignout);
1580     drms_setkey_int(outrec, "DATASIGN", (int)dsignout);
1581    
1582     tnow = (double)time(NULL);
1583     tnow += UNIX_epoch;
1584     drms_setkey_time(outrec, "DATE", tnow);
1585    
1586 tplarson 1.14 // drms_close_record(outrec, DRMS_INSERT_RECORD);
1587 tplarson 1.1 }
1588    
1589    
1590     if (verbflag > 1)
1591     {
1592     wt=getwalltime();
1593     ct=getcputime(&ut, &st);
1594     fprintf(stdout,
1595     " remap done, %.2f ms wall time, %.2f ms cpu time\n",
1596     wt-wt2,
1597     ct-ct2);
1598     }
1599    
1600 tplarson 1.9 if (!h2mflag && !tsflag)
1601     goto skip;
1602    
1603 tplarson 1.1 inp=v2hptr;
1604     outp=h2mptr;
1605    
1606     mean = 0.0;
1607     if (subtract_mean) /* get mean of entire remapped image */
1608     {
1609     nmean = 0;
1610     ip = inp;
1611     for (row=0; row<maprows; row++)
1612     {
1613     for (col=0; col<mapcols; col++)
1614     {
1615     if (!isnan(*ip))
1616     {
1617     nmean++;
1618     mean += *ip;
1619     }
1620     ip++;
1621     }
1622     }
1623     mean /= (nmean ? nmean : 1);
1624     }
1625    
1626     for (row=0; row<maprows; row++)
1627     {
1628    
1629     if (cent_long == 0)
1630     {
1631    
1632     /* Old code with 0 at beginning of array */
1633    
1634     nok = 0;
1635     bp = buf;
1636     wp = weight;
1637     ip = inp + mapcols * row;
1638     for (col=0; col<mapcols; col++)
1639     {
1640     if (!isnan(*ip))
1641     {
1642     *bp++ = *wp * (*ip - mean);
1643     nok += 1;
1644     }
1645     else
1646     *bp++ = 0.0;
1647     ip++;
1648     wp++;
1649     }
1650    
1651     /* zero fill */
1652     for (i=col; i<nfft; i++)
1653     *bp++ = 0.0;
1654     }
1655     else
1656     {
1657    
1658     /* New code with 0 at center meridian */
1659     /* Assumes that input array is symmetric around meridian */
1660    
1661     nok = 0;
1662    
1663     /* First copy right side of meridian */
1664    
1665     bp = buf;
1666     ip = inp + mapcols * row+mapcols2;
1667     wp = weight + mapcols2;
1668     if (subtract_mean)
1669     {
1670     for (col=0; col<=mapcols2; col++)
1671     {
1672     if (!isnan(*ip))
1673     {
1674     *bp++ = *wp * (*ip - mean);
1675     nok += 1;
1676     }
1677     else
1678     *bp++ = 0.0;
1679     ip++;
1680     wp++;
1681     }
1682     }
1683     else
1684     {
1685     for (col=0; col<=mapcols2; col++)
1686     {
1687     if (!isnan(*ip))
1688     {
1689     *bp++ = *wp * *ip;
1690     nok += 1;
1691     }
1692     else
1693     *bp++ = 0.0;
1694     ip++;
1695     wp++;
1696     }
1697     }
1698    
1699     /* Then do left side of meridian */
1700     bp = buf+lfft-mapcols2;
1701     ip = inp + mapcols * row;
1702     wp = weight;
1703     if (subtract_mean)
1704     {
1705     for (col=0; col<mapcols2; col++)
1706     {
1707     if (!isnan(*ip))
1708     {
1709     *bp++ = *wp * (*ip - mean);
1710     nok += 1;
1711     }
1712     else
1713     *bp++ = 0.0;
1714     ip++;
1715     wp++;
1716     }
1717     }
1718     else
1719     {
1720     for (col=0; col<mapcols2; col++)
1721     {
1722     if (!isnan(*ip))
1723     {
1724     *bp++ = *wp * *ip;
1725     nok += 1;
1726     }
1727     else
1728     *bp++ = 0.0;
1729     ip++;
1730     wp++;
1731     }
1732     }
1733    
1734     /* Finally zero fill */
1735     bp = buf+mapcols2+1;
1736     for (i=0; i<lfft-mapcols; i++)
1737     *bp++ = 0.0;
1738    
1739     } /* End of copying if statement */
1740    
1741     if ((zero_miss == 0) && (nok != mapcols))
1742     {
1743    
1744     /* Stuff with missing */
1745     for (i=0; i<nout; i++)
1746     {
1747     op = outp + i * maprows + row;
1748     *op = DRMS_MISSING_FLOAT;
1749     }
1750     }
1751     else
1752     {
1753     if (normalize)
1754     norm = 1./sqrt(2*(double)nfft/nok)/lfft;
1755     else
1756     norm = 1./lfft;
1757 tplarson 1.8
1758 tplarson 1.1 /* Fourier transform */
1759     fftwf_execute(fftwp);
1760    
1761     /* transpose, normalize, this is where most time is spent */
1762     /* First do real part */
1763     for (i=0; i<nout/2; i++)
1764     {
1765     op = outp + 2*i * maprows + row;
1766     *op = wbuf[i]*norm;
1767     }
1768     /* Do imaginary part */
1769     /* Imaginary part of m=0 is 0*/
1770     *(outp+row+maprows)=0.0;
1771     /* Use normx to get the complex conjugate */
1772     normx=-norm;
1773     for (i=1; i<nout/2; i++)
1774     {
1775     op = outp + 2*i * maprows + row + maprows;
1776     *op = wbuf[lfft-i]*normx;
1777     }
1778    
1779     }
1780     } /* Next row */
1781    
1782     if (h2mflag)
1783     {
1784 tplarson 1.14 // outrec = drms_create_record(drms_env, h2mout, lifetime, &status);
1785     outrec=h2mrecset->records[ih2mrec++];
1786 tplarson 1.20 drms_copykeys(outrec, inrec, 0, kDRMS_KeyClass_Explicit);
1787 tplarson 1.1 DRMS_Link_t *histlink = hcon_lookup_lower(&outrec->links, histlinkname);
1788     DRMS_Link_t *srclink = hcon_lookup_lower(&outrec->links, srclinkname);
1789 tplarson 1.14 if (histlink != NULL)
1790 tplarson 1.1 drms_setlink_static(outrec, histlinkname, histrecnum);
1791 tplarson 1.14 if (srclink != NULL)
1792 tplarson 1.1 drms_setlink_static(outrec, srclinkname, inrec->recnum);
1793     if (segoutflag)
1794     segout = drms_segment_lookup(outrec, segnameout);
1795     else
1796     segout = drms_segment_lookupnum(outrec, 0);
1797     length[0]=maprows;
1798     length[1]=nout;
1799 tplarson 1.8 outarr = drms_array_create(usetype, 2, length, h2mptr, &status);
1800 tplarson 1.22 drms_setkey_int(outrec, "TOTVALS", maprows*nout);
1801 tplarson 1.9 set_statistics(segout, outarr, 1);
1802 tplarson 1.16 outarr->bzero=segout->bzero;
1803     outarr->bscale=segout->bscale;
1804 tplarson 1.8 status=drms_segment_write(segout, outarr, 0);
1805     free(outarr);
1806    
1807     if (status != DRMS_SUCCESS)
1808     {
1809     fprintf(stderr, "ERROR: problem writing output segment: status = %d, T_REC = %s, input recnum = %lld, histrecnum = %lld\n", status, trecstr, inrec->recnum, histrecnum);
1810     return 0;
1811     }
1812    
1813 tplarson 1.15 // drms_copykey(outrec, inrec, "T_REC");
1814 tplarson 1.1 drms_setkey_int(outrec, "QUALITY", quality);
1815     drms_setkey_int(outrec, "MAPMMAX", mapped_lmax);
1816     drms_setkey_int(outrec, "SINBDIVS", sinb_divisions);
1817     drms_setkey_int(outrec, "LMAX", lmax);
1818     drms_setkey_double(outrec, "CRPIX1", maprows/2.0 + 0.5);
1819     drms_setkey_double(outrec, "CRVAL1", 0.0);
1820     drms_setkey_double(outrec, "CROTA1", 0.0);
1821     drms_setkey_double(outrec, "CDELT1", sinBdelta);
1822     drms_setkey_double(outrec, "CRPIX2", 1.0);
1823     drms_setkey_double(outrec, "CRVAL2", 0.0);
1824     drms_setkey_double(outrec, "CROTA2", 0.0);
1825     drms_setkey_double(outrec, "CDELT2", 1.0);
1826     drms_setkey_string(outrec, "CTYPE1", "CRLT_CEA");
1827     drms_setkey_string(outrec, "CTYPE2", "CRLN_FFT");
1828     drms_setkey_string(outrec, "CUNIT1", "rad");
1829     drms_setkey_string(outrec, "CUNIT2", "m");
1830 tplarson 1.17
1831 tplarson 1.1 tnow = (double)time(NULL);
1832     tnow += UNIX_epoch;
1833     drms_setkey_time(outrec, "DATE", tnow);
1834 tplarson 1.14 // drms_close_record(outrec, DRMS_INSERT_RECORD);
1835 tplarson 1.1 }
1836    
1837     if (verbflag > 1)
1838     {
1839     wt2=getwalltime();
1840     ct2=getcputime(&ut2, &st2);
1841     fprintf(stdout,
1842     " fft and transpose done, %.2f ms wall time, %.2f ms cpu time\n",
1843     wt2-wt,
1844     ct2-ct);
1845     }
1846    
1847 tplarson 1.9 if (!tsflag)
1848     goto skip;
1849    
1850 tplarson 1.1 inptr=h2mptr;
1851     imageoffset = imagesize * irec;
1852     for (mx = 0; mx < 2*msize; mx++) /* for each m, re and im */
1853     {
1854     moffset = mx * maprows;
1855     mptr = inptr + moffset;
1856     for (latx = 0; latx < nlat; latx++)
1857     {
1858     poslatx = nlat + latx; neglatx = nlat - 1 - latx;
1859     evenpart[latx] = mptr[poslatx] + mptr[neglatx];
1860     oddpart[latx] = mptr[poslatx] - mptr[neglatx];
1861     }
1862     workptr = folded + imageoffset + moffset;
1863     scopy_ (&nlat, evenpart, &increment1, workptr, &increment1);
1864     workptr += nlat;
1865     scopy_ (&nlat, oddpart, &increment1, workptr, &increment1);
1866     }
1867    
1868     skip:
1869 tplarson 1.8 inrec = drms_recordset_fetchnext(drms_env, inrecset, &fetchstat, &chunkstat, NULL);
1870 tplarson 1.1
1871 tplarson 1.4 if (inrec != NULL)
1872 tplarson 1.1 {
1873     trec = drms_getkey_time(inrec, "T_REC", &status);
1874     PARAMETER_ERROR("T_REC")
1875 tplarson 1.8 trecind=(trec-tstart+cadence/2)/cadence;
1876 tplarson 1.1 sprint_time(trecstr, trec, "TAI", 0);
1877     }
1878 tplarson 1.4
1879 tplarson 1.1 } /* end loop on each input image for this timechunk */
1880    
1881     if (verbflag)
1882     printf(" number of bad images = %d\n", bc);
1883 tplarson 1.4
1884 tplarson 1.9 if (!tsflag)
1885     goto continue_outer_loop;
1886    
1887 tplarson 1.8 //needed if recordset does not extend to end of a timechunk
1888     while (irec < nrecs)
1889     {
1890     bad[bc++]=irec;
1891     irec++;
1892     }
1893    
1894 tplarson 1.4 if (bc == nrecs)
1895 tplarson 1.1 {
1896 tplarson 1.4 nodata=1;
1897     }
1898     else
1899     {
1900     while (bc > 0)
1901     {
1902     imageoffset=imagesize*bad[--bc];
1903     for (i=0;i<imagesize;i++) folded[imageoffset+i]=0.0;
1904     }
1905 tplarson 1.1 }
1906    
1907     if (verbflag)
1908     {
1909     wt2=getwalltime();
1910     ct2=getcputime(&ut2, &st2);
1911     fprintf(stdout,
1912     " images processed, %.2f ms wall time, %.2f ms cpu time\n",
1913     wt2-wt1,
1914     ct2-ct1);
1915     }
1916    
1917 tplarson 1.8 // skip to here if no input records in a given timechunk
1918     skip_norecs:
1919 tplarson 1.1
1920     /* we now have folded data for a chunk of sn's */
1921     /* now do Jesper's tricks */
1922    
1923     /* ldone is the last l for which plm's have been set up */
1924     ldone=-1;
1925    
1926     /* loop on each chunk of l's */
1927     for (lchunk = lchunkfirst; lchunk <= lchunklast; lchunk++)
1928     {
1929     lfirst = lchunk * lchunksize;
1930     llast = lfirst + lchunksize - 1;
1931     lfirst = maxval(lfirst,lmin);
1932     llast = minval(llast,lmax);
1933     /* get the first and last indexes into the l-m array */
1934     ifirst = lfirst*(lfirst+1)/2;
1935     ilast = llast*(llast+1)/2+llast;
1936    
1937     if (verbflag > 1)
1938     {
1939     wt3=getwalltime();
1940     ct3=getcputime(&ut3, &st3);
1941     printf(" processing lchunk %d, lmin = %d, lmax = %d\n", lchunk, lfirst, llast);
1942     }
1943    
1944 tplarson 1.14 // outrec = drms_create_record(drms_env, outseries, lifetime, &status);
1945     outrec=outrecset->records[irecout++];
1946     /*
1947 tplarson 1.1 if (status != DRMS_SUCCESS || outrec == NULL)
1948     {
1949 tplarson 1.14 fprintf(stderr,"ERROR: unable to open record in output dataseries %s, status = %d, histrecnum = %lld\n", outseries, status, histrecnum);
1950 tplarson 1.1 return 0;
1951     }
1952 tplarson 1.14 */
1953     if (histlink != NULL)
1954 tplarson 1.1 drms_setlink_static(outrec, histlinkname, histrecnum);
1955    
1956 tplarson 1.4 if (nodata)
1957 tplarson 1.8 goto skip_nodata;
1958 tplarson 1.4
1959 tplarson 1.1 /* now the size of the output array is known */
1960     length[0]=2*nrecs; /* accomodate re & im parts for each sn */
1961     length[1]=(ilast-ifirst+1); /* for each l & m, lfirst <= l <= llast */
1962    
1963     outarr = drms_array_create(usetype, 2, length, NULL, &status);
1964    
1965     if (segoutflag)
1966     segout = drms_segment_lookup(outrec, segnameout);
1967     else
1968     segout = drms_segment_lookupnum(outrec, 0);
1969    
1970 tplarson 1.8 if (segout == NULL || outarr == NULL || status != DRMS_SUCCESS)
1971 tplarson 1.1 {
1972 tplarson 1.14 fprintf(stderr,"ERROR: problem with output segment or data array: lfirst = %d, llast = %d, length = [%d, %d], status = %d, iset = %d, T_START= %s, histrecnum = %lld",
1973     lfirst, llast, length[0], length[1], status, iset, tstartstr, histrecnum);
1974 tplarson 1.1 return 0;
1975     }
1976    
1977     outptr = (float *)(outarr->data);
1978    
1979     /* loop on each m */
1980     for (m = 0; m <= llast; m++)
1981     {
1982    
1983     modd = is_odd(m);
1984     meven = !modd;
1985     lstart = maxval(lfirst,m); /* no l can be smaller than this m */
1986    
1987     /* set up masks (plm's) for this m and chunk in l */
1988    
1989     if ((lstart-1) == ldone)
1990     {
1991     /* get saved plms if any */
1992     if ((lstart - 2) >= m)
1993     for (latx = 0; latx < nlat; latx++)
1994     plm[(lstart-2)*nlat + latx] = saveplm[m*nlat + latx];
1995     if ((lstart - 1) >= m)
1996     for (latx = 0; latx < nlat; latx++)
1997     plm[(lstart-1)*nlat + latx] = saveplm[msize*nlat + m*nlat + latx];
1998    
1999     /* then set up the current chunk */
2000 tplarson 1.17 // setplm_ (&lstart, &llast, &m, &nlat, indx, latgrid, &nlat, plm);
2001     setplm2(lstart, llast, m, nlat, indx, latgrid, nlat, plm, NULL);
2002 tplarson 1.1 }
2003     else
2004     {
2005     /* This fixes the lmin != 0 problem */
2006 tplarson 1.17 // setplm_ (&m, &llast, &m, &nlat, indx, latgrid, &nlat, plm);
2007     setplm2(m, llast, m, nlat, indx, latgrid, nlat, plm, NULL);
2008 tplarson 1.1 }
2009    
2010     /* save plm's for next chunk */
2011     if ((llast-1) >= m)
2012     for (latx = 0; latx < nlat; latx++)
2013     saveplm[m*nlat + latx] = plm[(llast - 1)*nlat + latx];
2014     for (latx = 0; latx < nlat; latx++)
2015     saveplm[msize*nlat + m*nlat + latx] = plm[llast*nlat + latx];
2016     ldone=llast;
2017    
2018     /* copy plm's into masks */
2019     /* note that this converts from double to single precision */
2020     /* the test prevents underflows which gobble CPU time */
2021     /* Hmmm... looks like if statement is not needed. Weird...
2022     for (l = lstart; l <= llast; l++) {
2023     moffset = l * nlat;
2024     for (latx = 0; latx < nlat; latx++) {
2025     plmptr = plm + moffset + latx;
2026     if (is_very_small (*plmptr))
2027     masks [(l-lstart)*nlat + latx] = 0.0;
2028     else
2029     masks [(l-lstart)*nlat + latx] = *plmptr;
2030     }
2031     plmptr = plm + moffset;
2032     maskptr = masks+(l-lstart)*nlat;
2033     dscopy_(&nlat,plmptr,maskptr);
2034     }
2035     */
2036     plmptr=plm+nlat*lstart;
2037     maskptr=masks;
2038     latx=nlat*(llast-lstart+1);
2039     // dscopy_(&latx,plmptr,maskptr);
2040     int ilatx;
2041     for (ilatx=0;ilatx<latx;ilatx++)
2042     maskptr[ilatx]=plmptr[ilatx];
2043    
2044     /* for each sn in snchunk */
2045     // for (sn = infsn; sn <= inlsn; sn++) {
2046     for (snx=0; snx<nrecs; snx++)
2047     {
2048     /* select folded data for real/imag l's and this m
2049     into temporay arrays for matrix multiply */
2050     // snx = sn - infsn;
2051     /* TO DO - pull offset calculations out of loop */
2052     /* New code with odd leading dimension */
2053     scopy_ (&nlat,
2054     folded + nlat*(4*m+modd) + snx*imagesize,
2055     &increment1,
2056     real4evenl + snx*nlatx,
2057     &increment1);
2058     scopy_ (&nlat,
2059     folded + nlat*(4*m+meven) + snx*imagesize,
2060     &increment1,
2061     real4oddl + snx*nlatx,
2062     &increment1);
2063     scopy_ (&nlat,
2064     folded + nlat*(4*m+2+modd) + snx*imagesize,
2065     &increment1,
2066     imag4evenl + snx*nlatx,
2067     &increment1);
2068     scopy_ (&nlat,
2069     folded + nlat*(4*m+2+meven) + snx*imagesize,
2070     &increment1,
2071     imag4oddl + snx*nlatx,
2072     &increment1);
2073     } /* end loop through snchunk */
2074    
2075    
2076     /* do even l's */
2077     lfirsteven = is_even(lstart) ? lstart : lstart+1;
2078     llasteven = is_even(llast) ? llast : llast-1;
2079     nevenl = (llasteven-lfirsteven)/2 + 1; /* number of even l's */
2080     /* do real part */
2081     /* All parts used to have alpha=&one, now have alpha=&cnorm */
2082     sgemm_ (transpose, /* form of op(A) */
2083     normal, /* form of op(B) */
2084     &nsn, /* number of sn's */
2085     &nevenl, /* number of even l's for this m */
2086     &nlat, /* number of latitudes */
2087     &cnorm, /* scalar multiplier of op(A) */
2088     real4evenl, /* matrix A */
2089     &nlatx, /* use every nlat-long row of A */
2090     masks + nlat*(lfirsteven-lstart), /* matrix B */
2091     &maprows, /* 2*nlat, use every other row (nlat long) of B */
2092     &zero, /* scalar multiplier of C */
2093     outx + nsn*2*(lfirsteven-lstart), /* matrix C (output) */
2094     &fournsn, /* use every fourth nsn-long row of C */
2095     1, /* length of transpose character string */
2096     1); /* length of normal character string */
2097     /* do imag part */
2098     sgemm_ (transpose, /* form of op(A) */
2099     normal, /* form of op(B) */
2100     &nsn, /* number of sn's */
2101     &nevenl, /* number of even l's for this m */
2102     &nlat, /* number of latitudes */
2103     &cnorm, /* scalar multiplier of op(A) */
2104     imag4evenl, /* matrix A */
2105     &nlatx, /* use every nlat-long row of A */
2106     masks + nlat*(lfirsteven-lstart), /* matrix B */
2107     &maprows, /* 2*nlat, use every other nlat-long row of B */
2108     &zero, /* scalar multiplier of C */
2109     outx + nsn*(2*(lfirsteven-lstart)+1), /* matrix C (output) */
2110     &fournsn, /* use every fourth nsn-long row of C */
2111     1, /* length of transpose character string */
2112     1); /* length of normal character string */
2113    
2114     /* do odd l's */
2115     lfirstodd = is_odd(lstart) ? lstart : lstart+1;
2116     llastodd = is_odd(llast) ? llast : llast-1;
2117     noddl = (llastodd-lfirstodd)/2 + 1; /* number of odd l's */
2118     /* do real part */
2119     sgemm_ (transpose, /* form of op(A) */
2120     normal, /* form of op(B) */
2121     &nsn, /* number of sn's */
2122     &noddl, /* number of odd l's for this m */
2123     &nlat, /* number of latitudes */
2124     &cnorm , /* scalar multiplier of op(A) */
2125     real4oddl, /* matrix A */
2126     &nlatx, /* use every nlat-long row of A */
2127     masks + nlat*(lfirstodd-lstart), /* matrix B */
2128     &maprows, /* 2*nlat, use every other nlat-long row of B */
2129     &zero, /* scalar multiplier of C */
2130     outx + nsn*2*(lfirstodd-lstart), /* matrix C (output) */
2131     &fournsn, /* use every fourth nsn-long row of C */
2132     1, /* length of transpose character string */
2133     1); /* length of normal character string */
2134     /* do imag part */
2135     sgemm_ (transpose, /* form of op(A) */
2136     normal, /* form of op(B) */
2137     &nsn, /* number of sn's */
2138     &noddl, /* number of odd l's for this m */
2139     &nlat, /* number of latitudes */
2140     &cnorm, /* scalar multiplier of op(A) */
2141     imag4oddl, /* matrix A */
2142     &nlatx, /* use every nlat-long row of A */
2143     masks + nlat*(lfirstodd-lstart), /* matrix B */
2144     &maprows, /* 2*nlat, use every other nlat-long row of B */
2145     &zero, /* scalar multiplier of C */
2146     outx + nsn*(2*(lfirstodd-lstart)+1), /* matrix C (output) */
2147     &fournsn, /* use every fourth nsn-long row of C */
2148     1, /* length of transpose character string */
2149     1); /* length of normal character string */
2150    
2151     /* copy outx into out sds */
2152     /* alternate real and imaginary values in out - as in pipeLNU */
2153     for (l = lstart; l <= llast; l++)
2154     {
2155     fromoffset = 2*nsn*(l-lstart);
2156     tooffset = 2*nsn*(l*(l+1)/2 + m -ifirst);
2157     scopy_ (&nsn,
2158     outx+fromoffset,
2159     &increment1,
2160     outptr+tooffset,
2161     &increment2);
2162     scopy_ (&nsn,
2163     outx+fromoffset+nsn,
2164     &increment1,
2165     outptr+tooffset+1,
2166     &increment2);
2167     } /* end loop through l's for this m */
2168    
2169    
2170     } /* end loop on m */
2171    
2172 tplarson 1.17
2173 tplarson 1.8 outarr->bzero=segout->bzero;
2174     outarr->bscale=segout->bscale;
2175     status=drms_segment_write(segout, outarr, 0);
2176 tplarson 1.4 drms_free_array(outarr);
2177     nsegments++;
2178    
2179 tplarson 1.8 if (status != DRMS_SUCCESS)
2180     {
2181     fprintf(stderr, "ERROR: problem writing output segment: status = %d, T_START = %s, LMIN = %d, LMAX = %d, histrecnum = %lld\n", status, tstartstr, lfirst, llast, histrecnum);
2182     return 0;
2183     }
2184    
2185     skip_nodata:
2186 tplarson 1.4
2187 tplarson 1.1 drms_setkey_int(outrec, "LMIN", lfirst);
2188     drms_setkey_int(outrec, "LMAX", llast);
2189     drms_setkey_time(outrec, "T_START", tstart);
2190     drms_setkey_time(outrec, "T_STOP", tstart+chunksecs);
2191     drms_setkey_time(outrec, "T_OBS", tstart+chunksecs/2);
2192     drms_setkey_time(outrec, "DATE__OBS", tstart);
2193 tplarson 1.8 drms_setkey_string(outrec, "TAG", tag);
2194 tplarson 1.23 if (verflag)
2195     drms_setkey_string(outrec, "VERSION", version);
2196 tplarson 1.20
2197     for (i=0;i<16;i++)
2198     setbits(calversout,4*i+3,4,nybblearrout[i]);
2199 tplarson 1.16 drms_setkey_longlong(outrec, "CALVER64", calversout);
2200 tplarson 1.1
2201 tplarson 1.4 if (nodata)
2202     drms_setkey_int(outrec, "QUALITY", QUAL_NODATA);
2203 tplarson 1.20 else if (mixflag)
2204     drms_setkey_int(outrec, "QUALITY", QUAL_MIXEDCALVER);
2205 tplarson 1.4 else
2206     drms_setkey_int(outrec, "QUALITY", 0);
2207 tplarson 1.1
2208     // these could be constant, but set them just in case
2209 tplarson 1.6 drms_setkey_int(outrec, "MAPMMAX", mapped_lmax);
2210     drms_setkey_int(outrec, "SINBDIVS", sinb_divisions);
2211 tplarson 1.1 drms_setkey_float(outrec, "T_STEP", cadence);
2212 tplarson 1.8
2213 tplarson 1.6 ndt=chunksecs/cadence;
2214     drms_setkey_int(outrec, "NDT", ndt);
2215    
2216 tplarson 1.1 tnow = (double)time(NULL);
2217     tnow += UNIX_epoch;
2218     drms_setkey_time(outrec, "DATE", tnow);
2219    
2220 tplarson 1.14 // drms_close_record(outrec, DRMS_INSERT_RECORD);
2221 tplarson 1.4 nrecords++;
2222 tplarson 1.1
2223     if (verbflag > 1)
2224     {
2225     wt=getwalltime();
2226     ct=getcputime(&ut, &st);
2227     fprintf(stdout,
2228     " %.2f ms wall time, %.2f ms cpu time\n",
2229     wt-wt3,
2230     ct-ct3);
2231     }
2232    
2233    
2234     } /* end loop on each chunk of l's */
2235    
2236     if (verbflag)
2237     {
2238     wt1=getwalltime();
2239     ct1=getcputime(&ut1, &st1);
2240     fprintf(stdout, "SHT of timechunk %d complete: %.2f ms wall time, %.2f ms cpu time\n", iset,
2241     wt1-wt2, ct1-ct2);
2242     }
2243    
2244 tplarson 1.8 continue_outer_loop:
2245 tplarson 1.1 tstart+=chunksecs;
2246     } /* end loop on each time chunk */
2247    
2248    
2249     if (chunkstat != kRecChunking_LastInRS && chunkstat != kRecChunking_NoMoreRecs)
2250     fprintf(stderr, "WARNING: input records remain after last output record: chunkstat = %d\n", (int)chunkstat);
2251    
2252 tplarson 1.8 drms_close_records(inrecset, DRMS_FREE_RECORD);
2253 tplarson 1.14 if (tsflag)
2254     drms_close_records(outrecset, DRMS_INSERT_RECORD);
2255     if (v2hflag)
2256     drms_close_records(v2hrecset, DRMS_INSERT_RECORD);
2257     if (h2mflag)
2258     drms_close_records(h2mrecset, DRMS_INSERT_RECORD);
2259    
2260 tplarson 1.1
2261     wt=getwalltime();
2262     ct=getcputime(&ut, &st);
2263 tplarson 1.13 if (verbflag && tsflag)
2264 tplarson 1.1 {
2265 tplarson 1.4 printf("number of records created = %d\n", nrecords);
2266     printf("number of segments created = %d\n", nsegments);
2267 tplarson 1.13 }
2268     if (verbflag)
2269     {
2270 tplarson 1.1 fprintf(stdout, "total time spent: %.2f ms wall time, %.2f ms cpu time\n",
2271     wt-wt0, ct-ct0);
2272     }
2273    
2274 tplarson 1.8 if (!error)
2275     printf("module %s successful completion\n", cmdparams.argv[0]);
2276     else
2277     printf("module %s failed to produce %d timechunks: histrecnum = %lld\n", cmdparams.argv[0], error, histrecnum);
2278    
2279 tplarson 1.1 return 0;
2280     }