* Last processed by NICE on 12-Jun-2000 15:53:00
* Customized for :  IEEE, LINUX, UNIX, MOTIF, F77
C+HPUX
c$OPTIMIZE LEVEL1
C-HPUX
      SUBROUTINE SET (LINE,ERROR)
C ----------------------------------------------------------------------
C 	Support routine for command
C	SET GAIN_AMPLIFIER [State] [Attenuation]
C	SET BEAM [Azimuth [Elevation [Gain]]] /CHANNEL bolometer_channel/DEFAULT
C	SET GAIN_ELEVATION [State] [Coef1 [Coef2 [...]]]
C	SET GAIN_CHANNEL [State] [Gain1 [Gain2 [...]]]
C	SET OPACITY [State] [Opacity]
C	SET REFERENCE bolometer_channel
C
C Arguments :
C	LINE	C*(*)	Command line			Input
C	ERROR	L	Logical error flag		Output
C
C ----------------------------------------------------------------------
      CHARACTER*(*) LINE
      LOGICAL ERROR
*
      INCLUDE 'const.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
* Local
*
      INTEGER*4 IP_SKYTAU, IP_SKYUT, POINTER
      INTEGER MVOCAB, NKEY, HOW_MANY, SIC_NARG, COUNTER
      INTEGER CHAN, I, LENC, NC
      REAL*4 AZIM(NREC), ELEV(NREC), GAIN(NREC), OLD_JY_TO_COUNTS
      REAL*4 AZIM_VAL, ELEV_VAL, GAIN_VAL, OPACITY_GRADIENT
      REAL*8 UT1, UT2
*
      PARAMETER (MVOCAB=7)
      CHARACTER VOCAB(MVOCAB)*14, ARGUM1*14, ARGUM2*2, KEYWORD*14
      CHARACTER TEXT*1, TEXT1*80
      LOGICAL SIC_PRESENT, OWN, OPACITY, DATA_TYPE
      LOGICAL LAST_REC, LAST_OPA
      LOGICAL DEFAULT_GAIN, DEFAULT_ELEV, GAIN_ELEVATION
      LOGICAL DEFAULT_OPACITY, AMPLI_GAIN, JY_GAIN
      LOGICAL LAST_GAIN, LAST_ELEV, FOUND, LAST_JY
      LOGICAL GR_ERROR
*
      DATA VOCAB/'BEAM','GAIN_AMPLIFIER','GAIN_ELEVATION',
     $'GAIN_CHANNEL','OPACITY','REFERENCE','JANSKY'/
      DATA OWN /.FALSE./, OPACITY /.FALSE./
      DATA GAIN_ELEVATION /.FALSE./
      DATA DEFAULT_GAIN /.FALSE./, DEFAULT_ELEV /.FALSE./
      DATA DEFAULT_OPACITY /.FALSE./, AMPLI_GAIN /.FALSE./
*
      SAVE AZIM_VAL, ELEV_VAL, GAIN_VAL, CHAN
*
* Verify command syntax
*
*
      COMMAND_OPACITY = LINE
      ARGUM1 = 'UNKNOWN'
      CALL SIC_KE(LINE,0,1,ARGUM1,NC,.FALSE.,ERROR)
      IF (ERROR) GOTO 999
      FOUND = .FALSE.
      DO I=1,MVOCAB
         FOUND = (INDEX(VOCAB(I)(1:LENC(VOCAB(I))),
     $   ARGUM1(1:LENC(ARGUM1))).NE.0).OR.FOUND
      ENDDO
      ERROR = .FALSE.
      IF (FOUND) CALL SIC_AMBIGS('SET',
     $ARGUM1,KEYWORD,NKEY,VOCAB,MVOCAB,ERROR)
      IF (ERROR) RETURN
      IF (.NOT.FOUND.OR.ARGUM1.EQ.'UNKNOWN') THEN
         CALL GR_EXEC1 (LINE(5:LENC(LINE)))
         ERROR=GR_ERROR()
         RETURN
      ENDIF
*
* Copy NIC variable in local variable
      CALL R4TOR4(MEMORY(IP_GAIN),RECEIVER_GAIN(1),NCHAN)
      CALL R4TOR4(MEMORY(IP_AZOFF),RECEIVER_AZ_OFFSET(1),NCHAN)
      CALL R4TOR4(MEMORY(IP_ELOFF),RECEIVER_EL_OFFSET(1),NCHAN)
*
* BEAM ---------------
*
      IF (KEYWORD.EQ.VOCAB(1)) THEN
