* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
*
      SUBROUTINE INPUT_NMB(FICH,NFILE,ERROR,DATA_TYPE)
*
      INCLUDE 'nmb.inc'
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
      CHARACTER*(*) FICH
      CHARACTER FILENAME*80, STRING*400, MONTH(12)*3, TEXT*80
      CHARACTER SAVE_STRING*80, C*1, D*1
      INTEGER*4 NFILE
      LOGICAL ERROR, STATE, COMPARE, DATA_TYPE
*
      INTEGER*4 POINTER
      INTEGER*4 IPBLOC,IP,IP1
      INTEGER*4 IP_INPUTSTREAM,IP_SUBSCANS_TOP
      INTEGER*4 LEN_DATA
      INTEGER*4 IADRBLOC(100)
*     INTEGER(KIND=4) DESC_MAPCELL(9),IP_MAPCELL
      INTEGER*4 IP_SKYUT, IP_SKYTAU
*
      REAL*8    LONGITUDE, UT1, UT2
      REAL*8    EPOCHFR,EPOCHTO,AMAT(9),AVEC(3),BVEC(3)
      REAL*8    RA_FROM,DEC_FROM,RA_DAY,DEC_DAY
      REAL*8    D_RA1,D_DEC1,D_RA2,D_DEC2,DELTA_RA,DELTA_DEC
*
      INTEGER*4 I, SL1,SL2,SL3,SL4,SB1,SB2,SB3,SB4
      INTEGER*4 SIC_FRELUN,SIC_GETVM,IER,SIC_OPEN,SIC_GETLUN
      INTEGER*4 IDATE, J, IMONTH1, ISCAN, LUN, FOUND_SCAN
      INTEGER   NPARAM_SUBSCAN
      LOGICAL   OFF
      LOGICAL   RECORD_2PHASES
*     LOGICAL   FOUND
*
*
      INTEGER*4 NRECORD_BLOC,IRECORD,NBLOC,IBLOC,N
      INTEGER*4 LEN_RECORD,LENGTH
*     REAL      XINC
      INTEGER   OLD_FLAG
      INTEGER   ID,IM,IY,DATE_OF_VAXTONMB
      INTEGER   PNT
      REAL*4    UT, OPACITY_GRADIENT, UT3, UT4
      INTEGER   MAX_SEG
      PARAMETER (MAX_SEG=100)
      REAL*4    VAL
      INTEGER   IL
      REAL      FACTOR
      LOGICAL   JY_STATE
*
      DATA MONTH /'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG',
     $'SEP','OCT','NOV','DEC'/
      DATA C /':'/
      DATA D /'.'/
      DATA OLD_FLAG /0/
      SAVE OLD_FLAG
*
* Close previous file
*
      IF (INPUTSTREAM.NE.0) THEN
         CALL CLOSE_STREAM(INPUTSTREAM)  ! close file immediately
         INPUTSTREAM = 0
      ENDIF
*
      IF (ILUN.GT.0) THEN
         CLOSE(UNIT=ILUN)
         IER = SIC_FRELUN(ILUN)
         ILUN = 0
      ENDIF
*
* Open new file
      FILENAME = FICH
      FILENAME(NFILE+1:NFILE+1)=CHAR(0)
*
C+UNIX
      CALL OPEN_STREAM(FILENAME,INPUTSTREAM)
C-UNIX
C+VMS
c      CALL OPEN_STREAM(%REF(FILENAME),INPUTSTREAM)
C-VMS
      IF (INPUTSTREAM.EQ.0) THEN
         OLD_FILENAME = ' '
         CALL MESSAGE(6,3,'INPUT_NMB',
     $   'Open failed on file '//FILENAME)
         ERROR =.FALSE.
         SCAN_NUMBER = -1
         RETURN
      ENDIF
      OLD_FILENAME = FICH
*
* Initialization for header data
*
*DB:07-02-97 CALL STANDARD_VARIABLES (.FALSE.,.TRUE.)
      DO I=1,20
         HEADER_PREHEADER(I) = ' '
      ENDDO
      HEADER_SOURCENAME = ' '
*
* Delete old SIC variables and free allocated memory
*
      NRECORD = 0
*      OFF = .TRUE.
*      CALL STANDARD_VARIABLES (OFF,.FALSE.)
*      CALL HEADER_VARIABLES(OFF,.FALSE.)
*      CALL BOLOMETER_VARIABLES(OFF,.FALSE.)
*      CALL ANTENNA_VARIABLES(OFF,.FALSE.)
*      CALL CALIBRATION_VARIABLES(OFF,.FALSE.)
*      CALL SKYDIP_VARIABLES(OFF)
*      CALL DATA_VARIABLES(OFF,.FALSE.)
*      CALL FLAG_VARIABLES(OFF,.FALSE.)
*      CALL SIC_LET_DBLE('BEAMSEP',0,ERROR)     ! beamsep = 0
*
      SCAN_NUMBER=-1
*fev2000      OLD_FLAG = 0
*
      IF (IADDR_SUBFLAG.NE.0) THEN
         IP = POINTER(IADDR_SUBFLAG,MEMORY)
         CALL FREE_SUBSCAN_MEMORY(MEMORY(IPSUBREC),MEMORY(IP))
         LENGTH = NSUBSCAN*NCHAN*2       ! address array (nchan*nsubscan)
         CALL FREE_VM(LENGTH,IADDR_SUBFLAG)
         IADDR_SUBFLAG = 0
      ENDIF
      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_PHASES.NE.0) THEN
         LENGTH = 2*NCHAN*NRECORD
         CALL FREE_VM(LENGTH,IADDR_PHASES)
         IADDR_PHASES = 0
      ENDIF
*
      HEADER_WOBBLINGAMPLI = -999
*
C Read Header
*
      MULTIBYTEMODE=0
      IP_INPUTSTREAM=POINTER(INPUTSTREAM,MEMORY)
C+UNIX
      CALL GETHEADERINFORMATION(MULTIBYTEMODE,MULTIBYTENUM,
     $MULTIBYTETEXT,
     $HEADER_STRUCT,MEMORY(IP_INPUTSTREAM),ERRORSTATUS)
*      WRITE(6,*)'after getheaderinfo'
C-UNIX
C+VMS
c      CALL GETHEADERINFORMATION(MULTIBYTEMODE,MULTIBYTENUM,
c     $%REF(MULTIBYTETEXT),
c     $HEADER_STRUCT,MEMORY(IP_INPUTSTREAM),ERRORSTATUS)
C-VMS
*
* Header Section -----------------------------
*
c     project_code
      SOURCE_NAME    = HEADER_SOURCENAME
      SOURCE_LAMBDA  = HEADER_LAMBDA(1)
      SOURCE_BETA    = HEADER_BETA(1)
