C @(#)tdminmax.for 17.1.1.1 (ES0-DMD) 01/25/02 17:47:15 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 Corresponding 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 C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C C.VERSION: 1.0 ESO-FORTRAN Conversion, AA 15:39 - 15 DEC 1987 C C.LANGUAGE: F77+ESOext C C.AUTHOR: J.D.PONZ C.IDENTIFICATION TDMNMX.FOR C.KEYWORDS TABLE, APPLICATIONS C.ENVIRONMENT MIDAS C C------------------------------------------------------------------ SUBROUTINE TDUMNX(TID,ICOL,N,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE ARRAY X. C NULL VALUES ARE NOT CONSIDERED. C NO SELECTION MASK. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER TID ! IN : table identifier INTEGER ICOL ! IN : column number INTEGER N ! IN : number of rows in the table INTEGER IL ! IN : logarithm flag REAL XMIN ! OUT: minimum value REAL XMAX ! OUT : maximum value C INTEGER I, J, STATUS REAL XX LOGICAL ISEL, INULL C XMIN = 0 XMAX = XMIN IF (IL.EQ.0) THEN DO 10 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDR(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = XX XMAX = XX GO TO 20 END IF 10 CONTINUE RETURN 20 CONTINUE DO 30 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDR(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = MIN(XMIN,XX) XMAX = MAX(XMAX,XX) END IF 30 CONTINUE ELSE DO 40 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDR(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.0) THEN XMIN = XX XMAX = XX GO TO 50 END IF 40 CONTINUE RETURN 50 CONTINUE IF (IL.EQ.1) THEN XMIN = ALOG10(XX) ELSE XMIN = ALOG(XX) END IF XMAX = XMIN DO 60 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDR(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.D0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,ALOG10(XX)) XMAX = MAX(XMAX,ALOG10(XX)) ELSE XMIN = MIN(XMIN,ALOG(XX)) XMAX = MAX(XMAX,ALOG(XX)) END IF END IF 60 CONTINUE END IF RETURN END SUBROUTINE TDMNXR(N,X,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE ARRAY X. C NULL VALUES ARE NOT CONSIDERED. C NO SELECTION MASK. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER N ! IN : dimension REAL X(N) ! IN : data array INTEGER IL ! IN : logarithm fleg REAL XMIN ! OUT: minimum value REAL XMAX ! OUT : maximum value C INTEGER I, J, TINULL REAL XX REAL TBLSEL, TRNULL DOUBLE PRECISION TDTRUE, TDFALS, TDNULL C C ... GET MACHINE CONSTANTS C CALL TBMCON(TBLSEL, TDTRUE, TDFALS) CALL TBMNUL(TINULL, TRNULL, TDNULL) C I = 1 XX = X(I) XMIN = 0.0 XMAX = XMIN IF (IL.EQ.0) THEN 10 CONTINUE IF ( .NOT. (XX.EQ.TRNULL.AND.I.LT.N)) GO TO 20 I = I + 1 XX = X(I) GO TO 10 20 CONTINUE XMIN = XX XMAX = XX DO 30 J = I,N IF (X(J).NE.TRNULL) THEN XMIN = MIN(XMIN,X(J)) XMAX = MAX(XMAX,X(J)) END IF 30 CONTINUE ELSE 40 CONTINUE IF ( .NOT. ((XX.EQ.TRNULL.OR.XX.LE.0.0).AND.I.LT. + N)) GO TO 50 I = I + 1 XX = X(I) GO TO 40 50 CONTINUE IF (IL.EQ.1) THEN XMIN = ALOG10(XX) ELSE XMIN = ALOG(XX) END IF XMAX = XMIN DO 60 J = I,N IF (X(J).NE.TRNULL .AND. X(J).GT.0.0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,ALOG10(X(J))) XMAX = MAX(XMAX,ALOG10(X(J))) ELSE XMIN = MIN(XMIN,ALOG(X(J))) XMAX = MAX(XMAX,ALOG(X(J))) END IF END IF 60 CONTINUE END IF RETURN END SUBROUTINE TDMNXD(N,X,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE ARRAY X. C NULL VALUES ARE NOT CONSIDERED. C DOUBLE PRECISION VERSION. C NO SELECTION MASK. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER N ! IN : array length DOUBLE PRECISION X(N) ! IN : data array INTEGER IL ! IN : logarithm flag DOUBLE PRECISION XMIN ! OUT: minimum value DOUBLE PRECISION XMAX ! OUT: maximum value C INTEGER I, J, TINULL REAL TBLSEL, TRNULL DOUBLE PRECISION TDTRUE, TDFALS, TDNULL DOUBLE PRECISION XX C C ... GET MACHINE CONSTANTS C CALL TBMCON(TBLSEL, TDTRUE, TDFALS) CALL TBMNUL(TINULL, TRNULL, TDNULL) C I = 1 XX = X(I) XMIN = 0.D0 XMAX = XMIN IF (IL.EQ.0) THEN 10 CONTINUE IF ( .NOT. (XX.EQ.TDNULL.AND.I.LT.N)) GO TO 20 I = I + 1 XX = X(I) GOTO 10 20 CONTINUE XMIN = XX XMAX = XX DO 30 J = I,N IF (X(J).NE.TDNULL) THEN XMIN = MIN(XMIN,X(J)) XMAX = MAX(XMAX,X(J)) END IF 30 CONTINUE ELSE 40 CONTINUE IF ( .NOT. ((XX.EQ.TDNULL.OR.XX.LE.0.0).AND.I.LT. + N)) GO TO 50 I = I + 1 XX = X(I) GO TO 40 50 CONTINUE IF (IL.EQ.1) THEN XMIN = DLOG10(XX) ELSE XMIN = DLOG(XX) END IF XMAX = XMIN DO 60 J = I,N IF (X(J).NE.TDNULL .AND. X(J).GT.0.0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,DLOG10(X(J))) XMAX = MAX(XMAX,DLOG10(X(J))) ELSE XMIN = MIN(XMIN,DLOG(X(J))) XMAX = MAX(XMAX,DLOG(X(J))) END IF END IF 60 CONTINUE END IF RETURN END SUBROUTINE TDMXIS(TID,ICOL,N,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE TABLE TID C NULL AND NON SELECTED VALUES ARE NOT CONSIDERED. C INTEGER VERSION. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER TID ! IN : table identifier INTEGER ICOL ! IN : column index INTEGER N ! IN : array length INTEGER IL ! IN : logarithm flag REAL XMIN ! OUT: minimum value REAL XMAX ! OUT: maximum value C INTEGER I, J, IVAL, STATUS REAL XX LOGICAL ISEL, INULL C XMIN = 0.0 XMAX = XMIN IF (IL.EQ.0) THEN DO 10 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDI(TID,I,ICOL,IVAL,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = IVAL XMAX = IVAL GO TO 20 END IF 10 CONTINUE RETURN 20 CONTINUE DO 30 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDI(TID,J,ICOL,IVAL,INULL,STATUS) XX = IVAL IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = MIN(XMIN,XX) XMAX = MAX(XMAX,XX) END IF 30 CONTINUE ELSE DO 40 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDI(TID,I,ICOL,IVAL,INULL,STATUS) XX = IVAL IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.0) THEN XMIN = XX XMAX = XX GO TO 50 END IF 40 CONTINUE RETURN 50 CONTINUE IF (IL.EQ.1) THEN XMIN = ALOG10(XX) ELSE XMIN = ALOG(XX) END IF XMAX = XMIN DO 60 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDI(TID,J,ICOL,IVAL,INULL,STATUS) XX = IVAL IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.D0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,ALOG10(XX)) XMAX = MAX(XMAX,ALOG10(XX)) ELSE XMIN = MIN(XMIN,ALOG(XX)) XMAX = MAX(XMAX,ALOG(XX)) END IF END IF 60 CONTINUE END IF RETURN END SUBROUTINE TDMXRS(TID,ICOL,N,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE TABLE TID C NULL AND NON SELECTED VALUES ARE NOT CONSIDERED. C SINGLE PRECISION VERSION. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER TID ! IN : table identifier INTEGER ICOL ! IN : column index INTEGER N ! IN : array length INTEGER IL ! IN : logarithm flag REAL XMIN ! OUT: minimum value REAL XMAX ! OUT: maximum value C INTEGER I, J, STATUS REAL XX LOGICAL ISEL, INULL C XMIN = 0.0 XMAX = XMIN IF (IL.EQ.0) THEN DO 10 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDR(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = XX XMAX = XX GO TO 20 END IF 10 CONTINUE RETURN 20 CONTINUE DO 30 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDR(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = MIN(XMIN,XX) XMAX = MAX(XMAX,XX) END IF 30 CONTINUE ELSE DO 40 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDR(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.0) THEN XMIN = XX XMAX = XX GO TO 50 END IF 40 CONTINUE RETURN 50 CONTINUE IF (IL.EQ.1) THEN XMIN = ALOG10(XX) ELSE XMIN = ALOG(XX) END IF XMAX = XMIN DO 60 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDR(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.D0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,ALOG10(XX)) XMAX = MAX(XMAX,ALOG10(XX)) ELSE XMIN = MIN(XMIN,ALOG(XX)) XMAX = MAX(XMAX,ALOG(XX)) END IF END IF 60 CONTINUE END IF RETURN END SUBROUTINE TDMXDS(TID,ICOL,N,IL,XMIN,XMAX) C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.PURPOSE C FIND MINIMUM/ MAXIMUM VALUES IN THE TABLE TID C NULL AND NON SELECTED VALUES ARE NOT CONSIDERED. C DOUBLE PRECISION VERSION. C C------------------------------------------------------------------ IMPLICIT NONE INTEGER TID ! IN : table identifier INTEGER ICOL ! IN : column index INTEGER N ! IN : array length INTEGER IL ! IN : logarithm flag DOUBLE PRECISION XMIN ! OUT: minimum value DOUBLE PRECISION XMAX ! OUT : maximum value C INTEGER I, J, STATUS DOUBLE PRECISION XX LOGICAL ISEL, INULL C XMIN = 0.D0 XMAX = XMIN IF (IL.EQ.0) THEN DO 10 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDD(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = XX XMAX = XX GO TO 20 END IF 10 CONTINUE RETURN 20 CONTINUE DO 30 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDD(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL)) THEN XMIN = MIN(XMIN,XX) XMAX = MAX(XMAX,XX) END IF 30 CONTINUE ELSE DO 40 I = 1,N CALL TBSGET(TID,I,ISEL,STATUS) CALL TBERDD(TID,I,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.D0) THEN XMIN = XX XMAX = XX GO TO 50 END IF 40 CONTINUE RETURN 50 CONTINUE IF (IL.EQ.1) THEN XMIN = DLOG10(XX) ELSE XMIN = DLOG(XX) END IF XMAX = XMIN DO 60 J = I,N CALL TBSGET(TID,J,ISEL,STATUS) CALL TBERDD(TID,J,ICOL,XX,INULL,STATUS) IF (ISEL .AND. (.NOT.INULL) .AND. XX.GT.0.D0) THEN IF (IL.EQ.1) THEN XMIN = MIN(XMIN,DLOG10(XX)) XMAX = MAX(XMAX,DLOG10(XX)) ELSE XMIN = MIN(XMIN,DLOG(XX)) XMAX = MAX(XMAX,DLOG(XX)) END IF END IF 60 CONTINUE END IF RETURN END