C @(#)inteline.for	19.1 (ES0-DMD) 02/25/03 13:19:45
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.COPYRIGHT: Copyright (c) 1987 European Southern Observatory,
C                                    all rights reserved
C.IDENTIFICATION: INTEGR
C.PURPOSE:        Integrate a line or a portion of a line interactively 
C                 using cursor control, or in batch mode
C.LANGUAGE:       F77+ESOext
C.ALGORITHM:      Uses the AGL plotting package
C.KEYWORDS:       Graphics, bulk data frame, integration, line profile
C.INPUT/OUTPUT:   IN_A/C/1/60   = input frame
C                 INPUTI/I/1/1  = line number (defaulted to 1)
C.AUTHOR:         Ch. Ounnas
C.VERSION:        ?????? Ch. Ounnas    Creation
C.VERSION:        850513 K. Banse      ???
C.VERSION:        870625 RHW rewritten and restructured
C.VERSION:        871203 RHW ESO-FORTRAN Conversion
C.VERSION:        890131 RHW ST interfaces
C.VERSION:        900430 RHW Mapping of frame with STFMAP and STFGET
C.VERSION:        910115 RHW IMPLICIT NONE added
C.VERSION:        9312?? RHW change to new graphics interfaces
C.VERSION:        990316 K. Banse   NPMAX => 300 000
C  -----------------------------------------------------------------
      PROGRAM    INTEGR
      IMPLICIT   NONE
C 
      INTEGER    NPMAX
      PARAMETER  (NPMAX=300000)
      INTEGER    MADRID(1)
      INTEGER    I, IAC,II,III,IMF
      INTEGER    IST,ISTAT,NAXIS,NL,NPL
      INTEGER    NVAL,NPIX(3)
      INTEGER    NPL1, NPL2, NPS
      INTEGER    NCH1,NCH2,NCHA(2),KUN(1),KNUL
      INTEGER*8  WPNTR1,WPNTR2
      INTEGER    WIMNO
      INTEGER    NCUR,NDEG, INDX(2)
      INTEGER    ACCESS
      INTEGER    BNMOD,LTYPE

      REAL       SX,SY,XS,YS
      REAL       X0,XPS(NPMAX)
      REAL       FRAME(8),SCALES(3)
      REAL       OFFSET(2),AREA(4)
      REAL       IMAGE(4)
      REAL       DELTAX
      REAL       XC(12),CURS(12)
      REAL       YOFF
      REAL       PLTEPS
C
      DOUBLE PRECISION START(2),STEP(2)
C
      CHARACTER  MODE*1,INPUT*72,TEXT*80
      CHARACTER  LABEL1*80,LABEL2*80
      CHARACTER  LAB1U*16,LAB2U*16
      CHARACTER  NAME*60,IDENT*72,CUNIT*64
      CHARACTER  BINMOD*4
      CHARACTER  XFRAME*4, YFRAME*4
C
      INTEGER    PLMODE
C
      INCLUDE    'MID_INCLUDE:ST_DEF.INC/NOLIST'
      COMMON     /VMR/MADRID
      INCLUDE    'MID_INCLUDE:ST_DAT.INC/NOLIST'

      DATA       LABEL1(1:10)/'Position ('/
      DATA       LABEL2(1:13)/'Pixel value ('/
      DATA       YOFF/0.0/
      DATA       PLMODE/1/
      DATA       ACCESS/0/
      DATA       SCALES/0.0,0.0,0.0/
      DATA       OFFSET/-999.,-999./
      DATA       PLTEPS/1.0E-20/
      DATA       XFRAME/'MANU'/
      DATA       YFRAME/'MANU'/
C
 9001 FORMAT('Row: ', I6)
 9002 FORMAT('*** WARNING: zero dynamics range in data: value = ',
     2        G13.6)
C
C  *** start of executable code ***************************************
      CALL STSPRO('INTEGR')                    ! contact with the MIDAS monitor
C
C *** find file name and read the data
      CALL STKRDC('IN_A',1,1,60,IAC,NAME,KUN,KNUL,IST)
      CALL STFOPN(NAME,D_R4_FORMAT,0,F_IMA_TYPE,IMF,IST)
      CALL STDRDI(IMF,'NAXIS',1,1,IAC,NAXIS,KUN,KNUL,IST)
      CALL STDRDI(IMF,'NPIX',1,NAXIS,IAC,NPIX,KUN,KNUL,IST)
      CALL STDRDD(IMF,'START',1,NAXIS,IAC,START,KUN,KNUL,IST)
      CALL STDRDD(IMF,'STEP',1,NAXIS,IAC,STEP,KUN,KNUL,IST)
      CALL STDRDC(IMF,'IDENT',1,1,72,IAC,IDENT,KUN,KNUL,IST)
      CALL STDRDC(IMF,'CUNIT',1,1,64,IAC,CUNIT,KUN,KNUL,IST)
C
C *** read the manual setting
      CALL PTKRDR('XAXIS',4,IAC,FRAME)
      CALL PTKRDR('YAXIS',4,IAC,FRAME(5))
C 
C  allocate virtual memory for a single line of the frame
      NVAL = NPIX(1)
      IF (NVAL.EQ.1) THEN
         CALL STTPUT('*** FATAL: Image row contains only one point!',
     2               ISTAT)
      ENDIF
      IF (NVAL.LT.512) NVAL = 512
      CALL STFCRE('PLOTWORK',D_R4_FORMAT,F_X_MODE,F_IMA_TYPE,
     +            NVAL,WIMNO,IST)
      CALL STFMAP(WIMNO,F_X_MODE,1,NVAL,IAC,WPNTR1,IST)
C 
C *** determine the various pameters for the plotting
      NPL = NPIX(1)
      NL  = NPIX(2)
      SX  = STEP(1)
      SY  = STEP(2)
      XS  = START(1)
      YS  = START(2)
C
C *** line number
      IF (NAXIS.GT.1) THEN
         CALL STKRDC('P2',1,1,72,IAC,INPUT,KUN,KNUL,IST)
         II     = INDEX(INPUT,' ')
         CALL GETSIN(INPUT(1:II-1),NL,YS,SY,IMAGE(3))
         IMAGE(4)  = IMAGE(3)
         CALL BOXPTW(IMAGE(3),NL,YS,SY,AREA(3))
C
      ELSE
         IMAGE(3) = 1.
         IMAGE(4) = 1.
      ENDIF
C
C *** first and last pixel
      CALL STKRDC('INPUTC',1,1,72,IAC,INPUT,KUN,KNUL,IST)
      CALL UPCAS(INPUT,INPUT)
      IF (INPUT(1:1).EQ.'M') THEN                                  ! manu input
         CALL BOXWTP(FRAME(1),NPL,XS,SX,IMAGE(1))
         CALL BOXPTW(IMAGE(1),NPL,XS,SX,AREA(1))
C
      ELSE
         II     = INDEX(INPUT,',')
         CALL GETSIN(INPUT(1:II-1),NPL,XS,SX,IMAGE(1))
         III    = INDEX(INPUT,' ')
         CALL GETSIN(INPUT(II+1:III-1),NPL,XS,SX,IMAGE(2))
         CALL BOXPTW(IMAGE(1),NPL,XS,SX,AREA(1))
      ENDIF
C
C *** pixels to be plotted
      CALL PTKWRR('PIXEL',4,IMAGE)
      NPL1   = INT(MIN(IMAGE(1),IMAGE(2))) 
      NPL2   = INT(MAX(IMAGE(1),IMAGE(2))) 
      NPS    = ABS(NPL1-NPL2) + 1 
      WPNTR2 = WPNTR1 + NPL1 - 1
C
C *** set the array indexes
      II = (INT(IMAGE(3))-1)*NPL + 1                         ! offset in frame
      CALL STFGET(IMF,II,NPL,IAC,MADRID(WPNTR1),IST)
C
C *** get the number of cursor and the interpolation
      CALL STKRDI('INPUTI',1,2,IAC,NCHA,KUN,KNUL,IST)
      NCUR   = NCHA(1)
      NDEG   = NCHA(2)
C
C *** batch mode or in forground
      CALL STKRDC('P5',1,1,1,IAC,MODE,KUN,KNUL,IST)
      CALL UPCAS(MODE,MODE)
C
C *** interactive or batch mode
      IF (MODE.EQ.'B') THEN
         CALL STKRDR('CURS',1,12,IAC,CURS,KUN,KNUL,IST)          !get positions
         DO 10 II = 1,NCUR
             XC(II) = CURS(II)
   10    CONTINUE
         DELTAX   = CURS(NCUR+1)
         IMAGE(1) = 1.
         IMAGE(2) = FLOAT(NPL)
         CALL INTFRB(MADRID(WPNTR1),NPL,IMAGE,SX,XS,NCUR,NDEG,
     2                DELTAX,XC)

      ELSE
C
C *** calculate the frame of the x axis
         IF ((ABS(FRAME(1)).LT.PLTEPS) .AND. 
     2       (ABS(FRAME(2)).LT.PLTEPS)) THEN
            XFRAME   = 'AUTO'
            FRAME(1) = AREA(1)
            FRAME(2) = AREA(2)
            FRAME(3) = 0.0
            FRAME(4) = 0.0
         ELSE
            XFRAME   = 'MANU'
         ENDIF
C
C *** set min and max pixel values
         IF ((ABS(FRAME(5)).LT.PLTEPS) .AND. 
     2       (ABS(FRAME(6)).LT.PLTEPS)) THEN
            YFRAME = 'AUTO'
            CALL MNMX(MADRID(WPNTR2),NPS,FRAME(5),INDX)
            IF (FRAME(5).EQ.FRAME(6)) THEN
               WRITE (TEXT,9002) FRAME(5)
               CALL STTPUT(TEXT,ISTAT)
            ENDIF
            FRAME(7) = 0.0
            FRAME(8) = 0.0
         ELSE
            YFRAME   = 'MANU'
         ENDIF
C 
         CALL GETAXS(XFRAME,FRAME)
         CALL GETAXS(YFRAME,FRAME(5))
         CALL PTKWRR('XWNDL',4,FRAME)
         CALL PTKWRR('YWNDL',4,FRAME(5))
C
C *** statistics determined; get the setups
         CALL PTKRDC('BINMOD',4,IAC,BINMOD)
         IF (BINMOD(1:2).EQ.'ON') THEN
             BNMOD = 1
         ELSE
             BNMOD = 0
         ENDIF
C
         CALL PTKRDI('LTYPE',1,IAC,LTYPE) 
         CALL PTOPEN(' ',' ',ACCESS,PLMODE)
C
C *** do the work
         X0 = FLOAT(NPL1-1)*SX + XS
         DO 20 I = 1,NPS
            XPS(I) = X0 + (I-1)*SX
   20    CONTINUE
         CALL PTDATA(0,LTYPE,BNMOD,XPS,MADRID(WPNTR2),YOFF,NPS)
C
C *** draw the axis and the label
         LAB1U = CUNIT(17:32) 
         NCH1 = INDEX(LAB1U,' ')-1
         IF (NCH1 .LT. 0) THEN 
            LABEL1(10:) = ' '
         ELSE
    	    LABEL1(11:) = LAB1U(1:NCH1)//')'
         ENDIF
         LAB2U = CUNIT(33:48)
         NCH2 = INDEX(LAB2U,' ')-1
         IF (NCH2 .LT. 0) THEN
            LABEL2(13:) = ' '
         ELSE
            LABEL2(14:) = LAB2U(1:NCH2)//')' 
         ENDIF
         CALL PTFRAM(FRAME(1),FRAME(5),LABEL1,LABEL2)
C
C *** do the integration
         CALL INTFRI(MADRID(WPNTR1),NPS,IMAGE,SX,XS,NCUR,NDEG)
         CALL PTCLOS()
      END IF
C
C *** finish this bastard and exit
      CALL STSEPI
      END

      SUBROUTINE GETSIN(STRING,NOPIX,START,STEP,PIXEL) 
C+++
C.PURPOSE:  Convert the user coordinate input string into pixel value         
C.AUTHOR:   Klaus Banse, ESO-Garching
C.COMMENTS: If coord outside valid interval PIXEL .LE. 0 will be returned...  
C.VERSION:  87???? RHW small adjustments of the plotting package
C.VERSION:  910115 RHW IMPLICIT NONE added
C---
      IMPLICIT      NONE
      CHARACTER*(*) STRING                  ! IN: coordinate string
      INTEGER       NOPIX                   ! IN: number pixels in frame
      REAL          START                   ! IN: start value of frame
      REAL          STEP                    ! IN: step between pixel
      REAL          PIXEL                   ! OUT: pixel number     
C
      INTEGER       IVAL, ISTAT
      INTEGER       MADRID(1)
      REAL          RVAL
      CHARACTER*1   TEST
      DOUBLE PRECISION DVAL

C
      COMMON        /VMR/MADRID
C
C *** 
      TEST  = STRING(1:1)                  ! check 1. character of input string
      IF (TEST.EQ.'<') THEN                                !  handle "<" format
          PIXEL  = 1
          RETURN
C
      ELSE IF (TEST.EQ.'>') THEN                            ! handle ">" format
         PIXEL  = NOPIX
         RETURN
C
      ELSE IF (TEST.EQ.'@') THEN                            ! handle "@" format
         CALL GENCNV(STRING(2:),1,1,IVAL,RVAL,DVAL,ISTAT)
         IF (ISTAT.GT.0) THEN
C           PIXEL = IVAL-1  
            PIXEL = IVAL
         ENDIF
C
      ELSE                                     ! here we have world coordinates
         CALL GENCNV(STRING,2,1,IVAL,RVAL,DVAL,ISTAT)
         IF (ISTAT.GT.0) THEN
            PIXEL  = NINT((RVAL-START)/STEP) + 1 
         ENDIF
      END IF
C
C  test, if pixel too large...
      IF (PIXEL.GT.NOPIX) THEN 
         PIXEL  = 0
      ELSE IF (PIXEL.LT.1) THEN
         PIXEL  = -1 
      END IF
C       
      RETURN
      END 