c     source_flux 		! (jy)
      TELESCOPE      = HEADER_PREHEADER(2)(12:40)
      IF (INDEX(TELESCOPE,'Pico Veleta').NE.0 .OR.
     $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
      DATA_FORMAT    = FORMAT_NMB
      SCAN_NUMBER    = HEADER_SCANNUMBER
      WRITE (6,'('' Defaulted to '',i4.4,''.nmb'')') SCAN_NUMBER
*
      SCAN_TYPE = 6
      IF (HEADER_SRP(1).GT.2.AND.HEADER_SRP(2).EQ.1) SCAN_TYPE = 1     ! ON-OFF
      IF (HEADER_AZIMUTH(3).NE.0) SCAN_TYPE = 2! ON-THE-FLY
      IF (HEADER_SRP(1).EQ.1.AND.HEADER_SRP(3).EQ.1) SCAN_TYPE = 3     ! SKYDIP
      IF (HEADER_SRP(1).EQ.2.AND.HEADER_SRP(2).EQ.2) SCAN_TYPE = 4     ! POINTING
      IF (HEADER_SRP(1).EQ.2.AND.HEADER_SRP(2).EQ.1) SCAN_TYPE = 5     ! FOCUS
      IF (SCAN_TYPE.EQ.5.AND.HEADER_DAZM.GT.1E-8)    SCAN_TYPE = 1     ! ON-OFF
      IF (SOURCE_NAME(1:6).EQ.'SKYPAD')              SCAN_TYPE = 8     ! SKYPAD
      IF (SOURCE_NAME(1:9).EQ.'RASTERDIP'.AND.SCAN_TYPE.EQ.3)
     $SCAN_TYPE = 9                      ! RASTERDIP
      IF (HEADER_WOBBLINGAMPLI.EQ.0.AND.SCAN_TYPE.EQ.6) SCAN_TYPE = 6
c     data_size
c     data_address
      EPOCH          = HEADER_EPOCH
      COORDINATE_SYSTEM = HEADER_SBAS
      DATE_OF_OBSERVATION = HEADER_DATE(1)*10000+
     $HEADER_DATE(2)*100+
     $HEADER_DATE(3)
      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
c     name_of_reducer
      N_RECEIVERS = HEADER_CHANNELS
      NCHAN       = N_RECEIVERS
      IF (N_RECEIVERS.GT.7.AND.N_RECEIVERS.LT.19) THEN
         NCHAN   = 7
      ENDIF
      IF (N_RECEIVERS.GT.19.AND.N_RECEIVERS.LT.37.AND.
     $TELESCOPE(1:3).NE.'CSO') THEN
         NCHAN   = 19
      ENDIF
      IF (N_RECEIVERS.GT.37.AND.N_RECEIVERS.LT.117) THEN
         NCHAN   = 37
      ENDIF
      IF (N_RECEIVERS.GT.117) THEN
         NCHAN   = 117
      ENDIF
      NCALPOW = N_RECEIVERS - NCHAN
*
      IS_LST = .TRUE.
      DO IL=1,20
         IF (INDEX(HEADER_PREHEADER(IL),'FORMAT').NE.0 .AND.
     $   INDEX(HEADER_PREHEADER(IL),'UT').NE.0)
     $   IS_LST =.FALSE.
      ENDDO
*
      SCAN_COORD_FOUND = .FALSE.
      DO IL=1,20
         IF (INDEX(HEADER_PREHEADER(IL),'FORMAT').NE.0 .AND.
     $   INDEX(HEADER_PREHEADER(IL),'SCAN_COORD').NE.0)
     $   SCAN_COORD_FOUND =.TRUE.
      ENDDO
*
      RECORD_2PHASES = .FALSE.
      DO IL=1,20
         IF (INDEX(HEADER_PREHEADER(IL),'FORMAT').NE.0 .AND.
     $   INDEX(HEADER_PREHEADER(IL),'2>').NE.0)
     $   RECORD_2PHASES =.TRUE.
      ENDDO
*
      VAX_PROCESSED = .TRUE.
*DB:23-05-95  IF (INDEX(HEADER_PREHEADER(1),'VAX_TO_NMB').NE.0)
*            $VAX_PROCESSED=.TRUE.
      IF (.NOT.IS_LST) VAX_PROCESSED = .FALSE. ! UT only for DRUMBEAT files
*
      IF (.NOT.VAX_PROCESSED)
     $WRITE(6,*)'Not processed by VAX_TO_NMB'
      IF (.NOT.IS_LST) WRITE(6,*)'UT converted to LST'
*
* Find old nmb files which are not compatible with NIC software
*
      IF (INDEX(HEADER_PREHEADER(1),'VAX_TO_NMB').EQ.0 .AND.
     $INDEX(HEADER_PREHEADER(1),'NIC').EQ.0) THEN
         IF ((SCAN_TYPE.EQ.2 .OR. SCAN_TYPE.EQ.4 .OR. SCAN_TYPE.EQ.5)
     $   .AND.IS_LST) THEN
            WRITE(6,*)'Old NMB format. Cannot be reduced by NIC'
            CALL CLOSE_STREAM(INPUTSTREAM)     ! close file immediately
            INPUTSTREAM =0
            RETURN
         ENDIF
      ENDIF
*
* Correct date if files have been processed by VAX_TO_NMB before 14-3-96
*
      I = INDEX(HEADER_PREHEADER(1),'Version')
      IF (I.NE.0) THEN
         READ(HEADER_PREHEADER(1)(I+12:I+13),*)ID
         READ(HEADER_PREHEADER(1)(I+15:I+16),*)IM
         READ(HEADER_PREHEADER(1)(I+18:I+21),*)IY
         DATE_OF_VAXTONMB = IY*10000+IM*100+ID
      ENDIF
*
* Project name
*
      PROJECT_NAME = 'unknown'
      DO IL=1,20
         I = INDEX(HEADER_PREHEADER(IL),'PROJECT')
         IF (I.NE.0) PROJECT_NAME = HEADER_PREHEADER(IL)(I+8:)
      ENDDO
*
* Bolometer Section -----------------------
*
      DO I = 1,NCHAN
         RECEIVER_NUMBER(I) = I
      ENDDO
      IF (TELESCOPE(1:3).EQ.'CSO') THEN
         REFERENCE_RECEIVER = -1
         DO IL=1,20
            I = INDEX(HEADER_PREHEADER(IL),'REF')
            IF (I.NE.0) READ(HEADER_PREHEADER(IL)(I+4:I+5),*)
     $      REFERENCE_RECEIVER
         ENDDO
         IF (REFERENCE_RECEIVER.EQ.-1) THEN
            CALL MESSAGE (2,1,'FILE','No reference channel defined')
            CALL MESSAGE (2,1,'FILE','Using channel 12 by default')
            REFERENCE_RECEIVER = 12
         ENDIF
      ENDIF
      REFERENCE_GAIN     = HEADER_GAIN
      FREQUENCY          = HEADER_FREQUENCY
*
* Antenna Section -------------------------
*
      WOBBLER_DEVICE     = 0
      WOBBLER_PERIOD     = 0
      WOBBLER_THROW      = 0
      IF (HEADER_WOBBLINGAMPLI.NE.0.AND.
     $HEADER_WOBBLINGAMPLI.NE.-999) THEN
         WOBBLER_DEVICE  = HEADER_WOBBLINGDEVICE
         WOBBLER_PERIOD  = HEADER_WOBBLINGPERIOD
         WOBBLER_THROW   = HEADER_WOBBLINGAMPLI
      ENDIF
*
* Calibration Section ----------------------
*
*     Gain is initialized by routine INIT_OFFSET_GAIN()
*
* 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
*
* Total Power Section -----------------------
*
      IF (NCALPOW.NE.0) THEN
         DO I = 1,NCALPOW
            CALPOW_FLAG(I)   = .FALSE.
            CALPOW_GAIN(I)   = 1.
         ENDDO
         CALPOW_NUMBER(1) = 1
         CALPOW_NUMBER(2) = 17
         CALPOW_NUMBER(3) = 32
      ENDIF
*
*
* Parameters used by MAKPLAN
      NBI = 1
      DO IL=1,20
         I = INDEX(HEADER_PREHEADER(IL),'DUMPS')
         IF (I.NE.0) READ(HEADER_PREHEADER(IL)(I+6:I+6),*) NBI
      ENDDO
      IDAY  = HEADER_DATE(3)
      IMONTH = HEADER_DATE(2)
      IYEAR = HEADER_DATE(1)
*
      OLAM  = HEADER_LAMBDA(2)
      VLAM  = HEADER_LAMBDA(3)
      OBET  = HEADER_BETA(2)
      SAZM  = HEADER_AZIMUTH(1)
      OAZM  = HEADER_AZIMUTH(2)
      VAZM  = HEADER_AZIMUTH(3)
      OELV  = HEADER_ELEVATION(2)
      VELV  = HEADER_ELEVATION(3)
      SINT  = ABS(HEADER_SINT)
      DAZM  = HEADER_DAZM
      ISRP2 = HEADER_SRP(2)
      ISR1OPTFLAG = HEADER_SRP(3)
      AMBIENT_PRESSURE    = HEADER_PRESSURE
      AMBIENT_TEMPERATURE = HEADER_TEMPERATURE
      HUMIDITY            = HEADER_HUMIDITY
      REFRACTION          = HEADER_REFRACTION
      PNULA = HEADER_NULA
      PNULE = HEADER_ NULE
      COLSTAR = HEADER_COLSTAR
      IF (SCAN_TYPE.EQ.5.AND.DAZM.GT.1E-8) SCAN_TYPE = 1   ! ONOFF
*
C Read Subscan Information
C+UNIX
*      WRITE(6,*)'before  GETSUBSCANINFORMATION'
      CALL GETSUBSCANINFORMATION(MULTIBYTEMODE,MULTIBYTENUM,
     $MULTIBYTETEXT,
     $MEMORY(IP_INPUTSTREAM), ERRORSTATUS, STARTTIME,
     $SUBSCANS_TOP)
*      WRITE(6,*)'after  GETSUBSCANINFORMATION'
C-UNIX
C+VMS
c      CALL GETSUBSCANINFORMATION(MULTIBYTEMODE,MULTIBYTENUM,
c     $%REF(MULTIBYTETEXT),
c     $MEMORY(IP_INPUTSTREAM), ERRORSTATUS, STARTTIME,
c     $SUBSCANS_TOP)
C-VMS
*
      IP_SUBSCANS_TOP = POINTER(SUBSCANS_TOP,MEMORY)
      CALL FINDNOOFSUBSCANS(MEMORY(IP_SUBSCANS_TOP),NSUBSCAN)
      WRITE(6,*) 'Number of subscans: ',NSUBSCAN
      SUBSCAN_NUMBER = NSUBSCAN
      IF (NSUBSCAN.LE.0) THEN
         NRECORD = 0
         CALL CLOSE_STREAM(INPUTSTREAM)  ! close file immediately
         INPUTSTREAM =0
         RETURN
      ENDIF
*
*
C Read records
      ERRORSTATUS = 0
      NRECORD = 0
      NBLOC=0
      NRECORD_BLOC=1000
      LEN_RECORD = 5+N_RECEIVERS         ! UT/LST,AZ,EL,2*SCAN_COORD and n chann
      IF (RECORD_2PHASES) THEN
         LEN_RECORD = 5+2*NCHAN+NCALPOW
      ENDIF
      IF (SCAN_COORD_FOUND) THEN
         LEN_DATA   = N_RECEIVERS
         IF (RECORD_2PHASES) LEN_DATA =  N_RECEIVERS+NCHAN
      ELSEIF (SCAN_TYPE.EQ.4 .OR.
     $(SCAN_TYPE.EQ.2 .AND. VAX_PROCESSED)) THEN
         LEN_DATA   = N_RECEIVERS+2
      ELSEIF (SCAN_TYPE.EQ.5) THEN       ! if focus
         LEN_DATA   = N_RECEIVERS+1
      ELSE
         LEN_DATA   = N_RECEIVERS
      ENDIF
      DO WHILE (ERRORSTATUS.EQ.0)
         NBLOC = NBLOC+1
         IER = SIC_GETVM (NRECORD_BLOC*LEN_RECORD,IADRBLOC(NBLOC))
         IRECORD = 0
         IPBLOC = POINTER(IADRBLOC(NBLOC),MEMORY)
         IF (SCAN_COORD_FOUND) THEN
            DO WHILE (IRECORD.LT.NRECORD_BLOC .AND.
     $         (ERRORSTATUS.EQ.0))
*
C+UNIX
               CALL GETNMBRECORD(MULTIBYTEMODE,MULTIBYTENUM,
     $         MULTIBYTETEXT,
     $         MEMORY(IP_INPUTSTREAM),
     $         LEN_DATA,
     $         MEMORY(IPBLOC),
     $         ERRORSTATUS)
C-UNIX
C+VMS
c               CALL GETNMBRECORD(MULTIBYTEMODE,MULTIBYTENUM,
c     $         %REF(MULTIBYTETEXT),
c     $         MEMORY(IP_INPUTSTREAM),
c     $         LEN_DATA,
c     $         MEMORY(IPBLOC),
c     $         ERRORSTATUS)
C-VMS
               IPBLOC  = IPBLOC+LEN_RECORD
               IRECORD = IRECORD+1
               NRECORD = NRECORD+1
            ENDDO
         ELSE
            DO WHILE (IRECORD.LT.NRECORD_BLOC .AND.
     $         (ERRORSTATUS.EQ.0))
*
C+UNIX
               CALL GETNMBRECORD_OLD(MULTIBYTEMODE,MULTIBYTENUM,
     $         MULTIBYTETEXT,
     $         MEMORY(IP_INPUTSTREAM),
     $         N_RECEIVERS,LEN_DATA,
     $         MEMORY(IPBLOC),
     $         ERRORSTATUS)
C-UNIX
C+VMS
c               CALL GETNMBRECORD_OLD(MULTIBYTEMODE,MULTIBYTENUM,
c     $         %REF(MULTIBYTETEXT),
c     $         MEMORY(IP_INPUTSTREAM),
c     $         N_RECEIVERS,LEN_DATA,
c     $         MEMORY(IPBLOC),
c     $         ERRORSTATUS)
C-VMS
               IPBLOC  = IPBLOC+LEN_RECORD
               IRECORD = IRECORD+1
               NRECORD = NRECORD+1
            ENDDO
         ENDIF
      ENDDO
*
      IRECORD = IRECORD-1
      NRECORD = NRECORD-1
      WRITE(6,*) 'Number of records: ',NRECORD
      IF (NRECORD.EQ.0) THEN
         CALL CLOSE_STREAM(INPUTSTREAM)
         INPUTSTREAM =0
         RETURN
      ENDIF
*
* 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,nsubrec
*    - 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 .OR. SCAN_TYPE.EQ.4)
     $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 = 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')
            CALL CLOSE_STREAM(INPUTSTREAM)
            INPUTSTREAM =0
            RETURN
         ENDIF
         IP_PHASE1 = POINTER(IADDR_PHASES,MEMORY)
         IP_PHASE2 = IP_PHASE1 + NRECORD*NCHAN
      ENDIF
