C @(#)waves.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 WAVES C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C C Program WAVE 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 background "wave" image, given the amplitude, period, and C dimensions of the image. C C.OUTPUT C C Keys: OUT_A/C/1/60 output data array C INPUTR/R/1/1 amplitude C INPUTR/R/1/1 period C INPUTI/I/2/1 frame dimensions 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),MADRID,KUN,KNUL CHARACTER*60 OUTIMA CHARACTER*72 IDENTO CHARACTER*80 CUNITO C INTEGER IACT,ISTAT,IDIM,NDIMO INTEGER*8 JPNTR INTEGER IMNO,KUNIT REAL AMPL,PERIOD 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('WAVES') C C ... get name of output frame C CALL STKRDC('OUT_A',1,1,60,IACT,OUTIMA,KUN,KNUL,ISTAT) C C ... get amplitude, period, and frame dimensions. C CALL STKRDR('INPUTR',1,1,IACT,AMPL,KUN,KNUL,ISTAT) CALL STKRDR('INPUTR',2,1,IACT,PERIOD,KUN,KNUL,ISTAT) CALL STKRDI('INPUTI',1,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 CUNITO = ' NONE' IDENTO = ' ARTIFICIAL BACKGROUND WAVE IMAGE' DSTEP(1) = STEPO(1) DSTART(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,AMPL,PERIOD,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 C.OUTPUT PARAMETERS C C ARR = the frame, C RMIN, RMAX = cut values (max. and min. flux values). C C---------------------------------------------------------------------- SUBROUTINE PATTERN(ARR,RMIN,RMAX,AMPL,PERIOD,IDIM,ISTAT) C IMPLICIT NONE C C INTEGER IDIM,ISTAT,NDIM1,NDIM2,I,J REAL ARR(IDIM,IDIM) REAL RMIN,RMAX,AMPL,PERIOD,ANGLE,PHASE C C C NDIM1 = IDIM NDIM2 = IDIM PHASE = 0.0 C C (Mean, over one period, is 0 flux units per pixel.) C DO I = 1, NDIM1 DO J = 1, NDIM2 ANGLE = (2*3.1415926/PERIOD)*FLOAT(I) - PHASE ARR(I,J) = AMPL*SIN(ANGLE) ENDDO ENDDO 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