C @(#)mvautil.for 17.1.1.1 (ES0-DMD) 01/25/02 17:16:38 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 SUBROUTINE MAPSM(IN,OUT,NAR,NSEL,NCOL) INTEGER NAR,NSEL,NCOL,I,J REAL*4 IN(NAR,NCOL),OUT(NSEL,NCOL) DO 20 J=1,NCOL DO 10 I=1,NSEL OUT(I,J) = IN(I,J) 10 CONTINUE 20 CONTINUE RETURN END SUBROUTINE MIPSM(IN,OUT,NAR,NSEL,NCOL) INTEGER NAR,NSEL,NCOL,I,J REAL*4 IN(NAR,NCOL) INTEGER OUT(NSEL,NCOL) DO 20 J=1,NCOL DO 10 I=1,NSEL OUT(I,J) = IN(I,J) 10 CONTINUE 20 CONTINUE RETURN END SUBROUTINE MAPBG(IN,OUT,NAR,NSEL,NCOL) INTEGER NAR,NSEL,NCOL,TINULL,I,J REAL*4 IN(NSEL,NCOL),OUT(NAR,NCOL) REAL*4 TRNULL DOUBLE PRECISION TDNULL CALL TBMNUL(TINULL,TRNULL,TDNULL) DO 30 J=1,NCOL DO 10 I=1,NSEL OUT(I,J) = IN(I,J) 10 CONTINUE DO 20 I=NSEL+1,NAR OUT(I,J) = TDNULL 20 CONTINUE 30 CONTINUE RETURN END SUBROUTINE MIPBG(IN,OUT,NAR,NSEL,NCOL) INTEGER NAR,NSEL,NCOL,TINULL,I,J INTEGER IN(NSEL,NCOL) REAL*4 OUT(NAR,NCOL) REAL*4 TRNULL DOUBLE PRECISION TDNULL CALL TBMNUL(TINULL,TRNULL,TDNULL) DO 30 J=1,NCOL DO 10 I=1,NSEL OUT(I,J) = IN(I,J) 10 CONTINUE DO 20 I=NSEL+1,NAR OUT(I,J) = TDNULL 20 CONTINUE 30 CONTINUE RETURN END SUBROUTINE CHSEL(TID,NROW,NSEL) C C COUNT SELECTED ELEMENTS C INTEGER*4 TID,STATUS,NROW,NSEL,I LOGICAL SEL C NSEL = 0 DO I = 1, NROW CALL TBSGET(TID,I,SEL,STATUS) IF (SEL) NSEL = NSEL+1 ENDDO RETURN END