* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
C
*
      SUBROUTINE INPUT_ASC(FICH,NFILE,ERROR,DATA_TYPE)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
      CHARACTER*(*) FICH
      INTEGER   NFILE
      LOGICAL   ERROR, DATA_TYPE
*
      REAL*8    EPOCHFR,EPOCHTO,AMAT(9),AVEC(3),BVEC(3)
      REAL*8    RA_FROM,DEC_FROM,RA_DAY,DEC_DAY, UT1, UT2
      REAL*8    D_RA1,D_DEC1,D_RA2,D_DEC2,DELTA_RA,DELTA_DEC
*
      INTEGER*4 POINTER,IADDRSUBSCAN,IP1
      INTEGER*4 IADRBLOC(100),IPBLOC,IP,IPSUBSCAN_TMP
*     INTEGER(KIND=4) DESC_MAPCELL(9),IP_MAPCELL
      INTEGER*4 IP_SKYUT, IP_SKYTAU
*
      INTEGER   RCMAX                    ! length for format (F10,1X,F10,1X,F8,n
      PARAMETER   (RCMAX=10+1+10+1+8+ NREC*16 +10)
      CHARACTER*(RCMAX) LINE
      CHARACTER STRING*300, MONTH(12)*3, TEXT*80, SAVE_STRING*80
      CHARACTER C*1, D*1
*
      INTEGER*4 IER, SIC_GETLUN, SIC_FRELUN, SIC_GETVM, IDATE
      INTEGER*4 IMONTH1, FOUND_SCAN, PNT
      INTEGER*4 IOS,J,I,SL1,SL2,SL3,SL4,SB1,SB2,SB3,SB4, SIC_OPEN
      LOGICAL   OFF,STATE,COMPARE
      LOGICAL   RECORD_2PHASES
*     LOGICAL   FOUND
*
      INTEGER*4 NRECORD_BLOC,IRECORD,NBLOC,IBLOC,N
      INTEGER*4 LEN_RECORD,LENGTH, ISCAN
*     REAL      XINC
      REAL      OPACITY_GRADIENT, UT3, UT4
      INTEGER   OLD_FLAG, LUN
      INTEGER   MAX_SEG
      INTEGER   NPARAM_SUBSCAN
      LOGICAL   JY_STATE
      PARAMETER (MAX_SEG=100)
*
      DATA MONTH /'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
     $'SEP','OCT','NOV','DEC'/
      DATA C /':'/
      DATA D /'.'/
*
* Close useless files
*
      CALL STANDARD_VARIABLES (.FALSE.,.TRUE.)
      IF (INPUTSTREAM.NE.0) THEN
         CALL CLOSE_STREAM(INPUTSTREAM)
         INPUTSTREAM = 0
      ENDIF
      IF (ILUN.GT.0 .AND. FICH.NE.OLD_FILENAME) THEN
         CLOSE(UNIT=ILUN)
         IER = SIC_FRELUN(ILUN)
         ILUN = 0
      ENDIF
*
* Delete old SIC variables
*
*      OFF = .TRUE.
*      CALL HEADER_VARIABLES(OFF,.FALSE.)
*      CALL BOLOMETER_VARIABLES(OFF,.FALSE.)
*      CALL ANTENNA_VARIABLES(OFF,.FALSE.)
*      CALL CALIBRATION_VARIABLES(OFF,.FALSE.)
*      CALL SKYDIP_VARIABLES(OFF,.FALSE.)
*      CALL DATA_VARIABLES(OFF,.FALSE.)
*      CALL FLAG_VARIABLES(OFF,.FALSE.)
      CALL SIC_LET_DBLE('BEAMSEP',0,ERROR)     ! beamsep = 0
*
      OLD_FLAG = 0
      IF (IADDRRECORD.NE.0) THEN
         OLD_FLAG = NCHAN
         CALL R4TOR4(MEMORY(IP_FLAG),RECEIVER_FLAG(1),NCHAN)
         IF (DATA_SHMID.NE.0)
     $   CALL REMOVE_MEMORY(DATA_SHMID,IADDRRECORD)
         DATA_SHMID=0
         IADDRRECORD = 0
      ENDIF
      IF (IADDRSPIKE.NE.0) THEN
         LENGTH = NCHAN + 2*LENGTH_SPIKE*NCHAN
         CALL FREE_VM(LENGTH,IADDRSPIKE)
         IADDRSPIKE = 0
      ENDIF
      IF (IADDR_SUBFLAG.NE.0) THEN
         LENGTH = NCHAN*NSUBSCAN*2
         CALL FREE_VM(LENGTH,IADDR_SUBFLAG)
         IADDR_SUBFLAG = 0
      ENDIF
*
      SCAN_NUMBER=-1
      NRECORD = 0
*
* Open new file
*
      IF (FICH.NE.OLD_FILENAME) THEN
         IER = SIC_GETLUN(ILUN)
         IF (IER.NE.1) THEN
            ERROR=.FALSE.
            CALL MESSAGE(8,4,'INPUT_ASC','No logical unit left')
            RETURN
         ENDIF
C+VMS
c         OPEN(UNIT=ILUN,FILE=FICH,STATUS='old',RECL=RCMAX,
c     $   ERR=200,IOSTAT=IOS)
C-VMS
C+UNIX
         OPEN(UNIT=ILUN,FILE=FICH,STATUS='old',
     $   ERR=200,IOSTAT=IOS)
C-UNIX
         OLD_FILENAME = FICH
      ELSE
         REWIND(ILUN)
      ENDIF
*
*
* Read header
*
      DATA_FORMAT = FORMAT_ASC
*
      WOBBLER_DEVICE = 0
      WOBBLER_PERIOD = 0
      WOBBLER_THROW  = -999
      ISRP1          = -999              ! assume not set at all
      ISRP2          = -999              ! assume not set at all
      ISR1OPTFLAG    = -999              ! assume not set at all
      ISR2OPTFLAG    = -999              ! assume not set at all
      PROJECT_NAME = 'unknown'
*
      DO WHILE (LINE(2:).NE.'EndOfHeaderData')
         READ(ILUN,'(a)',END=100)LINE
         IF (LINE(2:11).EQ.'SourceName') THEN
            SOURCE_NAME = LINE(13:)
         ELSEIF (LINE(2:5) .EQ.'SLAM' ) THEN
            READ(LINE(7:),*) SOURCE_LAMBDA
         ELSEIF (LINE(2:5) .EQ.'SBET' ) THEN
            READ(LINE(7:),*) SOURCE_BETA
         ELSEIF (LINE(2:10).EQ.'Telescope') THEN
            TELESCOPE=LINE(12:40)
            IF (INDEX(TELESCOPE,'HHT').NE.0) TELESCOPE='HHT'
*
         ELSEIF (LINE(2:7).EQ.'Format') THEN
            RECORD_2PHASES = .FALSE.
            IF (INDEX(LINE,'2>').NE.0)
     $      RECORD_2PHASES =.TRUE.
            SCAN_COORD_FOUND = .FALSE.
            IF (INDEX(LINE,'SCAN_COORD').NE.0)
     $      SCAN_COORD_FOUND =.TRUE.
            IF (LINE(9:11).EQ.'LST') THEN
               IS_LST = .TRUE.
            ELSE
               IS_LST = .FALSE.
            ENDIF
            IF (.NOT.IS_LST) WRITE(6,*) 'UT converted to LST'
         ELSEIF (LINE(2:11) .EQ.'ScanNumber' ) THEN
            READ(LINE(13:),*) SCAN_NUMBER
         ELSEIF (LINE(2:6) .EQ.'EPOCH' ) THEN
            READ (LINE (8:),*) EPOCH
         ELSEIF (LINE(2:9) .EQ.'Channels' ) THEN
            READ (LINE (11:),*) N_RECEIVERS
            NCHAN       = N_RECEIVERS
            NCALPOW     = 0
            IF (N_RECEIVERS.GT.7.AND.N_RECEIVERS.LT.19) THEN
               NCHAN   = 7
               NCALPOW = N_RECEIVERS-NCHAN
            ENDIF
            IF (N_RECEIVERS.GT.19.AND.N_RECEIVERS.LT.37) THEN
               NCHAN   = 19
               NCALPOW = N_RECEIVERS-19
            ENDIF
            IF (N_RECEIVERS.GT.37) THEN
               NCHAN   = 37
               NCALPOW = N_RECEIVERS-37
            ENDIF
         ELSEIF (LINE(2:5).EQ.'Date') THEN
            READ(LINE(7:8),*) IDAY
            READ(LINE(10:11),*) IMONTH
            READ(LINE(13:16),*) IYEAR
            DATE_OF_OBSERVATION = IDAY+IMONTH*100+
     $      IYEAR*10000
            VAX_PROCESSED = .FALSE.
            IF (INDEX(LINE,'VAX_TO_NMB').NE.0)
     $      VAX_PROCESSED=.TRUE.
            IF (.NOT.VAX_PROCESSED)
     $      WRITE(6,*)'Not processed by VAX_TO_NMB'
         ELSEIF (LINE(2:10).EQ.'Frequency') THEN
            READ (LINE(12:),*) FREQUENCY
         ELSEIF (LINE(2:5).EQ.'Gain') THEN
            READ (LINE(7:),*) REFERENCE_GAIN
*
         ELSEIF (LINE(2:6) .EQ.'Dumps' ) THEN
            READ(LINE(8:),*) NBI
         ELSEIF (LINE(2:5) .EQ.'OLAM' ) THEN
            READ(LINE(7:),*) OLAM
         ELSEIF (LINE(2:5) .EQ.'VLAM' ) THEN
            READ(LINE(7:),*) VLAM
         ELSEIF (LINE(2:5) .EQ.'OBET' ) THEN
            READ(LINE(7:),*) OBET
         ELSEIF (LINE(2:5) .EQ.'SAZM' ) THEN
            READ(LINE(7:),*) SAZM
         ELSEIF (LINE(2:5) .EQ.'OAZM' ) THEN
            READ(LINE(7:),*) OAZM
         ELSEIF (LINE(2:5) .EQ.'VAZM' ) THEN
            READ(LINE(7:),*) VAZM
         ELSEIF (LINE(2:5) .EQ.'OELV' ) THEN
            READ(LINE(7:),*) OELV
         ELSEIF (LINE(2:5) .EQ.'VELV' ) THEN
            READ(LINE(7:),*) VELV
         ELSEIF (LINE(2:5) .EQ.'SINT' ) THEN
            READ(LINE(7:),*) SINT
         ELSEIF (LINE(2:5) .EQ.'SBAS' ) THEN
            READ(LINE(7:),*) ISBAS
         ELSEIF (LINE(2:5) .EQ.'DAZM' ) THEN
            READ(LINE(7:),*) DAZM
*
         ELSEIF (LINE(2:5) .EQ.'SRP1' ) THEN
            READ(LINE(7:),*) ISRP1
         ELSEIF (LINE(2:11) .EQ.'SR1OPTFLAG' ) THEN
            READ(LINE(13:),*) ISR1OPTFLAG
*
         ELSEIF (LINE(2:5) .EQ.'SRP2' ) THEN
            READ(LINE(7:),*) ISRP2
         ELSEIF (LINE(2:11) .EQ.'SR2OPTFLAG' ) THEN
            READ(LINE(13:),*) ISR2OPTFLAG
*
         ELSEIF (LINE(2:9) .EQ.'PRESSURE' ) THEN
            READ(LINE(11:),*) AMBIENT_PRESSURE
         ELSEIF (LINE(2:12) .EQ.'TEMPERATURE' ) THEN
            READ(LINE(14:),*) AMBIENT_TEMPERATURE
         ELSEIF (LINE(2:9) .EQ.'HUMIDITY' ) THEN
            READ(LINE(11:),*) HUMIDITY
         ELSEIF (LINE(2:5) .EQ.'NULA' ) THEN
            READ(LINE(7:),*) PNULA
         ELSEIF (LINE(2:5) .EQ.'NULE' ) THEN
            READ(LINE(7:),*) PNULE
*
         ELSEIF (LINE(2:8) .EQ.'COLSTAR' ) THEN
            READ(LINE(10:),*) COLSTAR
*
         ELSEIF (LINE(2:15) .EQ.'WobblingDevice' ) THEN
            READ(LINE(17:),*) WOBBLER_DEVICE
         ELSEIF (LINE(2:14) .EQ.'WobblingAmpli' ) THEN
            READ(LINE(16:),*) WOBBLER_THROW
         ELSEIF (LINE(2:15) .EQ.'WobblingPeriod' ) THEN
            READ(LINE(17:),*) WOBBLER_PERIOD
         ELSEIF (INDEX(LINE,'Project').NE.0 ) THEN
            PROJECT_NAME = LINE(INDEX(LINE,'Project')+8:)
*
         ENDIF
      ENDDO
*
*
      SCAN_TYPE = 6
      IF (ISRP1.GT.2.AND.ISRP2.EQ.1)       SCAN_TYPE = 1   ! ON-OFF
      IF (VAZM.NE.0)                       SCAN_TYPE = 2   ! ON-THE-FLY
      IF (ISRP1.EQ.1.AND.ISR1OPTFLAG.EQ.1) SCAN_TYPE = 3   ! SKYDIP
      IF (ISRP1.EQ.2.AND.ISRP2.EQ.2)       SCAN_TYPE = 4   ! POINTING
      IF (ISRP1.EQ.2.AND.ISRP2.EQ.1)       SCAN_TYPE = 5   ! FOCUS
      IF (SOURCE_NAME(1:9).EQ.'RASTERDIP'.AND.SCAN_TYPE.EQ.3)
     $SCAN_TYPE = 9                      ! RASTERDIP
      IF (SCAN_TYPE.EQ.5.AND.DAZM.GT.1E-8) SCAN_TYPE = 1   ! ONOFF
c     if (wobbler_throw.eq.0.and.scan_type.eq.6) scan_type = 6
*
      IF (INDEX(TELESCOPE,'Pico Veleta').NE.0) THEN
         SITE_ALTITUDE  = 2850           ! (m)
         SITE_LATITUDE  = (37D0+4/6D1+5.6/36D2)/180*PI     ! (rad)
         SITE_LONGITUDE = -3.39954257D0/180*PI ! (rad)
         TELESCOPE_DIAMETER = 30         ! (m)
      ELSEIF (INDEX(TELESCOPE,'CSO').NE.0) THEN
         SITE_ALTITUDE  = 4200           ! (m)
         SITE_LATITUDE  = (19D0+46/6D1+36/36D2)/180*PI     ! (rad)
         SITE_LONGITUDE = -(155D0+28/6D1+18/36D2)/180*PI   ! (rad)
         TELESCOPE_DIAMETER = 10         ! (m)
      ELSEIF (INDEX(TELESCOPE,'HHT').NE.0) THEN
         SITE_ALTITUDE  = 3178           ! (m)
         SITE_LATITUDE  = (32D0+42/6D1+5/36D2)/180*PI! (rad)
         SITE_LONGITUDE = -(109D0+52/6D1+26/36D2)/180*PI   ! (rad)
         TELESCOPE_DIAMETER = 10         ! (m)
      ENDIF
*
      COORDINATE_SYSTEM = ISBAS
      IF (SCAN_TYPE.LE.2.AND.(COORDINATE_SYSTEM.LE.4.OR.
     $(COORDINATE_SYSTEM.GE.6.AND.COORDINATE_SYSTEM.LE.9))) THEN
         CALL POSITION (SL1,SL2,SL3,SL4,SB1,SB2,SB3,SB4)
         WRITE (FIELD_CENTER,
     $   '(2(i2.2,a),i2.2,a,i3.3,x,I3.2,2(A,I2.2),A,I2.2)')
     $   SL1,C,SL2,C,SL3,D,SL4,SB1,C,SB2,C,SB3,D,SB4
      ELSE
         FIELD_CENTER = ' '
      ENDIF
*
* Flag Section -----------------------
*
*
*     GAIN_ELEV_FLAG     = .FALSE.
*     GAIN_RECEIVER_FLAG = .FALSE.
*     OPACITY_FLAG       = .FALSE.
*     AMPLI_FLAG         = .FALSE.
*     JANSKY_FLAG        = .FALSE.
      NOISE_REMOVAL_FLAG = .FALSE.
      DO I=1,NCHAN
         SPIKE_REMOVAL_FLAG(I) = -1
      ENDDO
*
* Bolometer Section -----------------------
*
      DO I = 1,NCHAN
         RECEIVER_NUMBER(I) = I
      ENDDO
*
*
* Total Power Section -----------------------
*
      IF (NCALPOW.NE.0) THEN
         DO I = 1,NCALPOW
            CALPOW_NUMBER(I) = I
            CALPOW_FLAG(I)   = .FALSE.
            CALPOW_GAIN(I)   = 1.
         ENDDO
      ENDIF
*
*
*
* Read subscan information
*
      READ(ILUN,'(a)',END=100)LINE
      IF (LINE(2:14).EQ.'SUBSCANFORMAT') THEN
         NSUBSCAN = 0
         READ(ILUN,'(a)',END=100)LINE
         DO WHILE (LINE(2:).NE.'EndOfSubScanData')
            NSUBSCAN = NSUBSCAN+1
            READ(ILUN,'(a)',END=100)LINE
         ENDDO
         WRITE (6,*) 'Number of subscans: ',NSUBSCAN
         SUBSCAN_NUMBER = NSUBSCAN
*
*
         IER = SIC_GETVM(NSUBSCAN*3,IADDRSUBSCAN)
         IPSUBSCAN=POINTER(IADDRSUBSCAN,MEMORY)
*
         REWIND(ILUN)
         DO WHILE (LINE(2:14).NE.'SUBSCANFORMAT')
            READ(ILUN,'(a)',END=100) LINE
         ENDDO
         IP = IPSUBSCAN
         READ(ILUN,'(a)',END=100) LINE
         DO WHILE (LINE(2:).NE.'EndOfSubScanData')
            READ(LINE,*) MEMORY(IP),RMEMORY(IP+NSUBSCAN),
     $      RMEMORY(IP+2*NSUBSCAN)
            IP = IP+1
            READ(ILUN,'(a)',END=100) LINE
         ENDDO
      ENDIF
      IF (.NOT.IS_LST) CALL UTST(MEMORY(IPSUBSCAN+2*NSUBSCAN),NSUBSCAN,
     $IDAY,IMONTH,IYEAR,SITE_LONGITUDE/DEG_TO_RAD)
*
*
* Read data
      DO WHILE (LINE(2:14).NE.'RawDataFormat')
         READ(ILUN,'(a)',END=100)LINE
      ENDDO
      NRECORD = 0
      NBLOC=0
      NRECORD_BLOC=1000
*
      LEN_RECORD = 5+N_RECEIVERS         ! UT/LST,AZ,EL,SCAN_COORD[2] and n chan
      IF (RECORD_2PHASES) THEN
         LEN_RECORD = 5+2*NCHAN+NCALPOW
      ENDIF
*
      READ(ILUN,'(a)',END=100)LINE
      DO WHILE (LINE(2:).NE.'EndOfRawData')
         NBLOC = NBLOC+1
         IER = SIC_GETVM (NRECORD_BLOC*LEN_RECORD,IADRBLOC(NBLOC))
         IRECORD = 0
         IPBLOC = POINTER(IADRBLOC(NBLOC),MEMORY)
         DO WHILE (IRECORD.LT.NRECORD_BLOC .AND.
     $      LINE(2:).NE.'EndOfRawData')
            READ(LINE,*) (RMEMORY(IPBLOC+(J-1)),J=1,LEN_RECORD)
            IPBLOC = IPBLOC+LEN_RECORD
            IRECORD = IRECORD+1
            NRECORD = NRECORD+1
            READ(ILUN,'(a)',END=100)LINE
         ENDDO
      ENDDO
*
100   CONTINUE
      WRITE(6,*) 'Number of records: ',NRECORD
*
* Allocate shared memory for :
*    - 3 parameters to describe structure of shared memory :
*        n_receivers, nparam(=5), nparam_subscan(=4)
*    - NPARAM parameters :
*         receiver_az_offset(nchan)
*         receiver_el_offset(nchan)
*         receiver_flag(nchan)
*         receiver_rms(nchan)
*         receiver_gain(nchan)
*    - subscan info : subscan_number,subscan_epoch,subscan_time,flag
*    - LST,AZ,EL,SIGNAL,SCAN_COORD,MDB and EKH support
*
      NRECORD_ALLOCATED = NRECORD
      NPARAM  = 5
      NPARAM_SUBSCAN = 4
      LENGTH = 3 + NCHAN*NPARAM + NSUBSCAN*NPARAM_SUBSCAN +
     $NRECORD_ALLOCATED*LEN_RECORD
      IF (SCAN_TYPE.EQ.2) LENGTH = LENGTH+ 6*MAX_SEG*NCHAN+2     ! support
      CALL CREATE_SHARED_MEMORY(DATA_SHMID,LENGTH*4)
      CALL ATTACH_MEMORY(DATA_SHMID,IADDRRECORD)
      IP   = POINTER(IADDRRECORD,MEMORY)
      CALL R4TOR4(N_RECEIVERS,MEMORY(IP),1)
      CALL R4TOR4(NPARAM,MEMORY(IP+1),1)
      CALL R4TOR4(NPARAM_SUBSCAN,MEMORY(IP+2),1)
      IPPARAM   = IP +3
      IPSUBSCAN_TMP = IPSUBSCAN          ! save ipsubscan
      IPSUBSCAN = IPPARAM   + NPARAM*NCHAN
      IPRECORD  = IPSUBSCAN + NPARAM_SUBSCAN*NSUBSCAN
! Allocate memory to store 2 phases
      IF (RECORD_2PHASES) THEN
         IER = SIC_GETVM (2*NRECORD*NCHAN,IADDR_PHASES)
         IF (IER.NE.1) THEN
            CALL MESSAGE (2,1,'FILE','Memory allocation failure')
            RETURN
         ENDIF
         IP_PHASE1 = POINTER(IADDR_PHASES,MEMORY)
         IP_PHASE2 = IP_PHASE1 + NRECORD*NCHAN
      ENDIF
*
*
* Update data :
*
*
*   Subscan information
      CALL R4TOR4(MEMORY(IPSUBSCAN_TMP),MEMORY(IPSUBSCAN),NSUBSCAN*3)
*
*   LST,AZ,EL,SCAN_COORD,support
      IP_LST    = IPRECORD
      IP_AZ     = IP_LST + NRECORD
      IP_EL     = IP_AZ  + NRECORD
      IP_SIGNAL = IP_EL  + NRECORD
      IP_CALPOW = IP_SIGNAL + NCHAN*NRECORD
      IP_SCAN_COORD = IP_SIGNAL + NRECORD*N_RECEIVERS
      IF (SCAN_TYPE.EQ.2) THEN           ! ON-THE-FLY
         IP_MDB_SUPPORT = IP_SCAN_COORD  + NRECORD*2
         IP_EKH_SUPPORT = IP_MDB_SUPPORT + 4*MAX_SEG*NCHAN + 1
         CALL RAZ_MEMORY(MEMORY(IP_MDB_SUPPORT),6*MAX_SEG*NCHAN+2)
      ENDIF
      IP = IPRECORD
      N  = NRECORD_BLOC
      IP1= IP_PHASE1
      DO IBLOC=1,NBLOC
         IPBLOC = POINTER(IADRBLOC(IBLOC),MEMORY)
         IF (IBLOC.EQ.NBLOC) N = IRECORD ! if last bloc
         CALL UPDATE_DATA(RMEMORY(IPBLOC),RMEMORY(IP),RMEMORY(IP1),N,
     $   LEN_RECORD,RECORD_2PHASES)
         IP = IP+N
         IP1= IP1+N
      ENDDO
*      DO IBLOC=1,NBLOC
*         IPBLOC = POINTER(IADRBLOC(IBLOC),MEMORY)
*         IF (IBLOC.EQ.NBLOC) N = IRECORD ! if last bloc
*         CALL UPDATE_DATA(RMEMORY(IPBLOC),RMEMORY(IP),N,LEN_RECORD,
*     $   NRECORD_ALLOCATED,RECORD_2PHASES)
*         IP = IP+N
*      ENDDO
*
*   Gain-elevation curve and Receivers offsets and gain
*
      IP_AZOFF = IPPARAM
      IP_ELOFF = IP_AZOFF + NCHAN
      IP_FLAG  = IP_ELOFF + NCHAN
      IP_RMS   = IP_FLAG  + NCHAN
      IP_GAIN  = IP_RMS   + NCHAN
      FIELD_ROTATION = 1                 ! default (Pico Veleta)
      IF (TELESCOPE(1:3).EQ.'CSO') THEN
         CALL INIT_OFFSET_GAIN_SHARC(RECEIVER_AZ_OFFSET(1),
     $   RECEIVER_EL_OFFSET(1),RECEIVER_GAIN(1),NCHAN,TEXT)
         GAIN_ELEV_FLAG = .FALSE.        ! no correction applied
         FIELD_ROTATION = 0
      ELSEIF (TELESCOPE(1:3).EQ.'HHT') THEN
         CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)     ! added UT1 to arg list
         CALL INIT_OFFSET_GAIN_HHT(RECEIVER_AZ_OFFSET(1),  ! 06-mars-2000 hwi
     $   RECEIVER_EL_OFFSET(1),RECEIVER_GAIN(1),NCHAN,TEXT,UT1)
         GAIN_ELEV_FLAG = .FALSE.        ! no correction applied
         FIELD_ROTATION = -1
      ELSE                               ! pico veleta
         CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)
         CALL INIT_OFFSET_GAIN(RECEIVER_AZ_OFFSET(1),
     $   RECEIVER_EL_OFFSET(1),RECEIVER_GAIN(1),NCHAN,TEXT,
     $   UT1)
         CALL INIT_GAIN_ELEVATION(GAIN_ELEV)
      ENDIF