*
*
* Update data :
*
*
*   Subscan information
*
      CALL COPYSUBSCANINFORMATION(MEMORY(IP_SUBSCANS_TOP),
     $MEMORY(IPSUBSCAN),MEMORY(IPSUBSCAN+NSUBSCAN),
     $MEMORY(IPSUBSCAN+2*NSUBSCAN))
      IF (.NOT.IS_LST) CALL UTST(MEMORY(IPSUBSCAN+2*NSUBSCAN),NSUBSCAN,
     $IDAY,IMONTH,IYEAR,SITE_LONGITUDE/DEG_TO_RAD)
*
*
*   LST,AZ,EL,SCAN_COORD,SUPPORT,UT
*
      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 .OR. SCAN_TYPE.EQ.4) 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
*
      IER = SIC_GETVM (NRECORD,IADDR_UT)
      IP_UT = POINTER (IADDR_UT,MEMORY)
*
      N  = NRECORD_BLOC
      IP = IPRECORD
      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
* If CSO data, multiply by 10  because data divided by 10 in sharc_to_nmb
      IF (TELESCOPE(1:3).EQ.'CSO') THEN
         FACTOR = 1
         DO IL=1,20
            I = INDEX(HEADER_PREHEADER(IL),'FACTOR')
            IF (I.NE.0)
     $      READ(HEADER_PREHEADER(IL)(I+7:),*) FACTOR
         ENDDO
         IF (FACTOR.NE.1) THEN
            DO I=1,NCHAN*NRECORD
               CALL R4TOR4(MEMORY(IP_SIGNAL+I-1),VAL,1)
               VAL = VAL/FACTOR
               CALL R4TOR4(VAL,MEMORY(IP_SIGNAL+I-1),1)
            ENDDO
         ENDIF
      ENDIF
*
*   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 value for 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              ! no rotation
      ELSEIF (TELESCOPE(1:3).EQ.'HHT') THEN
         CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)     ! hwi 06-mars-2000
         CALL INIT_OFFSET_GAIN_HHT(RECEIVER_AZ_OFFSET(1),
     $   RECEIVER_EL_OFFSET(1),RECEIVER_GAIN(1),NCHAN,TEXT,
     $   UT1)                            ! added UT1 to argument list - hwi 06-mars-2000
         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)
      IF (IER.NE.1) THEN
         WRITE(6,*)' Error getting unit for nic.fit'
         GOTO 99
      ENDIF
      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 300
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
      IER = SIC_FRELUN(LUN)
*
      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
* Correction of date for file converted before 03-1996
      CALL CHECK_DATE(DATE_OF_VAXTONMB,UT,
     $MEMORY(IP_LST+NRECORD-1),MEMORY(IPSUBSCAN+NSUBSCAN))
      DATE_OF_OBSERVATION = IYEAR*10000+ IMONTH*100+ IDAY
*
* 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 flagged subscans
*
      LENGTH = NCHAN*NSUBSCAN*2
      IER = SIC_GETVM (LENGTH,IADDR_SUBFLAG)
      IF (IER.NE.1) THEN
         CALL MESSAGE (2,1,'FILE','Memory allocation failure')
         CALL CLOSE_STREAM(INPUTSTREAM)
         INPUTSTREAM = 0
         RETURN
      ENDIF
      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
*
* Special processing for ON-THE-FLY scans
*
      IF ((SCAN_TYPE.EQ.2.AND.SINT.GT.1E-20).OR.     ! on-the-fly
     $(SCAN_TYPE.EQ.1.AND.DAZM.GT.1E-20)) THEN ! on-off
*
*  Transform UT in LST if required
*
         LONGITUDE = SITE_LONGITUDE/DEG_TO_RAD
         IF (.NOT.IS_LST) CALL UTST (MEMORY(IPRECORD),NRECORD,
     $   IDAY,IMONTH,IYEAR,LONGITUDE)
*
*  Compute SCAN_COORDINATE if Drumbeat .NMB file
*
         IF (.NOT.VAX_PROCESSED.AND..NOT.SCAN_COORD_FOUND) THEN
            IF (ABS(SOURCE_LAMBDA).LT.1.D-32 .AND.
     $      ABS(SOURCE_BETA)  .LT.1.D-32) THEN
               WRITE(6,*)
     $         ' *** SOURCE_LAMBDA = 0 and SOURCE_BETA =0 ***'
               WRITE(6,*) ' *** Unable to compute SCAN_COORD ***'
            ELSE
*
*  Compute RA_DAY and DEC_DAY (1st method)
*
               RA_FROM = SOURCE_LAMBDA
               DEC_FROM = SOURCE_BETA
*              WRITE(6,*) RA_FROM,DEC_FROM
               EPOCHFR = EPOCH
               CALL R4TOR8(MEMORY(IPSUBSCAN+NSUBSCAN),EPOCHTO,1)
               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)!
*              PRINT *,'RA OF DATE = ',RA_DAY,' DEC OF DATE =',DEC_DAY
*
*  Precession (2nd method. for comparaison)
*
               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
*              PRINT *,'RA OF DATE = ',RA_DAY,' DEC OF DATE =',DEC_DAY
*
*  Compute SCAN_COORDINATE
*
               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
      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
*
* 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(IP_LST),
     $MEMORY(IP_SCAN_COORD))
      CALL R4TOR4(MEMORY(IP_LST),MEMORY(IP_UT),NRECORD)
      CALL STUT (MEMORY(IP_UT),NRECORD,IDAY,IMONTH,IYEAR,
     $SITE_LONGITUDE/DEG_TO_RAD)
*
*   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)
*RN      IF (XINC.GT.SINT) THEN
*         IF (XINC.LT.SINT) THEN
*            CALL R4TOR4(XINC,MEMORY(IP_MAPCELL),1)
*            CALL R4TOR4(XINC,MEMORY(IP_MAPCELL+1),1) !*RN
*         ELSE
*            CALL R4TOR4(SINT,MEMORY(IP_MAPCELL),1)
*            CALL R4TOR4(SINT,MEMORY(IP_MAPCELL+1),1) !*RN
*         ENDIF
*RN      CALL R4TOR4(SINT,MEMORY(IP_MAPCELL+1),1)
*      ENDIF
*
* End
      SKEW = 0
      IF (SCAN_TYPE.EQ.2.AND.TELESCOPE(1:3).NE.'CSO') THEN
         CALL ANY_SKEW (MEMORY(IPSUBREC),MEMORY(IP_SCAN_COORD),
     $   NSUBSCAN)
         IF (OELV.GT.0) SKEW = -SKEW
      ENDIF
      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.)
      IF (SECTION(9).EQ.1) CALL CALPOW_VARIABLES(OFF,.FALSE.)
      IF (SECTION(9).EQ.2) CALL CALPOW_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.AND.SCAN_TYPE.NE.8)
     $CALL DO_GE (MEMORY(IP_EL),MEMORY(IP_SIGNAL),GAIN_ELEV,STATE)
      SCAN_OPACITY = 0
      IF (OPACITY_FLAG.AND.SCAN_TYPE.NE.3.AND.SCAN_TYPE.NE.8) 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.AND.DATA_TYPE)
     $   CALL MESSAGE (2,1,'OPACITY','Crazy atmosphere')
         IF (ATMOSPHERIC_OPACITY.LT.0) THEN
            IF (DATA_TYPE) CALL MESSAGE (2,1,'OPACITY',
     $      'no correction applied (Undefined ?)')
         ELSE
            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
      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
      CALL CLOSE_STREAM(INPUTSTREAM)
      INPUTSTREAM = 0
      RETURN