*
* Option CHANNEL
*
         CHAN = 0
         AZIM_VAL = -999
         ELEV_VAL = -999
         GAIN_VAL = -999
         IF (SIC_PRESENT(1,1))
     $   CALL SIC_I4(LINE,1,1,CHAN,.TRUE.,ERROR)
         IF (ERROR) GOTO 999
         IF ((CHAN.GT.NCHAN.AND.NRECORD.NE.0).OR.
     $   (CHAN.EQ.0 .AND. .NOT.SIC_PRESENT(2,0))) THEN
            CALL MESSAGE (2,1,'BEAM','Invalid channel number')
            GOTO 999
         ENDIF
         IF (NRECORD.EQ.0)
     $   CALL MESSAGE (2,1,'BEAM','No input file opened')
*
* Option DEFAULT
*
         IF (SIC_PRESENT(2,0)) THEN
            CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)
            CALL INIT_OFFSET_GAIN(AZIM,ELEV,GAIN,NCHAN,TEXT1,UT1)
         ENDIF
*
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.4) THEN
            CALL MESSAGE (2,1,'BEAM','Bad number of parameters')
         ELSE
            IF (HOW_MANY.GT.1) THEN
               CALL SIC_CH (LINE,0,2,TEXT,NC,.TRUE.,ERROR)
               IF (ERROR) GOTO 999
               IF (TEXT.NE.'=')
     $         CALL SIC_R4 (LINE,0,2,AZIM_VAL,.TRUE.,ERROR)
               IF (ERROR) GOTO 999
               IF (HOW_MANY.GT.2) THEN
                  CALL SIC_CH (LINE,0,3,TEXT,NC,.TRUE.,ERROR)
                  IF (ERROR) GOTO 999
                  IF (TEXT.NE.'=')
     $            CALL SIC_R4 (LINE,0,3,ELEV_VAL,.TRUE.,ERROR)
                  IF (ERROR) GOTO 999
                  IF (HOW_MANY.GT.3) THEN
                     CALL SIC_CH (LINE,0,4,TEXT,NC,.TRUE.,ERROR)
                     IF (ERROR) GOTO 999
                     IF (TEXT.NE.'=')
     $               CALL SIC_R4 (LINE,0,4,GAIN_VAL,.TRUE.,ERROR)
                     IF (ERROR) GOTO 999
                  ENDIF
               ENDIF
            ENDIF
         ENDIF
*
         IF (CHAN.EQ.0) THEN
            DO I=1,NCHAN
               RECEIVER_AZ_OFFSET(I) = AZIM(I)
               RECEIVER_EL_OFFSET(I) = ELEV(I)
               RECEIVER_GAIN(I)      = GAIN(I)
            ENDDO
         ELSE
            IF (AZIM_VAL.NE.-999) RECEIVER_AZ_OFFSET(CHAN) = AZIM_VAL
            IF (ELEV_VAL.NE.-999) RECEIVER_EL_OFFSET(CHAN) = ELEV_VAL
            IF (GAIN_VAL.NE.-999) RECEIVER_GAIN(CHAN)      = GAIN_VAL
         ENDIF
*
* Update 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)
         RETURN
      ENDIF
*
* AMPLIFIER GAIN  ---------------
*
      IF (KEYWORD.EQ.VOCAB(2)) THEN
         IF (.NOT.AMPLI_FLAG) AMPLI_GAIN = .FALSE.
         ARGUM2 = 'ON'
         CALL SIC_KE(LINE,0,2,ARGUM2,NC,.FALSE.,ERROR)
         IF (ERROR) GOTO 999
         LAST_GAIN = ARGUM2(1:2).EQ.'OF'
         IF (.NOT.LAST_GAIN .AND. AMPLI_GAIN) THEN
            CALL MESSAGE (2,1,'GAIN','... already enabled')
            RETURN
         ENDIF
         IF (LAST_GAIN .AND. .NOT.AMPLI_GAIN) THEN
            CALL MESSAGE (2,1,'GAIN','... already disabled')
            RETURN
         ENDIF
         IF (NRECORD.EQ.0) THEN
*           CALL MESSAGE(2,1,'GAIN','No input file opened')
            AMPLI_FLAG = .NOT.LAST_GAIN
            AMPLI_GAIN = .NOT.LAST_GAIN
            RETURN
         ENDIF
