C @(#)plflux.for 17.1.1.1 (ES0-DMD) 01/25/02 17:11:37 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 C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C.IDENTIFICATION: PLFLUX C.PURPOSE: Trace d'une courbe XMES(IPL)=FONC(XECH(IPL)) en coordonees C rectangulaires. C.AUTHOR: C.VERSION: 790319 C.O. creation C.VERSION: 830128 L.L. adjusted to RSX C.VERSION: 880904 RHW rewritten and adjusted for portable MIDAS C.VERSION: 910115 RHW IMPLICIT NONE added C ------------------------------------------------------------------------ SUBROUTINE PLFLUX(NO,XECH,XMES,NPOINT, 2 RADIUS,FOND,XOUT,YOUT,IST) IMPLICIT NONE C INTEGER NO INTEGER NPOINT REAL XECH(NPOINT) REAL XMES(NPOINT) REAL RADIUS REAL FOND REAL XOUT REAL YOUT INTEGER IST C INTEGER L, IPL INTEGER IAC INTEGER MADRID(1) INTEGER LTYPE3,LTYPE1 C REAL DXP REAL FRAME(8) REAL XPOS(2),YPOS(2) REAL YPW, XPW REAL XTEXT, YTEXT CHARACTER*30 IBUFF C INCLUDE 'MID_INCLUDE:PLTDEC.INC/NOLIST' COMMON /VMR/MADRID C DATA LTYPE1/1/ DATA LTYPE3/3/ C 631 FORMAT(' *** Computed radius:',F7.1) C C *** axis plot CALL PTKRDR('XWNDL',4,IAC,FRAME) CALL PTKRDR('YWNDL',4,IAC,FRAME(5)) DXP = FRAME(2)/FLOAT(NPOINT) XPOS(1) = FRAME(1) YPOS(1) = FOND XPOS(2) = FRAME(2) YPOS(2) = FOND LTYPE = LTYPE1 CALL PTDATA(0,LTYPE,0,XPOS,YPOS,0.0,2) C C *** profile plot L = 0 XPOS(1) = XECH(1)*DXP YPOS(1) = XMES(1) DO 20 IPL = 2,NPOINT XPW = XECH(IPL)*DXP YPW = XMES(IPL) IF (XPW.GE.FRAME(1) .AND. XPW.LE.FRAME(2) .AND. 2 YPW.GE.FRAME(5) .AND. YPW.LE.FRAME(6)) THEN XPOS(2) = XPW YPOS(2) = YPW LTYPE = LTYPE1 CALL PTDATA(0,LTYPE,0,XPOS,YPOS,0.0,2) XPOS(1) = XPOS(2) YPOS(1) = YPOS(2) ELSE XPOS(1) = XPW YPOS(1) = YPW END IF 20 CONTINUE C C *** plot of "computed" radius XPOS(1) = RADIUS XPOS(2) = RADIUS YPOS(1) = FOND - 0.1*(FRAME(6)-FRAME(5)) YPOS(2) = FOND + 0.1*(FRAME(6)+FRAME(5)) LTYPE = LTYPE3 CALL PTDATA(0,LTYPE,0,XPOS,YPOS,0.0,2) WRITE(IBUFF,631) RADIUS XTEXT = XPOS(1) YTEXT = YPOS(2) CALL PTTEXT(IBUFF,XTEXT,YTEXT,0.0,1.0,1) C RETURN END