*
99    CALL MESSAGE (8,4,'INPUT_NMB','Not enough memory ')
      DO IBLOC=1,NBLOC-1
         CALL FREE_VM(NRECORD_BLOC*LEN_RECORD,IADRBLOC(IBLOC))
      ENDDO
      RETURN
      END
*
***********************************************************************
*
      SUBROUTINE INIT_OFFSET_GAIN(AZ,EL,GAIN,NR,TEXT,UT_DATE)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      REAL*8   UT_DATE
      INTEGER  NR, EXPIRATION_DATE
      REAL*4   AZ(NREC),EL(NREC),GAIN(NREC)
*
      INTEGER     I,IREC,K
      INTEGER     NREF
      PARAMETER   (NREF=19)
      CHARACTER   IDENT(NREF)*53, TEXT*80
      INTEGER     DATE_REF(NREF)
      REAL*4      AZIM_REF(NREC,NREF)
      REAL*4      ELEV_REF(NREC,NREF)
      REAL*4      GAIN_REF(NREC,NREF)
      INTEGER     NCHAN_REF(NREF)
      REAL*4      X
*
      DATA   DATE_REF    /19930208, 19940401, 19941201,
     $19950201, 19950308, 19960111, 19960201, 19960228,
     $19961127, 19970123, 19970423, 19980107, 19980125,
     $19981201, 19990205, 19990208.5, 19990211.06, 19991203,
     $20000124/
*
      DATA   NCHAN_REF
     $/ 7,  7, 19,  7, 19,  7, 19, 19,  7, 19,
     $37, 37, 37, 37, 37, 37, 37, 37, 37/
*
*     DATA   EXPIRATION_DATE /19991224/
      DATA   EXPIRATION_DATE /20001009/
*
*
*  Date: 08-Feb-1993 / 7 channels
*
      DATA   (AZIM_REF(I,1), I=1,7) /
     $-18.31,-18.18, 0.00,-0.37, 19.23, 19.01,  0.12 /
      DATA   (ELEV_REF(I,1), I=1,7) /
     $9.98,-10.77, 0.00, 20.66, 10.74,-10.75,-21.76 /
      DATA   (GAIN_REF(I,1), I=1,7) /
     $1.18,  1.13,  1.00,  1.21,  0.91,  1.07,  1.08 /
      DATA   IDENT(1)
     $/'Using date: 08-Feb-1993 - 7 Beam parameter set'/
*
*  Date: 01-Apr-1994 / 7 channels
*
      DATA   (AZIM_REF(I,2), I=1,7) /
     $0.00, 21.30, 10.60,-10.70,-21.30,-10.60, 10.70 /
*      DATA   (ELEV_REF(I,2), I=1,7) /   ! ** change convention on 17-10-1995
*     $0.00,  0.10,-18.50,-18.40,  0.10, 18.40, 18.70 /
      DATA   (ELEV_REF(I,2), I=1,7) /
     $0.00,  -0.10, 18.50, 18.40, -0.10,-18.40,-18.70 /
      DATA   (GAIN_REF(I,2), I=1,7) /
     $1.00,  1.15,  1.04,  0.97,  0.92,  0.91,  1.09 /
      DATA   IDENT(2)
     $/'Using date: 01-Apr-1994 - 7 Beam parameter set'/
*
*  Date: 01-Dec-1994 / 19 channels
*
      DATA   (AZIM_REF(I,3), I=1,19) /
     $0.00,  5.88,-16.69,-22.20, -6.34, 16.23, 22.75, 11.39,
     $-11.00,-32.23,-38.57,-44.27,-29.13,-13.19, 10.03, 33.43,
     $40.13, 44.67, 28.12 /
*      DATA   (ELEV_REF(I,3), I=1,19) /   ! ** change convention on 17-10-1995
*     $0.00, 22.25, 16.30, -5.07,-21.98,-16.03,  6.00, 43.63,
*     $38.51, 32.71, 11.51,-10.70,-27.43,-43.50,-38.56,-32.79,
*     $-9.94, 12.96, 28.71 /
      DATA   (ELEV_REF(I,3), I=1,19) /
     $0.00,-22.25,-16.30,  5.07, 21.98, 16.03, -6.00,-43.63,
     $-38.51,-32.71,-11.51, 10.70, 27.43, 43.50, 38.56, 32.79,
     $9.94,-12.96,-28.71 /
      DATA   (GAIN_REF(I,3), I=1,19) /
     $1.000, 1.099, 0.987, 1.021, 1.081, 1.027, 1.144, 1.017,
     $1.107, 1.129, 1.009, 0.875, 1.046, 1.018, 1.141, 1.123,
     $1.098, 1.150, 1.226 /
      DATA   IDENT(3)
     $/'Using date: 01-Dec-1994 - 19 Beam parameter set'/
*
*  Date: 01-Feb-1995 / 7 channels
*
      DATA   (AZIM_REF(I,4), I=1,7) /
     $0.00, 20.56,  9.72,-11.03,-20.72, -9.92, 10.69 /
*      DATA   (ELEV_REF(I,4), I=1,7) /  ! ** change convention on 17-10-1995
*     $0.00, -0.74,-18.25,-17.44,  0.70, 18.21, 17.59 /
      DATA   (ELEV_REF(I,4), I=1,7) /
     $0.00,  0.74,  18.25, 17.44, -0.70,-18.21,-17.59 /
      DATA   (GAIN_REF(I,4), I=1,7) /
     $1.00,  1.21,  1.04,  1.10,  0.99,  1.09,  1.10 /
      DATA   IDENT(4)
     $/'Using date: 01-Feb-1995 - 7 Beam parameter set'/
*
*  Date: 08-Mar-1995 / 19 channels
*
      DATA   (AZIM_REF(I,5), I=1,19) /
     $0.00,-11.91, 11.36, 22.81, 45.75,-12.01,-23.34,-23.49,
     $-0.53, 22.81, 34.71, 11.06, 33.90, 21.51, -1.23,-23.81,
     $-34.99,-46.38,-34.85 /
*      DATA   (ELEV_REF(I,5), I=1,19) / ! ** change convention on 17-10-1995
*     $0.00, 20.24, 20.01,  0.39,  1.22,-19.98,  0.53, 39.72,
*     $39.72, 40.11, 20.64,-20.03,-19.19,-39.35,-39.52,-38.30,
*     $-18.53,  1.81, 20.52 /
      DATA   (ELEV_REF(I,5), I=1,19) /
     $0.00, -20.31,-20.07, 0.05, -0.44, 19.68, -0.58,-39.82,
     $-39.97,-39.89,-20.07, 19.74, 19.48, 39.17, 39.42, 38.51,
     $18.81, -1.41,-20.69 /
*      DATA   (GAIN_REF(I,5), I=1,19) /
*     $  1.000, 1.053, 1.044, 1.102, 1.184, 0.991, 1.090, 1.078,
*     $  1.167, 1.344, 1.206, 1.087, 1.138, 1.057, 1.065, 0.879,
*     $  0.978, 1.039, 1.117 /
      DATA   (GAIN_REF(I,5), I=1,19) /
     $1.000, 0.950, 0.958, 0.908, 0.844, 1.009, 0.918, 0.927,
     $0.857, 0.744, 0.829, 0.920, 0.878, 0.946, 0.939, 1.137,
     $1.023, 0.963, 0.896 /
      DATA   IDENT(5)
     $/'Using date: 08-Mar-1995 - 19 Beam parameter set'/
*
*  Date: 11-Jan-1996 / 7 channels
*
      DATA   (AZIM_REF(I,6), I=1,7) /
     $0.00,-11.95, 11.14, 22.57, 45.30,-12.43,-23.39 /
      DATA   (ELEV_REF(I,6), I=1,7) /
     $0.00, -20.24,-20.01, -0.39, -1.22, 19.98, -0.53 /
      DATA   (GAIN_REF(I,6), I=1,7) /
     $1.000, 0.950, 0.958, 0.908, 0.844, 1.009, 0.918 /
      DATA   IDENT(6)
     $/'Using date: 11-Jan-1996 - 7 Beam parameter set'/
*
*  Using date: 01-Feb-1996 / 19 channels
*
      DATA   (AZIM_REF(I,7), I=1,19) /
     $0.00, 34.40, -1.02, 10.94, 21.38,-23.80,45.33,
     $33.74,-45.75,-34.77,-12.13, 23.01,-0.18, 22.53,
     $-23.04, -11.61,-23.19,-34.55, 11.55 /
      DATA   (ELEV_REF(I,7), I=1,19) /
     $0.00, -19.75, 39.08, 19.84, 38.96, 38.13, 0.02,
     $20.09, -1.98, 18.24, 19.19, 0.08, -39.55, -39.16,
     $-39.27, -20.01, -0.90, -20.68, -19.87 /
      DATA   (GAIN_REF(I,7), I=1,19) /
     $1.000, .840, .877, .926, .909, 1.000, .870, 1.042, .961,
     $.990, .980, .909, .847, .794,  .943, .901,  .909, .901,
     $.943 /
      DATA   IDENT(7)
     $/'Using date: 01-Feb-1996 - 19 Beam parameter set'/
