C @(#)sortit.for 17.1.1.1 (ESO-DMD) 01/25/02 17:40:36 C=========================================================================== C Copyright (C) 1995 European Southern Observatory (ESO) C C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of C the License, or (at your option) any later version. C C This program is distributed in the hope that it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General Public License for more details. C C You should have received a copy of the GNU General Public C License along with this program; if not, write to the Free C Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, C MA 02139, USA. C C Correspondence concerning ESO-MIDAS should be addressed as follows: C Internet e-mail: midas@eso.org C Postal address: European Southern Observatory C Data Management Division C Karl-Schwarzschild-Strasse 2 C D 85748 Garching bei Muenchen C GERMANY C=========================================================================== C SUBROUTINE SORTME(RA,ZBINS,N,LL,VALU,STATUS) C C++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine SORTME C.AUTHOR C K. Banse ESO - Garching C C.KEYWORDS C sorting C C.PURPOSE C sort an array to get the median value C C.ALGORITHM C for sorting we use the Heapsort algorithm from "Numerical Recipes", page 231 C C.INPUT/OUTPUT C C call as SORTME(RA,ZBINS,N,LL,VALU,STATUS) C C input par: C ZBINS: R*4 array low, high excess bins C if low >= high, no excess bins C N: I*4 size of array RA C LL: I*4 index of array element to be returned C C in/output par: C RA: R*4 array array to be sorted C C output par: C VALU: R*4 value = RA(LL) of sorted array RA C STATUS: I*4 return status, = 0 is o.k. C C.VERSIONS C 1.00 pulled out from `smosub3.for' C C-------------------------------------------------- C C IMPLICIT NONE C INTEGER N,LL,STATUS INTEGER NTRUE,LLTRUE,L C REAL RA(N),ZBINS(2),VALU REAL ZL,ZH C STATUS = 0 C C first check for excess bins IF (ZBINS(2).GT.ZBINS(1)) THEN ZL = ZBINS(1) ZH = ZBINS(2) NTRUE = 0 DO 100, L=1,N IF ((RA(L).GE.ZL).AND.(RA(L).LE.ZH)) THEN NTRUE = NTRUE + 1 RA(NTRUE) = RA(L) ENDIF 100 CONTINUE LLTRUE = (NTRUE+1)/2 ELSE NTRUE = N LLTRUE = LL ENDIF C IF (NTRUE.LE.3) THEN IF (NTRUE.LT.1) THEN STATUS = -1 RETURN ELSE IF (NTRUE.LE.2) THEN VALU = RA(1) !for ndim = 1,2, median is 1st elem. RETURN ELSE VALU = RA(2) !for ndim = 3, median is 2nd elem. RETURN ENDIF ENDIF C CALL NSORT(RA,NTRUE,LLTRUE,VALU) RETURN C END