*
* Get amplifier gain
*
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.3) GOTO 999
         IF (HOW_MANY.EQ.3)
     $   CALL SIC_R4 (LINE,0,3,REFERENCE_GAIN,.TRUE.,ERROR)
         IF (ERROR) GOTO 999
         IF (REFERENCE_GAIN.NE.NINT(REFERENCE_GAIN)) THEN
            CALL MESSAGE (2,1,'GAIN','invalid gain [integer]')
            RETURN
         ENDIF
         IF (REFERENCE_GAIN.LT.1.OR.REFERENCE_GAIN.GT.9) THEN
            CALL MESSAGE (2,1,'GAIN','gain not in range [1..9]')
            RETURN
         ENDIF
         IF (REFERENCE_GAIN.EQ.0) THEN
            CALL MESSAGE (2,1,'GAIN','no scaling applied (Undefined ?)')
            RETURN
         ENDIF
*
* Activate or Deactivate amplifier gain
*
         IF ((.NOT.LAST_GAIN .AND. .NOT.AMPLI_GAIN) .OR.
     $   (LAST_GAIN .AND. AMPLI_GAIN)) THEN
            CALL DO_AM (MEMORY(IP_SIGNAL),AMPLI_GAIN,
     $      NINT(REFERENCE_GAIN))
         ENDIF
         RETURN
      ENDIF
*
* GAIN_ELEVATION ---------------
*
      IF (KEYWORD.EQ.VOCAB(3)) THEN
         IF (SCAN_TYPE.EQ.3) RETURN
         IF (.NOT.GAIN_ELEV_FLAG) GAIN_ELEVATION = .FALSE.
         ARGUM2 = 'ON'
         CALL SIC_KE(LINE,0,2,ARGUM2,NC,.FALSE.,ERROR)
         IF (ERROR) GOTO 999
         LAST_ELEV = ARGUM2(1:2).EQ.'OF'
         IF (.NOT.LAST_ELEV .AND. GAIN_ELEVATION) THEN
            CALL MESSAGE (2,1,'GAIN','... already enabled')
            RETURN
         ENDIF
         IF (LAST_ELEV. AND. .NOT.GAIN_ELEVATION) THEN
            CALL MESSAGE (2,1,'GAIN','... already disabled')
            RETURN
         ENDIF
         IF (NRECORD.EQ.0) THEN
*           CALL MESSAGE(2,1,'GAIN','No input file opened')
            GAIN_ELEV_FLAG     = .NOT.LAST_ELEV
            GAIN_ELEVATION     = .NOT.LAST_ELEV
            RETURN
         ENDIF
*
* Get gain elevation curve
*
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.10) GOTO 999
         IF (HOW_MANY.GT.2.AND. .NOT.LAST_ELEV) THEN
            DO COUNTER = 1,8
               GAIN_ELEV(COUNTER) = 0
            ENDDO
            COUNTER = 2
            DO WHILE (COUNTER.NE.HOW_MANY)
               COUNTER = COUNTER+1
               CALL SIC_R4 (LINE,0,COUNTER,GAIN_ELEV(COUNTER-2),
     $         .TRUE.,ERROR)
               IF (ERROR) GOTO 999
            ENDDO
            DEFAULT_ELEV = .TRUE.
         ELSE
            IF (.NOT.DEFAULT_ELEV) THEN
               CALL INIT_GAIN_ELEVATION (GAIN_ELEV)
               IF (GAIN_ELEV(1).EQ.0) THEN
                  CALL MESSAGE (2,1,'GAIN',
     $            'No gain-elevation curve available')
                  GAIN_ELEV_FLAG = .FALSE.
                  RETURN
               ENDIF
            ENDIF
         ENDIF
*
* Activate or Deactivate Gain-Elevation Curve
*
         IF ((.NOT.LAST_ELEV .AND. .NOT.GAIN_ELEVATION).OR.
     $   (LAST_ELEV .AND. GAIN_ELEVATION)) THEN
            CALL DO_GE (MEMORY(IP_EL),MEMORY(IP_SIGNAL),
     $      GAIN_ELEV,GAIN_ELEVATION)
            IF (LAST_ELEV) DEFAULT_ELEV = .FALSE.
         ENDIF
         RETURN
      ENDIF