*
*
*  Date: 28-Feb-1996 / 19 channels
*
      DATA   (AZIM_REF(I,8), I=1,19) /
     $0.00, 35.39, -.68, 11.37, 21.79,-23.36,46.00,
     $33.81,-46.00,-33.81,-11.61, 23.42, 0.29, 23.59,
     $-22.54, -11.24,-22.94,-34.45, 11.62 /
      DATA   (ELEV_REF(I,8), I=1,19) /
     $0.00, -19.64, 39.03, 19.97, 39.12, 38.12, -0.17,
     $19.72, -1.09, 18.48, 19.63, 0.15, -39.38, -39.33,
     $-39.89, -20.23, -0.14, -20.42, -20.12 /
      DATA   (GAIN_REF(I,8), I=1,19) /
     $1.00, .97, .97, 1.03, .89, 0.98, .90, .94, 1.11,
     $.99, 1.09, 1.02, 1.01, .89,  1.08, .99,  .95, 1.01,
     $1.07 /
      DATA   IDENT(8)
     $/'Using date: 28-Feb-1996 - 19 Beam parameter set'/
*
*  Date: 27-Nov-1996 / 7 channels
*
      DATA   (AZIM_REF(I,9), I=1,7) /
     $0.00, 20.62, 10.51,-10.39,-20.74,-10.66, 10.05 /
      DATA   (ELEV_REF(I,9), I=1,7) /
     $0.00,  0.20, 17.88, 18.10,  0.28,-18.07,-18.09 /
      DATA   (GAIN_REF(I,9), I=1,7) /
     $1.000, 1.16, 1.05, 1.10, 0.95, 1.06, 1.07 /
      DATA   IDENT(9)
     $/'Using date: 27-Nov-1996 - 7 Beam parameter set'/
*
*  Using date: 23-Jan-1997 / 19 channels
*
      DATA   (AZIM_REF(I,10), I=1,19) /
     $0.00, 34.57,  0.66, 45.91, 23.05,-21.89, 11.98,
     $34.34,-46.14,-34.04,-11.26, 23.50,-0.62, 22.49,
     $-23.65, -11.99,-23.10,-35.20, 11.37 /
      DATA   (ELEV_REF(I,10), I=1,19) /
     $0.00, -20.76, 39.62, -1.38, 38.85, 39.76, 19.65,
     $18.43, 1.50,  20.79,  20.61, -.56, -39.76, -40.05,
     $-39.19, -19.99, 0.42, -19.18, -20.46 /
      DATA   (GAIN_REF(I,10), I=1,19) /
     $1.00, 0.86, 0.85, 0.85, 0.86, 0.92, 0.90, 0.84, 0.92,
     $1.03, 1.00, 0.90, 0.86, 0.77, 0.89, 0.91, 0.85, 0.86,
     $0.97/
      DATA   IDENT(10)
     $/'Using date: 23-Jan-1997 - 19 Beam parameter set'/
*
*  Using date: 24-Apr-1997 / 37 channels
*
      DATA   (AZIM_REF(I,11), I=1,37) /
     $-0.8,   9.7,  20.8,  10.3, -11.2, -22.7, -12.2, 19.3, 30.3, 40.8,
     $30.4,  20.1,  -0.3, -21.4, -32.7, -44.1,  28.7, 40.5, 50.7, 60.9,
     $51.5,  41.6,  31.1,   9.8, -10.4, -31.4, -41.9,-53.2,-64.4,-54.1,
     $-44.7,-34.7, -33.4, -23.7, -1.67, -12.8,   8.0/
      DATA   (ELEV_REF(I,11), I=1,37) /
     $-0.4, -18.4,   0.0,  17.9, 18.9,    0.0, -18.6,-37.3,-19.0, -1.0,
     $17.6,  36.0,  36.5,  36.9, 18.3,    0.0, -55.1,-37.5,-19.9, -1.2,
     $16.8,  35.5,  54.6,  54.0, 54.1,   54.5,  36.3, 17.4, -0.1, -18.8,
     $-36.2,-54.8, -18.4, -37.2,-36.6,  -55.1, -55.0/
      DATA   (GAIN_REF(I,11), I=1,37) /
     $1.0,   1.0,  1.0,  1.0,  1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
     $1.0,   1.0,  1.0,  1.0,  1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
     $1.0,   1.0,  1.0,  1.0,  1.0, 1.0, 1.0, 1.0, 1.0, 1.0,
     $1.0,   1.0,  1.0,  1.0,  1.0, 1.0, 1.0/
      DATA   IDENT(11)
     $/'Using date: 24-Apr-1997 - 37 Beam parameter set'/
*
*  Using date: 07-Jan-1998 / 37 channels
*
      DATA   (AZIM_REF(I,12), I=1,37) /
     $0.00,-11.20, 62.69,-20.90, 31.88,-42.29,-52.38,
     $-0.22, 52.86,-10.45,-31.71, 41.69,  0.52,-52.19,
     $11.06, 32.23, 31.44,-10.69,-21.53, 42.66, 52.45,
     $-41.75, 31.07, 10.61,-10.24,-30.92, 21.17,-62.19,
     $21.71, 21.23,-21.13,-31.62, 10.69,-31.73, 42.32,
     $-41.68, 10.26 /
      DATA   (ELEV_REF(I,12), I=1,37) /
     $0.00,-18.34,  0.39, 36.18, 18.67, -0.40,-18.49,
     $-36.16,-17.73, 18.56, 18.00, 36.52, 36.70, 17.61,
     $18.92,-17.94,-53.68,-53.95, -0.08,  0.22, 17.92,
     $35.74, 54.46, 54.46, 54.45, 54.28, 36.63, -0.55,
     $0.48,-36.14,-36.04,-53.94,-18.23,-18.31,-35.71,
     $-36.21,-54.13 /
      DATA   (GAIN_REF(I,12), I=1,37) /
     $1.000, 0.988, 0.858, 0.996, 0.978, 1.045, 1.173,
     $0.866, 0.898, 0.870, 0.886, 0.944, 0.898, 1.094,
     $0.978, 1.048, 0.915, 0.642, 1.006, 0.944, 0.886,
     $1.047, 0.822, 1.050, 1.234, 1.280, 1.032, 1.019,
     $1.015, 1.056, 0.991, 0.878, 1.136, 0.894, 0.810,
     $1.046, 0.900 /
      DATA   IDENT(12)
     $/'Using date: 07-Jan-1998 - 37 Beam parameter set'/
*
*  Using date: 25-Jan-1998 / 37 channels
*
      DATA   (AZIM_REF(I,13), I=1,37) /
     $0.00,-11.20, 62.69,-20.90, 31.88,-42.29,-52.38,
     $-0.22, 52.86,-10.45,-31.71, 41.69,  0.52,-52.19,
     $11.06, 32.23, 31.44,-10.69,-21.53, 42.66, 52.45,
     $-41.75, 31.07, 10.61,-10.24,-30.92, 21.17,-62.19,
     $21.71, 21.23,-21.13,-31.62, 10.69,-31.73, 42.32,
     $-41.68, 10.26 /
      DATA   (ELEV_REF(I,13), I=1,37) /
     $0.00,-18.34,  0.39, 36.18, 18.67, -0.40,-18.49,
     $-36.16,-17.73, 18.56, 18.00, 36.52, 36.70, 17.61,
     $18.92,-17.94,-53.68,-53.95, -0.08,  0.22, 17.92,
     $35.74, 54.46, 54.46, 54.45, 54.28, 36.63, -0.55,
     $0.48,-36.14,-36.04,-53.94,-18.23,-18.31,-35.71,
     $-36.21,-54.13 /
      DATA   (GAIN_REF(I,13), I=1,37) /
     $1.000, 0.874, 1.177, 0.804, 1.027, 0.816, 0.858,
     $0.880, 1.047, 0.858, 0.797, 1.240, 0.828, 0.826,
     $0.920, 1.000, 1.096, 0.596, 0.889, 1.002, 1.203,
     $0.871, 1.068, 0.998, 1.100, 1.191, 1.084, 0.967,
     $1.091, 0.986, 0.990, 0.881, 1.124, 0.834, 0.976,
     $0.892, 0.959 /
      DATA   IDENT(13)
     $/'Using date: 25-Jan-1998 - 37 Beam parameter set'/
*
*  Using date: 25-Jan-1998 / 37 channels
*
      DATA   (AZIM_REF(I,14), I=1,19) /
     $0.00,18.93,-38.17,0.41,-37.33,-38.09,-19.19,
     $-18.43,-0.18,-19.29,-19.61,-0.24, 37.86, 38.11,
     $37.34, 18.98, 0.12, 18.81, 19.38 /
      DATA   (ELEV_REF(I,14), I=1,19) /
     $0.00, 32.57, -0.13, 42.76, 22.06,-21.64, 10.75,
     $31.98,-43.94,-32.58,-10.97, 21.80, 0.44, 21.55,
     $-22.22,-11.33,-21.37,-33.19, 10.78 /
      DATA   (GAIN_REF(I,14), I=1,19) /
     $1.000, 0.850, 0.890, 0.890, 1.080, 0.950, 0.900,
     $0.940, 0.910, 0.950, 1.010, 0.930, 0.810, 0.760,
     $0.810, 0.900, 2.960, 0.820, 0.930 /
      DATA   IDENT(14)
     $/'Using date: 04-Dec-1998 - 19 Beam parameter set'/
