C @(#)gd8l.for 17.1.1.1 (ES0-DMD) 01/25/02 17:34:39 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 GD8025(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IILWLT version 1.00 880120 C IILRLT 1.00 880120 C K. Banse ESO - Garching C C.KEYWORDS C DeAnza display , LUT C C.PURPOSE C to load an LUT into the DeAnza, C to read an LUT from DeAnza, C according to the IDI document C C.ALGORITHM C use DeAnza level 0 software C C.INPUT/OUTPUT C call as IILWLT(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST) C IILRLT(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST) C C input par: C DISPLAY: I*4 DISPLAY no. C NLUT: I*4 LUT section no. (0 - 3) C if = 4, it's for the overlay !! C ISTA: I*4 start within LUT table in DeAnza C COUNT: I*4 no. of entries in table to send/read C C input/output par: C RLUT: R*4 array LUT table with R,G,B entries C IDST: I*4 return status C C----------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,NLUT,ISTA,COUNT,IDST INTEGER*4 N,NN,ISW C REAL*4 RLUT(3,COUNT) C INTEGER*2 UNIT,LUT(1024,2),RESREG INTEGER*2 RR,LR,LPA,LVR C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' C EXTERNAL RR,LR,LPA,LVR C UNIT = DISPLAY C C check, if we want to load an overlay table IF (NLUT.EQ.4) THEN CALL KKOWLT(UNIT,ISTA,COUNT,RLUT,IDST) RETURN ENDIF C C set resolution register for low byte transfer CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) RESREG = IAND(SYSREG(12),"177677) RESREG = IOR(RESREG,"100) CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11) C C set LUT address in the DeAnza N = IAND("377,ISTA) !cut out low byte VOCREG(4) = IOR(N,ISHFT(NLUT,8)) C C main loop: C convert R, G, B real table to I*2 and send it to the DeAnza C ISW = 1 DO NN=1,3 C DO N=1,COUNT LUT(N,ISW) = NINT(RLUT(NN,N)*255.) ENDDO C CALL IP8W(UNIT) !wait till ready ... CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3) CALL IP8Q(LPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,NN-1,1) ISW = 3 - ISW !switch buffer ENDDO C CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) IDST = 0 RETURN END SUBROUTINE GD8026(DISPLAY,NLUT,ISTA,COUNT,RLUT,IDST) C IMPLICIT NONE C INTEGER*4 DISPLAY,NLUT,ISTA,COUNT,IDST INTEGER*4 N,ISW,JSW C REAL*4 RLUT(3,COUNT) REAL*4 F C INTEGER*2 UNIT,LUT(1024,2),RESREG INTEGER*2 RR,LR,RPA,LVR C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' C EXTERNAL RR,LR,RPA,LVR C UNIT = DISPLAY C C set resolution register for low byte transfer CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) RESREG = IAND(SYSREG(12),"177677) RESREG = IOR(RESREG,"100) CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11) C C set LUT address in the DeAnza N = IAND("377,ISTA) !cut out low byte VOCREG(4) = IOR(N,ISHFT(NLUT,8)) C C main loop: C get LUT from the DeAnza and convert I*2 table to R, G, B real table C ISW = 1 JSW = 3 - ISW !switch buffer F = 1./255. C C read red table with wait + greeen table without wait CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3) CALL IP8QW(RPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,0,1) CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3) CALL IP8Q(RPA,UNIT,DZIOSB,,,LUT(1,JSW),COUNT*2,1,1) C C make sure high byte is 0 and convert red table to real DO N=1,COUNT RLUT(1,N) = F * FLOAT(IAND(LUT(N,ISW),"377)) ENDDO C C fire up reading of blue as soon as green table is in CALL IP8W(UNIT) !wait till ready ... CALL IP8QW(LVR,UNIT,DZIOSB,,,VOCREG(4),2,0,3) CALL IP8Q(RPA,UNIT,DZIOSB,,,LUT(1,ISW),COUNT*2,2,1) C C convert green table DO N=1,COUNT RLUT(2,N) = F * FLOAT(IAND(LUT(N,JSW),"377)) ENDDO C C wait + convert blue table CALL IP8W(UNIT) DO N=1,COUNT RLUT(3,N) = F * FLOAT(IAND(LUT(N,ISW),"377)) ENDDO C CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) IDST = 0 RETURN END SUBROUTINE GD8023(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IILWIT version 1.00 880120 C IILRIT 1.00 880120 C K. Banse ESO - Garching C C.KEYWORDS C DeAnza display , ITT C C.PURPOSE C to load an ITT into the DeAnza, C to read an ITT from DeAnza C according to the IDI document C C.ALGORITHM C use DeAnza level 0 software C C.INPUT/OUTPUT C call as IILWIT(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST) C IILRIT(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST) C C input par: C DISPLAY: I*4 display no. C CHAN: I*4 memory board no. C NITT: I*4 ITT section no. (0 - 3) C ISTA: I*4 start in ITT table inside DeAnza C COUNT: I*4 no. of bytes to send/read C C input/output par: C RITT: R*4 array ITT table C IDST: I*4 return stat C C----------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,CHAN,NITT,ISTA,COUNT,IDST INTEGER*4 N C REAL*4 RITT(1) C INTEGER*2 UNIT,ITT(256),ILADR,RESREG INTEGER*2 RR,LR,LMC,LPA C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' C EXTERNAL RR,LR,LMC,LPA C UNIT = DISPLAY C C set resolution register for low byte transfer CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) RESREG = IAND(SYSREG(12),"177677) RESREG = IOR(RESREG,"100) CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11) C C convert real table to I*2 DO N=1,COUNT ITT(N) = NINT(RITT(N)*255.) ENDDO C C build ITT address N = IAND("377,ISTA) !cut out start (usually = 0 anyway) N = IOR("10000,ISTA) !add ITT enable bit (bit 12) ILADR = IOR(N,ISHFT(NITT,8)) !integrate also ITT section N = CHAN + 1 MEMREG(4,N) = IAND(MEMREG(4,N),"176377) !clear L9,L8 bit (9,8) MEMREG(4,N) = IOR(MEMREG(4,N),ILADR) C C send the table to the DeAnza CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(4,N),2,CHAN,3) !set LUT address reg. CALL IP8QW(LPA,UNIT,DZIOSB,,,ITT,COUNT*2,CHAN,0) C CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) IDST = 0 RETURN END SUBROUTINE GD8024(DISPLAY,CHAN,NITT,ISTA,COUNT,RITT,IDST) C IMPLICIT NONE C INTEGER*4 DISPLAY,CHAN,NITT,ISTA,COUNT,IDST INTEGER*4 N C INTEGER*2 UNIT,ITT(256),ILADR,RESREG INTEGER*2 RR,LR,LMC,RPA C REAL*4 RITT(1) REAL*4 F C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' C EXTERNAL RR,LR,LMC,RPA C C set resolution register for low byte transfer CALL IP8QW(RR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) RESREG = IAND(SYSREG(12),"177677) RESREG = IOR(RESREG,"100) CALL IP8QW(LR,UNIT,DZIOSB,,,RESREG,2,0,11) C C build ITT address N = IAND("377,ISTA) !cut out start (usually = 0 anyway) N = IOR("10000,ISTA) !add ITT enable bit (bit 12) ILADR = IOR(N,ISHFT(NITT,8)) !integrate also ITT section N = CHAN + 1 MEMREG(4,N) = IAND(MEMREG(4,N),"176377) !clear L9,L8 bit (9,8) MEMREG(4,N) = IOR(MEMREG(4,N),ILADR) C C read the table from the DeAnza CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(4,N),2,CHAN,3) !set LUT address reg. CALL IP8QW(RPA,UNIT,DZIOSB,,,ITT,COUNT*2,CHAN,0) C C make sure high byte is 0 and convert to real F = 1./255. DO N=1,COUNT RITT(N) = F * FLOAT(IAND(ITT(N),"377)) ENDDO C CALL IP8QW(LR,UNIT,DZIOSB,,,SYSREG(12),2,0,11) IDST = 0 RETURN END SUBROUTINE GD8049(DISPLAY,CHAN,VISI,IDST) C C++++++++++++++++++++++++++++++++++++++++++++++++++ C C.IDENTIFICATION C subroutine IILSBV version 1.00 880125 C K. Banse ESO - Garching C C.KEYWORDS C DeAnza, LUT C C.PURPOSE C fulfill the requirements as described in the IDI document C C.ALGORITHM C use DeAnza level 0 software C C.INPUT/OUTPUT C call as IILSBV(DISPLAY,CHAN,VISI,IDST) C C input par: C DISPLAY: I*4 display id. C CHAN: I*4 memory id C VISI: I*4 LUT bar visibility, 0 = off, > 0 = on C C output par: C IDST: I*4 return status C C-------------------------------------------------- C IMPLICIT NONE C INTEGER*4 DISPLAY,CHAN,VISI,IDST INTEGER*4 N,STAT C INTEGER*2 UNIT,CLREF,SETREF INTEGER*2 LMC C INCLUDE 'MID_INCLUDE:DEANZAH.INC' INCLUDE 'MID_INCLUDE:DEANZAS.INC' C DATA CLREF /"167777/, SETREF /"010000/ C EXTERNAL LMC C N = CHAN + 1 UNIT = DISPLAY C C clear + set RF bit (12) of memory register 0 of channel CHAN C depending upon VISI C MEMREG(1,N) = IAND(MEMREG(1,N),CLREF) IF (VISI.GT.0) + MEMREG(1,N) = IOR(MEMREG(1,N),SETREF) C CALL IP8QW(LMC,UNIT,DZIOSB,,,MEMREG(1,N),2,CHAN,0) C IDST = 0 RETURN END