*
* GAIN_RECEIVER ---------------
*
      IF (KEYWORD.EQ.VOCAB(4)) THEN
         IF (.NOT.GAIN_RECEIVER_FLAG) GAIN_REC = .FALSE.
         ARGUM2 = 'ON'
         CALL SIC_KE(LINE,0,2,ARGUM2,NC,.FALSE.,ERROR)
         IF (ERROR) GOTO 999
         LAST_REC = ARGUM2(1:2).EQ.'OF'
         IF (.NOT.LAST_REC .AND. GAIN_REC) THEN
            CALL MESSAGE (2,1,'GAIN','... already enabled')
            RETURN
         ENDIF
         IF (LAST_REC .AND. .NOT.GAIN_REC) THEN
            CALL MESSAGE (2,1,'GAIN','... already disabled')
            RETURN
         ENDIF
         IF (NRECORD.EQ.0) THEN
*           CALL MESSAGE(2,1,'GAIN','No input file opened')
            GAIN_RECEIVER_FLAG = .NOT.LAST_REC
            GAIN_REC           = .NOT.LAST_REC
            RETURN
         ENDIF
*
* Get Receiver Gains
*
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.NCHAN+2) GOTO 999
         IF (HOW_MANY.GT.2 .AND. .NOT.LAST_REC) THEN
            DO COUNTER = 1,NCHAN
               GAIN(COUNTER) = 0
            ENDDO
            COUNTER = 2
            DO WHILE (COUNTER.NE.HOW_MANY)
               COUNTER = COUNTER+1
               CALL SIC_R4 (LINE,0,COUNTER,GAIN(COUNTER-2),
     $         .TRUE.,ERROR)
               IF (ERROR) GOTO 999
            ENDDO
            DEFAULT_GAIN = .TRUE.
            DO COUNTER = HOW_MANY-1,NCHAN
               GAIN(COUNTER) = 1.
            ENDDO
         ELSE
*            IF (DATE_OF_OBSERVATION.GE.19930208) THEN! February 1993
*               IF (.NOT.DEFAULT_GAIN) THEN
*                  CALL INIT_OFFSET_GAIN(AZIM,ELEV,GAIN,Nchan)
*               ENDIF
*            ELSE
*               CALL MESSAGE (2,1,'GAIN',
*     $         'No receiver gains available')
*               DO COUNTER = 1,Nchan
*                  GAIN(COUNTER) = 1.
*               ENDDO
*            ENDIF
            CALL R4TOR4(MEMORY(IP_GAIN),GAIN(1),NCHAN)     !DO_GR use GAIN
         ENDIF
         DO COUNTER=1,NCHAN
            RECEIVER_GAIN(COUNTER) = GAIN(COUNTER)
         ENDDO
         CALL R4TOR4(RECEIVER_GAIN(1),MEMORY(IP_GAIN),NCHAN)
*
* Activate or Deactivate Receiver Gains
*
         IF ((.NOT.LAST_REC .AND. .NOT.GAIN_REC).OR.
     $   (LAST_REC .AND. GAIN_REC)) THEN
            CALL DO_GR (MEMORY(IP_SIGNAL),GAIN)
            IF (LAST_REC) DEFAULT_GAIN = .FALSE.
         ENDIF
         RETURN
      ENDIF
*
* OPACITY ---------------
*
      IF (KEYWORD.EQ.VOCAB(5)) THEN
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.3) GOTO 999
         IF (.NOT.OPACITY_FLAG) OPACITY = .FALSE.
         ARGUM2 = 'ON'
         CALL SIC_KE(LINE,0,2,ARGUM2,NC,.FALSE.,ERROR)
         IF (ERROR) GOTO 999
         LAST_OPA = ARGUM2(1:2).EQ.'OF'
         IF (LAST_OPA.AND..NOT.OPACITY) THEN
            CALL MESSAGE (2,1,'OPACITY','... already disabled')
            RETURN
         ENDIF
         IF (HOW_MANY.EQ.3) THEN
            CALL SIC_R4 (LINE,0,3,
     $      ATMOSPHERIC_OPACITY,.TRUE.,ERROR)
            IF (ERROR) GOTO 999
            IF (ATMOSPHERIC_OPACITY.EQ.0) THEN
               CALL MESSAGE (2,1,'OPACITY','Invalid opacity')
               GOTO 999
            ENDIF
            MANUAL_OPACITY = ATMOSPHERIC_OPACITY
            IF (OPACITY)
     $      CALL MESSAGE (2,1,'OPACITY','... changing to new opacity')
         ELSE
            MANUAL_OPACITY = 0
         ENDIF
         IF (SCAN_TYPE.EQ.3) THEN
            CALL MESSAGE (2,1,
     $      'OPACITY','Command will not be executed on a SKYDIP')
            RETURN
         ENDIF
         IF (OPACITY.AND.NRECORD.NE.0) THEN
            CALL DO_OP (MEMORY(IP_SIGNAL),MEMORY(IP_EL),OPACITY,
     $      OLD_OPACITY,OLD_OPACITY_GRADIENT,OLD_UT1,OLD_UT2,DATA_TYPE)
            OPACITY = .FALSE.
            IF (LAST_OPA) RETURN
         ENDIF
         IF (.NOT.LAST_OPA.AND.OPACITY.AND.MANUAL_OPACITY.EQ.0) THEN
            IF (DATA_TYPE)
     $      CALL MESSAGE (2,1,'OPACITY','... already enabled')
         ENDIF
         IF (NRECORD.EQ.0) THEN
