/*===========================*/ /* DML routines */ /*===========================*/ /*-Title: DYNAMIC MEMORY LIST (DML) ROUTINES -end*/ /*-Intro: These are a series of 'C' based routines concerned with the allocation and management of memory for lists of (in memory) records. Up to 100 separate lists may be managed. Fortran interfaces are provided for the the routines except those which return pointers to the stored data. Two general purpose sort routines are also included. -end*/ /*-Section_order: 1 2 -end*/ /* Routines: The following routines are available: Managed memory lists dml_init Allocate and initialise a new records list dml_addrec Add a record to a records list dml_delrecs Delete selected records from a records list dml_numrecs Return the number of records stored dml_recpointer Return the current pointer to a given record dml_getrec Return the contents of a given record dml_putrec Store new contents for a given record dml_data Return current pointer to data dml_clear Clear data from a records list dml_freespace Free space at the end of a records list dml_free Free a records list for re-use dml_freeall Free all records lists for re-use dml_sort Sort records list dml_sort0 Sort records list General purpose sort routines dml_qsor Sort in memory records dml_qsor0 Sort in memory records */ #include #include #include "dml_systyp.h" /* Define Fortran binding names */ #if LINKTYP == 1 #define dmlf_init dmlf_init_ #define dmlf_addrec dmlf_addrec_ #define dmlf_delrecs dmlf_delrecs_ #define dmlf_numrecs dmlf_numrecs_ #define dmlf_getrec dmlf_getrec_ #define dmlf_putrec dmlf_putrec_ #define dmlf_clear dmlf_clear_ #define dmlf_freespace dmlf_freespace_ #define dmlf_free dmlf_free_ #define dmlf_freeall dmlf_freeall_ #define dmlf_sort dmlf_sort_ #define dmlf_sort0 dmlf_sort0_ #define dmlf_qsor dmlf_qsor_ #define dmlf_qsor0 dmlf_qsor0_ #endif #if LINKTYP == 2 #define dmlf_init DMLF_INIT #define dmlf_addrec DMLF_ADDREC #define dmlf_delrecs DMLF_DELRECS #define dmlf_numrecs DMLF_NUMRECS #define dmlf_getrec DMLF_GETREC #define dmlf_putrec DMLF_PUTREC #define dmlf_clear DMLF_CLEAR #define dmlf_freespace DMLF_FREESPACE #define dmlf_free DMLF_FREE #define dmlf_freeall DMLF_FREEALL #define dmlf_sort DMLF_SORT #define dmlf_sort0 DMLF_SORT #define dmlf_qsor DMLF_QSOR #define dmlf_qsor0 DMLF_QSOR0 #endif void dmlf_init(); void dmlf_addrec(); void dmlf_delrecs(); void dmlf_numrecs(); void dmlf_getrec(); void dmlf_putrec(); void dmlf_clear(); void dmlf_freespace(); void dmlf_free(); void dmlf_freeall(); void dmlf_sort(); void dmlf_sort0(); void dmlf_qsor(); void dmlf_qsor0(); #define MAXLISTS 100 #define MAXSP 25 #define CUTOFF 20 typedef struct _ListPar { int in_use; int init_alloc; int inc_alloc; int rec_size; int num_alloc; int last_rec; void * data; }ListPar; static ListPar lists[MAXLISTS]; static int initialised=0; /*-Section: Managing Dynamic Memory Lists Routines are available to create new dynamic memory lists, to add, replace or read records in such lists or to delete the memory allocated when no longer required. Routines are also available to sort such lists. -end*/ /*-Routine: Allocate and initialise a list - dml_init The routine dml_init (dmlf_init) checks to see if a spare slot is available and, if so, allocates the memory for a new records list with an initial allocation of records. The routine returns an index (handle) to be used in all other routines for accessing that list. -end*/ /* ************************ ** dml_init ** ************************ Purpose: Allocate and initialise a list Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_INIT (INIT_ALLOC, INT_ALLOC, NWRDS, MINDX) CD-end: */ /*-Parameters: INIT_ALLOC i (R) Initial allocation required (no. of records). INC_ALLOC i (R) No. of records by which to extend the list each time an extension is required. NWRDS i (R) Number of words/record. MINDX i (W) Index for the allocated reflection list (>=0) A negative return value indicates an error and the value is the return code from the routine dml_init. -end*/ /*-C:*/ int dml_init (int init_alloc, int inc_alloc, int rec_size) /*end*/ /*-Parameters: int init_alloc Number of records for initial allocation (R) int inc_alloc Number of records for further increments (R) int rec_size Record size in bytes (R) Return: >=0, the index of the allocated list -1, no spare lists available -2, cannot allocate initial memory -3, invalid parameter in call -end*/ { int i; int indx; if (!initialised) { for (i=0;i=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; lists[mindx].last_rec += 1; if (lists[mindx].last_rec>=lists[mindx].num_alloc) { lists[mindx].data = realloc (lists[mindx].data, (lists[mindx].num_alloc+lists[mindx].inc_alloc)* lists[mindx].rec_size); if (lists[mindx].data==0) { dml_free (mindx); return -2; } lists[mindx].num_alloc += lists[mindx].inc_alloc; } p = (char *) lists[mindx].data + lists[mindx].last_rec*lists[mindx].rec_size; memcpy ((void *) p, rec, lists[mindx].rec_size); return 0; } /* Fortran binding: dmlf_addrec */ void dmlf_addrec (int *mindx, int *irec, int *ierr) { *ierr = dml_addrec (*mindx, irec); return; } /*-Routine: Delete records from a list - dml_delrecs The routine dml_delrecs (dmlf_delrecs) deletes records from a records list. A user supplied function determines whether or not a record is to be deleted based on the record contents. -end*/ /* ************************ ** dml_delrecs ** ************************ Purpose: Delete selected records from a list Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_DELRECS (MINDX, DELFUN, IDATA, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT DELFUN s (R) User supplied function to check for deletion IDATA() i (R) Data array to pass to DELFUN routine IERR i (W) Error return code from dml_delrecs DELFUN will be as follows: INTEGER FUNCTION DELFUN (IREC, IDATA) Return 1 if the record is to be deleted Return 0 if the record is not to be deleted IREC() is a record buffer passed internally from the records list IDATA() is the data passed from the calling routine to be used if and as needed -end*/ /*-C:*/ int dml_delrecs (int mindx, int (*delfun)(), void * client_data) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) int (* delfun)(); User supplied function to see if record is to be deleted return 1 if yes, 0 if no. Call is: delfun (void *rec, void * client_data) where rec is a pointer to the record being tested. and client_data is passed from the calling routine. (R) Return: = 0, OK = -1, Invalid index given or list not initialised -end*/ { char * p1; char * p2; int i; int ndel; if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; if (lists[mindx].last_rec<0) return -1; p1 = (char *) lists[mindx].data; p1 -= lists[mindx].rec_size; p2 = p1; ndel = 0; for (i=0;i<=lists[mindx].last_rec;++i) { p1 += lists[mindx].rec_size; if (delfun((void *) p1, client_data)) {ndel++; continue;} p2 += lists[mindx].rec_size; if (p2!=p1) memcpy ((void *) p2, (void *) p1, lists[mindx].rec_size); } lists[mindx].last_rec -= ndel; return 0; } /* Fortran binding: dmlf_delrecs */ void dmlf_delrecs (int *mindx, int (*delfun)(), int *idata, int *ierr) { *ierr = dml_delrecs (*mindx, delfun, idata); return; } /*-Routine: Return the number of records stored - dml_numrecs The routine dml_numrecs (dmlf_numrecs) returns the number of records currently stored in a records list. -end*/ /* ************************ ** dml_numrecs ** ************************ Purpose: Return the number of records stored Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_NUMRECS (MINDX, NUMREC) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT NUMREC i (W) The number of records in the list (-1 if an invalid index given or the list not initialised) -end*/ /*-C:*/ int dml_numrecs (int mindx) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) Return: >= 0, The number of records currently stored for the records list = -1, Invalid index given or list not initialised -end*/ { if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; if (lists[mindx].last_rec<0) return 0; return lists[mindx].last_rec + 1; } /* Fortran binding: dmlf_numrecs */ void dmlf_numrecs (int *mindx, int*numrec) { *numrec = dml_numrecs (*mindx); return; } /*-Routine: Get record pointer - dml_recpointer The routine dml_recpointer returns the current value of a pointer to a given record within a records list.deletes records from a records list. Note that this may change if routines such as dml_addrec, dml_freespace or dml_delrecs are called. Note also that this routine does not have a Fortran interface and the stored data cannot be accessed direcly from Fortran. -end*/ /* ************************ ** dml_recpointer ** ************************ Purpose: Get current record pointer for a given record Author: John W. Campbell, May 1995 CD-Fortran: No Fortran interface. CD-end: */ /*-C:*/ void * dml_recpointer (int mindx, int irec) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) int irec; Record number (from 1 upwards) (R) Return: > 0, The record pointer, OK = 0, Invalid index given, list not initialised or requested record not present -end*/ { char * ptemp; if (!initialised) return 0; if (mindx<0||mindx>=MAXLISTS) return 0; if (lists[mindx].in_use==0) return 0; if (irec<1) return 0; if (irec-1>lists[mindx].last_rec) return 0; ptemp = (char *)lists[mindx].data; ptemp += (irec-1)*lists[mindx].rec_size; return (void *) ptemp; } /*-Routine: Return the contents of a given record - dml_getrec The routine dml_getrec (dmlf_getrec) returns the contents of a requested record. -end*/ /* ************************ ** dml_getrec ** ************************ Purpose: Return the data for a given record Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_GETREC (MINDX, IR, IREC, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT IR i (R) Record number (from 1 upwards) IREC() i (W) Record buffer IERR i (W) Error return code from dml_getrec -end*/ /*-C:*/ int dml_getrec (int mindx, int irec, void * rec) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) int irec; Record number (from 1 upwards) (R) void * rec; Record buffer in which data are to be returned (W) Return: = 0, OK = -1, Invalid index given, list not initialised or requested record not present -end*/ { char * p; if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; if (irec<1) return -1; if (irec-1>lists[mindx].last_rec) return -1; p = lists[mindx].data; p += (irec-1)*lists[mindx].rec_size; memcpy (rec, (void *) p, lists[mindx].rec_size); return 0; } /* Fortran binding: dmlf_getrec */ void dmlf_getrec (int *mindx, int *ir, int *irec, int *ierr) { *ierr = dml_getrec (*mindx, *ir, irec); return; } /*-Routine: Update the contents of a given record - dml_putrec The routine dml_putrec (dmlf_putrec) updates the contents of a requested record. -end*/ /* ************************ ** dml_putrec ** ************************ Purpose: Update the data for a given record Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_PUTREC (MINDX, IR, IREC, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT IR i (R) Record number (from 1 upwards) IREC() i (R) Record buffer IERR i (W) Error return code from dml_addrec -end*/ /*-C:*/ int dml_putrec (int mindx, int irec, void * rec) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) int irec; Record number (from 1 upwards) (R) void * rec; Record buffer containing the new data (R) Return: = 0, OK = -1, Invalid index given, list not initialised or requested record not present -end*/ { char * p; if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; if (irec<1) return -1; if (irec-1>lists[mindx].last_rec) return -1; p = lists[mindx].data; p += (irec-1)*lists[mindx].rec_size; memcpy ((void *) p, rec, lists[mindx].rec_size); return 0; } /* Fortran binding: dmlf_putrec */ void dmlf_putrec (int *mindx, int *ir, int *irec, int *ierr) { *ierr = dml_putrec (*mindx, *ir, irec); return; } /*-Routine: Return current data pointer - dml_data The routine dml_data returns the current data pointer to the data in a records list. Note that this may change after calls to dml_addrec and dml_freespace where memory may be re-allocated. Note also that this routine does not have a Fortran interface and the stored data cannot be accessed direcly from Fortran. -end*/ /* ************************ ** dml_data ** ************************ Purpose: Return current pointer to the data Author: John W. Campbell, May 1995 CD-Fortran: No Fortran interface. CD-end: */ /*-C:*/ void * dml_data (int mindx) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) Return: > 0, The data pointer = 0, Invalid index given or list not initialized -end*/ { if (!initialised) return 0; if (mindx<0||mindx>=MAXLISTS) return 0; if (lists[mindx].in_use==0) return 0; return lists[mindx].data; } /*-Routine: Clear a records list - dml_clear The routine dml_clear (dmlf_clear) clears a records list but keeps the memory currently allocated for that list. -end*/ /* ************************* ** dml_clear ** ************************* Purpose: Clear records list but keep allocated memory Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_CLEAR (MINDX, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT IERR i (W) Return flag from dml_clear call -end*/ /*-C:*/ int dml_clear (int mindx) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) Return: = 0, OK = -1, Invalid index given or list not initialised -end*/ { int nr; if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; lists[mindx].last_rec = -1; return 0; } /* Fortran binding: dmlf_clear */ void dmlf_clear (int *mindx, int *ierr) { *ierr = dml_clear (*mindx); return; } /*-Routine: Free unused space - dml_freespace The routine dml_freespace (dmlf_freespace) frees any unused memory at the end of a records list. A minimum of one record's worth of memory will remain even if the list is empty. New records may be added with the dml_addrec routine as required. -end*/ /* ************************* ** dml_freespace ** ************************* Purpose: Free unused memory at the end of a records list Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_FREESPACE (MINDX, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT IERR i (W) Return flag from dml_freespace call -end*/ /*-C:*/ int dml_freespace (int mindx) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) Return: = 0, OK = -1, Invalid index given or list not initialised -end*/ { int nr; if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; nr = lists[mindx].last_rec + 1; if (nr<1) nr = 1; lists[mindx].data = realloc (lists[mindx].data, nr*lists[mindx].rec_size); lists[mindx].num_alloc = nr; return 0; } /* Fortran binding: dmlf_freespace */ void dmlf_freespace (int *mindx, int *ierr) { *ierr = dml_freespace (*mindx); return; } /*-Routine: Free a records list for re-use - dml_free The routine dml_free (dmlf_free) frees a records list for re-use. The memory used for the list is de-allocated and the index is freed for use by another list. -end*/ /* ************************ ** dml_free ** ************************ Purpose: Free a records list for re-use Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_FREE (MINDX, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT IERR i (W) Return flag from dml_clear call -end*/ /*-C:*/ int dml_free (int mindx) /*end*/ /*-Parameters: int mindx; Index to required list as returned from dml_init (R) Return: = 0, OK = -1, Invalid index given or list not initialised -end*/ { if (!initialised) return -1; if (mindx<0||mindx>=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; if (lists[mindx].data!=0) free (lists[mindx].data); lists[mindx].in_use = 0; lists[mindx].init_alloc = 100; lists[mindx].inc_alloc = 100; lists[mindx].rec_size = sizeof(int); lists[mindx].num_alloc = 0; lists[mindx].last_rec = -1; lists[mindx].data = 0; return 0; } /* Fortran binding: dmlf_free */ void dmlf_free (int *mindx, int *ierr) { *ierr = dml_free (*mindx); return; } /*-Routine: Free all the records lists for re-use - dml_freeall The routine dml_freeall (dmlf_freeall) frees all the records lists and the memory associated with them for re-use. -end*/ /* ************************ ** dml_freeall ** ************************ Purpose: Free all records lists for re-use Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_FREEALL CD-end: */ /*-Parameters: none -end*/ /*-C:*/ void dml_freeall() /*end*/ /*-Parameters: none Return: none -end*/ { int i; for (i=0;iirec2 wrt the required sort key(s) -1 if irec1i2 -1 if irec1==irec2 wrt the sort key(s) and i1rec2 wrt the required sort key(s) -1 if rec1i2 -1 if rec1==rec2 wrt the sort key(s) and i1=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; nrecs = lists[mindx].last_rec + 1; if (nrecs<2) return 0; i = dml_qsor (lists[mindx].data, nrecs, lists[mindx].rec_size, compar); if (i!=0) return -2; return 0; } /* Fortran binding: dmlf_sort */ void dmlf_sort (int *mindx, int (*sorfun)(), int *ierr) { *ierr = dml_sort (*mindx, sorfun); return; } /*-Routine: Sort a records list - dml_sort0 The routine dml_sort0 (dmlf_sort0) sorts a records list. A user supplied function compares a given pair of records to determine their relative order. This version does not preserve the order of records which have identical sort keys. If the order of records with the same sort key is to be preserved, dml_sort (dmlf_sort) may be used instead. -end*/ /* ************************ ** dml_sort0 ** ************************ Purpose: Sort a records list Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_SORT0 (MINDX, SORFUN, IERR) CD-end: */ /*-Parameters: MINDX i (R) Index as returned by DMLF_INIT SORFUN s (R) User supplied function to compare two records IERR i (W) Error return code from dml_delrecs SORFUN will be as follows: INTEGER FUNCTION SORFUN (IREC1, IREC2) IREC1() The first record for the comparison IREC2() The second reord for the comparison return 1 if irec1>irec2 wrt the required sort key(s) -1 if irec1rec2 wrt the required sort key(s) 0 if rec1==rec2 wrt the required sort key(s) -1 if rec1=MAXLISTS) return -1; if (lists[mindx].in_use==0) return -1; nrecs = lists[mindx].last_rec + 1; if (nrecs<2) return 0; i = dml_qsor0 (lists[mindx].data, nrecs, lists[mindx].rec_size, compar); if (i!=0) return -2; return 0; } /* Fortran binding: dmlf_sort0 */ void dmlf_sort0 (int *mindx, int (*sorfun)(), int *ierr) { *ierr = dml_sort0 (*mindx, sorfun); return; } /*-Section: General Purpose Sort Routines Two routines are available for sorting in memory data treated logically as a set of records. In contrast to the other DML routines described in the previous section, these are passed the address of the memory array/area to be sorted rather than a memory list allocated and managed via the DML routines. They may thus be used for example to sort data held in a Fortran array. -end*/ /*-Routine: Sort in memory records - dml_qsor This routine sorts a set of in memory records. A user supplied function compares a given pair of records to determine their relative order. This version preserves the order of records which have identical sort keys but uses additional temporary memory (allocated internally) for an index array. If the order of records with the same sort key is unimportant dml_qsor0 may be used instead. -end*/ /* ************************ ** dml_qsor ** ************************ Purpose: Sort in memory records preserving order of records with identical sort keys, Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_QSOR (IDATA, NRECS, NWRDS, SORFUN, IERR) CD-end: */ /*-Parameters: IDATA i (R) The array of data to be sorted NRECS i (R) No. of 'records' of data in the array NWRDS i (R) No. of words/'record' in the array SORFUN s (R) User supplied function to compare two records IERR i (W) Error return code from dml_delrecs SORFUN will be as follows: INTEGER FUNCTION SORFUN (IREC1, IREC2, I1, I2) IREC1() The first record for the comparison IREC2() The second reord for the comparison I1 An integer passed from the sort routine I2 An integer passed from the sort routine return 1 if irec1>irec2 wrt the required sort key(s) -1 if irec1i2 -1 if irec1==irec2 wrt the sort key(s) and i1rec2 wrt the required sort key(s) -1 if rec1i2 -1 if rec1==rec2 wrt the sort key(s) and i1CUTOFF) { middle = (low+high)/2; pmiddle = dp + middle*rec_len; if ((*compar)(plow, pmiddle, &indx[low], &indx[middle])>0) { memcpy (ptemp, pmiddle, rec_len); memcpy (pmiddle, plow, rec_len); memcpy (plow, ptemp, rec_len); itemp = indx[middle]; indx[middle] = indx[low]; indx[low] = itemp; } if ((*compar)(pmiddle, phigh, &indx[middle], &indx[high])>0) { memcpy (ptemp, phigh, rec_len); memcpy (phigh, pmiddle, rec_len); memcpy (pmiddle, ptemp, rec_len); itemp = indx[high]; indx[high] = indx[middle]; indx[middle] = itemp; if ((*compar)(plow, pmiddle, &indx[low], &indx[middle])>0) { memcpy (ptemp, pmiddle, rec_len); memcpy (pmiddle, plow, rec_len); memcpy (plow, ptemp, rec_len); itemp = indx[middle]; indx[middle] = indx[low]; indx[low] = itemp; } } memcpy (cut, pmiddle, rec_len); idxcut = indx[middle]; up = low; pup = dp + up*rec_len; down = high; pdown = dp + down*rec_len; lab70: down--; pdown = dp + down*rec_len; if ((*compar)(cut, pdown, &idxcut, &indx[down])<0) goto lab70; lab80: up++; pup = dp + up*rec_len; if ((*compar)(cut, pup, &idxcut, &indx[up])>0) goto lab80; if (up=2) { mm = high-1; for (m=low;m<=mm;++m) { pm = dp + m*rec_len; min = m; pmin = dp + min*rec_len; mmm = m + 1; for (n=mmm;n<=high;++n) { pn = dp + n*rec_len; if ((*compar)(pmin, pn, &indx[min], &indx[n])>0) { min = n; pmin = dp + min*rec_len; } } if (min!=m) { memcpy (ptemp, pm, rec_len); memcpy (pm, pmin, rec_len); memcpy (pmin, ptemp, rec_len); itemp = indx[m]; indx[m] = indx[min]; indx[min] = itemp; } } } if (sp<0) goto tidy; low = sav[0][sp]; plow = dp + low*rec_len; high = sav[1][sp]; phigh = dp + high*rec_len; sp--; goto lab20; } sp++; if (sp>=MAXSP) {ier=-2; goto tidy;} bottom = down - low; top = high - up; if (bottom>top) { sav[0][sp] = low; sav[1][sp] = down; low = up; plow = dp + low*rec_len; } else { sav[0][sp] = up; sav[1][sp] = high; high = down; phigh = dp + high*rec_len; } goto lab20; tidy: if (ptemp!=0) free(ptemp); if (cut!=0) free(cut); if (indx!=0) free(indx); return ier; } /* Fortran binding: dmlf_qsor */ void dmlf_qsor (int *idata, int * nrecs, int *nwrds, int (*sorfun)(), int *ierr) { *ierr = dml_qsor (idata, *nrecs, (*nwrds)*sizeof(int), sorfun); return; } /*-Routine: Sort in memory records - dml_qsor0 This routine sorts a set of in memory records. A user supplied function compares a given pair of records to determine their relative order. This version does not preserve the order of records which have identical sort keys. If the order of records with the same sort key is important dml_qsor may be used instead. -end*/ /* ************************ ** dml_qsor0 ** ************************ Purpose: Sort in memory records. Author: John W. Campbell, May 1995 CD-Fortran: CALL DMLF_QSOR0 (IDATA, NRECS, NWRDS, SORFUN, IERR) CD-end: */ /*-Parameters: IDATA i (R) The array of data to be sorted NRECS i (R) No. of 'records' of data in the array NWRDS i (R) No. of words/'record' in the array SORFUN s (R) User supplied function to compare two records IERR i (W) Error return code from dml_delrecs SORFUN will be as follows: INTEGER FUNCTION SORFUN (IREC1, IREC2, I1, I2) IREC1() The first record for the comparison IREC2() The second reord for the comparison return 1 if irec1>irec2 wrt the required sort key(s) -1 if irec1rec2 wrt the required sort key(s) 0 if rec1==rec2 wrt the required sort key(s) -1 if rec1CUTOFF) { middle = (low+high)/2; pmiddle = dp + middle*rec_len; if ((*compar)(plow, pmiddle)>0) { memcpy (ptemp, pmiddle, rec_len); memcpy (pmiddle, plow, rec_len); memcpy (plow, ptemp, rec_len); } if ((*compar)(pmiddle, phigh)>0) { memcpy (ptemp, phigh, rec_len); memcpy (phigh, pmiddle, rec_len); memcpy (pmiddle, ptemp, rec_len); if ((*compar)(plow, pmiddle)>0) { memcpy (ptemp, pmiddle, rec_len); memcpy (pmiddle, plow, rec_len); memcpy (plow, ptemp, rec_len); } } memcpy (cut, pmiddle, rec_len); up = low; pup = dp + up*rec_len; down = high; pdown = dp + down*rec_len; lab70: down--; pdown = dp + down*rec_len; if ((*compar)(cut, pdown)<0) goto lab70; lab80: up++; pup = dp + up*rec_len; if ((*compar)(cut, pup)>0) goto lab80; if (up=2) { mm = high-1; for (m=low;m<=mm;++m) { pm = dp + m*rec_len; min = m; pmin = dp + min*rec_len; mmm = m + 1; for (n=mmm;n<=high;++n) { pn = dp + n*rec_len; if ((*compar)(pmin, pn)>0) { min = n; pmin = dp + min*rec_len; } } if (min!=m) { memcpy (ptemp, pm, rec_len); memcpy (pm, pmin, rec_len); memcpy (pmin, ptemp, rec_len); } } } if (sp<0) goto tidy; low = sav[0][sp]; plow = dp + low*rec_len; high = sav[1][sp]; phigh = dp + high*rec_len; sp--; goto lab20; } sp++; if (sp>=MAXSP) {ier=-2; goto tidy;} bottom = down - low; top = high - up; if (bottom>top) { sav[0][sp] = low; sav[1][sp] = down; low = up; plow = dp + low*rec_len; } else { sav[0][sp] = up; sav[1][sp] = high; high = down; phigh = dp + high*rec_len; } goto lab20; tidy: if (ptemp!=0) free(ptemp); if (cut!=0) free(cut); return ier; } /* Fortran binding: dmlf_qsor0 */ void dmlf_qsor0 (int *idata, int * nrecs, int *nwrds, int (*sorfun)(), int *ierr) { *ierr = dml_qsor0 (idata, *nrecs, (*nwrds)*sizeof(int), sorfun); return; }