SUBROUTINE GETDEL (CLTIME, CLSRC, CLSTA, CLARR, CLFQID, * BUFFIM, GEODLY, IERR) C----------------------------------------------------------------------- C! Evaluates delay polynomials in IM table, shifts them to CL table C# EXT-appl VLBI C----------------------------------------------------------------------- C; Copyright (C) 1995, 1996 C; Associated Universities, Inc. Washington DC, USA. 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 Massachusetts Ave, Cambridge, C; MA 02139, USA. C; C; Correspondence concerning AIPS should be addressed as follows: C; Internet email: aipsmail@nrao.edu. C; Postal address: AIPS Project Office C; National Radio Astronomy Observatory C; 520 Edgemont Road C; Charlottesville, VA 22903-2475 USA C----------------------------------------------------------------------- C----------------------------------------------------------------------- C Routine to evaluate the geometric delay polynomials in the IM table C for the times in the new CL table. C C Input: C CLTIME D CL entry time (days) C CLSRC I CL entry source C CLSTA I CL entry antenna number C CLARR I CL entry array number C CLFQID I CL entry FQID C BUFFIM I(*) IM table buffer C Output: C GEODLY I(*) Delay polynomial C IERR I 0 => all OK C 1 => EOF on IM table with no match C----------------------------------------------------------------------- INCLUDE 'INCS:PUVD.INC' INCLUDE 'INCS:DGLB.INC' INCLUDE 'INCS:DMSG.INC' INTEGER CLSRC, CLSTA, CLARR, CLFQID, IERR, BUFFIM(*) DOUBLE PRECISION CLTIME, GEODLY(*) C Local variables DOUBLE PRECISION DELTIM, POLYN(10), CURTIM DOUBLE PRECISION TRANGE INTEGER NUMENT, IROWS, IROWE, IROWP, I, TIM(4) REAL RTIME LOGICAL VALID SAVE CURTIM, IROWS, IROWE, IROWP INCLUDE 'INCS:DIMV.INC' C----------------------------------------------------------------------- C Number of entries in IM table NUMENT = BUFFIM(5) C Lifetime of an IM entry is two C mins, note no backward eval. of C polynomials is allowed, i.e. C delta time > 0. TRANGE = 2.0D0 / 1440.0D0 C Initialize curr. IM block time C and IM row pointer IROWP; save C IROWP pointer, as IM table vals. C are guaranteed to be in time C order. IF (IIMRNO.LE.1) THEN CURTIM = -99.0D0 IROWP = 1 END IF C See if we already have the right C IM table timerange for this CL C entry, if not find start, end row, C starting search at current row C pointer DELTIM = CLTIME - CURTIM IF ((DELTIM.LE.TRANGE).AND.(DELTIM.GT.0.0D0)) GO TO 200 C If out of time sequence then C backspace current pointer in C table. IF (DELTIM.LT.0) THEN IIMRNO = MAX (IROWP-1, 1) C While (ROW > 0) and (still C out of time sequence) do: C backspace record 20 IF ((IIMRNO.LE.0).OR.(CURTIM.LT.(CLTIME-TRANGE))) GO TO 40 CALL IMTAB ('READ', BUFFIM, NOBAND, IERR) IF (IERR.GT.0) THEN WRITE (MSGTXT,1010) IERR GO TO 990 END IF CURTIM = TIME IIMRNO = IIMRNO - 2 GO TO 20 C Endwhile 40 IROWP = IIMRNO + 1 END IF C Start searching through the IM C table from row IROWP until reach C an entry within two minutes (beyond) C an IM table row time tag, then C determine start and end row in IM C table for this timerange. IROWS = 0 IROWE = 0 IIMRNO = IROWP C 50 IF (IIMRNO.GT.NUMENT) THEN MSGTXT = 'No IM entries for this CL timerange, returning zeros' CALL DFILL (NPOLY, 0.D0, GEODLY) GO TO 999 END IF CALL IMTAB ('READ', BUFFIM, NOBAND, IERR) IF (IERR.GT.0) THEN WRITE (MSGTXT,1010) IERR GO TO 990 END IF IF ((CLTIME-TIME).LE.TRANGE.AND.(CLTIME-TIME).GT.0.0D0) THEN CURTIM = TIME IROWS = IIMRNO - 1 DO 100 I=1,NUMENT IF (IIMRNO.GT.NUMENT) THEN IROWE = NUMENT IROWP = NUMENT + 1 GO TO 200 END IF CALL IMTAB ('READ', BUFFIM, NOBAND, IERR) IF (IERR.GT.0) THEN WRITE (MSGTXT,1010) IERR GO TO 990 END IF IF (TIME.GT.CURTIM) THEN IROWE = IIMRNO - 2 IROWP = IIMRNO - 1 GO TO 200 END IF 100 CONTINUE ELSE GO TO 50 END IF C Search from IROWS to IROWE for C IM entry for this CL time/src etc. 200 VALID = .FALSE. DO 250 I=IROWS,IROWE IIMRNO = I CALL IMTAB ('READ', BUFFIM, NOBAND, IERR) IF (IERR.GT.0) THEN WRITE (MSGTXT,1010) IERR GO TO 990 END IF VALID = (ISRC.EQ.CLSRC) .AND. (NOSTA.EQ.CLSTA) .AND. * (IFQID.EQ.CLFQID) IF (VALID) GO TO 300 250 CONTINUE C Problem: no IM entry found. C This can be caused by the rare C occurence of the correlator C dropping an IM record. Warn the C user. Zero the delays for now. C This problem is under C investigation (30NOV94) RTIME = CLTIME CALL TODHMS (RTIME, TIM) WRITE (MSGTXT,1020) CLSTA, CLSRC, TIM CALL DFILL (NPOLY, 0.D0, GEODLY) GO TO 990 C C Convert time offset to seconds, C must be positive, in keeping with C correlator implementation 300 DELTIM = (CLTIME - CURTIM) * 86400.0D0 IF (DELTIM.LT.0.0D0) THEN WRITE (MSGTXT,1030) IERR = 2 GO TO 990 END IF C Move IM polynomial to temp array CALL DPCOPY (NPOLY, GDELA1, POLYN) C At this point, correct polyn. C is in POLYN, now shift delay to C CL table entry time. For the C delay, this is equivalent to C evaluating the previous IM C table polynomial at the CL C entry time, it is slightly C different than evaluation for C the higher-order terms. This is C a little academic anyway, as C these polynomials are never C used (yet). CALL PSHIFT (DELTIM, POLYN) C Flush results into GEODLY CALL DPCOPY (NPOLY, POLYN, GEODLY) GO TO 999 C 990 CALL MSGWRT (6) 999 RETURN C----------------------------------------------------------------------- 1010 FORMAT ('GETDEL: ERROR ',I3,' READING IM TABLE') 1020 FORMAT ('GETDEL: No IM entry for station ',I2,' source ',I3, * ' at ',I3,'/',3I3) 1030 FORMAT ('GETDEL: NEGATIVE POLYNOMIAL EVALUATION ERROR') END