*
* Check for file nic.fit
*
      IER = SIC_GETLUN(LUN)
      IER = SIC_OPEN(LUN,'nic.fit','old',.FALSE.)
      IF (IER.EQ.0) THEN
         FOUND_SCAN = -1
300      READ (LUN,'(a)',ERR=350,END=400) STRING
         IF (INDEX(STRING,'! Scan:').NE.0) THEN
            SAVE_STRING = STRING
            READ (STRING(9:12),'(i4)',ERR=350,END=350) ISCAN
            I = INDEX(STRING,'Date: ')+6
            READ (STRING(I:I+1),'(i2)',ERR=350,END=350) IDATE
            I = I+3
            DO J=1,12
               IF (STRING(I:I+2).EQ.MONTH(J)) IMONTH1 = J
            ENDDO
            IDATE = IDATE+100*IMONTH1
            I = I+4
            READ (STRING(I:I+3),'(i4)',ERR=350,END=350) J
            IDATE = IDATE+J*10000
            IF (DATE_OF_OBSERVATION.LT.IDATE) GOTO 300
            CALL R4TOR4 (MEMORY(IP_LST),UT4,1)
            CALL STUT (UT4,1,IDAY,IMONTH,IYEAR,
     $      SITE_LONGITUDE/DEG_TO_RAD)
            I = INDEX(STRING,'Time: ')+6
            READ (STRING(I:I+6),'(f7.1)',ERR=350,END=350) UT3
            IF (DATE_OF_OBSERVATION.EQ.IDATE.AND.
     $      UT3-UT4.GT.1) GOTO 300       ! one second enough ?