*           CALL MESSAGE(2,1,'OPACITY','No input file opened')
            OPACITY_FLAG = .NOT.LAST_OPA
            OPACITY      = .NOT.LAST_OPA
            RETURN
         ENDIF
         IF (NUMBER_OF_SKYDIPS.LE.0.AND.MANUAL_OPACITY.EQ.0) THEN
            IF (DATA_TYPE)
     $      CALL MESSAGE(2,1,'OPACITY','No sky opacity available')
            RETURN
         ENDIF
*
* Get opacity correction
*
         CALL GET_SCAN_UT (UT1,MEMORY(IP_LST),1)
         CALL GET_SCAN_UT (UT2,MEMORY(IP_LST),NRECORD)
         OPACITY_GRADIENT = 0
         IF (HOW_MANY.LE.2.AND.NUMBER_OF_SKYDIPS.GT.0) THEN
            IP_SKYUT = POINTER(SKYDIP_MEM,MEMORY)
            IP_SKYTAU = IP_SKYUT + 2*NUMBER_OF_SKYDIPS     ! double precision
            DATA_TYPE = .TRUE.
            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.AND.DATA_TYPE) THEN
            CALL MESSAGE (2,1,'OPACITY',
     $      'no correction applied (Undefined ?)')
            OPACITY_FLAG = .FALSE.
            RETURN
         ENDIF
*
* Activate or Deactivate Atmospheric Corrections
*
         IF ((.NOT.LAST_OPA .AND. .NOT.OPACITY).OR.
     $   (LAST_OPA .AND. OPACITY)) THEN
            CALL DO_OP (MEMORY(IP_SIGNAL),MEMORY(IP_EL),OPACITY,
     $      ATMOSPHERIC_OPACITY,OPACITY_GRADIENT,UT1,UT2,DATA_TYPE)
         ENDIF
         OLD_OPACITY = ATMOSPHERIC_OPACITY
         OLD_OPACITY_GRADIENT = OPACITY_GRADIENT
         OLD_UT1 = UT1
         OLD_UT2 = UT2
         RETURN
      ENDIF
*
* REFERENCE ---------------
*
      IF (KEYWORD.EQ.VOCAB(6)) THEN
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.EQ.2) THEN
            CALL SIC_I4 (LINE,0,2,CHAN,.TRUE.,ERROR)
            IF (ERROR) GOTO 999
*
            IF (CHAN.NE.1.AND.NRECORD.EQ.0) THEN
               CALL MESSAGE(2,1,'REFERENCE','No input file opened')
               CALL MESSAGE(2,1,'REFERENCE','Command not accepted')
               RETURN
            ENDIF
            IF ((CHAN.GT.NCHAN.OR.CHAN.LT.1)
     $      .AND.NRECORD.NE.0) THEN
               CALL MESSAGE(2,1,'REFERENCE','Invalid Reference Channel')
               RETURN
            ENDIF
            REFERENCE_RECEIVER = CHAN
         ENDIF
         RETURN
      ENDIF
*
* JY CONVERSION  ---------------
*
      IF (KEYWORD.EQ.VOCAB(7)) THEN
         JY_GAIN = .TRUE.
         IF (.NOT.JANSKY_FLAG) JY_GAIN = .FALSE.
*         IF (NRECORD.EQ.0) THEN
*            CALL MESSAGE(2,1,'GAIN','No input file opened')
*            CALL MESSAGE(2,1,'GAIN','Conversion factor defined ')
*         ENDIF
         ARGUM2 = 'ON'
         CALL SIC_KE(LINE,0,2,ARGUM2,NC,.FALSE.,ERROR)
         IF (ERROR) GOTO 999
         LAST_JY = ARGUM2(1:2).EQ.'OF'
         IF (.NOT.LAST_JY.AND.ARGUM2(1:2).NE.'ON') THEN
            CALL MESSAGE(2,1,'JANSKY','... bad syntax')
            ERROR = .TRUE.
            RETURN
         ENDIF