*
*  Using date: 04-Dec-1998 / 19 channels
*
      DATA   (AZIM_REF(I,15), I=1,37) /
     $0.00, 55.07,-18.32, 37.73,  1.71, 17.06, 37.63,
     $16.10,  1.29,-34.89,-52.76,-34.40,-34.78,-36.54,
     $0.00, 17.73, 53.48,   .80, 18.95,-53.06,-17.49,
     $-36.04,  1.26,-52.04,  1.30,-16.81,-16.69,-17.13,
     $-52.75, 54.89, 19.53, 54.69, 38.18,  1.28, 17.63,
     $37.58,  .00 /
      DATA   (ELEV_REF(I,15), I=1,37) /
     $0.00,  -9.64,-32.09, 40.87, 20.87, 31.14,-18.35,
     $10.91, 41.96, 40.26, 29.90,-40.39,   .06, 20.09,
     $0.00,-30.22, 31.54,-19.63, 52.54,-31.10,-10.43,
     $-21.17, 61.25,  8.84,-64.21, 51.31, 29.77,-52.02,
     $-10.58, 10.95,-10.69,-29.19, -0.52,-41.45,-52.59,
     $20.41,   .00 /
      DATA   (GAIN_REF(I,15), I=1,37) /
     $1.000, 0.785, 0.878, 1.337, 1.046, 1.215, 1.154,
     $1.601, 0.873, 0.901, 0.963, 1.076, 1.016, 1.054,
     $1.000, 1.338, 0.991, 0.874, 0.967, 0.988, 1.003,
     $0.819, 1.176, 1.314, 1.307, 0.990, 1.188, 1.087,
     $1.008, 0.902, 0.924, 1.130, 0.978, 1.068, 1.515,
     $1.191, 1.000 /
      DATA   IDENT(15)
     $/'Using date: 05-Feb-1999 - 37 Beam parameter set'/
*
*  Using date: 05-Feb-1999 / 37 channels
*
      DATA   (AZIM_REF(I,16), I=1,37) /
     $0.00, 55.07,-18.32, 37.73,  1.71, 17.06, 37.63,
     $16.10,  1.29,-34.89,-52.76,-34.40,-34.78,-36.54,
     $0.00, 17.73, 38.18,  1.28, 17.63, 53.48,   .80,
     $18.95,-53.06,-17.49,-36.04,  1.26,-52.04,  1.30,
     $-16.81,-16.69,-17.13,-52.75, 54.89, 19.53, 54.69,
     $37.58,  .00 /
      DATA   (ELEV_REF(I,16), I=1,37) /
     $0.00,  -9.64,-32.09, 40.87, 20.87, 31.14,-18.35,
     $10.91, 41.96, 40.26, 29.90,-40.39,   .06, 20.09,
     $0.00,-30.22, -0.52,-41.45,-52.59, 31.54,-19.63,
     $52.54,-31.10,-10.43,-21.17, 61.25,  8.84,-64.21,
     $51.31, 29.77,-52.02,-10.58, 10.95,-10.69,-29.19,
     $20.41,   .00 /
      DATA   (GAIN_REF(I,16), I=1,37) /
     $1.000, 0.785, 0.878, 1.337, 1.046, 1.215, 1.154,
     $1.601, 0.873, 0.901, 0.963, 1.076, 1.016, 1.054,
     $1.000, 1.338, 0.978, 1.068, 1.515, 0.991, 0.874,
     $0.967, 0.988, 1.003,0.819, 1.176, 1.314, 1.307,
     $0.990, 1.188, 1.087,1.008, 0.902, 0.924, 1.130,
     $1.191, 1.000 /
      DATA   IDENT(16)
     $/'Using date: 08-Feb-1999 - 37 Beam parameter set'/
*
*  Using date: 08-Feb-1999 22 UT / 37 channels
*
      DATA   (AZIM_REF(I,17), I=1,37) /
     $0.00, 55.07,-18.32, 37.73,  1.71, 17.06, 37.63,
     $16.10,  1.29,-34.89,-52.76,-34.40,-34.78,-36.54,
     $0.00, 17.73, 53.48,   .80, 18.95,-53.06,-17.49,
     $-36.04,  1.26,-52.04,  1.30,-16.81,-16.69,-17.13,
     $-52.75, 54.89, 19.53, 54.69, 38.18,  1.28, 17.63,
     $37.58,  .00 /
      DATA   (ELEV_REF(I,17), I=1,37) /
     $0.00,  -9.64,-32.09, 40.87, 20.87, 31.14,-18.35,
     $10.91, 41.96, 40.26, 29.90,-40.39,   .06, 20.09,
     $0.00,-30.22, 31.54,-19.63, 52.54,-31.10,-10.43,
     $-21.17, 61.25,  8.84,-64.21, 51.31, 29.77,-52.02,
     $-10.58, 10.95,-10.69,-29.19, -0.52,-41.45,-52.59,
     $20.41,   .00 /
      DATA   (GAIN_REF(I,17), I=1,37) /
     $1.000, 0.785, 0.878, 1.337, 1.046, 1.215, 1.154,
     $1.601, 0.873, 0.901, 0.963, 1.076, 1.016, 1.054,
     $1.000, 1.338, 0.991, 0.874, 0.967, 0.988, 1.003,
     $0.819, 1.176, 1.314, 1.307, 0.990, 1.188, 1.087,
     $1.008, 0.902, 0.924, 1.130, 0.978, 1.068, 1.515,
     $1.191, 1.000 /
      DATA   IDENT(17)
     $/'Using date: 05-Feb-1999 - 37 Beam parameter set'/
*
*  Using date: 05-Feb-1999 / 37 channels
*
      DATA   (AZIM_REF(I,18), I=1,37) /
     $0.00, 53.43,-35.76, 18.12, -0.53,  0.45, 35.47,
     $1.26, 53.98,-36.26,-16.12,-54.54,-35.71,-36.58,
     $-0.67, 17.22,-54.43,  1.11, 18.18, 54.35, -0.24,
     $-35.24,-18.29,-54.00,-18.38,-18.29,-17.27, 0.27,
     $53.30, 36.36, 18.65,-53.75, 17.56,  0.27, 35.94,
     $17.86, 36.13 /
      DATA   (ELEV_REF(I,18), I=1,37) /
     $0.00,-10.88, 21.07,-10.45,-41.41, 21.39,-20.98,
     $62.01,  9.54,-19.87, 51.96, -9.33,  0.66,-40.60,
     $-61.18,-51.58,-29.67, 41.40, 10.58, 30.89,-20.61,
     $41.73, 10.57, 11.27,-10.06,-30.61, 31.46,  0.98,
     $-31.24, 40.90, 51.15, 31.30,-31.31,  0.98, 20.58,
     $30.78, -0.34 /
      DATA   (GAIN_REF(I,18), I=1,37) /
     $1.00, 0.88, 1.35, 0.92, 0.93, 1.37, 0.94,
     $1.35, 1.16, 1.15, 1.07, 1.03, 1.38, 0.92,
     $0.95, 0.97, 0.97, 0.92, 1.01, 1.36, 0.88,
     $1.18, 1.31, 1.16, 1.17, 0.90, 1.04, 0.00,
     $0.92, 1.12, 1.03, 1.23, 0.89, 0.00, 1.29,
     $1.22, 0.95 /
      DATA   IDENT(18)
     $/'Using date: 03-Dec-1999 - 37 Mambo II set'/
*
*  Using date: 03-Dec-1999 - 37 Mambo II set
*
      DATA   (AZIM_REF(I,19), I=1,37) /
     $0.00, 54.14,-35.86, 18.07, -0.07,  0.57, 36.12,
     $0.36, 53.83,-35.69,-16.81,-53.81,-35.49,-35.81,
     $0.53, 18.13,-53.95,  0.54, 18.15, 53.74, -0.32,
     $-35.79,-17.82,-53.98,-17.82,-17.97,-17.48,  0.0,
     $53.99, 35.96, 17.92,-54.27, 17.98,  0.0,  35.85,
     $17.76, 36.30 /
      DATA   (ELEV_REF(I,19), I=1,37) /
     $0.00, -9.69, 20.53, -9.77,-40.80, 22.05,-20.02,
     $61.97, 10.66,-19.93, 51.97, -9.92,  0.13,-40.37,
     $-60.73,-50.78,-29.97, 41.55, 10.91, 31.15,-20.72,
     $41.40, 11.21, 10.69, -9.69,-30.60, 31.25,  0.0 ,
     $-30.32, 41.33, 51.58, 31.60,-30.39,  0.0 , 21.34,
     $31.19,  0.85 /
      DATA   (GAIN_REF(I,19), I=1,37) /
     $1.00, 0.76, 1.29, 0.91, 0.91, 1.23, 0.93,
     $1.33, 0.93, 1.07, 1.03, 1.07, 1.49, 0.81,
     $0.87, 0.86, 0.90, 0.82, 0.94, 1.29, 0.83,
     $1.11, 1.00, 1.13, 1.06, 0.92, 1.03, 0.00,
     $0.85, 0.98, 0.87, 1.06, 0.87, 0.00, 0.89,
     $1.20, 0.93 /
      DATA   IDENT(19)
     $/'Using date: 28-Jan-2000 - 37 Mambo II set #131 Saturn'/
*
*  Using date: 24-Jan-2000 - 37 Mambo II set
*
* When adding further array parameters modify accordingly
* their guessed date of expiration.
*
* Default initialization for az,el,gain
*
      DO IREC =1,NR
         AZ(IREC)   = 0
         EL(IREC)   = 0
         GAIN(IREC) = 1
      ENDDO
      TEXT = "DEFAULT INITIALIZATION FOR AZ, EL, GAIN..."