*
* Get Az, El and Gain
*
310         READ (LUN,'(a)',ERR=350,END=350) STRING
            IF (INDEX(STRING,'! Az:').EQ.0) GOTO 310
            DO J=1,NCHAN
               READ (STRING((J-1)*8+7:J*8+6),'(f8.2)',ERR=350,END=350)
     $         RECEIVER_AZ_OFFSET(J)
            ENDDO
320         READ (LUN,'(a)',ERR=350,END=350) STRING
            IF (INDEX(STRING,'! El:').EQ.0) GOTO 320
            DO J=1,NCHAN
               READ (STRING((J-1)*8+7:J*8+6),'(f8.2)',ERR=350,END=350)
     $         RECEIVER_EL_OFFSET(J)
            ENDDO
330         READ (LUN,'(a)',ERR=350,END=350) STRING
            IF (INDEX(STRING,'! Ga:').EQ.0) GOTO 330
            DO J=1,NCHAN
               READ (STRING((J-1)*8+7:J*8+6),'(f8.2)',ERR=350,END=350)
     $         RECEIVER_GAIN(J)
            ENDDO
            FOUND_SCAN = ISCAN
            TEXT = SAVE_STRING
         ENDIF
         GOTO 400
350      CALL MESSAGE (2,1,'INIT',
     $   'File NIC.FIT is corrupted or incomplete')
