C @(#)coord.for 17.1.1.1 (ES0-DMD) 01/25/02 17:11:36 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 SUBROUTINE BOXWTP(RBOUND,NPIX,START,STEP,IBOUND) C+++ C.PURPOSE: Compute pixel coordinates and check for legal boundaries C.AUTHOR: Rein H. Warmels, ESO-Garching C.COMMENTS: none C.VERSION: 87???? RHW creation C.VERSION: 910115 RHW IMPICIT NONE added C--- IMPLICIT NONE REAL RBOUND(2) ! IN: image pixel in world coordinates INTEGER NPIX ! IN: number of pixels in the x direction REAL START ! IN: start of image in x in world unit REAL STEP ! IN: distance between x pixels in world unit REAL IBOUND(2) ! OUT: image coordinate in pixel coordinates C INTEGER ISTAT,ERR1,ERR2 CHARACTER TEXT*37,TEXT1*43,TEXT2*43 C DATA TEXT/'*** WARNING: One or more coordinates '/ DATA TEXT1/'fall(s) below frame boundaries'/ DATA TEXT2/'fall(s) beyond frame boundaries'/ DATA ERR1/0/ DATA ERR2/0/ C C *** IBOUND(1) = (RBOUND(1)-START)/STEP+1 IBOUND(2) = (RBOUND(2)-START)/STEP+1 C IF (IBOUND(1).LE.0.) THEN IBOUND(1) = 1. ERR1 = 1 END IF IF (IBOUND(1).GT.FLOAT(NPIX)) THEN IBOUND(1) = FLOAT(NPIX) ERR2 = 1 END IF C IF (IBOUND(2).LE.0.) THEN IBOUND(2) = 1. ERR1 = 1 END IF IF (IBOUND(2).GT.FLOAT(NPIX)) THEN IBOUND(2) = FLOAT(NPIX) ERR2 = 1 END IF C IF (ERR1.EQ.1) THEN CALL STTPUT(TEXT//TEXT1,ISTAT) ENDIF IF (ERR2.EQ.1) THEN CALL STTPUT(TEXT//TEXT2,ISTAT) ENDIF C RETURN END SUBROUTINE BOXPTW(IBOUND,NPIX,START,STEP,RBOUND) C+++ C.PURPOSE: Compute world coordinates and check for legal boundaries C.AUTHOR: Rein H. Warmels, ESO-Garching C.COMMENTS: none C.VERSION: 87???? RHW creation C.VERSION: 910115 RHW IMPICIT NONE added C--- IMPLICIT NONE REAL IBOUND(2) ! IN: image coordinate in pixel coordinates INTEGER NPIX ! IN: number of pixels in the x direction REAL START ! IN: start of image in x in world unit REAL STEP ! IN: distance between x pixels in world unit REAL RBOUND(2) ! OUT:image pixel in world coordinates C INTEGER ISTAT,ERR1,ERR2 CHARACTER TEXT*37,TEXT1*43,TEXT2*43 C DATA TEXT/'*** WARNING: One or more coordinates '/ DATA TEXT1/'fall(s) below frame boundaries'/ DATA TEXT2/'fall(s) beyond frame boundaries'/ DATA ERR1/0/ DATA ERR2/0/ C C *** IF (IBOUND(1).EQ.-1.) THEN ! first x coord. too low ERR1 = 1 IBOUND(1) = 1. ENDIF IF (IBOUND(1).EQ.0.) THEN ! first x coord. too high ERR2 = 1 IBOUND(1) = FLOAT(NPIX) ENDIF C IF (IBOUND(2).EQ.-1.) THEN ! second x coord. too low ERR1 = 1 IBOUND(2) = 1. ENDIF IF (IBOUND(2).EQ.0.) THEN ! second x coord. too high ERR2 = 1 IBOUND(2) = FLOAT(NPIX) ENDIF RBOUND(1) = START + (IBOUND(1)-1.)*STEP RBOUND(2) = START + (IBOUND(2)-1.)*STEP C IF (ERR1.EQ.1) THEN CALL STTPUT(TEXT//TEXT1,ISTAT) ENDIF IF (ERR2.EQ.1) THEN CALL STTPUT(TEXT//TEXT2,ISTAT) ENDIF C RETURN END