*
* Initialize buffer according to date_of observation
*
      IF (UT_DATE.GE.EXPIRATION_DATE) THEN
         WRITE (6,'(a)') 'New Nasmyth configuration missing ...'
         WRITE (6,'(a)') 'Please consult IRAM at nic@iram.fr'
         RETURN
      ENDIF
      IF (UT_DATE.GE.DATE_REF(1)) THEN
         I = 1
         DO K=2,NREF
            IF (UT_DATE.GE.DATE_REF(K)) I = K
         ENDDO
         TEXT = IDENT(I)
         IF (NR.LE.7) THEN
            DO IREC=1,NR
               AZ(IREC)   = AZIM_REF(IREC,I)
               EL(IREC)   = ELEV_REF(IREC,I)
               GAIN(IREC) = GAIN_REF(IREC,I)
            ENDDO
         ELSE                            ! first channel can not be used
            CALL R4TOR4(MEMORY(IPRECORD+(3+18)*NRECORD),X,1)
            X = 2                        !*RN 25-02-1996
            IF (ABS(X).LT.1) THEN
               DO IREC=1,NR-1
                  AZ(IREC)   = AZIM_REF(IREC+1,I)
                  EL(IREC)   = ELEV_REF(IREC+1,I)
                  GAIN(IREC) = GAIN_REF(IREC+1,I)
               ENDDO
            ELSE
               DO IREC=1,NR
                  AZ(IREC)   = AZIM_REF(IREC,I)
                  EL(IREC)   = ELEV_REF(IREC,I)
                  GAIN(IREC) = GAIN_REF(IREC,I)
               ENDDO
            ENDIF
         ENDIF
      ENDIF
      RETURN
      END
*
***********************************************************************
*
      SUBROUTINE INIT_GAIN_ELEVATION(GAEL)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
*
      INTEGER     I, J, K, NREF
      PARAMETER   (NREF=2)
      INTEGER     DATE_REF(NREF)
      REAL*4   GAEL_REF(8,NREF)          ! Gain elevation curve / max = 8
      REAL*4   GAEL(8)
*
      DATA   DATE_REF /19940401, 19950201/
*
      DATA    (GAEL_REF(I,1),I=1,8)
     $/8.42E-1,-1.2E-2,6.9E-4,-9.8E-6,3.9E-8,0,0,0/
      DATA    (GAEL_REF(I,2),I=1,8)
     $/.7861598865,.7716227862E-2,.1162196519E-4,-.227964435E-5,
     $.1219232112E-7,0,0,0/
*
      GAEL(1) = 1                        ! default value
      DO J =2,8
         GAEL(J) = 0
      ENDDO
*
* Initialize buffer according to date_of observation
*
      IF (DATE_OF_OBSERVATION.GE.DATE_REF(1)) THEN
         I = 1
         DO K=2,NREF
            IF (DATE_OF_OBSERVATION.GE.DATE_REF(K)) I = K
         ENDDO
         DO J=1,8
            GAEL(J) = GAEL_REF(J,I)
         ENDDO
      ENDIF
      RETURN
      END
*
***********************************************************************
*
      SUBROUTINE RECORDS_IN_SUBSCAN (SUBREC,SUBSCAN,SUBSCAN_LST,
     $NUMBER,LST,DAZ)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INTEGER*4  NUMBER, I, BAD_RECORD, COUNTER, PHASE, PHASE_SIGN
      INTEGER*4  SUBSCAN(NUMBER), SUBREC(NUMBER), OLD
      REAL*4     SUBSCAN_LST(NUMBER), LST(NRECORD), DAZ(NRECORD)
      REAL*4     SUBSCAN_OFF, RECORD_OFF
*
      SUBSCAN_OFF = 0
      RECORD_OFF  = 0
      OLD = 0
      COUNTER = 0
      PHASE = 0
      PHASE_SIGN = 0
      IF (VAX_PROCESSED.AND.SCAN_TYPE.EQ.2) THEN
         DO I=1,NUMBER-1
            IF (SUBSCAN_LST(I+1).LT.SUBSCAN_LST(I)) SUBSCAN_OFF = 86400.
            DO WHILE (SUBSCAN_LST(I+1)+SUBSCAN_OFF.GT.
     $         LST(COUNTER+1)+RECORD_OFF)
               COUNTER = COUNTER + 1
               IF (LST(COUNTER+1).LT.LST(COUNTER)) RECORD_OFF = 86400.
            ENDDO
*
* counter = start of next subscan
*     old = start of last subscan
*
            IF (I/2*2.EQ.I) THEN
               PHASE = PHASE + 1
               IF (SIGN(1.,DAZ(COUNTER+1)).EQ.SIGN(1.,DAZ(OLD+1)))
     $         PHASE_SIGN = PHASE_SIGN + 1
            ENDIF
            SUBREC(I) = COUNTER - OLD
            OLD = COUNTER
         ENDDO
         SUBREC(NUMBER) = NRECORD-COUNTER
      ELSE                               ! ON-OFF scans
         IF (TELESCOPE(1:3).NE.'CSO') THEN
            DO I=1,NUMBER-1
               BAD_RECORD = 0
               IF (SUBSCAN_LST(I+1).LT.SUBSCAN_LST(I)) SUBSCAN_OFF = 864
     $         00.
               DO WHILE (SUBSCAN_LST(I+1)+SUBSCAN_OFF.GT.
     $            LST(COUNTER+1)+RECORD_OFF)
                  IF (SCAN_COORD_FOUND .AND. COUNTER.NE.OLD) THEN
                     IF (BAD_RECORD.NE.0.OR.(SCAN_TYPE.EQ.1
     $               .AND.(ABS(DAZ(COUNTER+1)-DAZ(COUNTER)).GT.10)))
     $               THEN
                        BAD_RECORD =  BAD_RECORD + 1
                        WRITE(6,*)'badrecord: ',
     $                  COUNTER,DAZ(COUNTER+1),DAZ(COUNTER)
                     ENDIF
                  ENDIF
                  COUNTER = COUNTER + 1
                  IF (LST(COUNTER+1).LT.LST(COUNTER)) RECORD_OFF = 86400
     $            .
               ENDDO
*
*     counter = start of next subscan
*     old = start of last subscan
*
               IF (I/2*2.EQ.I) THEN
                  PHASE = PHASE + 1
                  IF (SCAN_COORD_FOUND) THEN
                     IF (SIGN(1.,DAZ(COUNTER+1)).NE.SIGN(1.,DAZ(OLD+1)))
     $               PHASE_SIGN = PHASE_SIGN + 1     ! change phase sign
                  ENDIF
               ENDIF
*     DB:08-06-95   SUBREC(I) = COUNTER - OLD - BAD_RECORD
               SUBREC(I) = COUNTER - OLD
               OLD = COUNTER
            ENDDO
            SUBREC(NUMBER) = NRECORD-COUNTER
*
         ELSE                            ! SHARC ON_OFF
            DO I=1,NUMBER-1
               IF (SUBSCAN_LST(I+1).LT.SUBSCAN_LST(I))
     $         SUBSCAN_OFF = 86400.
               DO WHILE (SUBSCAN_LST(I+1)+SUBSCAN_OFF.GT.
     $            LST(COUNTER+1)+RECORD_OFF)
                  COUNTER = COUNTER + 1
                  IF (LST(COUNTER+1).LT.LST(COUNTER)) RECORD_OFF = 86400
               ENDDO
               SUBREC(I) = COUNTER
            ENDDO
            SUBREC(NUMBER) = NRECORD-COUNTER
         ENDIF
      ENDIF
*
* only on-off
*
      IF (SCAN_TYPE.EQ.1) THEN
         IF (PHASE.EQ.PHASE_SIGN) THEN   ! change phase on every subscan
            ONOFF_MODE = -1              ! antisymmetric on-off
         ELSE
            ONOFF_MODE = +1              ! symmetric on-off
         ENDIF
         IF (TELESCOPE(1:3).EQ.'CSO') ONOFF_MODE = +1
         IF (.NOT.SCAN_COORD_FOUND) ONOFF_MODE = 0   ! undefined
      ELSE
         ONOFF_MODE = 0
      ENDIF
      RETURN
      END
*
**********************************************************************
*
      SUBROUTINE RAZ_MEMORY(BUFFER,N)
      INTEGER*4  BUFFER(1)
      INTEGER*4  N,I
*
      DO I=1,N
         BUFFER(I)=0
      ENDDO
      END
*
***********************************************************************
C+HPUX
c$OPTIMIZE LEVEL1
C-HPUX
      SUBROUTINE  UPDATE_DATA(IN,OUT,OUT_PHASE,N,LEN_RECORD_IN,
     $RECORD_2PHASES)
*
      INCLUDE 'nic.inc'
      INCLUDE 'par.inc'
      REAL*4 IN(1)
      REAL*4 OUT(1),OUT_PHASE(1)
      INTEGER*4 IPBLOC,IP
      INTEGER   J,LEN_RECORD_IN,N,IREC,ICOL
      LOGICAL   RECORD_2PHASES
*
      INTEGER   FIRST_TOT,ICOL1,ICOL2
*
      IP=1
      IPBLOC=1
*
      FIRST_TOT = 5+NCHAN+1
      IF (RECORD_2PHASES) THEN
         FIRST_TOT = 5+2*NCHAN+1
      ENDIF
      DO IREC=1,N
         DO J=1,LEN_RECORD_IN
            IF (J.LT.4) THEN
               OUT(IP+NRECORD_ALLOCATED*(J-1)) = IN(IPBLOC+J-1)
            ELSEIF (J.EQ.4 .OR.J.EQ.5) THEN    ! scan_coordinates (after data)
               ICOL = 3 + NCHAN + NCALPOW + (J-4)
               OUT(IP+NRECORD_ALLOCATED*ICOL) = IN(IPBLOC+J-1)
            ELSEIF (J.GE.FIRST_TOT) THEN ! total power
               ICOL = 3 + NCHAN + (J-FIRST_TOT)
               OUT(IP+NRECORD_ALLOCATED*ICOL) = IN(IPBLOC+J-1)
            ELSEIF (.NOT.RECORD_2PHASES) THEN
               ICOL = J-3
               OUT(IP+NRECORD_ALLOCATED*ICOL) = IN(IPBLOC+J-1)