400      CLOSE (LUN)
         IF (FOUND_SCAN.NE.-1) THEN
            WRITE (STRING,'(a,i4.4,a)')
     $      'Beam parameter retrieved from scan [',FOUND_SCAN,
     $      '] in NIC.FIT'
            CALL MESSAGE (2,1,'BEAM',STRING)
            TEXT = TEXT(15:)
         ENDIF
      ENDIF
*
* Copy offset and gain in shared memory
*
      CALL R4TOR4(RECEIVER_AZ_OFFSET(1),MEMORY(IP_AZOFF),NCHAN)
      CALL R4TOR4(RECEIVER_EL_OFFSET(1),MEMORY(IP_ELOFF),NCHAN)
      CALL R4TOR4(RECEIVER_GAIN(1),MEMORY(IP_GAIN),NCHAN)
      IF (OLD_FLAG.EQ.0 .OR. OLD_FLAG.NE.NCHAN) THEN
         DO I=1,NCHAN
            RECEIVER_FLAG(I) = .FALSE.
         ENDDO
      ENDIF
      CALL R4TOR4(RECEIVER_FLAG(1),MEMORY(IP_FLAG),
     $NCHAN)
      CALL RAZ_MEMORY(MEMORY(IP_RMS),NCHAN)    !receiver_rms
