C @(#)radcnv.for 17.1.1.1 (ES0-DMD) 01/25/02 17:19:21 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 RADCNV C C +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.COPYRIGHT: Copyright (c) 1987 European Southern Observatory, C all rights reserved C.IDENTIFICATION: RADCNV C.PURPOSE: compute the size of an aperture in screen coordinates C.AUTHOR: Ch. Ounnas ESO - Garching C.LANGUAGE: F77+ESO ext C.KEYWORDS: DEANZA display C.ALGORITHM: use the keywords DEANZA,DAZMEMI nad the routine PIXCNV C.INPUT/OUTPUT: the procedure file should contain: C INPUTR/R/1/1 radius of the aperture C AP/I/1/4 local keyword to store screen pixels C.VERSION: 2.6 upgrade to mod. DeAnza stuff (1K memory, 512 display...) C.VERSION: 871216 RHW ESO-FORTRAN Conversion C.VERSION: 900319 put into real ST interfaces and close image display C correctly KB C ------------------------------------------------------------------- C IMPLICIT NONE C INTEGER MADRID INTEGER XY(4),KUNI(1),KNUL,IMNO INTEGER STAT,IAV,IMA C CHARACTER FRAME*60 C REAL RINF(6),PIXEL1(6),PIXEL2(6),RS REAL RAYON C DOUBLE PRECISION START(2) C INCLUDE 'MID_INCLUDE:ST_DEF.INC' C COMMON /VMR/MADRID(1) C INCLUDE 'MID_INCLUDE:IDIMEM.INC/NOLIST' INCLUDE 'MID_INCLUDE:IDIDEV.INC/NOLIST' C INCLUDE 'MID_INCLUDE:ST_DAT.INC' C C *** C CALL STSPRO('RADCNV') !get into MIDAS environment CALL DTOPEN(1,STAT) !open image display C C *** get the radius of the aperture in user unit CALL STKRDR('INPUTR',1,1,IAV,RAYON,KUNI,KNUL,STAT) C CALL DTGICH(QDSPNO,QIMCH,FRAME,RINF,STAT) IF (SOURCE.NE.1) THEN !no image loaded... CALL STETER(1,'RADCNV: No image loaded - we abort... ') ELSE IMA = 1 IF (RAYON.EQ.-1.) GO TO 20 END IF C C *** get necessary descriptors of frame CALL STFOPN(FRAME,D_OLD_FORMAT,0,F_IMA_TYPE,IMNO,STAT) CALL STDRDD(IMNO,'START',1,2,IAV,START,KUNI,KNUL,STAT) CALL PIXXCV('INIT',IMNO,RINF,STAT) C C *** now convert world coordinates to screen pixels PIXEL1(1) = START(1) PIXEL1(2) = START(2) CALL PIXXCV('WRS',0,PIXEL1,STAT) IF (START(2).GT.0.) THEN PIXEL2(1) = PIXEL1(1) + RAYON ELSE PIXEL2(1) = PIXEL1(1) - RAYON END IF PIXEL2(2) = START(2) CALL PIXXCV('WRS',0,PIXEL2,STAT) RS = ABS(PIXEL2(5)-PIXEL1(5)) XY(1) = 200 XY(2) = 200 XY(3) = 200 + IFIX(2.*RS) + 1 XY(4) = 200 + IFIX(2.*RS) + 1 CALL STKWRI('AP',XY,1,4,KUNI,STAT) C 20 CALL STKWRI('IMA',IMA,1,1,KUNI,STAT) C CALL DAZCLO(QDSPNO) CALL STSEPI END