*
* Get conversion factor
*
         OLD_JY_TO_COUNTS = JY_TO_COUNTS
         HOW_MANY = SIC_NARG(0)
         IF (HOW_MANY.GT.3) GOTO 999
         IF (HOW_MANY.EQ.3)
     $   CALL SIC_R4 (LINE,0,3,JY_TO_COUNTS,.TRUE.,ERROR)
         IF (ERROR) GOTO 999
         IF (JY_TO_COUNTS.LT.1E-3) THEN
            CALL MESSAGE (2,1,'JANSKY','... bad conversion factor')
            JY_TO_COUNTS = OLD_JY_TO_COUNTS
            ERROR = .TRUE.
            RETURN
         ENDIF
*
* Activate or Deactivate conversion factor
*
         IF (.NOT.LAST_JY .AND. JY_GAIN) THEN
            CALL DO_JY (MEMORY(IP_SIGNAL),JY_GAIN,OLD_JY_TO_COUNTS)
            IF (OLD_JY_TO_COUNTS.NE.JY_TO_COUNTS)
     $      CALL MESSAGE (2,1,'JANSKY','... new factor applied')
         ENDIF
*
         IF ((.NOT.LAST_JY .AND. .NOT.JY_GAIN) .OR.
     $   (LAST_JY .AND. JY_GAIN)) THEN
            CALL DO_JY (MEMORY(IP_SIGNAL),JY_GAIN,JY_TO_COUNTS)
         ENDIF
         IF (.NOT.JANSKY_FLAG) JY_TO_COUNTS = 0
         RETURN
      ENDIF
*
999   ERROR = .TRUE.
      RETURN
      END
*
      SUBROUTINE DO_GE (EL,SIGNAL,COEF,OFF_ELEV)
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
      REAL SIGNAL(NRECORD,NCHAN)
      REAL COEF(8), EL(NRECORD), CORR
      INTEGER I, K, COUNTER
      LOGICAL OFF_ELEV, LOW
*
      DO I=1,NRECORD
         DO K=1,NCHAN
            CORR = 0
            DO COUNTER = 1,8
               CORR = CORR+COEF(COUNTER)*EL(I)**(COUNTER-1)
            ENDDO
            IF (OFF_ELEV) CORR = 1/CORR
            IF (SIGNAL(I,K).NE.BLANKING)
     $      SIGNAL(I,K) = SIGNAL(I,K)/CORR
         ENDDO
         MEAN_GAIN = MEAN_GAIN+CORR
      ENDDO
      MEAN_GAIN = MEAN_GAIN/NRECORD
      OFF_ELEV = .NOT.OFF_ELEV
      IF (OFF_ELEV) THEN
         GAIN_ELEV_FLAG = .TRUE.
      ELSE
         MEAN_GAIN = 0
         GAIN_ELEV_FLAG = .FALSE.
      ENDIF
      LOW = .FALSE.
      DO I=1,NRECORD
         IF (EL(I).LT.20) LOW = .TRUE.
      ENDDO
      IF (LOW.AND.MEAN_GAIN.NE.0)
     $CALL MESSAGE (2,1,'GAIN','Low elevation correction dubious')
      RETURN
      END
*
      SUBROUTINE DO_GR (SIGNAL,GAIN)
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
      REAL SIGNAL(NRECORD,NCHAN), GAIN(NREC)
      INTEGER I, K
*
      DO I=1,NRECORD
         DO K=1,NCHAN
            IF (SIGNAL(I,K).NE.BLANKING.AND.GAIN(K).NE.0) THEN
               IF (GAIN_REC) THEN
                  SIGNAL(I,K) = SIGNAL(I,K)/GAIN(K)
               ELSE
                  SIGNAL(I,K) = SIGNAL(I,K)*GAIN(K)
               ENDIF
            ENDIF
         ENDDO
      ENDDO
      GAIN_REC = .NOT.GAIN_REC
      IF (GAIN_REC) THEN
         GAIN_RECEIVER_FLAG = .TRUE.
c         CALL MESSAGE (2,1,'GAIN',
c     $        'Modified channel gain corrections enabled ...')
      ELSE
         GAIN_RECEIVER_FLAG = .FALSE.
      ENDIF
      RETURN
      END