*
*
* Compute number of records per subscan
*
*DB-02-06-95      IER =  SIC_GETVM (NSUBSCAN,SUBREC)
*DB-02-06-95      IPSUBREC = POINTER (SUBREC,MEMORY)
      IPSUBREC = IPSUBSCAN + 3*NSUBSCAN
      CALL RECORDS_IN_SUBSCAN (MEMORY(IPSUBREC),MEMORY(IPSUBSCAN),
     $MEMORY(IPSUBSCAN+2*NSUBSCAN),NSUBSCAN,MEMORY(IPRECORD),
     $MEMORY(IP_SCAN_COORD))
*
* Allocate memory for spike data
*
      LENGTH_SPIKE = 1000
      LENGTH = NCHAN + 2*NCHAN*LENGTH_SPIKE
      IER = SIC_GETVM (LENGTH,IADDRSPIKE)
      IPSPIKE = POINTER(IADDRSPIKE,MEMORY)
      CALL RAZ_MEMORY(MEMORY(IPSPIKE),LENGTH)
*
* Allocate memory for subscan flags
*
      LENGTH = NCHAN*NSUBSCAN*2
      IER = SIC_GETVM (LENGTH,IADDR_SUBFLAG)
      IP = POINTER(IADDR_SUBFLAG,MEMORY)
      CALL RAZ_MEMORY(MEMORY(IP),LENGTH)
