C @(#)tdcopy.for	17.1.1.1 (ES0-DMD) 01/25/02 17:47:13
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  19:37 - 11 DEC 1987
C
C.LANGUAGE: F77+ESOext
C
C.AUTHOR: J.D.PONZ
C
C
C.IDENTIFICATION        TDCOPY.FOR
C.KEYWORDS           TABLE, APPLICATIONS
C.ENVIRONMENT  MIDAS
C.PURPOSE
C  UTILITIES USED INTERNALLY IN THE PACKAGE TO COPY SCALARS, VECTORS AND
C  COLUMNS
C
C
C------------------------------------------------------------------
C
      SUBROUTINE TDCPVV(INPUT,OUTPUT,N)
C
C COPY INPUT(N) INTO OUTPUT(N)
C INTERNAL ROUTINE TO BE USED IN THE MAPPING CONTEXT
      IMPLICIT NONE
C
      INTEGER  N
      REAL     INPUT(N)
      REAL     OUTPUT(N)
      INTEGER  I
C
C
      DO 10 I = 1,N
          OUTPUT(I) = INPUT(I)
   10 CONTINUE
      RETURN

      END

      SUBROUTINE TDCPSV(INPUT,OUTPUT,N,I)
C
C COPY THE SINGLE PRECISION VALUE INPUT(I) INTO THE ARRAY OUTPUT(N)
C INTERNAL ROUTINE TO BE USED IN THE MAPPING CONTEXT
C
C      IMPLICIT NONE
      INTEGER I,J,N
      REAL INPUT(I),OUTPUT(N)

      DO 10 J = 1,N
          OUTPUT(J) = INPUT(I)
   10 CONTINUE
      RETURN

      END

      SUBROUTINE TDCPDV(INPUT,OUTPUT,N,I)
C
C COPY THE DOUBLE PRECISION VALUE INPUT(I) INTO THE ARRAY OUTPUT(N)
C INTERNAL ROUTINE TO BE USED IN THE MAPPING CONTEXT
C
C      IMPLICIT NONE
      INTEGER I,J,N
      DOUBLE PRECISION INPUT(I),OUTPUT(N)

      DO 10 J = 1,N
          OUTPUT(J) = INPUT(I)
   10 CONTINUE
      RETURN

      END

      SUBROUTINE TDCPSS(INPUT,OUTPUT,I,J)
C
C COPY INPUT(I) INTO OUTPUT(J)
C INTERNAL ROUTINE TO BE USED IN THE MAPPING CONTEXT
C
C      IMPLICIT NONE

      INTEGER I,J
      REAL INPUT(I),OUTPUT(J)

      OUTPUT(J) = INPUT(I)
      RETURN

      END

      SUBROUTINE TDCPDD(INPUT,OUTPUT,I,J)
C
C COPY INPUT(I) INTO OUTPUT(J)
C      IMPLICIT NONE
C INTERNAL ROUTINE TO BE USED IN THE MAPPING CONTEXT
C

      INTEGER I,J
      DOUBLE PRECISION INPUT(I),OUTPUT(J)

      OUTPUT(J) = INPUT(I)
      RETURN

      END

      SUBROUTINE TDCCRR(MASK,INPUT,OUTPUT,N)
C
C  COPY REAL ARRAY ACCORDING TO MASK.
C      IMPLICIT NONE
C SKIP OVER NON SELECTED VALUES
C
      INTEGER I,N
      REAL MASK(N),INPUT(N),OUTPUT(N)
C
      REAL TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET SELECTION VALUE
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL) OUTPUT(I) = INPUT(I)
   10 CONTINUE
      RETURN

      END

      SUBROUTINE TDCCR1(MASK,INPUT,OUTPUT,N,NT)
C
C  COPY REAL ARRAY ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
      INTEGER I,N,NT,NNT
      REAL MASK(N),INPUT(N),OUTPUT(N)
C
      REAL TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET SELECTION VALUE
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      NNT    = 0
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              NNT    = NNT + 1
              OUTPUT(NNT) = INPUT(I)
          END IF

   10 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCCR2(MASK,INPUT,OUTPUT,N,NT)
C
C  COPY REAL ARRAY ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C       DO NOT COPY THE NULL VALUES
C
C      IMPLICIT NONE
      INTEGER I,N,NT,NNT
      REAL MASK(N),INPUT(N),OUTPUT(N)