* record 2 phases
            ELSE
               ICOL = J-6
               OUT_PHASE(IP+NRECORD_ALLOCATED*ICOL) = IN(IPBLOC+J-1)
               IF (J.GT.5+NCHAN) THEN
                  ICOL1 = J-6
                  ICOL2 = ICOL1 - NCHAN
                  ICOL =  J-3-NCHAN
                  OUT(IP+NRECORD_ALLOCATED*ICOL) =
     $            OUT_PHASE(IP+NRECORD_ALLOCATED*ICOL2) -
     $            OUT_PHASE(IP+NRECORD_ALLOCATED*ICOL1)
               ENDIF
            ENDIF
         ENDDO
         IPBLOC = IPBLOC+LEN_RECORD_IN
         IP = IP+1
      ENDDO
      RETURN
      END
*
***********************************************************************
      SUBROUTINE  CHECK_DATE(DATE_OF_VAXTONMB,UT,LST,SUBSCAN_EPOCH)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'const.inc'
      INTEGER  DATE_OF_VAXTONMB,I
      REAL     UT,SUBSCAN_EPOCH(1),LST
      INTEGER  IDAY_1,IMONTH_1,IYEAR_1
*
      IDAY_1   = IDAY
      IMONTH_1 = IMONTH
      IYEAR_1  = IYEAR
      CALL SUBSTRACT_1DAY(IDAY_1,IMONTH_1,IYEAR_1)
      UT = LST                           ! ut is the output of stut
      CALL STUT(UT,1,IDAY_1,IMONTH_1,IYEAR_1,
     $SITE_LONGITUDE/DEG_TO_RAD)
      UT = UT+60                         ! 60 second before RAW_TO_NMB begin con
*
      IF (DATE_OF_VAXTONMB.LT.19960317) THEN
         IF (DATE_OF_OBSERVATION.GT.19960101) THEN
            IF (UT.GT.3600*23) THEN
               DO I=1,NSUBSCAN
                  SUBSCAN_EPOCH(I)= SUBSCAN_EPOCH(I)-1/365.
               ENDDO
               IDAY  =IDAY_1
               IMONTH=IMONTH_1
               IYEAR =IYEAR_1
            ENDIF
         ELSEIF (DATE_OF_OBSERVATION.GT.19950326) THEN
            IF (UT.GT.3600*22) THEN
               DO I=1,NSUBSCAN
                  SUBSCAN_EPOCH(I)= SUBSCAN_EPOCH(I)-1/365.
               ENDDO
               IDAY  =IDAY_1
               IMONTH=IMONTH_1
               IYEAR =IYEAR_1
            ENDIF
         ELSEIF (DATE_OF_OBSERVATION.GT.19941201) THEN
            IF (UT.GT.3600*23) THEN
               DO I=1,NSUBSCAN
                  SUBSCAN_EPOCH(I)= SUBSCAN_EPOCH(I)-1/365.
               ENDDO
            ENDIF
         ELSEIF (DATE_OF_OBSERVATION.GT.19940327) THEN
            IF (UT.GT.3600*22) THEN
               DO I=1,NSUBSCAN
                  SUBSCAN_EPOCH(I)= SUBSCAN_EPOCH(I)-1/365.
               ENDDO
               IDAY  =IDAY_1
               IMONTH=IMONTH_1
               IYEAR =IYEAR_1
            ENDIF
         ELSE
            IF (UT.GT.3600*23) THEN
               DO I=1,NSUBSCAN
                  SUBSCAN_EPOCH(I)= SUBSCAN_EPOCH(I)-1/365.
               ENDDO
               IDAY  =IDAY_1
               IMONTH=IMONTH_1
               IYEAR =IYEAR_1
            ENDIF
         ENDIF
      ENDIF
      END
***********************************************************************
      SUBROUTINE  SUBSTRACT_1DAY(IDAY,IMONTH,IYEAR)
*
      INTEGER  IDAY,IMONTH,IYEAR
      INTEGER  IMON(12)
      INTEGER  ID,I
      DATA     IMON/31,28,31,30,31,30,31,31,30,31,30,31/
*
      ID = IDAY
      DO I=1,IMONTH-1
         ID = ID+IMON(I)
      ENDDO
      ID = ID -1                         ! substract 1 day
      IF (ID.EQ.0) THEN
         IDAY = 31
         IMONTH = 12
         IYEAR = IYEAR - 1
      ELSE
         I = 1
         DO WHILE (ID.GT.0)
            ID = ID-IMON(I)
            I = I+1
         ENDDO
         IMONTH = I-1
         IDAY = ID + IMON(I-1)
      ENDIF
      END
***********************************************************************
*
      SUBROUTINE INIT_OFFSET_GAIN_SHARC(AZ,EL,GAIN,NR,TEXT)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INTEGER  NR
      REAL*4   AZ(NREC),EL(NREC),GAIN(NREC)
*
      INTEGER     I,IREC
      INTEGER     NREF
      PARAMETER   (NREF=1)
      CHARACTER   IDENT(NREF)*48, TEXT*80
      INTEGER     DATE_REF(NREF)
      REAL*4      AZIM_REF(NREC,NREF)
      REAL*4      ELEV_REF(NREC,NREF)
      REAL*4      GAIN_REF(NREC,NREF)
*
      DATA   DATE_REF /19960101/
*
*
*  Date: 1996 / 24 channels
*
      DATA   (AZIM_REF(I,1), I=1,24) /
     $0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     $0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
     $0., 0., 0., 0. /
      DATA   (ELEV_REF(I,1), I=1,24) /
     $-95.0,-90.0,-85.0,-80.0,-75.0,-70.0,-65.0,-60.0,-55.0,-50.0,
     $-45.0,-40.0,-35.0,-30.0,-25.0,-20.0,-15.0,-10.0, -5.0,  0.0,
     $5.0, 10.0, 15.0, 20.0 /
      DATA   (GAIN_REF(I,1), I=1,24) /
     $1., 1., 1., 1., 1., 1., 1., 1., 1., 1.,
     $1., 1., 1., 1., 1., 1., 1., 1., 1., 1.,
     $1., 1., 1., 1./
      DATA   IDENT(1)
     $/'Using default parameters - 24 Beam parameter set'/
*
* Default initialization for az,el,gain
*
      DO IREC =1,NR
         AZ(IREC)   = AZIM_REF(IREC,1)
         EL(IREC)   = ELEV_REF(IREC,1)
         GAIN(IREC) = GAIN_REF(IREC,1)
      ENDDO
      TEXT = IDENT(1)
      RETURN
      END
*
***********************************************************************
*
      SUBROUTINE INIT_OFFSET_GAIN_HHT(AZ,EL,GAIN,NR,TEXT,UT_DATE)
*
      INCLUDE 'nic.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INTEGER  NR
      REAL*4   AZ(NREC),EL(NREC),GAIN(NREC)
      REAL*8   UT_DATE
*
      INTEGER     I,IREC,K
      INTEGER     NREF
      PARAMETER   (NREF=2)
      CHARACTER   IDENT(NREF)*48, TEXT*80
      INTEGER     DATE_REF(NREF)
      REAL*4      AZIM_REF(NREC,NREF)
      REAL*4      ELEV_REF(NREC,NREF)
      REAL*4      GAIN_REF(NREC,NREF)
*
      DATA   DATE_REF /19980101, 20000101/
*
* 06-Mars-2000: added UT_DATE to argument list to distinguish
*               between bolometer arrays, added 19 channel
*               data from fit to Saturn (7130.asc)
*               no data from channel 15 -> flag.
*               Values to be confirmed by HHT staff.
* May 2000: Values sent by Michael Dumke
*
*
*  Using date: 01-Jan-1998 / 7 channels
*
      DATA   (AZIM_REF(I,1), I=1,7) /
     $0., -65.5, 112.5, -116.2, 64.1,  52.9, -46.1/
      DATA   (ELEV_REF(I,1), I=1,7) /
     $0., -96.4, -5.9,    12.6, 94.1, -103.3, 106.4/
      DATA   (GAIN_REF(I,1), I=1,7) /
     $1., 1., 1., 1., 1., 1., 1./
      DATA   IDENT(1)
     $/'Using default parameters - 7 Beam parameter set'/
*
*  Using date: 01-Jan-2000 / 19 channels
*
      DATA   (AZIM_REF(I,2), I=1,19) /
     $0.,      1.6, -74.0,  -24.3,   75.4,   50.0,  -75.7,
     $75.1,  -24.9,  50.1,  -48.7,   -0.2,  101.0,   25.3,
     $-49.4,  -99.4, -50.4,   51.6,   25.8/
      DATA   (ELEV_REF(I,2), I=1,19) /
     $0.,   -86.6, -43.5,  -43.5,  -42.9,   87.2,   43.2,
     $44.3,  43.0,   0.4,   -87.0,   86.7,     0.3,   43.40,
     $-0.2,  -0.5,   86.6,   -86.5,  -43.0/
      DATA   (GAIN_REF(I,2), I=1,19) /
     $1.00,  0.93,  0.93,    1.13,  0.93,  0.93,  0.94,
     $0.94,  0.93,  0.86,    1.03,  0.74,  0.79,  0.92,
     $0.93,  1.00,  0.95,    0.93,  0.93/
      DATA   IDENT(2)
     $/'Using date: 01-Jan-2000 - 19 Beam parameter set'/
*
* Default initialization for az,el,gain
*
*
      IF (UT_DATE.GE.DATE_REF(1)) THEN
         I = 1
         DO K=2,NREF
            IF (UT_DATE.GE.DATE_REF(K)) I = K
         ENDDO
         TEXT = IDENT(I)
         DO IREC=1,NR
            AZ(IREC)   = AZIM_REF(IREC,I)
            EL(IREC)   = ELEV_REF(IREC,I)
            GAIN(IREC) = GAIN_REF(IREC,I)
         ENDDO
      ENDIF
      RETURN
      END
