* Last processed by NICE on 12-Jun-2000 15:54:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
*
*
      SUBROUTINE SUPPORT (LINE,ERROR)
*----------------------------------------------------------------------
*       Support routine for command
*
*       SUPPORT [dx+ [dy+ [dx- [dy-]]]] /CURSOR  /FILE [new] /INPUT /CHANNEL
*               /DELETE
* Arguments :
*
*       LINE    C*(*)   Command line                    Input
*       ERROR   L       Logical error flag              Output
*
*----------------------------------------------------------------------
*
      INCLUDE 'inc:xpar.inc'
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
      INTEGER  MAX_SEG
      PARAMETER (MAX_SEG = 100)
      CHARACTER*(*) LINE
      LOGICAL   ERROR
*
*
* real*8
      REAL*8  U(MAX_SEG,2),V(2*MAX_SEG,2)
      REAL*8  XU(MAX_SEG), YU(MAX_SEG), XS(2), YS(2)
      REAL*8  XCOO, YCOO
      REAL*8  BEAMSEP
      INTEGER*4 IPMAP,POINTER,IP
*
      REAL*8    EPOCH_FROM_INPUT,EPOCH_FROM_SCAN,EPOCHTO
      REAL*8    RA_FROM_SCAN,DEC_FROM_SCAN,RA_DAY_SCAN,DEC_DAY_SCAN
      REAL*8    RA_DAY_INPUT,DEC_DAY_INPUT,AMAT(9),AVEC(3),BVEC(3)
      REAL*8    LATI
      INTEGER*4  CHAN,CHAN_REF, NC, NX, NY, DIM(4), I,LENC
      REAL*4    LIM_INFX,LIM_SUPX, LIM_INFY,LIM_SUPY
      REAL*4  CORNER_XLOW, CORNER_XUP, CORNER_YLOW, CORNER_YUP
*
      LOGICAL   FILE_OPT,CURSOR_OPT,INPUT_OPT,FILE_READ,CHANNEL_OPT
      LOGICAL   SIC_PRESENT,GTG_CURS
      CHARACTER RGDATA*80, RGPLOT*40
      CHARACTER TYPE*12, NAME*80, LIMIT_STRING*40, OPTION*12
      CHARACTER SUPPORTNAME*80,SUPPORTFILE*80,STRING*200
      CHARACTER CODE(MAX_SEG)*1,CODEMOUSE*1
      CHARACTER SIC_STRING*50
      REAL      X4COO,Y4COO
      REAL*4    X4(MAX_SEG), Y4(MAX_SEG)
      INTEGER   IER, SIC_GETVM
      INTEGER   PNT,NV,ICHAN
      LOGICAL   EXIST_MAP,OPEN_A_MAP
*
      EQUIVALENCE (U(1,1),XU(1))         ! interface of routine transform_coordi
      EQUIVALENCE (U(1,2),YU(1))         !    "
*
* Initialisation
      PNT = 0
      OPEN_A_MAP = .FALSE.
*
* Test if a file has been opened
*
      IF (IADDRRECORD.EQ.0) THEN
         CALL MESSAGE(2,1,'SUPPORT','No input file opened')
         ERROR = .TRUE.
         RETURN
      ENDIF