C
      INTEGER TINULL
      REAL    TBLSEL, TRNULL
      DOUBLE PRECISION TDTRUE, TDFALS, TDNULL
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
      CALL TBMNUL(TINULL, TRNULL, TDNULL)
C
C ... ITERATION
C
      NNT    = 0
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL .AND. INPUT(I).NE.TRNULL) THEN
              NNT    = NNT + 1
              OUTPUT(NNT) = INPUT(I)
          END IF

   10 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCCDD(MASK,INPUT,OUTPUT,N)
C
C  COPY DOUBLE PRECISION ARRAY ACCORDING TO MASK.
C SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
      INTEGER I,N
      REAL MASK(N)
      DOUBLE PRECISION INPUT(N),OUTPUT(N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL) OUTPUT(I) = INPUT(I)
   10 CONTINUE
      RETURN

      END

      SUBROUTINE TDCCD1(MASK,INPUT,OUTPUT,N,NT)
C
C  COPY REAL ARRAY ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
      INTEGER I,N,NT,NNT
      REAL MASK(N)
      DOUBLE PRECISION INPUT(N),OUTPUT(N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      NNT    = 0
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              NNT    = NNT + 1
              OUTPUT(NNT) = INPUT(I)
          END IF

   10 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCCD2(MASK,INPUT,OUTPUT,N,NT)
C
C  COPY REAL ARRAY ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C       DO NOT COPY NULL VALUES
C
C      IMPLICIT NONE
      INTEGER I,N,NT,NNT
      REAL MASK(N)
      DOUBLE PRECISION INPUT(N),OUTPUT(N)
C
      INTEGER TINULL
      REAL    TBLSEL, TRNULL
      DOUBLE PRECISION TDTRUE, TDFALS, TDNULL
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
      CALL TBMNUL(TINULL, TRNULL, TDNULL)
C
C ... ITERATION
C
      NNT    = 0
      DO 10 I = 1,N
          IF (MASK(I).EQ.TBLSEL .AND. INPUT(I).NE.TDNULL) THEN
              NNT    = NNT + 1
              OUTPUT(NNT) = INPUT(I)
          END IF

   10 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCCWW(MASK,INPUT,OUTPUT,N,NW)
C
C  COPY BYTE ARRAY ACCORDING TO MASK.
C SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
      INTEGER I,J,N,NW
      REAL MASK(N)
      REAL INPUT(NW,N),OUTPUT(NW,N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      DO 20 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              DO 10 J = 1,NW
                  OUTPUT(J,I) = INPUT(J,I)
   10         CONTINUE
          END IF

   20 CONTINUE
      RETURN

      END

      SUBROUTINE TDCCW1(MASK,INPUT,OUTPUT,N,NW,NT)
C
C  COPY ARRAY ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C
      INTEGER I,J,N,NW,NT,NNT
      REAL MASK(N)
      REAL INPUT(NW,N),OUTPUT(NW,N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      NNT    = 0
      DO 20 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              NNT    = NNT + 1
              DO 10 J = 1,NW
                  OUTPUT(J,NNT) = INPUT(J,I)
   10         CONTINUE
          END IF

   20 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCCSS(MASK,INPUT,OUTPUT,N,ISI,NB,ISO,NBI,NBO)
C
C  COPY BYTE SUBSTRINGS ACCORDING TO MASK.
C SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
C
      INTEGER I,J,J1,ISI,NB,NBI,NBO,ISO,IEND,N
      REAL MASK(N)
      INTEGER INPUT(NBI,N),OUTPUT(NBO,N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      IEND   = ISI + NB - 1
C
      DO 20 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              J1     = ISO
              DO 10 J = ISI,IEND
                  OUTPUT(J1,I) = INPUT(J,I)
                  J1     = J1 + 1
   10         CONTINUE
          END IF

   20 CONTINUE
      RETURN

      END

      SUBROUTINE TDCCS1(MASK,INPUT,OUTPUT,N,ISI,NB,ISO,NBI,NBO,NT)
C
C  COPY BYTE SUBSTRINGS ACCORDING TO MASK.
C DO NOT SKIP OVER NON SELECTED VALUES
C
C      IMPLICIT NONE
C
      INTEGER I,J,N,J1,NB,ISI,ISO,NBI,NBO,NT,NNT,IEND
      REAL MASK(N)
      INTEGER INPUT(NBI,N),OUTPUT(NBO,N)
C
      REAL    TBLSEL
      DOUBLE PRECISION TDTRUE, TDFALS
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
C
C ... ITERATION
C
      IEND   = ISI + NB - 1
      NNT    = 0
C
      DO 20 I = 1,N
          IF (MASK(I).EQ.TBLSEL) THEN
              NNT    = NNT + 1
              J1     = ISO
              DO 10 J = ISI,IEND
                  OUTPUT(J1,NNT) = INPUT(J,I)
                  J1     = J1 + 1
   10         CONTINUE
          END IF

   20 CONTINUE
      NT     = NNT
      RETURN

      END

      SUBROUTINE TDCRRR(MASK,IDENT1,IDENT2,IREF,ISORT,NBYTES,INPUT,NBI,
     +                  ISI,OUTPUT,NBO,ISO,NIN,NOUT)
C
C      IMPLICIT NONE
C COPY BY REFERENCE VALUES
C REFERENCE COLUMN IN SINGLE PRECISION
C
      INTEGER IREF,ISORT,NBYTES,NBI,ISI,ISO,NBO,NIN,NOUT,N
      INTEGER NB,I,N1,I1,NN1,NEXT
      REAL MASK(NIN),INPUT(1),OUTPUT(1)
      REAL IDENT1(NIN),IDENT2(NOUT),ZERO,VALUE
C
      INTEGER TINULL
      REAL    TBLSEL, TRNULL
      DOUBLE PRECISION TDTRUE, TDFALS, TDNULL
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
      CALL TBMNUL(TINULL, TRNULL, TDNULL)
C
      ZERO   = 0.
      N      = MAX(NIN,NOUT)
      NB     = NBYTES
C
C ... JUMP ACCORDING TO OUTPUT FORMAT
C
      IF (NBYTES+4) 10,80,150
C
C ... DOUBLE PRECISION
C
   10 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 30 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBAR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   20                     N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 20
                          END IF

                      END IF

                  END IF

   30         CONTINUE

          ELSE
              DO 50 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBDR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   40                     N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 40
                          END IF

                      END IF

                  END IF

   50         CONTINUE
          END IF

      ELSE
          DO 70 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                  NN1    = 1
   60             CALL TZSCSR(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      N1     = 2*NEXT - 1
                      I1     = 2*I - 1
                      OUTPUT(N1) = INPUT(I1)
                      N1     = N1 + 1
                      I1     = I1 + 1
                      OUTPUT(N1) = INPUT(I1)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 60
                  END IF

              END IF

   70     CONTINUE
      END IF

      RETURN
C
C ... SINGLE PRECISION
C
   80 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 100 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBAR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   90                     OUTPUT(NEXT) = INPUT(I)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 90
                          END IF

                      END IF

                  END IF

  100         CONTINUE

          ELSE
              DO 120 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBDR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  110                     OUTPUT(NEXT) = INPUT(I)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 110
                          END IF

                      END IF

                  END IF

  120         CONTINUE
          END IF

      ELSE
          DO 140 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                  NN1    = 1
  130             CALL TZSCSR(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      OUTPUT(NEXT) = INPUT(I)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 130
                  END IF

              END IF

  140     CONTINUE
      END IF

      RETURN
C
C ... CHARACTER STRING
C
  150 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 170 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBAR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  160                     CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,
     +                                ISO,NB,N)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 160
                          END IF

                      END IF

                  END IF

  170         CONTINUE

          ELSE
              DO 190 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                      CALL TZSBDR(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  180                     CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,
     +                                ISO,NB,N)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 180
                          END IF

                      END IF

                  END IF

  190         CONTINUE
          END IF

      ELSE
          DO 210 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TRNULL) THEN
                  NN1    = 1
  200             CALL TZSCSR(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,ISO,
     +                            NB,N)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 200
                  END IF

              END IF

  210     CONTINUE
      END IF

      RETURN

      END

      SUBROUTINE TDCRDD(MASK,IDENT1,IDENT2,IREF,ISORT,NBYTES,INPUT,NBI,
     +                  ISI,OUTPUT,NBO,ISO,NIN,NOUT)
C
C COPY BY REFERENCE VALUES
C REFERENCE COLUMN IN DOUBLE PRECISION
C
C      IMPLICIT NONE
      INTEGER IREF,ISORT,NBYTES,NBI,ISI,ISO,NIN,NOUT,I,I1,N1
      REAL MASK(NIN),INPUT(1),OUTPUT(1)
      DOUBLE PRECISION IDENT1(NIN),IDENT2(NOUT),VALUE,ZERO
C
      INTEGER TINULL,NBO,N,NB,NEXT,NN1
      REAL    TBLSEL, TRNULL
      DOUBLE PRECISION TDTRUE, TDFALS, TDNULL
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
      CALL TBMNUL(TINULL, TRNULL, TDNULL)
      ZERO   = 0.D0
      N      = MAX(NIN,NOUT)
      NB     = NBYTES
C
C ... JUMP ACCORDING TO OUTPUT FORMAT
C
      IF (NBYTES+4) 10,80,150
C
C ... DOUBLE PRECISION
C
   10 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 30 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBAD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   20                     N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 20
                          END IF

                      END IF

                  END IF

   30         CONTINUE

          ELSE
              DO 50 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBDD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   40                     N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 40
                          END IF

                      END IF

                  END IF

   50         CONTINUE
          END IF

      ELSE
          DO 70 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                  NN1    = 1
   60             CALL TZSCSD(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      N1     = 2*NEXT - 1
                      I1     = 2*I - 1
                      OUTPUT(N1) = INPUT(I1)
                      N1     = N1 + 1
                      I1     = I1 + 1
                      OUTPUT(N1) = INPUT(I1)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 60
                  END IF

              END IF

   70     CONTINUE
      END IF

      RETURN
C
C ... SINGLE PRECISION
C
   80 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 100 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBAD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
   90                     OUTPUT(NEXT) = INPUT(I)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 90
                          END IF

                      END IF

                  END IF

  100         CONTINUE

          ELSE
              DO 120 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBDD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  110                     OUTPUT(NEXT) = INPUT(I)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 110
                          END IF

                      END IF

                  END IF

  120         CONTINUE
          END IF

      ELSE
          DO 140 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                  NN1    = 1
  130             CALL TZSCSD(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      OUTPUT(NEXT) = INPUT(I)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 130
                  END IF

              END IF

  140     CONTINUE
      END IF

      RETURN
C
C ... CHARACTER STRING
C
  150 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 170 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBAD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  160                     CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,
     +                                ISO,NB,N)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 160
                          END IF

                      END IF

                  END IF

  170         CONTINUE

          ELSE
              DO 190 I = 1,NIN
                  VALUE  = IDENT1(I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                      CALL TZSBDD(IDENT2,NOUT,VALUE,ZERO,1,NEXT)
                      IF (NEXT.GT.0) THEN
  180                     CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,
     +                                ISO,NB,N)
C
C ... CASE OF EQUAL OUTPUT REFERENCES
C
                          IF (NEXT.LT.NOUT) THEN
                              NEXT   = NEXT + 1
                              IF (IDENT2(NEXT-1).EQ.
     +                            IDENT2(NEXT)) GO TO 180
                          END IF

                      END IF

                  END IF

  190         CONTINUE
          END IF

      ELSE
          DO 210 I = 1,NIN
              VALUE  = IDENT1(I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.TDNULL) THEN
                  NN1    = 1
  200             CALL TZSCSD(IDENT2,NOUT,VALUE,ZERO,NN1,NEXT)
                  IF (NEXT.GT.0) THEN
                      CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,NEXT,NBO,ISO,
     +                            NB,N)
                      NN1    = NEXT + 1
                      IF (NN1.LE.NOUT) GO TO 200
                  END IF

              END IF

  210     CONTINUE
      END IF

      RETURN

      END

      SUBROUTINE TDCRSS(MASK,IDENT1,IDENT2,NW,NBR,IREF,ISORT,NBYTES,
     +                  INPUT,NBI,ISI,OUTPUT,NBO,ISO,NIN,NOUT)
C      IMPLICIT NONE
C
C COPY BY REFERENCE VALUES
C REFERENCE COLUMN AS CHARACTER STRING
C
      INTEGER NBR,NW,IREF,ISORT,NBYTES,NBI,NBO,ISI,ISO,NIN
      INTEGER NOUT,I,NEXT,I1,N1,NB,N
      REAL MASK(NIN),INPUT(1),OUTPUT(1)
      INTEGER IDENT1(NW,NIN),IDENT2(NW,NOUT),VALUE
C
      INTEGER TINULL
      REAL    TBLSEL, TRNULL
      DOUBLE PRECISION TDTRUE, TDFALS, TDNULL
C
C ... GET MACHINE DEPENDENT VALUES
C
      CALL TBMCON(TBLSEL, TDTRUE, TDFALS)
      CALL TBMNUL(TINULL, TRNULL, TDNULL)
C
      N      = MAX(NIN,NOUT)
      NB     = NBYTES
C
C ... JUMP ACCORDING TO OUTPUT FORMAT
C
      IF (NBYTES+4) 10,50,90
C
C ... DOUBLE PRECISION
C
   10 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 20 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBAC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) THEN
                          N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
                      END IF

                  END IF

   20         CONTINUE

          ELSE
              DO 30 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBDC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) THEN
                          N1     = 2*NEXT - 1
                          I1     = 2*I - 1
                          OUTPUT(N1) = INPUT(I1)
                          N1     = N1 + 1
                          I1     = I1 + 1
                          OUTPUT(N1) = INPUT(I1)
                      END IF

                  END IF

   30         CONTINUE
          END IF

      ELSE
          DO 40 I = 1,NIN
              VALUE  = IDENT1(1,I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                  CALL TZSCSC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,NEXT)
                  IF (NEXT.GT.0) THEN
                      N1     = 2*NEXT - 1
                      I1     = 2*I - 1
                      OUTPUT(N1) = INPUT(I1)
                      N1     = N1 + 1
                      I1     = I1 + 1
                      OUTPUT(N1) = INPUT(I1)
                  END IF

              END IF

   40     CONTINUE
      END IF

      RETURN
C
C ... SINGLE PRECISION
C
   50 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 60 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBAC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) OUTPUT(NEXT) = INPUT(I)
                  END IF

   60         CONTINUE

          ELSE
              DO 70 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBDC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) OUTPUT(NEXT) = INPUT(I)
                  END IF

   70         CONTINUE
          END IF

      ELSE
          DO 80 I = 1,NIN
              VALUE  = IDENT1(1,I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                  CALL TZSCSC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,NEXT)
                  IF (NEXT.GT.0) OUTPUT(NEXT) = INPUT(I)
              END IF

   80     CONTINUE
      END IF

      RETURN
