C @(#)updtl.for 17.1.1.1 (ES0-DMD) 01/25/02 17:15:46 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 C C C----------------------------------------------------------------------- SUBROUTINE UPDTL( MCAT , NL , NN , M ) C IMPLICIT NONE C INTEGER ISTAT INTEGER NL INTEGER M , M3 , M4 C INTEGER M1 , M2 INTEGER MB , MCAT(4,NL) , MM3 , MR , MS C INTEGER MX1 , MX2 INTEGER MX3 , MX4 , MXX4 C INTEGER MY1 , MY2 INTEGER MY3 , MY4 , MYY4 INTEGER NN , NNB , NXB C REAL B1 , B2, BX1 , BX2 , BY1 , BY2 C MS = M - MOD( M-1 , NL ) - 1 IF (MS .GE. NL) THEN CALL STTPUT('*** FATAL: Internal buffer overflow; ',ISTAT) CALL STTPUT + (' Please, restrict search to smaller subframe',ISTAT) CALL STTPUT + (' or modify parameter setup fro detection',ISTAT) CALL STSEPI ENDIF MB = M - MS IF ( MB .EQ. 0 ) THEN MS = MS - NL MB = NL ENDIF MM3 = MCAT(3,MB) C C ****** Read neighbour parameters. C IF ( NN .GT. MS ) THEN NNB = MOD( NN-1 , NL ) + 1 M3 = MCAT(3,NNB) M4 = MCAT(4,NNB) c ELSE c READ ( ISF , REC=NN ) M1 , M2 , M3 , M4 , B1 , B2 ENDIF MR = 0 C C ****** Four out of five cases will be considered. C IF ( M3 . EQ. 0 .AND. MM3 .EQ. 0 ) THEN C C ****** Detection is single and neighbour is single. C M3 = NN MM3 = NN M4 = M MR = 1 ELSE IF ( M3 .EQ. 0 .AND. MM3 .NE. 0 ) THEN C C ****** Detection is multiple and neighbour is single. C IF ( MM3 .GT. MS ) THEN NXB = MOD( MM3-1 , NL ) + 1 MX4 = MCAT( 4 , NXB ) c ELSE c READ ( ISF , REC=MM3 ) MX1 , MX2 , MX3 , MX4 , BX1 , BX2 ENDIF M4 = MX4 MX4 = NN M3 = MM3 IF ( MM3 .GT. MS ) THEN MCAT( 4 , NXB ) = MX4 c ELSE c WRITE ( ISF , REC=MM3 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF MR = 1 ELSE IF ( M3 .NE. 0 .AND. MM3 .EQ. 0 ) THEN C C ****** Detection is single, neighbour is multiple. C MM3 = M3 MX4 = M4 MXX4 = M4 IF ( M4 .EQ. 0 ) THEN M4 = M MR = 1 ENDIF 10 CONTINUE IF ( MXX4 .GT. MS ) THEN NXB = MOD ( MXX4-1 , NL ) + 1 MX4 = MCAT(4,NXB) c ELSE IF ( MXX4 .GT. 0 ) THEN c READ ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF IF ( MX4 .NE. 0 ) THEN MXX4 = MX4 GOTO 10 ENDIF MX4 = M IF ( MXX4 .GT. MS ) THEN NXB = MOD( MXX4-1 , NL ) + 1 MCAT(4,NXB) = MX4 c ELSE IF ( MXX4 .GT. 0 ) THEN c WRITE ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF ELSE IF ( M3 .NE. 0 .AND. MM3 .NE. 0 .AND. M3 .NE. MM3 ) THEN C C ****** Detection is multiple, neighbour is multiple. C ****** They belong to different objects. C MY3 = MM3 IF ( MY3 .GT. MS ) THEN NXB = MOD( MY3-1 , NL ) + 1 MY4 = MCAT( 4 , NXB ) c ELSE c READ ( ISF , REC=MY3 ) MY1, MY2, MY3, MY4, BY1, BY2 ENDIF MYY4 = MY4 MX3 = M3 IF ( MX3 .GT. MS ) THEN NXB = MOD( MX3-1 , NL ) + 1 MX4 = MCAT( 4 , NXB ) c ELSE c READ ( ISF , REC=MX3 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF MY4 = MX3 MX3 = MY3 IF ( MY3 . GT. MS ) THEN NXB = MOD( MY3-1 , NL ) + 1 MCAT( 4 , NXB ) = MY4 c ELSE c WRITE ( ISF , REC=MY3 ) MY1, MY2, MY3, MY4, BY1, BY2 ENDIF IF ( MY4 .GT. MS ) THEN NXB = MOD( MY4-1 , NL ) + 1 MCAT ( 3 , NXB ) = MX3 c ELSE c WRITE ( ISF , REC=MY4 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF MXX4 = MX4 20 CONTINUE IF ( MXX4 .GT. MS ) THEN NXB = MOD ( MXX4-1 , NL ) + 1 MX4 = MCAT( 4 , NXB ) c ELSE IF ( MXX4 .GT. 0 ) THEN c READ ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF IF ( MX4 .NE. 0 ) THEN MX3 = MY3 IF ( MXX4 .GT. MS ) THEN NXB = MOD( MXX4-1 , NL ) + 1 MCAT( 3 , NXB ) = MX3 c ELSE c READ ( ISF , REC=MXX4 ) MX1,MX2,MX3,MX4,BX1,BX2 ENDIF MXX4 = MX4 GOTO 20 ENDIF MX3 = MY3 MX4 = MYY4 IF ( MXX4 .GT. MS ) THEN NXB = MOD( MXX4-1 , NL ) + 1 MCAT(3,NXB) = MX3 MCAT(4,NXB) = MX4 c ELSE IF ( MXX4 .GT. 0 ) THEN c WRITE ( ISF , REC=MXX4 ) MX1, MX2, MX3, MX4, BX1, BX2 ENDIF ENDIF IF ( MR .EQ. 1 ) THEN IF ( NN .GT. MS ) THEN NXB = MOD( NN-1 , NL ) + 1 MCAT(3,NXB) = M3 MCAT(4,NXB) = M4 c ELSE c WRITE ( ISF , REC=NN ) M1 , M2 , M3 , M4 , B1 , B2 ENDIF ENDIF MCAT(3,MB) = MM3 C RETURN C END