C @(#)fdummy.for	17.1.1.1 (ES0-DMD) 01/25/02 17:54:07
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
      PROGRAM FDUMMY
C
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.COPYRIGHT        (c) 1988 European Southern Observatory
C.IDENTIFICATION   FDUMMY
C.LANGUAGE         ESO-FOR
C.AUTHOR           Preben Grosbol (ESO-IPG)
C.KEYWORDS         Create image
C.ENVIRONMENT      MIDAS
C.COMMENT          MIDAS command similar to the IHAP FDUMMY command
C.PURPOSE          Create a dummy frame with constant value.
C.VERSION          1.0    1988-Nov-18 : Creation      (PJG)
C---------------------------------------------------------------------
C
      IMPLICIT NONE
      INTEGER	MEM
      PARAMETER  (MEM=10240)
C
      CHARACTER*10      TYPE
      CHARACTER*16      UNIT
      CHARACTER*40      INAME
      CHARACTER*72      IDEN
      INTEGER           IAV,IERR,NA,N,I,ISIZE
      INTEGER           NPIX(16),KUNIT(4),INULL
      INTEGER           IDF,IOFF,NDIM(17)
      REAL              DATA(MEM),CONST
      REAL              PARM(32)
      DOUBLE PRECISION  START(16),STEP(16)
      REAL              CUTS(6),VMADD(1)
C
      COMMON /VMR/VMADD
C
      INCLUDE  'MID_REL_INCL:MIDAS_DEF.INC'
C
C     INITIATE MIDAS
C
      CALL STSPRO('FDUMMY ',IERR)
C
C     READ PARAMETERS
C
      CALL STKRDC('IN_A ',1,1,40,IAV,INAME,KUNIT,INULL,IERR)
      CALL STKRDC('INPUTC ',1,1,10,IAV,TYPE,KUNIT,INULL,IERR)
      CALL STKRDI('INPUTI ',1,17,IAV,NDIM,KUNIT,INULL,IERR)
      CALL STKRDR('PARM ',1,32,IAV,PARM,KUNIT,INULL,IERR)
      CALL STKRDR('INPUTR ',1,1,IAV,CONST,KUNIT,INULL,IERR)
      NA = MAX(1,MIN(16,NDIM(1)))
      ISIZE = 1
      DO 100, N = 1,NA
         NPIX(N) = MAX(1,NDIM(N+1))
         I = 2*(N-1) + 1
         START(N) = PARM(I)
         STEP(N)  = PARM(I+1)
         ISIZE = ISIZE * NPIX(N)
  100 CONTINUE
C
C     CREATE FRAME AND WRITE STANDARD DESCRIPTORS
C
      CALL STFCRE(INAME,D_R4_FORMAT,F_O_MODE,1,ISIZE,IDF,IERR)
C
      IDEN = 'TEST IMAGE'
      UNIT = ' '
      CALL STDWRC(IDF,'IDENT ',1,IDEN,1,72,KUNIT,IERR)
      CALL STDWRI(IDF,'NAXIS ',NA,1,1,KUNIT,IERR)
      CALL STDWRI(IDF,'NPIX ',NPIX,1,NA,KUNIT,IERR)
      CALL STDWRD(IDF,'START ',START,1,NA,KUNIT,IERR)
      CALL STDWRD(IDF,'STEP ',STEP,1,NA,KUNIT,IERR)
      CALL STDWRC(IDF,'CUNIT ',16,UNIT,1,1,KUNIT,IERR)
      DO 200, N = 1,NA
         CALL STDWRC(IDF,'CUNIT ',16,UNIT,N+1,1,KUNIT,IERR)
  200 CONTINUE
C
C     INITIATE VARIABLES AND MEMORY
C
      IOFF = 1
      DO 300, N = 1,6
         CUTS(N) = CONST
  300 CONTINUE
      DO 400, N = 1,MEM
         DATA(N) = CONST
  400 CONTINUE
C
C     GO THROUGH FRAME BUFFER BY BUFFER
C
 1000 N = MIN( MEM, ISIZE-IOFF+1)
      IF (N.LE.0) GOTO 2000
      CALL STFPUT(IDF,IOFF,N,DATA,IERR)
      IOFF = IOFF + N
      GOTO 1000
C
C     FINISHED - EXIT
C
 2000 CONTINUE
      CALL STDWRR(IDF,'LHCUTS ',CUTS,1,6,KUNIT,IERR)
90000 CALL STFCLO(IDF,IERR)
      CALL STSEPI(IERR)
      END