C
C ... CHARACTER STRING
C
   90 CONTINUE
      IF (IREF.EQ.IABS(ISORT)) THEN
          IF (ISORT.GT.0) THEN
              DO 100 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBAC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,
     +                                    NEXT,NBO,ISO,NB,N)
                  END IF

  100         CONTINUE

          ELSE
              DO 110 I = 1,NIN
                  VALUE  = IDENT1(1,I)
                  IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                      CALL TZSBDC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,
     +                            NEXT)
                      IF (NEXT.GT.0) CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,
     +                                    NEXT,NBO,ISO,NB,N)
                  END IF

  110         CONTINUE
          END IF

      ELSE
          DO 120 I = 1,NIN
              VALUE  = IDENT1(1,I)
              IF (MASK(I).EQ.TBLSEL .AND. VALUE.NE.0) THEN
                  CALL TZSCSC(IDENT2,NW,NOUT,IDENT1(1,I),1,NBR,1,NEXT)
                  IF (NEXT.GT.0) CALL TDCPBY(INPUT,I,NBI,ISI,OUTPUT,
     +                                NEXT,NBO,ISO,NB,N)
              END IF

  120     CONTINUE
      END IF

      RETURN

      END

      SUBROUTINE TDCPBY(INPUT,IP,NBI,ISI,OUTPUT,NEXT,NBO,ISO,NB,N)
C
C COPY BYTE STRING
C      IMPLICIT NONE
C
      INTEGER IP,NBI,ISI,NEXT,NBO,ISO,NB,I,N,I1,I2
      INTEGER INPUT(NBI,N),OUTPUT(NBO,N)
C
      DO 10 I = 0,NB - 1
          I1     = I + ISI
          I2     = I + ISO
          OUTPUT(I2,NEXT) = INPUT(I1,IP)
   10 CONTINUE
      RETURN

      END