*
* Free useless memory
*
      DO IBLOC=1,NBLOC
         CALL FREE_VM(NRECORD_BLOC*LEN_RECORD,IADRBLOC(IBLOC))
      ENDDO
      CALL FREE_VM(NSUBSCAN*3,IADDRSUBSCAN)
*
* Special processing for ON-THE-FLY scans
*
      IF (SCAN_TYPE.EQ.2 .AND. SINT.GT.1.E-20) THEN
*-------Transform UT in LST if required
         IF (.NOT.IS_LST) CALL UTST (MEMORY(IPRECORD),NRECORD,
     $   IDAY,IMONTH,IYEAR,SITE_LONGITUDE/DEG_TO_RAD)
*-------Compute SCAN_COORDINATE if Drumbeat .NMB file
         IF (.NOT.VAX_PROCESSED.AND..NOT.SCAN_COORD_FOUND) THEN
*----------Computes RA_DAY and DEC_DAY (1st method)
            RA_FROM = SOURCE_LAMBDA
            DEC_FROM = SOURCE_BETA
c            write(6,*)ra_from,dec_from
            EPOCHFR = EPOCH
            CALL R4TOR8(MEMORY(IPSUBSCAN+NSUBSCAN),EPOCHTO,1)
c            write(6,*)'epochfr,epochto',epochfr,epochto
            CALL PRECMAT(EPOCHFR,EPOCHTO,AMAT) ! compute precession matrix
            CALL DCOSIN(RA_FROM,DEC_FROM,AVEC) ! compute vector
            CALL MATMUL(AMAT,AVEC,BVEC,-9)     ! multiply by precession matrix
            CALL DANGLE(RA_DAY,DEC_DAY,BVEC)   !
