C @(#)dto.for	17.1.1.1 (ES0-DMD) 01/25/02 17:39:34
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+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C.IDENTIFICATION:
C  subroutine DTO               version 1.00   840614
C  R.M. van Hees                ESO - Garching
C
C.KEYWORDS:
C  High level image display interfaces
C
C.PURPOSE:
C  Takes care of opening and closing of display devices
C
C.ALGORITHM:
C  updates display keywords and display common blocks
C  calls high level C display interfaces 
C
C.COMMENTS
C  holds DTOPEN, DTCLOS, DTGICH and DTPICH
C
C.VERSIONS
C  1.00       Taken from DAZSUBS.FOR, author K.Banse
C--------------------------------------------------------------------------
C
C
C ++++++++++++++++++++++++++++++
C.IDENTIFIER  DTOPEN
C.PURPOSE
C  connect to IDI device + save info display common blocks IDIDEV & IDIMEM
C
C.INPUT/OUTPUT
C  call as   DTOPEN(FLAG,STAT)
C
C  input par:
C     FLAG:        integer	1 for display window
C                               2 for graphics window
C                               3 for zoom window (display)
C  output par:
C  STAT: 	integer		return status: 
C				0   if o.k. - no change in window size
C                               1   if o.k. - yes, a change in window size
C                              -1   if error
C ------------------------------
C
      SUBROUTINE DTOPEN(FLAG,STAT)
C
      IMPLICIT NONE
C
      INTEGER FLAG,STAT
      INTEGER IAV
      INTEGER UNIT(1),NULLO
C
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
C 
      CALL DAZOPN(FLAG)
C 
      CALL STKRDI('IDIDEV',1,26,IAV,DZDEV,UNIT,NULLO,STAT)
      CALL STKRDI('IDIMEMI',1,17,IAV,DZMEMI,UNIT,NULLO,STAT)
      RETURN
C 
      END

C
C ++++++++++++++++++++++++++++++
C.IDENTIFIER  DTCLOS
C.PURPOSE
C  close display & save display common blocks
C
C.INPUT/OUTPUT
C  call as   DTCLOS(DISPNO)
C
C  input par:
C  DISPNO:      integer         display number
C
C ------------------------------
C
      SUBROUTINE DTCLOS(DISPNO)
C 
      IMPLICIT NONE
C
      INTEGER DISPNO,STAT
      INTEGER UNIT(1)
C
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
C 
      CALL DAZCLO(DISPNO)
C
      CALL STKWRI('IDIDEV',DZDEV,1,26,UNIT,STAT)
      RETURN
C 
      END

C
C ++++++++++++++++++++++++++++++
C.IDENTIFIER  DTGICH
C.PURPOSE
C  return info about given channel in the image display
C
C.INPUT/OUTPUT
C  call as   DTGICH(DSPLAY,CHANL,NAME,RBUF,STAT)
C
C  input par:
C  DSPLAY: 	integer		image display device no.
C  CHANL: 	integer		image display channel no. (0,1,...)
C 
C  output par:
C  NAME: 	char. string 	name of frame currently loaded into channel
C  RBUF: 	real array	real info related to channel, 
C                               (8 elements long)
C  STAT: 	integer		return status: 
C				0 = o.k.
C				1 = nothing loaded into channel
C
C ------------------------------
C
      SUBROUTINE DTGICH(DSPLAY,CHANL,NAME,RBUF,STAT)
C
      IMPLICIT NONE
C
      INTEGER IAV,DSPLAY,CHANL,STAT
      INTEGER RLEN,ILEN,CLEN
      INTEGER UNIT(1),NULLO
C
      CHARACTER*(*) NAME
      CHARACTER WORK*60
C 
      REAL  RBUF(*)
C
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
C 
      DATA  RLEN /8/                        !float length per channel
      DATA  CLEN /60/                       !char. length per channel
      DATA  ILEN /17/                       !integer length per channel
C
      CALL DAZGII(CHANL)
C 
C  move from keywords to COMMON + Parameter arrays
C 
      CALL STKRDC('IDIMEMC',1,1,CLEN,IAV,WORK,UNIT,NULLO,STAT)
      CALL STKRDI('IDIMEMI',1,ILEN,IAV,DZMEMI,UNIT,NULLO,STAT)
      CALL STKRDR('IDIMEMR',1,RLEN,IAV,RBUF,UNIT,NULLO,STAT)
C 
      NAME(1:) = WORK(1:CLEN)//' '
      IF (NAME(1:1).EQ.' ') THEN
         STAT = 1                          !indicate, that there is no image
      ELSE
         STAT = 0
      ENDIF
C 
      RETURN
      END

C
C ++++++++++++++++++++++++++++++
C.IDENTIFIER  DTPICH
C.PURPOSE
C  store info about given channel in the relevant keywords
C
C.INPUT/OUTPUT
C  call as   DTPICH(DSPLAY,CHANL,NAME,RBUF,STAT)
C
C  input par:
C  DSPLAY: 	integer		image display device no.
C  CHANL: 	integer		image display channel no. (0,1,...)
C  NAME: 	char. string 	name of frame currently loaded into channel
C  RBUF: 	real array	real info related to channel, 
C                               (8 elements long)
C
C  output par:
C  STAT: 	integer		return status: 0 = o.k., 
C                                              else something wrong...
C
C ------------------------------
C
      SUBROUTINE DTPICH(DSPLAY,CHANL,NAME,RBUF,STAT)
C
      IMPLICIT NONE
C
      INTEGER DSPLAY,CHANL,STAT
      INTEGER RLEN,ILEN,CLEN
      INTEGER UNIT(1)
C
      CHARACTER*(*) NAME
      CHARACTER WORK*60
C
      REAL  RBUF(*)
C
      INCLUDE  'MID_INCLUDE:IDIDEV.INC'
      INCLUDE  'MID_INCLUDE:IDIMEM.INC'
C
      DATA  RLEN /8/                        !float length per channel
      DATA  CLEN /60/                       !char. length per channel
      DATA  ILEN /17/                       !integer length per channel
C
C  store name of loaded frame 
      WORK(1:) = NAME(1:)//' '
      CALL STKWRC('IDIMEMC',1,WORK,1,CLEN,UNIT,STAT) 
      CALL STKWRI('IDIMEMI',DZMEMI,1,ILEN,UNIT,STAT)
      CALL STKWRR('IDIMEMR',RBUF,1,RLEN,UNIT,STAT)
C
      CALL DAZPII(CHANL)
C 
      STAT   = 0
      RETURN
      END