*
* Option /DELETE
*
      IF (SIC_PRESENT(5,0).AND.IADDR_SUPPORT.NE.0) THEN
         CALL SIC_DELVARIABLE('support_mdb',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_ekh',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_saa',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_cnv',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_input',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support',.FALSE.,ERROR)
         CALL FREE_VM(LENGTH_SUPPORT,IADDR_SUPPORT)
         IADDR_SUPPORT = 0
         LENGTH_SUPPORT = 0
         IF (IADDR_SUPPORT_MOS.NE.0) THEN
            CALL FREE_VM(LENGTH_SUPPORT,IADDR_SUPPORT_MOS)
            IADDR_SUPPORT_MOS = 0
         ENDIF
         CALL R4TOR4(0,MEMORY(IP_MDB_SUPPORT),1)
         CALL R4TOR4(0,MEMORY(IP_EKH_SUPPORT),1)
         ERROR = .FALSE.
         RETURN
      ELSE
         IF (SIC_PRESENT(5,0)) THEN
            CALL MESSAGE (2,1,'SUPPORT','No support currently defined')
            RETURN
         ENDIF
      ENDIF
*
* Check for ON-THE-FLY scan or POINTING scans
*
      IF (SCAN_TYPE.NE.2 .AND. SCAN_TYPE.NE.4) THEN
         CALL MESSAGE(2,1,'SUPPORT',
     $   'Only valid on ON-THE-FLY scans ...')
         RETURN
      ENDIF
*
* Option /CURSOR
*
      CURSOR_OPT = SIC_PRESENT(1,0)
*
* Option /CHANNEL
*
      CHANNEL_OPT = SIC_PRESENT(4,0)
      CHAN_REF = 1
      IF (TELESCOPE(1:3).EQ.'CSO') CHAN_REF = 12
      IF (CHANNEL_OPT) THEN
         CALL SIC_I4 (LINE,4,1,CHAN_REF,.TRUE.,ERROR)
         IF (CHAN_REF.LT.1 .OR. CHAN_REF.GT.NCHAN) THEN
            CALL MESSAGE (2,1,'SUPPORT','Bad channel number ')
            GOTO 99
         ENDIF
      ENDIF
*
* Option /FILE			! /FILE Filename [new]
*
      FILE_OPT = SIC_PRESENT(2,0)
      FILE_READ = .TRUE.
      IF (.NOT.FILE_OPT) FILE_READ = .FALSE.
      IF (FILE_OPT) THEN
         SUPPORTFILE = 'nic.pol'
         IF (SIC_PRESENT(2,1)) THEN
            CALL SIC_CH (LINE,2,1,SUPPORTNAME,NC,.FALSE.,ERROR)
            IF (ERROR) GOTO 99
            I = INDEX(SUPPORTNAME,'.')
            IF (I.EQ.0) THEN
               CALL SIC_PARSEF(SUPPORTNAME,SUPPORTFILE,' ','.pol')
            ELSE
               SUPPORTFILE = SUPPORTNAME
            ENDIF
            CALL SIC_LOWER(SUPPORTFILE)
            IF (SIC_PRESENT(2,2)) THEN
               CALL SIC_KE (LINE,2,2,OPTION,NC,.TRUE.,ERROR)
               IF (ERROR) THEN
                  GOTO 99
               ELSE
                  IF (OPTION(1:3).EQ.'NEW') THEN
                     FILE_READ = .FALSE.
                  ENDIF
               ENDIF
            ENDIF
         ELSE
            CALL MESSAGE (2,1,'SUPPORT','Missing FILE option')
            GOTO 99
         ENDIF
      ENDIF
      IF (FILE_READ) THEN
         CALL  READ_SUPPORT(SUPPORTFILE,TYPE,RA_FROM_INPUT,
     $   DEC_FROM_INPUT,EPOCH_FROM_INPUT,PNT,XU,YU,0,ERROR)
         IF (ERROR) GOTO 99
      ENDIF
      IF (FILE_READ) GOTO 500
*
* Read file xxxx.mdb, or xxxx.ekh or xxxx.cnv according to extension TYPE
* and name NAME. If option /INPUT filename, open filename
*
      INPUT_OPT = SIC_PRESENT(3,0)
      IF (INPUT_OPT) THEN
         CALL SIC_CH (LINE,3,1,X_FILE,NC,.TRUE.,ERROR)
         IF (ERROR) GOTO 99
!DB:03-99 CALL SIC_LOWER(X_FILE)
         I = INDEX(X_FILE,'.')
         TYPE = X_FILE(I+1:I+3)
         IF (TYPE.NE.'mdb'.AND.TYPE.NE.'ekh'.AND.TYPE.NE.'saa'.AND.
     $   TYPE.NE.'cnv') THEN
            CALL MESSAGE (2,1,'SUPPORT','Invalid file extension')
            GOTO 99
         ENDIF
      ELSE
         NAME = ' '
         X_FILE = ' '
         CALL SIC_GET_CHAR ('TYPE',TYPE,NC,ERROR)
         CALL SIC_GET_CHAR ('NAME',NAME,NC,ERROR)
         CALL SIC_LOWER(TYPE)
         CALL SIC_LOWER(NAME)
         IF (NAME.NE.' ')
     $   CALL SIC_PARSEF(NAME,X_FILE,' ','.'//TYPE(1:3))
      ENDIF
      INQUIRE (FILE=X_FILE,EXIST=EXIST_MAP)
      IF (.NOT.EXIST_MAP) THEN
         IF (CURSOR_OPT.OR.INPUT_OPT) THEN
            WRITE (STRING,'(a,1x,a)') 'Open failed on file ',X_FILE
            CALL MESSAGE (2,1,'SUPPORT',STRING)
            GOTO 99
         ELSE
            X_FILE = ' '
         ENDIF
      ENDIF
* Open image (if necessary)
      IF (EXIST_MAP .AND.
     $(CURSOR_OPT.OR.
     $INPUT_OPT .OR.
     $TYPE.EQ.'cnv'.OR.TYPE.EQ.'CNV')) THEN
         CALL OPEN_MAP (IPMAP,INPUT_OPT,NAME,TYPE,ERROR)
         IF (ERROR) GOTO 99
         OPEN_A_MAP = .TRUE.
      ENDIF
*
* Find xmin,xmax,ymin,ymax of input map
*   xmin,xmax,ymin,ymax are used to plot map or as default values if
*   rectangular support
*
*
      IF (OPEN_A_MAP) THEN
         NX = X_DIM(1)
         NY = X_DIM(2)
         LIM_SUPX = ((NX- X_REF1)*X_INC1+X_VAL1)/SEC_TO_RAD
         LIM_SUPY = ((NY- X_REF2)*X_INC2+X_VAL2)/SEC_TO_RAD
         LIM_INFX = ((1 - X_REF1)*X_INC1+X_VAL1)/SEC_TO_RAD
         LIM_INFY = ((1 - X_REF2)*X_INC2+X_VAL2)/SEC_TO_RAD
      ELSE
         CALL FIND_XY_LIMITS(MEMORY(IP_SCAN_COORD),
     $   MEMORY(IP_SCAN_COORD+NRECORD),NRECORD,LIM_INFX,LIM_SUPX,
     $   LIM_INFY,LIM_SUPY,MEMORY(IP_SIGNAL))
      ENDIF
      LIMIT_STRING = 'LIM -000.000 +000.000 -000.000 +000.000'
      WRITE (LIMIT_STRING(05:12),'(f8.3)') LIM_INFX
      WRITE (LIMIT_STRING(14:21),'(f8.3)') LIM_SUPX
      WRITE (LIMIT_STRING(23:30),'(f8.3)') LIM_INFY
      WRITE (LIMIT_STRING(32:39),'(f8.3)') LIM_SUPY
*
* Rectangular support
*
      IF (.NOT.CURSOR_OPT) THEN
         IF (SKEW.NE.0.AND..NOT.SIC_PRESENT(0,1) .AND.
     $   TYPE(1:3).NE.'cnv') THEN
            CALL SKEW_SUPPORT(LIM_INFX,LIM_SUPX,LIM_INFY,LIM_SUPY,
     $      XU,YU,SKEW,NSUBSCAN)
         ELSE
            IF (SCAN_TYPE.EQ.2) THEN     ! on-the-fly
               CORNER_XLOW = LIM_INFX+12
               CORNER_XUP  = LIM_SUPX-12
               CORNER_YLOW = LIM_INFY+12
               CORNER_YUP  = LIM_SUPY-12
            ELSE                         ! pointing
               TYPE(1:3) = 'MDB'
               CORNER_XLOW = -WOBBLER_THROW/2 - 15
               CORNER_XUP  =  WOBBLER_THROW/2 + 15
               CORNER_YLOW = -15
               CORNER_YUP  = +15
*              WRITE(6,*) CORNER_XLOW,CORNER_XUP,CORNER_YLOW,CORNER_YUP
            ENDIF
            IF (SIC_PRESENT(0,1)) THEN
               CALL SIC_R4 (LINE,0,1,CORNER_XLOW,.FALSE.,ERROR)
               IF (ERROR) GOTO 99
               CORNER_YUP  = (LIM_INFY+LIM_SUPY)/2-CORNER_XLOW
               CORNER_YLOW = (LIM_INFY+LIM_SUPY)/2+CORNER_XLOW
               CORNER_XUP  = (LIM_INFX+LIM_SUPX)/2-CORNER_XLOW
               CORNER_XLOW = (LIM_INFX+LIM_SUPX)/2+CORNER_XLOW
            ENDIF
            IF (SIC_PRESENT(0,3)) THEN
               CALL SIC_R4 (LINE,0,3,CORNER_XUP,.FALSE.,ERROR)
               IF (ERROR) GOTO 99
               CORNER_XUP = (LIM_INFX+LIM_SUPX)/2-CORNER_XUP
            ENDIF
            IF (SIC_PRESENT(0,2)) THEN
               CALL SIC_R4 (LINE,0,2,CORNER_YLOW,.FALSE.,ERROR)
               IF (ERROR) GOTO 99
               CORNER_YUP  = (LIM_INFY+LIM_SUPY)/2-CORNER_YLOW
               CORNER_YLOW = (LIM_INFY+LIM_SUPY)/2+CORNER_YLOW
            ENDIF
            IF (SIC_PRESENT(0,4)) THEN
               CALL SIC_R4 (LINE,0,4,CORNER_YUP,.FALSE.,ERROR)
               IF (ERROR) GOTO 99
               CORNER_YUP = (LIM_INFY+LIM_SUPY)/2-CORNER_YUP
            ENDIF
            XU(1) = CORNER_XLOW
            YU(1) = CORNER_YLOW
            XU(2) = CORNER_XUP
            YU(2) = CORNER_YLOW
            XU(3) = CORNER_XUP
            YU(3) = CORNER_YUP
            XU(4) = CORNER_XLOW
            YU(4) = CORNER_YUP
            XU(5) = CORNER_XLOW
            YU(5) = CORNER_YLOW
         ENDIF
         PNT = 5
      ENDIF
*
* Plot map (only if cursor option)
*
      IF (CURSOR_OPT.AND..NOT.GTG_CURS()) THEN
         CALL MESSAGE(2,1,'SUPPORT','No cursor available')
         GOTO 99
      ENDIF
      IF (CURSOR_OPT) THEN
         CHAN = 1
         IF (TYPE.NE.'cnv'.AND.CHANNEL_OPT) CHAN = CHAN_REF
         DIM(1)=X_DIM(1)
         DIM(2)=X_DIM(2)
         DIM(3)=NCHAN
         RGDATA = 'def ima map '//X_FILE
         RGDATA(LENC(RGDATA)+1:) = ' read'
         CALL GR_EXEC ('clea plot')
         SIC_STRING = RGDATA
         CALL EXEC_ALL (SIC_STRING)
         WRITE (RGPLOT,'(a,2f11.2)') 'PLOT /SCAL LIN ',X_RMIN, X_RMAX
         WRITE (RGDATA,'(a,i2.2,a)') 'rgdata map[',CHAN,'] /var'
         CALL GR_EXEC (RGDATA)
         CALL GR_EXEC ('lim /rg')
         CALL GR_EXEC ('set box mat')
         CALL GR_EXEC (RGPLOT)
         CALL GR_EXEC ('rgmap q')
         CALL GR_EXEC ('set exp 1.')
         CALL GR_EXEC (LIMIT_STRING)
         CALL GR_EXEC ('box')
         CALL EXEC_ALL ('del /var map')
*
         IF (X_SYST(1:1).EQ.'E') THEN
            CALL GR_EXEC ('label "\GD\Ga (arcsec)" /x')
            CALL GR_EXEC ('label "\GD\Gd (arcsec)" /y')
         ELSE
            CALL GR_EXEC ('label "Azimuth (arcsec)" /x')
            CALL GR_EXEC ('label "Elevation (arcsec)" /y')
         ENDIF
*
         CODE(1) = 'R'
         PNT = 1
         DO WHILE (CODE(PNT).NE.'E'.AND.CODE(PNT).NE.'*')
            CALL GR_CURS(XCOO,YCOO,X4COO,Y4COO,CODEMOUSE)
            CODE(PNT) = CODEMOUSE
            X4(PNT) = X4COO
            Y4(PNT) = Y4COO
            IF (CODE(PNT).EQ.'R'.OR.CODE(PNT).EQ.'^') THEN
               CALL RELOCATE (XCOO,YCOO)
               XU(1) = XCOO
               YU(1) = YCOO
               XS(1) = XCOO
               YS(1) = YCOO
               PNT = 2
               CODE(PNT) = 'R'           ! dummy
            ELSEIF (CODE(PNT).EQ.'L'.OR.CODE(PNT).EQ.'&') THEN
               IF (PNT.EQ.1) RETURN
               XU(PNT) = XCOO
               YU(PNT) = YCOO
               XS(2) = XCOO
               YS(2) = YCOO
               CALL GR_SEGM ('support',ERROR)
               CALL GR8_CONNECT (2,XS,YS,0D0,-1D0)
               CALL GR_OUT
               XS(1) = XCOO
               YS(1) = YCOO
               PNT = PNT+1
               CODE(PNT) = 'R'           ! dummy
               IF (PNT.GT.MAX_SEG) THEN
                  CALL MESSAGE (2,1,'SUPPORT',
     $            'Internal limit exceeded')
                  RETURN
               ENDIF
            ENDIF
         ENDDO
         IF (PNT.EQ.1) RETURN
         XU(PNT) = XU(1)
         YU(PNT) = YU(1)
         XS(2) = XU(1)
         YS(2) = YU(1)
         CALL GR_SEGM ('support',ERROR)
         CALL GR8_CONNECT (2,XS,YS,0D0,-1D0)
         CALL GR_OUT
      ELSE
         IF (PNT.GT.1.AND.X_FILE.NE.' ') THEN
            CALL GR_SEGM ('support',ERROR)
            CALL GR8_CONNECT (PNT,XU,YU,0D0,-1D0)
            CALL GR_OUT
         ENDIF
      ENDIF
*
* Allocate memory
*
500   IF (IADDR_SUPPORT.NE.0) THEN
         CALL SIC_DELVARIABLE('support_mdb',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_ekh',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_saa',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_cnv',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support_INPUT',.FALSE.,ERROR)
         CALL SIC_DELVARIABLE('support',.FALSE.,ERROR)
         CALL FREE_VM(LENGTH_SUPPORT,IADDR_SUPPORT)
      ENDIF
      IF (IADDR_SUPPORT_MOS.NE.0) THEN
         CALL FREE_VM(LENGTH_SUPPORT,IADDR_SUPPORT_MOS)
      ENDIF
      LENGTH_SUPPORT = 2*PNT+1           ! mosaic + cnv buffers
      DIM(1) = PNT
      DIM(2) = 2
      DIM(3) = NCHAN
      LATI = SITE_LATITUDE/DEG_TO_RAD
*
* Transform coordinates and save results
*
* cnv buffer and others
*
      LENGTH_SUPPORT = 2*PNT+1           ! cnv buffers
      IER = SIC_GETVM(LENGTH_SUPPORT,IADDR_SUPPORT)
      IF (IER.NE.1) THEN
         WRITE(6,*)' *** Unable to allocate memory ***'
         ERROR = .TRUE.
         RETURN
      ENDIF
      IP_CNV_SUPPORT = POINTER(IADDR_SUPPORT,MEMORY)
      CALL SIC_DEF_REAL ('support_cnv',MEMORY(IP_CNV_SUPPORT+1),2,DIM,
     $.FALSE.,ERROR)
      CALL SIC_DEF_REAL ('support_ekh',MEMORY(IP_EKH_SUPPORT+1),3,DIM,
     $.FALSE.,ERROR)
      CALL SIC_DEF_REAL ('support_saa',MEMORY(IP_EKH_SUPPORT+1),3,DIM,
     $.FALSE.,ERROR)
*
* First case: type = cnv
* -------------------------
*
* Compute RA_DAY,DEC_DAY of mosaic (-12344)
*
      IF (X_POSA.LE.-12344) THEN
         RA_FROM_INPUT = X_A0/DEG_TO_RAD
         DEC_FROM_INPUT = X_D0/DEG_TO_RAD
         EPOCH_FROM_INPUT = X_EPOC
*         WRITE(6,'(a,3f15.9)') 'RA_FROM_INPT,DEC_FROM_INPT,EPOCH =',
*     $        RA_FROM_INPUT,DEC_FROM_INPUT,EPOCH_FROM_INPUT
         IER = SIC_GETVM(LENGTH_SUPPORT,IADDR_SUPPORT_MOS)
         IF (IER.NE.1) THEN
            WRITE(6,*)' *** Unable to allocate memory ***'
            ERROR = .TRUE.
            RETURN
         ENDIF
         IP_MOS_SUPPORT = POINTER(IADDR_SUPPORT_MOS,MEMORY)
         CALL SIC_DEF_REAL ('support_input',MEMORY(IP_MOS_SUPPORT+1),
     $   2,DIM,.FALSE.,ERROR)
         CALL R4TOR4(PNT,MEMORY(IP_MOS_SUPPORT),1)
         CALL R8TOR4(XU, MEMORY(IP_MOS_SUPPORT+1),PNT)
         CALL R8TOR4(YU, MEMORY(IP_MOS_SUPPORT+1+PNT),PNT)
      ENDIF
*
* Compute RA_DAY,DEC_DAY of scan
*
      RA_FROM_SCAN = SOURCE_LAMBDA + OLAM/DEG_TO_RAD
      DEC_FROM_SCAN = SOURCE_BETA  + OBET/DEG_TO_RAD
      EPOCH_FROM_SCAN = EPOCH
*      WRITE(6,'(a,3f15.9)') 'RA_FROM_SCAN,DEC_FROM_SCAN,EPOCH =',
*     $     RA_FROM_SCAN,DEC_FROM_SCAN,EPOCH_FROM_SCAN
      CALL R4TOR8(MEMORY(IPSUBSCAN+NSUBSCAN),EPOCHTO,1)
      CALL PRECMAT(EPOCH_FROM_SCAN,EPOCHTO,AMAT)     ! get precession matrix
      CALL DCOSIN(RA_FROM_SCAN,DEC_FROM_SCAN,AVEC)   ! compute vector
      CALL MATMUL(AMAT,AVEC,BVEC,-9)     ! multiply by precession
      CALL DANGLE(RA_DAY_SCAN,DEC_DAY_SCAN,BVEC)
*
*      Update cnv_support buffer
*
      IF (TYPE(1:3).EQ.'cnv') THEN
         IP = IP_CNV_SUPPORT
         CALL R4TOR4(PNT,MEMORY(IP_CNV_SUPPORT),1)
         IF (FILE_READ) THEN
            CALL  READ_SUPPORT(SUPPORTFILE,TYPE,RA_FROM_INPUT,
     $      DEC_FROM_INPUT,EPOCH_FROM_INPUT,PNT,XU,YU,1,ERROR)
         ELSE
            RA_FROM_INPUT = X_A0/DEG_TO_RAD
            DEC_FROM_INPUT = X_D0/DEG_TO_RAD
            EPOCH_FROM_INPUT = X_EPOC
         ENDIF
*
*      Update cnv_support buffer
*      Compute RA_DAY and DEC_DAY of input map
*
         CALL PRECMAT(EPOCH_FROM_INPUT,EPOCHTO,AMAT) ! get precession matrix
         CALL DCOSIN(RA_FROM_INPUT,DEC_FROM_INPUT,AVEC)    ! compute vector
         CALL MATMUL(AMAT,AVEC,BVEC,-9)  ! multiply by precession
         CALL DANGLE(RA_DAY_INPUT,DEC_DAY_INPUT,BVEC)
*         WRITE(6,'(a,3f15.9)') 'RA_DATE,DEC_DATE,EPOCH =',
*     $     RA_DAY_INPUT,DEC_DAY_INPUT,EPOCHTO
         IF (RA_DAY_INPUT - RA_DAY_SCAN .GT.180)
     $   RA_DAY_INPUT = RA_DAY_INPUT-360
         IF (RA_DAY_INPUT - RA_DAY_SCAN .LT.-180)
     $   RA_DAY_INPUT = RA_DAY_INPUT+360
         DO I=1,PNT
            XU(I) = XU(I) + (RA_DAY_INPUT  - RA_DAY_SCAN)*36D2
     $      *COS((DEC_DAY_INPUT+DEC_DAY_SCAN)*PI/360)
            YU(I) = YU(I) + (DEC_DAY_INPUT - DEC_DAY_SCAN)*36D2
         ENDDO
         CALL R8TOR4(XU, MEMORY(IP_CNV_SUPPORT+1),PNT)
         CALL R8TOR4(YU, MEMORY(IP_CNV_SUPPORT+1+PNT),PNT)
         IF (X_POSA.LE.-12344) THEN      ! for mosaic, x_posa = -12345
            RA_FROM_INPUT = RA_FROM_SCAN
            DEC_FROM_INPUT = DEC_FROM_SCAN
         ENDIF
         EPOCHFR_INPUT =  EPOCH_FROM_SCAN
         PREVIOUS_RA  = RA_FROM_INPUT    ! identify it with current scan
         PREVIOUS_DEC = DEC_FROM_INPUT   ! identify it with current scan
*
*      Update ekh_support buffer
*
         CALL R4TOR4(PNT,MEMORY(IP_EKH_SUPPORT),1)
         CALL TRANSFORM_CNV_TO_EKH(XU,YU,PNT,
     $   MEMORY(IP_EKH_SUPPORT+1),
     $   RA_DAY_SCAN,DEC_DAY_SCAN,LATI,
     $   MEMORY(IP_LST),MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $   MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $   NCHAN,NSUBSCAN,NRECORD,TELESCOPE,FIELD_ROTATION)
*
*      Update mdb_support buffer
*
         CALL SIC_GET_DBLE('BEAMSEP',BEAMSEP,ERROR)
         IF (DABS(BEAMSEP).LT.1.D-3) THEN
            BEAMSEP = WOBBLER_THROW
         ENDIF
         CALL R4TOR8(MEMORY(IP_EKH_SUPPORT+1),U(1,1),PNT)
         CALL R4TOR8(MEMORY(IP_EKH_SUPPORT+1+PNT),U(1,2),PNT)
         CALL TRANSFORM_COORDINATES (U,PNT-1,V,NV,BEAMSEP,ERROR)
         IF (ERROR) RETURN
         CALL SHIFT_MAP (V(1,1), V(1,2), NV, MEMORY(IP_MDB_SUPPORT+1),
     $   MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $   MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $   NCHAN,NSUBSCAN,1,TELESCOPE,FIELD_ROTATION)
         CALL R4TOR4(NV,MEMORY(IP_MDB_SUPPORT),1)
         REFERENCE_SUPPORT = 'CNV'
*
* -- Second case: type = ekh
*
      ELSEIF (TYPE(1:3).EQ.'ekh'.OR.TYPE(1:3).EQ.'saa') THEN
*      Update ekh_support buffer
         IP = IP_EKH_SUPPORT
         CALL R4TOR4(PNT,MEMORY(IP_EKH_SUPPORT),1)
         IF (FILE_READ) THEN
            DO ICHAN=NCHAN,1,-1
               CALL  READ_SUPPORT(SUPPORTFILE,TYPE,RA_FROM_INPUT,
     $         DEC_FROM_INPUT,EPOCHFR_INPUT,PNT,XU,YU,ICHAN,ERROR)
               CALL R8TOR4(XU,
     $         MEMORY(IP_EKH_SUPPORT+1+2*PNT*(ICHAN-1)),PNT)
               CALL R8TOR4(YU,
     $         MEMORY(IP_EKH_SUPPORT+1+PNT+2*PNT*(ICHAN-1)),PNT)
            ENDDO
         ELSE
            CALL SHIFT_MAP (XU, YU, PNT, MEMORY(IP_EKH_SUPPORT+1),
     $      MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $      MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $      NCHAN,NSUBSCAN,CHAN_REF,TELESCOPE,FIELD_ROTATION)
         ENDIF
*      Update cnv_support buffer
         CALL R4TOR4(PNT,MEMORY(IP_CNV_SUPPORT),1)
         CALL TRANSFORM_EKH_TO_CNV(XU,YU,PNT,
     $   MEMORY(IP_CNV_SUPPORT+1),
     $   RA_DAY_SCAN,DEC_DAY_SCAN,LATI,
     $   MEMORY(IP_LST),MEMORY(IP_SCAN_COORD+NRECORD),
     $   MEMORY(IPSUBREC),NCHAN,NSUBSCAN,NRECORD)
*      Update mdb_support buffer
         CALL SIC_GET_DBLE('BEAMSEP',BEAMSEP,ERROR)
         IF (DABS(BEAMSEP).LT.1.D-3) THEN
            BEAMSEP = WOBBLER_THROW
         ENDIF
         CALL TRANSFORM_COORDINATES (U,PNT-1,V,NV,BEAMSEP,ERROR)
         IF (ERROR) RETURN
         CALL SHIFT_MAP (V(1,1), V(1,2), NV, MEMORY(IP_MDB_SUPPORT+1),
     $   MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $   MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $   NCHAN,NSUBSCAN,CHAN_REF,TELESCOPE,FIELD_ROTATION)
         CALL R4TOR4(NV,MEMORY(IP_MDB_SUPPORT),1)
         RA_FROM_INPUT  = RA_FROM_SCAN
         DEC_FROM_INPUT = DEC_FROM_SCAN
         EPOCHFR_INPUT =  EPOCH
         REFERENCE_SUPPORT = 'EKH'
         IF (TYPE(1:3).EQ.'saa') REFERENCE_SUPPORT = 'SAA'
      ELSE
*
* -- Third case: type = mdb
*
         IP = IP_MDB_SUPPORT
         CALL R4TOR4(PNT,MEMORY(IP_MDB_SUPPORT),1)
         IF (FILE_READ) THEN
            DO ICHAN=NCHAN,1,-1
               CALL  READ_SUPPORT(SUPPORTFILE,TYPE,RA_FROM_INPUT,
     $         DEC_FROM_INPUT,EPOCHFR_INPUT,PNT,XU,YU,ICHAN,ERROR)
               CALL R8TOR4(XU,
     $         MEMORY(IP_MDB_SUPPORT+1+2*PNT*(ICHAN-1)),PNT)
               CALL R8TOR4(YU,
     $         MEMORY(IP_MDB_SUPPORT+1+PNT+2*PNT*(ICHAN-1)),PNT)
            ENDDO
         ELSE
            CALL SHIFT_MAP (XU, YU, PNT, MEMORY(IP_MDB_SUPPORT+1),
     $      MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $      MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $      NCHAN,NSUBSCAN,CHAN_REF,TELESCOPE,FIELD_ROTATION)
         ENDIF
         NV = PNT                        ! to define SIC variable support_mdb[]
*      Update ekh_support buffer
         CALL R4TOR4(PNT,MEMORY(IP_EKH_SUPPORT),1)
         CALL R4TOR4(MEMORY(IP_MDB_SUPPORT+1),
     $   MEMORY(IP_EKH_SUPPORT+1),2*PNT*NCHAN)
*      Update cnv_support buffer
         CALL R4TOR4(PNT,MEMORY(IP_CNV_SUPPORT),1)
         CALL TRANSFORM_EKH_TO_CNV(XU,YU,PNT,
     $   MEMORY(IP_CNV_SUPPORT+1),
     $   RA_DAY_SCAN,DEC_DAY_SCAN,LATI,
     $   MEMORY(IP_LST),MEMORY(IP_SCAN_COORD+NRECORD),
     $   MEMORY(IPSUBREC),NCHAN,NSUBSCAN,NRECORD)
         RA_FROM_INPUT  = RA_FROM_SCAN
         DEC_FROM_INPUT = DEC_FROM_SCAN
         EPOCHFR_INPUT =  EPOCH
         REFERENCE_SUPPORT = 'MDB'
      ENDIF
      CALL SIC_DEF_CHAR ('support',REFERENCE_SUPPORT,.TRUE.,ERROR)
      SUPPORT_ORIGIN = 1
*
* Define MDB variable
      DIM(1) = NV
      DIM(2) = 2
      DIM(3) = NCHAN
      CALL SIC_DEF_REAL ('support_mdb',MEMORY(IP_MDB_SUPPORT+1),
     $3,DIM,.FALSE.,ERROR)
*
* Consider flagged channels or reference channels
*
      CALL  BLANK_SUPPORT (MEMORY(IP_MDB_SUPPORT+1),
     $MEMORY(IP_EKH_SUPPORT+1),MEMORY(IP_MDB_SUPPORT),
     $MEMORY(IP_EKH_SUPPORT),MEMORY(IP_FLAG),
     $CHANNEL_OPT,CHAN_REF,BLANKING,NCHAN)
*
*
* Save support in file
*
      IF (FILE_OPT.AND..NOT.FILE_READ) THEN
         CALL WRITE_SUPPORT(SUPPORTFILE,LINE,SCAN_NUMBER,TYPE,
     $   RA_FROM_INPUT,DEC_FROM_INPUT,EPOCHFR_INPUT,
     $   MEMORY(IP),MEMORY(IP+1),NCHAN)
      ENDIF
*
* Free slot:
      IF (OPEN_A_MAP) CALL GDF_FRIS(X_ISLO,ERROR)
      RETURN
*
* End
*
99    ERROR = .TRUE.
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C    OPEN_MAP
C
C ----------------------------------------------------------------------
      SUBROUTINE OPEN_MAP (IPMAP,INPUT_OPT,NAME,TYPE,ERROR)
*
      INCLUDE 'inc:xpar.inc'
      INTEGER*4 IPMAP, POINTER
      INTEGER    MEMORY
      INTEGER   BLC(4), TRC(4)
      LOGICAL   ERROR, INPUT_OPT
      CHARACTER STRING*200, NAME*80, TYPE*12
      DATA BLC /0,0,0,0/, TRC /0,0,0,0/
*
      CALL GDF_GEIS  (X_ISLO,ERROR)
      CALL GDF_REIS  (X_ISLO,X_TYPE,X_FILE,X_FORM,X_SIZE,ERROR)
      IF (ERROR) THEN
         IF (INPUT_OPT) THEN
            WRITE (STRING,'(a,1x,a)') 'Open failed on file ',X_FILE
         ELSE
            WRITE (STRING,'(2a)') 'Open failed on file ',
     $      NAME(1:4)//'.'//TYPE(1:3)
         ENDIF
         CALL MESSAGE (2,1,'SUPPORT',STRING)
         CALL GDF_FRIS (X_ISLO,ERROR)    ! free slot
         RETURN
      ENDIF
      CALL GDF_READX  (X_ISLO,ERROR)
      CALL GDF_GEMS  (X_MSLO,X_ISLO,BLC,TRC,X_ADDR,X_FORM,ERROR)
      IPMAP = POINTER (X_ADDR,MEMORY)
*
      IF (ERROR) CALL GDF_FRIS (X_ISLO,ERROR)  ! free slot if error
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C     TRANSFORM_CNV_TO_EKH
C
C ----------------------------------------------------------------------
      SUBROUTINE TRANSFORM_CNV_TO_EKH(XU,YU,PNT,
     $COORD_EKH,
     $RA_DAY,DEC_DAY,LATI,
     $LST,EL,
     $YCOORD,
     $OA, OE,
     $NSUBREC,NCHAN,NSUBSCAN,NRECORD,TELESCOPE,FIELD_ROTATION)
*
      INCLUDE 'const.inc'
*
      REAL*8    XU(1),YU(1)
      REAL*8    RA_DAY,DEC_DAY,LATI
      REAL*4    LST(1),EL(1),YCOORD(1),OA(1),OE(1)
      REAL*4    COORD_EKH(1)             ! output
      INTEGER   PNT,NSUBREC(1),NCHAN,NSUBSCAN,NRECORD
      INTEGER   FIELD_ROTATION
      CHARACTER*40 TELESCOPE
*
      REAL*8    DRA,DDEC,DLST,DAZ,DEL
      REAL      XCOO,YCOO,COS_EL,SIN_EL,DMIN
      INTEGER   I,IREC,IREC_BEST,IREC_SUB,ICHAN,ISUBSCAN,IREF
*
      DO I=1,PNT
         DRA = XU(I)
         DDEC = YU(I)
         IREC = NSUBREC(1)/2
         DMIN = 1.D10
         DO ISUBSCAN = 1,NSUBSCAN
            IF (ISUBSCAN.GT.1) IREC = IREC + NSUBREC(ISUBSCAN-1)
            DLST = LST(IREC)
            CALL NIC_RADEC_TO_AZEL(DRA,DDEC,DLST,LATI,RA_DAY,
     $      DEC_DAY,DAZ,DEL)
            CALL FIND_NEAREST_SUBSCAN(NSUBREC,YCOORD,NSUBSCAN,DEL,
     $      IREC_SUB)
            IF (ABS(YCOORD(IREC_SUB)/10.-DEL).LT.DMIN) THEN
               IREC_BEST = IREC
               DMIN = ABS(YCOORD(IREC_SUB)/10.-DEL)
            ENDIF
         ENDDO
         DLST = LST(IREC_BEST)
         CALL NIC_RADEC_TO_AZEL(DRA,DDEC,DLST,LATI,RA_DAY,
     $   DEC_DAY,DAZ,DEL)
* ----- Find AZ-EL for all channels
         COS_EL = COS(FIELD_ROTATION*EL(IREC_BEST)*DEG_TO_RAD)
         SIN_EL = SIN(FIELD_ROTATION*EL(IREC_BEST)*DEG_TO_RAD)
         IREF = 1
         IF (TELESCOPE(1:3).EQ.'CSO') THEN
            IREF = 12
            COS_EL = 1                   ! no rotation
            SIN_EL = 0
         ENDIF
         DO ICHAN = 1,NCHAN
            XCOO = DAZ
     $      -(OA(IREF)-OA(ICHAN))*COS_EL
     $      -(OE(IREF)-OE(ICHAN))*SIN_EL
            YCOO = DEL
     $      +(OA(IREF)-OA(ICHAN))*SIN_EL
     $      -(OE(IREF)-OE(ICHAN))*COS_EL
            COORD_EKH((ICHAN-1)*2*PNT + I)      = XCOO
            COORD_EKH((ICHAN-1)*2*PNT + PNT +I) = YCOO
         ENDDO
      ENDDO
      RETURN
      END
*
*
C ----------------------------------------------------------------------
C
C     TRANSFORM_EKH_TO_CNV
C
C ----------------------------------------------------------------------
      SUBROUTINE TRANSFORM_EKH_TO_CNV(XU, YU, PNT,
     $COORD_CNV, RA_DAY, DEC_DAY, LATI, LST, YCOORD,
     $NSUBREC,NCHAN,NSUBSCAN,NRECORD)
*
      INCLUDE 'const.inc'
*
      REAL*8    XU(1),YU(1)
      REAL*8    RA_DAY,DEC_DAY,LATI
      REAL*4    LST(1),YCOORD(1)
      REAL*4    COORD_CNV(1)             ! output
      INTEGER   PNT,NSUBREC(1),NCHAN,NSUBSCAN,NRECORD
*
      REAL*8    DRA,DDEC,DLST
      INTEGER   I,IREC
*
      DO I=1,PNT
         CALL FIND_NEAREST_SUBSCAN(NSUBREC,YCOORD,NSUBSCAN,YU(I),
     $   IREC)
         DLST = LST(IREC)
         CALL NIC_AZEL_TO_RADEC(XU(I),YU(I),DLST,LATI,RA_DAY,
     $   DEC_DAY,DRA,DDEC)
         COORD_CNV(I) = DRA
         COORD_CNV(PNT+I) = DDEC
      ENDDO
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C     SHIFT_MAP
C
C ----------------------------------------------------------------------
      SUBROUTINE SHIFT_MAP(XU,YU,PNT,
     $COORD,
     $EL,
     $YCOORD,
     $OA, OE,
     $NSUBREC,NCHAN,NSUBSCAN,IREF,TELESCOPE,FIELD_ROTATION)
*
      INCLUDE 'const.inc'
*
      REAL*8    XU(1),YU(1)
      REAL*4    EL(1),YCOORD(1),OA(1),OE(1)
      REAL*4    COORD(1)                 ! output
      INTEGER   PNT,NSUBREC(1),NCHAN,NSUBSCAN,IREF,FIELD_ROTATION
      CHARACTER*40 TELESCOPE
*
      REAL      XCOO,YCOO,COS_EL,SIN_EL
      INTEGER   I,ICHAN,IREC
*
      DO I=1,PNT
         CALL FIND_NEAREST_SUBSCAN(NSUBREC,YCOORD,NSUBSCAN,YU(I),
     $   IREC)
* ----- Find AZ-EL for all channels
         COS_EL = COS(FIELD_ROTATION*EL(IREC)*DEG_TO_RAD)
         SIN_EL = SIN(FIELD_ROTATION*EL(IREC)*DEG_TO_RAD)
         IF (TELESCOPE(1:3).EQ.'CSO') THEN
            COS_EL = 1                   ! no rotation
            SIN_EL = 0
         ENDIF
         DO ICHAN = 1,NCHAN
            XCOO = XU(I)
     $      -(OA(IREF)-OA(ICHAN))*COS_EL -(OE(IREF)-OE(ICHAN))*SIN_EL
            YCOO = YU(I)
     $      +(OA(IREF)-OA(ICHAN))*SIN_EL -(OE(IREF)-OE(ICHAN))*COS_EL
            COORD((ICHAN-1)*2*PNT + I)      = XCOO
            COORD((ICHAN-1)*2*PNT + PNT +I) = YCOO
         ENDDO
      ENDDO
*
      IF ((IREF.NE.1 .AND.TELESCOPE(1:3).NE.'CSO').OR.
     $(IREF.NE.12.AND.TELESCOPE(1:3).EQ.'CSO')) THEN
         DO I=1,PNT                      ! copy coord of first channel in xu,yu
            XU(I) = COORD(I)
            YU(I) = COORD(PNT+I)
         ENDDO
      ENDIF
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C     FIND_NEAREST_SUBSCAN
C
C ----------------------------------------------------------------------
*
      SUBROUTINE FIND_NEAREST_SUBSCAN(NSUBREC,YCOORD,NSUBSCAN,DEL,
     $IREC_MIN)
*
      INTEGER NSUBREC(1),IREC_MIN,NSUBSCAN
      REAL    YCOORD(1)
      REAL*8  DEL
*
      INTEGER ISUB,ISUB_MIN,IREC
      REAL    DIST_MIN
*
      ISUB = 1
      IREC = 1
      DIST_MIN = 1.D32
      DO ISUB=1,NSUBSCAN
         IF(ABS(YCOORD(IREC+NSUBREC(ISUB)/2)/10.-DEL).LT.DIST_MIN) THEN
            DIST_MIN = ABS(YCOORD(IREC+NSUBREC(ISUB)/2)/10.-DEL)
            ISUB_MIN = ISUB
            IREC_MIN = IREC +NSUBREC(ISUB)/2
         ENDIF
         IREC = IREC + NSUBREC(ISUB)
      ENDDO
      RETURN
      END
C ----------------------------------------------------------------------
C
C     FIND_XY_LIMITS
C
C ----------------------------------------------------------------------
*
      SUBROUTINE FIND_XY_LIMITS(XCOORD,YCOORD,N,XMIN,XMAX,YMIN,YMAX,
     $SIG)
*
      INCLUDE 'parameter.inc'
      REAL XCOORD(1),YCOORD(1),SIG(1)
      REAL XMIN,XMAX,YMIN,YMAX
      INTEGER N
*
      INTEGER I
*
      XMIN = 1.D32
      XMAX = -1.D32
      YMIN = 1.D32
      YMAX = -1.D32
      DO I=1,N
         IF (ABS(SIG(I)-BLANKING).GE.0.5) THEN
            IF (XMIN.GT.XCOORD(I)) XMIN = XCOORD(I)
            IF (XMAX.LT.XCOORD(I)) XMAX = XCOORD(I)
            IF (YMIN.GT.YCOORD(I)) YMIN = YCOORD(I)
            IF (YMAX.LT.YCOORD(I)) YMAX = YCOORD(I)
         ENDIF
      ENDDO
      XMIN = XMIN/10
      XMAX = XMAX/10
      YMIN = YMIN/10
      YMAX = YMAX/10
      END
C ----------------------------------------------------------------------
C
C     WRITE_SUPPORT
C
C ----------------------------------------------------------------------
*
      SUBROUTINE WRITE_SUPPORT(SUPPORTFILE,LINE,SCAN_NUMBER,TYPE,
     $RA,DEC,EPOCH,PNT,COORD,NCHAN)
*
      CHARACTER*(*) SUPPORTFILE,LINE,TYPE
      INTEGER       SCAN_NUMBER,PNT,NCHAN
      REAL*8        RA,DEC
      REAL*8        EPOCH
      REAL*4        COORD(1)
*
      CHARACTER*40  DATE_OF_REDUC
      CHARACTER SIC_STRING*50
      INTEGER       SIC_OPEN,I,ICHAN,I0,IER,N
      LOGICAL       ERROR
*
* Open file
*
      IER = SIC_OPEN(2,SUPPORTFILE,'NEW',.FALSE.)
      IF (IER.NE.0) THEN
         CALL MESSAGE (2,1,'SUPPORT','Not able to create file')
         RETURN
      ENDIF
*
* Read date
      CALL SIC_DEF_CHAR ('date_of_reduc',DATE_OF_REDUC,
     $.FALSE.,ERROR)
      CALL EXEC_ALL ('sic date')
      SIC_STRING = 'LET DATE_OF_REDUC ''SYS_DATE'''
      CALL EXEC_ALL (SIC_STRING)
      CALL SIC_DELVARIABLE('date_of_reduc',.FALSE.,ERROR)
*
* Write header
      WRITE(2,'(a,i4,10x,a)')'! Scan: ',SCAN_NUMBER, DATE_OF_REDUC
      WRITE(2,'(a,a72)')       '! ', LINE
      WRITE(2,'(a,a)')       '! Type: ', TYPE(1:3)
      IF (TYPE.EQ.'cnv') THEN
         WRITE(2,'(a,f11.6,a,f11.6,a,f9.3)')
     $   '! RA:',RA,' deg     DEC:',DEC,' deg    Epoch:',EPOCH
         N = 1
      ELSE
         WRITE(2,'(a)')'! '
         N = NCHAN
      ENDIF
*
* Write support coordinates
      DO ICHAN=1,N
         I0 =(ICHAN-1)*2*PNT
         WRITE(2,'(a,i2)')'! Channel ',ICHAN
         DO I=1,PNT
            WRITE (2,'(2f10.2)') COORD(I0+I),COORD(I0+I+PNT)
         ENDDO
      ENDDO
      CLOSE (UNIT=2)
      END
C ----------------------------------------------------------------------
C
C     READ_SUPPORT
C
C ----------------------------------------------------------------------
*
      SUBROUTINE READ_SUPPORT(SUPPORTFILE,TYPE,
     $RA,DEC,EPOCH,PNT,XCOORD,YCOORD,ICHAN,ERROR)
*
      CHARACTER*(*) SUPPORTFILE,TYPE
      INTEGER       PNT,ICHAN
      REAL*8        RA,DEC
      REAL*8        EPOCH
      REAL*8        XCOORD(1),YCOORD(1)
      LOGICAL       ERROR
*
      INTEGER       SIC_OPEN,I,IER,IC
      CHARACTER*80  LINE
*
* Open file
*
      ERROR = .FALSE.
      IER = SIC_OPEN(2,SUPPORTFILE,'old',.FALSE.)
      IF (IER.NE.0) THEN
         CALL MESSAGE (2,1,'SUPPORT','Not able to open file')
         ERROR = .TRUE.
         RETURN
      ENDIF
*
* Read header
      IF (ICHAN.EQ.0) THEN
         LINE = ' '
         DO WHILE (INDEX(LINE,'Type').EQ.0)
            READ(2,'(a)',END=99) LINE
         ENDDO
         I = INDEX(LINE,':')
         TYPE = LINE(I+2:I+4)
         READ(2,'(a)') LINE
         IF (TYPE.EQ.'cnv') THEN
            I = INDEX(LINE,'RA:')
            READ(LINE(I+3:I+13),*) RA
            I = INDEX(LINE,'DEC:')
            READ(LINE(I+4:I+14),*) DEC
            I = INDEX(LINE,'Epoch:')
            READ(LINE(I+6:I+14),*) EPOCH
         ENDIF
*
*     Read number of channels
         DO WHILE (INDEX(LINE,'Channel').EQ.0) ! find channel 1 or end
            READ(2,'(a)') LINE
         ENDDO
         I = 0
         READ(2,'(a)') LINE
         DO WHILE (INDEX(LINE,'Channel').EQ.0) ! find channel 2 or end
            I = I+1
            READ(2,'(a)',END=100) LINE
         ENDDO
100      PNT = I
*
* Read data
      ELSE
         IC = 0
         DO WHILE(IC.NE.ICHAN)
            READ(2,'(a)')LINE
            DO WHILE (INDEX(LINE,'Channel').EQ.0)    ! find channel 1 or end
               READ(2,'(a)',END=200) LINE
            ENDDO
            I = INDEX(LINE,'Channel')
            READ(LINE(I+7:),*) IC
         ENDDO
         DO I=1,PNT
            READ(2,*) XCOORD(I),YCOORD(I)
         ENDDO
200      CONTINUE
      ENDIF
      CLOSE (UNIT=2)
      RETURN
*
99    CALL MESSAGE (2,1,'SUPPORT','Invalid format in the support file')
      ERROR = .TRUE.
      CLOSE (UNIT=2)
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C     BLANK_SUPPORT
C
C ----------------------------------------------------------------------
*
      SUBROUTINE BLANK_SUPPORT(SUPPORT_MDB,SUPPORT_EKH,N_MDB,N_EKH,
     $RECEIVER_FLAG,CHANNEL_OPT,CHAN_REF,BLANKING,NCHAN)
      REAL    SUPPORT_MDB(1),SUPPORT_EKH(1),BLANKING
      INTEGER N_MDB,N_EKH, CHAN_REF,NCHAN
      LOGICAL RECEIVER_FLAG(1)
      LOGICAL CHANNEL_OPT
*
      INTEGER I,I0,ICHAN
*
      DO ICHAN=1,NCHAN
         IF (RECEIVER_FLAG(ICHAN).OR.
     $   (CHANNEL_OPT.AND.ICHAN.NE.CHAN_REF)) THEN
            I0 = 2*N_MDB*(ICHAN-1)
            DO I=1,2*N_MDB
               SUPPORT_MDB(I0+I)= BLANKING
            ENDDO
            I0 = 2*N_EKH*(ICHAN-1)
            DO I=1,2*N_EKH
               SUPPORT_EKH(I0+I)= BLANKING
            ENDDO
         ENDIF
      ENDDO
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C    UPDATE_MDB_EKH_SUPPORT
C
C      This subroutine is used by NIC\FILE when SUPPORT_CNV is defined
C
C ----------------------------------------------------------------------
      SUBROUTINE UPDATE_MDB_EKH_SUPPORT(PNT,X4,Y4,ERROR)
*
      INCLUDE 'nmb.inc'
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
*
      INTEGER   PNT
      REAL      X4(1),Y4(1)
      LOGICAL   ERROR
*
      INTEGER  MAX_SEG
      PARAMETER (MAX_SEG = 100)
      REAL*8    U(MAX_SEG,2),V(2*MAX_SEG,2)
      REAL*8    XU(MAX_SEG), YU(MAX_SEG)
      REAL*8    BEAMSEP
      REAL*8    EPOCHFR,EPOCHTO,AMAT(9),AVEC(3),BVEC(3)
      REAL*8    RA_FROM_SCAN,DEC_FROM_SCAN,RA_DAY_SCAN,DEC_DAY_SCAN
      REAL*8    RA_DAY_INPUT,DEC_DAY_INPUT
      REAL*8    LATI
      INTEGER   I,NV,DIM(4)
      EQUIVALENCE (U(1,1),XU(1))         ! interface of routine transform_coordi
      EQUIVALENCE (U(1,2),YU(1))         !    "
*
* -- Compute RA_DAY,DEC_DAY of scan
*
      RA_FROM_SCAN = SOURCE_LAMBDA + OLAM/DEG_TO_RAD
      DEC_FROM_SCAN = SOURCE_BETA  + OBET/DEG_TO_RAD
      EPOCHFR = EPOCH
*      WRITE(6,'(A,3F15.9)') 'RA_FROM_SCAN,DEC_FROM_SCAN,EPOCHFROM =',
*     $     RA_FROM_SCAN,DEC_FROM_SCAN,EPOCH
      CALL R4TOR8(MEMORY(IPSUBSCAN+NSUBSCAN),EPOCHTO,1)
      CALL PRECMAT(EPOCHFR,EPOCHTO,AMAT) ! compute precession matrix
      CALL DCOSIN(RA_FROM_SCAN,DEC_FROM_SCAN,AVEC)   ! compute vector
      CALL MATMUL(AMAT,AVEC,BVEC,-9)     ! multiply by precession
      CALL DANGLE(RA_DAY_SCAN,DEC_DAY_SCAN,BVEC)
      LATI = SITE_LATITUDE/DEG_TO_RAD
*      WRITE(6,'(A,3F15.9)') 'RA_DAY_SCAN,DEC_DAY_SCAN,EPOCHTO =  ',
*     $     RA_DAY_SCAN,DEC_DAY_SCAN,EPOCHTO
      IF (PREVIOUS_RA.NE.RA_FROM_SCAN.AND.
     $PREVIOUS_DEC.NE.DEC_FROM_SCAN) THEN
         PREVIOUS_RA  = RA_FROM_SCAN
         PREVIOUS_DEC = DEC_FROM_SCAN
*
* -- Compute RA_DAY and DEC_DAY of SUPPORT_CNV
*
         CALL PRECMAT(EPOCHFR_INPUT,EPOCHTO,AMAT)    ! compute precession matrix
         CALL DCOSIN(RA_FROM_INPUT,DEC_FROM_INPUT,AVEC)    ! compute vector
         CALL MATMUL(AMAT,AVEC,BVEC,-9)  ! multiply by precession
         CALL DANGLE(RA_DAY_INPUT,DEC_DAY_INPUT,BVEC)
         RA_FROM_INPUT = RA_FROM_SCAN
         DEC_FROM_INPUT = DEC_FROM_SCAN
         EPOCHFR_INPUT = EPOCH
*
*  Update ekh_support buffer
*
         CALL R4TOR4(PNT,MEMORY(IP_EKH_SUPPORT),1)
         IF (RA_DAY_INPUT - RA_DAY_SCAN .GT.180)
     $   RA_DAY_INPUT = RA_DAY_INPUT-360
         IF (RA_DAY_INPUT - RA_DAY_SCAN .LT.-180)
     $   RA_DAY_INPUT = RA_DAY_INPUT+360
         DO I=1,PNT
            X4(I) = X4(I) + (RA_DAY_INPUT  - RA_DAY_SCAN)*36D2
     $      *COS((DEC_DAY_INPUT+DEC_DAY_SCAN)*PI/360)
            Y4(I) = Y4(I) + (DEC_DAY_INPUT - DEC_DAY_SCAN)*36D2
         ENDDO
         CALL R4TOR8(X4,XU,PNT)
         CALL R4TOR8(Y4,YU,PNT)
      ELSE
         CALL R4TOR8(MEMORY(IP_CNV_SUPPORT+1),XU,PNT)
         CALL R4TOR8(MEMORY(IP_CNV_SUPPORT+1+PNT),YU,PNT)
      ENDIF
      CALL TRANSFORM_CNV_TO_EKH(XU,YU,PNT,
     $MEMORY(IP_EKH_SUPPORT+1),
     $RA_DAY_SCAN,DEC_DAY_SCAN,LATI,
     $MEMORY(IP_LST),MEMORY(IP_EL),
     $MEMORY(IP_SCAN_COORD+NRECORD),
     $MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $NCHAN,NSUBSCAN,NRECORD,TELESCOPE,FIELD_ROTATION)
*
*
*  Update mdb_support buffer
      CALL SIC_GET_DBLE('BEAMSEP',BEAMSEP,ERROR)
      IF (DABS(BEAMSEP).LT.1.D-3) THEN
         BEAMSEP = WOBBLER_THROW
      ENDIF
      CALL R4TOR8(MEMORY(IP_EKH_SUPPORT+1),U(1,1),PNT)
      CALL R4TOR8(MEMORY(IP_EKH_SUPPORT+1+PNT),U(1,2),PNT)
      CALL TRANSFORM_COORDINATES (U,PNT-1,V,NV,BEAMSEP,ERROR)
      IF (ERROR) RETURN
      CALL SHIFT_MAP (V(1,1), V(1,2), NV, MEMORY(IP_MDB_SUPPORT+1),
     $MEMORY(IP_EL),MEMORY(IP_SCAN_COORD+NRECORD),
     $MEMORY(IP_AZOFF),MEMORY(IP_ELOFF),MEMORY(IPSUBREC),
     $NCHAN,NSUBSCAN,1,TELESCOPE,FIELD_ROTATION)
*
*  Update variable
      DIM(1) = PNT
      DIM(2) = 2
      DIM(3) = NCHAN
      CALL SIC_DEF_REAL ('support_ekh',MEMORY(IP_EKH_SUPPORT+1),
     $3,DIM,.FALSE.,ERROR)
      CALL SIC_DEF_REAL ('support_saa',MEMORY(IP_EKH_SUPPORT+1),
     $3,DIM,.FALSE.,ERROR)
      CALL SIC_DEF_CHAR ('support',REFERENCE_SUPPORT,.TRUE.,ERROR)
      CALL R4TOR4(NV,MEMORY(IP_MDB_SUPPORT),1)
      DIM(1) = NV
      CALL SIC_DEF_REAL ('support_mdb',MEMORY(IP_MDB_SUPPORT+1),
     $3,DIM,.FALSE.,ERROR)
*
* Consider flagged channels or reference channels
*
      CALL  BLANK_SUPPORT (MEMORY(IP_MDB_SUPPORT+1),
     $MEMORY(IP_EKH_SUPPORT+1),MEMORY(IP_MDB_SUPPORT),
     $MEMORY(IP_EKH_SUPPORT),MEMORY(IP_FLAG),
     $.FALSE.,1,BLANKING,NCHAN)
      RETURN
      END
*
C ----------------------------------------------------------------------
C
C    SKEW_SUPPORT
C
C ----------------------------------------------------------------------
      SUBROUTINE SKEW_SUPPORT(MINX,MAXX,MINY,MAXY,XU,YU,SKEW,NSUBSCAN)
*
      REAL*4 MINX,MAXX,MINY,MAXY
      REAL*4 SKEW
      REAL*8 XU(5)
      REAL*8 YU(5)
      INTEGER NSUBSCAN
*
      REAL*8 TAN
*
      TAN = SKEW*(NSUBSCAN-1)/(MAXY-MINY)
      XU(1) = MINX +12
      XU(3) = MAXX -12
      XU(2) = MAXX - (MAXY-MINY)*ABS(TAN) -12
      XU(4) = MINX + (MAXY-MINY)*ABS(TAN) +12
      IF (SKEW.GT.0) THEN
         YU(1) = MINY + 12
         YU(3) = MAXY - 12
      ELSE
         YU(1) = MAXY + 12
         YU(3) = MINY - 12
      ENDIF
      YU(2) = YU(1)
      YU(4) = YU(3)
      XU(5) = XU(1)
      YU(5) = YU(1)
      END