*
      SUBROUTINE DO_OP (SIGNAL,EL,OPACITY_STATE,
     $OPACITY,GRAD,UT1,UT2,DATA_TYPE)
      INCLUDE 'const.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
      REAL SIGNAL(NRECORD,NCHAN), EL(NRECORD), MEAN_OPACITY
      REAL OPACITY, CORR, GRAD, CURRENT_OPACITY
      REAL*8 UT1, UT2
      CHARACTER STRING*36
      INTEGER I, K
      LOGICAL OPACITY_STATE, DATA_TYPE
*
      MEAN_OPACITY = 0.0                 !WAS MISSING. GD.
      IF (SCAN_TYPE.NE.3) THEN
         DO I=1,NRECORD
            CURRENT_OPACITY = OPACITY+GRAD*(UT2-UT1)*(I-1)/(NRECORD-1)
            MEAN_OPACITY = MEAN_OPACITY+CURRENT_OPACITY
            CORR = EXP(CURRENT_OPACITY/SIN(EL(I)*PI/180))
            DO K=1,NCHAN
               IF (SIGNAL(I,K).NE.BLANKING) THEN
                  IF (OPACITY_STATE) THEN
                     SIGNAL(I,K) = SIGNAL(I,K)/CORR
                  ELSE
                     SIGNAL(I,K) = SIGNAL(I,K)*CORR
                  ENDIF
               ENDIF
            ENDDO
         ENDDO
         IF (OPACITY.GT.0.AND..NOT.OPACITY_STATE) THEN
            SCAN_OPACITY = MEAN_OPACITY/NRECORD
            STRING = 'Using a mean zenith opacity of '
            WRITE (STRING(32:36),'(f5.3)') SCAN_OPACITY
            IF (DATA_TYPE) CALL MESSAGE (2,1,'OPACITY',STRING)
         ENDIF
         CORR = EXP(SCAN_OPACITY/SIN(EL(NRECORD/2)*PI/180))
         IF (OPACITY_STATE.AND.SCAN_TYPE.NE.3) THEN
            CALL CORRECT_DIV(MEMORY(IP_RMS),CORR)
         ELSE
            CALL CORRECT_MUL(MEMORY(IP_RMS),CORR)
         ENDIF
      ENDIF
      OPACITY_STATE = .NOT.OPACITY_STATE
      IF (OPACITY_STATE) THEN
         OPACITY_FLAG = .TRUE.
      ELSE
         OPACITY_FLAG = .FALSE.
      ENDIF
      RETURN
      END
*
      SUBROUTINE DO_AM (SIGNAL,AMPLI_STATE,GAIN)
      INCLUDE 'const.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
      REAL SIGNAL(NRECORD,NCHAN),CORR
      INTEGER I, K, GAIN
      LOGICAL AMPLI_STATE
*
      CORR = 2**(GAIN-1)
      IF (AMPLI_STATE) THEN
         CALL CORRECT_DIV(MEMORY(IP_RMS),CORR)
      ELSE
         CALL CORRECT_MUL(MEMORY(IP_RMS),CORR)
      ENDIF
      DO I=1,NRECORD
         DO K=1,NCHAN
            IF (SIGNAL(I,K).NE.BLANKING) THEN
               IF (AMPLI_STATE) THEN
                  SIGNAL(I,K) = SIGNAL(I,K)/CORR
               ELSE
                  SIGNAL(I,K) = SIGNAL(I,K)*CORR
               ENDIF
            ENDIF
         ENDDO
      ENDDO
      AMPLI_STATE = .NOT.AMPLI_STATE
      IF (AMPLI_STATE) THEN
         AMPLI_FLAG = .TRUE.
      ELSE
         AMPLI_FLAG = .FALSE.
      ENDIF
      RETURN
      END
*
      SUBROUTINE DO_JY (SIGNAL,JY_STATE,GAIN)
      INCLUDE 'const.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
      REAL SIGNAL(NRECORD,NCHAN), GAIN
      INTEGER I, K
      LOGICAL JY_STATE
*
      IF (JY_STATE) THEN
         CALL CORRECT_MUL(MEMORY(IP_RMS),GAIN)
      ELSE
         CALL CORRECT_DIV(MEMORY(IP_RMS),GAIN)
      ENDIF
      DO I=1,NRECORD
         DO K=1,NCHAN
            IF (SIGNAL(I,K).NE.BLANKING) THEN
               IF (JY_STATE) THEN
                  SIGNAL(I,K) = SIGNAL(I,K)*GAIN
               ELSE
                  SIGNAL(I,K) = SIGNAL(I,K)/GAIN
               ENDIF
            ENDIF
         ENDDO
      ENDDO
      JY_STATE = .NOT.JY_STATE
      IF (JY_STATE) THEN
         JANSKY_FLAG = .TRUE.
      ELSE
         JANSKY_FLAG = .FALSE.
      ENDIF
      RETURN
      END
