C @(#)tmask.for	19.1 (ES0-DMD) 02/25/03 13:29:45
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 TMASK(KAMP,DAK,CMA,PAR,NCO,BET,NPU,IVX,IVY,
     *                 ITER,MX,MY,MR,MC,PMA,KFL)
C
      IMPLICIT  NONE
      INTEGER   KAMP(10000,15,2)
      REAL      DAK(2000,3)
      REAL      CMA 
      REAL      PAR(1)
      INTEGER   NCO
      REAL      BET
      INTEGER   NPU
      INTEGER   IVX(1)
      INTEGER   IVY(1)
      INTEGER   ITER
      INTEGER   MX(1)
      INTEGER   MY(1)
      INTEGER   MR
      INTEGER   MC
      REAL      PMA
      INTEGER   KFL
C
      INTEGER   NPAR
      INTEGER   MC2, MR2
      INTEGER   KR
      INTEGER   I, II, IR, J
      INTEGER   IXF, IYF
      INTEGER   IDX, IDY, INDI
      INTEGER   INX, INY
      INTEGER   KDX, KDY
      INTEGER   KRX(100),KRY(100),KRM(100)
      INTEGER   LX, LY
      INTEGER   ISCA, IA, LF, LF1
      INTEGER   IND
      INTEGER   ISTAT
      
      REAL      RMAG
      REAL      D1, D2, DH
      REAL      PARS(300)
      REAL      RX, RY
C
      NPAR=NCO*4+3
      MC2=MC/2+1
      MR2=MR/2+1
      KR=0
C
      IF (ITER.EQ.1) THEN
         DO 10 I=1,NPAR
            PARS(I)=PAR(I)
   10    CONTINUE
         DO 20 I=1,NPU
           MX(I)=0
           MY(I)=0
   20    CONTINUE
         KR=1
      ELSE
         DO 30 I=1,NCO
            IND=4*I
            D1=ABS(PARS(IND+1)-PAR(IND+1))
            D2=ABS(PARS(IND+2)-PAR(IND+2))
            DH=-2.5*ALOG10(PARS(IND)/PAR(IND))
            IF(D1.GE.0.1) KRX(I)=1
            IF(D2.GE.0.1) KRY(I)=1
            IF(DH.GE.PMA) KRM(I)=1
            IF(KRX(I).EQ.1.OR.KRY(I).EQ.1.OR.KRM(I).EQ.1) KR=1
   30    CONTINUE
      END IF
C
      IF (KR.EQ.1) THEN
         KFL=0
         DO 40 II=1,NCO
            IND=II*4
            RX=PAR(IND+1)-INT(PAR(IND+1))
            RY=PAR(IND+2)-INT(PAR(IND+2))
            IXF=INT(RX*10+.5)
            IYF=INT(RY*10+.5)
            KDX=0
            KDY=0
            IF(IXF.EQ.5.AND.RX.GT..5) KDX=-1
            IF(IYF.EQ.5.AND.RY.GT..5) KDY=-1
            IF (IXF.LE.5) THEN
               IXF=IXF+5
            ELSE
              IXF=IXF-5
            END IF
            IF (IYF.LE.5) THEN
               IYF=IYF+5
            ELSE
               IYF=IYF-5
            END IF
            RMAG = -2.5*ALOG10(PAR(IND)*3.14159*PAR(IND+3)**2/
     2             (BET-1))+CMA
            IF (RMAG.LT.DAK(1,3)) THEN
               RMAG=DAK(1,3)
               KFL=1
            END IF
            LX=0
            LY=0
            IF (IXF.GT.5) THEN
               IXF=10-IXF
               LX=1
            END IF
            IF (IYF.GT.5) THEN
               IYF=10-IYF
               LY=1
            END IF
            ISCA = 0
            IF (IYF.LT.IXF) THEN
               IA=IXF
               IXF=IYF
               IYF=IA
               ISCA=1
            END IF
            LF=0
            LF1=0
            I=0
C
12          CONTINUE
            IF (LF.NE.0) GO TO 11
            I=I+1
            IF (I.GE.2000) THEN
               IF (LF1.EQ.0) THEN
                  CALL STTPUT('***FATAL: Too many data points'//
     2                        ' (TMASK)',ISTAT)
                  CALL STSEPI
               ELSE
                  I=IR
                  LF=1
               END IF
            ELSE
               IF (INT(DAK(I,1)*10+.5).EQ.IXF) THEN
                  IF (INT(DAK(I,2)*10+.5).EQ.IYF) THEN
                     IF (RMAG.GE.DAK(I,3)) THEN
                        IF (DAK(I,3).GT.0.1) THEN
                           LF1=1
                           IR=I
                           IF (RMAG-PMA.LT.DAK(I,3)) THEN
                              LF=1
                           END IF
                        END IF
                     END IF
                  END IF
               END IF
            END IF
            GO TO 12
C
11          CONTINUE
            INDI=(IR-1)*MR
            DO 50  J=1,NPU
               IDX=INT(PAR(IND+1)+.5)-IVX(J)
               IDY=INT(PAR(IND+2)+.5)-IVY(J)
               IDX=IDX+KDX
               IDY=IDY+KDY
               IF (LX.EQ.1) IDX=-IDX
               IF(LY.EQ.1) IDY=-IDY
               IF (ISCA.EQ.1) THEN
                  IA=IDX
                  IDX=IDY
                  IDY=IA
               END IF
               INX=MC2-IDX
               INY=MR2-IDY
               IF (INX.GE.1 .AND. INX.LE.MC .AND. 
     2             INY.GE.1.AND.INY.LE.MR) THEN
                  MX(J)=MAX0(MX(J),KAMP(INDI+INY,INX,1))
                  MY(J)=MAX0(MY(J),KAMP(INDI+INY,INX,2))
               ELSE
                  MX(J)=MAX0(MX(J),1)
                  MY(J)=MAX0(MY(J),1)
               END IF
  50        CONTINUE
  40     CONTINUE
C
         DO 60 I=1,NCO
            IND=4*I
            IF (KRM(I).EQ.1) THEN
               PARS(IND)=PAR(IND)
               KRM(I)=0
            END IF
            IF (KRX(I).EQ.1) THEN
               PARS(IND+1)=PAR(IND+1)
               KRX(I)=0
            END IF
            IF (KRY(I).EQ.1) THEN
               PARS(IND+2)=PAR(IND+2)
               KRY(I)=0
           END IF
  60     CONTINUE
      END IF
C
      RETURN
      END
