C @(#)spec2.for	17.1.1.1 (ES0-DMD) 01/25/02 17:14:57
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 SPEC2
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  Program SPEC2                  version 1.00   860806
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 "ripple" image, given the slope, amplitude, period, 
C  phase, and dimensions of the image; and the deviates from the mean
C  of each pixel.
C
C.OUTPUT
C
C  Keys:  OUT_A/C/1/60       output data array
C         INPUTR/R/1/1       slope
C         INPUTI/I/1/1       phase
C         INPUTI/I/2/1       frame dimensions
C         INPUTI/I/3/1       period
C         RIPVALS/I/1/10     ripple values (pixel deviates from mean)
C
C-----------------------------------------------------------
C
C
       IMPLICIT NONE
C
       REAL                     RMIN,RMAX
       REAL                     STEPO(3),STARTO(3),CUTS(4)
       DOUBLE PRECISION         DSTEP(3),DSTART(3)
       INTEGER                  NPIXO(3),PERIOD,IVALS(10),PHASE
       INTEGER                  MADRID,KUN,KNUL
       CHARACTER*1              TYPE
       CHARACTER*60             OUTIMA
       CHARACTER*80             IDENTO
       CHARACTER*80             CUNITO
C
       INTEGER                  IACT,ISTAT,IDIM,IBYT,NDIMO
       INTEGER*8                JPNTR
       INTEGER                  IMNO,KUNIT
       REAL                     SLOPE
C
        INCLUDE                 'MID_INCLUDE:ST_DEF.INC/NOLIST'
        COMMON                  /VMR/MADRID(1)
        INCLUDE                 'MID_INCLUDE:ST_DAT.INC/NOLIST'

C
C
C ... get into MIDAS
C
       CALL STSPRO('SPEC2')
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 STKRDI('INPUTI',  1,1,IACT,PHASE, KUN,KNUL,ISTAT)
        CALL STKRDI('INPUTI',  2,1,IACT,IDIM,  KUN,KNUL,ISTAT)
        CALL STKRDI('INPUTI',  3,1,IACT,PERIOD,KUN,KNUL,ISTAT)
       IF (PERIOD.LE.0) THEN
          CALL STTPUT(' The period must be > 0.',ISTAT)
          CALL STTPUT(' Using period = 10.',ISTAT)
          PERIOD = 10
       ENDIF
       IF (PERIOD.GT.20) THEN
          PERIOD = MOD(PERIOD,20)
          CALL STTPUT(' The period is > 20.',ISTAT)
          CALL STTPUT(' Using period = mod(period,20).',ISTAT)
       ENDIF
C
C ... get deviates of pixels from mean.
C
        CALL STKFND('RIPVALS',TYPE,IACT,IBYT,ISTAT)
       IF (TYPE.EQ.' ') THEN     
C          (KEYWORD NOT PRESENT)
          IVALS(1) = 4
          IVALS(2) = 5
          IVALS(3) = 6
          IVALS(4) = 3
          IVALS(5) = 2
          IVALS(6) = 7
          IVALS(7) = 1
          IVALS(8) = 4
          IVALS(9) = 5
          IVALS(10) = 0
       ELSE
           CALL STKRDI('RIPVALS',1,PERIOD,IACT,IVALS,KUN,KNUL,ISTAT)
       ENDIF
C
C ... map output image
C
       NDIMO = 1
       NPIXO(1)  = IDIM
       STARTO(1) = 1
       STEPO(1)  = 1.0
       CUNITO    = ' NONE'
       IDENTO    = ' ARTIFICIAL RIPPLE 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,PERIOD,PHASE,
     X      IDIM,IVALS,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,PERIOD,PHASE,IDIM,
     X                          IVALS,ISTAT)
C
       IMPLICIT NONE
C
       INTEGER              IDIM,ISTAT,NDIM1,I,IVAL,ILOC
       REAL                 ARR(IDIM)
       INTEGER              IVALS(10),PERIOD,PHASE
C
       REAL                 MEAN,RMIN,RMAX,SLOPE
C
C
C
       NDIM1 = IDIM
       MEAN = 0.0
       DO I = 1, IDIM
          ARR(I) = MEAN
       ENDDO
C
       IVAL = PHASE
       DO I = 1, IDIM
          ILOC = MOD(I+IVAL-1,PERIOD)
          IF (ILOC.EQ.0) ILOC = PERIOD
          ARR(I) = ARR(I) + IVALS(ILOC)
          ARR(I) = ARR(I)+SLOPE*FLOAT(I)                 ! Slope this.  
       ENDDO
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