C @(#)spec1.for	17.1.1.1 (ES0-DMD) 01/25/02 17:14:56
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 SPEC1
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  Program SPEC1                  version 1.00   860706
C                                 version 2.00   890424 (pMIDAS)
C  F. Murtagh                            STECF              
C  M. Peron                              IPG     890901  add include files
C  P. Ballester                          IPG     910313  Compil. option -u
C                                                        and more
C
C.KEYWORDS
C  Simulated images, test images.
C
C.PURPOSE
C  Create sloping "wave" image, given the slope, amplitude, period, 
C  phase, and dimensions of the image.
C
C.OUTPUT
C
C  Keys:  OUT_A/C/1/60       output data array
C         INPUTR/R/1/1       slope
C         INPUTR/R/2/1       amplitude
C         INPUTR/R/3/1       period
C         INPUTR/R/4/1       phase
C         INPUTI/I/1/1       frame dimensions
C
C-------------------------------------------------------------------------
C
C
       IMPLICIT NONE
C
       CHARACTER*60              OUTIMA
       CHARACTER*72              IDENTO
       CHARACTER*80              CUNIT0
       REAL                      RMIN,RMAX
       REAL                      STEPO(3),STARTO(3),CUTS(4)
       DOUBLE PRECISION          DSTEP(3),DSTART(3)
       INTEGER                   NPIXO(3), KUN, KNUL, IACT
       INTEGER                   MADRID
C
       INTEGER                   ISTAT,IDIM,NDIMO
       INTEGER*8                 JPNTR
       INTEGER                   IMNO,KUNIT
       REAL                      SLOPE,AMPL,PERIOD,PHASE,CUNITO        
C
       INCLUDE                   'MID_INCLUDE:ST_DEF.INC'
       COMMON/VMR/MADRID(1)
       INCLUDE                   'MID_INCLUDE:ST_DAT.INC'
C
C
C ... get into MIDAS
C
       CALL STSPRO('SPEC1')
C
C ... get name of output frame
C
        CALL STKRDC('OUT_A',1,1,60,IACT,OUTIMA,KUN,KNUL,ISTAT)
C
C ... get slope, amplitude, period, phase and frame dimensions.
C
        CALL STKRDR('INPUTR',1,1,IACT,SLOPE,KUN,KNUL,ISTAT)
        CALL STKRDR('INPUTR',2,1,IACT,AMPL,KUN,KNUL,ISTAT)
        CALL STKRDR('INPUTR',3,1,IACT,PERIOD,KUN,KNUL,ISTAT)
        CALL STKRDR('INPUTR',4,1,IACT,PHASE,KUN,KNUL,ISTAT)
        CALL STKRDI('INPUTI',1,1,IACT,IDIM,KUN,KNUL,ISTAT)
C
C ... map output image
C
       NDIMO = 1
       NPIXO(1)  = IDIM
       STARTO(1) = 1
       STEPO(1)  = 1.0
       CUNIT0    = ' NONE'
       IDENTO    = ' ARTIFICIAL SINUSOIDAL 1-D IMAGE' 
       DSTART(1) = STARTO(1)
       DSTEP(1)  = STEPO(1)
       CALL STIPUT(OUTIMA,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,NDIMO,
     .                  NPIXO,DSTART,DSTEP,
     .                  IDENTO,CUNITO,JPNTR,IMNO,ISTAT)
C
C ... now do the work
C
       CALL PATTRN(MADRID(JPNTR),RMIN,RMAX,SLOPE,AMPL,PERIOD,PHASE,
     X      IDIM,ISTAT)
C
C ... write cuts
C
       CUTS(1) = RMIN
       CUTS(2) = RMAX
       CUTS(3) = RMIN
       CUTS(4) = RMAX
        CALL STDWRR(IMNO,'LHCUTS',CUTS,1,4,KUNIT,ISTAT)
C
C ... end
C
       CALL STSEPI
       END

C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  Program PATTRN    
C  F. MURTAGH                                 ST-ECF  Version 1.0 860411
C
C.KEYWORDS
C
C  Test patterns, simulated images.
C
C
C.OUTPUT PARAMETERS
C 
C  ARR  = the frame,
C  RMIN, RMAX = cut values (max. and min. flux values).
C
C----------------------------------------------------------------------
       SUBROUTINE PATTRN(ARR,RMIN,RMAX,SLOPE,AMPL,PERIOD,PHASE,IDIM,
     X                          ISTAT)
       IMPLICIT NONE
       INTEGER           IDIM,ISTAT,NDIM1,I
       REAL              RMIN,RMAX,SLOPE,AMPL,PERIOD,PHASE,VALMIN
       REAL              ANGLE,TOT
       REAL              ARR(IDIM)
C
C
C
       NDIM1 = IDIM
C
       VALMIN = 1000000.0
       DO I = 1, NDIM1
          ANGLE = (2*3.1415926/PERIOD)*FLOAT(I) - PHASE  ! Angle at I
          ARR(I) = AMPL*SIN(ANGLE)                       ! => y-value.
          ARR(I) = ARR(I)+SLOPE*FLOAT(I)                 ! Slope this.  
          IF (ARR(I).LT.VALMIN) VALMIN = ARR(I)
       ENDDO
C
C  Normalize to average of 100.0 flux units per pixel.
C
       TOT = 0.0
       DO I = 1, NDIM1
          ARR(I) = ARR(I) + VALMIN
          TOT = TOT + ARR(I)
       ENDDO
       TOT = TOT/FLOAT(NDIM1)
       DO I = 1, NDIM1
          ARR(I) = ARR(I)*(100.0/TOT)
       ENDDO
C
C
C ------DETERMINE CUTS (I.E. MAX AND MIN VALUES)---------------------
C
       RMIN = 1000000.
       RMAX = -100000.
       DO I = 1, NDIM1
          IF (ARR(I).LT.RMIN) RMIN = ARR(I)
          IF (ARR(I).GT.RMAX) RMAX = ARR(I)
       ENDDO
C
C
       RETURN
C
       END