c            PRINT *,'RA OF DATE = ',RA_DAY,' DEC OF DATE =',DEC_DAY
*----------Precession (2nd method. seems to give better results)
            D_RA1 = SOURCE_LAMBDA*DEG_TO_RAD
            D_DEC1= SOURCE_BETA*DEG_TO_RAD
            CALL MOVE1(NINT(EPOCH),IYEAR,IMONTH,IDAY,
     $      D_RA1,D_DEC1,DELTA_RA,DELTA_DEC,0.D0)
*          Calculate again with ra and dec corresponding to the mean period
            D_RA2 = D_RA1  + 0.5D0*DELTA_RA
            D_DEC2= D_DEC1 + 0.5D0*DELTA_DEC
            CALL MOVE1(1950,IYEAR,IMONTH,IDAY,
     $      D_RA2,D_DEC2,DELTA_RA,DELTA_DEC,0.D0)
            RA_DAY  = (D_RA1 +DELTA_RA) /DEG_TO_RAD
            DEC_DAY = (D_DEC1+DELTA_DEC)/DEG_TO_RAD
c            PRINT *,'RA OF DATE = ',RA_DAY,' DEC OF DATE =',DEC_DAY
*----------Compute scan_coordinates
            CALL INIT_XYCOORD (RA_DAY,DEC_DAY,
     $      MEMORY(IP_AZ),MEMORY(IP_EL),
     $      MEMORY(IP_SCAN_COORD),
     $      MEMORY(IP_SCAN_COORD+NRECORD),
     $      MEMORY(IP_LST),SITE_LATITUDE,NRECORD)
         ENDIF
      ENDIF
      IF (SCAN_TYPE.NE.3.AND.JY_TO_COUNTS.NE.0.AND.JANSKY_FLAG) THEN
         JY_STATE=.FALSE.
         CALL DO_JY (MEMORY(IP_SIGNAL),JY_STATE,JY_TO_COUNTS)
      ENDIF
*
*
*   Initialize MAP_CELL  (if ON-THE-FLY scans)
*      IF (SCAN_TYPE.EQ.2) THEN     ! on-the-fly
*         XINC = VAZM * 0.5*60. + 0.5     ! xinc in arcsec, vazm in deg/min
*         XINC = INT(XINC)          ! xinc in arcsec
*         CALL SIC_DESCRIPTOR ('MAP_CELL', DESC_MAPCELL, FOUND)
*         IP_MAPCELL = POINTER(DESC_MAPCELL(2),MEMORY)
*         IF (XINC.GT.SINT) THEN
*            CALL R4TOR4(XINC,MEMORY(IP_MAPCELL),1)
*         ELSE
*            CALL R4TOR4(SINT,MEMORY(IP_MAPCELL),1)
*         ENDIF
*         CALL R4TOR4(SINT,MEMORY(IP_MAPCELL+1),1)
*      ENDIF
*
*
      CALL ANY_SKEW (MEMORY(IPSUBREC),MEMORY(IP_SCAN_COORD),
     $NSUBSCAN)
      OFF = .FALSE.
      CALL STANDARD_VARIABLES (OFF,.FALSE.)
      IF (SECTION(1).EQ.1) CALL HEADER_VARIABLES(OFF,.FALSE.)
      IF (SECTION(1).EQ.2) CALL HEADER_VARIABLES(OFF,.TRUE.)
      IF (SECTION(2).EQ.1) CALL BOLOMETER_VARIABLES(OFF,.FALSE.)
      IF (SECTION(2).EQ.2) CALL BOLOMETER_VARIABLES(OFF,.TRUE.)
      IF (SECTION(3).EQ.1) CALL ANTENNA_VARIABLES(OFF,.FALSE.)
      IF (SECTION(3).EQ.2) CALL ANTENNA_VARIABLES(OFF,.TRUE.)
      IF (SECTION(4).EQ.1) CALL CALIBRATION_VARIABLES(OFF,.FALSE.)
      IF (SECTION(4).EQ.2) CALL CALIBRATION_VARIABLES(OFF,.TRUE.)
      IF (SECTION(5).EQ.1) CALL FLAG_VARIABLES(OFF,.FALSE.)
      IF (SECTION(5).EQ.2) CALL FLAG_VARIABLES(OFF,.TRUE.)
      IF (SECTION(6).EQ.1) CALL SKYDIP_VARIABLES(OFF,.FALSE.)
      IF (SECTION(6).EQ.2) CALL SKYDIP_VARIABLES(OFF,.TRUE.)
      IF (SECTION(7).EQ.1) CALL FIT_VARIABLES(OFF,.FALSE.)
      IF (SECTION(7).EQ.2) CALL FIT_VARIABLES(OFF,.TRUE.)
      IF (SECTION(8).EQ.1) CALL DATA_VARIABLES(OFF,.FALSE.)
      IF (SECTION(8).EQ.2) CALL DATA_VARIABLES(OFF,.TRUE.)
