void idlprimfill( HDSLoc *cloc, IDL_VPTR datav, void *datptr, int *status ) {
int j; /* loop counters */
UCHAR idltype; /* The IDL type */
char type[DAT__SZTYP+1]; /* Type in which to to map HDS data */
int bpix; /* Number of bytes/value */
int defined; /* If HDS value defined */
void *cpntr; /* True C pointer to mapped data */
size_t nels; /* Number of mapped elements */
int nels_i;
size_t nbytes; /* Number of bytes in array */
int flen; /* length of HDS strings */
int clen; /* length of corresponding C string */
char *chars; /* pointer to imported characters */
IDL_STRING *strings; /* pointer to array of string structures */
IDL_VPTR chptr; /* Scratch variable pointer */
if ( *status != SAI__OK ) return;
/* check type compatibility */
/* Get the number of bytes per element */
/* and the HDS type in which to map the data */
idltype = datav->type;
switch (idltype) {
case IDL_TYP_FLOAT:
strcpy( type, "_REAL" );
bpix = 4;
break;
case IDL_TYP_LONG:
strcpy( type, "_INTEGER" );
bpix = 4;
break;
case IDL_TYP_INT:
strcpy( type, "_WORD" );
bpix = 2;
break;
case IDL_TYP_DOUBLE:
strcpy( type, "_DOUBLE" );
bpix = 8;
break;
case IDL_TYP_BYTE:
strcpy( type, "_UBYTE" );
bpix = 1;
break;
case IDL_TYP_STRING:
datType( cloc, type, status);
bpix = 1;
break;
default:
/* flag no data to copy */
bpix = 0;
*status = SAI__ERROR;
emsSeti( "TYPE", idltype );
emsRep( " ", "Illegal IDL type ^TYPE", status );
break;
} /* end of case */
if ( (*status == SAI__OK ) && bpix ) {
/* Map the data as if a vector - provided it is defined */
datState( cloc, &defined, status );
if ( defined ) {
datMapV( cloc, type, "READ", &cpntr, &nels, status );
if ( *status != SAI__OK ) {
emsRep(" ", "Failed to map HDS component", status );
} else {
if ( idltype == IDL_TYP_STRING ) {
flen = atoi( type + 6 );
clen = flen + 1;
/* Import the Fortran strings to C */
nels_i = (int)nels;
chars = IDL_GetScratch( &chptr, nels_i, clen );
cnfImprta( cpntr, flen, chars, clen, 1, &nels_i );
/* set strings to be a pointer to the IDL_STRING structure(s) */
strings = (IDL_STRING *)datptr;
/* store the imported strings into the STRING structures */
for ( j=0; j<nels; j++ )
IDL_StrStore( strings+j, &chars[j*clen] );
IDL_Deltmp( chptr );
} else {
/* Type other than string */
if ( datav->flags & IDL_V_ARR ) {
/* Number Array */
/* copy the data to the array */
nbytes = bpix * nels;
memcpy( datptr, cpntr, nbytes );
} else {
/* Number Scalar */
switch (idltype) {
case IDL_TYP_FLOAT:
((IDL_ALLTYPES *)datptr)->f = *(float *)cpntr;
break;
case IDL_TYP_LONG:
((IDL_ALLTYPES *)datptr)->l = *(int *)cpntr;
break;
case IDL_TYP_INT:
((IDL_ALLTYPES *)datptr)->i = *(short *)cpntr;
break;
case IDL_TYP_DOUBLE:
((IDL_ALLTYPES *)datptr)->d = *(double *)cpntr;
break;
case IDL_TYP_BYTE:
((IDL_ALLTYPES *)datptr)->c = *(UCHAR *)cpntr;
break;
} /* end of case */
} /* end of if array */
} /* end if string */
datUnmap( cloc, status );
} /* end of mapped data */
} /* end of if defined */
} /* end of bpix non-zero */
return;
}
IDL_LONG spherematch
(int argc,
void * argv[])
{
IDL_LONG npoints1;
double * ra1;
double * dec1;
IDL_LONG npoints2;
double * ra2;
double * dec2;
double matchlength;
double minchunksize;
IDL_LONG *match1;
IDL_LONG *match2;
double * distance12;
IDL_LONG *nmatch;
double myx1,myy1,myz1;
IDL_LONG maxmatch, jmax;
double currra,sep;
IDL_LONG i,j,k,rachunk,decchunk;
IDL_LONG retval=1;
/* 0. allocate pointers from IDL */
npoints1 = *((IDL_LONG *)argv[0]);
ra1 = (double *)argv[1];
dec1 = (double *)argv[2];
npoints2 = *((IDL_LONG *)argv[3]);
ra2 = (double *)argv[4];
dec2 = (double *)argv[5];
matchlength = *(double *)argv[6];
minchunksize = *(double *)argv[7];
match1 = (IDL_LONG *)argv[8];
match2 = (IDL_LONG *)argv[9];
distance12 = (double *)argv[10];
nmatch = (IDL_LONG *)argv[11];
/* 1. define chunks */
setchunks(ra1,dec1,npoints1,minchunksize,&rabounds,
&decbounds,&nra,&ndec,&raoffset);
/* 2. assign targets to chunks, with minFibreSpacing of leeway */
assignchunks(ra2,dec2,npoints2,raoffset,matchlength,minchunksize,&nchunk2,
&chunklist2,rabounds,decbounds,nra,ndec);
/* 3. make x, y, z coords -- compute (x,y,z)1 on the fly - DPF */
xx2=(double *) IDL_GetScratch(&vxx2,npoints2,sizeof(double));
yy2=(double *) IDL_GetScratch(&vyy2,npoints2,sizeof(double));
zz2=(double *) IDL_GetScratch(&vzz2,npoints2,sizeof(double));
for(i=0;i<npoints2;i++) {
xx2[i]=cos(DEG2RAD*ra2[i])*cos(DEG2RAD*dec2[i]);
yy2[i]=sin(DEG2RAD*ra2[i])*cos(DEG2RAD*dec2[i]);
zz2[i]=sin(DEG2RAD*dec2[i]);
} /* end for i */
/* 4. run matching */
maxmatch = (*nmatch); /* if nmatch != 0 then fill arrays up to maxmatch */
(*nmatch)=0;
for(i=0;i<npoints1;i++) {
currra=fmod(ra1[i]+raoffset,360.);
getchunk(currra,dec1[i],&rachunk,&decchunk,rabounds,decbounds,nra,ndec);
jmax=nchunk2[decchunk][rachunk];
if(jmax>0) {
myx1=cos(DEG2RAD*ra1[i])*cos(DEG2RAD*dec1[i]);
myy1=sin(DEG2RAD*ra1[i])*cos(DEG2RAD*dec1[i]);
myz1=sin(DEG2RAD*dec1[i]);
for(j=0;j<jmax;j++) {
k=chunklist2[decchunk][rachunk][j];
sep=separation(myx1,myy1,myz1,xx2[k],yy2[k],zz2[k]);
if(sep<matchlength) {
if(maxmatch>(*nmatch)) {
match1[(*nmatch)]=i;
match2[(*nmatch)]=k;
distance12[(*nmatch)]=sep;
} /* end if */
(*nmatch)++;
} /* end if */
} /* end for j */
} /* end if jmax>0 */
} /* end for i */
/* 4. clean up after chunks */
unassignchunks(&nchunk2,&chunklist2,nra,ndec);
unsetchunks(&rabounds,&decbounds,&nra,&ndec);
/* 6. free memory */
free_memory();
return retval;
}