C @(#)ramp.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 RAMP
C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  Program RAMP               version 1.00       860706
C                             version 2.00       890424 (pMIDAS)
C
C  F. Murtagh                 STECF            
C  M .Peron                   IPG               890901 add include files
C  P. Ballester               IPG               910313 Compil. option -u
C                                                      and more
C.KEYWORDS
C  Simulated images, artificial images, test images.
C
C.PURPOSE
C  Create "ramp" ("background") test image, with user-specified slope
C  (in units/pixel along the gradient), position angle, and image
C  dimension.
C
C.INPUT PARAMETERS
C
C  Keys:  OUT_A/C/1/60        output data array
C         INPUTR/R/1/1       slope
C         INPUTI/I/1/1       position angle
C         INPUTI/I/2/1       dimension of output image
C
C-----------------------------------------------------------
C
C
      IMPLICIT NONE
C
      REAL                  RMIN,RMAX
      REAL                  STEPO(3),STARTO(3),CUTS(4)
      DOUBLE PRECISION      DSTART(3),DSTEP(3)
      INTEGER               NPIXO(3),MADRID,KUN,KNUL
      CHARACTER*60            OUTIMA
      CHARACTER*72            IDENTO
      CHARACTER*80            CUNITO
C
      INTEGER               IACT,ISTAT,IANGLE,IDIM,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('RAMP')
C
C ... get name of output frame
C
        CALL STKRDC('OUT_A',1,1,60,IACT,OUTIMA,KUN,KNUL,ISTAT)
C
C ... get slope, position angle (<= 90 degrees), and dimensions.
C
        CALL STKRDR('INPUTR',1,1,IACT,SLOPE,KUN,KNUL,ISTAT)
        CALL STKRDI('INPUTI',1,1,IACT,IANGLE,KUN,KNUL,ISTAT)
        CALL STKRDI('INPUTI',2,1,IACT,IDIM,KUN,KNUL,ISTAT)
C
C ... map output image
C
      NDIMO = 2
      NPIXO(1)  = IDIM
      NPIXO(2)  = IDIM
      STARTO(1) = 1
      STARTO(2) = 1
      STEPO(1)  = 1.0
      STEPO(2)  = 1.0 
      IDENTO    = ' ARTIFICIAL RAMP BACKGROUND IMAGE'
      CUNITO    = ' NONE'
        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 PATTERN(MADRID(JPNTR),RMIN,RMAX,IANGLE,SLOPE,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 STFCLO(IMNO,ISTAT)
      CALL STSEPI
      END

C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C.IDENTIFICATION
C
C  Program PATTERN    
C  F. MURTAGH                                 ST-ECF  Version 1.0 860411
C
C.KEYWORDS
C
C  Test patterns, simulated images.
C
C.OUTPUT PARAMETERS
C 
C  ARR  = the frame,
C  RMIN, RMAX = cut values (max. and min. flux values).
C
C.INPUT PARAMETERS
C
C  IANGLE = position angle (0, 90 or some integer value in between),
C  SLOPE = ramp slope (units/pixel along gradient) - default = 1.0,
C  IDIM   = image dimensions (default = 128),
C  ISTAT  
C
C----------------------------------------------------------------------
      SUBROUTINE PATTERN(ARR,RMIN,RMAX,IANGLE,SLOPE,IDIM,ISTAT)
C
      IMPLICIT NONE
C
C
      INTEGER              IANGLE,IDIM,ISTAT,NDIM1,NDIM2,I,J
      REAL                 ARR(IDIM,IDIM)
      REAL                 RMIN,RMAX,SLOPE,TOT,ANGLE,C,R,RTOT
C
C
C
      NDIM1 = IDIM
      NDIM2 = IDIM
      TOT   = 0.0
C
      IF (IANGLE.EQ.90) THEN
         DO I = 1, NDIM1
            DO J = 1, NDIM2
               ARR(I,J) = SLOPE*(FLOAT(J))
             TOT = TOT + ARR(I,J)
            ENDDO
         ENDDO
      ELSE IF (IANGLE.EQ.0) THEN
         DO J = 1, NDIM1
            DO I = 1, NDIM2
               ARR(I,J) = SLOPE*(FLOAT(I))
             TOT = TOT + ARR(I,J)
            ENDDO
         ENDDO
      ELSE
         ANGLE = IANGLE
         DO I = 1, NDIM1
            C = (TAN(90.0-ANGLE)+TAN(ANGLE))*FLOAT(I)
            DO J = 1, NDIM2
             R = FLOAT(J)/SIN(ANGLE)
             RTOT = R + C*SIN(90.0-ANGLE)
             ARR(I,J) = SLOPE*RTOT
             TOT = TOT + ARR(I,J)
            ENDDO
         ENDDO
      ENDIF          
C
C  Normalize to mean flux per pixel of 100 units
C
      TOT = TOT/FLOAT(NDIM1*NDIM2)
      DO I = 1, NDIM1
         DO J = 1, NDIM2
            ARR(I,J) = 100.0+ARR(I,J)-TOT
         ENDDO
      ENDDO
C
C
C ------DETERMINE CUTS (I.E. MAX AND MIN VALUES)---------------------
C
      RMIN = 1000000.
      RMAX = -100000.
      DO I = 1, NDIM1
         DO J = 1, NDIM2
            IF (ARR(I,J).LT.RMIN) RMIN = ARR(I,J)
            IF (ARR(I,J).GT.RMAX) RMAX = ARR(I,J)
         ENDDO
      ENDDO
C
C
      RETURN
C
      END