*
      ANY_BASE = .FALSE.
      STATE = .FALSE.
      IF (AMPLI_FLAG) CALL DO_AM (MEMORY(IP_SIGNAL),STATE,
     $NINT(REFERENCE_GAIN))
      GAIN_REC = .FALSE.
      IF (GAIN_RECEIVER_FLAG) CALL DO_GR (MEMORY(IP_SIGNAL),
     $MEMORY(IP_GAIN))
      IF (COMPARE (MEMORY(IP_GAIN),BEAM_GAIN(1)).AND.
     $GAIN_RECEIVER_FLAG)
     $CALL MESSAGE (2,1,'BEAM',TEXT)
      CALL R4TOR4 (MEMORY(IP_GAIN),BEAM_GAIN(1),NCHAN)
      STATE = .FALSE.
      IF (GAIN_ELEV_FLAG.AND.SCAN_TYPE.NE.3) CALL DO_GE (MEMORY(IP_EL),
     $MEMORY(IP_SIGNAL),GAIN_ELEV,STATE)
      SCAN_OPACITY = 0
      IF (OPACITY_FLAG) THEN
         CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)
         CALL GET_SCAN_UT (UT2,MEMORY(IP_LST),NRECORD)
         ATMOSPHERIC_OPACITY = MANUAL_OPACITY
         OPACITY_GRADIENT = 0
         IF (NUMBER_OF_SKYDIPS.GT.0.AND.MANUAL_OPACITY.EQ.0) THEN
            IP_SKYUT = POINTER(SKYDIP_MEM,MEMORY)
            IP_SKYTAU = IP_SKYUT + 2*NUMBER_OF_SKYDIPS     ! double precision
            CALL GET_OPACITY (UT1,MEMORY(IP_SKYUT),
     $      MEMORY(IP_SKYTAU),NUMBER_OF_SKYDIPS,
     $      ATMOSPHERIC_OPACITY,OPACITY_GRADIENT,DATA_TYPE)
         ENDIF
         IF (ATMOSPHERIC_OPACITY.GT.1)
     $   CALL MESSAGE (2,1,'OPACITY','Crazy atmosphere')
         IF (ATMOSPHERIC_OPACITY.LT.0)THEN
            CALL MESSAGE (2,1,'OPACITY',
     $      'no correction applied (Undefined ?)')
            RETURN
         ENDIF
         STATE = .FALSE.
         CALL DO_OP (MEMORY(IP_SIGNAL),MEMORY(IP_EL),STATE,
     $   ATMOSPHERIC_OPACITY,OPACITY_GRADIENT,UT1,UT2,DATA_TYPE)
         OLD_OPACITY = ATMOSPHERIC_OPACITY
         OLD_OPACITY_GRADIENT = OPACITY_GRADIENT
         OLD_UT1 = UT1
         OLD_UT2 = UT2
      ENDIF
*
* Update MDB and EKH support
      IF (SCAN_TYPE.EQ.2 .AND. IADDR_SUPPORT.NE.0) THEN
         CALL R4TOR4(MEMORY(IP_CNV_SUPPORT),PNT,1)
         CALL UPDATE_MDB_EKH_SUPPORT(PNT,
     $   MEMORY(IP_CNV_SUPPORT+1),MEMORY(IP_CNV_SUPPORT+1+PNT),
     $   ERROR)
      ENDIF
      RETURN
*
*
200   ERROR = .FALSE.
      CALL MESSAGE(6,3,'INPUT_ASC','Input file open failed')
c      write (6,'('' NIC%-E, File not existing'')')
c      write(6,*) 'iostat=',ios
      OLD_FILENAME = ' '
      RETURN
*
*99   CALL MESSAGE (8,4,'INPUT_ASC','Not enough memory ')
*     DO IBLOC=1,NBLOC-1
*       CALL FREE_VM(NRECORD_BLOC*LEN_RECORD,IADRBLOC(IBLOC))
*     ENDDO
*     CALL FREE_VM(NSUBSCAN*3,IADDRSUBSCAN)
*     RETURN
*
      END
