C===========================================================================
C Copyright (C) 1995-2006 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 Massachusetts Ave, Cambridge, 
C MA 02139, USA.
C
C Correspondence 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 ++++++++++++++++++++++++  YVECSUBS.FOR +++++++++++++++++++++++++++++++++++++++
C .LANGUAGE Fortran 77
C .IDENTIFICATION Module YVECSUBS.FOR
C .COMMENTS
C Module contains layer between the keyword related FORTRAN STxxxx interfaces
C and the SC_interfaces written in (hopefully independent) C
C .AUTHOR         K. Banse        ESO - Garching
C .KEYWORDS       standard interfaces.
C .ENVIRONMENT    FORTRAN and C standards
C .VERSION  [1.00] 871207:  created from SXFTOC.C
C 
C 060330	last modif
C ......................................................
C
C   call as OPFC(OPCODE,A,SCALR,C,NDIM,USRNUL,NCNT)
C           OPFF(OPCODE,A,B,C,NDIM,USRNUL,NCNT)
C
C   input par:
C   OPCODE:      char.exp.      operation code in postfix notation, e.g. "FF+"
C   A:           R*4 array      1. input array
C   B:           R*4 array      2. input array
C   SCALR:       R*4            scalar value
C   NDIM:        I*4            size of arrays involved
C   USRNUL:      R*4            user null value
C
C   output par:
C   C:           R*4 array      result array
C   NCNT:        I*4            null count
C
C -------------------------------------------------- 

      SUBROUTINE OPFC(OPCODE,A,RCONST,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   OPCODE
      REAL   A(*), C(*)
      REAL   RCONST, USRNUL
      INTEGER     NDIM, NCOUNT
C 
      CALL STSTR(1,OPCODE)
      CALL YOPFC(A,RCONST,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C
      SUBROUTINE OPFF(OPCODE,A,B,C,NDIM,USRNUL,NCOUNT)
C 
      IMPLICIT NONE
C
      CHARACTER*(*)   OPCODE
      REAL   A(*), C(*), B(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,OPCODE)
      CALL YOPFF(A,B,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C 
C call as FUN1F(CFUNC,A,C,NDIM,USRNUL,NCNT)
C         FUN2FF(CFUNC,A,B,C,NDIM,USRNUL,NCNT)
C         FUN2FC(CFUNC,A,SCALR,C,NDIM,USRNUL,NCNT)
C 
C  input par:
C  CFUNC:     char.exp.      function to do
C  A:         R*4 array      1. input array
C  B:         R*4 array      2. input array
C  NDIM:      I*4            size of arrays involved
C
C  output par:
C  C:         R*4 array      result array
C
C 030514         last modif
C
C -------------------------------------------------- 
C 
      SUBROUTINE FUN1F(CFUNC,A,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      REAL   A(*), C(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YFUN1F(A,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C

      SUBROUTINE FUN2FF(CFUNC,A,B,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      REAL   A(*), C(*), B(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YF2FF(A,B,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C
      SUBROUTINE FUN2FC(CFUNC,A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      REAL   A(*), C(*)
      REAL   SCALR, USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YF2FC(A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C  do it according to opcode ( `, +, -, *, / or =)
C  ` means ** (to the power of)
C  special condition handler is used for division by "zero"
C 
C  call as DOPFC(OPCODE,A,SCALR,C,NDIM,USRNUL,NCNT)
C          DOPFF(OPCODE,A,B,C,NDIM,USRNUL,NCNT)
C
C  input par:
C  OPCODE:      char.exp.      operation code in postfix notation, e.g. "FF+"
C  A:           R*8 array      1. input array
C  B:           R*8 array      2. input array
C  SCALR:       R*8            scalar value
C  NDIM:        I*4            size of arrays involved
C
C  output par:
C  C:           R*8 array      result array
C
C --------------------------------------------------  

      SUBROUTINE DOPFC(OPCODE,A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   OPCODE
      DOUBLE PRECISION   A(*), C(*), SCALR
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,OPCODE)
      CALL YDOPFC(A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C

      SUBROUTINE DOPFF(OPCODE,A,B,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   OPCODE
      DOUBLE PRECISION   A(*), C(*), B(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,OPCODE)
      CALL YDOPFF(A,B,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C 
C ++++++++++++++++++++++++++++++++++++++++++++++++
C 
C  use special condition handler NULLER to trap invalid input to functions
C  all trigonometric functions work with degrees...
C
C  call as DFN1F(CFUNC,A,C,NDIM,USRNUL,NCNT)
C          DFN2FF(CFUNC,A,B,C,NDIM,USRNUL,NCNT)
C          DFN2FC(CFUNC,A,SCALR,C,NDIM,USRNUL,NCNT)
C
C  input par:
C  CFUNC:      char.exp.      input function
C  NDIM:       I*4            size of arrays involved
C  A:          R*8 array      1. input array
C  B:          R*8 array      2. input array
C  SCALR:       R*8            input scalar value
C
C  output par:
C  C:          R*8 array      result array
C
C -------------------------------------------------- 
C
      SUBROUTINE DFN1F(CFUNC,A,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      DOUBLE PRECISION   A(*), C(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YDF1F(A,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C

      SUBROUTINE DFN2FF(CFUNC,A,B,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      DOUBLE PRECISION   A(*), C(*), B(*)
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YDF2FF(A,B,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C
      SUBROUTINE DFN2FC(CFUNC,A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      IMPLICIT NONE
C
      CHARACTER*(*)   CFUNC
      DOUBLE PRECISION   A(*), C(*), SCALR
      REAL   USRNUL
      INTEGER     NDIM, NCOUNT
C
      CALL STSTR(1,CFUNC)
      CALL YDF2FC(A,SCALR,C,NDIM,USRNUL,NCOUNT)
C
      RETURN
      END
C