*
      SUBROUTINE CORRECT_MUL(CHAN_RMS,GAIN)
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      REAL CHAN_RMS(NCHAN), GAIN
      INTEGER I
*
      DO I=1,NCHAN
         CHAN_RMS(I) = CHAN_RMS(I)*GAIN
      ENDDO
      RETURN
      END
*
      SUBROUTINE CORRECT_DIV(CHAN_RMS,GAIN)
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      REAL CHAN_RMS(NCHAN), GAIN
      INTEGER I
*
      IF (GAIN.NE.0) THEN
         DO I=1,NCHAN
            CHAN_RMS(I) = CHAN_RMS(I)/GAIN
         ENDDO
      ENDIF
      RETURN
      END
*
*
      SUBROUTINE GET_SCAN_UT(UT,LST,NPOS)
      INCLUDE 'const.inc'
      INCLUDE 'parameter.inc'
      INCLUDE 'par.inc'
      INCLUDE 'nic.inc'
*
* Global
      REAL*4  LST(NRECORD), UT_DUMMY
      INTEGER NPOS
* Local
      REAL*8  UT
*
      UT_DUMMY = LST(NPOS)
      CALL STUT (UT_DUMMY,1,
     $IDAY,IMONTH,IYEAR,SITE_LONGITUDE/DEG_TO_RAD)
      UT = DBLE(DATE_OF_OBSERVATION)+UT_DUMMY/86400D0
      RETURN
      END
*
      SUBROUTINE GET_OPACITY (UT,DIP_UT,DIP_TAU,NUM,TAU,GRAD,
     $DATA_TYPE)
      IMPLICIT NONE
      INTEGER NUM, J
      REAL*8 UT,DIP_UT(NUM), UT_MIN, UT_MAX
      REAL*4 TAU,DIP_TAU(NUM), TAU_1, TAU_2, GRAD
      LOGICAL FOUND,DATA_TYPE
*
      FOUND = .FALSE.
      J = 1
      UT_MIN = DIP_UT(1)
      UT_MAX = DIP_UT(NUM)
      IF (NUM.GT.1) THEN
         DO WHILE (.NOT.FOUND.AND.J.LT.NUM)
            IF (UT.GE.DIP_UT(J).AND.UT.LE.DIP_UT(J+1)) THEN
               FOUND = .TRUE.
               UT_MIN = DIP_UT(J)
               UT_MAX = DIP_UT(J+1)
               TAU_1 = DIP_TAU(J)
               TAU_2 = DIP_TAU(J+1)
            ELSE
               J = J+1
            ENDIF
         ENDDO
      ENDIF
      IF (.NOT.FOUND) THEN
         IF (DATA_TYPE) CALL MESSAGE (2,1,'OPACITY','Extrapolating...')
         IF (UT.GT.UT_MAX) THEN
            TAU = DIP_TAU(NUM)
            IF (UT-UT_MAX.GT.1/12..AND.DATA_TYPE)
     $      CALL MESSAGE (2,1,'OPACITY','Time lag...')
            IF (UT-UT_MAX.GT.1/6.) THEN
               GRAD = 0
               TAU = -1
            ENDIF
         ENDIF
         IF (UT.LT.UT_MIN) THEN
            TAU = DIP_TAU(1)
            IF (UT_MIN-UT.GT.1/12..AND.DATA_TYPE)
     $      CALL MESSAGE (2,1,'OPACITY','Time lag...')
            IF (UT_MIN-UT.GT.1/6.) THEN
               GRAD = 0
               TAU = -1
            ENDIF
         ENDIF
      ELSE
         GRAD =  (TAU_2-TAU_1)/(UT_MAX-UT_MIN)
         TAU = GRAD*(UT-UT_MIN)+TAU_1
         IF (MIN (UT_MAX-UT,UT-UT_MIN).GT.1/12..AND.DATA_TYPE)
     $   CALL MESSAGE (2,1,'OPACITY','Time lag...')
         IF (MIN (UT_MAX-UT,UT-UT_MIN).GT.1/6.) TAU = -1
         IF (MIN (ABS(TAU_1-TAU),ABS(TAU_2-TAU)).GT..1.AND.TAU.NE.-1
     $   .AND.DATA_TYPE)
     $   CALL MESSAGE (2,1,'OPACITY','Large variation...')
      ENDIF
      RETURN
      END
